|
Code:
- *PARMS BNDDIR(QC2LE)
- process nomonoprc apost xref
- Identification Division.
- program-id. RMVCSVBC.
- *author. Michael Quigley.
- *installation. The Way International.
- *date-written. 02/12/2015.
-
- * NOTICE: All computer programs, data bases and other work
- * product used in the compilation of this work, as
- * well as the work itself, are the property of The
- * Way International, publication or copying without
- * prior written permission prohibited. All rights
- * reserved.
-
- *-------------------------------------------------------------
- *
- * Purpose: This program reads a CSV stream file from the IFS
- * and removes single blanks from any field values.
- *
- * Notes: The largest file this routine can handle is around
- * 16 MB. Modifying the code can enable it to handle
- * much larger files. If opening and reading a file
- * larger than 2 GB is needed. o_LargeFile will need
- * to be set.
- * Additional logic will be also be needed to loop
- * through the larger file processing chunks of the file
- * rather than processing the entire file at one time.
- *
- *-------------------------------------------------------------
- * Modifications:
- *
-
-
- Environment Division.
- Configuration section.
- special-names.
- .
-
- *
- Data Division.
-
- *
- Working-storage section.
-
- *-- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- * Working fields
- *
-
- 01 Full-path-name pic x(2048).
-
- * The following are the largest a COBOL element can be.
- 01 File-data-in pic x(16711568).
- 01 File-data-out like File-data-in.
-
- 01 In-pointer pic 9(9) binary.
- 01 Out-pointer like In-pointer.
- 01 Work-pointer like In-pointer.
- 01 Move-length like In-pointer.
-
- * Define a constant for the Quote blank quote
- 01 Quote-blank-quote constant x'7F407F'.
-
- *--------------------------------------------
- * Links to other routines APIs
-
- *-- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- * System APIs
- * - - - - - - - - - - - - - - - - - - - - - -
-
- *-- -- -- -- -- -- -- -- -- -- -- -- -- -- --
- * Links to ILE C library and other C routines
- * - - - - - - - - - - - - - - - - - - - - - -
- * Standard UNIX error handling
- 01 Get-errno constant '__errno'.
- 01 Errno-pointer pointer.
-
- *--------------------------------------------
- * Stream File APIs
-
- * - - - - - - - - - - - - - - - - - - - - - -
- * File information (statistics?)
- 01 Get-file-information constant 'stat'.
-
- 01 Information-buffer.
- 05 Mode-permissions pic 9(9) binary.
- 05 Internal-file-number pic 9(9) binary.
- 05 Number-of-links pic 9(4) binary.
- 05 Reserved-2 pic 9(4) binary.
- 05 Owner-user-id pic 9(9) binary.
- 05 Group-id pic 9(9) binary.
- 05 Entry-size pic s9(9) binary.
- 05 Last-time-accessed pic s9(9) binary.
- 05 Last-time-changed pic s9(9) binary.
- 05 Last-status-change pic s9(9) binary.
- 05 File-system-device pic s9(9) binary.
- 05 Entry-block-size pic 9(9) binary.
- 05 Entry-bytes-allocated pic 9(9) binary.
- 05 Entry-object-type pic x(11).
- 05 Reserved-3 pic x.
- 05 Code-page pic 9(4) binary.
- 05 Entry-CCSID pic 9(4) binary.
- 05 Device-id pic 9(9) binary.
- 05 Number-of-links-long pic 9(9) binary.
- 05 Device-id-long pic 9(18) binary.
- 05 File-system-id pic 9(18) binary.
- 05 Mounted-file-system-id pic 9(9) binary.
- 05 Reserved-1 pic x(32).
- 05 Internal-generation-id pic 9(9) binary.
-
- * - - - - - - - - - - - - - - - - - - - - - -
- * IFS manipulation APIs
- 01 Open-file constant 'open'.
- 01 Close-stream-file constant 'close'.
- 01 Read-file-data constant 'read'.
- 01 Position-in-file constant 'lseek'.
- 01 Write-file-data constant 'write'.
- 01 File-truncate constant 'ftruncate'.
-
- * - - - - - - - - - - - - - - - - - - - - - -
- * General arguments
- 01 Bytes-to-process pic s9(9) binary.
- 01 Return-value pic s9(9) binary.
- 88 Processed-okay value 0.
- 88 Process-error value -1.
-
- * - - - - - - - - - - - - - - - - - - - - - -
- * Open specific arguments
- 01 File-descriptor pic s9(9) binary.
- 01 Oflag pic s9(9) binary.
-
- * o_Flag values (access control)
- 01 o_RdWr constant 4.
- 01 o_Trunc constant 64.
- 01 o_TextData constant 16777216.
- *01 o_LargeFile constant 536870912.
-
- * - - - - - - - - - - - - - - - - - - - - - -
- * Position in stream file lseek()
- 01 Seek-set constant 0.
- 01 Offset pic s9(9) binary.
- 01 Whence like Offset.
-
- *--------------------------------------------
- Linkage section.
- 01 Parm-path.
- 05 Parm-path-length pic s9(4) binary.
- 05 Parm-path-data pic x(1408).
-
- * - - - - - - - - - - - - - - - - - - - - - -
- * UNIX-type API error handling
- 01 Error-number pic 9(9) binary.
-
- Procedure Division
- using Parm-path
- .
-
- 0000-Main.
- perform 0010-Initialize
-
- perform 1000-Process-file
-
- perform 0050-Close-stream-file
-
- goback
- .
-
- *
- 0010-Initialize.
- move Parm-path-data(1:Parm-path-length)
- to Full-path-name
- move x'00' to Full-path-name(Parm-path-length + 1:1)
- perform 0020-Get-entry-information
- perform 0030-Open-stream-file
- .
-
- 0020-Get-entry-information.
- call procedure Get-file-information
- using Full-path-name
- Information-buffer
- returning Return-value
- end-call
-
- if Process-error
- perform 7000-Get-errno
- display 'Error number ', Error-number, ' encountered.'
- move zero to Entry-size
- end-if
- .
-
- 0030-Open-stream-file.
- compute Oflag
- = o_RdWr
- + o_TextData
- end-compute
-
- call procedure Open-file
- using
- by reference Full-path-name
- by value Oflag
- returning File-descriptor
- end-call
- if File-descriptor < 0
- perform 7000-Get-errno
- display 'File open error ', Error-number
- goback
- end-if
- .
-
- 0050-Close-stream-file.
- call procedure Close-stream-file
- using
- by value File-descriptor
- returning Return-value
- end-call
-
- if Process-error
- perform 7000-Get-errno
- display 'File close error', Error-number
- goback
- end-if
- .
-
- 1000-Process-file.
- perform 1010-Read-file-data
- move 1 to In-pointer
- Out-pointer
- move spaces to File-data-out
- perform 2100-Scan-file
- * The file has been completely scanned. See if the last
- * data has been processed.
- if Work-pointer + 3 <= Entry-size
- perform 2000-Remove-blanks
- until In-pointer + 2 > Entry-size
- end-if
- if In-pointer < Work-pointer
- and Work-pointer <= Entry-size
- perform 2200-Move-file-data
- end-if
-
- perform 1020-Write-file-data
-
- perform 1030-Truncate-file
- .
-
- 1010-Read-file-data.
- call procedure Read-file-data
- using
- by value File-descriptor
- by reference File-data-in
- by value Entry-size
- returning Return-value
- end-call
-
- if Process-error
- perform 7000-Get-errno
- display 'Error reading file: ', Error-number
- goback
- end-if
- .
-
- 1020-Write-file-data.
- move zero to Offset
- move Seek-set to Whence
- call procedure Position-in-file
- using
- by value File-descriptor
- Offset
- Whence
- returning Return-value
- end-call
-
- if Process-error
- perform 7000-Get-errno
- display 'Error positioning file for write: ', Error-number
- goback
- end-if
-
- * Out-pointer is one past the last byte moved.
- * So reduce the bytes to write by 1
- compute Bytes-to-process
- = Out-pointer
- - 1
- end-compute
- call procedure Write-file-data
- using
- by value File-descriptor
- by reference File-data-out
- by value Bytes-to-process
- returning Return-value
- end-call
-
- if Process-error
- display 'Error writing file: ', Error-number
- goback
- end-if
- .
-
- 1030-Truncate-file.
- call procedure File-truncate
- using
- by value File-descriptor
- Bytes-to-process
- returning Return-value
- end-call
-
- if Process-error
- display 'Error truncating file: ', Error-number
- goback
- end-if
- .
-
- 2000-Remove-blanks.
- perform 2200-Move-file-data
- if Work-pointer < Entry-size
- compute In-pointer
- = Work-pointer
- + 2
- end-compute
- perform 2100-Scan-file
- end-if
- .
-
- 2100-Scan-file.
- perform
- varying Work-pointer
- from In-pointer by 1
- until File-data-in(Work-pointer:3) = '" "'
- or Work-pointer + 2 > Entry-size
- continue
- end-perform
- .
-
- 2200-Move-file-data.
- If Work-pointer > Entry-size
- compute Move-length
- = Entry-size
- - In-pointer
- + 1
- end-compute
- else
- compute Move-length
- = Work-pointer
- - In-pointer
- + 1
- end-compute
- end-if
- move File-data-in(In-pointer:Move-length)
- to File-data-out(Out-pointer:Move-length)
-
- compute Out-pointer
- = Out-pointer
- + Move-length
- end-compute
- .
-
- *--------------------------------------------
- * Unix Errno handling
- 7000-Get-errno.
- call procedure Get-errno
- returning Errno-pointer
- end-call
-
- set address of Error-number to Errno-pointer
- .
|
|