feat: add benchmark-programs — 58 telecom COBOL test programs
作为子目录纳入系统，与核心测试管道协同 Co-Authored-By: Claude <noreply@anthropic.com>
This commit is contained in:
NB-076
@@ -0,0 +1,731 @@
|
||||
*> ============================================================
|
||||
*> 21-csv-fb-lf : CDR CSV取込(有LF) (CDR Import with LF)
|
||||
*> Input : FILE-IN (file-in.csv: 外部CDR CSV有LF)
|
||||
*> Output: FILE-OUT (file-out.dat: LF展开后固定长记录)
|
||||
*> Error : ERROR-REPORT (csv-lf-errors.dat: CSV错误明细)
|
||||
*> Audit : AUDIT-FILE (csv-lf-audit.dat: 审计跟踪)
|
||||
*> Coverage: CF-N002~N006, CF-A001, CF-E001~E005
|
||||
*> SECTION structure:
|
||||
*> 1000-INIT / 2000-OPEN-FILES / 3000-READ-INPUT
|
||||
*> 3100-VALIDATE-REC / 3200-PROCESS-REC / 3300-WRITE-OUTPUT
|
||||
*> 4000-REPORT / 5000-AUDIT / 6000-ERROR-HANDLE / 9000-EXIT
|
||||
*> ============================================================
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. CsvFbLf.
|
||||
ENVIRONMENT DIVISION.
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT FILE-IN ASSIGN TO 'file-in.csv'
|
||||
ORGANIZATION IS LINE SEQUENTIAL
|
||||
FILE STATUS IS WS-FILE-IN-STATUS.
|
||||
SELECT FILE-OUT ASSIGN TO 'file-out.dat'
|
||||
ORGANIZATION IS SEQUENTIAL
|
||||
FILE STATUS IS WS-FILE-OUT-STATUS.
|
||||
SELECT ERROR-REPORT ASSIGN TO 'csv-lf-errors.dat'
|
||||
ORGANIZATION IS LINE SEQUENTIAL
|
||||
FILE STATUS IS WS-ERR-STATUS.
|
||||
SELECT AUDIT-FILE ASSIGN TO 'csv-lf-audit.dat'
|
||||
ORGANIZATION IS LINE SEQUENTIAL
|
||||
FILE STATUS IS WS-AUDIT-STATUS.
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
FD FILE-IN.
|
||||
01 IN-LINE PIC X(200).
|
||||
FD FILE-OUT.
|
||||
01 OUT-REC PIC X(100).
|
||||
FD ERROR-REPORT.
|
||||
01 ERR-REC PIC X(200).
|
||||
FD AUDIT-FILE.
|
||||
01 AUD-REC PIC X(200).
|
||||
WORKING-STORAGE SECTION.
|
||||
*> Telecom CDR record layout
|
||||
01 WS-TELECOM-REC.
|
||||
COPY "telecom/TEL-CDR.cpy".
|
||||
*> File status fields
|
||||
01 WS-FILE-IN-STATUS PIC X(02).
|
||||
01 WS-FILE-OUT-STATUS PIC X(02).
|
||||
01 WS-ERR-STATUS PIC X(02).
|
||||
01 WS-AUDIT-STATUS PIC X(02).
|
||||
*> File open indicators
|
||||
01 WS-FILE-IN-OPEN PIC X(01) VALUE 'N'.
|
||||
88 WS-FILE-IN-IS-OPEN VALUE 'Y' FALSE 'N'.
|
||||
01 WS-FILE-OUT-OPEN PIC X(01) VALUE 'N'.
|
||||
88 WS-FILE-OUT-IS-OPEN VALUE 'Y' FALSE 'N'.
|
||||
01 WS-ERR-REP-OPEN PIC X(01) VALUE 'N'.
|
||||
88 WS-ERR-REP-IS-OPEN VALUE 'Y' FALSE 'N'.
|
||||
01 WS-AUDIT-OPEN PIC X(01) VALUE 'N'.
|
||||
88 WS-AUDIT-IS-OPEN VALUE 'Y' FALSE 'N'.
|
||||
*> EOF flag (original)
|
||||
01 WS-EOF PIC X(01) VALUE 'N'.
|
||||
88 WS-EOF-YES VALUE 'Y' FALSE 'N'.
|
||||
*> Original counters and fields
|
||||
01 WS-REC-COUNT PIC 9(05) VALUE ZERO.
|
||||
01 WS-LINE-COUNT PIC 9(05) VALUE ZERO.
|
||||
01 WS-SEG-TOTAL PIC 9(05) VALUE ZERO.
|
||||
01 WS-FIELD1 PIC X(30).
|
||||
01 WS-FIELD2 PIC X(30).
|
||||
01 WS-FIELD3 PIC X(100).
|
||||
*> INSPECT and segment fields (original)
|
||||
01 WS-PIPE-COUNT PIC 9(02).
|
||||
01 WS-SEGMENTS.
|
||||
05 WS-SEGMENT OCCURS 20 TIMES PIC X(50).
|
||||
01 WS-SEG-COUNT PIC 9(02).
|
||||
01 WS-SEG-IDX PIC 9(02).
|
||||
01 WS-POS PIC 9(03).
|
||||
01 WS-END-POS PIC 9(03).
|
||||
01 WS-SEG-LEN PIC 9(03).
|
||||
*> Output assembly (original)
|
||||
01 WS-OUT-LINE PIC X(100).
|
||||
*> Timestamp fields
|
||||
01 WS-TIMESTAMP PIC X(20).
|
||||
01 WS-CUR-DATE PIC X(08).
|
||||
01 WS-CUR-TIME PIC X(08).
|
||||
01 WS-DISP-TS.
|
||||
05 WS-DISP-DATE PIC X(08).
|
||||
05 WS-DISP-DASH PIC X(01) VALUE '-'.
|
||||
05 WS-DISP-TIME PIC X(06).
|
||||
*> Error severity constants
|
||||
01 WS-SEV-I PIC X(01) VALUE 'I'.
|
||||
01 WS-SEV-W PIC X(01) VALUE 'W'.
|
||||
01 WS-SEV-E PIC X(01) VALUE 'E'.
|
||||
01 WS-SEV-C PIC X(01) VALUE 'C'.
|
||||
*> Extended counters
|
||||
01 WS-TOTAL-INPUT PIC 9(09) VALUE 0.
|
||||
01 WS-TOTAL-OUTPUT PIC 9(09) VALUE 0.
|
||||
01 WS-ERR-TOTAL PIC 9(09) VALUE 0.
|
||||
01 WS-MALFORMED-CNT PIC 9(09) VALUE 0.
|
||||
01 WS-TRUNC-CNT PIC 9(09) VALUE 0.
|
||||
01 WS-ERR-REP-WRITTEN PIC 9(09) VALUE 0.
|
||||
01 WS-FIELD-COUNT-ERR PIC 9(09) VALUE 0.
|
||||
01 WS-INFO-COUNT PIC 9(09) VALUE 0.
|
||||
01 WS-WARN-COUNT PIC 9(09) VALUE 0.
|
||||
01 WS-ERR-SEV-COUNT PIC 9(09) VALUE 0.
|
||||
01 WS-CRIT-COUNT PIC 9(09) VALUE 0.
|
||||
*> Hash total (batch control)
|
||||
01 WS-HASH-TOTAL PIC 9(15) VALUE 0.
|
||||
01 WS-HASH-FIELD-LEN PIC 9(05) VALUE 0.
|
||||
*> Validation control
|
||||
01 WS-VALID-FLAG PIC X(01) VALUE 'Y'.
|
||||
88 WS-VALID-RECORD VALUE 'Y' FALSE 'N'.
|
||||
88 WS-INVALID-RECORD VALUE 'N'.
|
||||
01 WS-COMMA-COUNT PIC 9(02).
|
||||
01 WS-FIELD-COUNT PIC 9(02).
|
||||
01 WS-EXPECTED-FIELDS PIC 9(02) VALUE 3.
|
||||
*> Quote pairing validation
|
||||
01 WS-QUOTE-OPEN-COUNT PIC 9(03).
|
||||
01 WS-QUOTE-BALANCE PIC S9(03).
|
||||
01 WS-QUOTE-STATUS PIC X(01) VALUE 'B'.
|
||||
88 WS-QUOTES-BALANCED VALUE 'B'.
|
||||
88 WS-QUOTES-UNBALANCED VALUE 'U'.
|
||||
*> Field length truncation
|
||||
01 WS-FIELD1-MAX-LEN PIC 9(03) VALUE 030.
|
||||
01 WS-FIELD2-MAX-LEN PIC 9(03) VALUE 030.
|
||||
01 WS-FIELD3-MAX-LEN PIC 9(03) VALUE 100.
|
||||
01 WS-TRUNC-FLAG1 PIC X(01) VALUE 'N'.
|
||||
88 WS-TRUNCATED-F1 VALUE 'Y' FALSE 'N'.
|
||||
01 WS-TRUNC-FLAG2 PIC X(01) VALUE 'N'.
|
||||
88 WS-TRUNCATED-F2 VALUE 'Y' FALSE 'N'.
|
||||
01 WS-TRUNC-FLAG3 PIC X(01) VALUE 'N'.
|
||||
88 WS-TRUNCATED-F3 VALUE 'Y' FALSE 'N'.
|
||||
*> Numeric check for segment 1
|
||||
01 WS-SEGMENT-BUFFER PIC X(50).
|
||||
*> Record reconciliation
|
||||
01 WS-EXPECTED-OUT PIC 9(09).
|
||||
01 WS-RECON-DIFF PIC S9(09).
|
||||
01 WS-RECON-STATUS PIC X(01).
|
||||
88 WS-RECON-MATCH VALUE 'M'.
|
||||
88 WS-RECON-MISMATCH VALUE 'X'.
|
||||
*> Error context for 6000
|
||||
01 WS-ERR-LINE-NUM PIC 9(09).
|
||||
01 WS-ERR-SEVERITY PIC X(01).
|
||||
01 WS-ERR-DESC PIC X(80).
|
||||
*> Scratch fields
|
||||
01 WS-RPT-COUNT PIC Z(9)9.
|
||||
01 WS-ALL-NUMERIC PIC X(01).
|
||||
01 WS-IDX PIC 9(02).
|
||||
01 WS-CHAR-IDX PIC 9(04).
|
||||
01 WS-COMMA-POS1 PIC 9(03).
|
||||
01 WS-COMMA-POS2 PIC 9(03).
|
||||
01 WS-SUB PIC 9(03).
|
||||
01 WS-CHAR-CHK PIC X(01).
|
||||
PROCEDURE DIVISION.
|
||||
*> ============================================================
|
||||
*> MAIN SECTION — orchestration
|
||||
*> ============================================================
|
||||
MAIN SECTION.
|
||||
MB-PROCESS.
|
||||
PERFORM 1000-INIT.
|
||||
PERFORM 2000-OPEN-FILES.
|
||||
PERFORM 3000-READ-INPUT.
|
||||
PERFORM 4000-REPORT.
|
||||
PERFORM 5000-AUDIT.
|
||||
PERFORM 9000-EXIT.
|
||||
STOP RUN.
|
||||
*> ============================================================
|
||||
*> 1000-INIT SECTION
|
||||
*> ============================================================
|
||||
1000-INIT SECTION.
|
||||
1000-START.
|
||||
PERFORM 9900-TIMESTAMP.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'CsvFbLf STARTED — CDR CSV Import with LF'.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'Input: file-in.csv Output: file-out.dat'.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'Error: csv-lf-errors.dat Audit: csv-lf-audit.dat'.
|
||||
MOVE ZERO TO WS-TOTAL-INPUT WS-TOTAL-OUTPUT WS-ERR-TOTAL
|
||||
WS-MALFORMED-CNT WS-TRUNC-CNT
|
||||
WS-ERR-REP-WRITTEN WS-INFO-COUNT WS-WARN-COUNT
|
||||
WS-ERR-SEV-COUNT WS-CRIT-COUNT
|
||||
WS-FIELD-COUNT-ERR WS-HASH-TOTAL WS-SEG-TOTAL.
|
||||
MOVE 'N' TO WS-FILE-IN-OPEN WS-FILE-OUT-OPEN
|
||||
WS-ERR-REP-OPEN WS-AUDIT-OPEN.
|
||||
1000-EXIT. EXIT.
|
||||
*> ============================================================
|
||||
*> 2000-OPEN-FILES SECTION
|
||||
*> ============================================================
|
||||
2000-OPEN-FILES SECTION.
|
||||
2000-START.
|
||||
OPEN INPUT FILE-IN.
|
||||
IF WS-FILE-IN-STATUS NOT = '00'
|
||||
DISPLAY 'CRITICAL: Cannot open FILE-IN status: '
|
||||
WS-FILE-IN-STATUS
|
||||
MOVE 1 TO RETURN-CODE STOP RUN
|
||||
END-IF.
|
||||
MOVE 'Y' TO WS-FILE-IN-OPEN.
|
||||
PERFORM 9900-TIMESTAMP.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'FILE-IN opened, status: ' WS-FILE-IN-STATUS.
|
||||
OPEN OUTPUT FILE-OUT.
|
||||
IF WS-FILE-OUT-STATUS NOT = '00'
|
||||
DISPLAY 'CRITICAL: Cannot open FILE-OUT status: '
|
||||
WS-FILE-OUT-STATUS
|
||||
MOVE 1 TO RETURN-CODE PERFORM 9000-EXIT
|
||||
END-IF.
|
||||
MOVE 'Y' TO WS-FILE-OUT-OPEN.
|
||||
PERFORM 9900-TIMESTAMP.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'FILE-OUT opened, status: ' WS-FILE-OUT-STATUS.
|
||||
OPEN OUTPUT ERROR-REPORT.
|
||||
IF WS-ERR-STATUS NOT = '00'
|
||||
DISPLAY 'CRITICAL: Cannot open ERROR-REPORT status: '
|
||||
WS-ERR-STATUS
|
||||
MOVE 1 TO RETURN-CODE PERFORM 9000-EXIT
|
||||
END-IF.
|
||||
MOVE 'Y' TO WS-ERR-REP-OPEN.
|
||||
PERFORM 9900-TIMESTAMP.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'ERROR-REPORT opened, status: ' WS-ERR-STATUS.
|
||||
*> Write error report header
|
||||
MOVE SPACES TO ERR-REC.
|
||||
STRING 'CSV LF Error Detail - CsvFbLf ' WS-CUR-DATE
|
||||
INTO ERR-REC. WRITE ERR-REC.
|
||||
MOVE 'LINE SEV DESCRIPTION' TO ERR-REC. WRITE ERR-REC.
|
||||
MOVE SPACES TO ERR-REC. WRITE ERR-REC.
|
||||
OPEN OUTPUT AUDIT-FILE.
|
||||
IF WS-AUDIT-STATUS NOT = '00'
|
||||
DISPLAY 'CRITICAL: Cannot open AUDIT-FILE status: '
|
||||
WS-AUDIT-STATUS
|
||||
MOVE 1 TO RETURN-CODE PERFORM 9000-EXIT
|
||||
END-IF.
|
||||
MOVE 'Y' TO WS-AUDIT-OPEN.
|
||||
PERFORM 9900-TIMESTAMP.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'AUDIT-FILE opened, status: ' WS-AUDIT-STATUS.
|
||||
*> Write audit header
|
||||
MOVE SPACES TO AUD-REC.
|
||||
STRING 'CSV LF Audit - CsvFbLf Run: ' WS-CUR-DATE
|
||||
INTO AUD-REC. WRITE AUD-REC.
|
||||
MOVE SPACES TO AUD-REC. WRITE AUD-REC.
|
||||
2000-EXIT. EXIT.
|
||||
*> ============================================================
|
||||
*> 3000-READ-INPUT SECTION — main read-loop
|
||||
*> ============================================================
|
||||
3000-READ-INPUT SECTION.
|
||||
3000-LOOP.
|
||||
PERFORM 9900-TIMESTAMP.
|
||||
DISPLAY '[' WS-TIMESTAMP '] ' 'Processing CSV records'.
|
||||
PERFORM UNTIL WS-EOF-YES
|
||||
READ FILE-IN
|
||||
AT END SET WS-EOF-YES TO TRUE
|
||||
NOT AT END
|
||||
ADD 1 TO WS-LINE-COUNT
|
||||
ADD 1 TO WS-TOTAL-INPUT
|
||||
MOVE 'Y' TO WS-VALID-FLAG
|
||||
MOVE 'B' TO WS-QUOTE-STATUS
|
||||
PERFORM 3100-VALIDATE-RECORD
|
||||
IF WS-INVALID-RECORD
|
||||
MOVE WS-LINE-COUNT TO WS-ERR-LINE-NUM
|
||||
MOVE WS-SEV-E TO WS-ERR-SEVERITY
|
||||
PERFORM 6000-ERROR-HANDLE
|
||||
ELSE
|
||||
PERFORM 3200-PROCESS-RECORD
|
||||
END-IF
|
||||
END-READ
|
||||
IF WS-FILE-IN-STATUS NOT = '00'
|
||||
AND WS-FILE-IN-STATUS NOT = '10'
|
||||
AND WS-EOF NOT = 'Y'
|
||||
PERFORM 9900-TIMESTAMP
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'ERROR: READ FILE-IN status: '
|
||||
WS-FILE-IN-STATUS
|
||||
MOVE WS-LINE-COUNT TO WS-ERR-LINE-NUM
|
||||
MOVE WS-SEV-E TO WS-ERR-SEVERITY
|
||||
STRING 'READ failure status=' WS-FILE-IN-STATUS
|
||||
INTO WS-ERR-DESC
|
||||
PERFORM 6000-ERROR-HANDLE
|
||||
END-IF
|
||||
END-PERFORM.
|
||||
3000-EXIT. EXIT.
|
||||
*> ============================================================
|
||||
*> 3100-VALIDATE-RECORD SECTION
|
||||
*> ============================================================
|
||||
3100-VALIDATE-RECORD SECTION.
|
||||
3100-START.
|
||||
*> Field count (commas + 1, expect 3)
|
||||
MOVE ZERO TO WS-COMMA-COUNT.
|
||||
INSPECT IN-LINE TALLYING WS-COMMA-COUNT FOR ALL ','.
|
||||
COMPUTE WS-FIELD-COUNT = WS-COMMA-COUNT + 1.
|
||||
IF WS-FIELD-COUNT NOT = WS-EXPECTED-FIELDS
|
||||
MOVE 'N' TO WS-VALID-FLAG
|
||||
ADD 1 TO WS-FIELD-COUNT-ERR WS-MALFORMED-CNT
|
||||
WS-ERR-TOTAL WS-ERR-SEV-COUNT
|
||||
MOVE WS-LINE-COUNT TO WS-ERR-LINE-NUM
|
||||
MOVE WS-SEV-E TO WS-ERR-SEVERITY
|
||||
STRING 'Field count mismatch: expect '
|
||||
WS-EXPECTED-FIELDS ' got ' WS-FIELD-COUNT
|
||||
INTO WS-ERR-DESC
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'ERROR: line ' WS-LINE-COUNT
|
||||
' field-count ' WS-FIELD-COUNT
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*> Quote pairing validation
|
||||
MOVE ZERO TO WS-QUOTE-OPEN-COUNT.
|
||||
INSPECT IN-LINE TALLYING WS-QUOTE-OPEN-COUNT FOR ALL '"'.
|
||||
DIVIDE WS-QUOTE-OPEN-COUNT BY 2
|
||||
GIVING WS-QUOTE-BALANCE
|
||||
REMAINDER WS-QUOTE-BALANCE.
|
||||
IF WS-QUOTE-BALANCE NOT = 0
|
||||
MOVE 'U' TO WS-QUOTE-STATUS
|
||||
ADD 1 TO WS-WARN-COUNT WS-ERR-TOTAL
|
||||
MOVE WS-LINE-COUNT TO WS-ERR-LINE-NUM
|
||||
MOVE WS-SEV-W TO WS-ERR-SEVERITY
|
||||
STRING 'Unbalanced quotes: count=' WS-QUOTE-OPEN-COUNT
|
||||
INTO WS-ERR-DESC
|
||||
PERFORM 6000-ERROR-HANDLE
|
||||
END-IF.
|
||||
*> Estimate raw field lengths from CSV for truncation
|
||||
MOVE ZERO TO WS-COMMA-POS1 WS-COMMA-POS2.
|
||||
MOVE 0 TO WS-SUB.
|
||||
PERFORM VARYING WS-CHAR-IDX FROM 1 BY 1
|
||||
UNTIL WS-CHAR-IDX > 200
|
||||
IF IN-LINE(WS-CHAR-IDX:1) = ','
|
||||
ADD 1 TO WS-SUB
|
||||
IF WS-SUB = 1
|
||||
MOVE WS-CHAR-IDX TO WS-COMMA-POS1
|
||||
ELSE
|
||||
IF WS-SUB = 2
|
||||
MOVE WS-CHAR-IDX TO WS-COMMA-POS2
|
||||
EXIT PERFORM
|
||||
END-IF
|
||||
END-IF
|
||||
END-IF
|
||||
END-PERFORM.
|
||||
*> Field1 truncation check
|
||||
IF WS-COMMA-POS1 > 0
|
||||
COMPUTE WS-SUB = WS-COMMA-POS1 - 1
|
||||
IF WS-SUB > WS-FIELD1-MAX-LEN
|
||||
MOVE 'Y' TO WS-TRUNC-FLAG1
|
||||
ADD 1 TO WS-TRUNC-CNT WS-WARN-COUNT WS-ERR-TOTAL
|
||||
MOVE WS-LINE-COUNT TO WS-ERR-LINE-NUM
|
||||
MOVE WS-SEV-W TO WS-ERR-SEVERITY
|
||||
STRING 'Field1 trunc: raw len ' WS-SUB
|
||||
INTO WS-ERR-DESC
|
||||
PERFORM 6000-ERROR-HANDLE
|
||||
END-IF
|
||||
END-IF.
|
||||
*> Field2 truncation check
|
||||
IF WS-COMMA-POS2 > 0 AND WS-COMMA-POS1 > 0
|
||||
COMPUTE WS-SUB = WS-COMMA-POS2 - WS-COMMA-POS1 - 1
|
||||
IF WS-SUB > WS-FIELD2-MAX-LEN
|
||||
MOVE 'Y' TO WS-TRUNC-FLAG2
|
||||
ADD 1 TO WS-TRUNC-CNT WS-WARN-COUNT WS-ERR-TOTAL
|
||||
MOVE WS-LINE-COUNT TO WS-ERR-LINE-NUM
|
||||
MOVE WS-SEV-W TO WS-ERR-SEVERITY
|
||||
STRING 'Field2 trunc: raw len ' WS-SUB
|
||||
INTO WS-ERR-DESC
|
||||
PERFORM 6000-ERROR-HANDLE
|
||||
END-IF
|
||||
END-IF.
|
||||
*> Field3 truncation check (rest of line after 2nd comma)
|
||||
IF WS-COMMA-POS2 > 0
|
||||
COMPUTE WS-SUB = 200 - WS-COMMA-POS2
|
||||
IF WS-SUB > WS-FIELD3-MAX-LEN
|
||||
MOVE 'Y' TO WS-TRUNC-FLAG3
|
||||
ADD 1 TO WS-TRUNC-CNT WS-WARN-COUNT WS-ERR-TOTAL
|
||||
MOVE WS-LINE-COUNT TO WS-ERR-LINE-NUM
|
||||
MOVE WS-SEV-W TO WS-ERR-SEVERITY
|
||||
STRING 'Field3 trunc: raw len ' WS-SUB
|
||||
INTO WS-ERR-DESC
|
||||
PERFORM 6000-ERROR-HANDLE
|
||||
END-IF
|
||||
END-IF.
|
||||
3100-EXIT. EXIT.
|
||||
*> ============================================================
|
||||
*> 3200-PROCESS-RECORD SECTION
|
||||
*> Original PROCESS-CSV-LINE logic preserved intact:
|
||||
*> UNSTRING -> pipe-count -> replace -> segment -> output
|
||||
*> ============================================================
|
||||
3200-PROCESS-RECORD SECTION.
|
||||
3200-START.
|
||||
*> Unstring CSV into 3 fields
|
||||
MOVE SPACES TO WS-FIELD1 WS-FIELD2 WS-FIELD3.
|
||||
UNSTRING IN-LINE DELIMITED BY ','
|
||||
INTO WS-FIELD1 WS-FIELD2 WS-FIELD3
|
||||
END-UNSTRING.
|
||||
*> Char-check Field1
|
||||
MOVE 'Y' TO WS-ALL-NUMERIC.
|
||||
PERFORM VARYING WS-IDX FROM 1 BY 1
|
||||
UNTIL WS-IDX > 30 OR WS-ALL-NUMERIC = 'N'
|
||||
MOVE WS-FIELD1(WS-IDX:1) TO WS-CHAR-CHK
|
||||
IF WS-CHAR-CHK NOT = SPACE AND
|
||||
WS-CHAR-CHK < 'A' AND WS-CHAR-CHK > 'Z' AND
|
||||
WS-CHAR-CHK < '0' AND WS-CHAR-CHK > '9' AND
|
||||
WS-CHAR-CHK NOT = '-'
|
||||
MOVE 'N' TO WS-ALL-NUMERIC
|
||||
END-IF
|
||||
END-PERFORM.
|
||||
IF WS-ALL-NUMERIC = 'N'
|
||||
MOVE WS-LINE-COUNT TO WS-ERR-LINE-NUM
|
||||
MOVE WS-SEV-W TO WS-ERR-SEVERITY
|
||||
STRING 'Field1 special chars: "' WS-FIELD1(1:15) '"'
|
||||
INTO WS-ERR-DESC
|
||||
ADD 1 TO WS-WARN-COUNT WS-ERR-TOTAL
|
||||
PERFORM 6000-ERROR-HANDLE
|
||||
END-IF.
|
||||
*> Post-UNSTRING truncation detection
|
||||
IF FUNCTION LENGTH(FUNCTION TRIM(WS-FIELD1)) > 30
|
||||
ADD 1 TO WS-TRUNC-CNT
|
||||
MOVE WS-LINE-COUNT TO WS-ERR-LINE-NUM
|
||||
MOVE WS-SEV-W TO WS-ERR-SEVERITY
|
||||
MOVE 'Field1 truncated by UNSTRING' TO WS-ERR-DESC
|
||||
ADD 1 TO WS-WARN-COUNT WS-ERR-TOTAL
|
||||
PERFORM 6000-ERROR-HANDLE
|
||||
END-IF.
|
||||
IF FUNCTION LENGTH(FUNCTION TRIM(WS-FIELD2)) > 30
|
||||
ADD 1 TO WS-TRUNC-CNT
|
||||
MOVE WS-LINE-COUNT TO WS-ERR-LINE-NUM
|
||||
MOVE WS-SEV-W TO WS-ERR-SEVERITY
|
||||
MOVE 'Field2 truncated by UNSTRING' TO WS-ERR-DESC
|
||||
ADD 1 TO WS-WARN-COUNT WS-ERR-TOTAL
|
||||
PERFORM 6000-ERROR-HANDLE
|
||||
END-IF.
|
||||
*> Count pipe markers in field3 using INSPECT TALLYING
|
||||
MOVE ZERO TO WS-PIPE-COUNT.
|
||||
INSPECT WS-FIELD3 TALLYING WS-PIPE-COUNT FOR ALL '|'.
|
||||
*> Replace pipes with spaces for clean segment extraction
|
||||
INSPECT WS-FIELD3 REPLACING ALL '|' BY SPACE.
|
||||
*> Split field3 at original pipe positions into segments
|
||||
MOVE ZERO TO WS-SEG-COUNT.
|
||||
MOVE SPACES TO WS-SEGMENTS.
|
||||
UNSTRING WS-FIELD3 DELIMITED BY ALL SPACES
|
||||
INTO WS-SEGMENT(1) WS-SEGMENT(2) WS-SEGMENT(3)
|
||||
WS-SEGMENT(4) WS-SEGMENT(5) WS-SEGMENT(6)
|
||||
WS-SEGMENT(7) WS-SEGMENT(8) WS-SEGMENT(9)
|
||||
WS-SEGMENT(10)
|
||||
COUNT IN WS-SEG-COUNT
|
||||
END-UNSTRING.
|
||||
*> If no pipes, write one record
|
||||
IF WS-PIPE-COUNT = 0
|
||||
MOVE 1 TO WS-SEG-COUNT
|
||||
MOVE WS-FIELD3 TO WS-SEGMENT(1)
|
||||
END-IF.
|
||||
*> Write one output record per segment
|
||||
IF WS-SEG-COUNT = 0
|
||||
MOVE 1 TO WS-SEG-COUNT
|
||||
END-IF.
|
||||
*> Validate first segment numeric
|
||||
IF WS-SEG-COUNT >= 1
|
||||
MOVE SPACES TO WS-SEGMENT-BUFFER
|
||||
MOVE WS-SEGMENT(1) TO WS-SEGMENT-BUFFER
|
||||
IF WS-SEGMENT-BUFFER NOT IS NUMERIC
|
||||
AND WS-SEGMENT-BUFFER > SPACES
|
||||
MOVE WS-LINE-COUNT TO WS-ERR-LINE-NUM
|
||||
MOVE WS-SEV-W TO WS-ERR-SEVERITY
|
||||
STRING 'Non-numeric segment 1: "'
|
||||
WS-SEGMENT(1)(1:15) '"'
|
||||
INTO WS-ERR-DESC
|
||||
ADD 1 TO WS-WARN-COUNT WS-ERR-TOTAL
|
||||
PERFORM 6000-ERROR-HANDLE
|
||||
END-IF
|
||||
END-IF.
|
||||
PERFORM VARYING WS-SEG-IDX FROM 1 BY 1
|
||||
UNTIL WS-SEG-IDX > WS-SEG-COUNT OR WS-SEG-IDX > 10
|
||||
IF WS-SEGMENT(WS-SEG-IDX) > SPACES
|
||||
PERFORM 3300-WRITE-OUTPUT
|
||||
END-IF
|
||||
END-PERFORM.
|
||||
3200-EXIT. EXIT.
|
||||
*> ============================================================
|
||||
*> 3300-WRITE-OUTPUT SECTION
|
||||
*> ============================================================
|
||||
3300-WRITE-OUTPUT SECTION.
|
||||
3300-START.
|
||||
MOVE SPACES TO WS-OUT-LINE.
|
||||
STRING WS-FIELD1 DELIMITED BY SPACES
|
||||
'|' WS-FIELD2 DELIMITED BY SPACES
|
||||
'|' WS-SEGMENT(WS-SEG-IDX) DELIMITED BY SPACES
|
||||
INTO WS-OUT-LINE
|
||||
END-STRING.
|
||||
MOVE WS-OUT-LINE TO OUT-REC.
|
||||
WRITE OUT-REC.
|
||||
IF WS-FILE-OUT-STATUS NOT = '00'
|
||||
PERFORM 9900-TIMESTAMP
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'ERROR: WRITE FILE-OUT status: '
|
||||
WS-FILE-OUT-STATUS
|
||||
MOVE WS-LINE-COUNT TO WS-ERR-LINE-NUM
|
||||
MOVE WS-SEV-E TO WS-ERR-SEVERITY
|
||||
STRING 'WRITE FAIL status=' WS-FILE-OUT-STATUS
|
||||
INTO WS-ERR-DESC
|
||||
ADD 1 TO WS-ERR-SEV-COUNT WS-ERR-TOTAL
|
||||
PERFORM 6000-ERROR-HANDLE
|
||||
END-IF.
|
||||
ADD 1 TO WS-REC-COUNT WS-TOTAL-OUTPUT WS-SEG-TOTAL.
|
||||
COMPUTE WS-HASH-FIELD-LEN =
|
||||
FUNCTION LENGTH(FUNCTION TRIM(WS-SEGMENT(WS-SEG-IDX))).
|
||||
ADD WS-HASH-FIELD-LEN TO WS-HASH-TOTAL.
|
||||
3300-EXIT. EXIT.
|
||||
*> ============================================================
|
||||
*> 4000-REPORT SECTION — batch totals & reconciliation
|
||||
*> ============================================================
|
||||
4000-REPORT SECTION.
|
||||
4000-START.
|
||||
PERFORM 9900-TIMESTAMP.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'============================================'.
|
||||
DISPLAY '[' WS-TIMESTAMP '] ' 'CsvFbLf BATCH REPORT'.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'============================================'.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'Input lines : ' WS-TOTAL-INPUT.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'Output records : ' WS-TOTAL-OUTPUT.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'Segments expanded : ' WS-SEG-TOTAL.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'Error rep entries : ' WS-ERR-REP-WRITTEN.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'--------------------------------------------'.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'Error total : ' WS-ERR-TOTAL.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
' I=' WS-INFO-COUNT
|
||||
' W=' WS-WARN-COUNT
|
||||
' E=' WS-ERR-SEV-COUNT
|
||||
' C=' WS-CRIT-COUNT.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'--------------------------------------------'.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'Malformed : ' WS-MALFORMED-CNT.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'Truncations: ' WS-TRUNC-CNT.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'Field errs : ' WS-FIELD-COUNT-ERR.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'Hash total : ' WS-HASH-TOTAL.
|
||||
*> Final file status check
|
||||
IF WS-FILE-IN-STATUS NOT = '00' AND NOT = '10'
|
||||
DISPLAY ' FILE-IN final status: ' WS-FILE-IN-STATUS.
|
||||
IF WS-FILE-OUT-STATUS NOT = '00' AND NOT = '10'
|
||||
DISPLAY ' FILE-OUT final status: ' WS-FILE-OUT-STATUS.
|
||||
IF WS-ERR-STATUS NOT = '00' AND NOT = '10'
|
||||
DISPLAY ' ERROR-REPORT final status: ' WS-ERR-STATUS.
|
||||
IF WS-AUDIT-STATUS NOT = '00' AND NOT = '10'
|
||||
DISPLAY ' AUDIT-FILE final status: ' WS-AUDIT-STATUS.
|
||||
*> Record count reconciliation
|
||||
DISPLAY '--------------------------------------------'.
|
||||
DISPLAY 'RECONCILIATION'.
|
||||
IF WS-TOTAL-INPUT >= WS-MALFORMED-CNT
|
||||
COMPUTE WS-EXPECTED-OUT =
|
||||
WS-TOTAL-INPUT - WS-MALFORMED-CNT
|
||||
ELSE MOVE ZERO TO WS-EXPECTED-OUT.
|
||||
IF WS-TOTAL-OUTPUT = WS-EXPECTED-OUT
|
||||
MOVE 'M' TO WS-RECON-STATUS
|
||||
DISPLAY 'MATCH: input=' WS-TOTAL-INPUT
|
||||
' output=' WS-TOTAL-OUTPUT
|
||||
ELSE
|
||||
COMPUTE WS-RECON-DIFF =
|
||||
WS-TOTAL-OUTPUT - WS-EXPECTED-OUT
|
||||
MOVE 'X' TO WS-RECON-STATUS
|
||||
DISPLAY 'MISMATCH: input=' WS-TOTAL-INPUT
|
||||
' output=' WS-TOTAL-OUTPUT
|
||||
' diff=' WS-RECON-DIFF
|
||||
END-IF.
|
||||
DISPLAY '============================================'.
|
||||
4000-EXIT. EXIT.
|
||||
*> ============================================================
|
||||
*> 5000-AUDIT SECTION
|
||||
*> ============================================================
|
||||
5000-AUDIT SECTION.
|
||||
5000-START.
|
||||
PERFORM 9900-TIMESTAMP.
|
||||
MOVE SPACES TO AUD-REC.
|
||||
STRING '=== CSV LF Import Summary === '
|
||||
WS-CUR-DATE ' ' WS-CUR-TIME
|
||||
INTO AUD-REC.
|
||||
WRITE AUD-REC.
|
||||
IF WS-AUDIT-STATUS NOT = '00'
|
||||
DISPLAY 'AUDIT header WRITE status: ' WS-AUDIT-STATUS.
|
||||
MOVE SPACES TO AUD-REC. WRITE AUD-REC.
|
||||
MOVE WS-TOTAL-INPUT TO WS-RPT-COUNT.
|
||||
STRING 'Input lines read: ' WS-RPT-COUNT
|
||||
INTO AUD-REC. WRITE AUD-REC.
|
||||
MOVE WS-TOTAL-OUTPUT TO WS-RPT-COUNT.
|
||||
STRING 'Output records written: ' WS-RPT-COUNT
|
||||
INTO AUD-REC. WRITE AUD-REC.
|
||||
MOVE WS-SEG-TOTAL TO WS-RPT-COUNT.
|
||||
STRING 'Segments expanded: ' WS-RPT-COUNT
|
||||
INTO AUD-REC. WRITE AUD-REC.
|
||||
*> Error summary
|
||||
MOVE SPACES TO AUD-REC. WRITE AUD-REC.
|
||||
STRING 'Error summary —' INTO AUD-REC. WRITE AUD-REC.
|
||||
MOVE WS-ERR-TOTAL TO WS-RPT-COUNT.
|
||||
STRING ' Total: ' WS-RPT-COUNT
|
||||
INTO AUD-REC. WRITE AUD-REC.
|
||||
MOVE WS-INFO-COUNT TO WS-RPT-COUNT.
|
||||
STRING ' INFO (I): ' WS-RPT-COUNT
|
||||
INTO AUD-REC. WRITE AUD-REC.
|
||||
MOVE WS-WARN-COUNT TO WS-RPT-COUNT.
|
||||
STRING ' WARN (W): ' WS-RPT-COUNT
|
||||
INTO AUD-REC. WRITE AUD-REC.
|
||||
MOVE WS-ERR-SEV-COUNT TO WS-RPT-COUNT.
|
||||
STRING ' ERROR (E): ' WS-RPT-COUNT
|
||||
INTO AUD-REC. WRITE AUD-REC.
|
||||
MOVE WS-CRIT-COUNT TO WS-RPT-COUNT.
|
||||
STRING ' CRIT (C): ' WS-RPT-COUNT
|
||||
INTO AUD-REC. WRITE AUD-REC.
|
||||
*> Breakdown
|
||||
MOVE SPACES TO AUD-REC. WRITE AUD-REC.
|
||||
STRING 'Malformed records: ' WS-MALFORMED-CNT
|
||||
INTO AUD-REC. WRITE AUD-REC.
|
||||
STRING 'Truncation warnings: ' WS-TRUNC-CNT
|
||||
INTO AUD-REC. WRITE AUD-REC.
|
||||
STRING 'Field count errors: ' WS-FIELD-COUNT-ERR
|
||||
INTO AUD-REC. WRITE AUD-REC.
|
||||
*> Reconciliation
|
||||
MOVE SPACES TO AUD-REC. WRITE AUD-REC.
|
||||
STRING 'Reconciliation: ' WS-RECON-STATUS
|
||||
INTO AUD-REC. WRITE AUD-REC.
|
||||
MOVE WS-EXPECTED-OUT TO WS-RPT-COUNT.
|
||||
STRING ' Expected output: ' WS-RPT-COUNT
|
||||
INTO AUD-REC. WRITE AUD-REC.
|
||||
MOVE WS-TOTAL-OUTPUT TO WS-RPT-COUNT.
|
||||
STRING ' Actual output: ' WS-RPT-COUNT
|
||||
INTO AUD-REC. WRITE AUD-REC.
|
||||
IF WS-RECON-MISMATCH
|
||||
MOVE WS-RECON-DIFF TO WS-RPT-COUNT
|
||||
STRING ' Difference: ' WS-RPT-COUNT
|
||||
INTO AUD-REC. WRITE AUD-REC.
|
||||
*> Batch control totals
|
||||
MOVE SPACES TO AUD-REC. WRITE AUD-REC.
|
||||
STRING '=== Batch Control Totals ==='
|
||||
INTO AUD-REC. WRITE AUD-REC.
|
||||
STRING 'Batch date: ' WS-CUR-DATE
|
||||
INTO AUD-REC. WRITE AUD-REC.
|
||||
STRING 'Batch time: ' WS-CUR-TIME
|
||||
INTO AUD-REC. WRITE AUD-REC.
|
||||
MOVE WS-HASH-TOTAL TO WS-RPT-COUNT.
|
||||
STRING 'Hash total (seg lens): ' WS-RPT-COUNT
|
||||
INTO AUD-REC. WRITE AUD-REC.
|
||||
MOVE SPACES TO AUD-REC. WRITE AUD-REC.
|
||||
STRING '=== End of Audit Report ==='
|
||||
INTO AUD-REC. WRITE AUD-REC.
|
||||
5000-EXIT. EXIT.
|
||||
*> ============================================================
|
||||
*> 6000-ERROR-HANDLE SECTION
|
||||
*> ============================================================
|
||||
6000-ERROR-HANDLE SECTION.
|
||||
6000-START.
|
||||
MOVE SPACES TO ERR-REC.
|
||||
STRING WS-ERR-LINE-NUM ' '
|
||||
WS-ERR-SEVERITY ' '
|
||||
WS-ERR-DESC
|
||||
INTO ERR-REC.
|
||||
WRITE ERR-REC.
|
||||
IF WS-ERR-STATUS NOT = '00'
|
||||
DISPLAY 'ERROR: WRITE ERROR-REPORT status: '
|
||||
WS-ERR-STATUS.
|
||||
ADD 1 TO WS-ERR-REP-WRITTEN.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'ERR: line=' WS-ERR-LINE-NUM
|
||||
' sev=' WS-ERR-SEVERITY
|
||||
' ' WS-ERR-DESC.
|
||||
6000-EXIT. EXIT.
|
||||
*> ============================================================
|
||||
*> 9000-EXIT SECTION
|
||||
*> ============================================================
|
||||
9000-EXIT SECTION.
|
||||
9000-START.
|
||||
PERFORM 9900-TIMESTAMP.
|
||||
*> Close ERROR-REPORT
|
||||
IF WS-ERR-REP-IS-OPEN
|
||||
MOVE SPACES TO ERR-REC WRITE ERR-REC
|
||||
MOVE '--- End of Error Report ---' TO ERR-REC
|
||||
WRITE ERR-REC
|
||||
CLOSE ERROR-REPORT
|
||||
IF WS-ERR-STATUS NOT = '00'
|
||||
DISPLAY 'ERROR: CLOSE ERROR-REPORT status: '
|
||||
WS-ERR-STATUS
|
||||
ELSE
|
||||
DISPLAY 'ERROR-REPORT closed' END-IF.
|
||||
*> Close FILE-OUT
|
||||
IF WS-FILE-OUT-IS-OPEN
|
||||
CLOSE FILE-OUT
|
||||
IF WS-FILE-OUT-STATUS NOT = '00'
|
||||
DISPLAY 'ERROR: CLOSE FILE-OUT status: '
|
||||
WS-FILE-OUT-STATUS
|
||||
ELSE DISPLAY 'FILE-OUT closed' END-IF.
|
||||
*> Close AUDIT-FILE
|
||||
IF WS-AUDIT-IS-OPEN
|
||||
CLOSE AUDIT-FILE
|
||||
IF WS-AUDIT-STATUS NOT = '00'
|
||||
DISPLAY 'ERROR: CLOSE AUDIT-FILE status: '
|
||||
WS-AUDIT-STATUS
|
||||
ELSE DISPLAY 'AUDIT-FILE closed' END-IF.
|
||||
*> Close FILE-IN
|
||||
IF WS-FILE-IN-IS-OPEN
|
||||
CLOSE FILE-IN
|
||||
IF WS-FILE-IN-STATUS NOT = '00'
|
||||
DISPLAY 'ERROR: CLOSE FILE-IN status: '
|
||||
WS-FILE-IN-STATUS
|
||||
ELSE DISPLAY 'FILE-IN closed' END-IF.
|
||||
*> Final summary
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
'CsvFbLf COMPLETED.'
|
||||
' Input=' WS-LINE-COUNT
|
||||
' Output=' WS-REC-COUNT
|
||||
' Errors=' WS-ERR-TOTAL.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
' Malformed=' WS-MALFORMED-CNT
|
||||
' Truncated=' WS-TRUNC-CNT
|
||||
' FieldErr=' WS-FIELD-COUNT-ERR.
|
||||
DISPLAY '[' WS-TIMESTAMP '] '
|
||||
' Hash=' WS-HASH-TOTAL
|
||||
' ErrRep=csv-lf-errors.dat'
|
||||
' Audit=csv-lf-audit.dat'.
|
||||
STOP RUN.
|
||||
9000-EXIT-POINT. EXIT.
|
||||
*> ============================================================
|
||||
*> 9900-TIMESTAMP SECTION
|
||||
*> ============================================================
|
||||
9900-TIMESTAMP SECTION.
|
||||
9900-START.
|
||||
MOVE FUNCTION CURRENT-DATE (1:8) TO WS-CUR-DATE.
|
||||
MOVE FUNCTION CURRENT-DATE (9:6) TO WS-CUR-TIME.
|
||||
MOVE WS-CUR-DATE TO WS-DISP-DATE.
|
||||
MOVE WS-CUR-TIME TO WS-DISP-TIME.
|
||||
MOVE WS-DISP-TS TO WS-TIMESTAMP.
|
||||
9900-EXIT. EXIT.
|
||||
END PROGRAM CsvFbLf.
|
||||
Reference in New Issue
Block a user