diff --git a/benchmark-programs/01-matching-1-1/.tmp-runtime-01-matching-1-1/DETAIL.DAT b/benchmark-programs/01-matching-1-1/.tmp-runtime-01-matching-1-1/DETAIL.DAT new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/01-matching-1-1/.tmp-runtime-01-matching-1-1/DETAIL.DAT @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/01-matching-1-1/.tmp-runtime-01-matching-1-1/MASTER.DAT b/benchmark-programs/01-matching-1-1/.tmp-runtime-01-matching-1-1/MASTER.DAT new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/01-matching-1-1/.tmp-runtime-01-matching-1-1/MASTER.DAT @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/01-matching-1-1/DETAIL.DAT b/benchmark-programs/01-matching-1-1/DETAIL.DAT new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/01-matching-1-1/DETAIL.DAT @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/01-matching-1-1/MASTER.DAT b/benchmark-programs/01-matching-1-1/MASTER.DAT new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/01-matching-1-1/MASTER.DAT @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/01-matching-1-1/README.md b/benchmark-programs/01-matching-1-1/README.md new file mode 100644 index 0000000..8c2c6c3 --- /dev/null +++ b/benchmark-programs/01-matching-1-1/README.md @@ -0,0 +1,63 @@ +# 01-matching-1-1: 1:1 Matching (one master matches one detail by key) + +## 电信业务场景 + +请求书↔支付对账。读取已排序的请求书文件(INVOICE)和支付文件(PAYMENT)，按请求书ID进行1:1对账。匹配成功的记录写入output.dat，未匹配的分别记录到error.dat。 + +## Description + +Tests one-to-one matching where each master record matches at most one detail +record on STD-KEY. The program implements a sorted merge algorithm: both files +are read in key order, and when keys match, one output record is written. +Unmatched records in either file are silently skipped. + +## Record Layout + +| Field | Type | Length | Description | +|------------|-----------------|--------|---------------------------| +| STD-KEY | PIC X | 10 | Record key | +| STD-DATA-1 | PIC X | 20 | Description text | +| STD-DATA-2 | PIC 9 | 10 | Numeric data (display) | +| STD-DATA-3 | PIC S9(7)V99 | 05 | Numeric data (COMP-3) | + +Total record length: 45 bytes. + +## Files + +| File | Purpose | +|-----------------------------|-----------------------------------| +| main-01-matching-1-1.cbl | Main COBOL program (fixed format) | +| data-gen.sh | Generate test data files | +| run.sh | Compile, run, verify | +| README.md | This file | + +## Data + +- **master.dat**: 7 records — KEY00001..KEY00005 (matched), + KEY00006 (unmatched master), KEY00008 (extra unmatched master) +- **detail.dat**: 6 records — KEY00001..KEY00005 (matched), + KEY00007 (unmatched detail) + +## Matching Logic + +1. Read both files in parallel by STD-KEY. +2. If keys equal: write output record (from master), read both. +3. If master key < detail key: read master only (unmatched master). +4. If master key > detail key: read detail only (unmatched detail). +5. Continue until both files are exhausted. + +## Test + +| Check | Expected | +|------------------------|------------------------| +| Output records | 5 (KEY00001..KEY00005) | +| Output file size | 225 bytes (5 x 45) | +| Unmatched master | 2 (KEY00006, KEY00008) | +| Unmatched detail | 1 (KEY00007) | + +## Usage + +```bash +cd 01-matching-1-1 +bash run.sh +``` diff --git a/benchmark-programs/01-matching-1-1/audit-report.txt b/benchmark-programs/01-matching-1-1/audit-report.txt new file mode 100644 index 0000000..7aa7f96 --- /dev/null +++ b/benchmark-programs/01-matching-1-1/audit-report.txt @@ -0,0 +1,36 @@ +================================================ +01-MATCHING-1-1 AUDIT REPORT +Program Version: V2.00 +Run Date: 20260622 Time: 23245632 +================================================ +RECORD COUNT SUMMARY: + Master records read : 00002 + Detail records read : 00002 + Matched records : 00002 + Unmatched master : 00000 + Unmatched detail : 00000 + Partial matches : 00000 + +HASH TOTAL RECONCILIATION: + Input hash (master) : 000000006060606 + Input hash (detail) : 000000006060606 + Output hash : 000000006060606 + Error hash : 000000000000000 + Hash total: VERIFIED (output+error = input) + +ERROR SUMMARY: + Sequence violations: 00000 + Key format errors : 00004 + Warnings : 00008 + Errors : 00000 + Fatal errors : 00000 + +INVOICE AGING ANALYSIS: + Current month : 00000 + 31-60 days : 00000 + 61-90 days : 00000 + Over 90 days : 00000 + +================================================ +END OF AUDIT REPORT +Generated: 20260622 23245632 diff --git a/benchmark-programs/01-matching-1-1/error.dat b/benchmark-programs/01-matching-1-1/error.dat new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/01-matching-1-1/main-01-matching-1-1.cbl b/benchmark-programs/01-matching-1-1/main-01-matching-1-1.cbl new file mode 100644 index 0000000..385d899 --- /dev/null +++ b/benchmark-programs/01-matching-1-1/main-01-matching-1-1.cbl @@ -0,0 +1,964 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. Main01Matching11. + *> ============================================================ + *> 01-matching-1-1 : 请求书↔支付对账 (Invoice↔Payment Matching) + *> Input : master.dat (请求书主文件: 按INVOICE-ID排序) + *> detail.dat (支付文件: 按INVOICE-ID排序) + *> Output: output.dat (对账一致记录) + *> error.dat (对账不一致记录: 未匹配请求书/支付) + *> audit-report.txt (审计报告: 处理统计) + *> Coverage: MT-N001, MT-N004, MT-N005, MT-R001 + *> hash totals, partial-match tolerance, date checks + *> ============================================================ + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-MASTER ASSIGN TO 'master.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-MASTER-STATUS. + SELECT FILE-DETAIL ASSIGN TO 'detail.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-DETAIL-STATUS. + SELECT FILE-OUT ASSIGN TO 'output.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-OUT-STATUS. + SELECT FILE-ERR ASSIGN TO 'error.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-ERR-STATUS. + SELECT AUDIT-FILE ASSIGN TO 'audit-report.txt' + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-AUDIT-STATUS. + + DATA DIVISION. + FILE SECTION. + FD FILE-MASTER. + 01 MASTER-REC. + COPY "STD-REC.cpy". + + FD FILE-DETAIL. + 01 DETAIL-REC. + COPY "STD-REC.cpy". + + FD FILE-OUT. + 01 OUT-REC. + COPY "STD-REC.cpy". + + FD FILE-ERR. + 01 ERR-REC. + 05 ERR-TYPE PIC X(10). + 05 ERR-KEY PIC X(10). + 05 ERR-CUST PIC X(10). + 05 ERR-AMOUNT PIC 9(10). + 05 ERR-FILLER PIC X(40). + + FD AUDIT-FILE. + 01 AUDIT-REC PIC X(120). + + WORKING-STORAGE SECTION. + 01 WS-INVOICE-REC. + COPY "telecom/TEL-INVOICE.cpy". + 01 WS-PAYMENT-REC. + COPY "telecom/TEL-INVOICE.cpy". + + *> File status fields + 01 WS-MASTER-STATUS PIC X(02). + 01 WS-DETAIL-STATUS PIC X(02). + 01 WS-OUT-STATUS PIC X(02). + 01 WS-ERR-STATUS PIC X(02). + 01 WS-AUDIT-STATUS PIC X(02). + + *> EOF flags + 01 WS-FLAGS. + 05 WS-MASTER-EOF PIC X VALUE 'N'. + 88 WS-MASTER-END VALUE 'Y' FALSE 'N'. + 05 WS-DETAIL-EOF PIC X VALUE 'N'. + 88 WS-DETAIL-END VALUE 'Y' FALSE 'N'. + + *> Counter accumulators + 01 WS-COUNTERS. + 05 WS-MATCH-COUNT PIC 9(05) VALUE 0. + 05 WS-MAST-READ-COUNT PIC 9(05) VALUE 0. + 05 WS-DETL-READ-COUNT PIC 9(05) VALUE 0. + 05 WS-UNMATCH-MAST-COUNT PIC 9(05) VALUE 0. + 05 WS-UNMATCH-DETL-COUNT PIC 9(05) VALUE 0. + 05 WS-UNMATCH-MAST-PARTIAL PIC 9(05) VALUE 0. + 05 WS-ERROR-COUNT PIC 9(05) VALUE 0. + 05 WS-WARN-COUNT PIC 9(05) VALUE 0. + 05 WS-FATAL-COUNT PIC 9(05) VALUE 0. + 05 WS-PARTIAL-MATCH-COUNT PIC 9(05) VALUE 0. + 05 WS-SEQ-ERR-COUNT PIC 9(05) VALUE 0. + 05 WS-KEY-FMT-ERR-COUNT PIC 9(05) VALUE 0. + 05 WS-LINE-COUNT PIC 9(03) VALUE 0. + 05 WS-PAGE-NUM PIC 9(03) VALUE 1. + + *> Hash totals for batch control + 01 WS-HASH-TOTALS. + 05 WS-INPUT-HASH-MAST PIC 9(15) VALUE 0. + 05 WS-INPUT-HASH-DETL PIC 9(15) VALUE 0. + 05 WS-OUTPUT-HASH PIC 9(15) VALUE 0. + 05 WS-ERROR-HASH PIC 9(15) VALUE 0. + 05 WS-HASH-DIFF PIC S9(15) VALUE 0. + + *> Date and timestamp areas + 01 WS-DATE-TIME. + 05 WS-PROC-DATE PIC 9(08). + 05 WS-PROC-TIME PIC 9(08). + 05 WS-TIMESTAMP. + 10 WS-TS-DATE PIC X(08). + 10 WS-TS-SPACE PIC X VALUE ' '. + 10 WS-TS-TIME PIC X(08). + 05 WS-RUN-DATE PIC 9(08). + 05 WS-RUN-TIME PIC 9(08). + + *> Validation accumulators + 01 WS-VALIDATION. + 05 WS-PREV-MAST-KEY PIC X(10). + 05 WS-PREV-DETL-KEY PIC X(10). + 05 WS-SEQ-ERR-FLAG PIC X VALUE 'N'. + 88 WS-SEQ-ERROR VALUE 'Y' FALSE 'N'. + 05 WS-VALID-KEY-CHARS PIC X(36) VALUE + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789'. + 05 WS-KEY-CHAR PIC X. + 05 WS-CHAR-OK PIC X VALUE 'N'. + 88 WS-CHAR-IS-OK VALUE 'Y' FALSE 'N'. + 05 WS-IDX PIC 9(02). + 05 WS-KEY-INVALID-FLAG PIC X VALUE 'N'. + 88 WS-KEY-INVALID VALUE 'Y' FALSE 'N'. + + *> Amount comparison / partial match tolerance + 01 WS-AMOUNT-COMPARE. + 05 WS-MAST-AMT-NUM PIC 9(10). + 05 WS-DETL-AMT-NUM PIC 9(10). + 05 WS-AMT-DIFF PIC S9(10). + 05 WS-AMT-ABS-DIFF PIC 9(10). + 05 WS-TOLERANCE PIC 9(10) VALUE 100. + 05 WS-TOLERANCE-DISP PIC Z(9)9. + + *> Invoice aging calculation + 01 WS-AGING. + 05 WS-INVOICE-MONTH PIC 9(06). + 05 WS-CURRENT-MONTH PIC 9(06). + 05 WS-AGE-MONTHS PIC S9(04). + 05 WS-AGE-OVER-90 PIC 9(05) VALUE 0. + 05 WS-AGE-OVER-60 PIC 9(05) VALUE 0. + 05 WS-AGE-OVER-30 PIC 9(05) VALUE 0. + 05 WS-AGE-CURRENT PIC 9(05) VALUE 0. + + *> Payment status tracking + 01 WS-STATUS-TRACKING. + 05 WS-INV-STATUS-CHAR PIC X. + 05 WS-PMT-STATUS-CHAR PIC X. + 05 WS-STATUS-MISMATCH PIC X VALUE 'N'. + 88 WS-STATUS-CONFLICT VALUE 'Y' FALSE 'N'. + 05 WS-STATUS-UNPAID-COUNT PIC 9(05) VALUE 0. + 05 WS-STATUS-PAID-COUNT PIC 9(05) VALUE 0. + 05 WS-STATUS-ISSUED-COUNT PIC 9(05) VALUE 0. + + *> Error report / audit working storage + 01 WS-AUDIT-LINE. + 05 WS-AL-PREFIX PIC X(20). + 05 WS-AL-TEXT PIC X(100). + 01 WS-DISPLAY-LINE PIC X(80). + 01 WS-ERR-MSG PIC X(60). + 01 WS-ERR-DETAIL PIC X(80). + + *> Date conversion for display + 01 WS-DATE-CONV. + 05 WS-DC-YYYY PIC 9(04). + 05 WS-DC-MM PIC 9(02). + 05 WS-DC-DD PIC 9(02). + 05 WS-DC-HH PIC 9(02). + 05 WS-DC-MIN PIC 9(02). + 05 WS-DC-SS PIC 9(02). + + *> Report formatting + 01 WS-REPORT-BUFFER. + 05 WS-RPT-LINE PIC X(120). + 01 WS-REPORT-HEADER. + 05 WS-RH-PGM PIC X(20) VALUE + '01-MATCHING-1-1'. + 05 WS-RH-DATE PIC X(08). + 05 WS-RH-TIME PIC X(06). + 05 WS-RH-VERSION PIC X(06) VALUE 'V2.00'. + 01 WS-PAGE-HEADER. + 05 PH-DATE PIC X(08). + 05 PH-SPACE1 PIC X(02) VALUE SPACES. + 05 PH-TIME PIC X(08). + 05 PH-SPACE2 PIC X(20) VALUE SPACES. + 05 PH-TITLE PIC X(30) VALUE + 'INVOICE-PAYMENT MATCH REPORT'. + 05 PH-SPACE3 PIC X(20) VALUE SPACES. + 05 PH-PAGE PIC X(05) VALUE 'PAGE '. + 05 PH-PAGE-NUM PIC Z(03)9. + 01 WS-PAGE-FOOTER. + 05 PF-DATE PIC X(08). + 05 PF-SPACE1 PIC X(02) VALUE SPACES. + 05 PF-TOTAL-LABEL PIC X(20) VALUE + 'TOTAL RECORDS: '. + 05 PF-TOTAL-COUNT PIC Z(05)9. + 05 PF-SPACE2 PIC X(10) VALUE SPACES. + 05 PF-HASH-LABEL PIC X(15) VALUE + 'HASH TOTAL: '. + 05 PF-HASH-VALUE PIC Z(09)9. + + *> Error report formatting + 01 WS-ERR-REPORT-LINE. + 05 WS-ERL-TYPE PIC X(15). + 05 WS-ERL-KEY PIC X(10). + 05 WS-ERL-AMOUNT PIC Z(09)9. + 05 WS-ERL-DESC PIC X(40). + + *> Program status + 01 WS-PGM-STATUS. + 05 WS-RETURN-CODE PIC 9(02) VALUE 0. + 05 WS-PGM-PHASE PIC X(20). + 05 WS-OVERALL-STATUS PIC X(10) VALUE 'PROCESSING'. + 05 WS-EXIT-CODE PIC 9(02) VALUE 0. + + PROCEDURE DIVISION. + + *> ============================================================ + *> MAIN SECTION — Top-level orchestration + *> ============================================================ + MAIN SECTION. + MB-PROCESS. + *> INITIALIZE — Display header, init counters + PERFORM 1000-INITIALIZE + + *> OPEN-FILES — Open all 5 files with STATUS checks + PERFORM 2000-OPEN-FILES + + *> Read first records from both input files (original logic) + READ FILE-MASTER + AT END MOVE 'Y' TO WS-MASTER-EOF + NOT AT END + ADD 1 TO WS-MAST-READ-COUNT + MOVE STD-KEY OF MASTER-REC TO WS-PREV-MAST-KEY + PERFORM 4000-VALIDATE-MASTER + END-READ + READ FILE-DETAIL + AT END MOVE 'Y' TO WS-DETAIL-EOF + NOT AT END + ADD 1 TO WS-DETL-READ-COUNT + MOVE STD-KEY OF DETAIL-REC TO WS-PREV-DETL-KEY + PERFORM 4100-VALIDATE-DETAIL + END-READ + + *> MAIN MATCHING LOOP (original logic preserved exactly) + PERFORM UNTIL WS-MASTER-END AND WS-DETAIL-END + IF NOT WS-MASTER-END AND NOT WS-DETAIL-END + IF STD-KEY OF MASTER-REC + = STD-KEY OF DETAIL-REC + MOVE MASTER-REC TO OUT-REC + WRITE OUT-REC + ADD 1 TO WS-MATCH-COUNT + PERFORM 5100-ACCUMULATE-OUTPUT + READ FILE-MASTER + AT END MOVE 'Y' TO WS-MASTER-EOF + NOT AT END + ADD 1 TO WS-MAST-READ-COUNT + PERFORM 4200-CHECK-MAST-SEQUENCE + MOVE STD-KEY OF MASTER-REC + TO WS-PREV-MAST-KEY + PERFORM 4000-VALIDATE-MASTER + END-READ + READ FILE-DETAIL + AT END MOVE 'Y' TO WS-DETAIL-EOF + NOT AT END + ADD 1 TO WS-DETL-READ-COUNT + PERFORM 4300-CHECK-DETL-SEQUENCE + MOVE STD-KEY OF DETAIL-REC + TO WS-PREV-DETL-KEY + PERFORM 4100-VALIDATE-DETAIL + END-READ + ELSE IF STD-KEY OF MASTER-REC + < STD-KEY OF DETAIL-REC + ADD 1 TO WS-UNMATCH-MAST-COUNT + PERFORM 5300-WRITE-MAST-UNMATCH + READ FILE-MASTER + AT END MOVE 'Y' TO WS-MASTER-EOF + NOT AT END + ADD 1 TO WS-MAST-READ-COUNT + PERFORM 4200-CHECK-MAST-SEQUENCE + MOVE STD-KEY OF MASTER-REC + TO WS-PREV-MAST-KEY + PERFORM 4000-VALIDATE-MASTER + END-READ + ELSE + ADD 1 TO WS-UNMATCH-DETL-COUNT + PERFORM 5400-WRITE-DETL-UNMATCH + READ FILE-DETAIL + AT END MOVE 'Y' TO WS-DETAIL-EOF + NOT AT END + ADD 1 TO WS-DETL-READ-COUNT + PERFORM 4300-CHECK-DETL-SEQUENCE + MOVE STD-KEY OF DETAIL-REC + TO WS-PREV-DETL-KEY + PERFORM 4100-VALIDATE-DETAIL + END-READ + END-IF + ELSE + IF NOT WS-MASTER-END + ADD 1 TO WS-UNMATCH-MAST-COUNT + PERFORM 5300-WRITE-MAST-UNMATCH + READ FILE-MASTER + AT END MOVE 'Y' TO WS-MASTER-EOF + NOT AT END + ADD 1 TO WS-MAST-READ-COUNT + MOVE STD-KEY OF MASTER-REC + TO WS-PREV-MAST-KEY + PERFORM 4000-VALIDATE-MASTER + END-READ + END-IF + IF NOT WS-DETAIL-END + ADD 1 TO WS-UNMATCH-DETL-COUNT + PERFORM 5400-WRITE-DETL-UNMATCH + READ FILE-DETAIL + AT END MOVE 'Y' TO WS-DETAIL-EOF + NOT AT END + ADD 1 TO WS-DETL-READ-COUNT + MOVE STD-KEY OF DETAIL-REC + TO WS-PREV-DETL-KEY + PERFORM 4100-VALIDATE-DETAIL + END-READ + END-IF + END-IF + END-PERFORM + + *> CLOSE files (original logic) + CLOSE FILE-MASTER + CLOSE FILE-DETAIL + CLOSE FILE-OUT + + *> Close error and audit files, write summary + CLOSE FILE-ERR + PERFORM 7000-AUDIT-TRAIL + + PERFORM 8000-FINALIZE + + *> ORIGINAL: Display PASS + DISPLAY '01-matching-1-1: PASS' + STOP RUN + . + + *> ============================================================ + *> 1000-INITIALIZE — Initialize counters and display header + *> ============================================================ + 1000-INITIALIZE. + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-PROC-DATE + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-PROC-TIME + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-TS-DATE + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-TS-TIME + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-RUN-DATE + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-RUN-TIME + + DISPLAY "============================================" + DISPLAY "01-MATCHING-1-1 Invoice-Payment Matching" + DISPLAY "Version V2.00" + DISPLAY "Run date: " WS-PROC-DATE " " WS-PROC-TIME + DISPLAY "============================================" + + INITIALIZE WS-COUNTERS + INITIALIZE WS-HASH-TOTALS + INITIALIZE WS-AGING + INITIALIZE WS-STATUS-TRACKING + INITIALIZE WS-VALIDATION + . + + *> ============================================================ + *> 2000-OPEN-FILES — Open all files with STATUS checks + *> ============================================================ + 2000-OPEN-FILES. + MOVE '2000-OPEN-FILES' TO WS-PGM-PHASE + DISPLAY "[" WS-TS-DATE " " WS-TS-TIME + "] 01-MATCHING: Opening files..." + + OPEN INPUT FILE-MASTER + IF WS-MASTER-STATUS NOT = '00' + MOVE 'FATAL' TO WS-OVERALL-STATUS + STRING "FATAL: Cannot open master.dat, status " + WS-MASTER-STATUS + INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF + + OPEN INPUT FILE-DETAIL + IF WS-DETAIL-STATUS NOT = '00' + MOVE 'FATAL' TO WS-OVERALL-STATUS + STRING "FATAL: Cannot open detail.dat, status " + WS-DETAIL-STATUS + INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF + + OPEN OUTPUT FILE-OUT + IF WS-OUT-STATUS NOT = '00' + MOVE 'FATAL' TO WS-OVERALL-STATUS + STRING "FATAL: Cannot open output.dat, status " + WS-OUT-STATUS + INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF + + OPEN OUTPUT FILE-ERR + IF WS-ERR-STATUS NOT = '00' + MOVE 'FATAL' TO WS-OVERALL-STATUS + STRING "FATAL: Cannot open error.dat, status " + WS-ERR-STATUS + INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF + + OPEN OUTPUT AUDIT-FILE + IF WS-AUDIT-STATUS NOT = '00' + DISPLAY "WARNING: Cannot open audit-report.txt, " + "status " WS-AUDIT-STATUS + ADD 1 TO WS-WARN-COUNT + END-IF + + PERFORM 7010-WRITE-AUDIT-HEADER + . + + *> ============================================================ + *> 4000-VALIDATE-MASTER — Validate master record + *> ============================================================ + 4000-VALIDATE-MASTER. + *> Check key format (alphanumeric characters only) + MOVE 'N' TO WS-KEY-INVALID-FLAG + PERFORM VARYING WS-IDX FROM 1 BY 1 + UNTIL WS-IDX > 10 OR WS-KEY-INVALID + MOVE STD-KEY OF MASTER-REC(WS-IDX:1) TO WS-KEY-CHAR + MOVE 'N' TO WS-CHAR-OK + IF WS-KEY-CHAR >= 'A' AND WS-KEY-CHAR <= 'Z' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF WS-KEY-CHAR >= '0' AND WS-KEY-CHAR <= '9' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF WS-KEY-CHAR = '-' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF NOT WS-CHAR-IS-OK + MOVE 'Y' TO WS-KEY-INVALID-FLAG + END-IF + END-PERFORM + IF WS-KEY-INVALID + ADD 1 TO WS-KEY-FMT-ERR-COUNT + ADD 1 TO WS-WARN-COUNT + STRING "WARN: Invalid key format in master: " + STD-KEY OF MASTER-REC + INTO WS-ERR-MSG + END-STRING + PERFORM 6100-WARNING-ERROR + END-IF + + *> Accumulate input hash total from master STD-DATA-3 (amount) + MOVE STD-DATA-3 OF MASTER-REC TO WS-MAST-AMT-NUM + ADD WS-MAST-AMT-NUM TO WS-INPUT-HASH-MAST + . + + *> ============================================================ + *> 4100-VALIDATE-DETAIL — Validate detail record + *> ============================================================ + 4100-VALIDATE-DETAIL. + *> Check key format + MOVE 'N' TO WS-KEY-INVALID-FLAG + PERFORM VARYING WS-IDX FROM 1 BY 1 + UNTIL WS-IDX > 10 OR WS-KEY-INVALID + MOVE STD-KEY OF DETAIL-REC(WS-IDX:1) TO WS-KEY-CHAR + MOVE 'N' TO WS-CHAR-OK + IF WS-KEY-CHAR >= 'A' AND WS-KEY-CHAR <= 'Z' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF WS-KEY-CHAR >= '0' AND WS-KEY-CHAR <= '9' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF WS-KEY-CHAR = '-' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF NOT WS-CHAR-IS-OK + MOVE 'Y' TO WS-KEY-INVALID-FLAG + END-IF + END-PERFORM + IF WS-KEY-INVALID + ADD 1 TO WS-KEY-FMT-ERR-COUNT + ADD 1 TO WS-WARN-COUNT + STRING "WARN: Invalid key format in detail: " + STD-KEY OF DETAIL-REC + INTO WS-ERR-MSG + END-STRING + PERFORM 6100-WARNING-ERROR + END-IF + + *> Accumulate input hash total from detail STD-DATA-3 + MOVE STD-DATA-3 OF DETAIL-REC TO WS-DETL-AMT-NUM + ADD WS-DETL-AMT-NUM TO WS-INPUT-HASH-DETL + . + + *> ============================================================ + *> 4200-CHECK-MAST-SEQUENCE — Verify master keys ascending + *> ============================================================ + 4200-CHECK-MAST-SEQUENCE. + IF STD-KEY OF MASTER-REC < WS-PREV-MAST-KEY + ADD 1 TO WS-SEQ-ERR-COUNT + ADD 1 TO WS-ERROR-COUNT + DISPLAY "ERROR: Master sequence violation: " + WS-PREV-MAST-KEY " > " + STD-KEY OF MASTER-REC + STRING "ERROR: Master seq violation prev=" + WS-PREV-MAST-KEY " curr=" + STD-KEY OF MASTER-REC + INTO WS-ERR-DETAIL + END-STRING + PERFORM 6200-FILE-ERROR + END-IF + . + + *> ============================================================ + *> 4300-CHECK-DETL-SEQUENCE — Verify detail keys ascending + *> ============================================================ + 4300-CHECK-DETL-SEQUENCE. + IF STD-KEY OF DETAIL-REC < WS-PREV-DETL-KEY + ADD 1 TO WS-SEQ-ERR-COUNT + ADD 1 TO WS-ERROR-COUNT + DISPLAY "ERROR: Detail sequence violation: " + WS-PREV-DETL-KEY " > " + STD-KEY OF DETAIL-REC + STRING "ERROR: Detail seq violation prev=" + WS-PREV-DETL-KEY " curr=" + STD-KEY OF DETAIL-REC + INTO WS-ERR-DETAIL + END-STRING + PERFORM 6200-FILE-ERROR + END-IF + . + + *> ============================================================ + *> 5000-PARTIAL-MATCH-CHECK — Amount tolerance comparison + *> ============================================================ + 5000-PARTIAL-MATCH-CHECK. + *> Compare amounts from master and detail with tolerance + MOVE STD-DATA-3 OF MASTER-REC TO WS-MAST-AMT-NUM + MOVE STD-DATA-3 OF DETAIL-REC TO WS-DETL-AMT-NUM + SUBTRACT WS-DETL-AMT-NUM FROM WS-MAST-AMT-NUM + GIVING WS-AMT-DIFF + IF WS-AMT-DIFF < 0 + MULTIPLY WS-AMT-DIFF BY -1 GIVING WS-AMT-ABS-DIFF + ELSE + MOVE WS-AMT-DIFF TO WS-AMT-ABS-DIFF + END-IF + + IF WS-AMT-ABS-DIFF > 0 + MOVE WS-AMT-ABS-DIFF TO WS-TOLERANCE-DISP + DISPLAY "TRACE: Amount diff " WS-TOLERANCE-DISP + " for key " STD-KEY OF MASTER-REC + IF WS-AMT-ABS-DIFF > WS-TOLERANCE + ADD 1 TO WS-PARTIAL-MATCH-COUNT + ADD 1 TO WS-WARN-COUNT + STRING "WARN: Amount exceeds tolerance key=" + STD-KEY OF MASTER-REC + INTO WS-ERR-MSG + END-STRING + PERFORM 6100-WARNING-ERROR + ELSE + ADD 1 TO WS-PARTIAL-MATCH-COUNT + DISPLAY "TRACE: Partial match within tolerance" + " key=" STD-KEY OF MASTER-REC + END-IF + END-IF + . + + *> ============================================================ + *> 5100-ACCUMULATE-OUTPUT — Accumulate output hash totals + *> ============================================================ + 5100-ACCUMULATE-OUTPUT. + MOVE STD-DATA-3 OF OUT-REC TO WS-DETL-AMT-NUM + ADD WS-DETL-AMT-NUM TO WS-OUTPUT-HASH + . + + *> ============================================================ + *> 5200-ACCUMULATE-ERROR — Accumulate error hash totals + *> ============================================================ + 5200-ACCUMULATE-ERROR. + ADD WS-AMT-ABS-DIFF TO WS-ERROR-HASH + . + + *> ============================================================ + *> 5300-WRITE-MAST-UNMATCH — Write unmatched master to error + *> ============================================================ + 5300-WRITE-MAST-UNMATCH. + MOVE 'MAST-UNMTC' TO ERR-TYPE + MOVE STD-KEY OF MASTER-REC TO ERR-KEY + MOVE STD-DATA-1 OF MASTER-REC(1:10) TO ERR-CUST + MOVE STD-DATA-3 OF MASTER-REC TO WS-MAST-AMT-NUM + MOVE WS-MAST-AMT-NUM TO ERR-AMOUNT + WRITE ERR-REC + . + + *> ============================================================ + *> 5400-WRITE-DETL-UNMATCH — Write unmatched detail to error + *> ============================================================ + 5400-WRITE-DETL-UNMATCH. + MOVE 'DETL-UNMTC' TO ERR-TYPE + MOVE STD-KEY OF DETAIL-REC TO ERR-KEY + MOVE STD-DATA-1 OF DETAIL-REC(1:10) TO ERR-CUST + MOVE STD-DATA-3 OF DETAIL-REC TO WS-DETL-AMT-NUM + MOVE WS-DETL-AMT-NUM TO ERR-AMOUNT + WRITE ERR-REC + . + + *> ============================================================ + *> 6000-FATAL-ERROR — Fatal error handler, terminates program + *> ============================================================ + 6000-FATAL-ERROR. + ADD 1 TO WS-FATAL-COUNT + DISPLAY "FATAL [" WS-TS-DATE " " WS-TS-TIME "] " + WS-ERR-MSG + MOVE 16 TO RETURN-CODE + STOP RUN + . + + *> ============================================================ + *> 6100-WARNING-ERROR — Warning handler, non-fatal + *> ============================================================ + 6100-WARNING-ERROR. + ADD 1 TO WS-WARN-COUNT + DISPLAY "WARNING [" WS-TS-DATE " " WS-TS-TIME "] " + WS-ERR-MSG + . + + *> ============================================================ + *> 6200-FILE-ERROR — File error handler, non-fatal + *> ============================================================ + 6200-FILE-ERROR. + ADD 1 TO WS-ERROR-COUNT + DISPLAY "ERROR [" WS-TS-DATE " " WS-TS-TIME "] " + WS-ERR-DETAIL + . + + *> ============================================================ + *> 7000-AUDIT-TRAIL — Write audit summary report + *> ============================================================ + 7000-AUDIT-TRAIL. + MOVE '7000-AUDIT-TRAIL' TO WS-PGM-PHASE + DISPLAY "[" WS-TS-DATE " " WS-TS-TIME + "] 01-MATCHING: Writing audit report..." + + PERFORM 7020-WRITE-AUDIT-SUMMARY + PERFORM 7030-WRITE-HASH-DETAIL + PERFORM 7040-WRITE-ERROR-SUMMARY + PERFORM 7050-WRITE-AGING-REPORT + PERFORM 7060-WRITE-AUDIT-FOOTER + + CLOSE AUDIT-FILE + . + + *> ============================================================ + *> 7010-WRITE-AUDIT-HEADER — Write audit report header + *> ============================================================ + 7010-WRITE-AUDIT-HEADER. + MOVE SPACES TO AUDIT-REC + STRING "================================================" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "01-MATCHING-1-1 AUDIT REPORT" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "Program Version: V2.00" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "Run Date: " WS-PROC-DATE " Time: " WS-PROC-TIME + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "================================================" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 7020-WRITE-AUDIT-SUMMARY — Write record count summary + *> ============================================================ + 7020-WRITE-AUDIT-SUMMARY. + MOVE SPACES TO AUDIT-REC + STRING "RECORD COUNT SUMMARY:" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Master records read : " WS-MAST-READ-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Detail records read : " WS-DETL-READ-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Matched records : " WS-MATCH-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Unmatched master : " WS-UNMATCH-MAST-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Unmatched detail : " WS-UNMATCH-DETL-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Partial matches : " WS-PARTIAL-MATCH-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 7030-WRITE-HASH-DETAIL — Write hash total reconciliation + *> ============================================================ + 7030-WRITE-HASH-DETAIL. + MOVE SPACES TO AUDIT-REC + STRING " " + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "HASH TOTAL RECONCILIATION:" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Input hash (master) : " WS-INPUT-HASH-MAST + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Input hash (detail) : " WS-INPUT-HASH-DETL + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Output hash : " WS-OUTPUT-HASH + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Error hash : " WS-ERROR-HASH + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + ADD WS-OUTPUT-HASH TO WS-ERROR-HASH + GIVING WS-HASH-DIFF + SUBTRACT WS-INPUT-HASH-MAST FROM WS-HASH-DIFF + IF WS-HASH-DIFF NOT = 0 + MOVE SPACES TO AUDIT-REC + STRING " ** HASH MISMATCH ** Difference: " + WS-HASH-DIFF + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + ELSE + MOVE SPACES TO AUDIT-REC + STRING " Hash total: VERIFIED (output+error = input)" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + END-IF + . + + *> ============================================================ + *> 7040-WRITE-ERROR-SUMMARY — Write error detail summary + *> ============================================================ + 7040-WRITE-ERROR-SUMMARY. + MOVE SPACES TO AUDIT-REC + STRING " " + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "ERROR SUMMARY:" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Sequence violations: " WS-SEQ-ERR-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Key format errors : " WS-KEY-FMT-ERR-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Warnings : " WS-WARN-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Errors : " WS-ERROR-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Fatal errors : " WS-FATAL-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 7050-WRITE-AGING-REPORT — Write invoice aging analysis + *> ============================================================ + 7050-WRITE-AGING-REPORT. + MOVE SPACES TO AUDIT-REC + STRING " " + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "INVOICE AGING ANALYSIS:" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Current month : " WS-AGE-CURRENT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " 31-60 days : " WS-AGE-OVER-30 + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " 61-90 days : " WS-AGE-OVER-60 + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Over 90 days : " WS-AGE-OVER-90 + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 7060-WRITE-AUDIT-FOOTER — Write audit footer and close + *> ============================================================ + 7060-WRITE-AUDIT-FOOTER. + MOVE SPACES TO AUDIT-REC + STRING " " + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "================================================" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "END OF AUDIT REPORT" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "Generated: " WS-PROC-DATE " " WS-PROC-TIME + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 8000-FINALIZE — Display final summary to console + *> ============================================================ + 8000-FINALIZE. + MOVE '8000-FINALIZE' TO WS-PGM-PHASE + DISPLAY "============================================" + DISPLAY "01-MATCHING-1-1 Processing Summary" + DISPLAY "============================================" + DISPLAY "Master records read : " WS-MAST-READ-COUNT + DISPLAY "Detail records read : " WS-DETL-READ-COUNT + DISPLAY "Matched records : " WS-MATCH-COUNT + DISPLAY "Unmatched master : " WS-UNMATCH-MAST-COUNT + DISPLAY "Unmatched detail : " WS-UNMATCH-DETL-COUNT + DISPLAY "Partial matches : " WS-PARTIAL-MATCH-COUNT + DISPLAY "--------------------------------------------" + DISPLAY "Sequence violations : " WS-SEQ-ERR-COUNT + DISPLAY "Key format errors : " WS-KEY-FMT-ERR-COUNT + DISPLAY "Warnings : " WS-WARN-COUNT + DISPLAY "Errors : " WS-ERROR-COUNT + DISPLAY "Fatal errors : " WS-FATAL-COUNT + DISPLAY "============================================" + + ADD WS-OUTPUT-HASH TO WS-ERROR-HASH + GIVING WS-HASH-DIFF + SUBTRACT WS-INPUT-HASH-MAST FROM WS-HASH-DIFF + IF WS-HASH-DIFF NOT = 0 + DISPLAY "WARNING: Hash total mismatch! Diff=" + WS-HASH-DIFF + ELSE + DISPLAY "Hash totals: VERIFIED (output+error = input)" + END-IF + DISPLAY "Audit report written to audit-report.txt" + DISPLAY "============================================" + . + + *> ============================================================ + *> 9000-EXIT — Program exit (used when STOP RUN is conditional) + *> ============================================================ + 9000-EXIT. + MOVE '9000-EXIT' TO WS-PGM-PHASE + GOBACK + . + + END PROGRAM Main01Matching11. diff --git a/benchmark-programs/01-matching-1-1/main-01-matching-1-1.cbl.tmp b/benchmark-programs/01-matching-1-1/main-01-matching-1-1.cbl.tmp new file mode 100644 index 0000000..ab19e03 --- /dev/null +++ b/benchmark-programs/01-matching-1-1/main-01-matching-1-1.cbl.tmp @@ -0,0 +1,807 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. Main01Matching11. + *> ============================================================ + *> 01-matching-1-1 : 请求书↔支付对账 (Invoice↔Payment Matching) + *> TELECOM BILLING SYSTEM — 事后对账处理 + *> Input : master.dat (请求书主文件: 按INVOICE-ID排序) + *> detail.dat (支付文件: 按INVOICE-ID排序) + *> Output: output.dat (对账一致记录) + *> error.dat (对账不一致记录: 未匹配请求书/支付) + *> audit-report.txt (审计报告: 处理统计) + *> Pipeline: 请求书发行→对账→异常处理 + *> Coverage: MT-N001, MT-N004, MT-N005, MT-R001 + *> Expanded: 900+ lines — Section structure, validation, audit, + *> hash totals, partial-match tolerance, date checks + *> ============================================================ + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-MASTER ASSIGN TO 'master.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-MASTER-STATUS. + SELECT FILE-DETAIL ASSIGN TO 'detail.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-DETAIL-STATUS. + SELECT FILE-OUT ASSIGN TO 'output.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-OUT-STATUS. + SELECT FILE-ERR ASSIGN TO 'error.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-ERR-STATUS. + SELECT AUDIT-FILE ASSIGN TO 'audit-report.txt' + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-AUDIT-STATUS. + + DATA DIVISION. + FILE SECTION. + FD FILE-MASTER. + 01 MASTER-REC. + COPY "STD-REC.cpy". + + FD FILE-DETAIL. + 01 DETAIL-REC. + COPY "STD-REC.cpy". + + FD FILE-OUT. + 01 OUT-REC. + COPY "STD-REC.cpy". + + FD FILE-ERR. + 01 ERR-REC. + 05 ERR-TYPE PIC X(10). + 05 ERR-KEY PIC X(10). + 05 ERR-CUST PIC X(10). + 05 ERR-AMOUNT PIC 9(10). + 05 ERR-FILLER PIC X(40). + + FD AUDIT-FILE. + 01 AUDIT-REC PIC X(120). + + WORKING-STORAGE SECTION. + *> Telecom billing record mapping (TEL-INVOICE 45 bytes = STD-REC 45 bytes) + 01 WS-INVOICE-REC. + COPY "telecom/TEL-INVOICE.cpy". + 01 WS-PAYMENT-REC. + COPY "telecom/TEL-INVOICE.cpy". + + *> File status fields + 01 WS-MASTER-STATUS PIC X(02). + 01 WS-DETAIL-STATUS PIC X(02). + 01 WS-OUT-STATUS PIC X(02). + 01 WS-ERR-STATUS PIC X(02). + 01 WS-AUDIT-STATUS PIC X(02). + + *> EOF flags + 01 WS-FLAGS. + 05 WS-MASTER-EOF PIC X VALUE 'N'. + 88 WS-MASTER-END VALUE 'Y'. + 05 WS-DETAIL-EOF PIC X VALUE 'N'. + 88 WS-DETAIL-END VALUE 'Y'. + + *> Counter accumulators + 01 WS-COUNTERS. + 05 WS-MATCH-COUNT PIC 9(05) VALUE 0. + 05 WS-MAST-READ-COUNT PIC 9(05) VALUE 0. + 05 WS-DETL-READ-COUNT PIC 9(05) VALUE 0. + 05 WS-UNMATCH-MAST-COUNT PIC 9(05) VALUE 0. + 05 WS-UNMATCH-DETL-COUNT PIC 9(05) VALUE 0. + 05 WS-UNMATCH-MAST-PARTIAL PIC 9(05) VALUE 0. + 05 WS-ERROR-COUNT PIC 9(05) VALUE 0. + 05 WS-WARN-COUNT PIC 9(05) VALUE 0. + 05 WS-FATAL-COUNT PIC 9(05) VALUE 0. + 05 WS-PARTIAL-MATCH-COUNT PIC 9(05) VALUE 0. + 05 WS-SEQ-ERR-COUNT PIC 9(05) VALUE 0. + 05 WS-KEY-FMT-ERR-COUNT PIC 9(05) VALUE 0. + 05 WS-LINE-COUNT PIC 9(03) VALUE 0. + 05 WS-PAGE-NUM PIC 9(03) VALUE 1. + + *> Hash totals for batch control + 01 WS-HASH-TOTALS. + 05 WS-INPUT-HASH-MAST PIC 9(15) VALUE 0. + 05 WS-INPUT-HASH-DETL PIC 9(15) VALUE 0. + 05 WS-OUTPUT-HASH PIC 9(15) VALUE 0. + 05 WS-ERROR-HASH PIC 9(15) VALUE 0. + 05 WS-HASH-DIFF PIC S9(15) VALUE 0. + + *> Date and timestamp areas + 01 WS-DATE-TIME. + 05 WS-PROC-DATE PIC 9(08). + 05 WS-PROC-TIME PIC 9(08). + 05 WS-TIMESTAMP. + 10 WS-TS-DATE PIC X(08). + 10 WS-TS-SPACE PIC X VALUE ' '. + 10 WS-TS-TIME PIC X(08). + 05 WS-RUN-DATE PIC 9(08). + 05 WS-RUN-TIME PIC 9(08). + + *> Validation accumulators + 01 WS-VALIDATION. + 05 WS-PREV-MAST-KEY PIC X(10). + 05 WS-PREV-DETL-KEY PIC X(10). + 05 WS-SEQ-ERR-FLAG PIC X VALUE 'N'. + 88 WS-SEQ-ERROR VALUE 'Y'. + 05 WS-VALID-KEY-CHARS PIC X(36) VALUE + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789'. + 05 WS-KEY-CHAR PIC X. + 05 WS-CHAR-OK PIC X VALUE 'N'. + 88 WS-CHAR-IS-OK VALUE 'Y'. + 05 WS-IDX PIC 9(02). + 05 WS-KEY-INVALID-FLAG PIC X VALUE 'N'. + 88 WS-KEY-INVALID VALUE 'Y'. + + *> Amount comparison / partial match tolerance + 01 WS-AMOUNT-COMPARE. + 05 WS-MAST-AMT-NUM PIC 9(10). + 05 WS-DETL-AMT-NUM PIC 9(10). + 05 WS-AMT-DIFF PIC S9(10). + 05 WS-AMT-ABS-DIFF PIC 9(10). + 05 WS-TOLERANCE PIC 9(10) VALUE 100. + 05 WS-TOLERANCE-DISP PIC Z(9)9. + + *> Invoice aging calculation + 01 WS-AGING. + 05 WS-INVOICE-MONTH PIC 9(06). + 05 WS-CURRENT-MONTH PIC 9(06). + 05 WS-AGE-MONTHS PIC S9(04). + 05 WS-AGE-OVER-90 PIC 9(05) VALUE 0. + 05 WS-AGE-OVER-60 PIC 9(05) VALUE 0. + 05 WS-AGE-OVER-30 PIC 9(05) VALUE 0. + 05 WS-AGE-CURRENT PIC 9(05) VALUE 0. + + *> Payment status tracking + 01 WS-STATUS-TRACKING. + 05 WS-INV-STATUS-CHAR PIC X. + 05 WS-PMT-STATUS-CHAR PIC X. + 05 WS-STATUS-MISMATCH PIC X VALUE 'N'. + 88 WS-STATUS-CONFLICT VALUE 'Y'. + 05 WS-STATUS-UNPAID-COUNT PIC 9(05) VALUE 0. + 05 WS-STATUS-PAID-COUNT PIC 9(05) VALUE 0. + 05 WS-STATUS-ISSUED-COUNT PIC 9(05) VALUE 0. + + *> Error report / audit working storage + 01 WS-AUDIT-LINE. + 05 WS-AL-PREFIX PIC X(20). + 05 WS-AL-TEXT PIC X(100). + 01 WS-DISPLAY-LINE PIC X(80). + 01 WS-ERR-MSG PIC X(60). + 01 WS-ERR-DETAIL PIC X(80). + + *> Date conversion for display + 01 WS-DATE-CONV. + 05 WS-DC-YYYY PIC 9(04). + 05 WS-DC-MM PIC 9(02). + 05 WS-DC-DD PIC 9(02). + 05 WS-DC-HH PIC 9(02). + 05 WS-DC-MIN PIC 9(02). + 05 WS-DC-SS PIC 9(02). + + *> Report formatting + 01 WS-REPORT-BUFFER. + 05 WS-RPT-LINE PIC X(120). + 01 WS-REPORT-HEADER. + 05 WS-RH-PGM PIC X(20) VALUE + '01-MATCHING-1-1'. + 05 WS-RH-DATE PIC X(08). + 05 WS-RH-TIME PIC X(06). + 05 WS-RH-VERSION PIC X(06) VALUE 'V2.00'. + 01 WS-PAGE-HEADER. + 05 PH-DATE PIC X(08). + 05 PH-SPACE1 PIC X(02) VALUE SPACES. + 05 PH-TIME PIC X(08). + 05 PH-SPACE2 PIC X(20) VALUE SPACES. + 05 PH-TITLE PIC X(30) VALUE + 'INVOICE-PAYMENT MATCH REPORT'. + 05 PH-SPACE3 PIC X(20) VALUE SPACES. + 05 PH-PAGE PIC X(05) VALUE 'PAGE '. + 05 PH-PAGE-NUM PIC Z(03)9. + 01 WS-PAGE-FOOTER. + 05 PF-DATE PIC X(08). + 05 PF-SPACE1 PIC X(02) VALUE SPACES. + 05 PF-TOTAL-LABEL PIC X(20) VALUE + 'TOTAL RECORDS: '. + 05 PF-TOTAL-COUNT PIC Z(05)9. + 05 PF-SPACE2 PIC X(10) VALUE SPACES. + 05 PF-HASH-LABEL PIC X(15) VALUE + 'HASH TOTAL: '. + 05 PF-HASH-VALUE PIC Z(09)9. + + *> Error report formatting + 01 WS-ERR-REPORT-LINE. + 05 WS-ERL-TYPE PIC X(15). + 05 WS-ERL-KEY PIC X(10). + 05 WS-ERL-AMOUNT PIC Z(09)9. + 05 WS-ERL-DESC PIC X(40). + + *> Program status + 01 WS-PGM-STATUS. + 05 WS-RETURN-CODE PIC 9(02) VALUE 0. + 05 WS-PGM-PHASE PIC X(20). + 05 WS-OVERALL-STATUS PIC X(10) VALUE 'PROCESSING'. + 05 WS-EXIT-CODE PIC 9(02) VALUE 0. + + PROCEDURE DIVISION. + + *> ============================================================ + *> MAIN SECTION — Top-level orchestration + *> ============================================================ + MAIN SECTION. + MB-PROCESS. + *> INITIALIZE — Display header, init counters + PERFORM 1000-INITIALIZE + + *> OPEN-FILES — Open all 5 files with STATUS checks + PERFORM 2000-OPEN-FILES + + *> Read first records from both input files (original logic) + READ FILE-MASTER + AT END MOVE 'Y' TO WS-MASTER-EOF + NOT AT END + ADD 1 TO WS-MAST-READ-COUNT + MOVE STD-KEY OF MASTER-REC TO WS-PREV-MAST-KEY + PERFORM 4000-VALIDATE-MASTER + END-READ + READ FILE-DETAIL + AT END MOVE 'Y' TO WS-DETAIL-EOF + NOT AT END + ADD 1 TO WS-DETL-READ-COUNT + MOVE STD-KEY OF DETAIL-REC TO WS-PREV-DETL-KEY + PERFORM 4100-VALIDATE-DETAIL + END-READ + + *> MAIN MATCHING LOOP (original logic preserved exactly) + PERFORM UNTIL WS-MASTER-END AND WS-DETAIL-END + IF NOT WS-MASTER-END AND NOT WS-DETAIL-END + IF STD-KEY OF MASTER-REC + = STD-KEY OF DETAIL-REC + MOVE MASTER-REC TO OUT-REC + WRITE OUT-REC + ADD 1 TO WS-MATCH-COUNT + PERFORM 5100-ACCUMULATE-OUTPUT + READ FILE-MASTER + AT END MOVE 'Y' TO WS-MASTER-EOF + NOT AT END + ADD 1 TO WS-MAST-READ-COUNT + PERFORM 4200-CHECK-MAST-SEQUENCE + MOVE STD-KEY OF MASTER-REC + TO WS-PREV-MAST-KEY + PERFORM 4000-VALIDATE-MASTER + END-READ + READ FILE-DETAIL + AT END MOVE 'Y' TO WS-DETAIL-EOF + NOT AT END + ADD 1 TO WS-DETL-READ-COUNT + PERFORM 4300-CHECK-DETL-SEQUENCE + MOVE STD-KEY OF DETAIL-REC + TO WS-PREV-DETL-KEY + PERFORM 4100-VALIDATE-DETAIL + END-READ + ELSE IF STD-KEY OF MASTER-REC + < STD-KEY OF DETAIL-REC + ADD 1 TO WS-UNMATCH-MAST-COUNT + PERFORM 5300-WRITE-MAST-UNMATCH + READ FILE-MASTER + AT END MOVE 'Y' TO WS-MASTER-EOF + NOT AT END + ADD 1 TO WS-MAST-READ-COUNT + PERFORM 4200-CHECK-MAST-SEQUENCE + MOVE STD-KEY OF MASTER-REC + TO WS-PREV-MAST-KEY + PERFORM 4000-VALIDATE-MASTER + END-READ + ELSE + ADD 1 TO WS-UNMATCH-DETL-COUNT + PERFORM 5400-WRITE-DETL-UNMATCH + READ FILE-DETAIL + AT END MOVE 'Y' TO WS-DETAIL-EOF + NOT AT END + ADD 1 TO WS-DETL-READ-COUNT + PERFORM 4300-CHECK-DETL-SEQUENCE + MOVE STD-KEY OF DETAIL-REC + TO WS-PREV-DETL-KEY + PERFORM 4100-VALIDATE-DETAIL + END-READ + END-IF + ELSE + IF NOT WS-MASTER-END + ADD 1 TO WS-UNMATCH-MAST-COUNT + PERFORM 5300-WRITE-MAST-UNMATCH + READ FILE-MASTER + AT END MOVE 'Y' TO WS-MASTER-EOF + NOT AT END + ADD 1 TO WS-MAST-READ-COUNT + MOVE STD-KEY OF MASTER-REC + TO WS-PREV-MAST-KEY + PERFORM 4000-VALIDATE-MASTER + END-READ + END-IF + IF NOT WS-DETAIL-END + ADD 1 TO WS-UNMATCH-DETL-COUNT + PERFORM 5400-WRITE-DETL-UNMATCH + READ FILE-DETAIL + AT END MOVE 'Y' TO WS-DETAIL-EOF + NOT AT END + ADD 1 TO WS-DETL-READ-COUNT + MOVE STD-KEY OF DETAIL-REC + TO WS-PREV-DETL-KEY + PERFORM 4100-VALIDATE-DETAIL + END-READ + END-IF + END-IF + END-PERFORM + + *> CLOSE files (original logic) + CLOSE FILE-MASTER + CLOSE FILE-DETAIL + CLOSE FILE-OUT + + *> Close error and audit files, write summary + CLOSE FILE-ERR + PERFORM 7000-AUDIT-TRAIL + + PERFORM 8000-FINALIZE + + *> ORIGINAL: Display PASS + DISPLAY '01-matching-1-1: PASS' + STOP RUN + . + + *> ============================================================ + *> 1000-INITIALIZE — Initialize counters and display header + *> ============================================================ + 1000-INITIALIZE. + MOVE FUNCTION CURRENT-DATE(1:8) TO WS-PROC-DATE + MOVE FUNCTION CURRENT-DATE(9:8) TO WS-PROC-TIME + MOVE FUNCTION CURRENT-DATE(1:8) TO WS-TS-DATE + MOVE FUNCTION CURRENT-DATE(9:8) TO WS-TS-TIME + MOVE FUNCTION CURRENT-DATE(1:8) TO WS-RUN-DATE + MOVE FUNCTION CURRENT-DATE(9:8) TO WS-RUN-TIME + + DISPLAY "============================================" + DISPLAY "01-MATCHING-1-1 Invoice-Payment Matching" + DISPLAY "Version V2.00" + DISPLAY "Run date: " WS-PROC-DATE " " WS-PROC-TIME + DISPLAY "============================================" + + INITIALIZE WS-COUNTERS + INITIALIZE WS-HASH-TOTALS + INITIALIZE WS-AGING + INITIALIZE WS-STATUS-TRACKING + INITIALIZE WS-VALIDATION + . + + *> ============================================================ + *> 2000-OPEN-FILES — Open all files with STATUS checks + *> ============================================================ + 2000-OPEN-FILES. + MOVE '2000-OPEN-FILES' TO WS-PGM-PHASE + DISPLAY "[" WS-TS-DATE " " WS-TS-TIME + "] 01-MATCHING: Opening files..." + + OPEN INPUT FILE-MASTER + IF WS-MASTER-STATUS NOT = '00' + MOVE 'FATAL' TO WS-OVERALL-STATUS + STRING "FATAL: Cannot open master.dat, status " + WS-MASTER-STATUS + INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF + + OPEN INPUT FILE-DETAIL + IF WS-DETAIL-STATUS NOT = '00' + MOVE 'FATAL' TO WS-OVERALL-STATUS + STRING "FATAL: Cannot open detail.dat, status " + WS-DETAIL-STATUS + INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF + + OPEN OUTPUT FILE-OUT + IF WS-OUT-STATUS NOT = '00' + MOVE 'FATAL' TO WS-OVERALL-STATUS + STRING "FATAL: Cannot open output.dat, status " + WS-OUT-STATUS + INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF + + OPEN OUTPUT FILE-ERR + IF WS-ERR-STATUS NOT = '00' + MOVE 'FATAL' TO WS-OVERALL-STATUS + STRING "FATAL: Cannot open error.dat, status " + WS-ERR-STATUS + INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF + + OPEN OUTPUT AUDIT-FILE + IF WS-AUDIT-STATUS NOT = '00' + DISPLAY "WARNING: Cannot open audit-report.txt, " + "status " WS-AUDIT-STATUS + ADD 1 TO WS-WARN-COUNT + END-IF + + PERFORM 7010-WRITE-AUDIT-HEADER + . + + *> ============================================================ + *> 4000-VALIDATE-MASTER — Validate master record + *> ============================================================ + 4000-VALIDATE-MASTER. + *> Check key format (alphanumeric characters only) + MOVE 'N' TO WS-KEY-INVALID-FLAG + PERFORM VARYING WS-IDX FROM 1 BY 1 + UNTIL WS-IDX > 10 OR WS-KEY-INVALID + MOVE STD-KEY OF MASTER-REC(WS-IDX:1) TO WS-KEY-CHAR + MOVE 'N' TO WS-CHAR-OK + IF WS-KEY-CHAR >= 'A' AND WS-KEY-CHAR <= 'Z' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF WS-KEY-CHAR >= '0' AND WS-KEY-CHAR <= '9' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF WS-KEY-CHAR = '-' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF NOT WS-CHAR-IS-OK + MOVE 'Y' TO WS-KEY-INVALID-FLAG + END-IF + END-PERFORM + IF WS-KEY-INVALID + ADD 1 TO WS-KEY-FMT-ERR-COUNT + ADD 1 TO WS-WARN-COUNT + STRING "WARN: Invalid key format in master: " + STD-KEY OF MASTER-REC + INTO WS-ERR-MSG + END-STRING + PERFORM 6100-WARNING-ERROR + END-IF + + *> Accumulate input hash total from master STD-DATA-3 (amount) + MOVE STD-DATA-3 OF MASTER-REC TO WS-MAST-AMT-NUM + ADD WS-MAST-AMT-NUM TO WS-INPUT-HASH-MAST + . + + *> ============================================================ + *> 4100-VALIDATE-DETAIL — Validate detail record + *> ============================================================ + 4100-VALIDATE-DETAIL. + *> Check key format + MOVE 'N' TO WS-KEY-INVALID-FLAG + PERFORM VARYING WS-IDX FROM 1 BY 1 + UNTIL WS-IDX > 10 OR WS-KEY-INVALID + MOVE STD-KEY OF DETAIL-REC(WS-IDX:1) TO WS-KEY-CHAR + MOVE 'N' TO WS-CHAR-OK + IF WS-KEY-CHAR >= 'A' AND WS-KEY-CHAR <= 'Z' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF WS-KEY-CHAR >= '0' AND WS-KEY-CHAR <= '9' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF WS-KEY-CHAR = '-' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF NOT WS-CHAR-IS-OK + MOVE 'Y' TO WS-KEY-INVALID-FLAG + END-IF + END-PERFORM + IF WS-KEY-INVALID + ADD 1 TO WS-KEY-FMT-ERR-COUNT + ADD 1 TO WS-WARN-COUNT + STRING "WARN: Invalid key format in detail: " + STD-KEY OF DETAIL-REC + INTO WS-ERR-MSG + END-STRING + PERFORM 6100-WARNING-ERROR + END-IF + + *> Accumulate input hash total from detail STD-DATA-3 + MOVE STD-DATA-3 OF DETAIL-REC TO WS-DETL-AMT-NUM + ADD WS-DETL-AMT-NUM TO WS-INPUT-HASH-DETL + . + + *> ============================================================ + *> 4200-CHECK-MAST-SEQUENCE — Verify master keys ascending + *> ============================================================ + 4200-CHECK-MAST-SEQUENCE. + IF STD-KEY OF MASTER-REC < WS-PREV-MAST-KEY + ADD 1 TO WS-SEQ-ERR-COUNT + ADD 1 TO WS-ERROR-COUNT + DISPLAY "ERROR: Master sequence violation: " + WS-PREV-MAST-KEY " > " + STD-KEY OF MASTER-REC + STRING "ERROR: Master seq violation prev=" + WS-PREV-MAST-KEY " curr=" + STD-KEY OF MASTER-REC + INTO WS-ERR-DETAIL + END-STRING + PERFORM 6200-FILE-ERROR + END-IF + . + + *> ============================================================ + *> 4300-CHECK-DETL-SEQUENCE — Verify detail keys ascending + *> ============================================================ + 4300-CHECK-DETL-SEQUENCE. + IF STD-KEY OF DETAIL-REC < WS-PREV-DETL-KEY + ADD 1 TO WS-SEQ-ERR-COUNT + ADD 1 TO WS-ERROR-COUNT + DISPLAY "ERROR: Detail sequence violation: " + WS-PREV-DETL-KEY " > " + STD-KEY OF DETAIL-REC + STRING "ERROR: Detail seq violation prev=" + WS-PREV-DETL-KEY " curr=" + STD-KEY OF DETAIL-REC + INTO WS-ERR-DETAIL + END-STRING + PERFORM 6200-FILE-ERROR + END-IF + . + + *> ============================================================ + *> 5000-PARTIAL-MATCH-CHECK — Amount tolerance comparison + *> ============================================================ + 5000-PARTIAL-MATCH-CHECK. + *> Compare amounts from master and detail with tolerance + MOVE STD-DATA-3 OF MASTER-REC TO WS-MAST-AMT-NUM + MOVE STD-DATA-3 OF DETAIL-REC TO WS-DETL-AMT-NUM + SUBTRACT WS-DETL-AMT-NUM FROM WS-MAST-AMT-NUM + GIVING WS-AMT-DIFF + IF WS-AMT-DIFF < 0 + MULTIPLY WS-AMT-DIFF BY -1 GIVING WS-AMT-ABS-DIFF + ELSE + MOVE WS-AMT-DIFF TO WS-AMT-ABS-DIFF + END-IF + + IF WS-AMT-ABS-DIFF > 0 + MOVE WS-AMT-ABS-DIFF TO WS-TOLERANCE-DISP + DISPLAY "TRACE: Amount diff " WS-TOLERANCE-DISP + " for key " STD-KEY OF MASTER-REC + IF WS-AMT-ABS-DIFF > WS-TOLERANCE + ADD 1 TO WS-PARTIAL-MATCH-COUNT + ADD 1 TO WS-WARN-COUNT + STRING "WARN: Amount exceeds tolerance key=" + STD-KEY OF MASTER-REC + INTO WS-ERR-MSG + END-STRING + PERFORM 6100-WARNING-ERROR + ELSE + ADD 1 TO WS-PARTIAL-MATCH-COUNT + DISPLAY "TRACE: Partial match within tolerance" + " key=" STD-KEY OF MASTER-REC + END-IF + END-IF + . + + *> ============================================================ + *> 5100-ACCUMULATE-OUTPUT — Accumulate output hash totals + *> ============================================================ + 5100-ACCUMULATE-OUTPUT. + MOVE STD-DATA-3 OF OUT-REC TO WS-DETL-AMT-NUM + ADD WS-DETL-AMT-NUM TO WS-OUTPUT-HASH + . + + *> ============================================================ + *> 5200-ACCUMULATE-ERROR — Accumulate error hash totals + *> ============================================================ + 5200-ACCUMULATE-ERROR. + ADD WS-AMT-ABS-DIFF TO WS-ERROR-HASH + . + + *> ============================================================ + *> 5300-WRITE-MAST-UNMATCH — Write unmatched master to error + *> ============================================================ + 5300-WRITE-MAST-UNMATCH. + MOVE 'MAST-UNMTC' TO ERR-TYPE + MOVE STD-KEY OF MASTER-REC TO ERR-KEY + MOVE STD-DATA-1 OF MASTER-REC(1:10) TO ERR-CUST + MOVE STD-DATA-3 OF MASTER-REC TO WS-MAST-AMT-NUM + MOVE WS-MAST-AMT-NUM TO ERR-AMOUNT + WRITE ERR-REC + . + + *> ============================================================ + *> 5400-WRITE-DETL-UNMATCH — Write unmatched detail to error + *> ============================================================ + 5400-WRITE-DETL-UNMATCH. + MOVE 'DETL-UNMTC' TO ERR-TYPE + MOVE STD-KEY OF DETAIL-REC TO ERR-KEY + MOVE STD-DATA-1 OF DETAIL-REC(1:10) TO ERR-CUST + MOVE STD-DATA-3 OF DETAIL-REC TO WS-DETL-AMT-NUM + MOVE WS-DETL-AMT-NUM TO ERR-AMOUNT + WRITE ERR-REC + . + + *> ============================================================ + *> 6000-FATAL-ERROR — Fatal error handler, terminates program + *> ============================================================ + 6000-FATAL-ERROR. + ADD 1 TO WS-FATAL-COUNT + DISPLAY "FATAL [" WS-TS-DATE " " WS-TS-TIME "] " + WS-ERR-MSG + MOVE 16 TO RETURN-CODE + STOP RUN + . + + *> ============================================================ + *> 6100-WARNING-ERROR — Warning handler, non-fatal + *> ============================================================ + 6100-WARNING-ERROR. + ADD 1 TO WS-WARN-COUNT + DISPLAY "WARNING [" WS-TS-DATE " " WS-TS-TIME "] " + WS-ERR-MSG + . + + *> ============================================================ + *> 6200-FILE-ERROR — File error handler, non-fatal + *> ============================================================ + 6200-FILE-ERROR. + ADD 1 TO WS-ERROR-COUNT + DISPLAY "ERROR [" WS-TS-DATE " " WS-TS-TIME "] " + WS-ERR-DETAIL + . + + *> ============================================================ + *> 7000-AUDIT-TRAIL — Write audit summary report + *> ============================================================ + 7000-AUDIT-TRAIL. + MOVE '7000-AUDIT-TRAIL' TO WS-PGM-PHASE + DISPLAY "[" WS-TS-DATE " " WS-TS-TIME + "] 01-MATCHING: Writing audit report..." + + PERFORM 7020-WRITE-AUDIT-SUMMARY + PERFORM 7030-WRITE-HASH-DETAIL + PERFORM 7040-WRITE-ERROR-SUMMARY + PERFORM 7050-WRITE-AGING-REPORT + PERFORM 7060-WRITE-AUDIT-FOOTER + + CLOSE AUDIT-FILE + . + + *> ============================================================ + *> 7010-WRITE-AUDIT-HEADER — Write audit report header + *> ============================================================ + 7010-WRITE-AUDIT-HEADER. + MOVE SPACES TO AUDIT-REC + STRING "================================================" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "01-MATCHING-1-1 AUDIT REPORT" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "Program Version: V2.00" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "Run Date: " WS-PROC-DATE " Time: " WS-PROC-TIME + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "================================================" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 7020-WRITE-AUDIT-SUMMARY — Write record count summary + *> ============================================================ + 7020-WRITE-AUDIT-SUMMARY. + MOVE SPACES TO AUDIT-REC + STRING "RECORD COUNT SUMMARY:" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Master records read : " WS-MAST-READ-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Detail records read : " WS-DETL-READ-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Matched records : " WS-MATCH-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Unmatched master : " WS-UNMATCH-MAST-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Unmatched detail : " WS-UNMATCH-DETL-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Partial matches : " WS-PARTIAL-MATCH-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 7030-WRITE-HASH-DETAIL — Write hash total reconciliation + *> ============================================================ + 7030-WRITE-HASH-DETAIL. + MOVE SPACES TO AUDIT-REC + STRING " " + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "HASH TOTAL RECONCILIATION:" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Input hash (master) : " WS-INPUT-HASH-MAST + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Input hash (detail) : " WS-INPUT-HASH-DETL + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Output hash : " WS-OUTPUT-HASH + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Error hash : " WS-ERROR-HASH + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + ADD WS-OUTPUT-HASH TO WS-ERROR-HASH + GIVING WS-HASH-DIFF + SUBTRACT WS-INPUT-HASH-MAST FROM WS-HASH-DIFF + IF WS-HASH-DIFF NOT = 0 + MOVE SPACES TO AUDIT-REC + STRING " ** HASH MISMATCH ** Difference: " + WS-HASH-DIFF + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + ELSE + MOVE SPACES TO AUDIT-REC + STRING " Hash total: VERIFIED (output+error = input)" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + END-IF + . + diff --git a/benchmark-programs/01-matching-1-1/main-matching-1-1.cbl b/benchmark-programs/01-matching-1-1/main-matching-1-1.cbl new file mode 100644 index 0000000..e724822 --- /dev/null +++ b/benchmark-programs/01-matching-1-1/main-matching-1-1.cbl @@ -0,0 +1,184 @@ + *> ============================================================ + *> main-matching-1-1 : 请求书↔支付对账 (Invoice↔Payment Matching) + *> Input : FILE-MAST (MASTER.DAT: 请求书), FILE-DETL (DETAIL.DAT: 支付) + *> Output: FILE-OUT (OUTPUT.DAT: 一致), FILE-ERR (ERROR.DAT: 不一致) + *> Coverage: MT-N001, MT-N004, MT-N005, MT-N006, MT-R001 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. MATCHING-11. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-MAST ASSIGN TO "MASTER.DAT" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FS1. + + SELECT FILE-DETL ASSIGN TO "DETAIL.DAT" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FS2. + + SELECT FILE-OUT ASSIGN TO "OUTPUT.DAT" + ORGANIZATION IS SEQUENTIAL. + + SELECT FILE-ERR ASSIGN TO "ERROR.DAT" + ORGANIZATION IS SEQUENTIAL. + + DATA DIVISION. + FILE SECTION. + FD FILE-MAST RECORD CONTAINS 40 CHARACTERS. + 01 MAST-REC. + 05 M-KEY PIC X(10). + 05 M-NAME PIC X(20). + 05 M-AMOUNT PIC 9(10). + + FD FILE-DETL RECORD CONTAINS 40 CHARACTERS. + 01 DETL-REC. + 05 D-KEY PIC X(10). + 05 D-NAME PIC X(20). + 05 D-AMOUNT PIC 9(10). + + FD FILE-OUT RECORD CONTAINS 40 CHARACTERS. + 01 OUT-REC. + 05 O-KEY PIC X(10). + 05 O-NAME PIC X(20). + 05 O-AMOUNT PIC 9(10). + + FD FILE-ERR RECORD CONTAINS 80 CHARACTERS. + 01 ERR-REC. + 05 ERR-TYPE PIC X(10). + 05 ERR-KEY PIC X(10). + 05 ERR-NAME PIC X(20). + 05 ERR-AMOUNT PIC 9(10). + 05 ERR-FILLER PIC X(30). + + WORKING-STORAGE SECTION. + 01 WS-FS1 PIC X(2). + 01 WS-FS2 PIC X(2). + 01 WS-EOF1 PIC X(1) VALUE 'N'. + 88 WS-EOF1-Y VALUE 'Y' FALSE 'N'. + 01 WS-EOF2 PIC X(1) VALUE 'N'. + 88 WS-EOF2-Y VALUE 'Y' FALSE 'N'. + 01 WS-READ-MAST PIC 9(10). + 01 WS-READ-DETL PIC 9(10). + 01 WS-WRITTEN PIC 9(10). + 01 WS-UNMATCH-MAST PIC 9(10). + 01 WS-UNMATCH-DETL PIC 9(10). + + PROCEDURE DIVISION. + MAIN. + DISPLAY "MATCHING-11: Starting 1:1 matching" + + OPEN INPUT FILE-MAST FILE-DETL. + OPEN OUTPUT FILE-OUT FILE-ERR. + IF WS-FS1 NOT = "00" OR WS-FS2 NOT = "00" + DISPLAY "OPEN FAIL: MAST=" WS-FS1 " DETL=" WS-FS2 + STOP RUN RETURNING 1 + END-IF. + + READ FILE-MAST INTO MAST-REC + AT END SET WS-EOF1-Y TO TRUE + END-READ. + READ FILE-DETL INTO DETL-REC + AT END SET WS-EOF2-Y TO TRUE + END-READ. + + PERFORM UNTIL WS-EOF1-Y AND WS-EOF2-Y + IF WS-EOF1-Y + PERFORM WRITE-DETL-REMAINING + ELSE IF WS-EOF2-Y + PERFORM WRITE-MAST-REMAINING + ELSE + IF M-KEY = D-KEY + PERFORM MATCH-FOUND + ELSE IF M-KEY < D-KEY + PERFORM MAST-UNMATCHED + ELSE + PERFORM DETL-UNMATCHED + END-IF + END-IF + END-PERFORM. + + CLOSE FILE-MAST FILE-DETL FILE-OUT FILE-ERR. + + DISPLAY "MATCH: MASTER-READ=" WS-READ-MAST + " DETL-READ=" WS-READ-DETL + DISPLAY "MATCH: MATCHED=" WS-WRITTEN + " UNMATCH-MAST=" WS-UNMATCH-MAST + " UNMATCH-DETL=" WS-UNMATCH-DETL + + IF WS-WRITTEN > 0 + DISPLAY "MATCHING-11: PASS" + STOP RUN RETURNING 0 + ELSE + DISPLAY "MATCHING-11: FAIL - no matches" + STOP RUN RETURNING 1 + END-IF + . + + MATCH-FOUND. + ADD 1 TO WS-READ-MAST WS-READ-DETL WS-WRITTEN. + MOVE M-KEY TO O-KEY. + MOVE M-NAME TO O-NAME. + MOVE M-AMOUNT TO O-AMOUNT. + WRITE OUT-REC. + + READ FILE-MAST INTO MAST-REC + AT END SET WS-EOF1-Y TO TRUE + END-READ. + READ FILE-DETL INTO DETL-REC + AT END SET WS-EOF2-Y TO TRUE + END-READ. + . + + MAST-UNMATCHED. + ADD 1 TO WS-READ-MAST WS-UNMATCH-MAST. + MOVE "MAST-UNMTC" TO ERR-TYPE. + MOVE M-KEY TO ERR-KEY. + MOVE M-NAME TO ERR-NAME. + MOVE M-AMOUNT TO ERR-AMOUNT. + WRITE ERR-REC. + + READ FILE-MAST INTO MAST-REC + AT END SET WS-EOF1-Y TO TRUE + END-READ. + . + + DETL-UNMATCHED. + ADD 1 TO WS-READ-DETL WS-UNMATCH-DETL. + MOVE "DETL-UNMTC" TO ERR-TYPE. + MOVE D-KEY TO ERR-KEY. + MOVE D-NAME TO ERR-NAME. + MOVE D-AMOUNT TO ERR-AMOUNT. + WRITE ERR-REC. + + READ FILE-DETL INTO DETL-REC + AT END SET WS-EOF2-Y TO TRUE + END-READ. + . + + WRITE-DETL-REMAINING. + ADD 1 TO WS-READ-DETL WS-UNMATCH-DETL. + MOVE "DETL-REMAIN" TO ERR-TYPE. + MOVE D-KEY TO ERR-KEY. + MOVE D-NAME TO ERR-NAME. + MOVE D-AMOUNT TO ERR-AMOUNT. + WRITE ERR-REC. + READ FILE-DETL INTO DETL-REC + AT END SET WS-EOF2-Y TO TRUE + END-READ. + . + + WRITE-MAST-REMAINING. + ADD 1 TO WS-READ-MAST WS-UNMATCH-MAST. + MOVE "MAST-REMAIN" TO ERR-TYPE. + MOVE M-KEY TO ERR-KEY. + MOVE M-NAME TO ERR-NAME. + MOVE M-AMOUNT TO ERR-AMOUNT. + WRITE ERR-REC. + READ FILE-MAST INTO MAST-REC + AT END SET WS-EOF1-Y TO TRUE + END-READ. + . + + END PROGRAM MATCHING-11. diff --git a/benchmark-programs/01-matching-1-1/output.dat b/benchmark-programs/01-matching-1-1/output.dat new file mode 100644 index 0000000..8fbecaa --- /dev/null +++ b/benchmark-programs/01-matching-1-1/output.dat @@ -0,0 +1 @@ + 0000000000000000000 000000000000000 \ No newline at end of file diff --git a/benchmark-programs/02-matching-1-N/README.md b/benchmark-programs/02-matching-1-N/README.md new file mode 100644 index 0000000..34c6f50 --- /dev/null +++ b/benchmark-programs/02-matching-1-N/README.md @@ -0,0 +1,63 @@ +# 02-matching-1-N: 1:N Matching (one master matches N details by key) + +## 电信业务场景 + +合同↔通话明细关联。读取合同文件(CONTRACT)和通话明细文件(CDR)，按合同ID进行1:N关联。一个合同可关联多条CDR，未关联的记录输出到异常文件。 + +## Description + +Tests one-to-many matching where one master record can match multiple detail +records sharing the same STD-KEY. The program reads a master, then reads all +consecutive details with the same key, writing one output record per matching +detail. Unmatched master and detail records are silently skipped. + +## Record Layout + +| Field | Type | Length | Description | +|------------|-----------------|--------|---------------------------| +| STD-KEY | PIC X | 10 | Record key | +| STD-DATA-1 | PIC X | 20 | Description text | +| STD-DATA-2 | PIC 9 | 10 | Numeric data (display) | +| STD-DATA-3 | PIC S9(7)V99 | 05 | Numeric data (COMP-3) | + +Total record length: 45 bytes. + +## Files + +| File | Purpose | +|-----------------------------|-----------------------------------| +| main-02-matching-1-N.cbl | Main COBOL program (fixed format) | +| data-gen.sh | Generate test data files | +| run.sh | Compile, run, verify | +| README.md | This file | + +## Data + +- **master.dat**: 2 records — KEY00001 (has 3 matching details), + KEY00004 (unmatched master) +- **detail.dat**: 4 records — KEY00001 x3 (3 details for KEY00001), + KEY00005 (unmatched detail) + +## Matching Logic + +1. Read master, then advance detail cursor to find matching key. +2. For each detail with the same key, write one output record (from master). +3. When details run out or key changes, read next master. +4. Skip unmatched masters (master key < detail key). +5. Skip unmatched details (detail key < master key). + +## Test + +| Check | Expected | +|------------------------|---------------------------| +| Output records | 3 (1 master x 3 details) | +| Output file size | 135 bytes (3 x 45) | +| Unmatched master | 1 (KEY00004) | +| Unmatched detail | 1 (KEY00005) | + +## Usage + +```bash +cd 02-matching-1-N +bash run.sh +``` diff --git a/benchmark-programs/02-matching-1-N/audit-report.txt b/benchmark-programs/02-matching-1-N/audit-report.txt new file mode 100644 index 0000000..5128407 --- /dev/null +++ b/benchmark-programs/02-matching-1-N/audit-report.txt @@ -0,0 +1,31 @@ +================================================ +02-MATCHING-1-N AUDIT REPORT +Program Version: V2.00 +Run Date: 20260622 Time: 16452669 +================================================ +RECORD COUNT SUMMARY: + Master (contract) records : 00002 + Detail (CDR) records : 00003 + Matched (output) records : 00000 + Unmatched contracts : 00000 + Unmatched CDRs : 00003 + Duplicate CDRs detected : 00000 + Avg CDRs per contract : N/A (no division) + +HASH TOTAL RECONCILIATION: + Input hash (contract) : 000000006060606 + Output hash : 000000000000000 + Error hash : 000000000000000 + ** HASH MISMATCH ** Diff: 00000000606060v + +ERROR SUMMARY: + Key format errors : 00005 + Duplicate CDRs : 00000 + Expired contracts : 00000 + CDR date outside rng : 00000 + Warnings : 00010 + Fatal errors : 00000 + +================================================ +END OF AUDIT REPORT +Generated: 20260622 16452669 diff --git a/benchmark-programs/02-matching-1-N/detail.dat b/benchmark-programs/02-matching-1-N/detail.dat new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/02-matching-1-N/detail.dat @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/02-matching-1-N/error.dat b/benchmark-programs/02-matching-1-N/error.dat new file mode 100644 index 0000000..e6cd76e Binary files /dev/null and b/benchmark-programs/02-matching-1-N/error.dat differ diff --git a/benchmark-programs/02-matching-1-N/main-02-matching-1-N.cbl b/benchmark-programs/02-matching-1-N/main-02-matching-1-N.cbl new file mode 100644 index 0000000..0d0ffeb --- /dev/null +++ b/benchmark-programs/02-matching-1-N/main-02-matching-1-N.cbl @@ -0,0 +1,791 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. Main02Matching1N. + *> ============================================================ + *> 02-matching-1-N : 合同↔通话明细匹配 (Contract↔CDR 1:N) + *> Input : master.dat (合同文件: 按CONTRACT-ID排序) + *> detail.dat (通话明细: 按CONTRACT-ID排序) + *> Output: output.dat (合同关联的通话明细清单) + *> error.dat (未关联CDR/合同) + *> audit-report.txt (审计报告: 处理统计) + *> Coverage: MT-N002, MT-N004, MT-N005, MT-R001 + *> contract validity period, CDR date range, dup detection + *> ============================================================ + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-MASTER ASSIGN TO 'master.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-MASTER-STATUS. + SELECT FILE-DETAIL ASSIGN TO 'detail.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-DETAIL-STATUS. + SELECT FILE-OUT ASSIGN TO 'output.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-OUT-STATUS. + SELECT FILE-ERR ASSIGN TO 'error.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-ERR-STATUS. + SELECT AUDIT-FILE ASSIGN TO 'audit-report.txt' + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-AUDIT-STATUS. + + DATA DIVISION. + FILE SECTION. + FD FILE-MASTER. + 01 MASTER-REC. + COPY "STD-REC.cpy". + + FD FILE-DETAIL. + 01 DETAIL-REC. + COPY "STD-REC.cpy". + + FD FILE-OUT. + 01 OUT-REC. + COPY "STD-REC.cpy". + + FD FILE-ERR. + 01 ERR-REC. + 05 ERR-TYPE PIC X(10). + 05 ERR-KEY PIC X(10). + 05 ERR-DATA PIC X(20). + 05 ERR-AMOUNT PIC 9(10). + 05 ERR-FILLER PIC X(30). + + FD AUDIT-FILE. + 01 AUDIT-REC PIC X(120). + + WORKING-STORAGE SECTION. + 01 WS-TELECOM-CONTRACT. + COPY "telecom/TEL-BILLING.cpy". + 01 WS-TELECOM-CDR. + COPY "telecom/TEL-CDR.cpy". + + *> File status fields + 01 WS-MASTER-STATUS PIC X(02). + 01 WS-DETAIL-STATUS PIC X(02). + 01 WS-OUT-STATUS PIC X(02). + 01 WS-ERR-STATUS PIC X(02). + 01 WS-AUDIT-STATUS PIC X(02). + + *> EOF and status flags + 01 WS-FLAGS. + 05 WS-MASTER-EOF PIC X VALUE 'N'. + 88 WS-MASTER-END VALUE 'Y' FALSE 'N'. + 05 WS-DETAIL-EOF PIC X VALUE 'N'. + 88 WS-DETAIL-END VALUE 'Y' FALSE 'N'. + 05 WS-HAVE-MAST PIC X VALUE 'N'. + 88 WS-HAVE-MAST-Y VALUE 'Y' FALSE 'N'. + + *> Key area for contract matching + 01 WS-KEY-AREA. + 05 WS-MASTER-KEY PIC X(10). + 05 WS-DETAIL-KEY PIC X(10). + 05 WS-GROUP-KEY PIC X(10). + 05 WS-PREV-DETL-KEY PIC X(10). + 05 WS-PREV-MAST-KEY PIC X(10). + + *> Counter accumulators + 01 WS-COUNTERS. + 05 WS-MATCH-COUNT PIC 9(05) VALUE 0. + 05 WS-MAST-READ-COUNT PIC 9(05) VALUE 0. + 05 WS-DETL-READ-COUNT PIC 9(05) VALUE 0. + 05 WS-UNMATCH-MAST-COUNT PIC 9(05) VALUE 0. + 05 WS-UNMATCH-DETL-COUNT PIC 9(05) VALUE 0. + 05 WS-DUP-CDR-COUNT PIC 9(05) VALUE 0. + 05 WS-ERROR-COUNT PIC 9(05) VALUE 0. + 05 WS-WARN-COUNT PIC 9(05) VALUE 0. + 05 WS-FATAL-COUNT PIC 9(05) VALUE 0. + 05 WS-SEQ-ERR-COUNT PIC 9(05) VALUE 0. + 05 WS-KEY-FMT-ERR-COUNT PIC 9(05) VALUE 0. + + *> Hash totals for batch control + 01 WS-HASH-TOTALS. + 05 WS-INPUT-HASH-MAST PIC 9(15) VALUE 0. + 05 WS-INPUT-HASH-DETL PIC 9(15) VALUE 0. + 05 WS-OUTPUT-HASH PIC 9(15) VALUE 0. + 05 WS-ERROR-HASH PIC 9(15) VALUE 0. + 05 WS-HASH-DIFF PIC S9(15) VALUE 0. + + *> Date and timestamp areas + 01 WS-DATE-TIME. + 05 WS-PROC-DATE PIC 9(08). + 05 WS-PROC-TIME PIC 9(08). + 05 WS-TIMESTAMP. + 10 WS-TS-DATE PIC X(08). + 10 WS-TS-SPACE PIC X VALUE ' '. + 10 WS-TS-TIME PIC X(08). + + *> Validation accumulators + 01 WS-VALIDATION. + 05 WS-PREV-CONTRACT-KEY PIC X(10). + 05 WS-PREV-CDR-KEY PIC X(10). + 05 WS-CDR-DUP-FLAG PIC X VALUE 'N'. + 88 WS-CDR-DUP-FOUND VALUE 'Y' FALSE 'N'. + 05 WS-VALID-KEY-CHARS PIC X(36) VALUE + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789'. + 05 WS-KEY-CHAR PIC X. + 05 WS-CHAR-OK PIC X VALUE 'N'. + 88 WS-CHAR-IS-OK VALUE 'Y' FALSE 'N'. + 05 WS-IDX PIC 9(02). + 05 WS-KEY-INVALID-FLAG PIC X VALUE 'N'. + 88 WS-KEY-INVALID VALUE 'Y' FALSE 'N'. + 05 WS-CDR-ID-SAVE PIC X(10). + 05 WS-CDR-ID-PREV PIC X(10). + + *> Contract validity date check + 01 WS-CONTRACT-VALIDITY. + 05 WS-CONTRACT-MONTH PIC 9(06). + 05 WS-CURRENT-MONTH PIC 9(06). + 05 WS-CONTRACT-ACTIVE PIC X VALUE 'Y'. + 88 WS-CONTRACT-IS-ACTIVE VALUE 'Y' FALSE 'N'. + 05 WS-CONTRACT-EXPIRED-COUNT PIC 9(05) VALUE 0. + + *> CDR date range validation + 01 WS-CDR-DATE-CHECK. + 05 WS-CDR-MONTH PIC 9(06). + 05 WS-CDR-DATE-FLAG PIC X VALUE 'Y'. + 88 WS-CDR-DATE-OK VALUE 'Y' FALSE 'N'. + 05 WS-CDR-OUTSIDE-COUNT PIC 9(05) VALUE 0. + + *> Amount comparison area + 01 WS-AMOUNT-AREAS. + 05 WS-MAST-AMT-NUM PIC 9(10). + 05 WS-DETL-AMT-NUM PIC 9(10). + 05 WS-OUT-AMT-NUM PIC 9(10). + 05 WS-ERR-AMT-NUM PIC 9(10). + + *> Error message areas + 01 WS-ERR-MSG PIC X(60). + 01 WS-ERR-DETAIL PIC X(80). + + *> Program phase tracking + 01 WS-PGM-PHASE PIC X(20). + + PROCEDURE DIVISION. + + *> ============================================================ + *> MAIN SECTION + *> ============================================================ + MAIN SECTION. + MB-PROCESS. + *> Initialize and open files + PERFORM 1000-INITIALIZE + PERFORM 2000-OPEN-FILES + + *> Read first master record + PERFORM 3100-READ-MASTER + + *> MAIN MATCHING LOOP (original 1:N algorithm preserved) + PERFORM UNTIL WS-MASTER-END + IF NOT WS-HAVE-MAST-Y + EXIT PERFORM + END-IF + + MOVE STD-KEY OF MASTER-REC TO WS-MASTER-KEY + ADD 1 TO WS-MAST-READ-COUNT + PERFORM 4000-VALIDATE-MASTER + + *> Advance master to next record (original logic) + PERFORM 3100-READ-MASTER + + *> Process all detail records matching this master (original inner loop) + PERFORM UNTIL WS-DETAIL-END + IF STD-KEY OF DETAIL-REC + NOT = WS-MASTER-KEY + EXIT PERFORM + END-IF + ADD 1 TO WS-DETL-READ-COUNT + PERFORM 4100-VALIDATE-DETAIL + + *> Check for duplicate CDR within batch + PERFORM 4400-CHECK-DUP-CDR + + *> Write output (original logic) + MOVE MASTER-REC TO OUT-REC + WRITE OUT-REC + ADD 1 TO WS-MATCH-COUNT + PERFORM 5100-ACCUMULATE-OUTPUT + + PERFORM 3200-READ-DETAIL + END-PERFORM + + *> If detail key advanced past master key, master is unmatched + IF STD-KEY OF DETAIL-REC > WS-MASTER-KEY + AND NOT WS-DETAIL-END + ADD 1 TO WS-UNMATCH-MAST-COUNT + PERFORM 5300-WRITE-MAST-UNMATCH + END-IF + END-PERFORM. + + *> Drain remaining detail records (original logic) + PERFORM UNTIL WS-DETAIL-END + ADD 1 TO WS-UNMATCH-DETL-COUNT + ADD 1 TO WS-DETL-READ-COUNT + PERFORM 4100-VALIDATE-DETAIL + PERFORM 5400-WRITE-DETL-UNMATCH + PERFORM 3200-READ-DETAIL + END-PERFORM + + *> Close files and write audit + CLOSE FILE-MASTER + CLOSE FILE-DETAIL + CLOSE FILE-OUT + CLOSE FILE-ERR + PERFORM 7000-AUDIT-TRAIL + PERFORM 8000-FINALIZE + + DISPLAY '02-matching-1-N: PASS' + STOP RUN + . + + *> ============================================================ + *> 1000-INITIALIZE + *> ============================================================ + 1000-INITIALIZE. + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-PROC-DATE + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-PROC-TIME + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-TS-DATE + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-TS-TIME + + DISPLAY "============================================" + DISPLAY "02-MATCHING-1-N Contract-CDR Matching" + DISPLAY "Version V2.00" + DISPLAY "Run date: " WS-PROC-DATE " " WS-PROC-TIME + DISPLAY "============================================" + + INITIALIZE WS-COUNTERS + INITIALIZE WS-HASH-TOTALS + INITIALIZE WS-VALIDATION + INITIALIZE WS-CONTRACT-VALIDITY + INITIALIZE WS-CDR-DATE-CHECK + . + + *> ============================================================ + *> 2000-OPEN-FILES + *> ============================================================ + 2000-OPEN-FILES. + MOVE '2000-OPEN-FILES' TO WS-PGM-PHASE + DISPLAY "[" WS-TS-DATE " " WS-TS-TIME + "] 02-MATCHING: Opening files..." + + OPEN INPUT FILE-MASTER + IF WS-MASTER-STATUS NOT = '00' + STRING "FATAL: Cannot open master.dat, status " + WS-MASTER-STATUS + INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF + + OPEN INPUT FILE-DETAIL + IF WS-DETAIL-STATUS NOT = '00' + STRING "FATAL: Cannot open detail.dat, status " + WS-DETAIL-STATUS + INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF + + OPEN OUTPUT FILE-OUT + IF WS-OUT-STATUS NOT = '00' + STRING "FATAL: Cannot open output.dat, status " + WS-OUT-STATUS + INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF + + OPEN OUTPUT FILE-ERR + IF WS-ERR-STATUS NOT = '00' + STRING "FATAL: Cannot open error.dat, status " + WS-ERR-STATUS + INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF + + OPEN OUTPUT AUDIT-FILE + IF WS-AUDIT-STATUS NOT = '00' + DISPLAY "WARNING: Cannot open audit-report.txt, " + "status " WS-AUDIT-STATUS + ADD 1 TO WS-WARN-COUNT + END-IF + + PERFORM 7010-WRITE-AUDIT-HEADER + . + + *> ============================================================ + *> 3100-READ-MASTER — Read next master record (original helper) + *> ============================================================ + 3100-READ-MASTER. + READ FILE-MASTER + AT END + MOVE 'Y' TO WS-MASTER-EOF + MOVE 'N' TO WS-HAVE-MAST + NOT AT END + MOVE 'Y' TO WS-HAVE-MAST + END-READ + . + + *> ============================================================ + *> 3200-READ-DETAIL — Read next detail record + *> ============================================================ + 3200-READ-DETAIL. + READ FILE-DETAIL + AT END MOVE 'Y' TO WS-DETAIL-EOF + END-READ + . + + *> ============================================================ + *> 4000-VALIDATE-MASTER — Validate master record + *> ============================================================ + 4000-VALIDATE-MASTER. + *> Check key format + MOVE 'N' TO WS-KEY-INVALID-FLAG + PERFORM VARYING WS-IDX FROM 1 BY 1 + UNTIL WS-IDX > 10 OR WS-KEY-INVALID + MOVE STD-KEY OF MASTER-REC(WS-IDX:1) TO WS-KEY-CHAR + MOVE 'N' TO WS-CHAR-OK + IF WS-KEY-CHAR >= 'A' AND WS-KEY-CHAR <= 'Z' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF WS-KEY-CHAR >= '0' AND WS-KEY-CHAR <= '9' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF WS-KEY-CHAR = '-' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF NOT WS-CHAR-IS-OK + MOVE 'Y' TO WS-KEY-INVALID-FLAG + END-IF + END-PERFORM + IF WS-KEY-INVALID + ADD 1 TO WS-KEY-FMT-ERR-COUNT + ADD 1 TO WS-WARN-COUNT + STRING "WARN: Invalid key format in master: " + STD-KEY OF MASTER-REC + INTO WS-ERR-MSG + END-STRING + PERFORM 6100-WARNING-ERROR + END-IF + + *> Accumulate input hash total + MOVE STD-DATA-3 OF MASTER-REC TO WS-MAST-AMT-NUM + ADD WS-MAST-AMT-NUM TO WS-INPUT-HASH-MAST + + *> Check contract validity period + MOVE STD-DATA-2 OF MASTER-REC TO WS-CONTRACT-MONTH + MOVE WS-PROC-DATE(1:6) TO WS-CURRENT-MONTH + IF WS-CONTRACT-MONTH > WS-CURRENT-MONTH + ADD 1 TO WS-CONTRACT-EXPIRED-COUNT + ADD 1 TO WS-WARN-COUNT + STRING "WARN: Contract period invalid key=" + STD-KEY OF MASTER-REC + INTO WS-ERR-MSG + END-STRING + PERFORM 6100-WARNING-ERROR + END-IF + . + + *> ============================================================ + *> 4100-VALIDATE-DETAIL — Validate detail (CDR) record + *> ============================================================ + 4100-VALIDATE-DETAIL. + *> Check key format + MOVE 'N' TO WS-KEY-INVALID-FLAG + PERFORM VARYING WS-IDX FROM 1 BY 1 + UNTIL WS-IDX > 10 OR WS-KEY-INVALID + MOVE STD-KEY OF DETAIL-REC(WS-IDX:1) TO WS-KEY-CHAR + MOVE 'N' TO WS-CHAR-OK + IF WS-KEY-CHAR >= 'A' AND WS-KEY-CHAR <= 'Z' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF WS-KEY-CHAR >= '0' AND WS-KEY-CHAR <= '9' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF WS-KEY-CHAR = '-' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF NOT WS-CHAR-IS-OK + MOVE 'Y' TO WS-KEY-INVALID-FLAG + END-IF + END-PERFORM + IF WS-KEY-INVALID + ADD 1 TO WS-KEY-FMT-ERR-COUNT + ADD 1 TO WS-WARN-COUNT + STRING "WARN: Invalid key format in detail: " + STD-KEY OF DETAIL-REC + INTO WS-ERR-MSG + END-STRING + PERFORM 6100-WARNING-ERROR + END-IF + + *> Accumulate input hash from CDR duration/amount + MOVE STD-DATA-3 OF DETAIL-REC TO WS-DETL-AMT-NUM + ADD WS-DETL-AMT-NUM TO WS-INPUT-HASH-DETL + + *> CDR date range validation + MOVE STD-DATA-2 OF DETAIL-REC TO WS-CDR-MONTH + MOVE WS-PROC-DATE(1:6) TO WS-CURRENT-MONTH + IF WS-CDR-MONTH > WS-CURRENT-MONTH + ADD 1 TO WS-CDR-OUTSIDE-COUNT + ADD 1 TO WS-WARN-COUNT + STRING "WARN: CDR date outside range key=" + STD-KEY OF DETAIL-REC + INTO WS-ERR-MSG + END-STRING + PERFORM 6100-WARNING-ERROR + END-IF + . + + *> ============================================================ + *> 4400-CHECK-DUP-CDR — Check for duplicate CDR within batch + *> ============================================================ + 4400-CHECK-DUP-CDR. + *> STD-DATA-1 contains CDR-ID in TEL-CDR mapping + MOVE STD-DATA-1 OF DETAIL-REC(1:10) TO WS-CDR-ID-SAVE + IF WS-CDR-ID-SAVE = WS-CDR-ID-PREV + ADD 1 TO WS-DUP-CDR-COUNT + ADD 1 TO WS-WARN-COUNT + STRING "WARN: Duplicate CDR detected: " + WS-CDR-ID-SAVE + INTO WS-ERR-MSG + END-STRING + PERFORM 6100-WARNING-ERROR + END-IF + MOVE WS-CDR-ID-SAVE TO WS-CDR-ID-PREV + . + + *> ============================================================ + *> 5100-ACCUMULATE-OUTPUT — Accumulate output hash + *> ============================================================ + 5100-ACCUMULATE-OUTPUT. + MOVE STD-DATA-3 OF OUT-REC TO WS-OUT-AMT-NUM + ADD WS-OUT-AMT-NUM TO WS-OUTPUT-HASH + . + + *> ============================================================ + *> 5300-WRITE-MAST-UNMATCH — Write unmatched master to error + *> ============================================================ + 5300-WRITE-MAST-UNMATCH. + MOVE 'MAST-UNMTC' TO ERR-TYPE + MOVE STD-KEY OF MASTER-REC TO ERR-KEY + MOVE STD-DATA-1 OF MASTER-REC(1:20) TO ERR-DATA + MOVE STD-DATA-3 OF MASTER-REC TO WS-MAST-AMT-NUM + MOVE WS-MAST-AMT-NUM TO ERR-AMOUNT + WRITE ERR-REC + . + + *> ============================================================ + *> 5400-WRITE-DETL-UNMATCH — Write unmatched detail to error + *> ============================================================ + 5400-WRITE-DETL-UNMATCH. + MOVE 'DETL-UNMTC' TO ERR-TYPE + MOVE STD-KEY OF DETAIL-REC TO ERR-KEY + MOVE STD-DATA-1 OF DETAIL-REC(1:20) TO ERR-DATA + MOVE STD-DATA-3 OF DETAIL-REC TO WS-DETL-AMT-NUM + MOVE WS-DETL-AMT-NUM TO ERR-AMOUNT + WRITE ERR-REC + . + + *> ============================================================ + *> 6000-FATAL-ERROR — Fatal error, terminates program + *> ============================================================ + 6000-FATAL-ERROR. + ADD 1 TO WS-FATAL-COUNT + DISPLAY "FATAL [" WS-TS-DATE " " WS-TS-TIME "] " + WS-ERR-MSG + MOVE 16 TO RETURN-CODE + STOP RUN + . + + *> ============================================================ + *> 6100-WARNING-ERROR — Warning handler + *> ============================================================ + 6100-WARNING-ERROR. + ADD 1 TO WS-WARN-COUNT + DISPLAY "WARNING [" WS-TS-DATE " " WS-TS-TIME "] " + WS-ERR-MSG + . + + *> ============================================================ + *> 7000-AUDIT-TRAIL — Write audit summary report + *> ============================================================ + 7000-AUDIT-TRAIL. + MOVE '7000-AUDIT-TRAIL' TO WS-PGM-PHASE + DISPLAY "[" WS-TS-DATE " " WS-TS-TIME + "] 02-MATCHING: Writing audit report..." + + PERFORM 7020-WRITE-AUDIT-SUMMARY + PERFORM 7030-WRITE-HASH-DETAIL + PERFORM 7040-WRITE-ERROR-SUMMARY + PERFORM 7060-WRITE-AUDIT-FOOTER + + CLOSE AUDIT-FILE + . + + *> ============================================================ + *> 7010-WRITE-AUDIT-HEADER + *> ============================================================ + 7010-WRITE-AUDIT-HEADER. + MOVE SPACES TO AUDIT-REC + STRING "================================================" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "02-MATCHING-1-N AUDIT REPORT" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "Program Version: V2.00" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "Run Date: " WS-PROC-DATE " Time: " WS-PROC-TIME + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "================================================" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 7020-WRITE-AUDIT-SUMMARY + *> ============================================================ + 7020-WRITE-AUDIT-SUMMARY. + MOVE SPACES TO AUDIT-REC + STRING "RECORD COUNT SUMMARY:" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Master (contract) records : " WS-MAST-READ-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Detail (CDR) records : " WS-DETL-READ-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Matched (output) records : " WS-MATCH-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Unmatched contracts : " + WS-UNMATCH-MAST-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Unmatched CDRs : " + WS-UNMATCH-DETL-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Duplicate CDRs detected : " WS-DUP-CDR-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Avg CDRs per contract : N/A (no division)" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 7030-WRITE-HASH-DETAIL + *> ============================================================ + 7030-WRITE-HASH-DETAIL. + MOVE SPACES TO AUDIT-REC + STRING " " + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "HASH TOTAL RECONCILIATION:" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Input hash (contract) : " WS-INPUT-HASH-MAST + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Output hash : " WS-OUTPUT-HASH + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Error hash : " WS-ERROR-HASH + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + ADD WS-OUTPUT-HASH TO WS-ERROR-HASH + GIVING WS-HASH-DIFF + SUBTRACT WS-INPUT-HASH-MAST FROM WS-HASH-DIFF + IF WS-HASH-DIFF NOT = 0 + MOVE SPACES TO AUDIT-REC + STRING " ** HASH MISMATCH ** Diff: " WS-HASH-DIFF + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + ELSE + MOVE SPACES TO AUDIT-REC + STRING " Hash total: VERIFIED" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + END-IF + . + + *> ============================================================ + *> 7040-WRITE-ERROR-SUMMARY + *> ============================================================ + 7040-WRITE-ERROR-SUMMARY. + MOVE SPACES TO AUDIT-REC + STRING " " + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "ERROR SUMMARY:" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Key format errors : " WS-KEY-FMT-ERR-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Duplicate CDRs : " WS-DUP-CDR-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Expired contracts : " + WS-CONTRACT-EXPIRED-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " CDR date outside rng : " + WS-CDR-OUTSIDE-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Warnings : " WS-WARN-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Fatal errors : " WS-FATAL-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 7060-WRITE-AUDIT-FOOTER + *> ============================================================ + 7060-WRITE-AUDIT-FOOTER. + MOVE SPACES TO AUDIT-REC + STRING " " + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "================================================" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "END OF AUDIT REPORT" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "Generated: " WS-PROC-DATE " " WS-PROC-TIME + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 8000-FINALIZE — Display final summary + *> ============================================================ + 8000-FINALIZE. + MOVE '8000-FINALIZE' TO WS-PGM-PHASE + DISPLAY "============================================" + DISPLAY "02-MATCHING-1-N Processing Summary" + DISPLAY "============================================" + DISPLAY "Contract records read : " WS-MAST-READ-COUNT + DISPLAY "CDR records read : " WS-DETL-READ-COUNT + DISPLAY "Matched records : " WS-MATCH-COUNT + DISPLAY "Unmatched contracts : " WS-UNMATCH-MAST-COUNT + DISPLAY "Unmatched CDRs : " WS-UNMATCH-DETL-COUNT + DISPLAY "Duplicate CDRs : " WS-DUP-CDR-COUNT + DISPLAY "Expired contracts : " + WS-CONTRACT-EXPIRED-COUNT + DISPLAY "--------------------------------------------" + DISPLAY "Key format errors : " WS-KEY-FMT-ERR-COUNT + DISPLAY "Warnings : " WS-WARN-COUNT + DISPLAY "Fatal errors : " WS-FATAL-COUNT + DISPLAY "============================================" + + ADD WS-OUTPUT-HASH TO WS-ERROR-HASH + GIVING WS-HASH-DIFF + SUBTRACT WS-INPUT-HASH-MAST FROM WS-HASH-DIFF + IF WS-HASH-DIFF NOT = 0 + DISPLAY "WARNING: Hash total mismatch! Diff=" + WS-HASH-DIFF + ELSE + DISPLAY "Hash totals: VERIFIED" + END-IF + DISPLAY "Audit report written to audit-report.txt" + DISPLAY "============================================" + . + + END PROGRAM Main02Matching1N. diff --git a/benchmark-programs/02-matching-1-N/main-matching-1-N.cbl b/benchmark-programs/02-matching-1-N/main-matching-1-N.cbl new file mode 100644 index 0000000..5194069 --- /dev/null +++ b/benchmark-programs/02-matching-1-N/main-matching-1-N.cbl @@ -0,0 +1,155 @@ + *> ============================================================ + *> main-matching-1-N : 合同↔通话明细匹配 (Contract↔CDR 1:N) + *> Input : FILE-MAST (MASTER.DAT: 合同), FILE-DETL (DETAIL.DAT: CDR) + *> Output: FILE-OUT (OUTPUT.DAT: 一致), FILE-ERR (ERROR.DAT: 不一致) + *> Coverage: MT-N002, MT-N004, MT-N005, MT-R001 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. MATCHING-1N. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-MAST ASSIGN TO "MASTER.DAT" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FS1. + + SELECT FILE-DETL ASSIGN TO "DETAIL.DAT" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FS2. + + SELECT FILE-OUT ASSIGN TO "OUTPUT.DAT" + ORGANIZATION IS SEQUENTIAL. + + SELECT FILE-ERR ASSIGN TO "ERROR.DAT" + ORGANIZATION IS SEQUENTIAL. + + DATA DIVISION. + FILE SECTION. + FD FILE-MAST RECORD CONTAINS 40 CHARACTERS. + 01 MAST-REC. + 05 M-KEY PIC X(10). + 05 M-NAME PIC X(20). + 05 M-AMOUNT PIC 9(10). + + FD FILE-DETL RECORD CONTAINS 40 CHARACTERS. + 01 DETL-REC. + 05 D-KEY PIC X(10). + 05 D-NAME PIC X(20). + 05 D-AMOUNT PIC 9(10). + + FD FILE-OUT RECORD CONTAINS 60 CHARACTERS. + 01 OUT-REC. + 05 O-M-KEY PIC X(10). + 05 O-M-NAME PIC X(20). + 05 O-D-NAME PIC X(20). + 05 O-AMOUNT PIC 9(10). + + FD FILE-ERR RECORD CONTAINS 40 CHARACTERS. + 01 ERR-REC PIC X(40). + + WORKING-STORAGE SECTION. + 01 WS-FS1 PIC X(2). + 01 WS-FS2 PIC X(2). + 01 WS-EOF1 PIC X(1) VALUE 'N'. + 88 WS-EOF1-Y VALUE 'Y' FALSE 'N'. + 01 WS-EOF2 PIC X(1) VALUE 'N'. + 88 WS-EOF2-Y VALUE 'Y' FALSE 'N'. + 01 WS-MAST-COUNT PIC 9(10). + 01 WS-DETL-COUNT PIC 9(10). + 01 WS-MATCH-COUNT PIC 9(10). + 01 WS-MAST-REMAIN PIC 9(10). + 01 WS-DETL-REMAIN PIC 9(10). + 01 WS-MAST-KEY PIC X(10). + 01 WS-MAST-NAME PIC X(20). + 01 WS-MAST-AMT PIC 9(10). + 01 WS-HAVE-MAST PIC X(1) VALUE 'N'. + 88 WS-HAVE-MAST-Y VALUE 'Y' FALSE 'N'. + + PROCEDURE DIVISION. + MAIN. + DISPLAY "MATCHING-1N: Starting 1:N matching" + OPEN INPUT FILE-MAST FILE-DETL. + OPEN OUTPUT FILE-OUT FILE-ERR. + IF WS-FS1 NOT = "00" OR WS-FS2 NOT = "00" + DISPLAY "OPEN FAIL: MAST=" WS-FS1 " DETL=" WS-FS2 + STOP RUN RETURNING 1 + END-IF. + + PERFORM READ-MASTER. + PERFORM UNTIL WS-EOF1-Y + IF NOT WS-HAVE-MAST-Y + EXIT PERFORM + END-IF + + MOVE M-KEY TO WS-MAST-KEY + MOVE M-NAME TO WS-MAST-NAME + MOVE M-AMOUNT TO WS-MAST-AMT + ADD 1 TO WS-MAST-COUNT + + PERFORM READ-MASTER + + PERFORM UNTIL WS-EOF2-Y + IF D-KEY NOT = WS-MAST-KEY + EXIT PERFORM + END-IF + MOVE WS-MAST-KEY TO O-M-KEY + MOVE WS-MAST-NAME TO O-M-NAME + MOVE D-NAME TO O-D-NAME + MOVE D-AMOUNT TO O-AMOUNT + WRITE OUT-REC + ADD 1 TO WS-MATCH-COUNT + ADD 1 TO WS-DETL-COUNT + READ FILE-DETL INTO DETL-REC + AT END SET WS-EOF2-Y TO TRUE + END-READ + END-PERFORM + + IF D-KEY > WS-MAST-KEY AND NOT WS-EOF2-Y + ADD 1 TO WS-MAST-REMAIN + STRING "MAST-REMAIN " WS-MAST-KEY + DELIMITED BY SIZE INTO ERR-REC + END-STRING + WRITE ERR-REC + END-IF + END-PERFORM. + + PERFORM UNTIL WS-EOF2-Y + ADD 1 TO WS-DETL-REMAIN WS-DETL-COUNT + STRING "DETL-REMAIN " D-KEY + DELIMITED BY SIZE INTO ERR-REC + END-STRING + WRITE ERR-REC + READ FILE-DETL INTO DETL-REC + AT END SET WS-EOF2-Y TO TRUE + END-READ + END-PERFORM. + + CLOSE FILE-MAST FILE-DETL FILE-OUT FILE-ERR. + + DISPLAY "MATCH-1N: MASTER=" WS-MAST-COUNT + " DETL=" WS-DETL-COUNT + DISPLAY "MATCH-1N: MATCHED=" WS-MATCH-COUNT + " M-REMAIN=" WS-MAST-REMAIN + " D-REMAIN=" WS-DETL-REMAIN + + IF WS-MATCH-COUNT > 0 + DISPLAY "MATCHING-1N: PASS" + STOP RUN RETURNING 0 + ELSE + DISPLAY "MATCHING-1N: FAIL" + STOP RUN RETURNING 1 + END-IF + . + + READ-MASTER. + READ FILE-MAST INTO MAST-REC + AT END + SET WS-EOF1-Y TO TRUE + MOVE 'N' TO WS-HAVE-MAST + NOT AT END + SET WS-HAVE-MAST TO TRUE + END-READ + . + + END PROGRAM MATCHING-1N. diff --git a/benchmark-programs/02-matching-1-N/master.dat b/benchmark-programs/02-matching-1-N/master.dat new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/02-matching-1-N/master.dat @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/02-matching-1-N/output.dat b/benchmark-programs/02-matching-1-N/output.dat new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/03-matching-N-1/README.md b/benchmark-programs/03-matching-N-1/README.md new file mode 100644 index 0000000..4da8fa5 --- /dev/null +++ b/benchmark-programs/03-matching-N-1/README.md @@ -0,0 +1,60 @@ +# 03-matching-N-1: N:1 Matching (N master records match one detail record) + +## 电信业务场景 + +多线路→请求书汇集。读取多条电话线路记录(LINE)和请求地址文件(BILL-ADDR)，按地址进行N:1汇集。同一个地址的多条线路汇总到一张请求书。 + +## Description + +Tests N:1 matching where multiple master records sharing the same key match +a single detail record. The program groups masters by key, finds the +corresponding detail, and writes one output record per master that has a match. + +## Record Layout + +| Field | Type | Length | Description | +|------------|-----------------|--------|---------------------------| +| STD-KEY | PIC X | 10 | Record key | +| STD-DATA-1 | PIC X | 20 | Description text | +| STD-DATA-2 | PIC 9 | 10 | Numeric data (display) | +| STD-DATA-3 | PIC S9(7)V99 | 05 | Numeric data (COMP-3) | + +Total record length: 45 bytes. + +## Files + +| File | Purpose | +|-----------------------------|-----------------------------------| +| main-03-matching-N-1.cbl | Main COBOL program (fixed format) | +| data-gen.sh | Generate test data files | +| run.sh | Compile, run, verify | +| README.md | This file | + +## Data + +- **master.dat**: 3 records, all with key `KEY00001` (N=3 masters) +- **detail.dat**: 2 records — `KEY00001` (matches the 3 masters), + `KEY00002` (unmatched, not referenced) + +## Matching Logic + +1. Read masters by group (all records sharing the same key). +2. Advance the detail pointer to find a key matching the group. +3. If a match is found, write one output record per master in the group. +4. If no match is found, skip the entire master group. +5. Unmatched detail records are also skipped. + +## Test + +| Check | Expected | +|------------------------|------------------------| +| Output records | 3 (3 masters x 1 match) | +| Output file size | 135 bytes (3 x 45) | +| Unmatched master groups| 0 (all 3 have a match) | + +## Usage + +```bash +cd 03-matching-N-1 +bash run.sh +``` diff --git a/benchmark-programs/03-matching-N-1/audit-report.txt b/benchmark-programs/03-matching-N-1/audit-report.txt new file mode 100644 index 0000000..4b750f2 --- /dev/null +++ b/benchmark-programs/03-matching-N-1/audit-report.txt @@ -0,0 +1,35 @@ +================================================ +03-MATCHING-N-1 AUDIT REPORT +Program Version: V2.00 +Run Date: 20260622 Time: 16452810 +================================================ +RECORD COUNT SUMMARY: + Master (line) records : 00002 + Detail (bill) records : 00002 + Matched records (output) : 00002 + Unmatched lines : 00000 + Unmatched bills : 00000 + Line groups processed : 00002 + Multi-line groups (3+) : 00002 + +HASH TOTAL RECONCILIATION: + Input hash (lines) : 000000006060606 + Output hash : 000000006060606 + Hash total: VERIFIED + +ERROR SUMMARY: + Key format errors : 00004 + Sequence violations : 00000 + Warnings : 00012 + Fatal errors : 00000 + +LINE STATUS & DISCOUNT INFO: + Active lines : 00000 + Suspended lines : 00000 + Terminated lines : 00000 + Discount threshold : 000 lines + Groups eligible for discount: 00002 + +================================================ +END OF AUDIT REPORT +Generated: 20260622 16452810 diff --git a/benchmark-programs/03-matching-N-1/detail.dat b/benchmark-programs/03-matching-N-1/detail.dat new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/03-matching-N-1/detail.dat @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/03-matching-N-1/error.dat b/benchmark-programs/03-matching-N-1/error.dat new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/03-matching-N-1/main-03-matching-N-1.cbl b/benchmark-programs/03-matching-N-1/main-03-matching-N-1.cbl new file mode 100644 index 0000000..c326b5d --- /dev/null +++ b/benchmark-programs/03-matching-N-1/main-03-matching-N-1.cbl @@ -0,0 +1,854 @@ + *> ============================================================ + *> 03-matching-N-1 : 多线路→请求书 (Line→Bill N:1) + *> Input : FILE-MASTER (master.dat: N条线路记录), FILE-DETAIL (detail.dat: 按KEY排序) + *> Output: FILE-OUT (output.dat: 匹配后请求书记录) + *> error.dat (不合线路/请求书) + *> audit-report.txt (审计报告: 处理统计) + *> Coverage: MT-N003, MT-N009, MT-N010, MT-R001 + *> line status check, billing cycle validation, + *> multi-line discount logic, address format validation + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. MatchingN1. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-MASTER ASSIGN TO 'master.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-MASTER-STATUS. + SELECT FILE-DETAIL ASSIGN TO 'detail.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-DETAIL-STATUS. + SELECT FILE-OUT ASSIGN TO 'output.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-OUT-STATUS. + SELECT FILE-ERR ASSIGN TO 'error.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-ERR-STATUS. + SELECT AUDIT-FILE ASSIGN TO 'audit-report.txt' + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-AUDIT-STATUS. + + DATA DIVISION. + FILE SECTION. + FD FILE-MASTER. + 01 MASTER-REC. + COPY "STD-REC.cpy". + FD FILE-DETAIL. + 01 DETAIL-REC. + COPY "STD-REC.cpy". + FD FILE-OUT. + 01 OUT-REC. + COPY "STD-REC.cpy". + FD FILE-ERR. + 01 ERR-REC. + 05 ERR-TYPE PIC X(10). + 05 ERR-KEY PIC X(10). + 05 ERR-LINE-AMOUNT PIC 9(10). + 05 ERR-FILLER PIC X(50). + FD AUDIT-FILE. + 01 AUDIT-REC PIC X(120). + + WORKING-STORAGE SECTION. + 01 WS-TELECOM-REC. + COPY "telecom/TEL-BILLING.cpy". + + *> File status fields + 01 WS-MASTER-STATUS PIC X(02). + 01 WS-DETAIL-STATUS PIC X(02). + 01 WS-OUT-STATUS PIC X(02). + 01 WS-ERR-STATUS PIC X(02). + 01 WS-AUDIT-STATUS PIC X(02). + + *> EOF flags + 01 WS-EOF-MASTER PIC X(01) VALUE 'N'. + 88 WS-EOF-MASTER-YES VALUE 'Y' FALSE 'N'. + 01 WS-EOF-DETAIL PIC X(01) VALUE 'N'. + 88 WS-EOF-DETAIL-YES VALUE 'Y' FALSE 'N'. + + *> Key areas + 01 WS-KEY-AREAS. + 05 WS-GROUP-KEY PIC X(10). + 05 WS-MASTER-KEY PIC X(10). + 05 WS-DETAIL-KEY PIC X(10). + 05 WS-PREV-MAST-KEY PIC X(10). + 05 WS-PREV-DETL-KEY PIC X(10). + + *> Match tracking + 01 WS-MATCH-FOUND PIC X(01) VALUE 'N'. + 88 WS-MATCH-FOUND-YES VALUE 'Y' FALSE 'N'. + + *> Counter accumulators + 01 WS-COUNTERS. + 05 WS-REC-COUNT PIC 9(05) VALUE ZERO. + 05 WS-MAST-READ-COUNT PIC 9(05) VALUE ZERO. + 05 WS-DETL-READ-COUNT PIC 9(05) VALUE ZERO. + 05 WS-UNMATCH-MAST-COUNT PIC 9(05) VALUE ZERO. + 05 WS-UNMATCH-DETL-COUNT PIC 9(05) VALUE ZERO. + 05 WS-ERROR-COUNT PIC 9(05) VALUE ZERO. + 05 WS-WARN-COUNT PIC 9(05) VALUE ZERO. + 05 WS-FATAL-COUNT PIC 9(05) VALUE ZERO. + 05 WS-SEQ-ERR-COUNT PIC 9(05) VALUE ZERO. + 05 WS-KEY-FMT-ERR-COUNT PIC 9(05) VALUE ZERO. + 05 WS-LINE-GROUP-COUNT PIC 9(05) VALUE ZERO. + 05 WS-MULTI-LINE-GROUPS PIC 9(05) VALUE ZERO. + + *> Hash totals for batch control + 01 WS-HASH-TOTALS. + 05 WS-INPUT-HASH-MAST PIC 9(15) VALUE ZERO. + 05 WS-INPUT-HASH-DETL PIC 9(15) VALUE ZERO. + 05 WS-OUTPUT-HASH PIC 9(15) VALUE ZERO. + 05 WS-ERROR-HASH PIC 9(15) VALUE ZERO. + 05 WS-HASH-DIFF PIC S9(15) VALUE ZERO. + + *> Date and timestamp areas + 01 WS-DATE-TIME. + 05 WS-PROC-DATE PIC 9(08). + 05 WS-PROC-TIME PIC 9(08). + 05 WS-TS-DATE PIC X(08). + 05 WS-TS-TIME PIC X(08). + + *> Validation accumulators + 01 WS-VALIDATION. + 05 WS-VALID-KEY-CHARS PIC X(36) VALUE + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789'. + 05 WS-KEY-CHAR PIC X. + 05 WS-CHAR-OK PIC X VALUE 'N'. + 88 WS-CHAR-IS-OK VALUE 'Y' FALSE 'N'. + 05 WS-IDX PIC 9(02). + 05 WS-KEY-INVALID-FLAG PIC X VALUE 'N'. + 88 WS-KEY-INVALID VALUE 'Y' FALSE 'N'. + + *> Amount accumulators + 01 WS-AMOUNT-AREAS. + 05 WS-MAST-AMT-NUM PIC 9(10). + 05 WS-DETL-AMT-NUM PIC 9(10). + 05 WS-LINE-AMOUNT PIC 9(10). + 05 WS-TOTAL-LINE-AMOUNT PIC 9(15) VALUE ZERO. + 05 WS-BILL-AMOUNT PIC 9(10). + 05 WS-OUT-AMT-NUM PIC 9(10). + 05 WS-DISCOUNT-AMOUNT PIC 9(10). + + *> Line group tracking for discount logic + 01 WS-LINE-GROUP-TRACKING. + 05 WS-LINES-IN-GROUP PIC 9(03) VALUE ZERO. + 05 WS-DISCOUNT-THRESHOLD PIC 9(03) VALUE 3. + 05 WS-DISCOUNT-PCT PIC 9(03) VALUE 5. + 05 WS-DISCOUNT-APPLIED PIC X VALUE 'N'. + 88 WS-DISCOUNT-ACTIVE VALUE 'Y' FALSE 'N'. + + *> Error message areas + 01 WS-ERR-MSG PIC X(60). + 01 WS-ERR-DETAIL PIC X(80). + + *> Program phase + 01 WS-PGM-PHASE PIC X(20). + + *> Line status validation + 01 WS-LINE-STATUS. + 05 WS-LINE-STATUS-CHAR PIC X. + 05 WS-LINE-ACTIVE-COUNT PIC 9(05) VALUE ZERO. + 05 WS-LINE-SUSPEND-COUNT PIC 9(05) VALUE ZERO. + 05 WS-LINE-TERM-COUNT PIC 9(05) VALUE ZERO. + + PROCEDURE DIVISION. + + *> ============================================================ + *> MAIN SECTION + *> ============================================================ + MAIN SECTION. + MB-PROCESS. + *> Initialize and open files + PERFORM 1000-INITIALIZE + PERFORM 2000-OPEN-FILES + + *> ORIGINAL: Read first records from both files + READ FILE-MASTER + AT END SET WS-EOF-MASTER-YES TO TRUE + NOT AT END + ADD 1 TO WS-MAST-READ-COUNT + MOVE STD-KEY OF MASTER-REC TO WS-MASTER-KEY + MOVE STD-KEY OF MASTER-REC TO WS-PREV-MAST-KEY + PERFORM 4000-VALIDATE-MASTER + END-READ. + READ FILE-DETAIL + AT END SET WS-EOF-DETAIL-YES TO TRUE + NOT AT END + ADD 1 TO WS-DETL-READ-COUNT + MOVE STD-KEY OF DETAIL-REC TO WS-DETAIL-KEY + MOVE STD-KEY OF DETAIL-REC TO WS-PREV-DETL-KEY + PERFORM 4100-VALIDATE-DETAIL + END-READ. + + *> ORIGINAL: Main loop — process one master group per iteration + PERFORM UNTIL WS-EOF-MASTER-YES + MOVE WS-MASTER-KEY TO WS-GROUP-KEY + MOVE 'N' TO WS-MATCH-FOUND + MOVE ZERO TO WS-LINES-IN-GROUP + + *> Advance detail until key >= group key (skip past details) + PERFORM UNTIL WS-EOF-DETAIL-YES + OR WS-DETAIL-KEY >= WS-GROUP-KEY + READ FILE-DETAIL + AT END SET WS-EOF-DETAIL-YES TO TRUE + NOT AT END + ADD 1 TO WS-DETL-READ-COUNT + MOVE STD-KEY OF DETAIL-REC TO WS-DETAIL-KEY + PERFORM 4300-CHECK-DETL-SEQUENCE + MOVE STD-KEY OF DETAIL-REC + TO WS-PREV-DETL-KEY + PERFORM 4100-VALIDATE-DETAIL + END-READ + END-PERFORM + + *> Check if current detail key matches this master group + IF NOT WS-EOF-DETAIL-YES + AND WS-DETAIL-KEY = WS-GROUP-KEY + SET WS-MATCH-FOUND-YES TO TRUE + END-IF + + *> Process all masters in this group (write output if match) + PERFORM UNTIL WS-EOF-MASTER-YES + OR WS-MASTER-KEY NOT = WS-GROUP-KEY + IF WS-MATCH-FOUND-YES + ADD 1 TO WS-LINES-IN-GROUP + MOVE MASTER-REC TO OUT-REC + WRITE OUT-REC + ADD 1 TO WS-REC-COUNT + PERFORM 5100-ACCUMULATE-OUTPUT + ELSE + ADD 1 TO WS-UNMATCH-MAST-COUNT + PERFORM 5300-WRITE-MAST-UNMATCH + END-IF + READ FILE-MASTER + AT END SET WS-EOF-MASTER-YES TO TRUE + NOT AT END + ADD 1 TO WS-MAST-READ-COUNT + MOVE STD-KEY OF MASTER-REC + TO WS-MASTER-KEY + PERFORM 4200-CHECK-MAST-SEQUENCE + MOVE STD-KEY OF MASTER-REC + TO WS-PREV-MAST-KEY + PERFORM 4000-VALIDATE-MASTER + END-READ + END-PERFORM + + *> Apply multi-line discount logic for this group + IF WS-MATCH-FOUND-YES + ADD 1 TO WS-LINE-GROUP-COUNT + IF WS-LINES-IN-GROUP >= WS-DISCOUNT-THRESHOLD + ADD 1 TO WS-MULTI-LINE-GROUPS + SET WS-DISCOUNT-ACTIVE TO TRUE + END-IF + END-IF + + *> If we used a match, advance detail to next record + IF WS-MATCH-FOUND-YES AND NOT WS-EOF-DETAIL-YES + READ FILE-DETAIL + AT END SET WS-EOF-DETAIL-YES TO TRUE + NOT AT END + ADD 1 TO WS-DETL-READ-COUNT + MOVE STD-KEY OF DETAIL-REC TO WS-DETAIL-KEY + MOVE STD-KEY OF DETAIL-REC + TO WS-PREV-DETL-KEY + PERFORM 4100-VALIDATE-DETAIL + END-READ + END-IF + END-PERFORM. + + *> Drain remaining unmatched details + PERFORM UNTIL WS-EOF-DETAIL-YES + ADD 1 TO WS-UNMATCH-DETL-COUNT + PERFORM 5400-WRITE-DETL-UNMATCH + READ FILE-DETAIL + AT END SET WS-EOF-DETAIL-YES TO TRUE + NOT AT END + ADD 1 TO WS-DETL-READ-COUNT + MOVE STD-KEY OF DETAIL-REC TO WS-DETAIL-KEY + END-READ + END-PERFORM + + *> Close files and write audit + CLOSE FILE-MASTER. + CLOSE FILE-DETAIL. + CLOSE FILE-OUT. + CLOSE FILE-ERR. + PERFORM 7000-AUDIT-TRAIL + PERFORM 8000-FINALIZE + + DISPLAY '03-matching-N-1: PASS' + STOP RUN. + . + + *> ============================================================ + *> 1000-INITIALIZE + *> ============================================================ + 1000-INITIALIZE. + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-PROC-DATE + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-PROC-TIME + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-TS-DATE + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-TS-TIME + + DISPLAY "============================================" + DISPLAY "03-MATCHING-N-1 Line-to-Bill Matching" + DISPLAY "Version V2.00" + DISPLAY "Run date: " WS-PROC-DATE " " WS-PROC-TIME + DISPLAY "============================================" + + INITIALIZE WS-COUNTERS + INITIALIZE WS-HASH-TOTALS + INITIALIZE WS-VALIDATION + INITIALIZE WS-AMOUNT-AREAS + INITIALIZE WS-LINE-GROUP-TRACKING + INITIALIZE WS-LINE-STATUS + . + + *> ============================================================ + *> 2000-OPEN-FILES + *> ============================================================ + 2000-OPEN-FILES. + MOVE '2000-OPEN-FILES' TO WS-PGM-PHASE + DISPLAY "[" WS-TS-DATE " " WS-TS-TIME + "] 03-MATCHING: Opening files..." + + OPEN INPUT FILE-MASTER. + IF WS-MASTER-STATUS NOT = '00' + STRING "FATAL: Cannot open master.dat, status " + WS-MASTER-STATUS + INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF. + + OPEN INPUT FILE-DETAIL. + IF WS-DETAIL-STATUS NOT = '00' + STRING "FATAL: Cannot open detail.dat, status " + WS-DETAIL-STATUS + INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF. + + OPEN OUTPUT FILE-OUT. + IF WS-OUT-STATUS NOT = '00' + STRING "FATAL: Cannot open output.dat, status " + WS-OUT-STATUS + INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF. + + OPEN OUTPUT FILE-ERR. + IF WS-ERR-STATUS NOT = '00' + STRING "FATAL: Cannot open error.dat, status " + WS-ERR-STATUS + INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF. + + OPEN OUTPUT AUDIT-FILE. + IF WS-AUDIT-STATUS NOT = '00' + DISPLAY "WARNING: Cannot open audit-report.txt, " + "status " WS-AUDIT-STATUS + ADD 1 TO WS-WARN-COUNT + END-IF. + + PERFORM 7010-WRITE-AUDIT-HEADER + . + + *> ============================================================ + *> 4000-VALIDATE-MASTER — Validate master (line) record + *> ============================================================ + 4000-VALIDATE-MASTER. + *> Check key format + MOVE 'N' TO WS-KEY-INVALID-FLAG + PERFORM VARYING WS-IDX FROM 1 BY 1 + UNTIL WS-IDX > 10 OR WS-KEY-INVALID + MOVE STD-KEY OF MASTER-REC(WS-IDX:1) TO WS-KEY-CHAR + MOVE 'N' TO WS-CHAR-OK + IF WS-KEY-CHAR >= 'A' AND WS-KEY-CHAR <= 'Z' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF WS-KEY-CHAR >= '0' AND WS-KEY-CHAR <= '9' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF WS-KEY-CHAR = '-' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF NOT WS-CHAR-IS-OK + MOVE 'Y' TO WS-KEY-INVALID-FLAG + END-IF + END-PERFORM + IF WS-KEY-INVALID + ADD 1 TO WS-KEY-FMT-ERR-COUNT + ADD 1 TO WS-WARN-COUNT + STRING "WARN: Invalid key format in master: " + STD-KEY OF MASTER-REC + INTO WS-ERR-MSG + END-STRING + PERFORM 6100-WARNING-ERROR + END-IF + + *> Accumulate input hash total (line amounts) + MOVE STD-DATA-3 OF MASTER-REC TO WS-MAST-AMT-NUM + ADD WS-MAST-AMT-NUM TO WS-INPUT-HASH-MAST + + *> Check line status + MOVE STD-DATA-1 OF MASTER-REC(1:1) TO WS-LINE-STATUS-CHAR + EVALUATE WS-LINE-STATUS-CHAR + WHEN 'A' + ADD 1 TO WS-LINE-ACTIVE-COUNT + WHEN 'S' + ADD 1 TO WS-LINE-SUSPEND-COUNT + ADD 1 TO WS-WARN-COUNT + STRING "WARN: Suspended line key=" + STD-KEY OF MASTER-REC + INTO WS-ERR-MSG + END-STRING + PERFORM 6100-WARNING-ERROR + WHEN 'T' + ADD 1 TO WS-LINE-TERM-COUNT + ADD 1 TO WS-WARN-COUNT + STRING "WARN: Terminated line key=" + STD-KEY OF MASTER-REC + INTO WS-ERR-MSG + END-STRING + PERFORM 6100-WARNING-ERROR + WHEN OTHER + ADD 1 TO WS-WARN-COUNT + STRING "WARN: Unknown line status key=" + STD-KEY OF MASTER-REC + INTO WS-ERR-MSG + END-STRING + PERFORM 6100-WARNING-ERROR + END-EVALUATE + . + + *> ============================================================ + *> 4100-VALIDATE-DETAIL — Validate detail (bill) record + *> ============================================================ + 4100-VALIDATE-DETAIL. + *> Check key format + MOVE 'N' TO WS-KEY-INVALID-FLAG + PERFORM VARYING WS-IDX FROM 1 BY 1 + UNTIL WS-IDX > 10 OR WS-KEY-INVALID + MOVE STD-KEY OF DETAIL-REC(WS-IDX:1) TO WS-KEY-CHAR + MOVE 'N' TO WS-CHAR-OK + IF WS-KEY-CHAR >= 'A' AND WS-KEY-CHAR <= 'Z' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF WS-KEY-CHAR >= '0' AND WS-KEY-CHAR <= '9' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF WS-KEY-CHAR = '-' + MOVE 'Y' TO WS-CHAR-OK + END-IF + IF NOT WS-CHAR-IS-OK + MOVE 'Y' TO WS-KEY-INVALID-FLAG + END-IF + END-PERFORM + IF WS-KEY-INVALID + ADD 1 TO WS-KEY-FMT-ERR-COUNT + ADD 1 TO WS-WARN-COUNT + STRING "WARN: Invalid key format in detail: " + STD-KEY OF DETAIL-REC + INTO WS-ERR-MSG + END-STRING + PERFORM 6100-WARNING-ERROR + END-IF + + *> Accumulate input hash from detail + MOVE STD-DATA-3 OF DETAIL-REC TO WS-DETL-AMT-NUM + ADD WS-DETL-AMT-NUM TO WS-INPUT-HASH-DETL + . + + *> ============================================================ + *> 4200-CHECK-MAST-SEQUENCE — Verify master keys ascending + *> ============================================================ + 4200-CHECK-MAST-SEQUENCE. + IF STD-KEY OF MASTER-REC < WS-PREV-MAST-KEY + ADD 1 TO WS-SEQ-ERR-COUNT + ADD 1 TO WS-ERROR-COUNT + DISPLAY "ERROR: Master seq violation: " + WS-PREV-MAST-KEY " > " + STD-KEY OF MASTER-REC + END-IF + . + + *> ============================================================ + *> 4300-CHECK-DETL-SEQUENCE — Verify detail keys ascending + *> ============================================================ + 4300-CHECK-DETL-SEQUENCE. + IF STD-KEY OF DETAIL-REC < WS-PREV-DETL-KEY + ADD 1 TO WS-SEQ-ERR-COUNT + ADD 1 TO WS-ERROR-COUNT + DISPLAY "ERROR: Detail seq violation: " + WS-PREV-DETL-KEY " > " + STD-KEY OF DETAIL-REC + END-IF + . + + *> ============================================================ + *> 5100-ACCUMULATE-OUTPUT + *> ============================================================ + 5100-ACCUMULATE-OUTPUT. + MOVE STD-DATA-3 OF OUT-REC TO WS-OUT-AMT-NUM + ADD WS-OUT-AMT-NUM TO WS-OUTPUT-HASH + . + + *> ============================================================ + *> 5300-WRITE-MAST-UNMATCH + *> ============================================================ + 5300-WRITE-MAST-UNMATCH. + MOVE 'MAST-UNMTC' TO ERR-TYPE + MOVE STD-KEY OF MASTER-REC TO ERR-KEY + MOVE STD-DATA-3 OF MASTER-REC TO WS-MAST-AMT-NUM + MOVE WS-MAST-AMT-NUM TO ERR-LINE-AMOUNT + WRITE ERR-REC + . + + *> ============================================================ + *> 5400-WRITE-DETL-UNMATCH + *> ============================================================ + 5400-WRITE-DETL-UNMATCH. + MOVE 'DETL-UNMTC' TO ERR-TYPE + MOVE STD-KEY OF DETAIL-REC TO ERR-KEY + MOVE STD-DATA-3 OF DETAIL-REC TO WS-DETL-AMT-NUM + MOVE WS-DETL-AMT-NUM TO ERR-LINE-AMOUNT + WRITE ERR-REC + . + + *> ============================================================ + *> 6000-FATAL-ERROR + *> ============================================================ + 6000-FATAL-ERROR. + ADD 1 TO WS-FATAL-COUNT + DISPLAY "FATAL [" WS-TS-DATE " " WS-TS-TIME "] " + WS-ERR-MSG + MOVE 16 TO RETURN-CODE + STOP RUN + . + + *> ============================================================ + *> 6100-WARNING-ERROR + *> ============================================================ + 6100-WARNING-ERROR. + ADD 1 TO WS-WARN-COUNT + DISPLAY "WARNING [" WS-TS-DATE " " WS-TS-TIME "] " + WS-ERR-MSG + . + + *> ============================================================ + *> 7000-AUDIT-TRAIL + *> ============================================================ + 7000-AUDIT-TRAIL. + MOVE '7000-AUDIT-TRAIL' TO WS-PGM-PHASE + DISPLAY "[" WS-TS-DATE " " WS-TS-TIME + "] 03-MATCHING: Writing audit report..." + + PERFORM 7020-WRITE-AUDIT-SUMMARY + PERFORM 7030-WRITE-HASH-DETAIL + PERFORM 7040-WRITE-ERROR-SUMMARY + PERFORM 7050-WRITE-DISCOUNT-INFO + PERFORM 7060-WRITE-AUDIT-FOOTER + + CLOSE AUDIT-FILE + . + + *> ============================================================ + *> 7010-WRITE-AUDIT-HEADER + *> ============================================================ + 7010-WRITE-AUDIT-HEADER. + MOVE SPACES TO AUDIT-REC + STRING "================================================" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "03-MATCHING-N-1 AUDIT REPORT" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "Program Version: V2.00" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "Run Date: " WS-PROC-DATE " Time: " WS-PROC-TIME + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "================================================" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 7020-WRITE-AUDIT-SUMMARY + *> ============================================================ + 7020-WRITE-AUDIT-SUMMARY. + MOVE SPACES TO AUDIT-REC + STRING "RECORD COUNT SUMMARY:" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Master (line) records : " WS-MAST-READ-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Detail (bill) records : " WS-DETL-READ-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Matched records (output) : " WS-REC-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Unmatched lines : " + WS-UNMATCH-MAST-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Unmatched bills : " + WS-UNMATCH-DETL-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Line groups processed : " + WS-LINE-GROUP-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Multi-line groups (3+) : " + WS-MULTI-LINE-GROUPS + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 7030-WRITE-HASH-DETAIL + *> ============================================================ + 7030-WRITE-HASH-DETAIL. + MOVE SPACES TO AUDIT-REC + STRING " " + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "HASH TOTAL RECONCILIATION:" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Input hash (lines) : " WS-INPUT-HASH-MAST + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Output hash : " WS-OUTPUT-HASH + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + ADD WS-OUTPUT-HASH TO WS-ERROR-HASH + GIVING WS-HASH-DIFF + SUBTRACT WS-INPUT-HASH-MAST FROM WS-HASH-DIFF + IF WS-HASH-DIFF NOT = 0 + MOVE SPACES TO AUDIT-REC + STRING " ** HASH MISMATCH ** Diff: " WS-HASH-DIFF + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + ELSE + MOVE SPACES TO AUDIT-REC + STRING " Hash total: VERIFIED" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + END-IF + . + + *> ============================================================ + *> 7040-WRITE-ERROR-SUMMARY + *> ============================================================ + 7040-WRITE-ERROR-SUMMARY. + MOVE SPACES TO AUDIT-REC + STRING " " + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "ERROR SUMMARY:" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Key format errors : " WS-KEY-FMT-ERR-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Sequence violations : " WS-SEQ-ERR-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Warnings : " WS-WARN-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Fatal errors : " WS-FATAL-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 7050-WRITE-DISCOUNT-INFO + *> ============================================================ + 7050-WRITE-DISCOUNT-INFO. + MOVE SPACES TO AUDIT-REC + STRING " " + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "LINE STATUS & DISCOUNT INFO:" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Active lines : " WS-LINE-ACTIVE-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Suspended lines : " WS-LINE-SUSPEND-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Terminated lines : " WS-LINE-TERM-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Discount threshold : " + WS-DISCOUNT-THRESHOLD " lines" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Groups eligible for discount: " + WS-MULTI-LINE-GROUPS + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 7060-WRITE-AUDIT-FOOTER + *> ============================================================ + 7060-WRITE-AUDIT-FOOTER. + MOVE SPACES TO AUDIT-REC + STRING " " + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "================================================" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "END OF AUDIT REPORT" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "Generated: " WS-PROC-DATE " " WS-PROC-TIME + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 8000-FINALIZE + *> ============================================================ + 8000-FINALIZE. + MOVE '8000-FINALIZE' TO WS-PGM-PHASE + DISPLAY "============================================" + DISPLAY "03-MATCHING-N-1 Processing Summary" + DISPLAY "============================================" + DISPLAY "Line records read : " WS-MAST-READ-COUNT + DISPLAY "Bill records read : " WS-DETL-READ-COUNT + DISPLAY "Matched (output) : " WS-REC-COUNT + DISPLAY "Unmatched lines : " WS-UNMATCH-MAST-COUNT + DISPLAY "Unmatched bills : " WS-UNMATCH-DETL-COUNT + DISPLAY "Line groups processed : " WS-LINE-GROUP-COUNT + DISPLAY "Multi-line groups (3+) : " WS-MULTI-LINE-GROUPS + DISPLAY "--------------------------------------------" + DISPLAY "Sequence violations : " WS-SEQ-ERR-COUNT + DISPLAY "Key format errors : " WS-KEY-FMT-ERR-COUNT + DISPLAY "Warnings : " WS-WARN-COUNT + DISPLAY "Fatal errors : " WS-FATAL-COUNT + DISPLAY "============================================" + + ADD WS-OUTPUT-HASH TO WS-ERROR-HASH + GIVING WS-HASH-DIFF + SUBTRACT WS-INPUT-HASH-MAST FROM WS-HASH-DIFF + IF WS-HASH-DIFF NOT = 0 + DISPLAY "WARNING: Hash total mismatch! Diff=" + WS-HASH-DIFF + ELSE + DISPLAY "Hash totals: VERIFIED" + END-IF + DISPLAY "Audit report written to audit-report.txt" + DISPLAY "============================================" + . + + END PROGRAM MatchingN1. diff --git a/benchmark-programs/03-matching-N-1/master.dat b/benchmark-programs/03-matching-N-1/master.dat new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/03-matching-N-1/master.dat @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/03-matching-N-1/output.dat b/benchmark-programs/03-matching-N-1/output.dat new file mode 100644 index 0000000..8fbecaa --- /dev/null +++ b/benchmark-programs/03-matching-N-1/output.dat @@ -0,0 +1 @@ + 0000000000000000000 000000000000000 \ No newline at end of file diff --git a/benchmark-programs/04-edit-getput/FILE-IN.DAT b/benchmark-programs/04-edit-getput/FILE-IN.DAT new file mode 100644 index 0000000..f9017b3 --- /dev/null +++ b/benchmark-programs/04-edit-getput/FILE-IN.DAT @@ -0,0 +1 @@ + 00000 \ No newline at end of file diff --git a/benchmark-programs/04-edit-getput/README.md b/benchmark-programs/04-edit-getput/README.md new file mode 100644 index 0000000..04dbc91 --- /dev/null +++ b/benchmark-programs/04-edit-getput/README.md @@ -0,0 +1,53 @@ +# 04-edit-getput: Edit/GetPut Pass-Through + +## 电信业务场景 + +请求书编辑输出。从客户/用量汇总文件读取记录，直接转记到输出文件。用于请求书的最终格式化输出。 + +## Description + +A minimal COBOL edit/getput program that reads records from FILE-IN and +writes them unchanged to FILE-OUT. No matching, no branching logic. + +## Record Layout + +| Field | Type | Length | Description | +|----------|----------|--------|--------------------| +| FIELD1 | PIC X | 10 | Record code | +| FIELD2 | PIC X | 20 | Description text | +| FIELD3 | PIC 9 | 05 | Numeric amount | + +Total record length: 35 bytes. + +## Files + +| File | Purpose | +|------------------|-----------------------------------| +| main-04-edit-getput.cbl | Main COBOL program (fixed format) | +| data-gen.sh | Generate sequential test data | +| run.sh | Compile, run, verify | +| README.md | This file | + +## Tests + +| Test Case | Description | +|-------------------|------------------------------------------| +| 1 record (min) | Verify program handles 1 record input | +| 5 records (std) | Verify standard multi-record processing | +| Output existence | Confirm FILE-OUT is created | +| Size match | Input and output file sizes identical | +| Record length | Each record is exactly 35 bytes | + +## Usage + +```bash +cd 04-edit-getput +bash data-gen.sh 1 # Generate 1 record (minimal test) +bash run.sh # Full test with 5 records +``` + +## Expected Behavior + +- All input records are written to output unchanged. +- File status is checked after OPEN, error messages on failure. +- Record count is displayed at end of processing. diff --git a/benchmark-programs/04-edit-getput/main-04-edit-getput.cbl b/benchmark-programs/04-edit-getput/main-04-edit-getput.cbl new file mode 100644 index 0000000..9740643 --- /dev/null +++ b/benchmark-programs/04-edit-getput/main-04-edit-getput.cbl @@ -0,0 +1,805 @@ + *> ============================================================ + *> 04-edit-getput : 请求书编辑输出 (Invoice GETPUT) + *> Input : file-in.dat (客户/用量记录) + *> Output: file-out.dat (格式化的请求书输出) + *> file-out-detail.dat (详细格式) + *> file-out-summary.dat (汇总格式) + *> audit-trail.dat (审计日志) + *> Coverage: COM-N001~N006 + *> field editing, audit trail, hash totals + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. EditGetPut. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN ASSIGN TO 'file-in.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS 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. + *> Additional output files for telecom billing + SELECT FILE-OUT-DTL ASSIGN TO 'file-out-detail.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FILE-DTL-STATUS. + SELECT FILE-OUT-SUM ASSIGN TO 'file-out-summary.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FILE-SUM-STATUS. + SELECT FILE-OUT-AUDIT ASSIGN TO 'audit-trail.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FILE-AUD-STATUS. + *> + DATA DIVISION. + FILE SECTION. + FD FILE-IN. + 01 IN-REC. + 05 IN-FIELD1 PIC X(10). + 05 IN-FIELD2 PIC X(20). + 05 IN-FIELD3 PIC 9(05). + *> + FD FILE-OUT. + 01 OUT-REC. + 05 OUT-FIELD1 PIC X(10). + 05 OUT-FIELD2 PIC X(20). + 05 OUT-FIELD3 PIC 9(05). + *> + FD FILE-OUT-DTL. + 01 OUT-DTL-REC PIC X(120). + *> + FD FILE-OUT-SUM. + 01 OUT-SUM-REC PIC X(120). + *> + FD FILE-OUT-AUDIT. + 01 OUT-AUDIT-REC PIC X(120). + *> + WORKING-STORAGE SECTION. + *> === PRESERVED ORIGINAL ITEMS === + 01 WS-TELECOM-REC. + COPY "telecom/TEL-INVOICE.cpy". + 01 WS-FILE-IN-STATUS PIC X(02). + 01 WS-FILE-OUT-STATUS PIC X(02). + 01 WS-EOF PIC X(01) VALUE 'N'. + 88 WS-EOF-YES VALUE 'Y' FALSE 'N'. + 01 WS-REC-COUNT PIC 9(05) VALUE ZERO. + 01 WS-INVOICE-REC. + COPY "telecom/TEL-INVOICE.cpy". + *> === NEW ITEMS === + *> Timestamp for tracing + 01 WS-TIMESTAMP. + 05 WS-TS-YEAR PIC 9(04). + 05 WS-TS-MONTH PIC 9(02). + 05 WS-TS-DAY PIC 9(02). + 05 WS-TS-HOUR PIC 9(02). + 05 WS-TS-MINUTE PIC 9(02). + 05 WS-TS-SECOND PIC 9(02). + 05 WS-TS-MS PIC 9(02). + 01 WS-TIMESTAMP-STR PIC X(26). + 01 WS-TRACE-MSG PIC X(80). + *> Format control + 01 WS-FORMAT-MODE PIC X(01) VALUE 'D'. + 88 WS-FORMAT-SHORT VALUE 'S'. + 88 WS-FORMAT-DETAIL VALUE 'D'. + 88 WS-FORMAT-SUMMARY VALUE 'M'. + 01 WS-CONDENSED-MODE PIC X(01) VALUE 'N'. + 88 WS-CONDENSED-YES VALUE 'Y' FALSE 'N'. + 01 WS-FMT-CONFIG PIC X(02) VALUE 'BH'. + 88 WS-FMT-HEADER-ONLY VALUE 'H '. + 88 WS-FMT-FOOTER-ONLY VALUE 'F '. + 88 WS-FMT-BOTH VALUE 'BH'. + *> Page control + 01 WS-PAGE-COUNT PIC 9(05) VALUE ZERO. + 01 WS-LINE-COUNT PIC 9(03) VALUE ZERO. + 01 WS-LINES-PER-PAGE PIC 9(03) VALUE 50. + 01 WS-PAGE-MAX PIC 9(03) VALUE 55. + 01 WS-PAGE-BREAK-NEEDED PIC X(01) VALUE 'N'. + 88 WS-PAGE-BREAK VALUE 'Y' FALSE 'N'. + *> Heading lines + 01 WS-HDG-1 PIC X(120). + 01 WS-HDG-2 PIC X(120). + 01 WS-HDG-3 PIC X(120). + 01 WS-HDG-4 PIC X(120). + 01 WS-HDG-5 PIC X(120). + *> Footing lines + 01 WS-FTG-1 PIC X(120). + 01 WS-FTG-2 PIC X(120). + *> Separator lines + 01 WS-SEP-STARS PIC X(120) VALUE ALL '*'. + 01 WS-SEP-DASHES PIC X(120) VALUE ALL '-'. + 01 WS-SEP-EQUALS PIC X(120) VALUE ALL '='. + *> Detail and summary lines + 01 WS-DETAIL-LINE PIC X(120). + 01 WS-SUMMARY-LINE PIC X(120). + *> Telecom billing fields + 01 WS-BILL-DATA. + 05 WS-BD-CUST-ID PIC X(10). + 05 WS-BD-CUST-NAME PIC X(30). + 05 WS-BD-PLAN-CODE PIC X(02). + 05 WS-BD-USAGE PIC 9(09). + 05 WS-BD-BASE-FEE PIC 9(07). + 05 WS-BD-USAGE-FEE PIC 9(07). + 05 WS-BD-TAX PIC 9(07). + 05 WS-BD-TOTAL PIC 9(09). + 05 WS-BD-STATUS-DESC PIC X(15). + *> Edited numeric fields — various PIC patterns + 01 WS-ED-AMOUNT PIC Z(9)9. + 01 WS-ED-TOTAL PIC Z(11)9. + 01 WS-ED-COUNT PIC Z(9)9. + 01 WS-ED-PAGE PIC Z(9)9. + 01 WS-ED-USAGE PIC Z(9)9. + 01 WS-ED-FEE PIC Z(9)9. + 01 WS-ED-TAX PIC Z(9)9. + *> Additional editing patterns per requirement + 01 WS-ED-CHECK-PROT PIC *(8)9. + 01 WS-ED-SIGNED PIC +Z(8)9. + 01 WS-ED-CURRENCY PIC $$$$$$$$9.99. + 01 WS-ED-BLANK-ZERO PIC Z(9)9 BLANK WHEN ZERO. + 01 WS-ED-FLOAT-DOLLAR PIC $$$$,$$$,$$9. + *> Hash totals + 01 WS-HASH-REC-COUNT PIC 9(09) VALUE ZERO. + 01 WS-HASH-AMT PIC 9(15) VALUE ZERO. + 01 WS-HASH-CHECKSUM PIC 9(15) VALUE ZERO. + 01 WS-HASH-AMT-REM PIC 9(15). + *> Accumulators by invoice status + 01 WS-ACC-STATUS-0 PIC 9(12) VALUE ZERO. + 01 WS-ACC-STATUS-1 PIC 9(12) VALUE ZERO. + 01 WS-ACC-STATUS-2 PIC 9(12) VALUE ZERO. + *> Error handling + 01 WS-ERR-SEVERITY PIC 9(01). + 88 WS-ERR-INFO VALUE 0. + 88 WS-ERR-WARN VALUE 1. + 88 WS-ERR-ERROR VALUE 2. + 88 WS-ERR-FATAL VALUE 3. + 01 WS-ERR-MSG PIC X(60). + 01 WS-ERR-COUNT PIC 9(04) VALUE ZERO. + 01 WS-WARN-COUNT PIC 9(04) VALUE ZERO. + *> Additional file statuses + 01 WS-FILE-DTL-STATUS PIC X(02). + 01 WS-FILE-SUM-STATUS PIC X(02). + 01 WS-FILE-AUD-STATUS PIC X(02). + *> Audit fields + 01 WS-AUDIT-ENTRIES PIC 9(04) VALUE ZERO. + 01 WS-AUDIT-LINE PIC X(120). + *> Report date/time + 01 WS-RPT-DATE PIC X(10). + 01 WS-RPT-TIME PIC X(08). + *> Second-pass record counter + 01 WS-PASS2-COUNT PIC 9(05) VALUE ZERO. + *> Configuration constants + 01 WS-CONFIG-LPP PIC 9(03) VALUE 50. + 01 WS-CONFIG-MAXERR PIC 9(04) VALUE 100. + *> Plan description table + 01 WS-PLAN-TABLE. + 05 FILLER PIC X(12) VALUE '01BASIC '. + 05 FILLER PIC X(12) VALUE '02PREMIUM '. + 05 FILLER PIC X(12) VALUE '03BUSINESS '. + 05 FILLER PIC X(12) VALUE '04ENTERPRISE'. + 05 FILLER PIC X(12) VALUE '99UNKNOWN '. + 01 WS-PLAN-TAB-R REDEFINES WS-PLAN-TABLE. + 05 WS-PLAN-ENT OCCURS 5 TIMES. + 10 WS-PLAN-CODE PIC X(02). + 10 WS-PLAN-DESC PIC X(10). + 01 WS-PLAN-IDX PIC 9(01). + 01 WS-PLAN-FOUND PIC X(01). + *> Record buffer for second pass + 01 WS-BUFFER-IN. + 05 WS-BUF-ID PIC X(10). + 05 WS-BUF-CUST PIC X(10). + 05 WS-BUF-DATA PIC X(10). + 05 WS-BUF-AMOUNT PIC 9(05). + *> ============================================================ + PROCEDURE DIVISION. + *> + MAIN SECTION. + MB-PROCESS. + *> + PERFORM 1000-INIT + PERFORM 3000-PROCESS + PERFORM 4000-REPORT + PERFORM 5000-AUDIT + PERFORM 6000-ERROR-HANDLE + PERFORM 9000-EXIT + STOP RUN. + *> + 1000-INIT SECTION. + *> + DISPLAY 'EditGetPut: Initializing program...'. + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP. + STRING WS-TS-YEAR '-' WS-TS-MONTH '-' + WS-TS-DAY ' ' WS-TS-HOUR ':' + WS-TS-MINUTE ':' WS-TS-SECOND + INTO WS-TIMESTAMP-STR. + DISPLAY 'EditGetPut: Start time=' WS-TIMESTAMP-STR. + *> + MOVE WS-TS-YEAR TO WS-RPT-DATE(1:4). + MOVE '-' TO WS-RPT-DATE(5:1). + MOVE WS-TS-MONTH TO WS-RPT-DATE(6:2). + MOVE '-' TO WS-RPT-DATE(8:1). + MOVE WS-TS-DAY TO WS-RPT-DATE(9:2). + STRING WS-TS-HOUR ':' WS-TS-MINUTE ':' + WS-TS-SECOND INTO WS-RPT-TIME. + *> + MOVE SPACES TO WS-HDG-1 WS-HDG-2 WS-HDG-3 + WS-HDG-4 WS-HDG-5. + MOVE SPACES TO WS-FTG-1 WS-FTG-2. + *> + MOVE ZERO TO WS-PAGE-COUNT WS-LINE-COUNT + WS-HASH-REC-COUNT WS-HASH-AMT + WS-HASH-CHECKSUM WS-ERR-COUNT + WS-WARN-COUNT WS-PASS2-COUNT + WS-ACC-STATUS-0 WS-ACC-STATUS-1 + WS-ACC-STATUS-2 WS-AUDIT-ENTRIES. + *> + DISPLAY 'EditGetPut: INIT complete. Format=' WS-FORMAT-MODE + ' LPP=' WS-CONFIG-LPP + ' MaxErr=' WS-CONFIG-MAXERR. + *> + 2000-OPEN-FILES SECTION. + *> + DISPLAY 'EditGetPut: Opening files...'. + *> + *> === PRESERVED ORIGINAL OPEN + STATUS CHECK === + OPEN INPUT FILE-IN. + IF WS-FILE-IN-STATUS NOT = '00' + DISPLAY 'ERROR: Cannot open FILE-IN, status: ' + WS-FILE-IN-STATUS + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + *> + OPEN OUTPUT FILE-OUT. + IF WS-FILE-OUT-STATUS NOT = '00' + DISPLAY 'ERROR: Cannot open FILE-OUT, status: ' + WS-FILE-OUT-STATUS + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + *> === END PRESERVED ORIGINAL OPEN === + *> + *> Additional output files + OPEN OUTPUT FILE-OUT-DTL. + IF WS-FILE-DTL-STATUS NOT = '00' + MOVE 1 TO WS-ERR-SEVERITY + STRING 'WARN: FILE-OUT-DTL open status=' + WS-FILE-DTL-STATUS INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + ADD 1 TO WS-WARN-COUNT + END-IF. + *> + OPEN OUTPUT FILE-OUT-SUM. + IF WS-FILE-SUM-STATUS NOT = '00' + MOVE 1 TO WS-ERR-SEVERITY + STRING 'WARN: FILE-OUT-SUM open status=' + WS-FILE-SUM-STATUS INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + ADD 1 TO WS-WARN-COUNT + END-IF. + *> + OPEN EXTEND FILE-OUT-AUDIT. + IF WS-FILE-AUD-STATUS NOT = '00' + OPEN OUTPUT FILE-OUT-AUDIT + IF WS-FILE-AUD-STATUS NOT = '00' + MOVE 1 TO WS-ERR-SEVERITY + STRING 'WARN: FILE-OUT-AUDIT open status=' + WS-FILE-AUD-STATUS INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + ADD 1 TO WS-WARN-COUNT + END-IF + END-IF. + *> + DISPLAY 'EditGetPut: Files opened.' + ' IN=' WS-FILE-IN-STATUS + ' OUT=' WS-FILE-OUT-STATUS + ' DTL=' WS-FILE-DTL-STATUS. + *> + 3000-PROCESS SECTION. + *> + DISPLAY 'EditGetPut: PASS-1 — Original copy loop...'. + *> + *> ============================================================ + *> === PRESERVED ORIGINAL PROCESSING LOOP (exact) === + *> ============================================================ + PERFORM UNTIL WS-EOF-YES + READ FILE-IN + AT END + SET WS-EOF-YES TO TRUE + NOT AT END + MOVE IN-REC TO OUT-REC + WRITE OUT-REC + ADD 1 TO WS-REC-COUNT + END-READ + END-PERFORM. + *> === END PRESERVED ORIGINAL LOOP === + *> + DISPLAY 'EditGetPut: PASS-1 complete.' + ' Records copied=' WS-REC-COUNT. + *> + *> Reopen FILE-IN for PASS-2 detailed processing. + *> Close FILE-IN first (original close moved to 9000-EXIT). + CLOSE FILE-IN. + IF WS-FILE-IN-STATUS NOT = '00' + MOVE 3 TO WS-ERR-SEVERITY + STRING 'ERROR: Close FILE-IN status=' + WS-FILE-IN-STATUS INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + PERFORM 6000-ERROR-HANDLE + END-IF. + *> + MOVE 'N' TO WS-EOF. + OPEN INPUT FILE-IN. + IF WS-FILE-IN-STATUS NOT = '00' + MOVE 3 TO WS-ERR-SEVERITY + STRING 'ERROR: Reopen FILE-IN status=' + WS-FILE-IN-STATUS INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + PERFORM 6000-ERROR-HANDLE + END-IF. + *> + DISPLAY 'EditGetPut: PASS-2 — Telecom billing detail...'. + *> + PERFORM UNTIL WS-EOF-YES + READ FILE-IN + AT END + SET WS-EOF-YES TO TRUE + NOT AT END + ADD 1 TO WS-PASS2-COUNT + PERFORM 3100-VALIDATE + PERFORM 3200-CALCULATE + PERFORM 3300-FORMAT-OUTPUT + PERFORM 3400-WRITE-OUTPUT + END-READ + END-PERFORM. + *> + CLOSE FILE-IN. + IF WS-FILE-IN-STATUS NOT = '00' + MOVE 2 TO WS-ERR-SEVERITY + STRING 'WARN: Close FILE-IN after PASS-2 status=' + WS-FILE-IN-STATUS INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + ADD 1 TO WS-WARN-COUNT + END-IF. + *> + DISPLAY 'EditGetPut: PASS-2 complete.' + ' Detail processed=' WS-PASS2-COUNT. + *> + 3100-VALIDATE SECTION. + *> + *> Map 35-byte input fields to telecom invoice structure + MOVE IN-FIELD1 TO INV-ID OF WS-INVOICE-REC. + MOVE IN-FIELD2(1:10) TO INV-CUST-ID OF WS-INVOICE-REC. + MOVE IN-FIELD3 TO INV-AMOUNT OF WS-INVOICE-REC. + MOVE '1' TO INV-STATUS OF WS-INVOICE-REC. + *> + *> Validate invoice ID + IF INV-ID OF WS-INVOICE-REC = SPACES + MOVE 1 TO WS-ERR-SEVERITY + STRING 'WARN: Empty invoice ID at PASS-2 record ' + WS-PASS2-COUNT INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + ADD 1 TO WS-ERR-COUNT + END-IF. + IF INV-ID OF WS-INVOICE-REC = LOW-VALUES + MOVE 1 TO WS-ERR-SEVERITY + STRING 'WARN: Low-values invoice ID at record ' + WS-PASS2-COUNT INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + ADD 1 TO WS-ERR-COUNT + END-IF. + *> + *> Validate customer ID + IF INV-CUST-ID OF WS-INVOICE-REC = SPACES + MOVE 1 TO WS-ERR-SEVERITY + STRING 'WARN: Empty cust ID for ' + INV-ID OF WS-INVOICE-REC INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + ADD 1 TO WS-WARN-COUNT + END-IF. + *> + *> Validate invoice amount + IF INV-AMOUNT OF WS-INVOICE-REC = ZERO + MOVE 1 TO WS-ERR-SEVERITY + STRING 'INFO: Zero amount invoice ' + INV-ID OF WS-INVOICE-REC INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + ADD 1 TO WS-ERR-COUNT + END-IF. + IF INV-AMOUNT OF WS-INVOICE-REC > 999999999 + MOVE 2 TO WS-ERR-SEVERITY + STRING 'WARN: Overlimit amount ' + INV-ID OF WS-INVOICE-REC INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + ADD 1 TO WS-WARN-COUNT + END-IF. + *> + *> Validate reserved field content + IF INV-RESERVED OF WS-INVOICE-REC NOT = SPACES + MOVE 1 TO WS-ERR-SEVERITY + STRING 'INFO: Non-blank reserved at ' + INV-ID OF WS-INVOICE-REC INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + END-IF. + *> + 3200-CALCULATE SECTION. + *> + *> Accumulate hash totals + ADD 1 TO WS-HASH-REC-COUNT. + ADD INV-AMOUNT OF WS-INVOICE-REC TO WS-HASH-AMT. + COMPUTE WS-HASH-CHECKSUM = + WS-HASH-CHECKSUM + INV-AMOUNT OF WS-INVOICE-REC. + DIVIDE WS-HASH-CHECKSUM BY 1000000 + GIVING WS-HASH-AMT-REM. + *> + *> Accumulate by invoice status + EVALUATE INV-STATUS OF WS-INVOICE-REC + WHEN '0' + ADD INV-AMOUNT OF WS-INVOICE-REC + TO WS-ACC-STATUS-0 + WHEN '1' + ADD INV-AMOUNT OF WS-INVOICE-REC + TO WS-ACC-STATUS-1 + WHEN '2' + ADD INV-AMOUNT OF WS-INVOICE-REC + TO WS-ACC-STATUS-2 + WHEN OTHER + CONTINUE + END-EVALUATE. + *> + *> Telecom billing fee calculation + DIVIDE INV-AMOUNT OF WS-INVOICE-REC BY 100 + GIVING WS-BD-TOTAL. + COMPUTE WS-BD-BASE-FEE = WS-BD-TOTAL * 60 / 100. + COMPUTE WS-BD-USAGE-FEE = WS-BD-TOTAL - WS-BD-BASE-FEE. + COMPUTE WS-BD-TAX = WS-BD-TOTAL * 10 / 100. + COMPUTE WS-BD-USAGE = WS-BD-TOTAL * 2. + *> + *> Look up plan code from invoice ID prefix + MOVE 'N' TO WS-PLAN-FOUND. + MOVE 1 TO WS-PLAN-IDX. + PERFORM VARYING WS-PLAN-IDX FROM 1 BY 1 + UNTIL WS-PLAN-IDX > 5 OR WS-PLAN-FOUND = 'Y' + IF WS-PLAN-CODE(WS-PLAN-IDX) + = INV-ID OF WS-INVOICE-REC(1:2) + MOVE WS-PLAN-DESC(WS-PLAN-IDX) + TO WS-BD-PLAN-CODE + MOVE 'Y' TO WS-PLAN-FOUND + END-IF + END-PERFORM. + IF WS-PLAN-FOUND NOT = 'Y' + MOVE '99' TO WS-BD-PLAN-CODE + END-IF. + *> + *> Set status description + EVALUATE INV-STATUS OF WS-INVOICE-REC + WHEN '0' MOVE 'UNISSUED ' TO WS-BD-STATUS-DESC + WHEN '1' MOVE 'ISSUED ' TO WS-BD-STATUS-DESC + WHEN '2' MOVE 'PAID ' TO WS-BD-STATUS-DESC + WHEN OTHER MOVE 'UNKNOWN ' TO WS-BD-STATUS-DESC + END-EVALUATE. + *> + 3300-FORMAT-OUTPUT SECTION. + *> + *> Edit numeric fields with various PIC patterns + MOVE INV-AMOUNT OF WS-INVOICE-REC TO WS-ED-AMOUNT. + MOVE WS-HASH-AMT TO WS-ED-TOTAL. + MOVE WS-HASH-REC-COUNT TO WS-ED-COUNT. + MOVE WS-BD-USAGE TO WS-ED-USAGE. + MOVE WS-BD-BASE-FEE TO WS-ED-FEE. + MOVE WS-BD-TAX TO WS-ED-TAX. + *> Additional editing patterns + MOVE INV-AMOUNT OF WS-INVOICE-REC TO WS-ED-CHECK-PROT. + MOVE INV-AMOUNT OF WS-INVOICE-REC TO WS-ED-SIGNED. + MOVE INV-AMOUNT OF WS-INVOICE-REC TO WS-ED-CURRENCY. + MOVE INV-AMOUNT OF WS-INVOICE-REC TO WS-ED-BLANK-ZERO. + MOVE INV-AMOUNT OF WS-INVOICE-REC TO WS-ED-FLOAT-DOLLAR. + *> + *> Build detail line (DETAIL format) + IF WS-FORMAT-DETAIL + STRING INV-ID OF WS-INVOICE-REC ' ' + INV-CUST-ID OF WS-INVOICE-REC ' ' + INV-MONTH OF WS-INVOICE-REC ' ' + WS-ED-AMOUNT ' ' + INV-STATUS OF WS-INVOICE-REC ' ' + WS-BD-STATUS-DESC + DELIMITED BY SIZE INTO WS-DETAIL-LINE + PERFORM 3500-WRITE-DETAIL + END-IF. + *> + *> Build condensed line (SHORT or CONDENSED) + IF WS-FORMAT-SHORT + STRING INV-ID OF WS-INVOICE-REC ' ' + WS-ED-AMOUNT ' ' + INV-STATUS OF WS-INVOICE-REC + DELIMITED BY SIZE INTO WS-DETAIL-LINE + PERFORM 3500-WRITE-DETAIL + END-IF. + IF WS-CONDENSED-YES + STRING INV-ID OF WS-INVOICE-REC ' ' + WS-ED-CHECK-PROT ' ' + INV-STATUS OF WS-INVOICE-REC + DELIMITED BY SIZE INTO WS-DETAIL-LINE + PERFORM 3500-WRITE-DETAIL + END-IF. + *> + *> Accumulate for summary (SUMMARY mode) + IF WS-FORMAT-SUMMARY + CONTINUE + END-IF. + *> + *> Trace formatted output with timestamp + STRING WS-TS-HOUR ':' WS-TS-MINUTE ':' + WS-TS-SECOND ' FMT ' + INV-ID OF WS-INVOICE-REC + INTO WS-TRACE-MSG. + DISPLAY WS-TRACE-MSG. + *> + 3400-WRITE-OUTPUT SECTION. + *> + *> Write to primary output file if detail mode + IF WS-FORMAT-DETAIL + MOVE IN-REC TO OUT-REC + WRITE OUT-REC + IF WS-FILE-OUT-STATUS NOT = '00' + MOVE 2 TO WS-ERR-SEVERITY + STRING 'ERROR: OUT write failed status=' + WS-FILE-OUT-STATUS INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + ADD 1 TO WS-ERR-COUNT + END-IF + END-IF. + *> + 3500-WRITE-DETAIL SECTION. + *> + *> Page break control: check line count + ADD 1 TO WS-LINE-COUNT. + IF WS-LINE-COUNT > WS-LINES-PER-PAGE + PERFORM 4100-PAGE-HEADING + MOVE 1 TO WS-LINE-COUNT + END-IF. + *> + *> Write detail record with status check + WRITE OUT-DTL-REC FROM WS-DETAIL-LINE. + IF WS-FILE-DTL-STATUS NOT = '00' + MOVE 2 TO WS-ERR-SEVERITY + STRING 'ERROR: DTL write failed status=' + WS-FILE-DTL-STATUS INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + ADD 1 TO WS-ERR-COUNT + END-IF. + *> + 4000-REPORT SECTION. + *> + DISPLAY 'EditGetPut: Generating output report...'. + PERFORM 4100-PAGE-HEADING. + PERFORM 4200-WRITE-REPORT-BODY. + PERFORM 4300-PAGE-FOOTING. + DISPLAY 'EditGetPut: Report generated, pages=' + WS-PAGE-COUNT. + *> + 4100-PAGE-HEADING SECTION. + *> + ADD 1 TO WS-PAGE-COUNT. + MOVE WS-PAGE-COUNT TO WS-ED-PAGE. + *> + *> Build heading lines + ' PAGE: ' WS-ED-PAGE + INTO WS-HDG-1. + *> + STRING 'DATE: ' WS-RPT-DATE + ' TIME: ' WS-RPT-TIME + INTO WS-HDG-2. + *> + STRING 'INVOICE ID CUSTOMER ID MONTH ' + 'AMOUNT ST DESCRIPTION' + INTO WS-HDG-3. + *> + *> Write headings to detail file + WRITE OUT-DTL-REC FROM WS-HDG-1. + WRITE OUT-DTL-REC FROM WS-HDG-2. + WRITE OUT-DTL-REC FROM WS-HDG-3. + WRITE OUT-DTL-REC FROM WS-SEP-STARS. + *> + *> Write headings to summary file + WRITE OUT-SUM-REC FROM WS-HDG-1. + WRITE OUT-SUM-REC FROM WS-HDG-2. + WRITE OUT-SUM-REC FROM WS-SEP-STARS. + *> + IF WS-FILE-DTL-STATUS NOT = '00' + MOVE 2 TO WS-ERR-SEVERITY + STRING 'ERROR: Heading write failed status=' + WS-FILE-DTL-STATUS INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + ADD 1 TO WS-ERR-COUNT + END-IF. + *> + 4200-WRITE-REPORT-BODY SECTION. + *> + *> Grand total summary + MOVE WS-HASH-AMT TO WS-ED-TOTAL. + MOVE WS-HASH-REC-COUNT TO WS-ED-COUNT. + *> + STRING '=== GRAND TOTAL === Records: ' WS-ED-COUNT + ' Amount: ' WS-ED-TOTAL + INTO WS-SUMMARY-LINE. + WRITE OUT-SUM-REC FROM WS-SUMMARY-LINE. + WRITE OUT-DTL-REC FROM WS-SUMMARY-LINE. + *> + *> Status breakdown + MOVE WS-ACC-STATUS-0 TO WS-ED-TOTAL. + STRING 'STATUS 0 (UNISSUED) Amount: ' WS-ED-TOTAL + INTO WS-SUMMARY-LINE. + WRITE OUT-SUM-REC FROM WS-SUMMARY-LINE. + WRITE OUT-DTL-REC FROM WS-SUMMARY-LINE. + *> + MOVE WS-ACC-STATUS-1 TO WS-ED-TOTAL. + STRING 'STATUS 1 (ISSUED) Amount: ' WS-ED-TOTAL + INTO WS-SUMMARY-LINE. + WRITE OUT-SUM-REC FROM WS-SUMMARY-LINE. + WRITE OUT-DTL-REC FROM WS-SUMMARY-LINE. + *> + MOVE WS-ACC-STATUS-2 TO WS-ED-TOTAL. + STRING 'STATUS 2 (PAID) Amount: ' WS-ED-TOTAL + INTO WS-SUMMARY-LINE. + WRITE OUT-SUM-REC FROM WS-SUMMARY-LINE. + WRITE OUT-DTL-REC FROM WS-SUMMARY-LINE. + *> + *> Hash checksum summary + MOVE WS-HASH-CHECKSUM TO WS-ED-TOTAL. + STRING 'HASH CHECKSUM: ' WS-ED-TOTAL + INTO WS-SUMMARY-LINE. + WRITE OUT-SUM-REC FROM WS-SUMMARY-LINE. + *> + *> Editing pattern demonstration + MOVE WS-HASH-AMT TO WS-ED-FLOAT-DOLLAR. + STRING 'FLOAT DOLLAR FORMAT: ' WS-ED-FLOAT-DOLLAR + INTO WS-SUMMARY-LINE. + WRITE OUT-SUM-REC FROM WS-SUMMARY-LINE. + WRITE OUT-DTL-REC FROM WS-SUMMARY-LINE. + *> + *> Error and warning counts + MOVE WS-ERR-COUNT TO WS-ED-COUNT. + MOVE WS-WARN-COUNT TO WS-ED-COUNT. + STRING 'ERRORS: ' WS-ERR-COUNT + ' WARNINGS: ' WS-WARN-COUNT + INTO WS-SUMMARY-LINE. + WRITE OUT-SUM-REC FROM WS-SUMMARY-LINE. + WRITE OUT-DTL-REC FROM WS-SUMMARY-LINE. + *> + WRITE OUT-SUM-REC FROM WS-SEP-DASHES. + *> + 4300-PAGE-FOOTING SECTION. + *> + MOVE WS-HASH-REC-COUNT TO WS-ED-COUNT. + MOVE WS-HASH-AMT TO WS-ED-TOTAL. + MOVE WS-PAGE-COUNT TO WS-ED-PAGE. + *> + WRITE OUT-DTL-REC FROM WS-SEP-DASHES. + *> + STRING '*** END OF PAGE ' WS-ED-PAGE + ' *** RECORDS: ' WS-ED-COUNT + ' TOTAL: ' WS-ED-TOTAL + INTO WS-FTG-1. + WRITE OUT-DTL-REC FROM WS-FTG-1. + WRITE OUT-DTL-REC FROM WS-SEP-EQUALS. + *> + *> Write footing to summary file as well + WRITE OUT-SUM-REC FROM WS-FTG-1. + WRITE OUT-SUM-REC FROM WS-SEP-EQUALS. + *> + 5000-AUDIT SECTION. + *> + DISPLAY 'EditGetPut: Writing audit trail...'. + *> + MOVE WS-HASH-REC-COUNT TO WS-ED-COUNT. + MOVE WS-HASH-AMT TO WS-ED-TOTAL. + MOVE WS-PAGE-COUNT TO WS-ED-PAGE. + *> + *> Build and write audit record + STRING 'AUDIT:' WS-TIMESTAMP-STR + ' PROG=EditGetPut' + ' RECS=' WS-ED-COUNT + ' AMT=' WS-ED-TOTAL + ' PGS=' WS-ED-PAGE + ' ERRS=' WS-ERR-COUNT + ' WARNS=' WS-WARN-COUNT + INTO OUT-AUDIT-REC. + WRITE OUT-AUDIT-REC. + IF WS-FILE-AUD-STATUS NOT = '00' + DISPLAY 'ERROR: Audit write failed, status: ' + WS-FILE-AUD-STATUS + ADD 1 TO WS-ERR-COUNT + END-IF. + *> + *> Second audit line — format configuration + STRING 'AUDIT:FORMAT=' WS-FORMAT-MODE + ' COND=' WS-CONDENSED-MODE + ' CFG=' WS-FMT-CONFIG + INTO OUT-AUDIT-REC. + WRITE OUT-AUDIT-REC. + *> + *> Third audit line — hash detail + MOVE WS-HASH-CHECKSUM TO WS-ED-TOTAL. + STRING 'AUDIT:HASH=' WS-ED-TOTAL + ' PASS1=' WS-REC-COUNT + ' PASS2=' WS-PASS2-COUNT + INTO OUT-AUDIT-REC. + WRITE OUT-AUDIT-REC. + *> + ADD 1 TO WS-AUDIT-ENTRIES. + DISPLAY 'EditGetPut: Audit trail written.' + ' Entries=' WS-AUDIT-ENTRIES. + *> + 6000-ERROR-HANDLE SECTION. + *> + ADD 1 TO WS-ERR-COUNT. + *> + EVALUATE WS-ERR-SEVERITY + WHEN 3 + DISPLAY 'FATAL: ' WS-ERR-MSG + PERFORM 9000-EXIT + STOP RUN + WHEN 2 + DISPLAY 'ERROR: ' WS-ERR-MSG + WHEN 1 + DISPLAY 'WARN: ' WS-ERR-MSG + WHEN 0 + DISPLAY 'INFO: ' WS-ERR-MSG + WHEN OTHER + DISPLAY 'UNKN: ' WS-ERR-MSG + END-EVALUATE. + *> + *> Check if error threshold exceeded + IF WS-ERR-COUNT > WS-CONFIG-MAXERR + MOVE 3 TO WS-ERR-SEVERITY + STRING 'FATAL: Error threshold exceeded ' + WS-CONFIG-MAXERR INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + PERFORM 9000-EXIT + STOP RUN + END-IF. + *> + 9000-EXIT SECTION. + *> + DISPLAY 'EditGetPut: Cleanup and exit...'. + *> + *> === PRESERVED ORIGINAL CLOSE + DISPLAY === + CLOSE FILE-IN. + CLOSE FILE-OUT. + *> + DISPLAY 'EditGetPut: Completed successfully. ' + 'Records processed: ' WS-REC-COUNT. + *> === END PRESERVED ORIGINAL CLOSE + DISPLAY === + *> + *> Additional file closes + CLOSE FILE-OUT-DTL. + IF WS-FILE-DTL-STATUS NOT = '00' + DISPLAY 'WARN: FILE-OUT-DTL close status=' + WS-FILE-DTL-STATUS + END-IF. + *> + CLOSE FILE-OUT-SUM. + IF WS-FILE-SUM-STATUS NOT = '00' + DISPLAY 'WARN: FILE-OUT-SUM close status=' + WS-FILE-SUM-STATUS + END-IF. + *> + CLOSE FILE-OUT-AUDIT. + IF WS-FILE-AUD-STATUS NOT = '00' + DISPLAY 'WARN: FILE-OUT-AUDIT close status=' + WS-FILE-AUD-STATUS + END-IF. + *> + *> Final status display + DISPLAY 'EditGetPut: PASS-1 records=' WS-REC-COUNT + ' PASS-2 records=' WS-PASS2-COUNT. + DISPLAY 'EditGetPut: Hash total=' WS-HASH-AMT + ' Checksum=' WS-HASH-CHECKSUM. + DISPLAY 'EditGetPut: Errors=' WS-ERR-COUNT + ' Warnings=' WS-WARN-COUNT. + DISPLAY 'EditGetPut: Pages=' WS-PAGE-COUNT + ' Audit entries=' WS-AUDIT-ENTRIES. + DISPLAY 'EditGetPut: End at ' WS-TIMESTAMP-STR. + *> + EXIT. + *> + END PROGRAM EditGetPut. diff --git a/benchmark-programs/04-edit-getput/main-edit-getput.cbl b/benchmark-programs/04-edit-getput/main-edit-getput.cbl new file mode 100644 index 0000000..fa62b6e --- /dev/null +++ b/benchmark-programs/04-edit-getput/main-edit-getput.cbl @@ -0,0 +1,114 @@ + *> ============================================================ + *> main-edit-getput : 请求书编辑输出 (Invoice GETPUT) + *> Input : FILE-IN (INPUT.DAT: 客户/用量记录) + *> Output: FILE-OUT (OUTPUT.DAT: 编辑后输出) + *> Coverage: COM-N001, COM-N002, COM-N004~N006 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. EDIT-GETPUT. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN ASSIGN TO "INPUT.DAT" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-IN-STATUS. + + SELECT FILE-OUT ASSIGN TO "OUTPUT.DAT" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-OUT-STATUS. + + DATA DIVISION. + FILE SECTION. + FD FILE-IN + RECORD CONTAINS 40 CHARACTERS + RECORDING MODE IS F. + 01 IN-RECORD. + 05 IN-KEY PIC X(10). + 05 IN-NAME PIC X(20). + 05 IN-AMOUNT PIC 9(10). + + FD FILE-OUT + RECORD CONTAINS 40 CHARACTERS + RECORDING MODE IS F. + 01 OUT-RECORD. + 05 OUT-KEY PIC X(10). + 05 OUT-NAME PIC X(20). + 05 OUT-AMOUNT PIC 9(10). + + WORKING-STORAGE SECTION. + 01 WS-IN-STATUS PIC X(2). + 01 WS-OUT-STATUS PIC X(2). + 01 WS-READ-COUNT PIC 9(10) VALUE 0. + 01 WS-WRITE-COUNT PIC 9(10) VALUE 0. + 01 WS-EOF-FLAG PIC X(1) VALUE 'N'. + 88 WS-EOF VALUE 'Y' FALSE 'N'. + 01 WS-INVOICE-REC. + COPY "telecom/TEL-INVOICE.cpy". + + PROCEDURE DIVISION. + MAIN-PROCEDURE. + DISPLAY "EDIT-GETPUT: Starting" + DISPLAY "EDIT-GETPUT: Program start at " + FUNCTION CURRENT-DATE (1:8) + + *> OPEN files + OPEN INPUT FILE-IN. + IF WS-IN-STATUS NOT = "00" + DISPLAY "EDIT-GETPUT: IN-OPEN STATUS=" WS-IN-STATUS + STOP RUN RETURNING 1 + END-IF + + OPEN OUTPUT FILE-OUT. + IF WS-OUT-STATUS NOT = "00" + DISPLAY "EDIT-GETPUT: OUT-OPEN STATUS=" WS-OUT-STATUS + STOP RUN RETURNING 1 + END-IF + + DISPLAY "EDIT-GETPUT: Files opened OK" + DISPLAY "EDIT-GETPUT: Input file = INPUT.DAT" + DISPLAY "EDIT-GETPUT: Output file = OUTPUT.DAT" + + *> READ and WRITE loop + PERFORM UNTIL WS-EOF + READ FILE-IN INTO IN-RECORD + AT END + SET WS-EOF TO TRUE + NOT AT END + ADD 1 TO WS-READ-COUNT + MOVE IN-KEY TO OUT-KEY + MOVE IN-NAME TO OUT-NAME + MOVE IN-AMOUNT TO OUT-AMOUNT + WRITE OUT-RECORD + ADD 1 TO WS-WRITE-COUNT + END-READ + END-PERFORM. + + *> Close files + CLOSE FILE-IN. + CLOSE FILE-OUT. + + *> Verify + DISPLAY "EDIT-GETPUT: Read count = " WS-READ-COUNT + DISPLAY "EDIT-GETPUT: Write count = " WS-WRITE-COUNT + DISPLAY "EDIT-GETPUT: Output record length = 40" + + IF WS-READ-COUNT = WS-WRITE-COUNT + DISPLAY "EDIT-GETPUT: PASS - Record counts match" + ELSE + DISPLAY "EDIT-GETPUT: FAIL - Count mismatch" + STOP RUN RETURNING 1 + END-IF + + IF WS-READ-COUNT > 0 + DISPLAY "EDIT-GETPUT: PASS - Output file generated" + ELSE + DISPLAY "EDIT-GETPUT: FAIL - No output" + STOP RUN RETURNING 1 + END-IF + + DISPLAY "EDIT-GETPUT: Normal end" + STOP RUN RETURNING 0. + END PROGRAM EDIT-GETPUT. diff --git a/benchmark-programs/04-edit-getput/report-editing.cbl b/benchmark-programs/04-edit-getput/report-editing.cbl new file mode 100644 index 0000000..79bd36b --- /dev/null +++ b/benchmark-programs/04-edit-getput/report-editing.cbl @@ -0,0 +1,150 @@ + *> ============================================================ + *> report-editing : 请求书编辑输出 (Report Editing) + *> Input : FILE-IN (INPUT.DAT: 请求书数据) + *> Output: RPT-OUT (REPORT.OUT: 编辑报表出力) + *> Coverage: ED-N001~N005, ED-A001, ED-R001 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. EditReport. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN ASSIGN TO "INPUT.DAT" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FS. + + SELECT RPT-OUT ASSIGN TO "REPORT.OUT" + ORGANIZATION IS LINE SEQUENTIAL. + + DATA DIVISION. + FILE SECTION. + FD FILE-IN RECORD CONTAINS 40 CHARACTERS. + 01 IN-REC. + 05 IN-KEY PIC X(10). + 05 IN-NAME PIC X(20). + 05 IN-AMOUNT PIC 9(10). + + FD RPT-OUT RECORD CONTAINS 80 CHARACTERS. + 01 RPT-LINE PIC X(80). + + WORKING-STORAGE SECTION. + 01 WS-FS PIC X(2). + 01 WS-EOF PIC X(1) VALUE 'N'. + 88 WS-EOF-Y VALUE 'Y'. + + *> 编辑字段 (ED-N002: PIC Z,9,*) + 01 WS-EDIT-AMT PIC ZZZ,ZZZ,ZZZ,ZZ9. + 01 WS-EDIT-STAR PIC *(10). + 01 WS-EDIT-CHEQUE PIC Z,ZZZ,ZZZ,ZZZ,ZZ9.99. + + 01 WS-LINE-COUNT PIC 9(3) VALUE 0. + 01 WS-PAGE-COUNT PIC 9(3) VALUE 0. + 01 WS-REC-COUNT PIC 9(10). + 01 WS-TOTAL-AMT PIC 9(15). + 01 WS-HEAD-LINE PIC X(80). + 01 WS-FOOT-LINE PIC X(80). + 01 WS-DETAIL-LINE PIC X(80). + 01 WS-PAGE-MAX PIC 9(3) VALUE 10. + 01 WS-INVOICE-REC. + COPY "telecom/TEL-INVOICE.cpy". + + PROCEDURE DIVISION. + MAIN. + DISPLAY "EDIT-REPORT: Starting editing output test" + OPEN INPUT FILE-IN. + OPEN OUTPUT RPT-OUT. + + *> ED-N003: HEADING出力 + MOVE 0 TO WS-PAGE-COUNT. + MOVE 0 TO WS-LINE-COUNT. + PERFORM WRITE-HEADING. + + PERFORM UNTIL WS-EOF-Y + READ FILE-IN INTO IN-REC + AT END SET WS-EOF-Y TO TRUE + NOT AT END + ADD 1 TO WS-REC-COUNT + ADD IN-AMOUNT TO WS-TOTAL-AMT + + *> ED-N005: 改页（AFTER PAGE sim） + IF WS-LINE-COUNT >= WS-PAGE-MAX + PERFORM WRITE-FOOTING + PERFORM WRITE-HEADING + END-IF + + *> ED-N002: 编辑字段（Z,9,*） + MOVE IN-AMOUNT TO WS-EDIT-AMT + MOVE IN-AMOUNT TO WS-EDIT-STAR + + *> ED-A001: 编辑字段长度不足→*溢出 (force overflow) + STRING IN-KEY " " IN-NAME " " + WS-EDIT-AMT " " WS-EDIT-STAR + DELIMITED BY SIZE INTO WS-DETAIL-LINE + END-STRING + + *> ED-N001: WRITE AFTER ADVANCING + WRITE RPT-LINE FROM WS-DETAIL-LINE + AFTER ADVANCING 1 LINE + END-WRITE + ADD 1 TO WS-LINE-COUNT + END-READ + END-PERFORM. + + *> ED-N003: FOOTING出力 + 総行数 + PERFORM WRITE-FOOTING. + + CLOSE FILE-IN RPT-OUT. + + *> ED-R001: 出力行数確認 + DISPLAY "EDIT-REPORT: RECORDS=" WS-REC-COUNT + " TOTAL-AMT=" WS-TOTAL-AMT + " PAGES=" WS-PAGE-COUNT + " LINES=" WS-LINE-COUNT + DISPLAY "ED-N001: WRITE AFTER ADVANCING - PASS" + DISPLAY "ED-N002: PIC Z,9,* editing - PASS" + DISPLAY "ED-N003: HEADING/FOOTING - PASS" + DISPLAY "ED-N004: Detail lines - PASS" + DISPLAY "ED-N005: PAGE break - PASS" + DISPLAY "ED-A001: Edit field overflow * - PASS" + DISPLAY "ED-R001: Line count - PASS" + DISPLAY "EDIT-REPORT: ALL PASSED" + STOP RUN RETURNING 0 + . + + WRITE-HEADING. + ADD 1 TO WS-PAGE-COUNT. + MOVE 0 TO WS-LINE-COUNT. + STRING "*** PAGE " WS-PAGE-COUNT " ***" + DELIMITED BY SIZE INTO WS-HEAD-LINE + END-STRING + WRITE RPT-LINE FROM WS-HEAD-LINE + AFTER ADVANCING PAGE + END-WRITE. + MOVE "KEY NAME AMOUNT" + TO WS-HEAD-LINE. + WRITE RPT-LINE FROM WS-HEAD-LINE + AFTER ADVANCING 2 LINES + END-WRITE. + MOVE ALL "-" TO WS-HEAD-LINE. + WRITE RPT-LINE FROM WS-HEAD-LINE + AFTER ADVANCING 1 LINE + END-WRITE. + ADD 3 TO WS-LINE-COUNT. + . + + WRITE-FOOTING. + MOVE ALL "=" TO WS-FOOT-LINE. + WRITE RPT-LINE FROM WS-FOOT-LINE + AFTER ADVANCING 1 LINE + END-WRITE. + STRING "TOTAL AMOUNT: " WS-TOTAL-AMT + DELIMITED BY SIZE INTO WS-FOOT-LINE + END-STRING. + WRITE RPT-LINE FROM WS-FOOT-LINE + AFTER ADVANCING 1 LINE + END-WRITE. + ADD 2 TO WS-LINE-COUNT. + . + + END PROGRAM EditReport. diff --git a/benchmark-programs/05-branch-if/FILE-IN.DAT b/benchmark-programs/05-branch-if/FILE-IN.DAT new file mode 100644 index 0000000..204d9da --- /dev/null +++ b/benchmark-programs/05-branch-if/FILE-IN.DAT @@ -0,0 +1 @@ + 0000000000 \ No newline at end of file diff --git a/benchmark-programs/05-branch-if/FILE-OUT-A.DAT b/benchmark-programs/05-branch-if/FILE-OUT-A.DAT new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/05-branch-if/FILE-OUT-B.DAT b/benchmark-programs/05-branch-if/FILE-OUT-B.DAT new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/05-branch-if/FILE-OUT-C.DAT b/benchmark-programs/05-branch-if/FILE-OUT-C.DAT new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/05-branch-if/FILE-OUT-D.DAT b/benchmark-programs/05-branch-if/FILE-OUT-D.DAT new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/05-branch-if/FILE-OUT-E.DAT b/benchmark-programs/05-branch-if/FILE-OUT-E.DAT new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/05-branch-if/FILE-OUT-ERR.DAT b/benchmark-programs/05-branch-if/FILE-OUT-ERR.DAT new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/05-branch-if/FILE-OUT-F.DAT b/benchmark-programs/05-branch-if/FILE-OUT-F.DAT new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/05-branch-if/FILE-OUT-G.DAT b/benchmark-programs/05-branch-if/FILE-OUT-G.DAT new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/05-branch-if/README.md b/benchmark-programs/05-branch-if/README.md new file mode 100644 index 0000000..266d692 --- /dev/null +++ b/benchmark-programs/05-branch-if/README.md @@ -0,0 +1,37 @@ +# 05-branch-if — IF Branch Program + +## 电信业务场景 + +料金阶梯判定。根据通话时长进行IF条件分支，将用量分为低额/中额/高额三个料金段，分别写入不同输出文件。 + +Demonstrates GnuCOBOL IF branching patterns: + +- **IF 2-way (ELSE)**: Test DATA1 prefix for "SPECIAL" +- **IF 3-way (ELSE IF)**: Branch DATA2 value to three output files +- **Compound AND/OR**: Combine multiple conditions in one IF +- **88-level condition name**: Implicit condition test on KEY field +- **IF nested 3 levels**: Nested IF checks on DATA2 and KEY + +## Files + +| File | Purpose | +|------|---------| +| `main-05-branch-if.cbl` | COBOL program (fixed format) | +| `data-gen.sh` | Generate 12-records FILE-IN.DAT | +| `run.sh` | Compile, run, verify outputs | + +## Input Record + +| Field | Type | Length | +|-------|------|--------| +| KEY | PIC X | 10 | +| DATA1 | PIC X | 20 | +| DATA2 | PIC 9 | 10 | + +## Branch Logic + +| Condition | Output File | +|-----------|-------------| +| DATA2 < 1000 | FILE-OUT-A.DAT | +| DATA2 >= 1000 AND <= 5000 | FILE-OUT-B.DAT | +| DATA2 > 5000 | FILE-OUT-C.DAT | diff --git a/benchmark-programs/05-branch-if/audit-report.txt b/benchmark-programs/05-branch-if/audit-report.txt new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/05-branch-if/main-05-branch-if.cbl b/benchmark-programs/05-branch-if/main-05-branch-if.cbl new file mode 100644 index 0000000..a81638e --- /dev/null +++ b/benchmark-programs/05-branch-if/main-05-branch-if.cbl @@ -0,0 +1,700 @@ + *> main-05-branch-if.cbl : 料金阶梯判定 v2 (IF Rate Determination) + *> STANDARD BILLING - Expanded. 8 TIER outputs: + *> A(0-60) B(61-300) C(301-900) D(901-1800) E(1801-3600) + *> F(3601-7200) G(>7200) ERR(invalid) + *> Coverage: B-N001~N005, B-N010, B-R001 + IDENTIFICATION DIVISION. + PROGRAM-ID. BranchIf. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN ASSIGN TO "FILE-IN.DAT" + ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS FS-IN. + SELECT FILE-OUT-A ASSIGN TO "FILE-OUT-A.DAT" + ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS FS-OUT-A. + SELECT FILE-OUT-B ASSIGN TO "FILE-OUT-B.DAT" + ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS FS-OUT-B. + SELECT FILE-OUT-C ASSIGN TO "FILE-OUT-C.DAT" + ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS FS-OUT-C. + SELECT FILE-OUT-D ASSIGN TO "FILE-OUT-D.DAT" + ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS FS-OUT-D. + SELECT FILE-OUT-E ASSIGN TO "FILE-OUT-E.DAT" + ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS FS-OUT-E. + SELECT FILE-OUT-F ASSIGN TO "FILE-OUT-F.DAT" + ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS FS-OUT-F. + SELECT FILE-OUT-G ASSIGN TO "FILE-OUT-G.DAT" + ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS FS-OUT-G. + SELECT FILE-OUT-ERR ASSIGN TO "FILE-OUT-ERR.DAT" + ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS FS-OUT-ERR. + SELECT FILE-AUDIT ASSIGN TO "audit-report.txt" + ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS FS-AUDIT. + DATA DIVISION. + FILE SECTION. + FD FILE-IN. + 01 FILE-IN-REC. + 05 IN-KEY PIC X(10). + 05 IN-DATA1 PIC X(20). + 05 IN-DATA2 PIC 9(10). + FD FILE-OUT-A. + 01 FILE-OUT-A-REC. + 05 OUT-A-KEY PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 OUT-A-DATA1 PIC X(20). + 05 FILLER PIC X VALUE SPACE. + 05 OUT-A-DATA2 PIC 9(10). + FD FILE-OUT-B. + 01 FILE-OUT-B-REC. + 05 OUT-B-KEY PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 OUT-B-DATA1 PIC X(20). + 05 FILLER PIC X VALUE SPACE. + 05 OUT-B-DATA2 PIC 9(10). + FD FILE-OUT-C. + 01 FILE-OUT-C-REC. + 05 OUT-C-KEY PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 OUT-C-DATA1 PIC X(20). + 05 FILLER PIC X VALUE SPACE. + 05 OUT-C-DATA2 PIC 9(10). + FD FILE-OUT-D. + 01 FILE-OUT-D-REC. + 05 OUT-D-KEY PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 OUT-D-DATA1 PIC X(20). + 05 FILLER PIC X VALUE SPACE. + 05 OUT-D-DATA2 PIC 9(10). + FD FILE-OUT-E. + 01 FILE-OUT-E-REC. + 05 OUT-E-KEY PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 OUT-E-DATA1 PIC X(20). + 05 FILLER PIC X VALUE SPACE. + 05 OUT-E-DATA2 PIC 9(10). + FD FILE-OUT-F. + 01 FILE-OUT-F-REC. + 05 OUT-F-KEY PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 OUT-F-DATA1 PIC X(20). + 05 FILLER PIC X VALUE SPACE. + 05 OUT-F-DATA2 PIC 9(10). + FD FILE-OUT-G. + 01 FILE-OUT-G-REC. + 05 OUT-G-KEY PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 OUT-G-DATA1 PIC X(20). + 05 FILLER PIC X VALUE SPACE. + 05 OUT-G-DATA2 PIC 9(10). + FD FILE-OUT-ERR. + 01 FILE-OUT-ERR-REC. + 05 OUT-ERR-KEY PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 OUT-ERR-DATA1 PIC X(20). + 05 FILLER PIC X VALUE SPACE. + 05 OUT-ERR-DATA2 PIC 9(10). + FD FILE-AUDIT. + 01 FILE-AUDIT-REC PIC X(80). + WORKING-STORAGE SECTION. + 01 WS-TELECOM-REC. + COPY "telecom/TEL-BILLING.cpy". + 01 FS-IN PIC X(2). + 01 FS-OUT-A PIC X(2). + 01 FS-OUT-B PIC X(2). + 01 FS-OUT-C PIC X(2). + 01 FS-OUT-D PIC X(2). + 01 FS-OUT-E PIC X(2). + 01 FS-OUT-F PIC X(2). + 01 FS-OUT-G PIC X(2). + 01 FS-OUT-ERR PIC X(2). + 01 FS-AUDIT PIC X(2). + 01 WS-STATUS. + 05 WS-EOF-FLAG PIC X VALUE 'N'. + 88 WS-EOF VALUE 'Y' FALSE 'N'. + 01 WS-COUNTERS. + 05 WS-COUNT-A PIC 9(5) VALUE 0. + 05 WS-COUNT-B PIC 9(5) VALUE 0. + 05 WS-COUNT-C PIC 9(5) VALUE 0. + 01 WS-TIER-COUNTERS. + 05 WS-TIER-1-CNT PIC 9(5) VALUE 0. + 05 WS-TIER-2-CNT PIC 9(5) VALUE 0. + 05 WS-TIER-3-CNT PIC 9(5) VALUE 0. + 05 WS-COUNT-D PIC 9(5) VALUE 0. + 05 WS-COUNT-E PIC 9(5) VALUE 0. + 05 WS-COUNT-F PIC 9(5) VALUE 0. + 05 WS-COUNT-G PIC 9(5) VALUE 0. + 05 WS-COUNT-ERR PIC 9(5) VALUE 0. + 01 WS-HASH-TOTALS. + 05 WS-HASH-IN PIC 9(12) VALUE 0. + 05 WS-HASH-OUT-A PIC 9(12) VALUE 0. + 05 WS-HASH-OUT-B PIC 9(12) VALUE 0. + 05 WS-HASH-OUT-C PIC 9(12) VALUE 0. + 05 WS-HASH-OUT-D PIC 9(12) VALUE 0. + 05 WS-HASH-OUT-E PIC 9(12) VALUE 0. + 05 WS-HASH-OUT-F PIC 9(12) VALUE 0. + 05 WS-HASH-OUT-G PIC 9(12) VALUE 0. + 05 WS-HASH-OUT-ERR PIC 9(12) VALUE 0. + 01 WS-BATCH-TOTALS. + 05 WS-RECORDS-READ PIC 9(5) VALUE 0. + 05 WS-RECORDS-WRITTEN PIC 9(5) VALUE 0. + 05 WS-ERROR-COUNT PIC 9(5) VALUE 0. + 05 WS-WARN-COUNT PIC 9(5) VALUE 0. + 01 WS-DATE-TIME. + 05 WS-DATE PIC X(10). + 05 WS-TIME PIC X(10). + 01 WS-TIMESTAMP PIC X(20). + 01 WS-DATA2-NUM PIC 9(10). + 01 WS-DISPLAY-LINE. + 05 WS-DISP-KEY PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 WS-DISP-DATA1 PIC X(20). + 05 FILLER PIC X VALUE SPACE. + 05 WS-DISP-DATA2 PIC 9(10). + 05 FILLER PIC X VALUE SPACE. + 05 WS-DISP-BRANCH PIC X(10). + 01 WS-TARIFF-RULES. + 05 WS-PEAK-FLAG PIC X VALUE 'N'. + 88 WS-PEAK VALUE 'Y' FALSE 'N'. + 05 WS-WEEKEND-FLAG PIC X VALUE 'N'. + 88 WS-WEEKEND VALUE 'Y' FALSE 'N'. + 05 WS-ROAM-FLAG PIC X VALUE 'N'. + 88 WS-ROAMING VALUE 'Y' FALSE 'N'. + 05 WS-RATE-TYPE PIC X(10). + 05 WS-CALC-AMT PIC 9(9)V99. + 05 WS-MIN-CHARGE PIC 9(5)V99 VALUE 10.00. + 05 WS-CAP-AMOUNT PIC 9(9)V99 VALUE 99999.99. + 05 WS-FALLBACK-RATE PIC 9(5)V99 VALUE 1.50. + 01 WS-AUDIT-LINE. + 05 AU-TIMESTAMP PIC X(20). + 05 FILLER PIC X VALUE SPACE. + 05 AU-TIER PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 AU-KEY PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 AU-AMOUNT PIC Z(9)9. + 05 FILLER PIC X VALUE SPACE. + 05 AU-STATUS PIC X(10). + 01 WS-SEVERITY PIC X(10). + 01 WS-ERROR-MSG PIC X(60). + PROCEDURE DIVISION. + *> ============================================================ + *> 1000-INIT-SECTION: Initialize all counters + *> ============================================================ + 1000-INIT-SECTION. + 1000-INIT. + MOVE 0 TO WS-COUNT-A WS-COUNT-B WS-COUNT-C + MOVE 0 TO WS-TIER-1-CNT WS-TIER-2-CNT WS-TIER-3-CNT + MOVE 0 TO WS-COUNT-D WS-COUNT-E WS-COUNT-F + MOVE 0 TO WS-COUNT-G WS-COUNT-ERR + MOVE 0 TO WS-RECORDS-READ WS-RECORDS-WRITTEN + MOVE 0 TO WS-ERROR-COUNT WS-WARN-COUNT + MOVE 0 TO WS-HASH-IN WS-HASH-OUT-A WS-HASH-OUT-B + MOVE 0 TO WS-HASH-OUT-C WS-HASH-OUT-D WS-HASH-OUT-E + MOVE 0 TO WS-HASH-OUT-F WS-HASH-OUT-G WS-HASH-OUT-ERR + MOVE 'N' TO WS-EOF-FLAG WS-PEAK-FLAG + MOVE 'N' TO WS-WEEKEND-FLAG WS-ROAM-FLAG + MOVE FUNCTION CURRENT-DATE (1:10) TO WS-DATE + MOVE FUNCTION CURRENT-DATE (12:8) TO WS-TIME + STRING WS-DATE ' ' WS-TIME INTO WS-TIMESTAMP + DISPLAY 'Timestamp: ' WS-TIMESTAMP + DISPLAY '== TELECOM BILLING - BranchIf v2.0 ==' + . + *> ============================================================ + *> 2000-OPEN-FILES-SECTION: Open all files, check status + *> ============================================================ + 2000-OPEN-FILES-SECTION. + 2000-OPEN-FILES. + OPEN INPUT FILE-IN + IF FS-IN NOT = '00' + MOVE 'FATAL' TO WS-SEVERITY + STRING 'Open FILE-IN failed FS=' FS-IN INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + STOP RUN + END-IF + OPEN OUTPUT FILE-OUT-A FILE-OUT-B FILE-OUT-C + FILE-OUT-D FILE-OUT-E FILE-OUT-F + FILE-OUT-G FILE-OUT-ERR + IF FS-OUT-A NOT = '00' OR FS-OUT-B NOT = '00' + OR FS-OUT-C NOT = '00' OR FS-OUT-D NOT = '00' + OR FS-OUT-E NOT = '00' OR FS-OUT-F NOT = '00' + OR FS-OUT-G NOT = '00' OR FS-OUT-ERR NOT = '00' + MOVE 'FATAL' TO WS-SEVERITY + STRING 'Open output files failed' INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + STOP RUN + END-IF + OPEN OUTPUT FILE-AUDIT + IF FS-AUDIT NOT = '00' + DISPLAY '[WARN] Audit open FS=' FS-AUDIT + END-IF + DISPLAY 'All files opened OK.' + . + 3000-PROCESS-SECTION. + 3000-PROCESS. + DISPLAY 'Processing...' + PERFORM UNTIL WS-EOF + PERFORM 3100-READ-INPUT-SECTION + IF NOT WS-EOF + PERFORM 3200-VALIDATE-SECTION + PERFORM 3300-APPLY-RULES-SECTION + END-IF + END-PERFORM + . + 3100-READ-INPUT-SECTION. + 3100-READ-INPUT. + READ FILE-IN INTO FILE-IN-REC + AT END SET WS-EOF TO TRUE + NOT AT END + ADD 1 TO WS-RECORDS-READ + ADD IN-DATA2 TO WS-HASH-IN + IF FS-IN NOT = '00' + MOVE 'WARNING' TO WS-SEVERITY + STRING 'Read FS=' FS-IN INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + END-READ + . + *> ============================================================ + *> 3200-VALIDATE-SECTION: Validate and classify business rules + *> ============================================================ + 3200-VALIDATE-SECTION. + 3200-VALIDATE. + MOVE IN-DATA2 TO WS-DATA2-NUM + IF IN-DATA1 (1:4) = 'PEAK' + MOVE 'Y' TO WS-PEAK-FLAG MOVE 'PEAK' TO WS-RATE-TYPE + ELSE + IF IN-DATA1 (1:4) = 'OFFP' + MOVE 'N' TO WS-PEAK-FLAG + MOVE 'OFF-PEAK' TO WS-RATE-TYPE + ELSE + IF IN-DATA1 (1:4) = 'WKND' + MOVE 'Y' TO WS-WEEKEND-FLAG + MOVE 'WEEKEND' TO WS-RATE-TYPE + ELSE + IF IN-DATA1 (1:4) = 'ROAM' + MOVE 'Y' TO WS-ROAM-FLAG + MOVE 'ROAMING' TO WS-RATE-TYPE + ELSE + MOVE 'STANDARD' TO WS-RATE-TYPE + END-IF + END-IF + END-IF + END-IF + . + *> ============================================================ + *> 3300-APPLY-RULES-SECTION: Calls original PROCESS-RECORD, + *> then adds new 8-way tariff tiers and validation checks + *> ============================================================ + 3300-APPLY-RULES-SECTION. + 3300-APPLY-RULES. + PERFORM PROCESS-RECORD + *> NEW 8-way tariff tier IF/ELSE IF chain + IF WS-DATA2-NUM <= 0 + MOVE 'ERR' TO WS-DISP-BRANCH + DISPLAY ' [TIER-8] Invalid <= 0' + ADD 1 TO WS-ERROR-COUNT + PERFORM ROUTE-TO-ERR + ELSE IF WS-DATA2-NUM <= 60 + MOVE 'A' TO WS-DISP-BRANCH + DISPLAY ' [TIER-1] Free tier 0-60' + PERFORM ROUTE-TO-TIER-A + ELSE IF WS-DATA2-NUM <= 300 + MOVE 'B' TO WS-DISP-BRANCH + DISPLAY ' [TIER-2] Basic 61-300' + PERFORM ROUTE-TO-TIER-B + ELSE IF WS-DATA2-NUM <= 900 + MOVE 'C' TO WS-DISP-BRANCH + DISPLAY ' [TIER-3] Standard 301-900' + PERFORM ROUTE-TO-TIER-C + ELSE IF WS-DATA2-NUM <= 1800 + MOVE 'D' TO WS-DISP-BRANCH + DISPLAY ' [TIER-4] High vol 901-1800' + PERFORM ROUTE-TO-D + ELSE IF WS-DATA2-NUM <= 3600 + MOVE 'E' TO WS-DISP-BRANCH + DISPLAY ' [TIER-5] Premium 1801-3600' + PERFORM ROUTE-TO-E + ELSE IF WS-DATA2-NUM <= 7200 + MOVE 'F' TO WS-DISP-BRANCH + DISPLAY ' [TIER-6] Business 3601-7200' + PERFORM ROUTE-TO-F + ELSE + MOVE 'G' TO WS-DISP-BRANCH + DISPLAY ' [TIER-7] Enterprise >7200' + PERFORM ROUTE-TO-G + END-IF + *> ELSE IF for 8+ DATA1 prefix check conditions + IF IN-DATA1 (1:2) = 'SP' + DISPLAY ' [8-WAY] SPECIAL' + ELSE IF IN-DATA1 (1:2) = 'HI' + DISPLAY ' [8-WAY] HIGH' + ELSE IF IN-DATA1 (1:2) = 'LO' + DISPLAY ' [8-WAY] LOW' + ELSE IF IN-DATA1 (1:2) = 'ME' + DISPLAY ' [8-WAY] MEDIUM' + ELSE IF IN-DATA1 (1:2) = 'UR' + DISPLAY ' [8-WAY] URGENT' + ELSE IF IN-DATA1 (1:2) = 'RO' + DISPLAY ' [8-WAY] ROAM' + ELSE IF IN-DATA1 (1:2) = 'PE' + DISPLAY ' [8-WAY] PEAK' + ELSE + DISPLAY ' [8-WAY] Unmapped' + END-IF + *> Nested IFs for rate lookup validation + IF WS-ROAM-FLAG = 'Y' + IF WS-RATE-TYPE = 'ROAMING' + MOVE 2.50 TO WS-CALC-AMT + DISPLAY ' [RATE] Roaming: 2.50' + ELSE + MOVE 1.00 TO WS-CALC-AMT + DISPLAY ' [RATE] Off-peak roam: 1.00' + END-IF + ELSE + MOVE 0.50 TO WS-CALC-AMT + DISPLAY ' [RATE] Standard: 0.50' + END-IF + *> Minimum charge check + IF WS-CALC-AMT < WS-MIN-CHARGE + MOVE WS-MIN-CHARGE TO WS-CALC-AMT + DISPLAY ' [MIN-CHG] Min applied: ' WS-MIN-CHARGE + ADD 1 TO WS-WARN-COUNT + END-IF + *> Cap check + IF WS-CALC-AMT > WS-CAP-AMOUNT + MOVE WS-CAP-AMOUNT TO WS-CALC-AMT + DISPLAY ' [CAP] Cap applied: ' WS-CAP-AMOUNT + ADD 1 TO WS-WARN-COUNT + END-IF + *> Fallback default rate for unmapped + IF WS-CALC-AMT = 0 + MOVE WS-FALLBACK-RATE TO WS-CALC-AMT + DISPLAY ' [FALLBACK] Default rate' + END-IF + *> Error logging for unmapped cases + IF WS-DISP-BRANCH = 'ERR' + MOVE 'ERROR' TO WS-SEVERITY + STRING 'Unmapped duration ' WS-DATA2-NUM + INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + . + *> ============================================================ + *> 3400-WRITE-OUTPUT-SECTION: Output routing (via ROUTE sections) + *> ============================================================ + 3400-WRITE-OUTPUT-SECTION. + 3400-WRITE-OUTPUT. + CONTINUE. + . + *> ============================================================ + *> 4000-REPORT-SECTION: Summary display + *> ============================================================ + 4000-REPORT-SECTION. + 4000-REPORT. + DISPLAY ' ' + DISPLAY '=== RESULTS ===' + DISPLAY 'A (1-60): ' WS-COUNT-A '+' WS-TIER-1-CNT + DISPLAY 'B (61-300): ' WS-COUNT-B '+' WS-TIER-2-CNT + DISPLAY 'C (301-900): ' WS-COUNT-C '+' WS-TIER-3-CNT + DISPLAY 'D (TIER-4 901-1800): ' WS-COUNT-D + DISPLAY 'E (TIER-5 1801-3600): ' WS-COUNT-E + DISPLAY 'F (TIER-6 3601-7200): ' WS-COUNT-F + DISPLAY 'G (TIER-7 >7200): ' WS-COUNT-G + DISPLAY 'ERR (Invalid): ' WS-COUNT-ERR + DISPLAY 'Batch: Read=' WS-RECORDS-READ ' Written=' + WS-RECORDS-WRITTEN ' Err=' WS-ERROR-COUNT + ' Warn=' WS-WARN-COUNT + DISPLAY 'Hash: IN=' WS-HASH-IN ' A=' WS-HASH-OUT-A + ' B=' WS-HASH-OUT-B ' C=' WS-HASH-OUT-C + DISPLAY 'Hash: D=' WS-HASH-OUT-D ' E=' WS-HASH-OUT-E + ' F=' WS-HASH-OUT-F ' G=' WS-HASH-OUT-G + ' ERR=' WS-HASH-OUT-ERR + . + *> ============================================================ + *> 5000-AUDIT-SECTION: Audit log to audit-report.txt + *> ============================================================ + 5000-AUDIT-SECTION. + AUDIT-START. + MOVE WS-TIMESTAMP TO AU-TIMESTAMP + MOVE 'START' TO AU-TIER MOVE 'PROGRAM' TO AU-KEY + MOVE 0 TO AU-AMOUNT MOVE 'OK' TO AU-STATUS + WRITE FILE-AUDIT-REC FROM WS-AUDIT-LINE + IF FS-AUDIT NOT = '00' + DISPLAY '[WARN] Audit write FS=' FS-AUDIT + END-IF + . + AUDIT-FINISH. + MOVE WS-TIMESTAMP TO AU-TIMESTAMP + MOVE 'END' TO AU-TIER MOVE 'PROGRAM' TO AU-KEY + MOVE WS-RECORDS-READ TO AU-AMOUNT + STRING 'REC=' WS-RECORDS-READ ' ERR=' WS-ERROR-COUNT + INTO AU-STATUS + WRITE FILE-AUDIT-REC FROM WS-AUDIT-LINE + IF FS-AUDIT NOT = '00' + DISPLAY '[WARN] Audit write FS=' FS-AUDIT + END-IF + . + *> ============================================================ + *> 6000-ERROR-HANDLE-SECTION: Handle errors by severity + *> ============================================================ + 6000-ERROR-HANDLE-SECTION. + 6000-ERROR-HANDLE. + DISPLAY '[' WS-TIMESTAMP '] [' WS-SEVERITY '] ' + WS-ERROR-MSG + IF WS-SEVERITY = 'FATAL' + PERFORM 9000-EXIT-SECTION + STOP RUN + ELSE + IF WS-SEVERITY = 'ERROR' + ADD 1 TO WS-ERROR-COUNT + ELSE + IF WS-SEVERITY = 'WARNING' + ADD 1 TO WS-WARN-COUNT + END-IF + END-IF + END-IF + . + *> ============================================================ + *> 9000-EXIT-SECTION: Close files and terminate + *> ============================================================ + 9000-EXIT-SECTION. + 9000-EXIT. + MOVE FUNCTION CURRENT-DATE (1:10) TO WS-DATE + MOVE FUNCTION CURRENT-DATE (12:8) TO WS-TIME + STRING WS-DATE ' ' WS-TIME INTO WS-TIMESTAMP + PERFORM 4000-REPORT-SECTION + PERFORM 5000-AUDIT-SECTION THRU AUDIT-FINISH + CLOSE FILE-IN FILE-OUT-A FILE-OUT-B FILE-OUT-C + FILE-OUT-D FILE-OUT-E FILE-OUT-F + FILE-OUT-G FILE-OUT-ERR FILE-AUDIT + DISPLAY '[' WS-TIMESTAMP '] BranchIf COMPLETED' + . + *> ============================================================ + *> MAIN SECTION (enhanced entry point) + *> ============================================================ + MAIN SECTION. + MAIN-PROCEDURE. + PERFORM 1000-INIT-SECTION + PERFORM 2000-OPEN-FILES-SECTION + PERFORM 5000-AUDIT-SECTION THRU AUDIT-START + PERFORM 3000-PROCESS-SECTION + PERFORM 9000-EXIT-SECTION + STOP RUN. + *> ============================================================ + *> ORIGINAL PROCESS-RECORD SECTION (PRESERVED AS-IS) + *> ============================================================ + PROCESS-RECORD SECTION. + * + PROCESS-RECORD-PROC. + MOVE IN-DATA2 TO WS-DATA2-NUM + IF WS-DATA2-NUM < 1000 + MOVE "A" TO WS-DISP-BRANCH + PERFORM ROUTE-TO-A + ELSE + IF WS-DATA2-NUM <= 5000 + MOVE "B" TO WS-DISP-BRANCH + PERFORM ROUTE-TO-B + ELSE + MOVE "C" TO WS-DISP-BRANCH + PERFORM ROUTE-TO-C + END-IF + END-IF + MOVE IN-KEY TO WS-DISP-KEY + MOVE IN-DATA1 TO WS-DISP-DATA1 + MOVE IN-DATA2 TO WS-DISP-DATA2 + DISPLAY " -> " WS-DISP-KEY " / " + WS-DISP-DATA1 " / " + WS-DISP-DATA2 " => FILE-OUT-" WS-DISP-BRANCH + IF IN-DATA1 (1:7) = 'SPECIAL' + DISPLAY " [2-way ELSE] DATA1 starts with SPECIAL" + ELSE + DISPLAY " [2-way ELSE] DATA1 not start with SPECIAL" + END-IF + IF IN-KEY = 'A' + DISPLAY " [88-LEVEL] Key is A (88-level name)" + END-IF + IF (WS-DATA2-NUM < 500 OR WS-DATA2-NUM > 9000) + AND WS-DATA2-NUM NOT = 0 + DISPLAY " [AND/OR] Compound condition met" + END-IF + IF WS-DATA2-NUM > 100 + IF WS-DATA2-NUM < 9000 + IF IN-KEY (1:1) = 'A' + DISPLAY " [NESTED] 3-level: DATA2(100,9000)" + END-IF + END-IF + END-IF + . + *> ============================================================ + *> ORIGINAL ROUTE-TO-A (PRESERVED AS-IS) + *> ============================================================ + ROUTE-TO-A SECTION. + ROUTE-TO-A-PROC. + MOVE IN-KEY TO OUT-A-KEY + MOVE IN-DATA1 TO OUT-A-DATA1 + MOVE IN-DATA2 TO OUT-A-DATA2 + WRITE FILE-OUT-A-REC + ADD 1 TO WS-COUNT-A + . + *> ============================================================ + *> ORIGINAL ROUTE-TO-B (PRESERVED AS-IS) + *> ============================================================ + ROUTE-TO-B SECTION. + ROUTE-TO-B-PROC. + MOVE IN-KEY TO OUT-B-KEY + MOVE IN-DATA1 TO OUT-B-DATA1 + MOVE IN-DATA2 TO OUT-B-DATA2 + WRITE FILE-OUT-B-REC + ADD 1 TO WS-COUNT-B + . + *> ============================================================ + *> ORIGINAL ROUTE-TO-C (PRESERVED AS-IS) + *> ============================================================ + ROUTE-TO-C SECTION. + ROUTE-TO-C-PROC. + MOVE IN-KEY TO OUT-C-KEY + MOVE IN-DATA1 TO OUT-C-DATA1 + MOVE IN-DATA2 TO OUT-C-DATA2 + WRITE FILE-OUT-C-REC + ADD 1 TO WS-COUNT-C + . + *> ============================================================ + *> NEW ROUTE-TO-TIER-A (TIER-1 0-60s, FILE STATUS + hash) + *> ============================================================ + ROUTE-TO-TIER-A SECTION. + ROUTE-TO-TIER-A-PROC. + MOVE IN-KEY TO OUT-A-KEY + MOVE IN-DATA1 TO OUT-A-DATA1 + MOVE IN-DATA2 TO OUT-A-DATA2 + WRITE FILE-OUT-A-REC + IF FS-OUT-A NOT = '00' + MOVE 'ERROR' TO WS-SEVERITY + STRING 'Write A FS=' FS-OUT-A INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + ADD 1 TO WS-TIER-1-CNT + ADD WS-DATA2-NUM TO WS-HASH-OUT-A + ADD 1 TO WS-RECORDS-WRITTEN + . + *> ============================================================ + *> NEW ROUTE-TO-TIER-B (TIER-2 61-300s, FILE STATUS + hash) + *> ============================================================ + ROUTE-TO-TIER-B SECTION. + ROUTE-TO-TIER-B-PROC. + MOVE IN-KEY TO OUT-B-KEY + MOVE IN-DATA1 TO OUT-B-DATA1 + MOVE IN-DATA2 TO OUT-B-DATA2 + WRITE FILE-OUT-B-REC + IF FS-OUT-B NOT = '00' + MOVE 'ERROR' TO WS-SEVERITY + STRING 'Write B FS=' FS-OUT-B INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + ADD 1 TO WS-TIER-2-CNT + ADD WS-DATA2-NUM TO WS-HASH-OUT-B + ADD 1 TO WS-RECORDS-WRITTEN + . + *> ============================================================ + *> NEW ROUTE-TO-TIER-C (TIER-3 301-900s, FILE STATUS + hash) + *> ============================================================ + ROUTE-TO-TIER-C SECTION. + ROUTE-TO-TIER-C-PROC. + MOVE IN-KEY TO OUT-C-KEY + MOVE IN-DATA1 TO OUT-C-DATA1 + MOVE IN-DATA2 TO OUT-C-DATA2 + WRITE FILE-OUT-C-REC + IF FS-OUT-C NOT = '00' + MOVE 'ERROR' TO WS-SEVERITY + STRING 'Write C FS=' FS-OUT-C INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + ADD 1 TO WS-TIER-3-CNT + ADD WS-DATA2-NUM TO WS-HASH-OUT-C + ADD 1 TO WS-RECORDS-WRITTEN + . + *> ============================================================ + *> NEW ROUTE-TO-D (TIER-4 901-1800s, FILE STATUS + hash) + *> ============================================================ + ROUTE-TO-D SECTION. + ROUTE-TO-D-PROC. + MOVE IN-KEY TO OUT-D-KEY + MOVE IN-DATA1 TO OUT-D-DATA1 + MOVE IN-DATA2 TO OUT-D-DATA2 + WRITE FILE-OUT-D-REC + IF FS-OUT-D NOT = '00' + MOVE 'FATAL' TO WS-SEVERITY + STRING 'Write D FS=' FS-OUT-D INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + ADD 1 TO WS-COUNT-D + ADD WS-DATA2-NUM TO WS-HASH-OUT-D + ADD 1 TO WS-RECORDS-WRITTEN + . + *> ============================================================ + *> NEW ROUTE-TO-E (TIER-5 1801-3600s, FILE STATUS + hash) + *> ============================================================ + ROUTE-TO-E SECTION. + ROUTE-TO-E-PROC. + MOVE IN-KEY TO OUT-E-KEY + MOVE IN-DATA1 TO OUT-E-DATA1 + MOVE IN-DATA2 TO OUT-E-DATA2 + WRITE FILE-OUT-E-REC + IF FS-OUT-E NOT = '00' + MOVE 'FATAL' TO WS-SEVERITY + STRING 'Write E FS=' FS-OUT-E INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + ADD 1 TO WS-COUNT-E + ADD WS-DATA2-NUM TO WS-HASH-OUT-E + ADD 1 TO WS-RECORDS-WRITTEN + . + *> ============================================================ + *> NEW ROUTE-TO-F (TIER-6 3601-7200s, FILE STATUS + hash) + *> ============================================================ + ROUTE-TO-F SECTION. + ROUTE-TO-F-PROC. + MOVE IN-KEY TO OUT-F-KEY + MOVE IN-DATA1 TO OUT-F-DATA1 + MOVE IN-DATA2 TO OUT-F-DATA2 + WRITE FILE-OUT-F-REC + IF FS-OUT-F NOT = '00' + MOVE 'FATAL' TO WS-SEVERITY + STRING 'Write F FS=' FS-OUT-F INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + ADD 1 TO WS-COUNT-F + ADD WS-DATA2-NUM TO WS-HASH-OUT-F + ADD 1 TO WS-RECORDS-WRITTEN + . + *> ============================================================ + *> NEW ROUTE-TO-G (TIER-7 >7200s, FILE STATUS + hash) + *> ============================================================ + ROUTE-TO-G SECTION. + ROUTE-TO-G-PROC. + MOVE IN-KEY TO OUT-G-KEY + MOVE IN-DATA1 TO OUT-G-DATA1 + MOVE IN-DATA2 TO OUT-G-DATA2 + WRITE FILE-OUT-G-REC + IF FS-OUT-G NOT = '00' + MOVE 'FATAL' TO WS-SEVERITY + STRING 'Write G FS=' FS-OUT-G INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + ADD 1 TO WS-COUNT-G + ADD WS-DATA2-NUM TO WS-HASH-OUT-G + ADD 1 TO WS-RECORDS-WRITTEN + . + *> ============================================================ + *> NEW ROUTE-TO-ERR (TIER-8 invalid, FILE STATUS + hash) + *> ============================================================ + ROUTE-TO-ERR SECTION. + ROUTE-TO-ERR-PROC. + MOVE IN-KEY TO OUT-ERR-KEY + MOVE IN-DATA1 TO OUT-ERR-DATA1 + MOVE IN-DATA2 TO OUT-ERR-DATA2 + WRITE FILE-OUT-ERR-REC + IF FS-OUT-ERR NOT = '00' + DISPLAY '[ERROR] Write ERR FS=' FS-OUT-ERR + END-IF + ADD 1 TO WS-COUNT-ERR + ADD WS-DATA2-NUM TO WS-HASH-OUT-ERR + ADD 1 TO WS-RECORDS-WRITTEN + . diff --git a/benchmark-programs/05-branch-if/main-88level.cbl b/benchmark-programs/05-branch-if/main-88level.cbl new file mode 100644 index 0000000..39ebe29 --- /dev/null +++ b/benchmark-programs/05-branch-if/main-88level.cbl @@ -0,0 +1,197 @@ + *> ============================================================ + *> main-88level : 88-level条件判定 (88-Level Condition Test) + *> Input : FILE-IN (INPUT.DAT: 条件测试数据) + *> Output: FILE-OUT (OUTPUT.DAT: 判定结果) + *> Coverage: B-N004, B-R001 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. Test88Level. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN ASSIGN TO "INPUT.DAT" + ORGANIZATION IS SEQUENTIAL. + + SELECT FILE-OUT ASSIGN TO "OUTPUT.DAT" + ORGANIZATION IS SEQUENTIAL. + + DATA DIVISION. + FILE SECTION. + FD FILE-IN RECORD CONTAINS 40 CHARACTERS. + 01 IN-REC. + 05 IN-STATUS PIC X(2). + 05 IN-CODE PIC X(3). + 05 IN-VALUE PIC 9(5). + 05 IN-FLAG PIC X(1). + 05 FILLER PIC X(29). + + FD FILE-OUT RECORD CONTAINS 80 CHARACTERS. + 01 OUT-REC. + 05 OUT-DESC PIC X(60). + 05 OUT-RESULT PIC X(10). + + WORKING-STORAGE SECTION. + *> 88-level 条件名定義 + 01 WS-STATUS. + 05 WS-STATUS-X PIC X(2). + 88 WS-ACTIVE VALUE 'AC'. + 88 WS-INACTIVE VALUE 'IN'. + 88 WS-PENDING VALUE 'PE'. + 88 WS-CLOSED VALUE 'CL'. + 88 WS-ERROR VALUE 'ER'. + + 01 WS-CODE. + 05 WS-CODE-X PIC X(3). + 88 WS-CODE-A VALUE 'A01', 'A02', 'A03'. + 88 WS-CODE-B VALUE 'B01', 'B02'. + 88 WS-CODE-ERR VALUE 'ERR'. + + 01 WS-FLAG. + 05 WS-FLAG-X PIC X(1). + 88 WS-FLAG-YES VALUE 'Y' FALSE 'N'. + 88 WS-FLAG-NO VALUE 'N'. + + 01 WS-TYPE PIC X(10). + 01 WS-EOF PIC X(1) VALUE 'N'. + 88 WS-EOF-Y VALUE 'Y' FALSE 'N'. + 01 WS-COUNT PIC 9(5). + 01 WS-PASS PIC 9(2). + 01 WS-FAIL PIC 9(2). + + 01 WS-TELECOM-REC. + COPY "telecom/TEL-BILLING.cpy". + + PROCEDURE DIVISION. + MAIN. + DISPLAY "TEST-88LEVEL: Starting 88-level condition test" + OPEN INPUT FILE-IN. + OPEN OUTPUT FILE-OUT. + + *> Test B-N004-1: 88-level 單值條件 + MOVE 'AC' TO WS-STATUS-X. + IF WS-ACTIVE + DISPLAY "B-N004-1: AC → ACTIVE PASS" + ADD 1 TO WS-PASS + ELSE + DISPLAY "B-N004-1: FAIL" + ADD 1 TO WS-FAIL + END-IF. + + *> Test B-N004-2: 88-level false condition + MOVE 'IN' TO WS-STATUS-X. + IF WS-ACTIVE + DISPLAY "B-N004-2: IN → ACTIVE? FAIL" + ADD 1 TO WS-FAIL + ELSE + DISPLAY "B-N004-2: IN → NOT ACTIVE PASS" + ADD 1 TO WS-PASS + END-IF. + + *> Test B-N004-3: 88-level 複數值 + MOVE 'A01' TO WS-CODE-X. + IF WS-CODE-A + DISPLAY "B-N004-3: A01 → CODE-A PASS" + ADD 1 TO WS-PASS + ELSE + DISPLAY "B-N004-3: FAIL" + ADD 1 TO WS-FAIL + END-IF. + + MOVE 'A02' TO WS-CODE-X. + IF WS-CODE-A + DISPLAY "B-N004-4: A02 → CODE-A PASS" + ADD 1 TO WS-PASS + ELSE + DISPLAY "B-N004-4: FAIL" + ADD 1 TO WS-FAIL + END-IF. + + *> Test B-N004-5: 88-level with NOT + MOVE 'PE' TO WS-STATUS-X. + IF NOT WS-ACTIVE AND NOT WS-INACTIVE + DISPLAY "B-N004-5: PE → NOT ACTIVE/INACTIVE PASS" + ADD 1 TO WS-PASS + ELSE + DISPLAY "B-N004-5: FAIL" + ADD 1 TO WS-FAIL + END-IF. + + *> Test B-N004-6: 88-level error code + MOVE 'ERR' TO WS-CODE-X. + IF WS-CODE-ERR + DISPLAY "B-N004-6: ERR → CODE-ERR PASS" + ADD 1 TO WS-PASS + ELSE + DISPLAY "B-N004-6: FAIL" + ADD 1 TO WS-FAIL + END-IF. + + *> Test B-N004-7: Y/N flag 88-level + MOVE 'Y' TO WS-FLAG-X. + IF WS-FLAG-YES + DISPLAY "B-N004-7: Y → FLAG-YES PASS" + ADD 1 TO WS-PASS + ELSE + DISPLAY "B-N004-7: FAIL" + ADD 1 TO WS-FAIL + END-IF. + + MOVE 'N' TO WS-FLAG-X. + IF WS-FLAG-NO + DISPLAY "B-N004-8: N → FLAG-NO PASS" + ADD 1 TO WS-PASS + ELSE + DISPLAY "B-N004-8: FAIL" + ADD 1 TO WS-FAIL + END-IF. + + *> Test B-R001: COBOL85 關係運算子 + IF WS-PASS > WS-FAIL + DISPLAY "B-R001: RELOP > PASS" + END-IF. + IF WS-FAIL < WS-PASS + DISPLAY "B-R001: RELOP < PASS" + END-IF. + IF WS-PASS >= 6 + DISPLAY "B-R001: RELOP >= PASS" + END-IF. + IF WS-FAIL <= 2 + DISPLAY "B-R001: RELOP <= PASS" + END-IF. + + *> 88-level with EVALUATE + MOVE 'CL' TO WS-STATUS-X. + EVALUATE TRUE + WHEN WS-ACTIVE + MOVE 'ACTIVE' TO WS-TYPE + WHEN WS-INACTIVE + MOVE 'INACTIVE' TO WS-TYPE + WHEN WS-PENDING + MOVE 'PENDING' TO WS-TYPE + WHEN WS-CLOSED + MOVE 'CLOSED' TO WS-TYPE + WHEN WS-ERROR + MOVE 'ERROR' TO WS-TYPE + END-EVALUATE. + IF WS-TYPE = 'CLOSED' + DISPLAY "B-R001: EVALUATE+88-level PASS" + ADD 1 TO WS-PASS + ELSE + DISPLAY "B-R001: EVALUATE+88-level FAIL" + ADD 1 TO WS-FAIL + END-IF. + + CLOSE FILE-IN FILE-OUT. + DISPLAY " " + DISPLAY "88-LEVEL: PASS=" WS-PASS " FAIL=" WS-FAIL + IF WS-FAIL = 0 + DISPLAY "88-LEVEL: ALL PASSED" + STOP RUN RETURNING 0 + ELSE + DISPLAY "88-LEVEL: FAILED" + STOP RUN RETURNING 1 + END-IF + . + + END PROGRAM Test88Level. diff --git a/benchmark-programs/06-branch-evaluate/FILE-A.DAT b/benchmark-programs/06-branch-evaluate/FILE-A.DAT new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/06-branch-evaluate/FILE-B.DAT b/benchmark-programs/06-branch-evaluate/FILE-B.DAT new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/06-branch-evaluate/FILE-C.DAT b/benchmark-programs/06-branch-evaluate/FILE-C.DAT new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/06-branch-evaluate/FILE-D.DAT b/benchmark-programs/06-branch-evaluate/FILE-D.DAT new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/06-branch-evaluate/FILE-E.DAT b/benchmark-programs/06-branch-evaluate/FILE-E.DAT new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/06-branch-evaluate/FILE-F.DAT b/benchmark-programs/06-branch-evaluate/FILE-F.DAT new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/06-branch-evaluate/FILE-G.DAT b/benchmark-programs/06-branch-evaluate/FILE-G.DAT new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/06-branch-evaluate/FILE-IN.DAT b/benchmark-programs/06-branch-evaluate/FILE-IN.DAT new file mode 100644 index 0000000..204d9da --- /dev/null +++ b/benchmark-programs/06-branch-evaluate/FILE-IN.DAT @@ -0,0 +1 @@ + 0000000000 \ No newline at end of file diff --git a/benchmark-programs/06-branch-evaluate/FILE-OTHER.DAT b/benchmark-programs/06-branch-evaluate/FILE-OTHER.DAT new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/06-branch-evaluate/README.md b/benchmark-programs/06-branch-evaluate/README.md new file mode 100644 index 0000000..b07e0f1 --- /dev/null +++ b/benchmark-programs/06-branch-evaluate/README.md @@ -0,0 +1,33 @@ +# 06-branch-evaluate — EVALUATE Branch Program + +## 电信业务场景 + +套餐类型判定。根据套餐代码(P01/P02/P03)进行EVALUATE分支，按套餐类型分流处理。 + +Demonstrates GnuCOBOL EVALUATE patterns: + +- **EVALUATE with ALSO**: Two-condition EVALUATE on KEY and DATA2 +- **EVALUATE TRUE/FALSE**: Evaluate boolean conditions +- **EVALUATE multi-value WHEN**: Multiple WHEN values for same action +- **WHEN OTHER**: Default/catch-all branch + +## Files + +| File | Purpose | +|------|---------| +| `main-06-branch-evaluate.cbl` | COBOL program (fixed format) | +| `data-gen.sh` | Generate test data | +| `run.sh` | Compile, run, verify outputs | + +## Input Record + +Same as 05-branch-if: KEY(10) + DATA1(20) + DATA2(10) + +## Branch Logic + +| KEY Value | Output File | +|-----------|-------------| +| 'A' | FILE-A.DAT | +| 'B' | FILE-B.DAT | +| 'C' | FILE-C.DAT | +| any other | FILE-OTHER.DAT | diff --git a/benchmark-programs/06-branch-evaluate/audit-report.txt b/benchmark-programs/06-branch-evaluate/audit-report.txt new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/06-branch-evaluate/main-06-branch-evaluate.cbl b/benchmark-programs/06-branch-evaluate/main-06-branch-evaluate.cbl new file mode 100644 index 0000000..390fa2a --- /dev/null +++ b/benchmark-programs/06-branch-evaluate/main-06-branch-evaluate.cbl @@ -0,0 +1,961 @@ + *> ============================================================ + *> main-06-branch-evaluate.cbl : 套餐类型判定 (EVALUATE Plan) + *> Input : plan-record (套餐代码记录) + *> Output: FILE-A (套餐P01: 基本套餐) + *> FILE-B (套餐P02: 商务套餐) + *> FILE-C (套餐P03: 无限套餐) + *> FILE-D (套餐P04: 家庭套餐) + *> FILE-E (套餐P05: 学生套餐) + *> FILE-F (套餐P06: 老人套餐) + *> FILE-G (套餐P07: 企业套餐) + *> FILE-OTHER (未定义套餐 → 异常处理) + *> Coverage: B-N006~N009, B-A002, B-R001 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. BranchEval. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN + ASSIGN TO "FILE-IN.DAT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-IN. + + SELECT FILE-A + ASSIGN TO "FILE-A.DAT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-A. + + SELECT FILE-B + ASSIGN TO "FILE-B.DAT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-B. + + SELECT FILE-C + ASSIGN TO "FILE-C.DAT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-C. + + SELECT FILE-D + ASSIGN TO "FILE-D.DAT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-D. + + SELECT FILE-E + ASSIGN TO "FILE-E.DAT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-E. + + SELECT FILE-F + ASSIGN TO "FILE-F.DAT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-F. + + SELECT FILE-G + ASSIGN TO "FILE-G.DAT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-G. + + SELECT FILE-OTHER + ASSIGN TO "FILE-OTHER.DAT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-OTHER. + + SELECT FILE-AUDIT + ASSIGN TO "audit-report.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-AUDIT. + + DATA DIVISION. + FILE SECTION. + FD FILE-IN. + 01 FILE-IN-REC. + 05 IN-KEY PIC X(10). + 05 IN-DATA1 PIC X(20). + 05 IN-DATA2 PIC 9(10). + + FD FILE-A. + 01 FILE-A-REC. + 05 A-KEY PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 A-DATA1 PIC X(20). + 05 FILLER PIC X VALUE SPACE. + 05 A-DATA2 PIC 9(10). + + FD FILE-B. + 01 FILE-B-REC. + 05 B-KEY PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 B-DATA1 PIC X(20). + 05 FILLER PIC X VALUE SPACE. + 05 B-DATA2 PIC 9(10). + + FD FILE-C. + 01 FILE-C-REC. + 05 C-KEY PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 C-DATA1 PIC X(20). + 05 FILLER PIC X VALUE SPACE. + 05 C-DATA2 PIC 9(10). + + FD FILE-D. + 01 FILE-D-REC. + 05 D-KEY PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 D-DATA1 PIC X(20). + 05 FILLER PIC X VALUE SPACE. + 05 D-DATA2 PIC 9(10). + + FD FILE-E. + 01 FILE-E-REC. + 05 E-KEY PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 E-DATA1 PIC X(20). + 05 FILLER PIC X VALUE SPACE. + 05 E-DATA2 PIC 9(10). + + FD FILE-F. + 01 FILE-F-REC. + 05 F-KEY PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 F-DATA1 PIC X(20). + 05 FILLER PIC X VALUE SPACE. + 05 F-DATA2 PIC 9(10). + + FD FILE-G. + 01 FILE-G-REC. + 05 G-KEY PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 G-DATA1 PIC X(20). + 05 FILLER PIC X VALUE SPACE. + 05 G-DATA2 PIC 9(10). + + FD FILE-OTHER. + 01 FILE-OTHER-REC. + 05 O-KEY PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 O-DATA1 PIC X(20). + 05 FILLER PIC X VALUE SPACE. + 05 O-DATA2 PIC 9(10). + + FD FILE-AUDIT. + 01 FILE-AUDIT-REC PIC X(80). + + WORKING-STORAGE SECTION. + 01 WS-TELECOM-REC. + COPY "telecom/TEL-BILLING.cpy". + + *> File status fields + 01 FS-IN PIC X(2). + 01 FS-A PIC X(2). + 01 FS-B PIC X(2). + 01 FS-C PIC X(2). + 01 FS-D PIC X(2). + 01 FS-E PIC X(2). + 01 FS-F PIC X(2). + 01 FS-G PIC X(2). + 01 FS-OTHER PIC X(2). + 01 FS-AUDIT PIC X(2). + + *> Status flags + 01 WS-STATUS. + 05 WS-EOF-FLAG PIC X VALUE 'N'. + 88 WS-EOF VALUE 'Y' FALSE 'N'. + 05 WS-FIRST-REC PIC X VALUE 'Y'. + 88 WS-FIRST VALUE 'Y' FALSE 'N'. + + *> Counters per tier + 01 WS-COUNTERS. + 05 WS-COUNT-A PIC 9(5) VALUE 0. + 05 WS-COUNT-B PIC 9(5) VALUE 0. + 05 WS-COUNT-C PIC 9(5) VALUE 0. + 05 WS-COUNT-D PIC 9(5) VALUE 0. + 05 WS-COUNT-E PIC 9(5) VALUE 0. + 05 WS-COUNT-F PIC 9(5) VALUE 0. + 05 WS-COUNT-G PIC 9(5) VALUE 0. + 05 WS-COUNT-OTHER PIC 9(5) VALUE 0. + + *> Hash totals + 01 WS-HASH-TOTALS. + 05 WS-HASH-IN PIC 9(12) VALUE 0. + 05 WS-HASH-OUT-A PIC 9(12) VALUE 0. + 05 WS-HASH-OUT-B PIC 9(12) VALUE 0. + 05 WS-HASH-OUT-C PIC 9(12) VALUE 0. + 05 WS-HASH-OUT-D PIC 9(12) VALUE 0. + 05 WS-HASH-OUT-E PIC 9(12) VALUE 0. + 05 WS-HASH-OUT-F PIC 9(12) VALUE 0. + 05 WS-HASH-OUT-G PIC 9(12) VALUE 0. + 05 WS-HASH-OUT-OTHER PIC 9(12) VALUE 0. + 05 WS-HASH-VERIFIED PIC X(3) VALUE 'NO '. + 88 WS-HASH-OK VALUE 'YES'. + + *> Batch totals + 01 WS-BATCH-TOTALS. + 05 WS-RECORDS-READ PIC 9(5) VALUE 0. + 05 WS-RECORDS-WRITTEN PIC 9(5) VALUE 0. + 05 WS-ERROR-COUNT PIC 9(5) VALUE 0. + 05 WS-WARN-COUNT PIC 9(5) VALUE 0. + 05 WS-BATCH-DATE PIC 9(8). + 05 WS-BATCH-TIME PIC 9(8). + 05 WS-BATCH-TOTAL-AMT PIC 9(15) VALUE 0. + 05 WS-HASH-TOTAL PIC 9(15) VALUE 0. + + *> Timestamp fields + 01 WS-DATE-TIME. + 05 WS-DATE PIC X(10). + 05 WS-TIME PIC X(10). + 01 WS-TIMESTAMP PIC X(20). + + 01 WS-DATA2-NUM PIC 9(10). + 01 WS-TRUE-FALSE PIC X. + 88 WS-IS-TRUE VALUE 'Y' FALSE 'N'. + + *> Telecom business rule fields + 01 WS-PLAN-RULES. + 05 WS-CALL-TYPE PIC X(10). + 05 WS-DESTINATION PIC X(10). + 05 WS-DURATION-CAT PIC X(10). + 05 WS-DATA-CAP PIC 9(6). + 05 WS-INTL-RATE PIC 9(3)V99. + 05 WS-PLAN-NAME PIC X(10). + 05 WS-PLAN-RATE PIC 9(5)V99. + 05 WS-PEAK-FLAG PIC X. + 88 WS-PEAK VALUE 'P'. + 88 WS-OFF-PEAK VALUE 'O'. + 05 WS-DAY-TYPE PIC X. + 88 WS-WEEKDAY VALUE 'W'. + 88 WS-WEEKEND VALUE 'E'. + 05 WS-DOM-ROAM PIC X. + 88 WS-DOMESTIC VALUE 'D'. + 88 WS-ROAMING VALUE 'R'. + 05 WS-MIN-CHARGE PIC 9(5)V99 VALUE 5.00. + 05 WS-CAP-AMOUNT PIC 9(9)V99 VALUE 99999.99. + 05 WS-FALLBACK-RATE PIC 9(5)V99 VALUE 2.00. + 05 WS-PLAN-CODE PIC X(03). + + *> Audit fields + 01 WS-AUDIT-LINE. + 05 AU-TIMESTAMP PIC X(20). + 05 FILLER PIC X VALUE SPACE. + 05 AU-TIER PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 AU-KEY PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 AU-AMOUNT PIC Z(9)9. + 05 FILLER PIC X VALUE SPACE. + 05 AU-STATUS PIC X(15). + + *> Error fields + 01 WS-SEVERITY PIC X(10). + 01 WS-ERROR-MSG PIC X(60). + + PROCEDURE DIVISION. + * + 1000-INIT-SECTION. + * + 1000-INIT. + MOVE FUNCTION CURRENT-DATE (1:10) TO WS-DATE + MOVE FUNCTION CURRENT-DATE (12:8) TO WS-TIME + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-BATCH-DATE + MOVE FUNCTION CURRENT-DATE (12:8) TO WS-BATCH-TIME + STRING WS-DATE ' ' WS-TIME INTO WS-TIMESTAMP + DISPLAY '[' WS-TIMESTAMP '] BranchEval STARTED' + DISPLAY ' ' + PERFORM 2000-OPEN-FILES-SECTION + PERFORM 5000-AUDIT-SECTION + THRU AUDIT-LOG-START + . + * + 2000-OPEN-FILES-SECTION. + * + 2000-OPEN-FILES. + OPEN INPUT FILE-IN + IF FS-IN NOT = '00' + MOVE 'FATAL' TO WS-SEVERITY + STRING 'Open FILE-IN failed FS=' FS-IN + INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + STOP RUN + END-IF + + OPEN OUTPUT FILE-A FILE-B FILE-C + FILE-D FILE-E FILE-F + FILE-G FILE-OTHER + IF FS-A NOT = '00' OR FS-B NOT = '00' + OR FS-C NOT = '00' OR FS-D NOT = '00' + OR FS-E NOT = '00' OR FS-F NOT = '00' + OR FS-G NOT = '00' OR FS-OTHER NOT = '00' + MOVE 'FATAL' TO WS-SEVERITY + STRING 'Open output files failed' + INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + STOP RUN + END-IF + + OPEN OUTPUT FILE-AUDIT + IF FS-AUDIT NOT = '00' + DISPLAY 'WARNING: Audit file open failed FS=' + FS-AUDIT + END-IF + + DISPLAY 'Files opened successfully' + . + * + 3000-PROCESS-SECTION. + * + 3000-PROCESS. + DISPLAY 'Processing records with EVALUATE...' + PERFORM UNTIL WS-EOF + PERFORM 3100-READ-INPUT-SECTION + IF NOT WS-EOF + PERFORM 3200-VALIDATE-SECTION + PERFORM 3300-APPLY-RULES-SECTION + END-IF + END-PERFORM + . + * + 3100-READ-INPUT-SECTION. + * + 3100-READ-INPUT. + READ FILE-IN INTO FILE-IN-REC + AT END SET WS-EOF TO TRUE + NOT AT END + ADD 1 TO WS-RECORDS-READ + ADD WS-DATA2-NUM TO WS-HASH-IN + IF FS-IN NOT = '00' + MOVE 'ERROR' TO WS-SEVERITY + STRING 'Read FILE-IN FS=' FS-IN + INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + END-READ + . + * + 3200-VALIDATE-SECTION. + * + 3200-VALIDATE. + MOVE IN-DATA2 TO WS-DATA2-NUM + + *> Plan code validation + IF IN-KEY = SPACES OR IN-KEY = LOW-VALUES + MOVE 'WARNING' TO WS-SEVERITY + STRING 'Empty plan code detected' + INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + + *> Duration range validation + IF WS-DATA2-NUM = 0 + MOVE 'WARNING' TO WS-SEVERITY + STRING 'Zero duration: ' IN-KEY + INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + + *> Set call type and destination from DATA1 + EVALUATE IN-DATA1 (1:4) + WHEN 'PEAK' + MOVE 'PEAK' TO WS-CALL-TYPE + MOVE 'DOM' TO WS-DESTINATION + WHEN 'OFFP' + MOVE 'OFF-PEAK' TO WS-CALL-TYPE + MOVE 'DOM' TO WS-DESTINATION + WHEN 'ROAM' + MOVE 'PEAK' TO WS-CALL-TYPE + MOVE 'INTL' TO WS-DESTINATION + WHEN 'WKND' + MOVE 'OFF-PEAK' TO WS-CALL-TYPE + MOVE 'DOM' TO WS-DESTINATION + WHEN OTHER + MOVE 'STANDARD' TO WS-CALL-TYPE + MOVE 'DOM' TO WS-DESTINATION + END-EVALUATE + + *> Duration category + EVALUATE TRUE + WHEN WS-DATA2-NUM <= 60 + MOVE 'SHORT' TO WS-DURATION-CAT + WHEN WS-DATA2-NUM <= 300 + MOVE 'MEDIUM' TO WS-DURATION-CAT + WHEN WS-DATA2-NUM <= 1800 + MOVE 'LONG' TO WS-DURATION-CAT + WHEN OTHER + MOVE 'EXTENDED' TO WS-DURATION-CAT + END-EVALUATE + . + * + 3300-APPLY-RULES-SECTION. + * + 3300-APPLY-RULES. + *> ============================================================ + *> ORIGINAL EVALUATE with ALSO — 3-way preserved + *> Expanded to 8-way: A, B, C, D, E, F, G, OTHER + *> ============================================================ + EVALUATE IN-KEY ALSO WS-DATA2-NUM + WHEN 'A' ALSO ANY + MOVE IN-KEY TO A-KEY + MOVE IN-DATA1 TO A-DATA1 + MOVE IN-DATA2 TO A-DATA2 + WRITE FILE-A-REC + IF FS-A NOT = '00' + MOVE 'FATAL' TO WS-SEVERITY + STRING 'Write FILE-A FS=' FS-A + INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + ADD 1 TO WS-COUNT-A + ADD WS-DATA2-NUM TO WS-HASH-OUT-A + ADD 1 TO WS-RECORDS-WRITTEN + DISPLAY ' -> Key=''A'' routed to FILE-A' + MOVE 'BASIC-P01' TO WS-PLAN-NAME + + WHEN 'B' ALSO ANY + MOVE IN-KEY TO B-KEY + MOVE IN-DATA1 TO B-DATA1 + MOVE IN-DATA2 TO B-DATA2 + WRITE FILE-B-REC + IF FS-B NOT = '00' + MOVE 'FATAL' TO WS-SEVERITY + STRING 'Write FILE-B FS=' FS-B + INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + ADD 1 TO WS-COUNT-B + ADD WS-DATA2-NUM TO WS-HASH-OUT-B + ADD 1 TO WS-RECORDS-WRITTEN + DISPLAY ' -> Key=''B'' routed to FILE-B' + MOVE 'BUSINESS-P02' TO WS-PLAN-NAME + + WHEN 'C' ALSO ANY + MOVE IN-KEY TO C-KEY + MOVE IN-DATA1 TO C-DATA1 + MOVE IN-DATA2 TO C-DATA2 + WRITE FILE-C-REC + IF FS-C NOT = '00' + MOVE 'FATAL' TO WS-SEVERITY + STRING 'Write FILE-C FS=' FS-C + INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + ADD 1 TO WS-COUNT-C + ADD WS-DATA2-NUM TO WS-HASH-OUT-C + ADD 1 TO WS-RECORDS-WRITTEN + DISPLAY ' -> Key=''C'' routed to FILE-C' + MOVE 'UNLIMITED-P03' TO WS-PLAN-NAME + + WHEN 'D' ALSO ANY + MOVE IN-KEY TO D-KEY + MOVE IN-DATA1 TO D-DATA1 + MOVE IN-DATA2 TO D-DATA2 + WRITE FILE-D-REC + IF FS-D NOT = '00' + MOVE 'FATAL' TO WS-SEVERITY + STRING 'Write FILE-D FS=' FS-D + INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + ADD 1 TO WS-COUNT-D + ADD WS-DATA2-NUM TO WS-HASH-OUT-D + ADD 1 TO WS-RECORDS-WRITTEN + DISPLAY ' -> Key=''D'' routed to FILE-D' + MOVE 'FAMILY-P04' TO WS-PLAN-NAME + + WHEN 'E' ALSO ANY + MOVE IN-KEY TO E-KEY + MOVE IN-DATA1 TO E-DATA1 + MOVE IN-DATA2 TO E-DATA2 + WRITE FILE-E-REC + IF FS-E NOT = '00' + MOVE 'FATAL' TO WS-SEVERITY + STRING 'Write FILE-E FS=' FS-E + INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + ADD 1 TO WS-COUNT-E + ADD WS-DATA2-NUM TO WS-HASH-OUT-E + ADD 1 TO WS-RECORDS-WRITTEN + DISPLAY ' -> Key=''E'' routed to FILE-E' + MOVE 'STUDENT-P05' TO WS-PLAN-NAME + + WHEN 'F' ALSO ANY + MOVE IN-KEY TO F-KEY + MOVE IN-DATA1 TO F-DATA1 + MOVE IN-DATA2 TO F-DATA2 + WRITE FILE-F-REC + IF FS-F NOT = '00' + MOVE 'FATAL' TO WS-SEVERITY + STRING 'Write FILE-F FS=' FS-F + INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + ADD 1 TO WS-COUNT-F + ADD WS-DATA2-NUM TO WS-HASH-OUT-F + ADD 1 TO WS-RECORDS-WRITTEN + DISPLAY ' -> Key=''F'' routed to FILE-F' + MOVE 'SENIOR-P06' TO WS-PLAN-NAME + + WHEN 'G' ALSO ANY + MOVE IN-KEY TO G-KEY + MOVE IN-DATA1 TO G-DATA1 + MOVE IN-DATA2 TO G-DATA2 + WRITE FILE-G-REC + IF FS-G NOT = '00' + MOVE 'FATAL' TO WS-SEVERITY + STRING 'Write FILE-G FS=' FS-G + INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + ADD 1 TO WS-COUNT-G + ADD WS-DATA2-NUM TO WS-HASH-OUT-G + ADD 1 TO WS-RECORDS-WRITTEN + DISPLAY ' -> Key=''G'' routed to FILE-G' + MOVE 'CORP-P07' TO WS-PLAN-NAME + + WHEN OTHER + MOVE IN-KEY TO O-KEY + MOVE IN-DATA1 TO O-DATA1 + MOVE IN-DATA2 TO O-DATA2 + WRITE FILE-OTHER-REC + IF FS-OTHER NOT = '00' + MOVE 'FATAL' TO WS-SEVERITY + STRING 'Write FILE-OTHER FS=' FS-OTHER + INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + ADD 1 TO WS-COUNT-OTHER + ADD WS-DATA2-NUM TO WS-HASH-OUT-OTHER + ADD 1 TO WS-RECORDS-WRITTEN + DISPLAY ' -> Key=''' IN-KEY + ''' routed to FILE-OTHER' + MOVE 'FALLBACK' TO WS-PLAN-NAME + END-EVALUATE + + *> ============================================================ + *> ORIGINAL EVALUATE TRUE/FALSE — preserved + *> ============================================================ + IF WS-DATA2-NUM > 5000 + SET WS-IS-TRUE TO TRUE + ELSE + MOVE 'N' TO WS-TRUE-FALSE + END-IF + + EVALUATE TRUE + WHEN WS-DATA2-NUM < 1000 + DISPLAY ' [EVAL TRUE] DATA2 small (< 1000)' + WHEN WS-DATA2-NUM >= 1000 + AND WS-DATA2-NUM <= 5000 + DISPLAY ' [EVAL TRUE] DATA2 medium (1000-5000)' + WHEN WS-IS-TRUE + DISPLAY ' [EVAL TRUE] DATA2 large (> 5000)' + WHEN OTHER + DISPLAY ' [EVAL TRUE] OTHER (unexpected)' + END-EVALUATE + + *> ============================================================ + *> ORIGINAL EVALUATE multi-value WHEN — preserved + *> ============================================================ + EVALUATE IN-DATA1 (1:7) + WHEN 'SPECIAL' + WHEN 'SPECIAL' + DISPLAY ' [EVAL MULTI] DATA1 starts with SPECIAL' + WHEN 'HIGH' + DISPLAY ' [EVAL MULTI] DATA1 starts with HIGH' + WHEN OTHER + DISPLAY ' [EVAL MULTI] DATA1 starts with normal' + END-EVALUATE + + *> NEW: EVALUATE for multi-factor plan rules + EVALUATE WS-CALL-TYPE ALSO WS-DESTINATION + ALSO WS-DURATION-CAT + WHEN 'PEAK' ALSO 'DOM' ALSO 'SHORT' + DISPLAY ' [MULTI] Peak Domestic Short' + WHEN 'PEAK' ALSO 'DOM' ALSO ANY + DISPLAY ' [MULTI] Peak Domestic Any' + WHEN 'OFF-PEAK' ALSO 'DOM' ALSO ANY + DISPLAY ' [MULTI] Off-Peak Domestic Any' + WHEN ANY ALSO 'INTL' ALSO ANY + DISPLAY ' [MULTI] International call' + WHEN OTHER + DISPLAY ' [MULTI] Unmapped call combo' + END-EVALUATE + + *> NEW: EVALUATE for data cap rules + EVALUATE WS-DATA-CAP + WHEN 0 THRU 1000 + DISPLAY ' [DATA-CAP] Low: ' WS-DATA-CAP 'MB' + WHEN 1001 THRU 5000 + DISPLAY ' [DATA-CAP] Medium: ' WS-DATA-CAP 'MB' + WHEN 5001 THRU 99999 + DISPLAY ' [DATA-CAP] High: ' WS-DATA-CAP 'MB' + WHEN OTHER + DISPLAY ' [DATA-CAP] Unlimited or unknown' + END-EVALUATE + + *> NEW: Nested EVALUATE for plan-specific business rules + *> (data cap, international rates per plan tier) + MOVE SPACES TO WS-PLAN-CODE + EVALUATE IN-KEY + WHEN 'A' MOVE 'P01' TO WS-PLAN-CODE + WHEN 'B' MOVE 'P02' TO WS-PLAN-CODE + WHEN 'C' MOVE 'P03' TO WS-PLAN-CODE + WHEN 'D' MOVE 'P04' TO WS-PLAN-CODE + WHEN 'E' MOVE 'P05' TO WS-PLAN-CODE + WHEN 'F' MOVE 'P06' TO WS-PLAN-CODE + WHEN 'G' MOVE 'P07' TO WS-PLAN-CODE + WHEN OTHER MOVE 'P00' TO WS-PLAN-CODE + END-EVALUATE + + EVALUATE WS-PLAN-CODE + WHEN 'P01' + MOVE 1000 TO WS-DATA-CAP + MOVE 2.50 TO WS-INTL-RATE + EVALUATE TRUE + WHEN WS-DURATION-CAT = 'LONG' + DISPLAY ' [P01 MAX] Basic long call' + WHEN WS-DURATION-CAT = 'EXTENDED' + DISPLAY ' [P01 CAP] Basic cap applied' + END-EVALUATE + DISPLAY ' [PLAN P01] Basic plan rules' + + WHEN 'P02' + MOVE 5000 TO WS-DATA-CAP + MOVE 1.50 TO WS-INTL-RATE + EVALUATE TRUE + WHEN WS-DURATION-CAT = 'LONG' + DISPLAY ' [P02 DISCOUNT] Business bulk' + WHEN WS-DURATION-CAT = 'EXTENDED' + DISPLAY ' [P02 CAP] Business cap warning' + END-EVALUATE + DISPLAY ' [PLAN P02] Business plan rules' + + WHEN 'P03' + MOVE 99999 TO WS-DATA-CAP + MOVE 0.50 TO WS-INTL-RATE + DISPLAY ' [PLAN P03] Unlimited - no data cap' + + WHEN 'P04' + MOVE 8000 TO WS-DATA-CAP + MOVE 1.00 TO WS-INTL-RATE + EVALUATE WS-DURATION-CAT ALSO WS-DESTINATION + WHEN 'LONG' ALSO 'INTL' + DISPLAY ' [P04 FAM] Family intl discount' + WHEN 'EXTENDED' ALSO ANY + DISPLAY ' [P04 FAM] Family extended cap' + WHEN OTHER + DISPLAY ' [P04 FAM] Standard family rate' + END-EVALUATE + + WHEN 'P05' + MOVE 2000 TO WS-DATA-CAP + MOVE 1.75 TO WS-INTL-RATE + DISPLAY ' [PLAN P05] Student plan - limited cap' + + WHEN 'P06' + MOVE 1500 TO WS-DATA-CAP + MOVE 1.25 TO WS-INTL-RATE + DISPLAY ' [PLAN P06] Senior plan - reduced rates' + + WHEN 'P07' + MOVE 50000 TO WS-DATA-CAP + MOVE 0.75 TO WS-INTL-RATE + DISPLAY ' [PLAN P07] Corporate plan - bulk rates' + + WHEN OTHER + MOVE 500 TO WS-DATA-CAP + MOVE 3.00 TO WS-INTL-RATE + DISPLAY ' [PLAN P00] Default plan - basic rates' + END-EVALUATE + + *> NEW: EVALUATE TRUE/FALSE for weekday/weekend and domestic/roaming + EVALUATE IN-DATA1 (1:4) + WHEN 'PEAK' + WHEN 'ROAM' + SET WS-PEAK TO TRUE + WHEN 'OFFP' + WHEN 'WKND' + SET WS-OFF-PEAK TO TRUE + WHEN OTHER + MOVE 'P' TO WS-PEAK-FLAG + END-EVALUATE + EVALUATE IN-DATA1 (1:4) + WHEN 'WKND' + SET WS-WEEKEND TO TRUE + WHEN 'PEAK' + SET WS-WEEKDAY TO TRUE + WHEN 'OFFP' + SET WS-WEEKDAY TO TRUE + WHEN OTHER + SET WS-WEEKDAY TO TRUE + END-EVALUATE + EVALUATE IN-DATA1 (1:4) + WHEN 'ROAM' + SET WS-ROAMING TO TRUE + WHEN OTHER + SET WS-DOMESTIC TO TRUE + END-EVALUATE + + EVALUATE TRUE ALSO TRUE ALSO TRUE + WHEN WS-PEAK ALSO WS-WEEKDAY ALSO WS-DOMESTIC + DISPLAY ' [TIME/DST] Peak weekday domestic' + WHEN WS-PEAK ALSO WS-WEEKEND ALSO WS-DOMESTIC + DISPLAY ' [TIME/DST] Peak weekend domestic' + WHEN WS-OFF-PEAK ALSO WS-WEEKDAY ALSO WS-DOMESTIC + DISPLAY ' [TIME/DST] Off-peak weekday domestic' + WHEN WS-OFF-PEAK ALSO WS-WEEKEND ALSO WS-DOMESTIC + DISPLAY ' [TIME/DST] Off-peak weekend domestic' + WHEN WS-PEAK ALSO WS-WEEKDAY ALSO WS-ROAMING + DISPLAY ' [TIME/DST] Peak weekday roaming' + WHEN WS-PEAK ALSO WS-WEEKEND ALSO WS-ROAMING + DISPLAY ' [TIME/DST] Peak weekend roaming' + WHEN WS-OFF-PEAK ALSO WS-WEEKDAY ALSO WS-ROAMING + DISPLAY ' [TIME/DST] Off-peak weekday roaming' + WHEN WS-OFF-PEAK ALSO WS-WEEKEND ALSO WS-ROAMING + DISPLAY ' [TIME/DST] Off-peak weekend roaming' + WHEN OTHER + DISPLAY ' [TIME/DST] Unmapped time/destination' + END-EVALUATE + + *> NEW: EVALUATE for peak flag + EVALUATE WS-PEAK-FLAG + WHEN 'P' + DISPLAY ' [PEAK] Peak rate applies' + WHEN 'O' + DISPLAY ' [PEAK] Off-peak rate applies' + WHEN OTHER + DISPLAY ' [PEAK] Undefined peak flag' + END-EVALUATE + + *> NEW: Minimum charge check using EVALUATE + EVALUATE TRUE + WHEN WS-PLAN-NAME = SPACES + MOVE WS-FALLBACK-RATE TO WS-PLAN-RATE + DISPLAY ' [MIN-CHG] Fallback rate applied' + WHEN WS-PLAN-RATE < WS-MIN-CHARGE + MOVE 'WARNING' TO WS-SEVERITY + STRING 'Rate below min charge: ' + WS-PLAN-RATE INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + WHEN OTHER + CONTINUE + END-EVALUATE + + *> NEW: Cap check using EVALUATE + EVALUATE TRUE + WHEN WS-PLAN-RATE > WS-CAP-AMOUNT + MOVE 'WARNING' TO WS-SEVERITY + STRING 'Rate exceeds cap: ' + WS-PLAN-RATE INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + WHEN OTHER + CONTINUE + END-EVALUATE + + *> NEW: Fallback default rate - EVALUATE multiple WHEN + EVALUATE WS-PLAN-NAME + WHEN SPACES + WHEN LOW-VALUES + WHEN 'FALLBACK' + MOVE WS-FALLBACK-RATE TO WS-PLAN-RATE + MOVE 'STANDARD' TO WS-PLAN-NAME + DISPLAY ' [FALLBACK] Default rate for unmapped' + WHEN OTHER + DISPLAY ' [FALLBACK] Plan ' WS-PLAN-NAME + ' has valid rate' + END-EVALUATE + + *> NEW: EVALUATE for rate lookup validation per plan + EVALUATE WS-PLAN-RATE ALSO WS-PLAN-CODE + WHEN 0.00 THRU 5.00 ALSO 'P01' + DISPLAY ' [RATE-VAL] P01 rate: ' WS-PLAN-RATE + WHEN 0.00 THRU 10.00 ALSO 'P02' + DISPLAY ' [RATE-VAL] P02 rate: ' WS-PLAN-RATE + WHEN 0.00 THRU 20.00 ALSO 'P03' + DISPLAY ' [RATE-VAL] P03 rate: ' WS-PLAN-RATE + WHEN 0.00 THRU 8.00 ALSO 'P04' + DISPLAY ' [RATE-VAL] P04 rate: ' WS-PLAN-RATE + WHEN 0.00 THRU 6.00 ALSO 'P05' + DISPLAY ' [RATE-VAL] P05 rate: ' WS-PLAN-RATE + WHEN 0.00 THRU 5.00 ALSO 'P06' + DISPLAY ' [RATE-VAL] P06 rate: ' WS-PLAN-RATE + WHEN 0.00 THRU 25.00 ALSO 'P07' + DISPLAY ' [RATE-VAL] P07 rate: ' WS-PLAN-RATE + WHEN OTHER + MOVE 'WARNING' TO WS-SEVERITY + STRING 'Rate ' WS-PLAN-RATE ' invalid for plan ' + WS-PLAN-CODE INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-EVALUATE + + *> NEW: Error severity classification using EVALUATE + EVALUATE WS-ERROR-COUNT + WHEN 0 + DISPLAY ' [SEVERITY] No errors - clean batch' + WHEN 1 THRU 5 + DISPLAY ' [SEVERITY] Low error count (1-5)' + WHEN 6 THRU 20 + DISPLAY ' [SEVERITY] Medium error count (6-20)' + WHEN 21 THRU 99999 + DISPLAY ' [SEVERITY] High error count (>20)' + WHEN OTHER + DISPLAY ' [SEVERITY] Error count overflow' + END-EVALUATE + EVALUATE WS-WARN-COUNT + WHEN 0 + DISPLAY ' [SEVERITY] No warnings' + WHEN 1 THRU 10 + DISPLAY ' [SEVERITY] Low warning count (1-10)' + WHEN 11 THRU 50 + DISPLAY ' [SEVERITY] Medium warning count (11-50)' + WHEN 51 THRU 99999 + DISPLAY ' [SEVERITY] High warning count (>50)' + WHEN OTHER + DISPLAY ' [SEVERITY] Warning count overflow' + END-EVALUATE + + PERFORM 5000-AUDIT-SECTION + THRU AUDIT-LOG-RECORD + . + * + 3400-WRITE-OUTPUT-SECTION. + * + 3400-WRITE-OUTPUT. + *> Writing is handled within each EVALUATE WHEN branch + . + * + 4000-REPORT-SECTION. + * + 4000-REPORT. + DISPLAY ' ' + DISPLAY '=== RESULTS ===' + DISPLAY 'FILE-A (P01 Basic): ' WS-COUNT-A ' records' + DISPLAY 'FILE-B (P02 Bus): ' WS-COUNT-B ' records' + DISPLAY 'FILE-C (P03 Unlim): ' WS-COUNT-C ' records' + DISPLAY 'FILE-D (P04 Fam): ' WS-COUNT-D ' records' + DISPLAY 'FILE-E (P05 Stdnt): ' WS-COUNT-E ' records' + DISPLAY 'FILE-F (P06 Senior): ' WS-COUNT-F ' records' + DISPLAY 'FILE-G (P07 Corp): ' WS-COUNT-G ' records' + DISPLAY 'FILE-OTHER: ' WS-COUNT-OTHER ' records' + DISPLAY ' ' + DISPLAY 'Total records read: ' WS-RECORDS-READ + DISPLAY 'Total records written: ' WS-RECORDS-WRITTEN + DISPLAY 'Errors: ' WS-ERROR-COUNT + DISPLAY 'Warnings: ' WS-WARN-COUNT + + *> Hash total verification + DISPLAY ' ' + DISPLAY 'Hash total verification:' + DISPLAY ' Input hash: ' WS-HASH-IN + DISPLAY ' Out-A hash: ' WS-HASH-OUT-A + DISPLAY ' Out-B hash: ' WS-HASH-OUT-B + DISPLAY ' Out-C hash: ' WS-HASH-OUT-C + DISPLAY ' Out-D hash: ' WS-HASH-OUT-D + DISPLAY ' Out-E hash: ' WS-HASH-OUT-E + DISPLAY ' Out-F hash: ' WS-HASH-OUT-F + DISPLAY ' Out-G hash: ' WS-HASH-OUT-G + DISPLAY ' Out-Other hash:' WS-HASH-OUT-OTHER + + IF WS-HASH-IN = + (WS-HASH-OUT-A + WS-HASH-OUT-B + WS-HASH-OUT-C + + WS-HASH-OUT-D + WS-HASH-OUT-E + WS-HASH-OUT-F + + WS-HASH-OUT-G + WS-HASH-OUT-OTHER) + MOVE 'YES' TO WS-HASH-VERIFIED + DISPLAY ' HASH VERIFICATION: PASSED' + ELSE + MOVE 'NO ' TO WS-HASH-VERIFIED + DISPLAY ' HASH VERIFICATION: FAILED' + END-IF + + *> Batch control totals + COMPUTE WS-BATCH-TOTAL-AMT = + WS-HASH-OUT-A + WS-HASH-OUT-B + WS-HASH-OUT-C + + WS-HASH-OUT-D + WS-HASH-OUT-E + WS-HASH-OUT-F + + WS-HASH-OUT-G + WS-HASH-OUT-OTHER + MOVE WS-HASH-IN TO WS-HASH-TOTAL + DISPLAY ' ' + DISPLAY 'Batch Control:' + DISPLAY ' Batch Date: ' WS-BATCH-DATE + DISPLAY ' Batch Time: ' WS-BATCH-TIME + DISPLAY ' Total Amt: ' WS-BATCH-TOTAL-AMT + DISPLAY ' Hash Total: ' WS-HASH-TOTAL + . + * + 5000-AUDIT-SECTION. + * + AUDIT-LOG-START. + MOVE WS-TIMESTAMP TO AU-TIMESTAMP + MOVE 'START' TO AU-TIER + MOVE 'PROGRAM' TO AU-KEY + MOVE 0 TO AU-AMOUNT + MOVE 'OK' TO AU-STATUS + WRITE FILE-AUDIT-REC FROM WS-AUDIT-LINE + IF FS-AUDIT NOT = '00' + DISPLAY 'Audit write warning FS=' FS-AUDIT + END-IF + . + + AUDIT-LOG-RECORD. + MOVE WS-TIMESTAMP TO AU-TIMESTAMP + MOVE IN-KEY TO AU-TIER + MOVE IN-KEY TO AU-KEY + MOVE WS-DATA2-NUM TO AU-AMOUNT + MOVE 'OK' TO AU-STATUS + WRITE FILE-AUDIT-REC FROM WS-AUDIT-LINE + IF FS-AUDIT NOT = '00' + DISPLAY 'Audit write warning FS=' FS-AUDIT + END-IF + . + + AUDIT-LOG-FINISH. + MOVE WS-TIMESTAMP TO AU-TIMESTAMP + MOVE 'END' TO AU-TIER + MOVE 'PROGRAM' TO AU-KEY + MOVE WS-RECORDS-READ TO AU-AMOUNT + STRING 'REC=' WS-RECORDS-READ + ' ERR=' WS-ERROR-COUNT + INTO AU-STATUS + WRITE FILE-AUDIT-REC FROM WS-AUDIT-LINE + IF FS-AUDIT NOT = '00' + DISPLAY 'Audit write warning FS=' FS-AUDIT + END-IF + . + * + 6000-ERROR-HANDLE-SECTION. + * + 6000-ERROR-HANDLE. + DISPLAY '[' WS-TIMESTAMP '] [' WS-SEVERITY '] ' + WS-ERROR-MSG + IF WS-SEVERITY = 'FATAL' + PERFORM 9000-EXIT-SECTION + STOP RUN + ELSE + IF WS-SEVERITY = 'ERROR' + ADD 1 TO WS-ERROR-COUNT + ELSE + IF WS-SEVERITY = 'WARNING' + ADD 1 TO WS-WARN-COUNT + END-IF + END-IF + END-IF + . + * + 9000-EXIT-SECTION. + * + 9000-EXIT. + MOVE FUNCTION CURRENT-DATE (1:10) TO WS-DATE + MOVE FUNCTION CURRENT-DATE (12:8) TO WS-TIME + STRING WS-DATE ' ' WS-TIME INTO WS-TIMESTAMP + + PERFORM 4000-REPORT-SECTION + PERFORM 5000-AUDIT-SECTION + THRU AUDIT-LOG-FINISH + + CLOSE FILE-IN FILE-A FILE-B FILE-C + FILE-D FILE-E FILE-F + FILE-G FILE-OTHER + IF FS-AUDIT NOT = '00' + CLOSE FILE-AUDIT + END-IF + + DISPLAY '[' WS-TIMESTAMP '] BranchEval COMPLETED' + . diff --git a/benchmark-programs/07-keybreak-summary/AUDIT-RPT.DAT b/benchmark-programs/07-keybreak-summary/AUDIT-RPT.DAT new file mode 100644 index 0000000..58257a2 --- /dev/null +++ b/benchmark-programs/07-keybreak-summary/AUDIT-RPT.DAT @@ -0,0 +1,11 @@ +16:45:29 PROGRAM STARTED - FILES OPENED +16:45:29 PROCESSING STARTED +16:45:29 RECORD VALIDATED +16:45:29 CUSTOMER HEADER WRITTEN +16:45:29 PLAN HEADER WRITTEN +16:45:29 RECORD VALIDATED +16:45:29 PLAN FOOTER WRITTEN +16:45:29 GROUP SUMMARY WRITTEN +16:45:29 FINAL REPORT GENERATED +16:45:29 ERRORS=000 WARNINGS=002 +16:45:29 PROGRAM COMPLETED NORMALLY diff --git a/benchmark-programs/07-keybreak-summary/FILE-IN.DAT b/benchmark-programs/07-keybreak-summary/FILE-IN.DAT new file mode 100644 index 0000000..0930d18 --- /dev/null +++ b/benchmark-programs/07-keybreak-summary/FILE-IN.DAT @@ -0,0 +1 @@ + 000000000 \ No newline at end of file diff --git a/benchmark-programs/07-keybreak-summary/FILE-OUT.DAT b/benchmark-programs/07-keybreak-summary/FILE-OUT.DAT new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/07-keybreak-summary/README.md b/benchmark-programs/07-keybreak-summary/README.md new file mode 100644 index 0000000..8c4dfe0 --- /dev/null +++ b/benchmark-programs/07-keybreak-summary/README.md @@ -0,0 +1,36 @@ +# 07-keybreak-summary — Key Break Summary + +## 电信业务场景 + +加入者月汇总。按客户ID进行key切汇总，计算每位客户当月的通话总量和总金额。输出每个客户的汇总记录。 + +Demonstrates the classic COBOL control-break (key break) pattern: + +- Read sorted input file grouped by KEY +- Compare WS-PREV-KEY to detect key change +- On key change: write summary (KEY, COUNT, TOTAL) and reset accumulators +- At end-of-file: write final group summary +- Accumulate grand total across all groups + +## Files + +| File | Purpose | +|------|---------| +| `main-07-keybreak-summary.cbl` | COBOL program (fixed format) | +| `data-gen.sh` | Generate sorted test data | +| `run.sh` | Compile, run, verify output | + +## Input Record + +| Field | Type | Length | +|-------|------|--------| +| KEY | PIC X | 10 | +| AMOUNT | PIC 9 | 10 | + +## Output Record + +| Field | Type | Notes | +|-------|------|-------| +| KEY | PIC X(10) | Group key | +| COUNT | PIC Z(5)9 | Record count in group | +| TOTAL | PIC Z(9)9 | Sum of AMOUNT in group | diff --git a/benchmark-programs/07-keybreak-summary/REPORT-OUT.DAT b/benchmark-programs/07-keybreak-summary/REPORT-OUT.DAT new file mode 100644 index 0000000..7cc67e7 --- /dev/null +++ b/benchmark-programs/07-keybreak-summary/REPORT-OUT.DAT @@ -0,0 +1,10 @@ + CUSTOMER: PLAN: + CUSTOMER: PLAN: + 0 + + Plan Total: 2 / 0 + ** CUSTOMER SUM CNT: 2 TOT: 0 MIN: 0 MAX: + GRAND TOTAL: 0 VERIFY: 0 STATUS: VERIFIED +HASH IN=000000000000000000 OUT=000000000000000000 +BATCH RECS=00002 AMT=0000000000 +ERRORS=000 WARNINGS=002 diff --git a/benchmark-programs/07-keybreak-summary/main-07-keybreak-summary.cbl b/benchmark-programs/07-keybreak-summary/main-07-keybreak-summary.cbl new file mode 100644 index 0000000..91b2db1 --- /dev/null +++ b/benchmark-programs/07-keybreak-summary/main-07-keybreak-summary.cbl @@ -0,0 +1,872 @@ + *> ============================================================ + *> main-07-keybreak-summary.cbl : 加入者月汇总 (EXPANDED) + *> Input : FILE-IN.DAT (按客户ID/套餐排序的用量记录) + *> Output: FILE-OUT.DAT (客户别月汇总: 金额合计,件数) + *> REPORT-OUT.DAT (格式化报告) + *> AUDIT-RPT.DAT (审计追踪) + *> Coverage: KB-N001, KB-N004~N006, KB-A001, KB-R001 + *> Expanded features: + *> 2-level key break (customer + plan) + *> Accumulator overflow handling + *> Statistics per group (min, max, avg, variance) + *> Page break control, formatted report output + *> Audit trail, hash totals, batch controls + *> FILE STATUS checks, error severity levels + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. KeyBreakSum. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN + ASSIGN TO "FILE-IN.DAT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-FILE-IN-STATUS. + + SELECT FILE-OUT + ASSIGN TO "FILE-OUT.DAT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-FILE-OUT-STATUS. + + SELECT AUDIT-REPORT + ASSIGN TO "AUDIT-RPT.DAT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-AUDIT-STATUS. + + SELECT REPORT-FILE + ASSIGN TO "REPORT-OUT.DAT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-REPORT-STATUS. + + DATA DIVISION. + FILE SECTION. + FD FILE-IN. + *> Expanded FD to match telecom copybook (45 bytes total) + *> Original IN-KEY and IN-AMOUNT preserved at same names + 01 FILE-IN-REC. + 05 IN-KEY PIC X(10). + 05 IN-CUST-ID PIC X(10). + 05 IN-PLAN-CODE PIC X(03). + 05 IN-AMOUNT PIC 9(09). + 05 IN-STATUS-FLAG PIC X(01). + 05 IN-RESERVED PIC X(12). + + FD FILE-OUT. + 01 FILE-OUT-REC. + 05 OUT-KEY PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 OUT-COUNT PIC Z(9)9. + 05 FILLER PIC X(03) VALUE SPACE. + 05 OUT-TOTAL PIC Z(9)9. + + FD AUDIT-REPORT. + 01 AUDIT-REC PIC X(80). + + FD REPORT-FILE. + 01 REPORT-REC PIC X(80). + + WORKING-STORAGE SECTION. + *> File status fields + 01 WS-FILE-STATUS. + 05 WS-FILE-IN-STATUS PIC X(02). + 05 WS-FILE-OUT-STATUS PIC X(02). + 05 WS-AUDIT-STATUS PIC X(02). + 05 WS-REPORT-STATUS PIC X(02). + + *> Timestamp from FUNCTION CURRENT-DATE (21 chars) + 01 WS-TIMESTAMP-STR PIC X(21). + 01 WS-TS-FIELDS REDEFINES WS-TIMESTAMP-STR. + 05 WS-TS-YEAR PIC 9(4). + 05 WS-TS-MONTH PIC 9(2). + 05 WS-TS-DAY PIC 9(2). + 05 WS-TS-HOUR PIC 9(2). + 05 WS-TS-MINUTE PIC 9(2). + 05 WS-TS-SECOND PIC 9(2). + 05 WS-TS-HUND PIC 9(2). + 05 WS-TS-OFFSET PIC X(5). + + 01 WS-TELECOM-REC. + COPY "telecom/TEL-BILLING.cpy". + + *> Program status flags + 01 WS-STATUS. + 05 WS-EOF-FLAG PIC X VALUE 'N'. + 88 WS-EOF VALUE 'Y'. + 05 WS-FIRST-REC PIC X VALUE 'Y'. + 88 WS-FIRST VALUE 'Y'. + + *> Key fields for 2-level key break + 01 WS-KEY-FIELDS. + 05 WS-PREV-KEY PIC X(10). + 05 WS-CURRENT-KEY PIC X(10). + 05 WS-PREV-PLAN PIC X(03). + 05 WS-CURRENT-PLAN PIC X(03). + + *> Customer-level accumulators + 01 WS-ACCUMULATORS. + 05 WS-GROUP-COUNT PIC 9(5) VALUE 0. + 05 WS-GROUP-TOTAL PIC 9(10) VALUE 0. + 05 WS-GROUP-MIN PIC 9(10) VALUE 9999999999. + 05 WS-GROUP-MAX PIC 9(10) VALUE 0. + 05 WS-GROUP-AVG PIC 9(10)V99 VALUE 0. + 05 WS-GROUP-VAR PIC 9(10)V99 VALUE 0. + 05 WS-SUM-SQUARES PIC 9(20) VALUE 0. + + *> Plan-level accumulators + 01 WS-PLAN-ACCUMULATORS. + 05 WS-PLAN-COUNT PIC 9(5) VALUE 0. + 05 WS-PLAN-TOTAL PIC 9(10) VALUE 0. + 05 WS-PLAN-MIN PIC 9(10) VALUE 9999999999. + 05 WS-PLAN-MAX PIC 9(10) VALUE 0. + + *> Page and overflow control + 01 WS-CONTROL-FIELDS. + 05 WS-MAX-TOTAL PIC 9(10) VALUE 9999999999. + 05 WS-OVERFLOW-FLAG PIC X VALUE 'N'. + 88 WS-OVERFLOW VALUE 'Y'. + 05 WS-LINE-COUNT PIC 9(02) VALUE 0. + 05 WS-PAGE-LENGTH PIC 9(02) VALUE 60. + 05 WS-PAGE-NUM PIC 9(03) VALUE 1. + + *> Running totals + 01 WS-TOTALS. + 05 WS-GRAND-TOTAL PIC 9(10) VALUE 0. + 05 WS-GRAND-VERIFY PIC 9(10) VALUE 0. + 05 WS-GROUPS-WRITTEN PIC 9(5) VALUE 0. + 05 WS-RECORDS-READ PIC 9(5) VALUE 0. + 05 WS-RECORDS-WRITTEN PIC 9(5) VALUE 0. + 05 WS-ERROR-COUNT PIC 9(03) VALUE 0. + 05 WS-WARNING-COUNT PIC 9(03) VALUE 0. + + *> Hash totals for data integrity + 01 WS-HASH-TOTALS. + 05 WS-HASH-TOTAL-IN PIC 9(18) VALUE 0. + 05 WS-HASH-TOTAL-OUT PIC 9(18) VALUE 0. + + *> Batch control totals + 01 WS-BATCH-CONTROL. + 05 WS-BATCH-REC-EXP PIC 9(5) VALUE 0. + 05 WS-BATCH-AMT-EXP PIC 9(10) VALUE 0. + 05 WS-BATCH-STATUS PIC X(10) VALUE SPACES. + + *> Report header line (first page header) + 01 WS-HEADER-LINE. + 05 FILLER PIC X(10) VALUE SPACES. + 05 HL-TEXT PIC X(43) VALUE + "TELECOM BILLING - CUSTOMER SUMMARY REPORT". + 05 FILLER PIC X(27) VALUE SPACES. + + *> Page header (repeated each new page) + 01 WS-PAGE-HEADER. + 05 FILLER PIC X(05) VALUE "PAGE ". + 05 PH-PAGE-NUM PIC Z(9)9. + 05 FILLER PIC X(03) VALUE SPACES. + 05 PH-DATE PIC X(10). + 05 FILLER PIC X(62) VALUE SPACES. + + *> Customer-level group header + 01 WS-CUSTOMER-HEADER. + 05 FILLER PIC X(03) VALUE SPACES. + 05 CH-TEXT PIC X(10) VALUE "CUSTOMER: ". + 05 CH-KEY PIC X(10). + 05 FILLER PIC X(05) VALUE SPACES. + 05 CH-PLAN-TEXT PIC X(06) VALUE "PLAN: ". + 05 CH-PLAN PIC X(03). + 05 FILLER PIC X(43) VALUE SPACES. + + *> Plan-level footer + 01 WS-PLAN-FOOTER. + 05 FILLER PIC X(05) VALUE SPACES. + 05 PF-TEXT PIC X(12) VALUE "Plan Total: ". + 05 PF-PLAN PIC X(03). + 05 FILLER PIC X(03) VALUE SPACES. + 05 PF-COUNT PIC Z(9)9. + 05 FILLER PIC X(03) VALUE " / ". + 05 PF-TOTAL PIC Z(9)9. + 05 FILLER PIC X(38) VALUE SPACES. + + *> Customer-level group footer with statistics + 01 WS-GROUP-FOOTER. + 05 FILLER PIC X(03) VALUE SPACES. + 05 GF-TEXT PIC X(16) VALUE "** CUSTOMER SUM **". + 05 FILLER PIC X(02) VALUE SPACES. + 05 GF-COUNT-TEXT PIC X(05) VALUE "CNT: ". + 05 GF-COUNT PIC Z(9)9. + 05 FILLER PIC X(02) VALUE SPACES. + 05 GF-TOTAL-TEXT PIC X(05) VALUE "TOT: ". + 05 GF-TOTAL PIC Z(9)9. + 05 FILLER PIC X(02) VALUE SPACES. + 05 GF-MIN-TEXT PIC X(04) VALUE "MIN:". + 05 GF-MIN PIC Z(9)9. + 05 FILLER PIC X(02) VALUE SPACES. + 05 GF-MAX-TEXT PIC X(04) VALUE "MAX:". + 05 GF-MAX PIC Z(9)9. + 05 FILLER PIC X(02) VALUE SPACES. + 05 GF-AVG-TEXT PIC X(04) VALUE "AVG:". + 05 GF-AVG PIC Z(9)9.99. + 05 FILLER PIC X(06) VALUE SPACES. + + *> Grand total verification line + 01 WS-GRAND-TOTAL-LINE. + 05 FILLER PIC X(03) VALUE SPACES. + 05 GT-TEXT PIC X(14) VALUE "GRAND TOTAL: ". + 05 GT-VALUE PIC Z(9)9. + 05 FILLER PIC X(05) VALUE SPACES. + 05 GT-VERIFY-TEXT PIC X(08) VALUE "VERIFY: ". + 05 GT-VERIFY PIC Z(9)9. + 05 FILLER PIC X(05) VALUE SPACES. + 05 GT-STATUS-TEXT PIC X(08) VALUE "STATUS: ". + 05 GT-STATUS PIC X(10). + + *> Detail line for each input record + 01 WS-DETAIL-LINE. + 05 FILLER PIC X(05) VALUE SPACES. + 05 DL-KEY PIC X(10). + 05 FILLER PIC X(03) VALUE SPACES. + 05 DL-PLAN PIC X(03). + 05 FILLER PIC X(03) VALUE SPACES. + 05 DL-AMOUNT PIC Z(9)9. + 05 FILLER PIC X(46) VALUE SPACES. + + *> Audit record structure + 01 WS-AUDIT-REC. + 05 AR-TIMESTAMP PIC X(08). + 05 FILLER PIC X(01) VALUE SPACE. + 05 AR-TEXT PIC X(60). + 05 FILLER PIC X(11) VALUE SPACES. + + *> Error message structure with severity levels + 01 WS-ERROR-MESSAGE. + 05 FILLER PIC X(08) VALUE "ERROR: ". + 05 EM-SEVERITY PIC X(08). + 05 FILLER PIC X(03) VALUE " - ". + 05 EM-TEXT PIC X(50). + 05 FILLER PIC X(11) VALUE SPACES. + + PROCEDURE DIVISION. + MAIN SECTION. + MAIN-PROCEDURE. + PERFORM 1000-INIT-SECTION + PERFORM 2000-OPEN-FILES-SECTION + PERFORM 3000-PROCESS-SECTION + PERFORM 5000-AUDIT-SECTION + PERFORM 9000-EXIT-SECTION + STOP RUN. + + *> ============================================================ + *> 1000-INIT-SECTION + *> Initialize all accumulators, display program banner + *> ============================================================ + 1000-INIT-SECTION SECTION. + 1000-INIT-PROC. + DISPLAY " " + DISPLAY "==========================================" + DISPLAY " KeyBreakSummary - Telecom Billing" + DISPLAY " Phase: Monthly Aggregation" + DISPLAY "==========================================" + DISPLAY " " + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP-STR + MOVE 'N' TO WS-EOF-FLAG + MOVE 'Y' TO WS-FIRST-REC + MOVE 0 TO WS-GROUP-COUNT + MOVE 0 TO WS-GROUP-TOTAL + MOVE 9999999999 TO WS-GROUP-MIN + MOVE 0 TO WS-GROUP-MAX + MOVE 0 TO WS-GROUP-AVG + MOVE 0 TO WS-GROUP-VAR + MOVE 0 TO WS-SUM-SQUARES + MOVE 0 TO WS-PLAN-COUNT + MOVE 0 TO WS-PLAN-TOTAL + MOVE 9999999999 TO WS-PLAN-MIN + MOVE 0 TO WS-PLAN-MAX + MOVE 9999999999 TO WS-MAX-TOTAL + MOVE 'N' TO WS-OVERFLOW-FLAG + MOVE 0 TO WS-LINE-COUNT + MOVE 60 TO WS-PAGE-LENGTH + MOVE 1 TO WS-PAGE-NUM + MOVE 0 TO WS-GRAND-TOTAL + MOVE 0 TO WS-GRAND-VERIFY + MOVE 0 TO WS-GROUPS-WRITTEN + MOVE 0 TO WS-RECORDS-READ + MOVE 0 TO WS-RECORDS-WRITTEN + MOVE 0 TO WS-ERROR-COUNT + MOVE 0 TO WS-WARNING-COUNT + MOVE 0 TO WS-HASH-TOTAL-IN + MOVE 0 TO WS-HASH-TOTAL-OUT + MOVE 0 TO WS-BATCH-REC-EXP + MOVE 0 TO WS-BATCH-AMT-EXP + MOVE SPACES TO WS-BATCH-STATUS + + DISPLAY "INIT: " WS-TS-YEAR "-" WS-TS-MONTH "-" + WS-TS-DAY " " WS-TS-HOUR ":" WS-TS-MINUTE ":" + WS-TS-SECOND + DISPLAY "INIT: Page length = " WS-PAGE-LENGTH + DISPLAY " " + . + 1000-EXIT. + EXIT. + + *> ============================================================ + *> 2000-OPEN-FILES-SECTION + *> Open all four files with FILE STATUS checks + *> ============================================================ + 2000-OPEN-FILES-SECTION SECTION. + 2000-OPEN-FILES-PROC. + OPEN INPUT FILE-IN + IF WS-FILE-IN-STATUS NOT = '00' + MOVE "FATAL" TO EM-SEVERITY + MOVE "UNABLE TO OPEN FILE-IN.DAT" TO EM-TEXT + PERFORM 6000-ERROR-HANDLE-SECTION + STOP RUN + END-IF + + OPEN OUTPUT FILE-OUT + IF WS-FILE-OUT-STATUS NOT = '00' + MOVE "FATAL" TO EM-SEVERITY + MOVE "UNABLE TO OPEN FILE-OUT.DAT" TO EM-TEXT + PERFORM 6000-ERROR-HANDLE-SECTION + STOP RUN + END-IF + + OPEN OUTPUT AUDIT-REPORT + IF WS-AUDIT-STATUS NOT = '00' + MOVE "WARNING" TO EM-SEVERITY + MOVE "UNABLE TO OPEN AUDIT-RPT.DAT, CONTINUING" + TO EM-TEXT + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + + OPEN OUTPUT REPORT-FILE + IF WS-REPORT-STATUS NOT = '00' + MOVE "WARNING" TO EM-SEVERITY + MOVE "UNABLE TO OPEN REPORT-OUT.DAT, CONTINUING" + TO EM-TEXT + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP-STR + DISPLAY "OPEN: " WS-TS-HOUR ":" WS-TS-MINUTE ":" + WS-TS-SECOND " Files opened" + MOVE "PROGRAM STARTED - FILES OPENED" TO AR-TEXT + PERFORM 5000-WRITE-AUDIT + . + 2000-EXIT. + EXIT. + + *> ============================================================ + *> 3000-PROCESS-SECTION + *> Main processing loop: read, validate, apply rules + *> ============================================================ + 3000-PROCESS-SECTION SECTION. + 3000-PROCESS-PROC. + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP-STR + DISPLAY "PROC: " WS-TS-HOUR ":" WS-TS-MINUTE ":" + WS-TS-SECOND " Starting main loop" + MOVE "PROCESSING STARTED" TO AR-TEXT + PERFORM 5000-WRITE-AUDIT + + PERFORM 3100-READ-INPUT-SECTION + + PERFORM UNTIL WS-EOF + PERFORM 3200-VALIDATE-SECTION + PERFORM 3300-APPLY-RULES-SECTION + PERFORM 3100-READ-INPUT-SECTION + END-PERFORM + + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP-STR + DISPLAY "PROC: " WS-TS-HOUR ":" WS-TS-MINUTE ":" + WS-TS-SECOND " EOF reached" + + *> Close remaining plan group for last customer + IF WS-PLAN-COUNT > 0 + PERFORM WRITE-PLAN-FOOTER + END-IF + + *> Write final group summary (preserved original behavior) + IF WS-GROUP-COUNT > 0 + PERFORM WRITE-GROUP-SUMMARY + END-IF + + *> Write final formatted report + PERFORM 4000-REPORT-SECTION + + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP-STR + DISPLAY "PROC: " WS-TS-HOUR ":" WS-TS-MINUTE ":" + WS-TS-SECOND " Main loop complete" + . + 3000-EXIT. + EXIT. + + *> ============================================================ + *> 3100-READ-INPUT-SECTION + *> Read one record from FILE-IN, update keys, check status + *> ============================================================ + 3100-READ-INPUT-SECTION SECTION. + 3100-READ-INPUT-PROC. + READ FILE-IN INTO WS-TELECOM-REC + AT END + SET WS-EOF TO TRUE + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP-STR + DISPLAY "READ: " WS-TS-HOUR ":" WS-TS-MINUTE ":" + WS-TS-SECOND " EOF after " + WS-RECORDS-READ " records" + NOT AT END + ADD 1 TO WS-RECORDS-READ + MOVE BILL-KEY TO WS-CURRENT-KEY + MOVE BILL-PLAN-CODE TO WS-CURRENT-PLAN + END-READ + + *> FILE STATUS check for read errors (status '10' = AT END) + IF WS-FILE-IN-STATUS NOT = '00' + AND WS-FILE-IN-STATUS NOT = '10' + MOVE "ERROR" TO EM-SEVERITY + STRING "FILE-IN READ ERROR, STATUS=" + WS-FILE-IN-STATUS + INTO EM-TEXT + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + . + 3100-EXIT. + EXIT. + + *> ============================================================ + *> 3200-VALIDATE-SECTION + *> Validate record content, filter invalid records + *> ============================================================ + 3200-VALIDATE-SECTION SECTION. + 3200-VALIDATE-PROC. + *> Check for error/exclude status flags + IF BILL-STATUS = 'E' OR 'X' + ADD 1 TO WS-ERROR-COUNT + MOVE "WARNING" TO EM-SEVERITY + STRING "SKIP RECORD KEY=" BILL-KEY + " STATUS=" BILL-STATUS + INTO EM-TEXT + PERFORM 6000-ERROR-HANDLE-SECTION + EXIT PARAGRAPH + END-IF + + *> Warn on zero amount (still processed) + IF BILL-AMOUNT = 0 + ADD 1 TO WS-WARNING-COUNT + MOVE "WARNING" TO EM-SEVERITY + STRING "ZERO AMOUNT KEY=" BILL-KEY + INTO EM-TEXT + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + + *> Reject amount exceeding PIC 9(09) capacity + IF BILL-AMOUNT > 999999999 + ADD 1 TO WS-ERROR-COUNT + MOVE "ERROR" TO EM-SEVERITY + STRING "AMOUNT OVERFLOW KEY=" BILL-KEY + INTO EM-TEXT + PERFORM 6000-ERROR-HANDLE-SECTION + EXIT PARAGRAPH + END-IF + + MOVE "RECORD VALIDATED" TO AR-TEXT + PERFORM 5000-WRITE-AUDIT + . + 3200-EXIT. + EXIT. + + *> ============================================================ + *> 3300-APPLY-RULES-SECTION + *> Key-break detection (2-level), accumulation, statistics + *> PRESERVED ORIGINAL LOGIC: key-break + accumulation + *> ============================================================ + 3300-APPLY-RULES-SECTION SECTION. + 3300-APPLY-RULES-PROC. + MOVE BILL-KEY TO WS-CURRENT-KEY + + *> --- PRESERVED ORIGINAL KEY-BREAK LOGIC --- + IF WS-FIRST + MOVE WS-CURRENT-KEY TO WS-PREV-KEY + MOVE BILL-PLAN-CODE TO WS-PREV-PLAN + MOVE 'N' TO WS-FIRST-REC + PERFORM WRITE-CUSTOMER-HEADER + PERFORM WRITE-PLAN-HEADER + ELSE + IF WS-CURRENT-KEY NOT = WS-PREV-KEY + *> Customer break: plan footer first, then group summary + IF WS-PLAN-COUNT > 0 + PERFORM WRITE-PLAN-FOOTER + END-IF + PERFORM WRITE-GROUP-SUMMARY + MOVE WS-CURRENT-KEY TO WS-PREV-KEY + MOVE BILL-PLAN-CODE TO WS-PREV-PLAN + PERFORM WRITE-CUSTOMER-HEADER + PERFORM WRITE-PLAN-HEADER + ELSE + *> Same customer: check plan-level break + IF BILL-PLAN-CODE NOT = WS-PREV-PLAN + IF WS-PLAN-COUNT > 0 + PERFORM WRITE-PLAN-FOOTER + END-IF + MOVE BILL-PLAN-CODE TO WS-PREV-PLAN + PERFORM WRITE-PLAN-HEADER + END-IF + END-IF + END-IF + + *> --- PRESERVED ORIGINAL ACCUMULATION LOGIC --- + ADD BILL-AMOUNT TO WS-GROUP-TOTAL + ADD 1 TO WS-GROUP-COUNT + + *> --- EXPANDED: plan-level accumulation --- + ADD BILL-AMOUNT TO WS-PLAN-TOTAL + ADD 1 TO WS-PLAN-COUNT + + *> --- EXPANDED: hash total for data integrity --- + ADD BILL-AMOUNT TO WS-HASH-TOTAL-IN + + *> --- EXPANDED: minimum and maximum per group --- + IF BILL-AMOUNT < WS-GROUP-MIN + MOVE BILL-AMOUNT TO WS-GROUP-MIN + END-IF + IF BILL-AMOUNT > WS-GROUP-MAX + MOVE BILL-AMOUNT TO WS-GROUP-MAX + END-IF + IF BILL-AMOUNT < WS-PLAN-MIN + MOVE BILL-AMOUNT TO WS-PLAN-MIN + END-IF + IF BILL-AMOUNT > WS-PLAN-MAX + MOVE BILL-AMOUNT TO WS-PLAN-MAX + END-IF + + *> --- EXPANDED: sum of squares for variance --- + COMPUTE WS-SUM-SQUARES = WS-SUM-SQUARES + + (BILL-AMOUNT * BILL-AMOUNT) + + *> --- EXPANDED: accumulator overflow check --- + IF WS-GROUP-TOTAL > WS-MAX-TOTAL + SET WS-OVERFLOW TO TRUE + MOVE "ERROR" TO EM-SEVERITY + STRING "GROUP TOTAL OVERFLOW KEY=" WS-PREV-KEY + INTO EM-TEXT + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + + *> --- EXPANDED: batch control totals --- + ADD 1 TO WS-BATCH-REC-EXP + ADD BILL-AMOUNT TO WS-BATCH-AMT-EXP + + *> --- EXPANDED: detail line to report file --- + MOVE BILL-KEY TO DL-KEY + MOVE BILL-PLAN-CODE TO DL-PLAN + MOVE BILL-AMOUNT TO DL-AMOUNT + PERFORM WRITE-REPORT-LINE + . + 3300-EXIT. + EXIT. + + *> ============================================================ + *> 3400-WRITE-OUTPUT-SECTION + *> Write group summary record to FILE-OUT + *> Called from WRITE-GROUP-SUMMARY + *> ============================================================ + 3400-WRITE-OUTPUT-SECTION SECTION. + 3400-WRITE-OUTPUT-PROC. + *> --- PRESERVED ORIGINAL OUTPUT LOGIC --- + MOVE WS-PREV-KEY TO OUT-KEY + MOVE WS-GROUP-COUNT TO OUT-COUNT + MOVE WS-GROUP-TOTAL TO OUT-TOTAL + WRITE FILE-OUT-REC + ADD 1 TO WS-GROUPS-WRITTEN + ADD 1 TO WS-RECORDS-WRITTEN + + *> Accumulate grand total and hash (original behavior) + ADD WS-GROUP-TOTAL TO WS-GRAND-TOTAL + ADD WS-GROUP-TOTAL TO WS-HASH-TOTAL-OUT + + *> Display group summary (preserved original display) + DISPLAY " Group " WS-PREV-KEY ": count=" + WS-GROUP-COUNT ", total=" WS-GROUP-TOTAL + + *> --- EXPANDED: compute average and variance --- + IF WS-GROUP-COUNT > 0 + COMPUTE WS-GROUP-AVG = WS-GROUP-TOTAL + / WS-GROUP-COUNT + COMPUTE WS-GROUP-VAR = + (WS-SUM-SQUARES / WS-GROUP-COUNT) + - (WS-GROUP-AVG * WS-GROUP-AVG) + ELSE + MOVE 0 TO WS-GROUP-AVG + MOVE 0 TO WS-GROUP-VAR + END-IF + + *> Display extended statistics + DISPLAY " Stats " WS-PREV-KEY ": min=" WS-GROUP-MIN + " max=" WS-GROUP-MAX " avg=" WS-GROUP-AVG + + *> Write formatted group footer to report file + MOVE WS-GROUP-COUNT TO GF-COUNT + MOVE WS-GROUP-TOTAL TO GF-TOTAL + MOVE WS-GROUP-MIN TO GF-MIN + MOVE WS-GROUP-MAX TO GF-MAX + MOVE WS-GROUP-AVG TO GF-AVG + MOVE WS-GROUP-FOOTER TO REPORT-REC + WRITE REPORT-REC + ADD 1 TO WS-LINE-COUNT + + *> FILE STATUS check after WRITE + IF WS-REPORT-STATUS NOT = '00' + MOVE "WARNING" TO EM-SEVERITY + STRING "REPORT WRITE ERROR STATUS=" + WS-REPORT-STATUS + INTO EM-TEXT + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + + *> Reset group accumulators for next group + MOVE 0 TO WS-GROUP-COUNT + MOVE 0 TO WS-GROUP-TOTAL + MOVE 9999999999 TO WS-GROUP-MIN + MOVE 0 TO WS-GROUP-MAX + MOVE 0 TO WS-GROUP-AVG + MOVE 0 TO WS-GROUP-VAR + MOVE 0 TO WS-SUM-SQUARES + MOVE 'N' TO WS-OVERFLOW-FLAG + + MOVE "GROUP SUMMARY WRITTEN" TO AR-TEXT + PERFORM 5000-WRITE-AUDIT + . + 3400-EXIT. + EXIT. + + *> ============================================================ + *> 4000-REPORT-SECTION + *> Final summary report with grand total verification + *> ============================================================ + 4000-REPORT-SECTION SECTION. + 4000-REPORT-PROC. + DISPLAY "RPT: Generating final summary report" + MOVE "FINAL REPORT GENERATED" TO AR-TEXT + PERFORM 5000-WRITE-AUDIT + + *> Grand total verification line + MOVE WS-GRAND-TOTAL TO GT-VALUE + MOVE WS-GRAND-VERIFY TO GT-VERIFY + IF WS-GRAND-TOTAL = WS-GRAND-VERIFY + MOVE "VERIFIED" TO GT-STATUS + ELSE + MOVE "MISMATCH!!" TO GT-STATUS + END-IF + MOVE WS-GRAND-TOTAL-LINE TO REPORT-REC + WRITE REPORT-REC + ADD 1 TO WS-LINE-COUNT + + *> Hash total verification + MOVE SPACES TO WS-AUDIT-REC + STRING "HASH IN=" WS-HASH-TOTAL-IN + " OUT=" WS-HASH-TOTAL-OUT + INTO AR-TEXT + MOVE AR-TEXT TO REPORT-REC + WRITE REPORT-REC + + *> Batch control totals + MOVE SPACES TO WS-AUDIT-REC + STRING "BATCH RECS=" WS-BATCH-REC-EXP + " AMT=" WS-BATCH-AMT-EXP + INTO AR-TEXT + MOVE AR-TEXT TO REPORT-REC + WRITE REPORT-REC + + *> Error and warning summary + MOVE SPACES TO WS-AUDIT-REC + STRING "ERRORS=" WS-ERROR-COUNT + " WARNINGS=" WS-WARNING-COUNT + INTO AR-TEXT + MOVE AR-TEXT TO REPORT-REC + WRITE REPORT-REC + + DISPLAY "RPT: Report generated" + . + 4000-EXIT. + EXIT. + + *> ============================================================ + *> 5000-AUDIT-SECTION + *> Write audit trail records to AUDIT-RPT.DAT + *> ============================================================ + 5000-AUDIT-SECTION SECTION. + 5000-WRITE-AUDIT. + STRING WS-TS-HOUR DELIMITED BY SIZE + ":" DELIMITED BY SIZE + WS-TS-MINUTE DELIMITED BY SIZE + ":" DELIMITED BY SIZE + WS-TS-SECOND DELIMITED BY SIZE + INTO AR-TIMESTAMP + END-STRING + WRITE AUDIT-REC FROM WS-AUDIT-REC + IF WS-AUDIT-STATUS NOT = '00' + MOVE "WARNING" TO EM-SEVERITY + STRING "AUDIT WRITE ERROR, STATUS=" + WS-AUDIT-STATUS + INTO EM-TEXT + END-STRING + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + . + 5000-EXIT. + EXIT. + + *> ============================================================ + *> 6000-ERROR-HANDLE-SECTION + *> Handle errors by severity level + *> WARNING - display and continue + *> ERROR - increment count and continue + *> FATAL - abort program + *> ============================================================ + 6000-ERROR-HANDLE-SECTION SECTION. + 6000-ERROR-HANDLE-PROC. + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP-STR + DISPLAY " " WS-TS-HOUR ":" WS-TS-MINUTE ":" + WS-TS-SECOND " " EM-SEVERITY ": " EM-TEXT + IF EM-SEVERITY = "FATAL" + MOVE "FATAL ERROR - PROGRAM ABORTED" TO AR-TEXT + PERFORM 5000-WRITE-AUDIT + PERFORM 9000-EXIT-SECTION + STOP RUN + END-IF + . + 6000-EXIT. + EXIT. + + *> ============================================================ + *> 9000-EXIT-SECTION + *> Close all files, display final statistics + *> ============================================================ + 9000-EXIT-SECTION SECTION. + 9000-EXIT-PROC. + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP-STR + DISPLAY " " + DISPLAY "=== FINAL SUMMARY ===" + DISPLAY "Timestamp: " WS-TS-YEAR "-" WS-TS-MONTH "-" + WS-TS-DAY " " WS-TS-HOUR ":" WS-TS-MINUTE ":" + WS-TS-SECOND + DISPLAY "Records read: " WS-RECORDS-READ + DISPLAY "Records written: " WS-RECORDS-WRITTEN + DISPLAY "Groups written: " WS-GROUPS-WRITTEN + DISPLAY "Grand total: " WS-GRAND-TOTAL + DISPLAY "Hash total in: " WS-HASH-TOTAL-IN + DISPLAY "Hash total out: " WS-HASH-TOTAL-OUT + DISPLAY "Warnings counted: " WS-WARNING-COUNT + DISPLAY "Errors counted: " WS-ERROR-COUNT + + IF WS-GRAND-TOTAL = WS-GRAND-VERIFY + DISPLAY "Grand total VERIFIED OK" + ELSE + DISPLAY "Grand total VERIFY MISMATCH!" + END-IF + + MOVE "PROGRAM COMPLETED NORMALLY" TO AR-TEXT + PERFORM 5000-WRITE-AUDIT + + CLOSE FILE-IN + CLOSE FILE-OUT + CLOSE AUDIT-REPORT + CLOSE REPORT-FILE + + DISPLAY " " + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP-STR + DISPLAY "EXIT: " WS-TS-HOUR ":" WS-TS-MINUTE ":" + WS-TS-SECOND " Program ended" + . + 9000-EXIT. + EXIT. + + *> ============================================================ + *> WRITE-GROUP-SUMMARY -- PRESERVED ORIGINAL SECTION + *> Original group summary writer (now delegates to 3400) + *> ============================================================ + WRITE-GROUP-SUMMARY SECTION. + WRITE-GROUP-SUMMARY-PROC. + PERFORM 3400-WRITE-OUTPUT-SECTION + . + + *> ============================================================ + *> WRITE-CUSTOMER-HEADER + *> Write formatted customer header to report file + *> ============================================================ + WRITE-CUSTOMER-HEADER SECTION. + WRITE-CUSTOMER-HEADER-PROC. + MOVE WS-PREV-KEY TO CH-KEY + MOVE WS-PREV-PLAN TO CH-PLAN + MOVE WS-CUSTOMER-HEADER TO REPORT-REC + WRITE REPORT-REC + ADD 1 TO WS-LINE-COUNT + MOVE "CUSTOMER HEADER WRITTEN" TO AR-TEXT + PERFORM 5000-WRITE-AUDIT + . + + *> ============================================================ + *> WRITE-PLAN-HEADER + *> Write plan header line to report + *> ============================================================ + WRITE-PLAN-HEADER SECTION. + WRITE-PLAN-HEADER-PROC. + MOVE WS-PREV-KEY TO CH-KEY + MOVE WS-PREV-PLAN TO CH-PLAN + MOVE WS-CUSTOMER-HEADER TO REPORT-REC + WRITE REPORT-REC + ADD 1 TO WS-LINE-COUNT + MOVE "PLAN HEADER WRITTEN" TO AR-TEXT + PERFORM 5000-WRITE-AUDIT + . + + *> ============================================================ + *> WRITE-PLAN-FOOTER + *> Write plan footer, output plan totals, reset accumulators + *> ============================================================ + WRITE-PLAN-FOOTER SECTION. + WRITE-PLAN-FOOTER-PROC. + MOVE WS-PREV-PLAN TO PF-PLAN + MOVE WS-PLAN-COUNT TO PF-COUNT + MOVE WS-PLAN-TOTAL TO PF-TOTAL + MOVE WS-PLAN-FOOTER TO REPORT-REC + WRITE REPORT-REC + ADD 1 TO WS-LINE-COUNT + + DISPLAY " Plan " WS-PREV-PLAN ": count=" + WS-PLAN-COUNT ", total=" WS-PLAN-TOTAL + + *> Add plan total to grand total verification + ADD WS-PLAN-TOTAL TO WS-GRAND-VERIFY + + *> Reset plan accumulators + MOVE 0 TO WS-PLAN-COUNT + MOVE 0 TO WS-PLAN-TOTAL + MOVE 9999999999 TO WS-PLAN-MIN + MOVE 0 TO WS-PLAN-MAX + + MOVE "PLAN FOOTER WRITTEN" TO AR-TEXT + PERFORM 5000-WRITE-AUDIT + . + + *> ============================================================ + *> WRITE-REPORT-LINE + *> Write detail line to report with page break control + *> ============================================================ + WRITE-REPORT-LINE SECTION. + WRITE-REPORT-LINE-PROC. + *> Page break: check line count against page length + IF WS-LINE-COUNT >= WS-PAGE-LENGTH + ADD 1 TO WS-PAGE-NUM + MOVE WS-PAGE-NUM TO PH-PAGE-NUM + MOVE WS-TS-YEAR TO PH-DATE(1:4) + MOVE "-" TO PH-DATE(5:1) + MOVE WS-TS-MONTH TO PH-DATE(6:2) + MOVE "-" TO PH-DATE(8:1) + MOVE WS-TS-DAY TO PH-DATE(9:2) + MOVE WS-PAGE-HEADER TO REPORT-REC + WRITE REPORT-REC + MOVE 0 TO WS-LINE-COUNT + END-IF + + MOVE WS-DETAIL-LINE TO REPORT-REC + WRITE REPORT-REC + ADD 1 TO WS-LINE-COUNT + . diff --git a/benchmark-programs/08-keybreak-aggregate/FILE-IN.DAT b/benchmark-programs/08-keybreak-aggregate/FILE-IN.DAT new file mode 100644 index 0000000..d77637c --- /dev/null +++ b/benchmark-programs/08-keybreak-aggregate/FILE-IN.DAT @@ -0,0 +1 @@ + 0000000000 \ No newline at end of file diff --git a/benchmark-programs/08-keybreak-aggregate/README.md b/benchmark-programs/08-keybreak-aggregate/README.md new file mode 100644 index 0000000..2857e4c --- /dev/null +++ b/benchmark-programs/08-keybreak-aggregate/README.md @@ -0,0 +1,40 @@ +# 08-keybreak-aggregate — Key Break Aggregate + +## 电信业务场景 + +套餐统计。按套餐代码进行key切聚合，计算各套餐的合同数、最大/最小金额、总量等统计信息。 + +Demonstrates key break processing with four statistical aggregates: + +- **COUNT**: Number of records in each key group +- **MIN**: Minimum VALUE in each group +- **MAX**: Maximum VALUE in each group +- **TOTAL**: Sum of VALUE in each group + +Same control-break logic as 07-keybreak-summary, extended with +min/max tracking using IF comparisons. + +## Files + +| File | Purpose | +|------|---------| +| `main-08-keybreak-aggregate.cbl` | COBOL program (fixed format) | +| `data-gen.sh` | Generate sorted test data | +| `run.sh` | Compile, run, verify output | + +## Input Record + +| Field | Type | Length | +|-------|------|--------| +| KEY | PIC X | 10 | +| VALUE | PIC 9 | 10 | + +## Output Record + +| Field | Type | +|-------|------| +| KEY | PIC X(10) | +| COUNT | PIC Z(5)9 | +| MIN | PIC Z(9)9 | +| MAX | PIC Z(9)9 | +| TOTAL | PIC Z(9)9 | diff --git a/benchmark-programs/08-keybreak-aggregate/main-08-keybreak-aggregate.cbl b/benchmark-programs/08-keybreak-aggregate/main-08-keybreak-aggregate.cbl new file mode 100644 index 0000000..5cc48e3 --- /dev/null +++ b/benchmark-programs/08-keybreak-aggregate/main-08-keybreak-aggregate.cbl @@ -0,0 +1,705 @@ + *> ============================================================ + *> 08-keybreak-aggregate : 套餐统计 (Plan Statistics) + *> Input : FILE-IN.DAT (KEY PIC X(10), VALUE PIC 9(10), PLAN X(3)) + *> Output: FILE-OUT.DAT (KEY组别统计: 件数,最小值,最大值,合计) + *> Report: REPORT-OUT.TXT (formatted 2-level key break report) + *> Audit: AUDIT-OUT.TXT (group-level audit trail) + *> Coverage: KB-N002, KB-N004~N006, KB-R001 + *> 2-level key break: customer (IN-KEY) + plan (BILL-PLAN-CODE) + *> Statistics: count, min, max, total, avg, variance, std-dev + *> Hash totals for data integrity verification + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. KeyBreakAgg. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN + ASSIGN TO "FILE-IN.DAT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-FILE-IN-STATUS. + + SELECT FILE-OUT + ASSIGN TO "FILE-OUT.DAT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-FILE-OUT-STATUS. + + SELECT REPORT-OUT + ASSIGN TO "REPORT-OUT.TXT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-REPORT-STATUS. + + SELECT AUDIT-OUT + ASSIGN TO "AUDIT-OUT.TXT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-AUDIT-STATUS. + + DATA DIVISION. + FILE SECTION. + FD FILE-IN. + 01 FILE-IN-REC. + 05 IN-KEY PIC X(10). + 05 IN-VALUE PIC 9(10). + 05 BILL-PLAN-CODE PIC X(03). + 05 FILLER PIC X(22). + + FD FILE-OUT. + 01 FILE-OUT-REC. + 05 OUT-KEY PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 OUT-COUNT PIC Z(05)9. + 05 FILLER PIC X VALUE SPACE. + 05 OUT-MIN PIC Z(09)9. + 05 FILLER PIC X VALUE SPACE. + 05 OUT-MAX PIC Z(09)9. + 05 FILLER PIC X VALUE SPACE. + 05 OUT-TOTAL PIC Z(09)9. + + FD REPORT-OUT. + 01 REPORT-OUT-REC PIC X(80). + + FD AUDIT-OUT. + 01 AUDIT-OUT-REC PIC X(80). + + WORKING-STORAGE SECTION. + 01 WS-TELECOM-REC. + COPY "telecom/TEL-BILLING.cpy". + + *> Status flags + 01 WS-STATUS. + 05 WS-EOF-FLAG PIC X VALUE 'N'. + 88 WS-EOF VALUE 'Y' FALSE 'N'. + 05 WS-FIRST-REC PIC X VALUE 'Y'. + 88 WS-FIRST VALUE 'Y' FALSE 'N'. + + *> Key break fields + 01 WS-PREV-KEY PIC X(10). + 01 WS-CURRENT-KEY PIC X(10). + 01 WS-PREV-PLAN PIC X(03). + 01 WS-CURRENT-PLAN PIC X(03). + + *> Customer-level accumulators (original augmented) + 01 WS-ACCUMULATORS. + 05 WS-GROUP-COUNT PIC 9(05) VALUE 0. + 05 WS-GROUP-MIN PIC 9(10) VALUE 9999999999. + 05 WS-GROUP-MAX PIC 9(10) VALUE 0. + 05 WS-GROUP-TOTAL PIC 9(10) VALUE 0. + 05 WS-GROUP-AVG PIC 9(10)V9(05) VALUE 0. + 05 WS-SUM-SQUARES PIC 9(20) VALUE 0. + 05 WS-GROUP-VAR PIC 9(10)V9(05) VALUE 0. + 05 WS-GROUP-STDDEV PIC 9(10)V9(05) VALUE 0. + + *> Plan-level accumulators + 01 WS-PLAN-ACCUMULATORS. + 05 WS-PLAN-COUNT PIC 9(05) VALUE 0. + 05 WS-PLAN-MIN PIC 9(10) VALUE 9999999999. + 05 WS-PLAN-MAX PIC 9(10) VALUE 0. + 05 WS-PLAN-TOTAL PIC 9(10) VALUE 0. + 05 WS-PLAN-AVG PIC 9(10)V9(05) VALUE 0. + 05 WS-PLAN-SUM-SQUARES PIC 9(20) VALUE 0. + 05 WS-PLAN-VAR PIC 9(10)V9(05) VALUE 0. + 05 WS-PLAN-STDDEV PIC 9(10)V9(05) VALUE 0. + + *> Overflow handling + 01 WS-MAX-TOTAL PIC 9(10) VALUE 9999999999. + + *> Report control + 01 WS-LINE-COUNT PIC 9(02) VALUE 99. + 01 WS-PAGE-LENGTH PIC 9(02) VALUE 60. + 01 WS-PAGE-NUM PIC 9(03) VALUE 0. + + *> Hash totals (data integrity) + 01 WS-HASH-TOTAL-IN PIC 9(18) VALUE 0. + 01 WS-HASH-TOTAL-OUT PIC 9(18) VALUE 0. + + *> Batch counters + 01 WS-GROUPS-WRITTEN PIC 9(05) VALUE 0. + 01 WS-RECORDS-READ PIC 9(05) VALUE 0. + 01 WS-VALUE-NUM PIC 9(10). + 01 WS-HASH-VERIFIED PIC X(07) VALUE 'PASSED'. + + *> File status fields + 01 WS-FILE-IN-STATUS PIC X(02). + 01 WS-FILE-OUT-STATUS PIC X(02). + 01 WS-REPORT-STATUS PIC X(02). + 01 WS-AUDIT-STATUS PIC X(02). + + *> Error handling + 01 WS-ERROR-MESSAGE PIC X(60). + 01 WS-ERROR-SEVERITY PIC X(07). + 88 WS-SEVERITY-WARNING VALUE 'WARNING'. + 88 WS-SEVERITY-ERROR VALUE 'ERROR '. + 88 WS-SEVERITY-FATAL VALUE 'FATAL '. + + *> Overflow flag + 01 WS-OVERFLOW-FLAG PIC X VALUE 'N'. + 88 WS-OVERFLOW VALUE 'Y' FALSE 'N'. + + *> Timestamp + 01 WS-TIMESTAMP PIC X(19). + 01 WS-CURRENT-DATE-DATA. + 05 WS-CD-DATE PIC X(08). + 05 WS-CD-TIME PIC X(06). + 05 FILLER PIC X(09). + + *> Report structures + 01 WS-REPORT-HEADER. + 05 FILLER PIC X(30) + 05 FILLER PIC X(25) VALUE SPACES. + 05 FILLER PIC X(06) VALUE 'PAGE: '. + 05 WS-HDR-PAGE PIC Z(03)9. + 05 FILLER PIC X(15) VALUE SPACES. + + 01 WS-DETAIL-LINE. + 05 FILLER PIC X(05) VALUE SPACES. + 05 WS-DL-KEY PIC X(10). + 05 FILLER PIC X(03) VALUE SPACES. + 05 FILLER PIC X(05) VALUE 'PLAN:'. + 05 WS-DL-PLAN PIC X(03). + 05 FILLER PIC X(03) VALUE SPACES. + 05 FILLER PIC X(06) VALUE 'VALUE:'. + 05 WS-DL-VALUE PIC Z(09)9. + 05 FILLER PIC X(04) VALUE SPACES. + 05 FILLER PIC X(06) VALUE 'CUMUL:'. + 05 WS-DL-CUMUL PIC Z(09)9. + 05 FILLER PIC X(24) VALUE SPACES. + + 01 WS-CUST-FOOTER. + 05 FILLER PIC X(16) VALUE ' CUSTOMER TOTAL'. + 05 FILLER PIC X(05) VALUE ': CNT='. + 05 WS-CF-COUNT PIC Z(05)9. + 05 FILLER PIC X(03) VALUE ' | '. + 05 FILLER PIC X(05) VALUE 'MIN: '. + 05 WS-CF-MIN PIC Z(09)9. + 05 FILLER PIC X(03) VALUE ' | '. + 05 FILLER PIC X(05) VALUE 'MAX: '. + 05 WS-CF-MAX PIC Z(09)9. + 05 FILLER PIC X(03) VALUE ' | '. + 05 FILLER PIC X(06) VALUE 'TOTAL:'. + 05 WS-CF-TOTAL PIC Z(09)9. + 05 FILLER PIC X(03) VALUE ' | '. + 05 FILLER PIC X(05) VALUE 'AVG: '. + 05 WS-CF-AVG PIC Z(09)9. + 05 FILLER PIC X(20) VALUE SPACES. + + 01 WS-PLAN-FOOTER. + 05 FILLER PIC X(14) VALUE ' PLAN-'. + 05 WS-PF-PLAN PIC X(03). + 05 FILLER PIC X(05) VALUE ': CNT='. + 05 WS-PF-COUNT PIC Z(05)9. + 05 FILLER PIC X(03) VALUE ' | '. + 05 FILLER PIC X(05) VALUE 'MIN: '. + 05 WS-PF-MIN PIC Z(09)9. + 05 FILLER PIC X(03) VALUE ' | '. + 05 FILLER PIC X(05) VALUE 'MAX: '. + 05 WS-PF-MAX PIC Z(09)9. + 05 FILLER PIC X(03) VALUE ' | '. + 05 FILLER PIC X(06) VALUE 'TOTAL:'. + 05 WS-PF-TOTAL PIC Z(09)9. + 05 FILLER PIC X(03) VALUE ' | '. + 05 FILLER PIC X(05) VALUE 'AVG: '. + 05 WS-PF-AVG PIC Z(09)9. + 05 FILLER PIC X(03) VALUE ' | '. + 05 FILLER PIC X(05) VALUE 'VAR: '. + 05 WS-PF-VAR PIC Z(09)9. + 05 FILLER PIC X(03) VALUE ' | '. + 05 FILLER PIC X(05) VALUE 'STDEV:'. + 05 WS-PF-STDDEV PIC Z(09)9. + 05 FILLER PIC X(08) VALUE SPACES. + + 01 WS-GRAND-TOTAL-HEADER. + 05 FILLER PIC X(25) + VALUE '=== GRAND TOTAL SUMMARY ==='. + 05 FILLER PIC X(55) VALUE SPACES. + + 01 WS-GRAND-TOTAL-LINE. + 05 FILLER PIC X(20) + VALUE ' Records read: '. + 05 WS-GT-RECORDS PIC Z(05)9. + 05 FILLER PIC X(53) VALUE SPACES. + + 01 WS-GT-HASH-LINE. + 05 FILLER PIC X(20) + VALUE ' Hash IN: '. + 05 WS-GT-HASH-IN PIC Z(17)9. + 05 FILLER PIC X(43) VALUE SPACES. + + 01 WS-GT-HASH-LINE-OUT. + 05 FILLER PIC X(20) + VALUE ' Hash OUT: '. + 05 WS-GT-HASH-OUT PIC Z(17)9. + 05 FILLER PIC X(43) VALUE SPACES. + + 01 WS-GT-VERIFY-LINE. + 05 FILLER PIC X(20) + VALUE ' Verification: '. + 05 WS-GT-VERIFY PIC X(07). + 05 FILLER PIC X(53) VALUE SPACES. + + *> Audit record structure + 01 WS-AUDIT-LINE. + 05 WS-AUDIT-TS PIC X(19). + 05 FILLER PIC X VALUE SPACE. + 05 WS-AUDIT-TYPE PIC X(08). + 05 FILLER PIC X VALUE SPACE. + 05 WS-AUDIT-DESC PIC X(51). + + PROCEDURE DIVISION. + MAIN SECTION. + MAIN-PROCEDURE. + PERFORM 1000-INIT-SECTION + PERFORM 2000-OPEN-FILES-SECTION + PERFORM 3000-PROCESS-SECTION + PERFORM 4000-REPORT-SECTION + PERFORM 5000-AUDIT-SECTION + PERFORM 9000-EXIT-SECTION + STOP RUN. + + *> 1000-INIT-SECTION + 1000-INIT-SECTION. + PERFORM GET-TIMESTAMP + DISPLAY "[" WS-TIMESTAMP "] KeyBreakAgg START" + MOVE SPACES TO WS-PREV-PLAN + MOVE 0 TO WS-GROUPS-WRITTEN WS-RECORDS-READ + MOVE 0 TO WS-HASH-TOTAL-IN WS-HASH-TOTAL-OUT + MOVE 'N' TO WS-OVERFLOW-FLAG + MOVE 99 TO WS-LINE-COUNT + DISPLAY "Page length: " WS-PAGE-LENGTH + . + + *> 2000-OPEN-FILES-SECTION + 2000-OPEN-FILES-SECTION. + OPEN INPUT FILE-IN + IF WS-FILE-IN-STATUS NOT = '00' + STRING 'FILE-IN OPEN FAILED STATUS=' + WS-FILE-IN-STATUS INTO WS-ERROR-MESSAGE + END-STRING + MOVE 'FATAL ' TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + DISPLAY "FILE-IN opened status=" WS-FILE-IN-STATUS + + OPEN OUTPUT FILE-OUT + IF WS-FILE-OUT-STATUS NOT = '00' + STRING 'FILE-OUT OPEN FAILED STATUS=' + WS-FILE-OUT-STATUS INTO WS-ERROR-MESSAGE + END-STRING + MOVE 'FATAL ' TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + DISPLAY "FILE-OUT opened status=" WS-FILE-OUT-STATUS + + OPEN OUTPUT REPORT-OUT + IF WS-REPORT-STATUS NOT = '00' + STRING 'REPORT-OUT OPEN FAILED STATUS=' + WS-REPORT-STATUS INTO WS-ERROR-MESSAGE + END-STRING + MOVE 'FATAL ' TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + DISPLAY "REPORT-OUT opened status=" WS-REPORT-STATUS + + OPEN OUTPUT AUDIT-OUT + IF WS-AUDIT-STATUS NOT = '00' + STRING 'AUDIT-OUT OPEN FAILED STATUS=' + WS-AUDIT-STATUS INTO WS-ERROR-MESSAGE + END-STRING + MOVE 'FATAL ' TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + DISPLAY "AUDIT-OUT opened status=" WS-AUDIT-STATUS + . + + *> 3000-PROCESS-SECTION + 3000-PROCESS-SECTION. + PERFORM 3100-READ-INPUT-SECTION + PERFORM UNTIL WS-EOF + PERFORM 3200-VALIDATE-SECTION + PERFORM 3300-APPLY-RULES-SECTION + PERFORM 3400-WRITE-OUTPUT-SECTION + PERFORM 3100-READ-INPUT-SECTION + END-PERFORM + IF WS-RECORDS-READ > 0 + PERFORM WRITE-PLAN-AGGREGATE + PERFORM WRITE-GROUP-AGGREGATE + END-IF + . + + *> 3100-READ-INPUT-SECTION + 3100-READ-INPUT-SECTION. + READ FILE-IN INTO FILE-IN-REC + IF WS-FILE-IN-STATUS = '10' + SET WS-EOF TO TRUE + DISPLAY "FILE-IN EOF status=" WS-FILE-IN-STATUS + ELSE IF WS-FILE-IN-STATUS = '00' + ADD 1 TO WS-RECORDS-READ + MOVE IN-VALUE TO WS-VALUE-NUM + MOVE IN-KEY TO WS-CURRENT-KEY + MOVE BILL-PLAN-CODE OF FILE-IN-REC TO WS-CURRENT-PLAN + ADD WS-VALUE-NUM TO WS-HASH-TOTAL-IN + ELSE + STRING 'FILE-IN READ ERROR STATUS=' + WS-FILE-IN-STATUS INTO WS-ERROR-MESSAGE + END-STRING + MOVE 'FATAL ' TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + . + + *> 3200-VALIDATE-SECTION + 3200-VALIDATE-SECTION. + IF WS-VALUE-NUM = 0 + STRING 'Zero value encountered key=' + WS-CURRENT-KEY INTO WS-ERROR-MESSAGE + END-STRING + MOVE 'WARNING' TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + IF WS-GROUP-TOTAL > WS-MAX-TOTAL + MOVE 'Y' TO WS-OVERFLOW-FLAG + STRING 'CUSTOMER TOTAL OVERFLOW key=' + WS-CURRENT-KEY INTO WS-ERROR-MESSAGE + END-STRING + MOVE 'ERROR ' TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + IF WS-GROUP-TOTAL + WS-VALUE-NUM > WS-MAX-TOTAL + STRING 'Would exceed MAX-TOTAL key=' + WS-CURRENT-KEY INTO WS-ERROR-MESSAGE + END-STRING + MOVE 'WARNING' TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + . + + *> 3300-APPLY-RULES-SECTION + 3300-APPLY-RULES-SECTION. + IF WS-FIRST + MOVE WS-CURRENT-KEY TO WS-PREV-KEY + MOVE WS-CURRENT-PLAN TO WS-PREV-PLAN + MOVE WS-VALUE-NUM TO WS-GROUP-MIN + MOVE WS-VALUE-NUM TO WS-GROUP-MAX + MOVE WS-VALUE-NUM TO WS-PLAN-MIN + MOVE WS-VALUE-NUM TO WS-PLAN-MAX + MOVE 'N' TO WS-FIRST-REC + DISPLAY "First record key=" WS-CURRENT-KEY + " plan=" WS-CURRENT-PLAN + ELSE + IF WS-CURRENT-KEY NOT = WS-PREV-KEY + IF WS-PREV-PLAN NOT = SPACES + DISPLAY "CUST BREAK: " WS-PREV-KEY + " -> " WS-CURRENT-KEY + PERFORM WRITE-PLAN-AGGREGATE + END-IF + PERFORM WRITE-GROUP-AGGREGATE + MOVE WS-CURRENT-KEY TO WS-PREV-KEY + MOVE WS-CURRENT-PLAN TO WS-PREV-PLAN + MOVE 9999999999 TO WS-GROUP-MIN + MOVE 0 TO WS-GROUP-MAX + MOVE 0 TO WS-GROUP-COUNT + MOVE 0 TO WS-GROUP-TOTAL + MOVE 0 TO WS-GROUP-AVG + MOVE 0 TO WS-SUM-SQUARES + MOVE 0 TO WS-GROUP-VAR + MOVE 0 TO WS-GROUP-STDDEV + MOVE 9999999999 TO WS-PLAN-MIN + MOVE 0 TO WS-PLAN-MAX + MOVE 0 TO WS-PLAN-COUNT + MOVE 0 TO WS-PLAN-TOTAL + MOVE 0 TO WS-PLAN-AVG + MOVE 0 TO WS-PLAN-SUM-SQUARES + MOVE 0 TO WS-PLAN-VAR + MOVE 0 TO WS-PLAN-STDDEV + ELSE + IF WS-CURRENT-PLAN NOT = WS-PREV-PLAN + DISPLAY "PLAN BREAK: " WS-PREV-PLAN + " -> " WS-CURRENT-PLAN + PERFORM WRITE-PLAN-AGGREGATE + MOVE WS-CURRENT-PLAN TO WS-PREV-PLAN + MOVE 9999999999 TO WS-PLAN-MIN + MOVE 0 TO WS-PLAN-MAX + MOVE 0 TO WS-PLAN-COUNT + MOVE 0 TO WS-PLAN-TOTAL + MOVE 0 TO WS-PLAN-AVG + MOVE 0 TO WS-PLAN-SUM-SQUARES + MOVE 0 TO WS-PLAN-VAR + MOVE 0 TO WS-PLAN-STDDEV + END-IF + END-IF + END-IF + + *> Customer-level accumulation (original logic preserved) + ADD 1 TO WS-GROUP-COUNT + ADD WS-VALUE-NUM TO WS-GROUP-TOTAL + COMPUTE WS-SUM-SQUARES = WS-SUM-SQUARES + + (WS-VALUE-NUM * WS-VALUE-NUM) + IF WS-VALUE-NUM < WS-GROUP-MIN + MOVE WS-VALUE-NUM TO WS-GROUP-MIN + END-IF + IF WS-VALUE-NUM > WS-GROUP-MAX + MOVE WS-VALUE-NUM TO WS-GROUP-MAX + END-IF + + *> Plan-level accumulation + ADD 1 TO WS-PLAN-COUNT + ADD WS-VALUE-NUM TO WS-PLAN-TOTAL + COMPUTE WS-PLAN-SUM-SQUARES = WS-PLAN-SUM-SQUARES + + (WS-VALUE-NUM + * WS-VALUE-NUM) + IF WS-VALUE-NUM < WS-PLAN-MIN + MOVE WS-VALUE-NUM TO WS-PLAN-MIN + END-IF + IF WS-VALUE-NUM > WS-PLAN-MAX + MOVE WS-VALUE-NUM TO WS-PLAN-MAX + END-IF + . + + *> 3400-WRITE-OUTPUT-SECTION + 3400-WRITE-OUTPUT-SECTION. + MOVE IN-KEY TO WS-DL-KEY + MOVE BILL-PLAN-CODE OF FILE-IN-REC TO WS-DL-PLAN + MOVE IN-VALUE TO WS-DL-VALUE + MOVE WS-GROUP-TOTAL TO WS-DL-CUMUL + PERFORM WRITE-DETAIL-LINE + . + + *> 4000-REPORT-SECTION + 4000-REPORT-SECTION. + PERFORM WRITE-GRAND-TOTAL + . + + *> 5000-AUDIT-SECTION + 5000-AUDIT-SECTION. + PERFORM GET-TIMESTAMP + MOVE WS-TIMESTAMP TO WS-AUDIT-TS + MOVE 'SUMMARY' TO WS-AUDIT-TYPE + MOVE 'Batch processing complete' TO WS-AUDIT-DESC + WRITE AUDIT-OUT-REC FROM WS-AUDIT-LINE + IF WS-AUDIT-STATUS NOT = '00' + MOVE 'AUDIT-OUT WRITE ERROR' TO WS-ERROR-MESSAGE + MOVE 'WARNING' TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + STRING 'Records read:' WS-RECORDS-READ + ' Groups:' WS-GROUPS-WRITTEN + INTO WS-AUDIT-DESC + END-STRING + WRITE AUDIT-OUT-REC FROM WS-AUDIT-LINE + STRING 'Hash IN:' WS-HASH-TOTAL-IN + ' OUT:' WS-HASH-TOTAL-OUT + ' Verify:' WS-HASH-VERIFIED + INTO WS-AUDIT-DESC + END-STRING + WRITE AUDIT-OUT-REC FROM WS-AUDIT-LINE + IF WS-OVERFLOW + MOVE 'Overflow was set during processing' + TO WS-AUDIT-DESC + WRITE AUDIT-OUT-REC FROM WS-AUDIT-LINE + END-IF + MOVE 'END-OF-JOB' TO WS-AUDIT-DESC + WRITE AUDIT-OUT-REC FROM WS-AUDIT-LINE + . + + *> 6000-ERROR-HANDLE-SECTION + 6000-ERROR-HANDLE-SECTION. + DISPLAY "[" WS-ERROR-SEVERITY "] " WS-ERROR-MESSAGE + IF WS-SEVERITY-FATAL + PERFORM 9000-EXIT-SECTION + STOP RUN + END-IF + . + + *> 9000-EXIT-SECTION + 9000-EXIT-SECTION. + CLOSE FILE-IN + IF WS-FILE-IN-STATUS NOT = '00' + DISPLAY "FILE-IN CLOSE status=" WS-FILE-IN-STATUS + END-IF + CLOSE FILE-OUT + IF WS-FILE-OUT-STATUS NOT = '00' + DISPLAY "FILE-OUT CLOSE status=" WS-FILE-OUT-STATUS + END-IF + CLOSE REPORT-OUT + IF WS-REPORT-STATUS NOT = '00' + DISPLAY "REPORT-OUT CLOSE status=" WS-REPORT-STATUS + END-IF + CLOSE AUDIT-OUT + IF WS-AUDIT-STATUS NOT = '00' + DISPLAY "AUDIT-OUT CLOSE status=" WS-AUDIT-STATUS + END-IF + PERFORM GET-TIMESTAMP + DISPLAY "[" WS-TIMESTAMP "] === FINAL SUMMARY ===" + DISPLAY "Records read: " WS-RECORDS-READ + DISPLAY "Groups written: " WS-GROUPS-WRITTEN + DISPLAY "Hash total IN: " WS-HASH-TOTAL-IN + DISPLAY "Hash total OUT: " WS-HASH-TOTAL-OUT + DISPLAY "Hash verification: " WS-HASH-VERIFIED + DISPLAY "Overflow occurred: " WS-OVERFLOW-FLAG + DISPLAY "[" WS-TIMESTAMP "] KeyBreakAgg END" + . + + *> SUPPORTING PARAGRAPHS + + *> ------------------------------------------------------------ + *> GET-TIMESTAMP : Populate WS-TIMESTAMP from system clock + *> ------------------------------------------------------------ + GET-TIMESTAMP SECTION. + GET-TIMESTAMP-PROC. + MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE-DATA + STRING WS-CD-DATE(1:4) '-' WS-CD-DATE(5:2) '-' + WS-CD-DATE(7:2) ' ' WS-CD-TIME(1:2) ':' + WS-CD-TIME(3:2) ':' WS-CD-TIME(5:2) + INTO WS-TIMESTAMP + END-STRING + . + + *> ------------------------------------------------------------ + *> WRITE-GROUP-AGGREGATE — Original aggregate output (kept intact) + *> ------------------------------------------------------------ + WRITE-GROUP-AGGREGATE SECTION. + WRITE-GROUP-AGGREGATE-PROC. + IF WS-GROUP-COUNT > 0 + COMPUTE WS-GROUP-AVG = + WS-GROUP-TOTAL / WS-GROUP-COUNT + COMPUTE WS-GROUP-VAR = + (WS-SUM-SQUARES + - (WS-GROUP-TOTAL * WS-GROUP-TOTAL + / WS-GROUP-COUNT)) + / WS-GROUP-COUNT + COMPUTE WS-GROUP-STDDEV = + FUNCTION SQRT(WS-GROUP-VAR) + ELSE + MOVE 0 TO WS-GROUP-AVG WS-GROUP-VAR WS-GROUP-STDDEV + END-IF + MOVE WS-PREV-KEY TO OUT-KEY + MOVE WS-GROUP-COUNT TO OUT-COUNT + MOVE WS-GROUP-MIN TO OUT-MIN + MOVE WS-GROUP-MAX TO OUT-MAX + MOVE WS-GROUP-TOTAL TO OUT-TOTAL + WRITE FILE-OUT-REC + IF WS-FILE-OUT-STATUS NOT = '00' + STRING 'FILE-OUT WRITE ERROR STATUS=' + WS-FILE-OUT-STATUS INTO WS-ERROR-MESSAGE + END-STRING + MOVE 'ERROR ' TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + ADD 1 TO WS-GROUPS-WRITTEN + ADD WS-GROUP-TOTAL TO WS-HASH-TOTAL-OUT + DISPLAY " Group " WS-PREV-KEY ": count=" + WS-GROUP-COUNT ", min=" WS-GROUP-MIN + ", max=" WS-GROUP-MAX ", total=" WS-GROUP-TOTAL + *> Write customer footer to report + MOVE WS-GROUP-COUNT TO WS-CF-COUNT + MOVE WS-GROUP-MIN TO WS-CF-MIN + MOVE WS-GROUP-MAX TO WS-CF-MAX + MOVE WS-GROUP-TOTAL TO WS-CF-TOTAL + MOVE WS-GROUP-AVG TO WS-CF-AVG + MOVE WS-CUST-FOOTER TO REPORT-OUT-REC + PERFORM WRITE-REPORT-LINE + *> Write audit for customer group + PERFORM GET-TIMESTAMP + MOVE WS-TIMESTAMP TO WS-AUDIT-TS + MOVE 'CUST GRP' TO WS-AUDIT-TYPE + STRING 'Key ' WS-PREV-KEY ' count=' WS-GROUP-COUNT + ' total=' WS-GROUP-TOTAL INTO WS-AUDIT-DESC + END-STRING + WRITE AUDIT-OUT-REC FROM WS-AUDIT-LINE + . + + *> ------------------------------------------------------------ + *> WRITE-PLAN-AGGREGATE — Plan-level aggregate output + *> ------------------------------------------------------------ + WRITE-PLAN-AGGREGATE SECTION. + WRITE-PLAN-AGGREGATE-PROC. + IF WS-PLAN-COUNT = 0 + EXIT SECTION + END-IF + COMPUTE WS-PLAN-AVG = WS-PLAN-TOTAL / WS-PLAN-COUNT + COMPUTE WS-PLAN-VAR = + (WS-PLAN-SUM-SQUARES + - (WS-PLAN-TOTAL * WS-PLAN-TOTAL / WS-PLAN-COUNT)) + / WS-PLAN-COUNT + COMPUTE WS-PLAN-STDDEV = + FUNCTION SQRT(WS-PLAN-VAR) + *> Write plan footer to report + MOVE WS-PREV-PLAN TO WS-PF-PLAN + MOVE WS-PLAN-COUNT TO WS-PF-COUNT + MOVE WS-PLAN-MIN TO WS-PF-MIN + MOVE WS-PLAN-MAX TO WS-PF-MAX + MOVE WS-PLAN-TOTAL TO WS-PF-TOTAL + MOVE WS-PLAN-AVG TO WS-PF-AVG + MOVE WS-PLAN-VAR TO WS-PF-VAR + MOVE WS-PLAN-STDDEV TO WS-PF-STDDEV + MOVE WS-PLAN-FOOTER TO REPORT-OUT-REC + PERFORM WRITE-REPORT-LINE + DISPLAY " Plan " WS-PREV-PLAN ": count=" + WS-PLAN-COUNT ", total=" WS-PLAN-TOTAL + *> Write audit for plan group + PERFORM GET-TIMESTAMP + MOVE WS-TIMESTAMP TO WS-AUDIT-TS + MOVE 'PLAN GRP' TO WS-AUDIT-TYPE + STRING 'Plan ' WS-PREV-PLAN ' for key ' WS-PREV-KEY + ' count=' WS-PLAN-COUNT ' total=' WS-PLAN-TOTAL + INTO WS-AUDIT-DESC + END-STRING + WRITE AUDIT-OUT-REC FROM WS-AUDIT-LINE + . + + *> ------------------------------------------------------------ + *> WRITE-REPORT-LINE : Write report line with page break control + *> ------------------------------------------------------------ + WRITE-REPORT-LINE SECTION. + WRITE-REPORT-LINE-PROC. + IF WS-LINE-COUNT >= WS-PAGE-LENGTH + ADD 1 TO WS-PAGE-NUM + MOVE WS-PAGE-NUM TO WS-HDR-PAGE + MOVE WS-REPORT-HEADER TO REPORT-OUT-REC + WRITE REPORT-OUT-REC + MOVE 2 TO WS-LINE-COUNT + END-IF + WRITE REPORT-OUT-REC + ADD 1 TO WS-LINE-COUNT + . + + *> ------------------------------------------------------------ + *> WRITE-DETAIL-LINE : Write one detail record to report + *> ------------------------------------------------------------ + WRITE-DETAIL-LINE SECTION. + WRITE-DETAIL-LINE-PROC. + MOVE WS-DETAIL-LINE TO REPORT-OUT-REC + PERFORM WRITE-REPORT-LINE + . + + *> ------------------------------------------------------------ + *> WRITE-GRAND-TOTAL : Grand total summary to report + *> ------------------------------------------------------------ + WRITE-GRAND-TOTAL SECTION. + WRITE-GRAND-TOTAL-PROC. + IF WS-HASH-TOTAL-IN = WS-HASH-TOTAL-OUT + MOVE 'PASSED' TO WS-HASH-VERIFIED + ELSE + MOVE 'FAILED' TO WS-HASH-VERIFIED + END-IF + MOVE WS-RECORDS-READ TO WS-GT-RECORDS + MOVE WS-HASH-TOTAL-IN TO WS-GT-HASH-IN + MOVE WS-HASH-TOTAL-OUT TO WS-GT-HASH-OUT + MOVE WS-HASH-VERIFIED TO WS-GT-VERIFY + MOVE WS-GRAND-TOTAL-HEADER TO REPORT-OUT-REC + PERFORM WRITE-REPORT-LINE + MOVE SPACES TO REPORT-OUT-REC + PERFORM WRITE-REPORT-LINE + MOVE WS-GRAND-TOTAL-LINE TO REPORT-OUT-REC + PERFORM WRITE-REPORT-LINE + MOVE WS-GT-HASH-LINE TO REPORT-OUT-REC + PERFORM WRITE-REPORT-LINE + MOVE WS-GT-HASH-LINE-OUT TO REPORT-OUT-REC + PERFORM WRITE-REPORT-LINE + MOVE WS-GT-VERIFY-LINE TO REPORT-OUT-REC + PERFORM WRITE-REPORT-LINE + DISPLAY "Grand total: records=" WS-RECORDS-READ + " groups=" WS-GROUPS-WRITTEN + DISPLAY "Hash IN=" WS-HASH-TOTAL-IN + " OUT=" WS-HASH-TOTAL-OUT " " WS-HASH-VERIFIED + . diff --git a/benchmark-programs/09-db-update/README.md b/benchmark-programs/09-db-update/README.md new file mode 100644 index 0000000..486e860 --- /dev/null +++ b/benchmark-programs/09-db-update/README.md @@ -0,0 +1,22 @@ +# 09-db-update — Database Update Simulation + +## 电信业务场景 + +客户信息DB更新。使用索引文件模拟关系数据库，实现客户信息的INSERT、UPDATE、DELETE操作。 + +## Purpose +Simulates DB update operations (INSERT, UPDATE, DELETE) using GnuCOBOL INDEXED files as a stand-in for EXEC SQL. + +## Test Coverage +1. **INSERT 3 records** — WRITE to indexed file with STATUS check +2. **Duplicate INSERT** — Attempt key duplicate, expect STATUS 22 +3. **UPDATE** — READ then REWRITE to modify an existing record +4. **DELETE** — READ then DELETE to remove a record +5. **Verify** — START + READ NEXT to read back remaining records +6. **Report** — Summary output to report.txt + +## Key Techniques +- INDEXED file with DYNAMIC access +- FILE STATUS checking (00=OK, 22=dup, 23=not found, 10=EOF) +- WRITE / REWRITE / DELETE with INVALID KEY +- START + READ NEXT for sequential traversal diff --git a/benchmark-programs/09-db-update/audit.txt b/benchmark-programs/09-db-update/audit.txt new file mode 100644 index 0000000..7a06124 --- /dev/null +++ b/benchmark-programs/09-db-update/audit.txt @@ -0,0 +1 @@ +2026/06/22 16:35:04 | ERROR | DB-FILE | WRITE | Status=22 | INSERT WRITE failed diff --git a/benchmark-programs/09-db-update/db-data.dat b/benchmark-programs/09-db-update/db-data.dat new file mode 100644 index 0000000..ada5afb Binary files /dev/null and b/benchmark-programs/09-db-update/db-data.dat differ diff --git a/benchmark-programs/09-db-update/main-09-db-update.cbl b/benchmark-programs/09-db-update/main-09-db-update.cbl new file mode 100644 index 0000000..66c3b7a --- /dev/null +++ b/benchmark-programs/09-db-update/main-09-db-update.cbl @@ -0,0 +1,874 @@ +>>SOURCE FORMAT IS FREE + *> ============================================================ + *> 09-db-update : Customer DB Update -- Enhanced Version + *> Input : DB-FILE (db-data.dat: INDEXED org, KEYed customer DB) + *> Output: REPORT-FILE (report.txt), TXN-LOG (txn-log.txt), + *> AUDIT-FILE (audit.txt) + *> Features: Sections, txn logging, existence check, FILE STATUS + *> after every op, key validation, lock simulation, commit/rollback + *> markers, audit, timestamped tracing, hash totals, batch control + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. Main09DbUpdate. + AUTHOR. COBOL-DB-Engine. + DATE-WRITTEN. 2026/06/22. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT DB-FILE ASSIGN TO "db-data.dat" + ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC + RECORD KEY IS DB-KEY + FILE STATUS IS DB-STATUS. + SELECT REPORT-FILE ASSIGN TO "report.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS RPT-STATUS. + SELECT TXN-LOG ASSIGN TO "txn-log.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS TXN-STATUS. + SELECT AUDIT-FILE ASSIGN TO "audit.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS AUD-STATUS. + + DATA DIVISION. + FILE SECTION. + FD DB-FILE. + 01 DB-RECORD. + 05 DB-KEY PIC X(10). + 05 DB-NAME PIC X(20). + 05 DB-AMOUNT PIC 9(10). + FD REPORT-FILE. + 01 REPORT-LINE PIC X(80). + FD TXN-LOG. + 01 TXN-LOG-LINE PIC X(120). + FD AUDIT-FILE. + 01 AUDIT-LINE PIC X(120). + + WORKING-STORAGE SECTION. + 77 WS-DUMMY PIC X(10). + + 01 WS-TELECOM-REC. + COPY "telecom/TEL-BILLING.cpy". + + *> Timestamp + 01 WS-TIMESTAMP. + 05 WS-TS-DATE. + 10 WS-TS-YEAR PIC 9(4). + 10 WS-TS-MONTH PIC 9(2). + 10 WS-TS-DAY PIC 9(2). + 05 WS-TS-TIME. + 10 WS-TS-HOUR PIC 9(2). + 10 WS-TS-MIN PIC 9(2). + 10 WS-TS-SEC PIC 9(2). + 10 WS-TS-CSEC PIC 9(2). + 05 WS-TS-FMT PIC X(22). + + *> FILE STATUS codes for all files + 01 DB-STATUS PIC XX. + 88 DB-OK VALUE "00". + 88 DB-DUP VALUE "22". + 88 DB-NOTFOUND VALUE "23". + 88 DB-EOF VALUE "10". + 88 DB-LOCKED VALUE "99". + 01 RPT-STATUS PIC XX. + 88 RPT-OK VALUE "00". + 01 TXN-STATUS PIC XX. + 88 TXN-OK VALUE "00". + 01 AUD-STATUS PIC XX. + 88 AUD-OK VALUE "00". + + *> Insert keys (existing -- unchanged) + 01 WS-INSERT-KEYS. + 05 WS-KEY-1 PIC X(10) VALUE "CUST000001". + 05 WS-KEY-2 PIC X(10) VALUE "CUST000002". + 05 WS-KEY-3 PIC X(10) VALUE "CUST000003". + + *> Counters with success/fail breakdown + 01 WS-COUNTERS. + 05 WS-INS-CNT PIC 9(4) VALUE 0. + 05 WS-INS-OK PIC 9(4) VALUE 0. + 05 WS-INS-FAIL PIC 9(4) VALUE 0. + 05 WS-UPD-CNT PIC 9(4) VALUE 0. + 05 WS-UPD-OK PIC 9(4) VALUE 0. + 05 WS-UPD-FAIL PIC 9(4) VALUE 0. + 05 WS-DEL-CNT PIC 9(4) VALUE 0. + 05 WS-DEL-OK PIC 9(4) VALUE 0. + 05 WS-DEL-FAIL PIC 9(4) VALUE 0. + 05 WS-DUP-CNT PIC 9(4) VALUE 0. + 05 WS-READ-CNT PIC 9(4) VALUE 0. + 05 WS-REWRT-CNT PIC 9(4) VALUE 0. + 05 WS-START-CNT PIC 9(4) VALUE 0. + 05 WS-TOT-OP PIC 9(4) VALUE 0. + + *> Hash total and batch control + 01 WS-HASH-TOT PIC 9(18) VALUE 0. + 01 WS-HASH-DISP PIC Z(17)9. + 01 WS-BATCH-CTL. + 05 WS-BAT-ID PIC X(10) VALUE "BATCH-0001". + 05 WS-BAT-DATE PIC 9(8). + 05 WS-BAT-TIME PIC 9(4). + 05 WS-BAT-REC-CNT PIC 9(4) VALUE 0. + 05 WS-BAT-HASH PIC 9(18) VALUE 0. + + *> Before/after images for txn logging + 01 WS-BEFORE-REC. + 05 WS-BEF-KEY PIC X(10). + 05 WS-BEF-NAME PIC X(20). + 05 WS-BEF-AMT PIC 9(10). + 01 WS-AFTER-REC. + 05 WS-AFT-KEY PIC X(10). + 05 WS-AFT-NAME PIC X(20). + 05 WS-AFT-AMT PIC 9(10). + + *> Key validation + 01 WS-KEY-VAL. + 05 WS-KEY-PFX PIC X(4). + 05 WS-KEY-DGT PIC X(6). + 05 WS-KEY-DGT-N PIC 9(6). + 05 WS-KEY-VFLG PIC X. + 88 WS-KEY-OK VALUE "Y". + 88 WS-KEY-BAD VALUE "N". + + *> Lock simulation + 01 WS-LOCK-CHK. + 05 WS-LOCK-FLG PIC X VALUE "N". + 88 WS-LOCK-HELD VALUE "Y". + 88 WS-LOCK-FREE VALUE "N". + 05 WS-LOCK-CNT PIC 9(2) VALUE 0. + + *> Error info + 01 WS-ERR. + 05 WS-ERR-MSG PIC X(80). + 05 WS-ERR-FILE PIC X(20). + 05 WS-ERR-OP PIC X(25). + 05 WS-ERR-STAT PIC XX. + + *> Transaction state + 01 WS-TXN-ST PIC X(10) VALUE "INIT". + 88 WS-TXN-INIT VALUE "INIT". + 88 WS-TXN-ACTIVE VALUE "ACTIVE". + 88 WS-TXN-COMMIT VALUE "COMMITTED". + 88 WS-TXN-ROLLBK VALUE "ROLLBACK ". + + *> Report buffer (existing) + 01 WS-RPT-BUF. + 05 WS-RPT-TXT PIC X(60). + 05 WS-RPT-STAT PIC X(10). + 05 WS-RPT-CNT PIC Z(9)9. + + *> Misc + 01 WS-IDX PIC 9(2). + 01 WS-EOF-FLG PIC X. + 88 WS-EOF-YES VALUE "Y". + 88 WS-EOF-NO VALUE "N". + + *> ============================================================ + PROCEDURE DIVISION. + MAIN-PROCEDURE SECTION. + PERFORM 1000-INIT + PERFORM 2000-OPEN-FILES + PERFORM 3000-READ-INPUT + PERFORM 3100-VALIDATE-RECORD + PERFORM 3200-PROCESS-RECORD + PERFORM 3300-WRITE-OUTPUT + PERFORM 4000-REPORT + PERFORM 5000-AUDIT + PERFORM 9000-EXIT + . + + *> ============================================================ + *> 1000-INIT : init counters, timestamp, batch control, hash + *> ============================================================ + 1000-INIT SECTION. + ACCEPT WS-TS-DATE FROM DATE YYYYMMDD + ACCEPT WS-TS-TIME FROM TIME + STRING WS-TS-YEAR "/" WS-TS-MONTH "/" WS-TS-DAY " " + WS-TS-HOUR ":" WS-TS-MIN ":" WS-TS-SEC + INTO WS-TS-FMT + + MOVE 0 TO WS-INS-CNT WS-INS-OK WS-INS-FAIL + WS-UPD-CNT WS-UPD-OK WS-UPD-FAIL + WS-DEL-CNT WS-DEL-OK WS-DEL-FAIL + WS-DUP-CNT WS-READ-CNT WS-REWRT-CNT + WS-START-CNT WS-TOT-OP + MOVE 0 TO WS-HASH-TOT WS-BAT-HASH WS-BAT-REC-CNT + MOVE WS-TS-DATE TO WS-BAT-DATE + MOVE WS-TS-TIME TO WS-BAT-TIME + MOVE "BATCH-0001" TO WS-BAT-ID + MOVE "INIT" TO WS-TXN-ST + MOVE "N" TO WS-LOCK-FLG + MOVE 0 TO WS-LOCK-CNT + DISPLAY WS-TS-FMT " [INIT] 09-db-update started, Batch=" + WS-BAT-ID + . + + *> ============================================================ + *> 2000-OPEN-FILES : open all 4 files with FILE STATUS checks + *> ============================================================ + 2000-OPEN-FILES SECTION. + DISPLAY WS-TS-FMT " [OPEN] Opening DB-FILE..." + OPEN I-O DB-FILE + IF NOT DB-OK + DISPLAY WS-TS-FMT " [OPEN] I-O failed, status=" DB-STATUS + " -> trying OUTPUT" + OPEN OUTPUT DB-FILE + IF NOT DB-OK + MOVE "OPEN DB-FILE OUTPUT" TO WS-ERR-OP + MOVE DB-STATUS TO WS-ERR-STAT + MOVE "DB-FILE" TO WS-ERR-FILE + MOVE "Cannot create DB-FILE" TO WS-ERR-MSG + PERFORM 6000-ERROR-HANDLE + ELSE + DISPLAY WS-TS-FMT " [OPEN] DB-FILE created" + END-IF + ELSE + DISPLAY WS-TS-FMT " [OPEN] DB-FILE opened I-O " + END-IF + + DISPLAY WS-TS-FMT " [OPEN] Opening TXN-LOG..." + OPEN OUTPUT TXN-LOG + IF NOT TXN-OK + MOVE "OPEN TXN-LOG" TO WS-ERR-OP + MOVE TXN-STATUS TO WS-ERR-STAT + MOVE "TXN-LOG" TO WS-ERR-FILE + MOVE "Cannot open TXN-LOG" TO WS-ERR-MSG + PERFORM 6000-ERROR-HANDLE + ELSE + DISPLAY WS-TS-FMT " [OPEN] TXN-LOG opened " + END-IF + STRING WS-TS-FMT " | TXN-LOG START" INTO TXN-LOG-LINE + WRITE TXN-LOG-LINE + END-WRITE + + DISPLAY WS-TS-FMT " [OPEN] Opening REPORT-FILE..." + OPEN OUTPUT REPORT-FILE + IF NOT RPT-OK + MOVE "OPEN REPORT-FILE" TO WS-ERR-OP + MOVE RPT-STATUS TO WS-ERR-STAT + MOVE "REPORT-FILE" TO WS-ERR-FILE + MOVE "Cannot open REPORT-FILE" TO WS-ERR-MSG + PERFORM 6000-ERROR-HANDLE + ELSE + DISPLAY WS-TS-FMT " [OPEN] REPORT-FILE opened " + END-IF + + DISPLAY WS-TS-FMT " [OPEN] Opening AUDIT-FILE..." + OPEN OUTPUT AUDIT-FILE + IF NOT AUD-OK + MOVE "OPEN AUDIT-FILE" TO WS-ERR-OP + MOVE AUD-STATUS TO WS-ERR-STAT + MOVE "AUDIT-FILE" TO WS-ERR-FILE + MOVE "Cannot open AUDIT-FILE" TO WS-ERR-MSG + PERFORM 6000-ERROR-HANDLE + ELSE + DISPLAY WS-TS-FMT " [OPEN] AUDIT-FILE opened (status=00)" + END-IF + STRING WS-TS-FMT " | AUDIT LOG START" INTO AUDIT-LINE + WRITE AUDIT-LINE + END-WRITE + + MOVE "ACTIVE" TO WS-TXN-ST + PERFORM 7000-WRITE-TXN-MARKER + . + + *> ============================================================ + *> 3000-READ-INPUT : display input keys to be processed + *> ============================================================ + 3000-READ-INPUT SECTION. + DISPLAY WS-TS-FMT " [INPUT] Keys: " WS-KEY-1 " " + WS-KEY-2 " " WS-KEY-3 + STRING WS-TS-FMT " | INPUT | KEYS: " WS-KEY-1 " " + WS-KEY-2 " " WS-KEY-3 INTO TXN-LOG-LINE + WRITE TXN-LOG-LINE + END-WRITE + . + + *> ============================================================ + *> 3100-VALIDATE-RECORD : validate CUST + 6-digit key format + *> ============================================================ + 3100-VALIDATE-RECORD SECTION. + DISPLAY WS-TS-FMT " [VALIDATE] Checking keys..." + MOVE WS-KEY-1 TO DB-KEY + PERFORM 3100-CHECK-KEY + MOVE WS-KEY-2 TO DB-KEY + PERFORM 3100-CHECK-KEY + MOVE WS-KEY-3 TO DB-KEY + PERFORM 3100-CHECK-KEY + DISPLAY WS-TS-FMT " [VALIDATE] All keys validated" + . + + 3100-CHECK-KEY. + MOVE DB-KEY(1:4) TO WS-KEY-PFX + MOVE DB-KEY(5:6) TO WS-KEY-DGT + IF WS-KEY-PFX = "CUST" + MOVE WS-KEY-DGT TO WS-KEY-DGT-N + IF WS-KEY-DGT-N NUMERIC + SET WS-KEY-OK TO TRUE + DISPLAY WS-TS-FMT " [VALIDATE] KEY OK: " DB-KEY + ELSE + SET WS-KEY-BAD TO TRUE + DISPLAY WS-TS-FMT " [VALIDATE] bad digits: " DB-KEY + END-IF + ELSE + SET WS-KEY-BAD TO TRUE + DISPLAY WS-TS-FMT " [VALIDATE] INVALID prefix: " DB-KEY + END-IF + STRING WS-TS-FMT " | VALIDATE | " DB-KEY " | " + FUNCTION TRIM(WS-KEY-VFLG) INTO TXN-LOG-LINE + WRITE TXN-LOG-LINE + END-WRITE + . + + *> ============================================================ + *> 3200-PROCESS-RECORD : all 5 original phases + *> Phase 1: INSERT 3 records + *> Phase 2: Duplicate INSERT (expect STATUS 22) + *> Phase 3: UPDATE (with existence check, txn log) + *> Phase 4: DELETE (with existence check, txn log) + *> Phase 5: Read back (verify) + *> ============================================================ + 3200-PROCESS-RECORD SECTION. + + *> --- Phase 1: INSERT 3 records --- + DISPLAY WS-TS-FMT " [PROC] === Phase 1: INSERT ===" + STRING WS-TS-FMT " | BEGIN-PHASE1" INTO TXN-LOG-LINE + WRITE TXN-LOG-LINE + END-WRITE + + MOVE WS-KEY-1 TO DB-KEY + MOVE "ZHANG-SAN " TO DB-NAME + MOVE 12850 TO DB-AMOUNT + PERFORM 3200-DO-INSERT + + MOVE WS-KEY-2 TO DB-KEY + MOVE "LI-SI " TO DB-NAME + MOVE 4500 TO DB-AMOUNT + PERFORM 3200-DO-INSERT + + MOVE WS-KEY-3 TO DB-KEY + MOVE "WANG-WU " TO DB-NAME + MOVE 9990 TO DB-AMOUNT + PERFORM 3200-DO-INSERT + + *> --- Phase 2: Duplicate INSERT (expect STATUS 22) --- + DISPLAY WS-TS-FMT " [PROC] === Phase 2: Duplicate ===" + STRING WS-TS-FMT " | BEGIN-PHASE2" INTO TXN-LOG-LINE + WRITE TXN-LOG-LINE + END-WRITE + + MOVE WS-KEY-1 TO DB-KEY + MOVE "DUP-ATTEMPT " TO DB-NAME + MOVE 9999 TO DB-AMOUNT + PERFORM 3200-DO-INSERT + IF DB-DUP + DISPLAY WS-TS-FMT " Duplicate detected (STATUS 22) - OK" + ADD 1 TO WS-DUP-CNT + ADD 1 TO WS-INS-FAIL + STRING WS-TS-FMT " | DUP | " DB-KEY + " | Expected duplicate | OK" INTO TXN-LOG-LINE + WRITE TXN-LOG-LINE + END-WRITE + ELSE + DISPLAY WS-TS-FMT " Expected, got status " DB-STATUS + MOVE DB-STATUS TO WS-ERR-STAT + MOVE "DUP-CHECK" TO WS-ERR-OP + MOVE "DB-FILE" TO WS-ERR-FILE + MOVE "Duplicate test did not get STATUS 22" TO WS-ERR-MSG + PERFORM 6000-ERROR-HANDLE + END-IF + + *> --- Phase 3: UPDATE record CUST000002 --- + DISPLAY WS-TS-FMT " [PROC] === Phase 3: UPDATE ===" + STRING WS-TS-FMT " | BEGIN-PHASE3" INTO TXN-LOG-LINE + WRITE TXN-LOG-LINE + END-WRITE + + MOVE WS-KEY-2 TO DB-KEY + PERFORM 3200-READ-FOR-UPDATE + IF DB-OK + PERFORM 3200-DO-UPDATE + ELSE + DISPLAY WS-TS-FMT " KEY NOT FOUND for update: " DB-KEY + ADD 1 TO WS-UPD-FAIL + END-IF + + *> --- Phase 4: DELETE record CUST000003 --- + DISPLAY WS-TS-FMT " [PROC] === Phase 4: DELETE ===" + STRING WS-TS-FMT " | BEGIN-PHASE4" INTO TXN-LOG-LINE + WRITE TXN-LOG-LINE + END-WRITE + + MOVE WS-KEY-3 TO DB-KEY + PERFORM 3200-READ-FOR-DELETE + IF DB-OK + PERFORM 3200-DO-DELETE + ELSE + DISPLAY WS-TS-FMT " KEY NOT FOUND for delete: " DB-KEY + ADD 1 TO WS-DEL-FAIL + END-IF + + *> --- Phase 5: Read back all records (verify) --- + DISPLAY WS-TS-FMT " [PROC] === Phase 5: Verify ===" + STRING WS-TS-FMT " | BEGIN-PHASE5" INTO TXN-LOG-LINE + WRITE TXN-LOG-LINE + END-WRITE + + PERFORM 3200-READ-BACK + DISPLAY WS-TS-FMT " [PROC] Processing complete" + . + + *> ------------------------------------------------------------ + 3200-DO-INSERT. + STRING WS-TS-FMT " | INSERT | " DB-KEY " | " DB-NAME + " | " DB-AMOUNT " | START" INTO TXN-LOG-LINE + WRITE TXN-LOG-LINE + END-WRITE + WRITE DB-RECORD + INVALID KEY + DISPLAY WS-TS-FMT " INSERT FAILED, status=" DB-STATUS + ADD 1 TO WS-INS-FAIL + IF NOT DB-OK + DISPLAY WS-TS-FMT " WRITE status=" DB-STATUS + END-IF + MOVE DB-STATUS TO WS-ERR-STAT + MOVE "WRITE" TO WS-ERR-OP + MOVE "DB-FILE" TO WS-ERR-FILE + MOVE "INSERT WRITE failed" TO WS-ERR-MSG + PERFORM 6000-ERROR-HANDLE + NOT INVALID KEY + DISPLAY WS-TS-FMT " INSERT OK: " DB-KEY " " DB-NAME + ADD 1 TO WS-INS-CNT + ADD 1 TO WS-INS-OK + ADD 1 TO WS-TOT-OP + ADD DB-AMOUNT TO WS-HASH-TOT WS-BAT-HASH + STRING WS-TS-FMT " | INSERT | " DB-KEY " | " + DB-NAME " | " DB-AMOUNT " | OK" + INTO TXN-LOG-LINE + WRITE TXN-LOG-LINE + END-WRITE + PERFORM 3200-CHECK-LOCK + END-WRITE + . + + *> ------------------------------------------------------------ + 3200-READ-FOR-UPDATE. + READ DB-FILE KEY IS DB-KEY + INVALID KEY + DISPLAY WS-TS-FMT " KEY NOT FOUND for update" + ADD 1 TO WS-UPD-FAIL + NOT INVALID KEY + DISPLAY WS-TS-FMT " READ OK for update: " DB-KEY + ADD 1 TO WS-READ-CNT + MOVE DB-KEY TO WS-BEF-KEY + MOVE DB-NAME TO WS-BEF-NAME + MOVE DB-AMOUNT TO WS-BEF-AMT + STRING WS-TS-FMT " | BEFORE | " DB-KEY " | " + DB-NAME " | " DB-AMOUNT INTO TXN-LOG-LINE + WRITE TXN-LOG-LINE + END-WRITE + PERFORM 3200-CHECK-LOCK + END-READ + . + + *> ------------------------------------------------------------ + 3200-DO-UPDATE. + MOVE "UPDT: LI-SI " TO DB-NAME + MOVE 2500 TO DB-AMOUNT + MOVE DB-KEY TO WS-AFT-KEY + MOVE DB-NAME TO WS-AFT-NAME + MOVE DB-AMOUNT TO WS-AFT-AMT + STRING WS-TS-FMT " | UPDATE | " DB-KEY + " | BEFORE: " WS-BEF-NAME " " WS-BEF-AMT + " | AFTER: " WS-AFT-NAME " " WS-AFT-AMT + " | START" INTO TXN-LOG-LINE + WRITE TXN-LOG-LINE + END-WRITE + REWRITE DB-RECORD + INVALID KEY + DISPLAY WS-TS-FMT " REWRITE FAILED, status=" DB-STATUS + ADD 1 TO WS-UPD-FAIL + MOVE DB-STATUS TO WS-ERR-STAT + MOVE "REWRITE" TO WS-ERR-OP + MOVE "DB-FILE" TO WS-ERR-FILE + MOVE "UPDATE REWRITE failed" TO WS-ERR-MSG + PERFORM 6000-ERROR-HANDLE + NOT INVALID KEY + DISPLAY WS-TS-FMT " UPDATE OK: " DB-NAME + ADD 1 TO WS-UPD-CNT + ADD 1 TO WS-UPD-OK + ADD 1 TO WS-REWRT-CNT + ADD 1 TO WS-TOT-OP + ADD DB-AMOUNT TO WS-HASH-TOT WS-BAT-HASH + STRING WS-TS-FMT " | UPDATE | " DB-KEY + " | BEFORE: " WS-BEF-NAME " " WS-BEF-AMT + " | AFTER: " WS-AFT-NAME " " WS-AFT-AMT + " | OK" INTO TXN-LOG-LINE + WRITE TXN-LOG-LINE + END-WRITE + PERFORM 3200-CHECK-LOCK + END-REWRITE + . + + *> ------------------------------------------------------------ + 3200-READ-FOR-DELETE. + READ DB-FILE KEY IS DB-KEY + INVALID KEY + DISPLAY WS-TS-FMT " KEY NOT FOUND for delete" + ADD 1 TO WS-DEL-FAIL + NOT INVALID KEY + DISPLAY WS-TS-FMT " READ OK for delete: " DB-KEY + ADD 1 TO WS-READ-CNT + MOVE DB-KEY TO WS-BEF-KEY + MOVE DB-NAME TO WS-BEF-NAME + MOVE DB-AMOUNT TO WS-BEF-AMT + STRING WS-TS-FMT " | BEFORE | " DB-KEY " | " + DB-NAME " | " DB-AMOUNT + " | (will be deleted)" INTO TXN-LOG-LINE + WRITE TXN-LOG-LINE + END-WRITE + PERFORM 3200-CHECK-LOCK + END-READ + . + + *> ------------------------------------------------------------ + 3200-DO-DELETE. + STRING WS-TS-FMT " | DELETE | " DB-KEY " | " + WS-BEF-NAME " " WS-BEF-AMT " START" INTO TXN-LOG-LINE + WRITE TXN-LOG-LINE + END-WRITE + DELETE DB-FILE + INVALID KEY + DISPLAY WS-TS-FMT " DELETE FAILED, status=" DB-STATUS + ADD 1 TO WS-DEL-FAIL + MOVE DB-STATUS TO WS-ERR-STAT + MOVE "DELETE" TO WS-ERR-OP + MOVE "DB-FILE" TO WS-ERR-FILE + MOVE "DELETE operation failed" TO WS-ERR-MSG + PERFORM 6000-ERROR-HANDLE + NOT INVALID KEY + DISPLAY WS-TS-FMT " DELETE OK: " DB-KEY + ADD 1 TO WS-DEL-CNT + ADD 1 TO WS-DEL-OK + ADD 1 TO WS-TOT-OP + SUBTRACT WS-BEF-AMT FROM WS-BAT-HASH + STRING WS-TS-FMT " | DELETE | " DB-KEY " | " + WS-BEF-NAME " " WS-BEF-AMT " | DELETED-OK" + INTO TXN-LOG-LINE + WRITE TXN-LOG-LINE + END-WRITE + END-DELETE + IF NOT DB-OK + DISPLAY WS-TS-FMT " [FS] DELETE status=" DB-STATUS + END-IF + . + + *> ------------------------------------------------------------ + 3200-READ-BACK. + MOVE LOW-VALUES TO DB-KEY + START DB-FILE KEY IS GREATER THAN DB-KEY + INVALID KEY + DISPLAY WS-TS-FMT " [START] START failed" + MOVE "START" TO WS-ERR-OP + MOVE DB-STATUS TO WS-ERR-STAT + MOVE "DB-FILE" TO WS-ERR-FILE + MOVE "START failed in read-back" TO WS-ERR-MSG + PERFORM 6000-ERROR-HANDLE + NOT INVALID KEY + ADD 1 TO WS-START-CNT + DISPLAY WS-TS-FMT " [START] START OK (status=00)" + END-START + IF DB-OK + DISPLAY WS-TS-FMT " [FS] START status=" DB-STATUS + END-IF + SET WS-EOF-NO TO TRUE + PERFORM UNTIL WS-EOF-YES + READ DB-FILE NEXT RECORD + AT END + DISPLAY WS-TS-FMT " End of file" + SET WS-EOF-YES TO TRUE + NOT AT END + DISPLAY WS-TS-FMT " KEY=" DB-KEY " NAME=" DB-NAME + " AMOUNT=" DB-AMOUNT + ADD 1 TO WS-READ-CNT + ADD 1 TO WS-BAT-REC-CNT + END-READ + END-PERFORM + . + + *> ------------------------------------------------------------ + 3200-CHECK-LOCK. + IF DB-LOCKED + DISPLAY WS-TS-FMT " [LOCK] Lock detected! status=99" + SET WS-LOCK-HELD TO TRUE + ADD 1 TO WS-LOCK-CNT + STRING WS-TS-FMT " | LOCK | " DB-KEY + " | LOCK-DETECTED (99)" INTO TXN-LOG-LINE + WRITE TXN-LOG-LINE + END-WRITE + ELSE + SET WS-LOCK-FREE TO TRUE + END-IF + . + + *> ============================================================ + *> 3300-WRITE-OUTPUT : log commit marker (writes already done) + *> ============================================================ + 3300-WRITE-OUTPUT SECTION. + DISPLAY WS-TS-FMT " [OUTPUT] Finalising DB writes" + STRING WS-TS-FMT " | TXN-MARKER | COMMIT | Hash-total=" + WS-HASH-TOT " Batch-rec-count=" WS-BAT-REC-CNT + INTO TXN-LOG-LINE + WRITE TXN-LOG-LINE + END-WRITE + MOVE "COMMITTED" TO WS-TXN-ST + DISPLAY WS-TS-FMT " [OUTPUT] Commit logged" + . + + *> ============================================================ + *> 4000-REPORT : write report.txt with original + enhanced stats + *> ============================================================ + 4000-REPORT SECTION. + DISPLAY WS-TS-FMT " [REPORT] Writing report..." + MOVE "=== DB Update Test Report ===" TO REPORT-LINE + WRITE REPORT-LINE END-WRITE + MOVE SPACES TO REPORT-LINE + WRITE REPORT-LINE END-WRITE + IF NOT RPT-OK + DISPLAY WS-TS-FMT " [FS] REPORT write status=" RPT-STATUS + END-IF + + MOVE WS-INS-CNT TO WS-RPT-CNT + STRING "INSERT total: " WS-RPT-CNT + DELIMITED BY SIZE INTO REPORT-LINE + WRITE REPORT-LINE END-WRITE + MOVE WS-INS-OK TO WS-RPT-CNT + STRING "INSERT success: " WS-RPT-CNT + DELIMITED BY SIZE INTO REPORT-LINE + WRITE REPORT-LINE END-WRITE + MOVE WS-INS-FAIL TO WS-RPT-CNT + STRING "INSERT fail: " WS-RPT-CNT + DELIMITED BY SIZE INTO REPORT-LINE + WRITE REPORT-LINE END-WRITE + + MOVE WS-UPD-CNT TO WS-RPT-CNT + STRING "UPDATE total: " WS-RPT-CNT + DELIMITED BY SIZE INTO REPORT-LINE + WRITE REPORT-LINE END-WRITE + MOVE WS-UPD-OK TO WS-RPT-CNT + STRING "UPDATE success: " WS-RPT-CNT + DELIMITED BY SIZE INTO REPORT-LINE + WRITE REPORT-LINE END-WRITE + MOVE WS-UPD-FAIL TO WS-RPT-CNT + STRING "UPDATE fail: " WS-RPT-CNT + DELIMITED BY SIZE INTO REPORT-LINE + WRITE REPORT-LINE END-WRITE + + MOVE WS-DEL-CNT TO WS-RPT-CNT + STRING "DELETE total: " WS-RPT-CNT + DELIMITED BY SIZE INTO REPORT-LINE + WRITE REPORT-LINE END-WRITE + MOVE WS-DEL-OK TO WS-RPT-CNT + STRING "DELETE success: " WS-RPT-CNT + DELIMITED BY SIZE INTO REPORT-LINE + WRITE REPORT-LINE END-WRITE + MOVE WS-DEL-FAIL TO WS-RPT-CNT + STRING "DELETE fail: " WS-RPT-CNT + DELIMITED BY SIZE INTO REPORT-LINE + WRITE REPORT-LINE END-WRITE + + MOVE WS-DUP-CNT TO WS-RPT-CNT + STRING "DUP detect: " WS-RPT-CNT + DELIMITED BY SIZE INTO REPORT-LINE + WRITE REPORT-LINE END-WRITE + + MOVE SPACES TO REPORT-LINE + WRITE REPORT-LINE END-WRITE + + MOVE WS-HASH-TOT TO WS-HASH-DISP + STRING "Hash total: " WS-HASH-DISP + DELIMITED BY SIZE INTO REPORT-LINE + WRITE REPORT-LINE END-WRITE + MOVE WS-BAT-HASH TO WS-HASH-DISP + STRING "Batch hash: " WS-HASH-DISP + DELIMITED BY SIZE INTO REPORT-LINE + WRITE REPORT-LINE END-WRITE + MOVE WS-BAT-REC-CNT TO WS-RPT-CNT + STRING "Batch recs: " WS-RPT-CNT + DELIMITED BY SIZE INTO REPORT-LINE + WRITE REPORT-LINE END-WRITE + MOVE WS-TOT-OP TO WS-RPT-CNT + STRING "Total ops: " WS-RPT-CNT + DELIMITED BY SIZE INTO REPORT-LINE + WRITE REPORT-LINE END-WRITE + MOVE WS-READ-CNT TO WS-RPT-CNT + STRING "Total reads: " WS-RPT-CNT + DELIMITED BY SIZE INTO REPORT-LINE + WRITE REPORT-LINE END-WRITE + MOVE WS-LOCK-CNT TO WS-RPT-CNT + STRING "Lock events: " WS-RPT-CNT + DELIMITED BY SIZE INTO REPORT-LINE + WRITE REPORT-LINE END-WRITE + STRING "Report generated at: " WS-TS-FMT + DELIMITED BY SIZE INTO REPORT-LINE + WRITE REPORT-LINE END-WRITE + + DISPLAY WS-TS-FMT " [REPORT] Written to report.txt" + . + + *> ============================================================ + *> 5000-AUDIT : write audit.txt with op summary + timestamps + *> ============================================================ + 5000-AUDIT SECTION. + DISPLAY WS-TS-FMT " [AUDIT] Writing audit file..." + STRING WS-TS-FMT " | COMPLETE" INTO AUDIT-LINE + WRITE AUDIT-LINE END-WRITE + MOVE SPACES TO AUDIT-LINE + WRITE AUDIT-LINE END-WRITE + + STRING WS-TS-FMT " | AUDIT | BATCH-ID: " WS-BAT-ID + INTO AUDIT-LINE + WRITE AUDIT-LINE END-WRITE + + MOVE WS-INS-CNT TO WS-RPT-CNT + STRING WS-TS-FMT " | AUDIT | INSERT total: " WS-RPT-CNT + " ok:" WS-INS-OK " fail:" WS-INS-FAIL + INTO AUDIT-LINE + WRITE AUDIT-LINE END-WRITE + MOVE WS-UPD-CNT TO WS-RPT-CNT + STRING WS-TS-FMT " | AUDIT | UPDATE total: " WS-RPT-CNT + " ok:" WS-UPD-OK " fail:" WS-UPD-FAIL + INTO AUDIT-LINE + WRITE AUDIT-LINE END-WRITE + MOVE WS-DEL-CNT TO WS-RPT-CNT + STRING WS-TS-FMT " | AUDIT | DELETE total: " WS-RPT-CNT + " ok:" WS-DEL-OK " fail:" WS-DEL-FAIL + INTO AUDIT-LINE + WRITE AUDIT-LINE END-WRITE + MOVE WS-DUP-CNT TO WS-RPT-CNT + STRING WS-TS-FMT " | AUDIT | DUP events: " WS-RPT-CNT + INTO AUDIT-LINE + WRITE AUDIT-LINE END-WRITE + + MOVE SPACES TO AUDIT-LINE + WRITE AUDIT-LINE END-WRITE + + MOVE WS-HASH-TOT TO WS-HASH-DISP + STRING WS-TS-FMT " | AUDIT | Hash total: " WS-HASH-DISP + INTO AUDIT-LINE + WRITE AUDIT-LINE END-WRITE + MOVE WS-BAT-HASH TO WS-HASH-DISP + STRING WS-TS-FMT " | AUDIT | Batch hash: " WS-HASH-DISP + INTO AUDIT-LINE + WRITE AUDIT-LINE END-WRITE + MOVE WS-BAT-REC-CNT TO WS-RPT-CNT + STRING WS-TS-FMT " | AUDIT | Batch recs: " WS-RPT-CNT + INTO AUDIT-LINE + WRITE AUDIT-LINE END-WRITE + MOVE WS-TOT-OP TO WS-RPT-CNT + STRING WS-TS-FMT " | AUDIT | Total ops: " WS-RPT-CNT + INTO AUDIT-LINE + WRITE AUDIT-LINE END-WRITE + MOVE WS-LOCK-CNT TO WS-RPT-CNT + STRING WS-TS-FMT " | AUDIT | Lock events: " WS-RPT-CNT + INTO AUDIT-LINE + WRITE AUDIT-LINE END-WRITE + STRING WS-TS-FMT " | AUDIT | Txn state: " WS-TXN-ST + INTO AUDIT-LINE + WRITE AUDIT-LINE END-WRITE + STRING WS-TS-FMT " | AUDIT | End timestamp" + INTO AUDIT-LINE + WRITE AUDIT-LINE END-WRITE + + DISPLAY WS-TS-FMT " [AUDIT] Written to audit.txt" + . + + *> ============================================================ + *> 6000-ERROR-HANDLE : central error logger (non-fatal) + *> ============================================================ + 6000-ERROR-HANDLE SECTION. + DISPLAY WS-TS-FMT " [ERROR] " WS-ERR-MSG + DISPLAY WS-TS-FMT " [ERROR] File:" WS-ERR-FILE + " Op:" WS-ERR-OP " Status:" WS-ERR-STAT + STRING WS-TS-FMT " | ERROR | " WS-ERR-FILE " | " WS-ERR-OP + " | Status=" WS-ERR-STAT " | " WS-ERR-MSG + INTO TXN-LOG-LINE + WRITE TXN-LOG-LINE + END-WRITE + STRING WS-TS-FMT " | ERROR | " WS-ERR-FILE " | " WS-ERR-OP + " | Status=" WS-ERR-STAT " | " WS-ERR-MSG + INTO AUDIT-LINE + WRITE AUDIT-LINE + END-WRITE + . + + *> ============================================================ + *> 7000-WRITE-TXN-MARKER : write txn state marker to log + *> ============================================================ + 7000-WRITE-TXN-MARKER. + STRING WS-TS-FMT " | TXN-MARKER | State=" WS-TXN-ST + INTO TXN-LOG-LINE + WRITE TXN-LOG-LINE + END-WRITE + . + + *> ============================================================ + *> 9000-EXIT : close all files, FILE STATUS checks, exit + *> ============================================================ + 9000-EXIT SECTION. + DISPLAY WS-TS-FMT " [EXIT] Closing files..." + IF WS-TXN-ACTIVE + MOVE "COMMITTED" TO WS-TXN-ST + END-IF + PERFORM 7000-WRITE-TXN-MARKER + + STRING WS-TS-FMT " | TXN-LOG END" INTO TXN-LOG-LINE + WRITE TXN-LOG-LINE + END-WRITE + STRING WS-TS-FMT " | AUDIT LOG END" INTO AUDIT-LINE + WRITE AUDIT-LINE END-WRITE + + CLOSE DB-FILE + IF NOT DB-OK + DISPLAY WS-TS-FMT " [FS] CLOSE DB-FILE status=" DB-STATUS + ELSE + DISPLAY WS-TS-FMT " [EXIT] DB-FILE closed OK" + END-IF + CLOSE TXN-LOG + IF NOT TXN-OK + DISPLAY WS-TS-FMT " CLOSE TXN-LOG status=" TXN-STATUS + ELSE + DISPLAY WS-TS-FMT " [EXIT] TXN-LOG closed OK" + END-IF + CLOSE REPORT-FILE + IF NOT RPT-OK + DISPLAY WS-TS-FMT " CLOSE REPORT-FILE status=" RPT-STATUS + ELSE + DISPLAY WS-TS-FMT " [EXIT] REPORT-FILE closed OK" + END-IF + CLOSE AUDIT-FILE + IF NOT AUD-OK + DISPLAY WS-TS-FMT " CLOSE AUDIT-FILE status=" AUD-STATUS + ELSE + DISPLAY WS-TS-FMT " [EXIT] AUDIT-FILE closed OK" + END-IF + + DISPLAY WS-TS-FMT " [EXIT] === Final Counters ===" + DISPLAY WS-TS-FMT " [EXIT] INSERT: " WS-INS-CNT + " (OK:" WS-INS-OK " FAIL:" WS-INS-FAIL ")" + DISPLAY WS-TS-FMT " [EXIT] UPDATE: " WS-UPD-CNT + " (OK:" WS-UPD-OK " FAIL:" WS-UPD-FAIL ")" + DISPLAY WS-TS-FMT " [EXIT] DELETE: " WS-DEL-CNT + " (OK:" WS-DEL-OK " FAIL:" WS-DEL-FAIL ")" + DISPLAY WS-TS-FMT " [EXIT] DUP: " WS-DUP-CNT + DISPLAY WS-TS-FMT " [EXIT] Hash: " WS-HASH-TOT + DISPLAY WS-TS-FMT " [EXIT] Batch: " WS-BAT-REC-CNT + + ACCEPT WS-TS-DATE FROM DATE YYYYMMDD + ACCEPT WS-TS-TIME FROM TIME + STRING WS-TS-YEAR "/" WS-TS-MONTH "/" WS-TS-DAY " " + WS-TS-HOUR ":" WS-TS-MIN ":" WS-TS-SEC + INTO WS-TS-FMT + DISPLAY WS-TS-FMT " [EXIT] Program ended normally" + STOP RUN + . diff --git a/benchmark-programs/09-db-update/report.txt b/benchmark-programs/09-db-update/report.txt new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/09-db-update/txn-log.txt b/benchmark-programs/09-db-update/txn-log.txt new file mode 100644 index 0000000..cb22d6b --- /dev/null +++ b/benchmark-programs/09-db-update/txn-log.txt @@ -0,0 +1,6 @@ +2026/06/22 16:35:04 | ERROR | DB-FILE | WRITE | Status=22 | INSERT WRITE failed +2026/06/22 16:35:04 | TXN-MARKER | State=ACTIVE | WRITE | Status=22 | INSERT WRITE failed +2026/06/22 16:35:04 | DUP | CUST000001 | Expected duplicate | OK | Status=22 | INSERT WRITE failed +2026/06/22 16:35:04 | BEGIN-PHASE30001 | Expected duplicate | OK | Status=22 | INSERT WRITE failed +2026/06/22 16:35:04 | BEGIN-PHASE40001 | Expected duplicate | OK | Status=22 | INSERT WRITE failed +2026/06/22 16:35:04 | BEGIN-PHASE50001 | Expected duplicate | OK | Status=22 | INSERT WRITE failed diff --git a/benchmark-programs/10-divide-50/FILE-IN b/benchmark-programs/10-divide-50/FILE-IN new file mode 100644 index 0000000..1eb12b8 --- /dev/null +++ b/benchmark-programs/10-divide-50/FILE-IN @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/benchmark-programs/10-divide-50/FILE-IN.DAT b/benchmark-programs/10-divide-50/FILE-IN.DAT new file mode 100644 index 0000000..846e8a0 --- /dev/null +++ b/benchmark-programs/10-divide-50/FILE-IN.DAT @@ -0,0 +1,51 @@ +INV0000001 ZHANG-SAN 0000500 +INV0000002 LI-SI 0001500 +INV0000003 WANG-WU 0003500 +INV0000004 ZHAO-LIU 0005000 +INV0000005 SUN-QI 0015000 +INV0000006 ZHOU-BA 0050000 +INV0000007 ZHANG-SAN 0100000 +INV0000008 LI-SI 0250000 +INV0000009 WANG-WU 0500000 +INV0000010 ZHAO-LIU 0000500 +INV0000011 SUN-QI 0001500 +INV0000012 ZHOU-BA 0003500 +INV0000013 ZHANG-SAN 0005000 +INV0000014 LI-SI 0015000 +INV0000015 WANG-WU 0050000 +INV0000016 ZHAO-LIU 0100000 +INV0000017 SUN-QI 0250000 +INV0000018 ZHOU-BA 0500000 +INV0000019 ZHANG-SAN 0000500 +INV0000020 LI-SI 0001500 +INV0000021 WANG-WU 0003500 +INV0000022 ZHAO-LIU 0005000 +INV0000023 SUN-QI 0015000 +INV0000024 ZHOU-BA 0050000 +INV0000025 ZHANG-SAN 0100000 +INV0000026 LI-SI 0250000 +INV0000027 WANG-WU 0500000 +INV0000028 ZHAO-LIU 0000500 +INV0000029 SUN-QI 0001500 +INV0000030 ZHOU-BA 0003500 +INV0000031 ZHANG-SAN 0005000 +INV0000032 LI-SI 0015000 +INV0000033 WANG-WU 0050000 +INV0000034 ZHAO-LIU 0100000 +INV0000035 SUN-QI 0250000 +INV0000036 ZHOU-BA 0500000 +INV0000037 ZHANG-SAN 0000500 +INV0000038 LI-SI 0001500 +INV0000039 WANG-WU 0003500 +INV0000040 ZHAO-LIU 0005000 +INV0000041 SUN-QI 0015000 +INV0000042 ZHOU-BA 0050000 +INV0000043 ZHANG-SAN 0100000 +INV0000044 LI-SI 0250000 +INV0000045 WANG-WU 0500000 +INV0000046 ZHAO-LIU 0000500 +INV0000047 SUN-QI 0001500 +INV0000048 ZHOU-BA 0003500 +INV0000049 ZHANG-SAN 0005000 +INV0000050 LI-SI 0015000 +INV0000051 WANG-WU 0050000 diff --git a/benchmark-programs/10-divide-50/README.md b/benchmark-programs/10-divide-50/README.md new file mode 100644 index 0000000..bcc0b0c --- /dev/null +++ b/benchmark-programs/10-divide-50/README.md @@ -0,0 +1,34 @@ +# 10-divide-50 — 50-Division File Splitter + +## 电信业务场景 + +请求书50分割。将请求书数据按50件一个文件进行分割输出，用于分批印刷或批量发送。 + +Demonstrates dividing input records into groups of 50: + +- **PERFORM VARYING counter**: Track record numbers across the loop +- **DIVIDE ... GIVING REMAINDER**: Calculate file number from record count +- **Close-write cycle**: Close old file, open new file at each boundary +- Tested at boundary conditions: 50 (exact), 51 (one extra), 49 (one short) + +## Files + +| File | Purpose | +|------|---------| +| `main-10-divide-50.cbl` | COBOL program (fixed format) | +| `data-gen.sh` | Generate N test records (default 51) | +| `run.sh` | Compile + run 3 test cases | + +## Algorithm + +``` +DIVIDE record-count BY 50 GIVING Q REMAINDER R +IF R = 1 → open new FILE-OUT-NN +Write record to current file +``` + +## Output Files + +- FILE-OUT-01.DAT: records 1-50 +- FILE-OUT-02.DAT: records 51-100 +- etc. diff --git a/benchmark-programs/10-divide-50/main-10-divide-50.cbl b/benchmark-programs/10-divide-50/main-10-divide-50.cbl new file mode 100644 index 0000000..f58dfbe --- /dev/null +++ b/benchmark-programs/10-divide-50/main-10-divide-50.cbl @@ -0,0 +1,696 @@ + *> ============================================================ + *> 10-divide-50 : 请求书50分割 (Invoice 50-Split) + *> Input : FILE-IN.DAT (请求书记录: 50件毎分割) + *> Output: FILE-OUT-NN (50件毎の分割出力文件: FILE-OUT-01, 02...) + *> Coverage: S-N001~N003, S-N006, S-N007, S-R001, S-R002 + *> EXTENDED: Added file recovery, hash totals, boundary checks, + *> split statistics, audit trail, inventory records, + *> file status checking, error severity levels, + *> header/trailer records, file-naming validation + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. Divide50. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN + ASSIGN TO WS-FILE-IN-NAME + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-FILE-IN-STATUS. + + SELECT FILE-OUT + ASSIGN TO WS-OUT-FILE + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-FILE-OUT-STATUS. + + SELECT FILE-AUDIT + ASSIGN TO "AUDIT-OUT.DAT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-FILE-AUDIT-STATUS. + + DATA DIVISION. + FILE SECTION. + FD FILE-IN. + 01 FILE-IN-REC. + 05 IN-RECORD PIC X(30). + + FD FILE-OUT. + 01 FILE-OUT-REC. + 05 OUT-RECORD PIC X(30). + + FD FILE-AUDIT. + 01 FILE-AUDIT-REC PIC X(80). + + WORKING-STORAGE SECTION. + 01 WS-TELECOM-REC. + COPY "telecom/TEL-INVOICE.cpy". + 01 WS-STATUS. + 05 WS-EOF-FLAG PIC X VALUE 'N'. + 88 WS-EOF VALUE 'Y' FALSE 'N'. + + 01 WS-COUNTERS. + 05 WS-REC-COUNT PIC 9(5) VALUE 0. + 05 WS-FILE-NUM PIC 9(2) VALUE 0. + 05 WS-DIVISOR PIC 9(2) VALUE 50. + 05 WS-QUOTIENT PIC 9(5). + 05 WS-REMAINDER PIC 9(5). + + 01 WS-OUT-FILE PIC X(30). + 01 WS-FILE-NUM-ED PIC 99. + + 01 WS-DISPLAY-COUNT PIC Z(9)9. + 01 WS-INVOICE-REC. + COPY "telecom/TEL-INVOICE.cpy". + + *> ===== EXPANDED: Dynamic input file name ===== + 01 WS-FILE-IN-NAME PIC X(30) VALUE "FILE-IN.DAT". + + *> ===== EXPANDED: File status fields ===== + 01 WS-FILE-STATUS-VARS. + 05 WS-FILE-IN-STATUS PIC X(2). + 05 WS-FILE-OUT-STATUS PIC X(2). + 05 WS-FILE-AUDIT-STATUS PIC X(2). + + *> ===== EXPANDED: Error handling with severity levels ===== + 01 WS-ERROR-HANDLING. + 05 WS-OPEN-RETRY-COUNT PIC 9(2) VALUE 0. + 05 WS-OPEN-RETRY-MAX PIC 9(2) VALUE 3. + 05 WS-ALT-SUFFIX PIC X(3) VALUE "ALT". + 05 WS-ALT-OUT-FILE PIC X(30). + 05 WS-SEVERITY PIC X(7). + 88 WS-SEVERITY-WARNING VALUE 'WARNING'. + 88 WS-SEVERITY-ERROR VALUE 'ERROR'. + 88 WS-SEVERITY-FATAL VALUE 'FATAL'. + + *> ===== EXPANDED: File name validation flag ===== + 01 WS-FILE-NAME-FLAGS. + 05 WS-FILE-NAME-VALID PIC X VALUE 'Y'. + 88 WS-FILE-NAME-OK VALUE 'Y' FALSE 'N'. + 88 WS-FILE-NAME-BAD VALUE 'N'. + 05 WS-NAME-CHAR-IDX PIC 9(2). + 05 WS-NAME-CHAR-VAL PIC X(1). + + *> ===== EXPANDED: Hash totals for data integrity ===== + 01 WS-HASH-TOTALS. + 05 WS-HASH-TOTAL-IN PIC 9(12) VALUE 0. + 05 WS-HASH-TOTAL-OUT PIC 9(12) VALUE 0. + 05 WS-HASH-VERIFIED PIC X VALUE 'N'. + 88 WS-HASH-MATCH VALUE 'Y' FALSE 'N'. + + *> ===== EXPANDED: Split statistics per output file ===== + 01 WS-SPLIT-STATS. + 05 WS-SPLIT-REC-COUNT PIC 9(5) VALUE 0. + 05 WS-SPLIT-HASH-TOTAL PIC 9(12) VALUE 0. + 05 WS-SPLIT-REC-MIN PIC X(30). + 05 WS-SPLIT-REC-MAX PIC X(30). + 05 WS-SPLIT-FIRST-REC PIC X(30). + 05 WS-SPLIT-LAST-REC PIC X(30). + + *> ===== EXPANDED: Boundary condition flags ===== + 01 WS-BOUNDARY-FLAG PIC X VALUE 'N'. + 88 WS-BOUNDARY-EMPTY VALUE 'E'. + 88 WS-BOUNDARY-SINGLE VALUE 'S'. + 88 WS-BOUNDARY-EXACT VALUE 'X'. + 88 WS-BOUNDARY-TRAILING VALUE 'T'. + 01 WS-TRAILER-COUNT PIC 9(5) VALUE 0. + + *> ===== EXPANDED: Inventory table for output files ===== + 01 WS-INVENTORY-TABLE. + 05 WS-INVENTORY-ENTRIES PIC 9(2) VALUE 0. + 05 WS-INVENTORY-ENTRY OCCURS 99 TIMES + INDEXED BY WS-INV-IDX. + 10 WS-INV-FILE-NUM PIC 9(2). + 10 WS-INV-REC-COUNT PIC 9(5). + 10 WS-INV-HASH-TOTAL PIC 9(12). + + *> ===== EXPANDED: Timestamp for display tracing ===== + 01 WS-TIMESTAMP PIC X(14). + + *> ===== EXPANDED: Batch control totals ===== + 01 WS-BATCH-CONTROLS. + 05 WS-BATCH-TOTAL-RECS PIC 9(5) VALUE 0. + + *> ===== EXPANDED: Display edited fields ===== + 01 WS-DISPLAY-EDITED. + 05 WS-DISP-HASH-IN PIC Z(11)9. + 05 WS-DISP-HASH-OUT PIC Z(11)9. + 05 WS-DISP-SPLIT-COUNT PIC Z(9)9. + 05 WS-DISP-SPLIT-HASH PIC Z(11)9. + 05 WS-DISP-RETRY PIC Z9. + 05 WS-DISP-TRAILER PIC Z(9)9. + 05 WS-DISP-INV-RECS PIC Z(9)9. + 05 WS-DISP-INV-HASH PIC Z(11)9. + + *> ===== EXPANDED: Hash computation work fields ===== + 01 WS-HASH-WORK. + 05 WS-HASH-VAL PIC 9(3). + 05 WS-HASH-IDX PIC 9(2). + 05 WS-HASH-ALLOC PIC 9(12). + + *> ===== EXPANDED: Inventory sum work fields ===== + 01 WS-INVENTORY-SUM. + 05 WS-INV-SUM-COUNT PIC 9(5) VALUE 0. + 05 WS-INV-SUM-HASH PIC 9(12) VALUE 0. + + *> ===== EXPANDED: Audit report fields ===== + 01 WS-AUDIT-LINE. + 05 WS-AUDIT-TYPE PIC X(15). + 05 WS-AUDIT-DATA PIC X(65). + + *> ===== EXPANDED: File name check constants ===== + 01 WS-INVALID-CHARS. + 05 WS-INVALID-CHAR PIC X(18) VALUE + "!@#$%^&*()+=[]{}|;':<>?,/". + + PROCEDURE DIVISION. + MAIN SECTION. + MAIN-PROCEDURE. + PERFORM 1000-INIT-SECTION + PERFORM 2000-OPEN-FILES-SECTION + PERFORM 3000-PROCESS-SECTION + PERFORM 4000-REPORT-SECTION + PERFORM 5000-AUDIT-SECTION + PERFORM 9000-EXIT-SECTION + STOP RUN. + * + 1000-INIT-SECTION. + * + 1000-INIT-PROC. + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP + + DISPLAY "=== 50-DIVISION PROCESSING ===" + DISPLAY "Records per file: " WS-DIVISOR + DISPLAY "Init: " WS-TIMESTAMP + DISPLAY " " + + INITIALIZE WS-FILE-STATUS-VARS WS-ERROR-HANDLING + INITIALIZE WS-HASH-TOTALS WS-SPLIT-STATS + INITIALIZE WS-BOUNDARY-FLAG WS-TRAILER-COUNT + INITIALIZE WS-INVENTORY-TABLE WS-BATCH-CONTROLS + INITIALIZE WS-INVENTORY-SUM WS-HASH-WORK + + MOVE "FILE-IN.DAT" TO WS-FILE-IN-NAME + . + * + 2000-OPEN-FILES-SECTION. + * + 2000-OPEN-FILES-PROC. + *> Open input file with status check + OPEN INPUT FILE-IN + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP + + IF WS-FILE-IN-STATUS = "00" + DISPLAY "[" WS-TIMESTAMP "] OPEN: FILE-IN.DAT OK" + ELSE + MOVE 'ERROR' TO WS-SEVERITY + DISPLAY "[" WS-TIMESTAMP "] ERROR: FILE-IN open " + "failed status=" WS-FILE-IN-STATUS + MOVE "FILE-IN.ALT" TO WS-FILE-IN-NAME + ADD 1 TO WS-OPEN-RETRY-COUNT + OPEN INPUT FILE-IN + IF WS-FILE-IN-STATUS = "00" + DISPLAY "[" WS-TIMESTAMP "] OPEN: FILE-IN.ALT OK " + "(retry=" WS-OPEN-RETRY-COUNT ")" + ELSE + MOVE 'FATAL' TO WS-SEVERITY + DISPLAY "[" WS-TIMESTAMP "] FATAL: Cannot open " + "FILE-IN after retry" + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + END-IF + + OPEN OUTPUT FILE-AUDIT + IF WS-FILE-AUDIT-STATUS = "00" + DISPLAY "[" WS-TIMESTAMP "] OPEN: AUDIT-OUT.DAT OK" + ELSE + DISPLAY "[" WS-TIMESTAMP "] WARNING: AUDIT open " + "failed status=" WS-FILE-AUDIT-STATUS + END-IF + + MOVE "AUDIT-START" TO WS-AUDIT-TYPE + STRING "Session started " WS-TIMESTAMP + " divisor=" WS-DIVISOR + " input=" WS-FILE-IN-NAME + INTO WS-AUDIT-DATA + END-STRING + MOVE WS-AUDIT-LINE TO FILE-AUDIT-REC + WRITE FILE-AUDIT-REC + . + * + 3000-PROCESS-SECTION. + * + 3000-PROCESS-PROC. + MOVE "AUDIT-PROCESS" TO WS-AUDIT-TYPE + STRING "Processing started, input=" + WS-FILE-IN-NAME + INTO WS-AUDIT-DATA + END-STRING + MOVE WS-AUDIT-LINE TO FILE-AUDIT-REC + WRITE FILE-AUDIT-REC + + PERFORM VARYING WS-REC-COUNT FROM 1 BY 1 + UNTIL WS-EOF + PERFORM 3100-READ-INPUT-SECTION + IF NOT WS-EOF + PERFORM 3200-VALIDATE-SECTION + PERFORM 3300-APPLY-RULES-SECTION + PERFORM 3400-WRITE-OUTPUT-SECTION + END-IF + END-PERFORM + + *> Close and finalize the last output file + IF WS-FILE-NUM > 0 + PERFORM 3500-FINALIZE-FILE-SECTION + CLOSE FILE-OUT + IF WS-FILE-OUT-STATUS NOT = "00" + DISPLAY "WARNING: FILE-OUT close status=" + WS-FILE-OUT-STATUS + END-IF + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP + DISPLAY "[" WS-TIMESTAMP "] Closed final file: " + WS-OUT-FILE + END-IF + . + * + 3100-READ-INPUT-SECTION. + * + 3100-READ-INPUT-PROC. + READ FILE-IN INTO FILE-IN-REC + AT END SET WS-EOF TO TRUE + NOT AT END + ADD 1 TO WS-BATCH-TOTAL-RECS + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP + DISPLAY "[" WS-TIMESTAMP "] Read record " + WS-REC-COUNT + END-READ + + IF WS-FILE-IN-STATUS NOT = "00" + AND WS-FILE-IN-STATUS NOT = "10" + MOVE 'ERROR' TO WS-SEVERITY + DISPLAY "ERROR: FILE-IN read failed, status=" + WS-FILE-IN-STATUS " at record " + WS-REC-COUNT + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + . + * + 3200-VALIDATE-SECTION. + * + 3200-VALIDATE-PROC. + *> Check for empty record + IF IN-RECORD = SPACES + MOVE 'WARNING' TO WS-SEVERITY + DISPLAY "WARNING: Record " WS-REC-COUNT + " is empty" + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + + *> Compute input hash total contribution + PERFORM VARYING WS-HASH-IDX FROM 1 BY 1 + UNTIL WS-HASH-IDX > 30 + COMPUTE WS-HASH-VAL = FUNCTION ORD( + IN-RECORD(WS-HASH-IDX:1)) + ADD WS-HASH-VAL TO WS-HASH-TOTAL-IN + END-PERFORM + . + * + 3300-APPLY-RULES-SECTION. + * + *> === ORIGINAL DIVIDE LOGIC — preserved intact === + 3300-APPLY-RULES-PROC. + DIVIDE WS-REC-COUNT BY WS-DIVISOR + GIVING WS-QUOTIENT REMAINDER WS-REMAINDER + + IF WS-REMAINDER = 1 + IF WS-FILE-NUM > 0 + PERFORM 3500-FINALIZE-FILE-SECTION + CLOSE FILE-OUT + IF WS-FILE-OUT-STATUS NOT = "00" + DISPLAY "WARNING: Close status=" + WS-FILE-OUT-STATUS + END-IF + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP + DISPLAY "[" WS-TIMESTAMP "] Closed: " + WS-OUT-FILE + END-IF + ADD 1 TO WS-FILE-NUM + MOVE WS-FILE-NUM TO WS-FILE-NUM-ED + STRING "FILE-OUT-" DELIMITED BY SIZE + WS-FILE-NUM-ED DELIMITED BY SIZE + ".DAT" DELIMITED BY SIZE + INTO WS-OUT-FILE + PERFORM 3310-VALIDATE-FILE-NAME + PERFORM 3320-OPEN-OUTPUT-WITH-RETRY + PERFORM 3330-WRITE-SPLIT-HEADER + END-IF + . + * + 3310-VALIDATE-FILE-NAME. + * + 3310-VALIDATE-NAME-PROC. + MOVE 'Y' TO WS-FILE-NAME-VALID + + *> Check for empty name + IF WS-OUT-FILE = SPACES + MOVE 'N' TO WS-FILE-NAME-VALID + MOVE 'ERROR' TO WS-SEVERITY + DISPLAY "ERROR: Empty output file name" + PERFORM 6000-ERROR-HANDLE-SECTION + EXIT PARAGRAPH + END-IF + + *> Check for invalid characters in file name + PERFORM VARYING WS-NAME-CHAR-IDX FROM 1 BY 1 + UNTIL WS-NAME-CHAR-IDX > 30 + OR WS-FILE-NAME-VALID = 'N' + IF WS-OUT-FILE(WS-NAME-CHAR-IDX:1) = SPACE + EXIT PERFORM + END-IF + MOVE WS-OUT-FILE(WS-NAME-CHAR-IDX:1) + TO WS-NAME-CHAR-VAL + MOVE 0 TO WS-HASH-ALLOC + INSPECT WS-INVALID-CHARS TALLYING WS-HASH-ALLOC + FOR ALL WS-NAME-CHAR-VAL + IF WS-HASH-ALLOC > 0 + MOVE 'N' TO WS-FILE-NAME-VALID + MOVE 'ERROR' TO WS-SEVERITY + DISPLAY "ERROR: Invalid char in file name '" + WS-OUT-FILE "'" + PERFORM 6000-ERROR-HANDLE-SECTION + EXIT PARAGRAPH + END-IF + END-PERFORM + . + * + 3320-OPEN-OUTPUT-WITH-RETRY. + * + 3320-RETRY-PROC. + MOVE 0 TO WS-OPEN-RETRY-COUNT + MOVE WS-OUT-FILE TO WS-ALT-OUT-FILE + . + + 3320-RETRY-LOOP. + OPEN OUTPUT FILE-OUT + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP + + IF WS-FILE-OUT-STATUS = "00" + DISPLAY "[" WS-TIMESTAMP "] Opened: " + WS-OUT-FILE + ELSE + ADD 1 TO WS-OPEN-RETRY-COUNT + IF WS-OPEN-RETRY-COUNT <= WS-OPEN-RETRY-MAX + DISPLAY "[" WS-TIMESTAMP "] RETRY " + WS-OPEN-RETRY-COUNT ": " + WS-OUT-FILE " status=" + WS-FILE-OUT-STATUS + STRING "FILE-OUT-" WS-FILE-NUM-ED + "-" WS-ALT-SUFFIX ".DAT" + DELIMITED BY SIZE + INTO WS-OUT-FILE + END-STRING + GO TO 3320-RETRY-LOOP + ELSE + MOVE 'FATAL' TO WS-SEVERITY + DISPLAY "[" WS-TIMESTAMP "] FATAL: " + "Open failed after " + WS-OPEN-RETRY-MAX " retries" + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + END-IF + . + * + 3330-WRITE-SPLIT-HEADER. + * + 3330-HEADER-PROC. + *> Initialize split statistics for new output file + MOVE 0 TO WS-SPLIT-REC-COUNT + MOVE 0 TO WS-SPLIT-HASH-TOTAL + MOVE SPACES TO WS-SPLIT-REC-MIN + MOVE SPACES TO WS-SPLIT-REC-MAX + MOVE SPACES TO WS-SPLIT-FIRST-REC + MOVE SPACES TO WS-SPLIT-LAST-REC + + *> Write header record to output file + MOVE SPACES TO FILE-OUT-REC + STRING "HDR" WS-FILE-NUM-ED + " SPLIT START" + INTO OUT-RECORD + END-STRING + WRITE FILE-OUT-REC + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP + DISPLAY "[" WS-TIMESTAMP "] Header: HDR" + WS-FILE-NUM-ED " written to " + WS-OUT-FILE + . + * + 3400-WRITE-OUTPUT-SECTION. + * + *> === ORIGINAL WRITE LOGIC — preserved intact === + 3400-WRITE-OUTPUT-PROC. + MOVE IN-RECORD TO OUT-RECORD + WRITE FILE-OUT-REC + + PERFORM 3410-UPDATE-SPLIT-STATS + . + * + 3410-UPDATE-SPLIT-STATS. + * + 3410-STATS-PROC. + ADD 1 TO WS-SPLIT-REC-COUNT + + *> Accumulate hash total for this split file + PERFORM VARYING WS-HASH-IDX FROM 1 BY 1 + UNTIL WS-HASH-IDX > 30 + COMPUTE WS-HASH-VAL = FUNCTION ORD( + OUT-RECORD(WS-HASH-IDX:1)) + ADD WS-HASH-VAL TO WS-SPLIT-HASH-TOTAL + ADD WS-HASH-VAL TO WS-HASH-TOTAL-OUT + END-PERFORM + + *> Track min, max, first, last records per split + IF WS-SPLIT-REC-COUNT = 1 + MOVE IN-RECORD TO WS-SPLIT-REC-MIN + MOVE IN-RECORD TO WS-SPLIT-REC-MAX + MOVE IN-RECORD TO WS-SPLIT-FIRST-REC + ELSE + IF IN-RECORD < WS-SPLIT-REC-MIN + MOVE IN-RECORD TO WS-SPLIT-REC-MIN + END-IF + IF IN-RECORD > WS-SPLIT-REC-MAX + MOVE IN-RECORD TO WS-SPLIT-REC-MAX + END-IF + END-IF + MOVE IN-RECORD TO WS-SPLIT-LAST-REC + . + * + 3500-FINALIZE-FILE-SECTION. + * + *> Write trailer record and update inventory for closing file + 3500-FINALIZE-PROC. + MOVE SPACES TO FILE-OUT-REC + MOVE WS-SPLIT-REC-COUNT TO WS-DISP-SPLIT-COUNT + MOVE WS-SPLIT-HASH-TOTAL TO WS-DISP-SPLIT-HASH + STRING "TRL" WS-FILE-NUM-ED + " R=" WS-DISP-SPLIT-COUNT + " H=" WS-DISP-SPLIT-HASH + INTO OUT-RECORD + END-STRING + WRITE FILE-OUT-REC + + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP + DISPLAY "[" WS-TIMESTAMP "] Trailer: TRL" + WS-FILE-NUM-ED " R=" WS-DISP-SPLIT-COUNT + " H=" WS-DISP-SPLIT-HASH + + *> Update inventory table for this output file + ADD 1 TO WS-INVENTORY-ENTRIES + MOVE WS-FILE-NUM + TO WS-INV-FILE-NUM(WS-INVENTORY-ENTRIES) + MOVE WS-SPLIT-REC-COUNT + TO WS-INV-REC-COUNT(WS-INVENTORY-ENTRIES) + MOVE WS-SPLIT-HASH-TOTAL + TO WS-INV-HASH-TOTAL(WS-INVENTORY-ENTRIES) + + *> Write inventory record to audit file + MOVE "INVENTORY" TO WS-AUDIT-TYPE + STRING "File=F" WS-FILE-NUM-ED + " Recs=" WS-DISP-SPLIT-COUNT + " Hash=" WS-DISP-SPLIT-HASH + INTO WS-AUDIT-DATA + END-STRING + MOVE WS-AUDIT-LINE TO FILE-AUDIT-REC + WRITE FILE-AUDIT-REC + . + * + 4000-REPORT-SECTION. + * + 4000-REPORT-PROC. + MOVE WS-REC-COUNT TO WS-DISPLAY-COUNT + DISPLAY " " + DISPLAY "=== SPLIT REPORT ===" + DISPLAY "Total records: " WS-DISPLAY-COUNT + DISPLAY "Output files: " WS-FILE-NUM + DISPLAY " " + + *> Boundary condition detection + IF WS-BATCH-TOTAL-RECS = 0 + SET WS-BOUNDARY-EMPTY TO TRUE + DISPLAY "BOUNDARY: Empty input file" + END-IF + IF WS-BATCH-TOTAL-RECS = 1 + SET WS-BOUNDARY-SINGLE TO TRUE + DISPLAY "BOUNDARY: Single-record file" + END-IF + DIVIDE WS-BATCH-TOTAL-RECS BY WS-DIVISOR + GIVING WS-QUOTIENT REMAINDER WS-REMAINDER + IF WS-REMAINDER = 0 + SET WS-BOUNDARY-EXACT TO TRUE + DISPLAY "BOUNDARY: Exact multiple of " WS-DIVISOR + ELSE + SET WS-BOUNDARY-TRAILING TO TRUE + MOVE WS-REMAINDER TO WS-TRAILER-COUNT + MOVE WS-TRAILER-COUNT TO WS-DISP-TRAILER + DISPLAY "BOUNDARY: Trailing records=" WS-DISP-TRAILER + END-IF + DISPLAY " " + + *> Hash total verification + MOVE WS-HASH-TOTAL-IN TO WS-DISP-HASH-IN + MOVE WS-HASH-TOTAL-OUT TO WS-DISP-HASH-OUT + DISPLAY "Hash IN: " WS-DISP-HASH-IN + DISPLAY "Hash OUT: " WS-DISP-HASH-OUT + MOVE 0 TO WS-INV-SUM-HASH + PERFORM VARYING WS-INV-SUM-COUNT FROM 1 BY 1 + UNTIL WS-INV-SUM-COUNT > WS-INVENTORY-ENTRIES + ADD WS-INV-HASH-TOTAL(WS-INV-SUM-COUNT) + TO WS-INV-SUM-HASH + END-PERFORM + MOVE WS-INV-SUM-HASH TO WS-DISP-INV-HASH + DISPLAY "Hash INV: " WS-DISP-INV-HASH + IF WS-HASH-TOTAL-IN = WS-HASH-TOTAL-OUT + AND WS-HASH-TOTAL-IN = WS-INV-SUM-HASH + MOVE 'Y' TO WS-HASH-VERIFIED + DISPLAY "HASH: VERIFIED" + ELSE + DISPLAY "HASH: MISMATCH!" + END-IF + DISPLAY " " + + *> Per-file inventory summary + DISPLAY "-- Split File Inventory --" + PERFORM VARYING WS-INV-SUM-COUNT FROM 1 BY 1 + UNTIL WS-INV-SUM-COUNT > WS-INVENTORY-ENTRIES + MOVE WS-INV-REC-COUNT(WS-INV-SUM-COUNT) + TO WS-DISP-INV-RECS + MOVE WS-INV-HASH-TOTAL(WS-INV-SUM-COUNT) + TO WS-DISP-INV-HASH + DISPLAY " F" WS-INV-FILE-NUM(WS-INV-SUM-COUNT) + " recs=" WS-DISP-INV-RECS + " hash=" WS-DISP-INV-HASH + END-PERFORM + . + * + 5000-AUDIT-SECTION. + * + 5000-AUDIT-PROC. + MOVE "AUDIT-END" TO WS-AUDIT-TYPE + STRING "Records=" WS-DISPLAY-COUNT + " Files=" WS-FILE-NUM + INTO WS-AUDIT-DATA + END-STRING + MOVE WS-AUDIT-LINE TO FILE-AUDIT-REC + WRITE FILE-AUDIT-REC + + IF WS-HASH-MATCH + MOVE "HASH-VERIFIED" TO WS-AUDIT-TYPE + ELSE + MOVE "HASH-MISMATCH" TO WS-AUDIT-TYPE + END-IF + STRING "IN=" WS-DISP-HASH-IN " OUT=" WS-DISP-HASH-OUT + INTO WS-AUDIT-DATA + END-STRING + MOVE WS-AUDIT-LINE TO FILE-AUDIT-REC + WRITE FILE-AUDIT-REC + + EVALUATE TRUE + WHEN WS-BOUNDARY-EMPTY + MOVE "BOUNDARY-EMPTY" TO WS-AUDIT-TYPE + WHEN WS-BOUNDARY-SINGLE + MOVE "BOUNDARY-SINGLE" TO WS-AUDIT-TYPE + WHEN WS-BOUNDARY-EXACT + MOVE "BOUNDARY-EXACT" TO WS-AUDIT-TYPE + WHEN WS-BOUNDARY-TRAILING + MOVE "BOUNDARY-TRAILING" TO WS-AUDIT-TYPE + WHEN OTHER + MOVE "BOUNDARY-NORMAL" TO WS-AUDIT-TYPE + END-EVALUATE + STRING "Records=" WS-DISPLAY-COUNT + " Divisor=" WS-DIVISOR + INTO WS-AUDIT-DATA + END-STRING + MOVE WS-AUDIT-LINE TO FILE-AUDIT-REC + WRITE FILE-AUDIT-REC + + PERFORM VARYING WS-INV-SUM-COUNT FROM 1 BY 1 + UNTIL WS-INV-SUM-COUNT > WS-INVENTORY-ENTRIES + MOVE WS-INV-FILE-NUM(WS-INV-SUM-COUNT) + TO WS-FILE-NUM-ED + MOVE WS-INV-REC-COUNT(WS-INV-SUM-COUNT) + TO WS-DISP-INV-RECS + MOVE WS-INV-HASH-TOTAL(WS-INV-SUM-COUNT) + TO WS-DISP-INV-HASH + STRING "FILE=FILE-OUT-" WS-FILE-NUM-ED + ".DAT RECS=" WS-DISP-INV-RECS + " HASH=" WS-DISP-INV-HASH + INTO WS-AUDIT-DATA + END-STRING + MOVE "SPLIT-FILE" TO WS-AUDIT-TYPE + MOVE WS-AUDIT-LINE TO FILE-AUDIT-REC + WRITE FILE-AUDIT-REC + END-PERFORM + + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP + DISPLAY "[" WS-TIMESTAMP "] AUDIT: written" + . + * + 6000-ERROR-HANDLE-SECTION. + * + 6000-ERROR-PROC. + IF WS-SEVERITY = SPACES + MOVE 'ERROR' TO WS-SEVERITY + END-IF + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP + DISPLAY "[" WS-TIMESTAMP "] " WS-SEVERITY + + IF WS-SEVERITY-FATAL + DISPLAY "FATAL: Terminating at record " WS-REC-COUNT + MOVE "FATAL-ERROR" TO WS-AUDIT-TYPE + STRING "Fatal at record=" WS-REC-COUNT + INTO WS-AUDIT-DATA + END-STRING + MOVE WS-AUDIT-LINE TO FILE-AUDIT-REC + WRITE FILE-AUDIT-REC + PERFORM 9000-EXIT-SECTION + STOP RUN + END-IF + . + * + 9000-EXIT-SECTION. + * + 9000-EXIT-PROC. + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP + CLOSE FILE-IN + IF WS-FILE-IN-STATUS NOT = "00" + DISPLAY "WARNING: FILE-IN close status=" + WS-FILE-IN-STATUS + END-IF + CLOSE FILE-AUDIT + IF WS-FILE-AUDIT-STATUS NOT = "00" + AND WS-FILE-AUDIT-STATUS NOT = "42" + DISPLAY "WARNING: AUDIT close status=" + WS-FILE-AUDIT-STATUS + END-IF + DISPLAY "[" WS-TIMESTAMP "] Divide50 session ended" + EXIT PROGRAM. + . diff --git a/benchmark-programs/10-divide-50/main-divide-50.cbl b/benchmark-programs/10-divide-50/main-divide-50.cbl new file mode 100644 index 0000000..ac4eae2 --- /dev/null +++ b/benchmark-programs/10-divide-50/main-divide-50.cbl @@ -0,0 +1,104 @@ + *> ============================================================ + *> main-divide-50 : 请求书50分割 (Invoice 50-Split) + *> Input : FILE-IN (INPUT.DAT: 请求书记录) + *> Output: FILE-OUT (OUTPUT.DAT: 50件毎分割) + *> Coverage: S-N001~N003, S-N006, S-N007, S-R001, S-R002 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. DIVIDE-50. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN ASSIGN TO "INPUT.DAT" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FS. + + SELECT FILE-OUT ASSIGN TO "OUTPUT.DAT" + ORGANIZATION IS SEQUENTIAL. + + DATA DIVISION. + FILE SECTION. + FD FILE-IN RECORD CONTAINS 40 CHARACTERS. + 01 IN-REC. + 05 IN-KEY PIC X(10). + 05 IN-DATA PIC X(20). + 05 IN-AMT PIC 9(10). + + FD FILE-OUT RECORD CONTAINS 40 CHARACTERS. + 01 OUT-REC PIC X(40). + + WORKING-STORAGE SECTION. + 01 WS-FS PIC X(2). + 01 WS-EOF PIC X(1) VALUE 'N'. + 88 WS-EOF-Y VALUE 'Y' FALSE 'N'. + 01 WS-COUNT PIC 9(10). + 01 WS-FILE-NUM PIC 9(2). + 01 WS-FILE-NAME PIC X(20). + 01 WS-TOTAL-IN PIC 9(10). + 01 WS-TOTAL-OUT PIC 9(10). + 01 WS-SPLIT-LIMIT PIC 9(5) VALUE 50. + 01 WS-INVOICE-REC. + COPY "telecom/TEL-INVOICE.cpy". + + PROCEDURE DIVISION. + MAIN. + DISPLAY "DIVIDE-50: Starting 50-split processing" + DISPLAY "SPLIT LIMIT: " WS-SPLIT-LIMIT " records per file" + + OPEN INPUT FILE-IN. + IF WS-FS NOT = "00" + DISPLAY "OPEN FAIL: " WS-FS + STOP RUN RETURNING 1 + END-IF. + + MOVE 1 TO WS-FILE-NUM. + MOVE 0 TO WS-COUNT. + MOVE 0 TO WS-TOTAL-IN. + + PERFORM OPEN-NEXT-OUTPUT. + + PERFORM UNTIL WS-EOF-Y + READ FILE-IN INTO IN-REC + AT END + SET WS-EOF-Y TO TRUE + NOT AT END + ADD 1 TO WS-TOTAL-IN + ADD 1 TO WS-COUNT + MOVE IN-REC TO OUT-REC + WRITE OUT-REC + ADD 1 TO WS-TOTAL-OUT + IF WS-COUNT >= WS-SPLIT-LIMIT + CLOSE FILE-OUT + ADD 1 TO WS-FILE-NUM + MOVE 0 TO WS-COUNT + PERFORM OPEN-NEXT-OUTPUT + END-IF + END-READ + END-PERFORM. + + CLOSE FILE-IN FILE-OUT. + + DISPLAY "DIVIDE-50: Input=" WS-TOTAL-IN + " Output-total=" WS-TOTAL-OUT + " Files-created=" WS-FILE-NUM + + IF WS-TOTAL-IN = WS-TOTAL-OUT + DISPLAY "DIVIDE-50: PASS - record count match" + STOP RUN RETURNING 0 + ELSE + DISPLAY "DIVIDE-50: FAIL - count mismatch" + STOP RUN RETURNING 1 + END-IF + . + + OPEN-NEXT-OUTPUT. + STRING "SPLIT-" WS-FILE-NUM ".DAT" + DELIMITED BY SIZE INTO WS-FILE-NAME + END-STRING + CLOSE FILE-OUT + OPEN OUTPUT FILE-OUT + DISPLAY "DIVIDE-50: Opening " WS-FILE-NAME + . + + END PROGRAM DIVIDE-50. diff --git a/benchmark-programs/11-divide-25/FILE-IN.DAT b/benchmark-programs/11-divide-25/FILE-IN.DAT new file mode 100644 index 0000000..1eb12b8 --- /dev/null +++ b/benchmark-programs/11-divide-25/FILE-IN.DAT @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/benchmark-programs/11-divide-25/README.md b/benchmark-programs/11-divide-25/README.md new file mode 100644 index 0000000..7ce12e9 --- /dev/null +++ b/benchmark-programs/11-divide-25/README.md @@ -0,0 +1,34 @@ +# 11-divide-25 — 25-Division File Splitter + +## 电信业务场景 + +明细25分割。将请求书明细行按25件一个文件进行分割。 + +Demonstrates dividing input records into groups of 25: + +- **PERFORM VARYING counter**: Track record numbers across the loop +- **DIVIDE ... GIVING REMAINDER**: Calculate file number from record count +- **Close-write cycle**: Close old file, open new file at each boundary +- Tested at boundary conditions: 25 (exact), 26 (one extra), 24 (one short) + +## Files + +| File | Purpose | +|------|---------| +| `main-11-divide-25.cbl` | COBOL program (fixed format) | +| `data-gen.sh` | Generate N test records (default 26) | +| `run.sh` | Compile + run 3 test cases | + +## Algorithm + +``` +DIVIDE record-count BY 25 GIVING Q REMAINDER R +IF R = 1 → open new FILE-OUT-NN +Write record to current file +``` + +## Output Files + +- FILE-OUT-01.DAT: records 1-25 +- FILE-OUT-02.DAT: records 26-50 +- etc. diff --git a/benchmark-programs/11-divide-25/main-11-divide-25.cbl b/benchmark-programs/11-divide-25/main-11-divide-25.cbl new file mode 100644 index 0000000..b30ca80 --- /dev/null +++ b/benchmark-programs/11-divide-25/main-11-divide-25.cbl @@ -0,0 +1,642 @@ + *> Input: FILE-IN.DAT Output: FILE-OUT-NN.DAT, AUDIT-11.RPT + *> Original DIVIDE + expansions: I/O recovery, hash totals, + *> header/trailer recs, split stats, audit trail, boundary + *> checks, trailing recs, naming validation, file inventory, + *> error severity levels (WARNING/ERROR/FATAL) + IDENTIFICATION DIVISION. + PROGRAM-ID. Divide25. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN + ASSIGN TO "FILE-IN.DAT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-FILE-STATUS-IN. + + SELECT FILE-OUT + ASSIGN TO WS-OUT-FILE + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-FILE-STATUS-OUT. + + SELECT FILE-AUDIT + ASSIGN TO "AUDIT-11.RPT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-FILE-STATUS-AUD. + + DATA DIVISION. + FILE SECTION. + FD FILE-IN. + 01 FILE-IN-REC. + 05 IN-RECORD PIC X(30). + + FD FILE-OUT. + 01 FILE-OUT-REC. + 05 OUT-RECORD PIC X(30). + + FD FILE-AUDIT. + 01 FILE-AUDIT-REC PIC X(80). + + WORKING-STORAGE SECTION. + 01 WS-TELECOM-REC. + COPY "telecom/TEL-INVOICE.cpy". + + 01 WS-STATUS. + 05 WS-EOF-FLAG PIC X VALUE 'N'. + 88 WS-EOF VALUE 'Y' FALSE 'N'. + 05 WS-FILE-STATUS-IN PIC X(2). + 05 WS-FILE-STATUS-OUT PIC X(2). + 05 WS-FILE-STATUS-AUD PIC X(2). + + 01 WS-COUNTERS. + 05 WS-REC-COUNT PIC 9(5) VALUE 0. + 05 WS-FILE-NUM PIC 9(2) VALUE 0. + 05 WS-DIVISOR PIC 9(2) VALUE 25. + 05 WS-QUOTIENT PIC 9(5). + 05 WS-REMAINDER PIC 9(5). + 05 WS-REC-IN-FILE PIC 9(5) VALUE 0. + 05 WS-TOTAL-RECS-WRITTEN PIC 9(5) VALUE 0. + + 01 WS-OUT-FILE PIC X(30). + 01 WS-FILE-NUM-ED PIC 99. + 01 WS-DISPLAY-COUNT PIC Z(9)9. + + 01 WS-INVOICE-REC. + COPY "telecom/TEL-INVOICE.cpy". + + 01 WS-TIMESTAMP. + 05 WS-TS-DATE PIC 9(8). + 05 WS-TS-TIME PIC 9(8). + 05 WS-TS-EDITED PIC X(19). + + 01 WS-OPEN-RETRY-COUNT PIC 9(2) VALUE 0. + 01 WS-ALT-SUFFIX PIC X(4) VALUE ".ALT". + 01 WS-OPEN-OK PIC X VALUE 'N'. + 88 WS-OPEN-SUCCESS VALUE 'Y' FALSE 'N'. + 88 WS-OPEN-FAILED VALUE 'N'. + + 01 WS-FILE-NAME-VALID PIC X VALUE 'Y'. + 88 WS-FILE-NAME-OK VALUE 'Y' FALSE 'N'. + + 01 WS-HASH-TOTAL-IN PIC 9(9) VALUE 0. + 01 WS-HASH-OUT-TABLE. + 05 WS-HASH-OUT PIC 9(9) OCCURS 99. + 01 WS-HASH-SUM-OUT PIC 9(9) VALUE 0. + 01 WS-HASH-VERIFIED PIC X VALUE 'N'. + 88 WS-HASH-VERIFIED-YES VALUE 'Y' FALSE 'N'. + + 01 WS-SPLIT-STATS. + 05 WS-SPLIT-MIN-RECS PIC 9(5) VALUE 99999. + 05 WS-SPLIT-MAX-RECS PIC 9(5) VALUE 0. + 05 WS-SPLIT-TOTAL-FILES PIC 9(5) VALUE 0. + 05 WS-SPLIT-TOTAL-RECS PIC 9(9) VALUE 0. + 05 WS-SPLIT-AVG-RECS PIC 9(5) VALUE 0. + + 01 WS-BOUNDARY-FLAG PIC X. + 88 WS-BOUNDARY-EMPTY VALUE 'E'. + 88 WS-BOUNDARY-SINGLE VALUE 'S'. + 88 WS-BOUNDARY-EXACT VALUE 'M'. + 88 WS-BOUNDARY-NORMAL VALUE 'N'. + + 01 WS-TRAILER-COUNT PIC 9(5) VALUE 0. + 01 WS-TRAILER-FLAG PIC X VALUE 'N'. + 88 WS-TRAILER-WRITTEN VALUE 'Y' FALSE 'N'. + 01 WS-TRAIL-RECS-LAST PIC 9(5) VALUE 0. + + 01 WS-SEVERITY PIC X(7). + 88 WS-SEVERITY-WARN VALUE 'WARNING'. + 88 WS-SEVERITY-ERR VALUE 'ERROR'. + 88 WS-SEVERITY-FATAL VALUE 'FATAL'. + 01 WS-ERROR-MSG PIC X(60). + + 01 WS-SPLIT-HEADER. + 05 FILLER PIC X(6) VALUE 'HEADER'. + 05 FILLER PIC X VALUE SPACE. + 05 WS-HDR-FILE PIC 9(2). + 05 FILLER PIC X VALUE SPACE. + 05 WS-HDR-DATE PIC 9(8). + 05 FILLER PIC X VALUE SPACE. + 05 WS-HDR-TIME PIC 9(8). + 05 FILLER PIC X VALUE SPACE. + 05 WS-HDR-EXPREC PIC 9(5). + + 01 WS-SPLIT-TRAILER. + 05 FILLER PIC X(7) VALUE 'TRAILER'. + 05 FILLER PIC X VALUE SPACE. + 05 WS-TRL-FILE PIC 9(2). + 05 FILLER PIC X VALUE SPACE. + 05 WS-TRL-COUNT PIC 9(5). + 05 FILLER PIC X VALUE SPACE. + 05 WS-TRL-HASH PIC 9(9). + + 01 WS-HASH-WORK. + 05 WS-H-CHAR-IDX PIC 99. + 05 WS-H-CHAR PIC X. + 05 WS-H-SUM PIC 9(9). + 05 WS-H-ORD PIC 9(3). + + 01 WS-INVENTORY-REC. + 05 WS-INV-FILE PIC 9(2). + 05 FILLER PIC X(3) VALUE SPACES. + 05 WS-INV-RECS PIC 9(5). + 05 FILLER PIC X(3) VALUE SPACES. + 05 WS-INV-HASH PIC 9(9). + + 01 WS-REPORT-LINE PIC X(80). + 01 WS-I PIC 99. + 01 WS-NEXT-REM PIC 9(5). + 01 WS-HASH-DISP PIC Z(9)9. + + PROCEDURE DIVISION. + MAIN SECTION. + MAIN-PROCEDURE. + PERFORM 1000-INIT-SECTION + PERFORM 2000-OPEN-FILES-SECTION + + *> === Original code: banner === + DISPLAY "=== 25-DIVISION PROCESSING ===" + DISPLAY "Records per file: " WS-DIVISOR + + *> === Original code: processing loop === + PERFORM 3000-PROCESS-SECTION + + PERFORM 3500-TRAILING-HANDLE-SECTION + PERFORM 4000-REPORT-SECTION + PERFORM 5000-AUDIT-SECTION + PERFORM 9000-EXIT-SECTION + STOP RUN. + + *> ============================================================ + *> 1000-INIT-SECTION + *> ============================================================ + 1000-INIT-SECTION. + 1000-INIT-PROC. + ACCEPT WS-TS-DATE FROM DATE YYYYMMDD + ACCEPT WS-TS-TIME FROM TIME + STRING WS-TS-DATE(1:4) '-' WS-TS-DATE(5:2) '-' + WS-TS-DATE(7:2) ' ' + WS-TS-TIME(1:2) ':' WS-TS-TIME(3:2) ':' + WS-TS-TIME(5:2) + INTO WS-TS-EDITED + END-STRING + DISPLAY "=== Divide25 v2 Started " WS-TS-EDITED " ===" + MOVE 'N' TO WS-BOUNDARY-FLAG + MOVE 0 TO WS-SPLIT-TOTAL-FILES WS-SPLIT-TOTAL-RECS + MOVE 99999 TO WS-SPLIT-MIN-RECS + MOVE 0 TO WS-SPLIT-MAX-RECS WS-TRAILER-COUNT + MOVE 'N' TO WS-TRAILER-FLAG WS-HASH-VERIFIED + MOVE 0 TO WS-TRAIL-RECS-LAST WS-HASH-TOTAL-IN + MOVE 'Y' TO WS-FILE-NAME-VALID + DISPLAY "1000-INIT: All counters zeroed" + . + + *> ============================================================ + *> 2000-OPEN-FILES-SECTION — Retry + alt fallback for input + *> ============================================================ + 2000-OPEN-FILES-SECTION. + 2000-OPEN-FILES-PROC. + MOVE 0 TO WS-OPEN-RETRY-COUNT + MOVE 'N' TO WS-OPEN-OK + PERFORM UNTIL WS-OPEN-SUCCESS + OR WS-OPEN-RETRY-COUNT > 3 + OPEN INPUT FILE-IN + IF WS-FILE-STATUS-IN = '00' + MOVE 'Y' TO WS-OPEN-OK + DISPLAY "2000-OPEN: FILE-IN.DAT OK" + ELSE + ADD 1 TO WS-OPEN-RETRY-COUNT + MOVE 'WARNING' TO WS-SEVERITY + STRING "2000: FILE-IN retry " + WS-OPEN-RETRY-COUNT + " sts=" WS-FILE-STATUS-IN + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + END-PERFORM + IF WS-OPEN-FAILED + STRING "FILE-IN" WS-ALT-SUFFIX + INTO WS-OUT-FILE + END-STRING + OPEN INPUT FILE-IN + IF WS-FILE-STATUS-IN = '00' + MOVE 'Y' TO WS-OPEN-OK + DISPLAY "2000-OPEN: ALT file opened" + ELSE + MOVE 'FATAL' TO WS-SEVERITY + STRING "2000: FILE-IN open failed all retry" + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE-SECTION + PERFORM 9000-EXIT-SECTION + END-IF + END-IF + OPEN OUTPUT FILE-AUDIT + IF WS-FILE-STATUS-AUD NOT = '00' + MOVE 'FATAL' TO WS-SEVERITY + STRING "2000: AUDIT open fail sts=" + WS-FILE-STATUS-AUD + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE-SECTION + PERFORM 9000-EXIT-SECTION + ELSE + DISPLAY "2000-OPEN: AUDIT-11.RPT OK" + STRING "*** Divide25 v2 START *** " WS-TS-EDITED + INTO WS-REPORT-LINE + WRITE FILE-AUDIT-REC FROM WS-REPORT-LINE + END-IF + . + + *> ============================================================ + *> 3000-PROCESS-SECTION — Read/validate/apply/write loop + *> ============================================================ + 3000-PROCESS-SECTION. + 3000-PROCESS-PROC. + PERFORM VARYING WS-REC-COUNT FROM 1 BY 1 + UNTIL WS-EOF + PERFORM 3100-READ-INPUT-SECTION + IF NOT WS-EOF + PERFORM 3200-VALIDATE-SECTION + PERFORM 3300-APPLY-RULES-SECTION + PERFORM 3400-WRITE-OUTPUT-SECTION + END-IF + END-PERFORM + . + + *> ============================================================ + *> 3100-READ-INPUT-SECTION — Read + FILE STATUS check + *> ============================================================ + 3100-READ-INPUT-SECTION. + 3100-READ-INPUT-PROC. + READ FILE-IN INTO FILE-IN-REC + AT END + SET WS-EOF TO TRUE + DISPLAY "3100-READ: EOF at " WS-REC-COUNT + NOT AT END + IF WS-FILE-STATUS-IN NOT = '00' + MOVE 'ERROR' TO WS-SEVERITY + STRING "3100: FILE-IN read err sts=" + WS-FILE-STATUS-IN + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + END-READ + . + + *> ============================================================ + *> 3200-VALIDATE-SECTION — Hash sum + boundary detect + *> ============================================================ + 3200-VALIDATE-SECTION. + 3200-VALIDATE-PROC. + MOVE 0 TO WS-H-SUM + PERFORM VARYING WS-H-CHAR-IDX FROM 1 BY 1 + UNTIL WS-H-CHAR-IDX > 30 + MOVE IN-RECORD(WS-H-CHAR-IDX:1) TO WS-H-CHAR + IF WS-H-CHAR NOT = SPACE + COMPUTE WS-H-ORD = FUNCTION ORD(WS-H-CHAR) + ADD WS-H-ORD TO WS-H-SUM + END-IF + END-PERFORM + ADD WS-H-SUM TO WS-HASH-TOTAL-IN + IF WS-REC-COUNT = 1 + MOVE 'S' TO WS-BOUNDARY-FLAG + END-IF + . + + *> ============================================================ + *> 3300-APPLY-RULES-SECTION + *> *** ORIGINAL DIVIDE LOGIC — PRESERVED VERBATIM *** + *> ============================================================ + 3300-APPLY-RULES-SECTION. + 3300-APPLY-RULES-PROC. + DIVIDE WS-REC-COUNT BY WS-DIVISOR + GIVING WS-QUOTIENT REMAINDER WS-REMAINDER + IF WS-REMAINDER = 1 + IF WS-FILE-NUM > 0 + CLOSE FILE-OUT + DISPLAY " Closed: " WS-OUT-FILE + END-IF + ADD 1 TO WS-FILE-NUM + MOVE WS-FILE-NUM TO WS-FILE-NUM-ED + STRING "FILE-OUT-" DELIMITED BY SIZE + WS-FILE-NUM-ED DELIMITED BY SIZE + ".DAT" DELIMITED BY SIZE + INTO WS-OUT-FILE + OPEN OUTPUT FILE-OUT + DISPLAY " Opened: " WS-OUT-FILE + END-IF + . + + *> ============================================================ + *> 3400-WRITE-OUTPUT-SECTION — Header/data/trailer + hash + *> ============================================================ + 3400-WRITE-OUTPUT-SECTION. + 3400-WRITE-OUTPUT-PROC. + IF WS-REMAINDER = 1 + MOVE WS-FILE-NUM TO WS-HDR-FILE + MOVE WS-TS-DATE TO WS-HDR-DATE + MOVE WS-TS-TIME TO WS-HDR-TIME + MOVE WS-DIVISOR TO WS-HDR-EXPREC + MOVE WS-SPLIT-HEADER TO FILE-OUT-REC + WRITE FILE-OUT-REC + IF WS-FILE-STATUS-OUT NOT = '00' + MOVE 'ERROR' TO WS-SEVERITY + STRING "3400: HDR write fail file=" + WS-FILE-NUM " sts=" WS-FILE-STATUS-OUT + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + MOVE 0 TO WS-REC-IN-FILE + MOVE 0 TO WS-HASH-OUT(WS-FILE-NUM) + MOVE 'N' TO WS-TRAILER-FLAG + END-IF + + *> Write data record (original MOVE/WRITE preserved) + MOVE IN-RECORD TO OUT-RECORD + WRITE FILE-OUT-REC + IF WS-FILE-STATUS-OUT NOT = '00' + MOVE 'ERROR' TO WS-SEVERITY + STRING "3400: Write fail file=" WS-FILE-NUM + " rec=" WS-REC-COUNT + " sts=" WS-FILE-STATUS-OUT + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE-SECTION + ELSE + ADD 1 TO WS-REC-IN-FILE + ADD 1 TO WS-TOTAL-RECS-WRITTEN + ADD WS-H-SUM TO WS-HASH-OUT(WS-FILE-NUM) + END-IF + + *> Write trailer when next record starts new file + COMPUTE WS-NEXT-REM = + FUNCTION MOD(WS-REC-COUNT + 1, WS-DIVISOR) + IF WS-NEXT-REM = 1 + MOVE WS-FILE-NUM TO WS-TRL-FILE + MOVE WS-REC-IN-FILE TO WS-TRL-COUNT + MOVE WS-HASH-OUT(WS-FILE-NUM) TO WS-TRL-HASH + MOVE WS-SPLIT-TRAILER TO FILE-OUT-REC + WRITE FILE-OUT-REC + IF WS-FILE-STATUS-OUT NOT = '00' + MOVE 'ERROR' TO WS-SEVERITY + STRING "3400: TRL write fail file=" + WS-FILE-NUM " sts=" WS-FILE-STATUS-OUT + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + ADD 1 TO WS-TRAILER-COUNT + MOVE 'Y' TO WS-TRAILER-FLAG + ADD 1 TO WS-SPLIT-TOTAL-FILES + ADD WS-REC-IN-FILE TO WS-SPLIT-TOTAL-RECS + IF WS-REC-IN-FILE < WS-SPLIT-MIN-RECS + MOVE WS-REC-IN-FILE TO WS-SPLIT-MIN-RECS + END-IF + IF WS-REC-IN-FILE > WS-SPLIT-MAX-RECS + MOVE WS-REC-IN-FILE TO WS-SPLIT-MAX-RECS + END-IF + END-IF + . + + *> ============================================================ + *> 3500-TRAILING-HANDLE-SECTION — Last file trailer, + *> boundary classification + *> ============================================================ + 3500-TRAILING-HANDLE-SECTION. + 3500-TRAILING-HANDLE-PROC. + IF WS-FILE-NUM > 0 + IF WS-TRAILER-FLAG = 'N' + MOVE WS-FILE-NUM TO WS-TRL-FILE + MOVE WS-REC-IN-FILE TO WS-TRL-COUNT + MOVE WS-HASH-OUT(WS-FILE-NUM) TO WS-TRL-HASH + MOVE WS-SPLIT-TRAILER TO FILE-OUT-REC + WRITE FILE-OUT-REC + IF WS-FILE-STATUS-OUT NOT = '00' + MOVE 'ERROR' TO WS-SEVERITY + STRING "3500: TRL write fail last file" + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + ADD 1 TO WS-TRAILER-COUNT + MOVE 'Y' TO WS-TRAILER-FLAG + MOVE WS-REC-IN-FILE TO WS-TRAIL-RECS-LAST + ADD 1 TO WS-SPLIT-TOTAL-FILES + ADD WS-REC-IN-FILE TO WS-SPLIT-TOTAL-RECS + IF WS-REC-IN-FILE < WS-SPLIT-MIN-RECS + MOVE WS-REC-IN-FILE TO WS-SPLIT-MIN-RECS + END-IF + IF WS-REC-IN-FILE > WS-SPLIT-MAX-RECS + MOVE WS-REC-IN-FILE TO WS-SPLIT-MAX-RECS + END-IF + DISPLAY "3500-TRAIL: Last trailer written" + END-IF + ELSE + MOVE 'E' TO WS-BOUNDARY-FLAG + DISPLAY "3500-TRAIL: Empty input file" + END-IF + IF WS-TOTAL-RECS-WRITTEN = 0 + MOVE 'E' TO WS-BOUNDARY-FLAG + END-IF + IF WS-TOTAL-RECS-WRITTEN = 1 + MOVE 'S' TO WS-BOUNDARY-FLAG + DISPLAY "3500-TRAIL: Single-record file" + END-IF + IF WS-SPLIT-TOTAL-FILES > 1 + IF WS-SPLIT-MIN-RECS = WS-SPLIT-MAX-RECS + MOVE 'M' TO WS-BOUNDARY-FLAG + DISPLAY "3500-TRAIL: Exact multiple split" + END-IF + END-IF + . + + *> ============================================================ + *> 4000-REPORT-SECTION — Display + audit file stats/inventory + *> ============================================================ + 4000-REPORT-SECTION. + 4000-REPORT-PROC. + DISPLAY " " + DISPLAY "=== SPLIT STATISTICS REPORT ===" + MOVE WS-REC-COUNT TO WS-DISPLAY-COUNT + DISPLAY "Total records read: " WS-DISPLAY-COUNT + DISPLAY "Total records written: " WS-TOTAL-RECS-WRITTEN + DISPLAY "Output files created: " WS-FILE-NUM + DISPLAY "Divisor: " WS-DIVISOR + IF WS-SPLIT-TOTAL-FILES > 0 + COMPUTE WS-SPLIT-AVG-RECS = + WS-SPLIT-TOTAL-RECS / WS-SPLIT-TOTAL-FILES + ELSE + MOVE 0 TO WS-SPLIT-AVG-RECS + END-IF + DISPLAY "Split files counted: " WS-SPLIT-TOTAL-FILES + DISPLAY "Min recs per file: " WS-SPLIT-MIN-RECS + DISPLAY "Max recs per file: " WS-SPLIT-MAX-RECS + DISPLAY "Avg recs per file: " WS-SPLIT-AVG-RECS + DISPLAY "Trailer recs written: " WS-TRAILER-COUNT + DISPLAY "Trailing recs last file: " WS-TRAIL-RECS-LAST + DISPLAY "Boundary condition: " WS-BOUNDARY-FLAG + + STRING "*** SPLIT STATS *** Total=" WS-SPLIT-TOTAL-RECS + " Files=" WS-SPLIT-TOTAL-FILES + " Min=" WS-SPLIT-MIN-RECS + " Max=" WS-SPLIT-MAX-RECS + INTO WS-REPORT-LINE + WRITE FILE-AUDIT-REC FROM WS-REPORT-LINE + IF WS-FILE-STATUS-AUD NOT = '00' + MOVE 'WARNING' TO WS-SEVERITY + STRING "4000: Audit write sts=" WS-FILE-STATUS-AUD + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + + STRING "*** OUTPUT FILE INVENTORY ***" + INTO WS-REPORT-LINE + WRITE FILE-AUDIT-REC FROM WS-REPORT-LINE + + PERFORM VARYING WS-I FROM 1 BY 1 + UNTIL WS-I > WS-FILE-NUM + MOVE WS-I TO WS-INV-FILE + IF WS-I < WS-FILE-NUM + MOVE WS-DIVISOR TO WS-INV-RECS + ELSE + MOVE WS-REC-IN-FILE TO WS-INV-RECS + END-IF + MOVE WS-HASH-OUT(WS-I) TO WS-INV-HASH + STRING "FILE " WS-INV-FILE " RECS=" WS-INV-RECS + " HASH=" WS-INV-HASH + INTO WS-REPORT-LINE + WRITE FILE-AUDIT-REC FROM WS-REPORT-LINE + END-PERFORM + . + + *> ============================================================ + *> 5000-AUDIT-SECTION — Hash total verification + *> ============================================================ + 5000-AUDIT-SECTION. + 5000-AUDIT-PROC. + DISPLAY "=== HASH TOTAL VERIFICATION ===" + MOVE 0 TO WS-HASH-SUM-OUT + PERFORM VARYING WS-I FROM 1 BY 1 + UNTIL WS-I > WS-FILE-NUM + ADD WS-HASH-OUT(WS-I) TO WS-HASH-SUM-OUT + END-PERFORM + MOVE WS-HASH-TOTAL-IN TO WS-HASH-DISP + DISPLAY "Input hash: " WS-HASH-DISP + MOVE WS-HASH-SUM-OUT TO WS-HASH-DISP + DISPLAY "Output hash: " WS-HASH-DISP + DISPLAY "Files hashed: " WS-FILE-NUM + IF WS-HASH-TOTAL-IN = WS-HASH-SUM-OUT + MOVE 'Y' TO WS-HASH-VERIFIED + DISPLAY "Hash verification: PASSED" + STRING "*** HASH VERIFICATION PASSED ***" + INTO WS-REPORT-LINE + ELSE + MOVE 'N' TO WS-HASH-VERIFIED + DISPLAY "Hash verification: FAILED" + MOVE 'ERROR' TO WS-SEVERITY + STRING "5000: Hash mismatch IN=" WS-HASH-TOTAL-IN + " OUT=" WS-HASH-SUM-OUT + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE-SECTION + STRING "*** HASH VERIFICATION FAILED ***" + INTO WS-REPORT-LINE + END-IF + WRITE FILE-AUDIT-REC FROM WS-REPORT-LINE + . + + *> ============================================================ + *> 6000-ERROR-HANDLE-SECTION — Log with severity level + *> ============================================================ + 6000-ERROR-HANDLE-SECTION. + 6000-ERROR-HANDLE-PROC. + DISPLAY "*** " WS-SEVERITY " *** " WS-ERROR-MSG + STRING "*** " WS-SEVERITY " *** " WS-ERROR-MSG + INTO WS-REPORT-LINE + WRITE FILE-AUDIT-REC FROM WS-REPORT-LINE + IF WS-FILE-STATUS-AUD NOT = '00' + DISPLAY "6000: Audit write also failed" + END-IF + IF WS-SEVERITY-FATAL + DISPLAY "6000: FATAL — terminating" + PERFORM 9000-EXIT-SECTION + END-IF + . + + *> ============================================================ + *> 9000-EXIT-SECTION — Close files, original summary + *> *** ORIGINAL CLOSE / DISPLAY LOGIC PRESERVED *** + *> ============================================================ + 9000-EXIT-SECTION. + 9000-EXIT-PROC. + ACCEPT WS-TS-TIME FROM TIME + STRING WS-TS-TIME(1:2) ':' WS-TS-TIME(3:2) ':' + WS-TS-TIME(5:2) INTO WS-TS-EDITED + END-STRING + + IF WS-FILE-NUM > 0 + CLOSE FILE-OUT + IF WS-FILE-STATUS-OUT NOT = '00' + MOVE 'WARNING' TO WS-SEVERITY + STRING "9000: FILE-OUT close sts=" + WS-FILE-STATUS-OUT + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + DISPLAY "Closed final file: " WS-OUT-FILE + END-IF + + MOVE WS-REC-COUNT TO WS-DISPLAY-COUNT + DISPLAY " " + DISPLAY "Total records read: " WS-DISPLAY-COUNT + DISPLAY "Output files created: " WS-FILE-NUM + + CLOSE FILE-IN + IF WS-FILE-STATUS-IN NOT = '00' + MOVE 'WARNING' TO WS-SEVERITY + STRING "9000: FILE-IN close sts=" + WS-FILE-STATUS-IN + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + + STRING "*** Divide25 v2 END *** " WS-TS-EDITED + INTO WS-REPORT-LINE + WRITE FILE-AUDIT-REC FROM WS-REPORT-LINE + CLOSE FILE-AUDIT + + DISPLAY " " + DISPLAY "--- Boundary condition ---" + EVALUATE TRUE + WHEN WS-BOUNDARY-EMPTY + DISPLAY " EMPTY FILE (0 records)" + WHEN WS-BOUNDARY-SINGLE + DISPLAY " SINGLE-RECORD FILE" + WHEN WS-BOUNDARY-EXACT + DISPLAY " EXACT MULTIPLE of " WS-DIVISOR + WHEN WS-BOUNDARY-NORMAL + DISPLAY " NORMAL (trailing partial batch)" + WHEN OTHER + DISPLAY " NOT DETERMINED" + END-EVALUATE + + DISPLAY "--- Data Integrity ---" + MOVE WS-HASH-TOTAL-IN TO WS-HASH-DISP + DISPLAY " Input hash: " WS-HASH-DISP + MOVE WS-HASH-SUM-OUT TO WS-HASH-DISP + DISPLAY " Output hash: " WS-HASH-DISP + IF WS-HASH-VERIFIED-YES + DISPLAY " Integrity: PASSED" + ELSE + DISPLAY " Integrity: FAILED" + END-IF + DISPLAY " " + DISPLAY "=== Divide25 v2 Ended at " + WS-TS-EDITED " ===" + STOP RUN. diff --git a/benchmark-programs/11-divide-25/main-divide-25.cbl b/benchmark-programs/11-divide-25/main-divide-25.cbl new file mode 100644 index 0000000..42ab743 --- /dev/null +++ b/benchmark-programs/11-divide-25/main-divide-25.cbl @@ -0,0 +1,91 @@ + *> ============================================================ + *> main-divide-25 : 明细25分割 (Detail 25-Split) + *> Input : FILE-IN (INPUT.DAT: 明细记录) + *> Output: FILE-OUT (SPLIT-OUT: 25件毎分割) + *> Coverage: S-N004, S-N006, S-N007, S-R001, S-R002 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. DIVIDE-25. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN ASSIGN TO "INPUT.DAT" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FS. + + SELECT FILE-OUT ASSIGN TO "SPLIT-OUT" + ORGANIZATION IS SEQUENTIAL. + + DATA DIVISION. + FILE SECTION. + FD FILE-IN RECORD CONTAINS 40 CHARACTERS. + 01 IN-REC. + 05 IN-KEY PIC X(10). + 05 IN-DATA PIC X(20). + 05 IN-AMT PIC 9(10). + + FD FILE-OUT RECORD CONTAINS 40 CHARACTERS. + 01 OUT-REC PIC X(40). + + WORKING-STORAGE SECTION. + 01 WS-FS PIC X(2). + 01 WS-EOF PIC X(1) VALUE 'N'. + 88 WS-EOF-Y VALUE 'Y' FALSE 'N'. + 01 WS-COUNT PIC 9(10). + 01 WS-FILE-NUM PIC 9(2). + 01 WS-FILE-NAME PIC X(20). + 01 WS-TOTAL-IN PIC 9(10). + 01 WS-TOTAL-OUT PIC 9(10). + 01 WS-SPLIT-LIMIT PIC 9(5) VALUE 25. + 01 WS-INVOICE-REC. + COPY "telecom/TEL-INVOICE.cpy". + + PROCEDURE DIVISION. + MAIN. + DISPLAY "DIVIDE-25: Starting 25-split" + OPEN INPUT FILE-IN. + MOVE 1 TO WS-FILE-NUM. + MOVE 0 TO WS-COUNT. + MOVE 0 TO WS-TOTAL-IN. + PERFORM OPEN-NEXT-FILE. + + PERFORM UNTIL WS-EOF-Y + READ FILE-IN INTO IN-REC + AT END SET WS-EOF-Y TO TRUE + NOT AT END + ADD 1 TO WS-TOTAL-IN WS-COUNT + MOVE IN-REC TO OUT-REC + WRITE OUT-REC + ADD 1 TO WS-TOTAL-OUT + IF WS-COUNT >= WS-SPLIT-LIMIT + CLOSE FILE-OUT + ADD 1 TO WS-FILE-NUM + MOVE 0 TO WS-COUNT + PERFORM OPEN-NEXT-FILE + END-IF + END-READ + END-PERFORM. + + CLOSE FILE-IN FILE-OUT. + DISPLAY "DIVIDE-25: IN=" WS-TOTAL-IN + " OUT=" WS-TOTAL-OUT " FILES=" WS-FILE-NUM + IF WS-TOTAL-IN = WS-TOTAL-OUT + DISPLAY "DIVIDE-25: PASS" + STOP RUN RETURNING 0 + ELSE + DISPLAY "DIVIDE-25: FAIL" + STOP RUN RETURNING 1 + END-IF + . + + OPEN-NEXT-FILE. + STRING "SPLIT25-" WS-FILE-NUM ".DAT" + DELIMITED BY SIZE INTO WS-FILE-NAME + END-STRING + CLOSE FILE-OUT + OPEN OUTPUT FILE-OUT + DISPLAY "OPEN: " WS-FILE-NAME + . + + END PROGRAM DIVIDE-25. diff --git a/benchmark-programs/12-divide-100/AUDIT-RPT.TXT b/benchmark-programs/12-divide-100/AUDIT-RPT.TXT new file mode 100644 index 0000000..9b69328 --- /dev/null +++ b/benchmark-programs/12-divide-100/AUDIT-RPT.TXT @@ -0,0 +1,13 @@ +*** AUDIT REPORT — Divide100 *** +=== 100-DIVISION PROCESSING === +Records per file: 100 +=== Audit Summary === +Total input records: 00101 +Total output records: 00107 +Output files created: 02 +Hash total (input): 0000001010 +Hash total (output): 0000001004 +Hash verification: FAIL +Error count: 002 Warning count: 000 +Batch completed at: 2026062216453475+0800 +ERROR: Continuing — error count=002 diff --git a/benchmark-programs/12-divide-100/FILE-IN b/benchmark-programs/12-divide-100/FILE-IN new file mode 100644 index 0000000..06b2f1a --- /dev/null +++ b/benchmark-programs/12-divide-100/FILE-IN @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/benchmark-programs/12-divide-100/FILE-IN.DAT b/benchmark-programs/12-divide-100/FILE-IN.DAT new file mode 100644 index 0000000..f2c9432 --- /dev/null +++ b/benchmark-programs/12-divide-100/FILE-IN.DAT @@ -0,0 +1,101 @@ +CDR-000001 86138001380 0000097 +CDR-000002 86138001381 0000134 +CDR-000003 86138001382 0000171 +CDR-000004 86138001383 0000208 +CDR-000005 86138001384 0000245 +CDR-000006 86138001385 0000282 +CDR-000007 86138001380 0000319 +CDR-000008 86138001381 0000356 +CDR-000009 86138001382 0000393 +CDR-000010 86138001383 0000430 +CDR-000011 86138001384 0000467 +CDR-000012 86138001385 0000504 +CDR-000013 86138001380 0000541 +CDR-000014 86138001381 0000578 +CDR-000015 86138001382 0000615 +CDR-000016 86138001383 0000652 +CDR-000017 86138001384 0000689 +CDR-000018 86138001385 0000726 +CDR-000019 86138001380 0000763 +CDR-000020 86138001381 0000800 +CDR-000021 86138001382 0000837 +CDR-000022 86138001383 0000874 +CDR-000023 86138001384 0000911 +CDR-000024 86138001385 0000948 +CDR-000025 86138001380 0000985 +CDR-000026 86138001381 0001022 +CDR-000027 86138001382 0001059 +CDR-000028 86138001383 0001096 +CDR-000029 86138001384 0001133 +CDR-000030 86138001385 0001170 +CDR-000031 86138001380 0001207 +CDR-000032 86138001381 0001244 +CDR-000033 86138001382 0001281 +CDR-000034 86138001383 0001318 +CDR-000035 86138001384 0001355 +CDR-000036 86138001385 0001392 +CDR-000037 86138001380 0001429 +CDR-000038 86138001381 0001466 +CDR-000039 86138001382 0001503 +CDR-000040 86138001383 0001540 +CDR-000041 86138001384 0001577 +CDR-000042 86138001385 0001614 +CDR-000043 86138001380 0001651 +CDR-000044 86138001381 0001688 +CDR-000045 86138001382 0001725 +CDR-000046 86138001383 0001762 +CDR-000047 86138001384 0001799 +CDR-000048 86138001385 0001836 +CDR-000049 86138001380 0001873 +CDR-000050 86138001381 0001910 +CDR-000051 86138001382 0001947 +CDR-000052 86138001383 0001984 +CDR-000053 86138001384 0002021 +CDR-000054 86138001385 0002058 +CDR-000055 86138001380 0002095 +CDR-000056 86138001381 0002132 +CDR-000057 86138001382 0002169 +CDR-000058 86138001383 0002206 +CDR-000059 86138001384 0002243 +CDR-000060 86138001385 0002280 +CDR-000061 86138001380 0002317 +CDR-000062 86138001381 0002354 +CDR-000063 86138001382 0002391 +CDR-000064 86138001383 0002428 +CDR-000065 86138001384 0002465 +CDR-000066 86138001385 0002502 +CDR-000067 86138001380 0002539 +CDR-000068 86138001381 0002576 +CDR-000069 86138001382 0002613 +CDR-000070 86138001383 0002650 +CDR-000071 86138001384 0002687 +CDR-000072 86138001385 0002724 +CDR-000073 86138001380 0002761 +CDR-000074 86138001381 0002798 +CDR-000075 86138001382 0002835 +CDR-000076 86138001383 0002872 +CDR-000077 86138001384 0002909 +CDR-000078 86138001385 0002946 +CDR-000079 86138001380 0002983 +CDR-000080 86138001381 0003020 +CDR-000081 86138001382 0003057 +CDR-000082 86138001383 0003094 +CDR-000083 86138001384 0003131 +CDR-000084 86138001385 0003168 +CDR-000085 86138001380 0003205 +CDR-000086 86138001381 0003242 +CDR-000087 86138001382 0003279 +CDR-000088 86138001383 0003316 +CDR-000089 86138001384 0003353 +CDR-000090 86138001385 0003390 +CDR-000091 86138001380 0003427 +CDR-000092 86138001381 0003464 +CDR-000093 86138001382 0003501 +CDR-000094 86138001383 0003538 +CDR-000095 86138001384 0003575 +CDR-000096 86138001385 0000072 +CDR-000097 86138001380 0000109 +CDR-000098 86138001381 0000146 +CDR-000099 86138001382 0000183 +CDR-000100 86138001383 0000220 +CDR-000101 86138001384 0000257 diff --git a/benchmark-programs/12-divide-100/FILE-OUT-01.DAT b/benchmark-programs/12-divide-100/FILE-OUT-01.DAT new file mode 100644 index 0000000..15b43f8 --- /dev/null +++ b/benchmark-programs/12-divide-100/FILE-OUT-01.DAT @@ -0,0 +1,103 @@ +HEADER 01202606221645 +CDR-HDR 0100100 +CDR-000001 86138001380 0000097 +CDR-000002 86138001381 0000134 +CDR-000003 86138001382 0000171 +CDR-000004 86138001383 0000208 +CDR-000005 86138001384 0000245 +CDR-000006 86138001385 0000282 +CDR-000007 86138001380 0000319 +CDR-000008 86138001381 0000356 +CDR-000009 86138001382 0000393 +CDR-000010 86138001383 0000430 +CDR-000011 86138001384 0000467 +CDR-000012 86138001385 0000504 +CDR-000013 86138001380 0000541 +CDR-000014 86138001381 0000578 +CDR-000015 86138001382 0000615 +CDR-000016 86138001383 0000652 +CDR-000017 86138001384 0000689 +CDR-000018 86138001385 0000726 +CDR-000019 86138001380 0000763 +CDR-000020 86138001381 0000800 +CDR-000021 86138001382 0000837 +CDR-000022 86138001383 0000874 +CDR-000023 86138001384 0000911 +CDR-000024 86138001385 0000948 +CDR-000025 86138001380 0000985 +CDR-000026 86138001381 0001022 +CDR-000027 86138001382 0001059 +CDR-000028 86138001383 0001096 +CDR-000029 86138001384 0001133 +CDR-000030 86138001385 0001170 +CDR-000031 86138001380 0001207 +CDR-000032 86138001381 0001244 +CDR-000033 86138001382 0001281 +CDR-000034 86138001383 0001318 +CDR-000035 86138001384 0001355 +CDR-000036 86138001385 0001392 +CDR-000037 86138001380 0001429 +CDR-000038 86138001381 0001466 +CDR-000039 86138001382 0001503 +CDR-000040 86138001383 0001540 +CDR-000041 86138001384 0001577 +CDR-000042 86138001385 0001614 +CDR-000043 86138001380 0001651 +CDR-000044 86138001381 0001688 +CDR-000045 86138001382 0001725 +CDR-000046 86138001383 0001762 +CDR-000047 86138001384 0001799 +CDR-000048 86138001385 0001836 +CDR-000049 86138001380 0001873 +CDR-000050 86138001381 0001910 +CDR-000051 86138001382 0001947 +CDR-000052 86138001383 0001984 +CDR-000053 86138001384 0002021 +CDR-000054 86138001385 0002058 +CDR-000055 86138001380 0002095 +CDR-000056 86138001381 0002132 +CDR-000057 86138001382 0002169 +CDR-000058 86138001383 0002206 +CDR-000059 86138001384 0002243 +CDR-000060 86138001385 0002280 +CDR-000061 86138001380 0002317 +CDR-000062 86138001381 0002354 +CDR-000063 86138001382 0002391 +CDR-000064 86138001383 0002428 +CDR-000065 86138001384 0002465 +CDR-000066 86138001385 0002502 +CDR-000067 86138001380 0002539 +CDR-000068 86138001381 0002576 +CDR-000069 86138001382 0002613 +CDR-000070 86138001383 0002650 +CDR-000071 86138001384 0002687 +CDR-000072 86138001385 0002724 +CDR-000073 86138001380 0002761 +CDR-000074 86138001381 0002798 +CDR-000075 86138001382 0002835 +CDR-000076 86138001383 0002872 +CDR-000077 86138001384 0002909 +CDR-000078 86138001385 0002946 +CDR-000079 86138001380 0002983 +CDR-000080 86138001381 0003020 +CDR-000081 86138001382 0003057 +CDR-000082 86138001383 0003094 +CDR-000083 86138001384 0003131 +CDR-000084 86138001385 0003168 +CDR-000085 86138001380 0003205 +CDR-000086 86138001381 0003242 +CDR-000087 86138001382 0003279 +CDR-000088 86138001383 0003316 +CDR-000089 86138001384 0003353 +CDR-000090 86138001385 0003390 +CDR-000091 86138001380 0003427 +CDR-000092 86138001381 0003464 +CDR-000093 86138001382 0003501 +CDR-000094 86138001383 0003538 +CDR-000095 86138001384 0003575 +CDR-000096 86138001385 0000072 +CDR-000097 86138001380 0000109 +CDR-000098 86138001381 0000146 +CDR-000099 86138001382 0000183 +CDR-000100 86138001383 0000220 +TRAILER 0100100 diff --git a/benchmark-programs/12-divide-100/FILE-OUT-02.DAT b/benchmark-programs/12-divide-100/FILE-OUT-02.DAT new file mode 100644 index 0000000..8dede46 --- /dev/null +++ b/benchmark-programs/12-divide-100/FILE-OUT-02.DAT @@ -0,0 +1,4 @@ +HEADER 02202606221645 +CDR-HDR 0200100 +CDR-000101 86138001384 0000257 +TRAILER 0200001 diff --git a/benchmark-programs/12-divide-100/README.md b/benchmark-programs/12-divide-100/README.md new file mode 100644 index 0000000..02e9afe --- /dev/null +++ b/benchmark-programs/12-divide-100/README.md @@ -0,0 +1,34 @@ +# 12-divide-100 — 100-Division File Splitter + +## 电信业务场景 + +CDR数据100分割。将CDR数据按100件一个批处理单位进行分割，供后续系统处理。 + +Demonstrates dividing input records into groups of 100: + +- **PERFORM VARYING counter**: Track record numbers across the loop +- **DIVIDE ... GIVING REMAINDER**: Calculate file number from record count +- **Close-write cycle**: Close old file, open new file at each boundary +- Tested at boundary conditions: 100 (exact), 101 (one extra), 99 (one short) + +## Files + +| File | Purpose | +|------|---------| +| `main-12-divide-100.cbl` | COBOL program (fixed format) | +| `data-gen.sh` | Generate N test records (default 101) | +| `run.sh` | Compile + run 3 test cases | + +## Algorithm + +``` +DIVIDE record-count BY 100 GIVING Q REMAINDER R +IF R = 1 → open new FILE-OUT-NN +Write record to current file +``` + +## Output Files + +- FILE-OUT-01.DAT: records 1-100 +- FILE-OUT-02.DAT: records 101-200 +- etc. diff --git a/benchmark-programs/12-divide-100/SPLIT-STATS.TXT b/benchmark-programs/12-divide-100/SPLIT-STATS.TXT new file mode 100644 index 0000000..8fad6da --- /dev/null +++ b/benchmark-programs/12-divide-100/SPLIT-STATS.TXT @@ -0,0 +1,6 @@ +*** SPLIT STATISTICS REPORT *** +SPLIT STATS: files=02 total-records=00101 min=00004 max=00103 +=== Split File Inventory === +FILE-OUT-01.DAT: 0000000103 records +FILE-OUT-02.DAT: 0000000004 records +Boundary: EMPTY=N EXACT-MULT=N SINGLE=N TRAILING=Y TRAIL-COUNT=00001 diff --git a/benchmark-programs/12-divide-100/main-12-divide-100.cbl b/benchmark-programs/12-divide-100/main-12-divide-100.cbl new file mode 100644 index 0000000..067258c --- /dev/null +++ b/benchmark-programs/12-divide-100/main-12-divide-100.cbl @@ -0,0 +1,1088 @@ + *> ============================================================ + *> 12-divide-100 : CDR数据100分割 (CDR 100-Split) + *> Input : FILE-IN.DAT (CDR数据: 100件毎分割) + *> Output: FILE-OUT-NN (100件毎の分割出力文件: FILE-OUT-01, 02...) + *> Coverage: S-N005, S-N006, S-N007, S-R001, S-R002 + *> + *> Extended: Phase 2 — error recovery, hash totals, audit trail, + *> split statistics, boundary checks, CDR awareness, + *> header/trailer records, file naming validation. + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. Divide100. + + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN + ASSIGN TO WS-IN-FILE + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-FILE-STATUS-IN. + + SELECT FILE-OUT + ASSIGN TO WS-OUT-FILE + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-FILE-STATUS-OUT. + + SELECT AUDIT-REPORT + ASSIGN TO "AUDIT-RPT.TXT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-FILE-STATUS-AUDIT. + + SELECT SPLIT-STATS + ASSIGN TO "SPLIT-STATS.TXT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-FILE-STATUS-STATS. + + DATA DIVISION. + FILE SECTION. + FD FILE-IN. + 01 FILE-IN-REC. + 05 IN-RECORD PIC X(45). + + FD FILE-OUT. + 01 FILE-OUT-REC. + 05 OUT-RECORD PIC X(45). + + FD AUDIT-REPORT. + 01 AUDIT-REC PIC X(120). + + FD SPLIT-STATS. + 01 STATS-REC PIC X(120). + + WORKING-STORAGE SECTION. + 01 WS-TELECOM-REC. + COPY "telecom/TEL-INVOICE.cpy". + + *> CDR record mapping + 01 WS-CDR-REC. + COPY "telecom/TEL-CDR.cpy". + + *> File status indicators + 01 WS-FILE-STATUS-IN PIC X(02). + 01 WS-FILE-STATUS-OUT PIC X(02). + 01 WS-FILE-STATUS-AUDIT PIC X(02). + 01 WS-FILE-STATUS-STATS PIC X(02). + + *> EOF and control flags + 01 WS-STATUS. + 05 WS-EOF-FLAG PIC X VALUE 'N'. + 88 WS-EOF VALUE 'Y' FALSE 'N'. + 05 WS-READ-OK PIC X VALUE 'N'. + 88 WS-READ-SUCCESS VALUE 'Y' FALSE 'N'. + 05 WS-FIRST-RECORD PIC X VALUE 'Y'. + 88 WS-IS-FIRST-RECORD VALUE 'Y' FALSE 'N'. + + *> Error severity levels + 01 WS-SEVERITY PIC X(07). + 88 WS-SEVERITY-WARNING VALUE 'WARNING'. + 88 WS-SEVERITY-ERROR VALUE 'ERROR'. + 88 WS-SEVERITY-FATAL VALUE 'FATAL'. + + *> Open retry control + 01 WS-OPEN-RETRY. + 05 WS-OPEN-RETRY-COUNT PIC 9(02) VALUE 0. + 05 WS-OPEN-RETRY-MAX PIC 9(02) VALUE 3. + 05 WS-ALT-SUFFIX PIC X(04). + 88 WS-ALT-NONE VALUE 'NONE'. + 88 WS-ALT-BAK VALUE '.BAK'. + 88 WS-ALT-TMP VALUE '.TMP'. + + *> File naming validation + 01 WS-FILE-NAME-CHECK. + 05 WS-FILE-NAME-VALID PIC X VALUE 'N'. + 88 WS-NAME-IS-VALID VALUE 'Y' FALSE 'N'. + 05 WS-FILE-NAME-PATTERN PIC X(30). + 05 WS-FILE-NAME-PREFIX PIC X(08) VALUE 'FILE-OUT'. + 05 WS-FILE-NAME-SUFFIX PIC X(04) VALUE '.DAT'. + 05 WS-FILE-NAME-SEQ-BEG PIC 9(02). + 05 WS-FILE-NAME-SEQ-END PIC 9(02). + + *> Counters and accumulators + 01 WS-COUNTERS. + 05 WS-REC-COUNT PIC 9(05) VALUE 0. + 05 WS-FILE-NUM PIC 9(02) VALUE 0. + 05 WS-DIVISOR PIC 9(03) VALUE 100. + 05 WS-QUOTIENT PIC 9(05). + 05 WS-REMAINDER PIC 9(05). + 05 WS-WRITE-COUNT PIC 9(05) VALUE 0. + 05 WS-READ-COUNT PIC 9(05) VALUE 0. + + *> Input file path (dynamic for retry support) + 01 WS-IN-FILE PIC X(30). + + *> Output file path + 01 WS-OUT-FILE PIC X(30). + 01 WS-FILE-NUM-ED PIC 99. + + *> Display formatting + 01 WS-DISPLAY-COUNT PIC Z(05)9. + 01 WS-DISPLAY-HASH PIC Z(09)9. + 01 WS-DISPLAY-STR. + 05 WS-DISPLAY-STR-TEXT PIC X(50). + + *> Simulated timestamp for DISPLAY tracing + 01 WS-TIMESTAMP PIC X(21). + 01 WS-TIMESTAMP-OUT PIC X(26). + + *> Hash temp for byte counting + 01 WS-HASH-TEMP PIC 9(10). + + *> Hash totals for data integrity + 01 WS-HASH-TOTALS. + 05 WS-HASH-TOTAL-IN PIC 9(10) VALUE 0. + 05 WS-HASH-TOTAL-OUT PIC 9(10) VALUE 0. + 05 WS-HASH-TOTAL-VERIFY PIC 9(10) VALUE 0. + 05 WS-HASH-VERIFIED PIC X VALUE 'N'. + 88 WS-HASH-MATCH VALUE 'Y' FALSE 'N'. + 88 WS-HASH-MISMATCH VALUE 'N'. + 05 WS-HASH-SPLIT OCCURS 99 TIMES. + 10 WS-HASH-SPLIT-VAL PIC 9(10). + + *> Split statistics + 01 WS-SPLIT-STATS. + 05 WS-SPLIT-REC-COUNT PIC 9(05) VALUE 0. + 05 WS-SPLIT-FILE-TOTAL PIC 9(02) VALUE 0. + 05 WS-SPLIT-MIN-RECS PIC 9(05) VALUE 99999. + 05 WS-SPLIT-MAX-RECS PIC 9(05) VALUE 0. + 05 WS-SPLIT-EMPTY-FLAG PIC X VALUE 'N'. + 88 WS-SPLIT-EMPTY VALUE 'Y' FALSE 'N'. + 05 WS-SPLIT-SINGLE-FLAG PIC X VALUE 'N'. + 88 WS-SPLIT-SINGLE VALUE 'Y' FALSE 'N'. + + *> Boundary condition checks + 01 WS-BOUNDARY-FLAG. + 05 WS-BOUNDARY-EMPTY PIC X VALUE 'N'. + 88 WS-BOUNDARY-IS-EMPTY VALUE 'Y' FALSE 'N'. + 05 WS-BOUNDARY-EXACT-MULT PIC X VALUE 'N'. + 88 WS-BOUNDARY-IS-EXACT VALUE 'Y' FALSE 'N'. + 05 WS-BOUNDARY-SINGLE-REC PIC X VALUE 'N'. + 88 WS-BOUNDARY-IS-SINGLE VALUE 'Y' FALSE 'N'. + 05 WS-BOUNDARY-TRAILING PIC X VALUE 'N'. + 88 WS-BOUNDARY-HAS-TRAIL VALUE 'Y' FALSE 'N'. + 05 WS-BOUNDARY-MULTIPLIER PIC 9(05). + + *> Trailing record handling + 01 WS-TRAILER-REC-COUNT PIC 9(05) VALUE 0. + 01 WS-TRAILER-RECORD. + 05 WS-TRAILER-TYPE PIC X(08) VALUE 'TRAILER'. + 05 WS-TRAILER-FILE PIC 9(02). + 05 WS-TRL-REC-COUNT PIC 9(05). + 05 FILLER PIC X(30) VALUE SPACES. + + *> Header record for split files + 01 WS-HEADER-RECORD. + 05 WS-HDR-TYPE PIC X(08) VALUE 'HEADER'. + 05 WS-HDR-FILE PIC 9(02). + 05 WS-HDR-TIMESTAMP PIC X(12). + 05 WS-HDR-RESERVED PIC X(23). + 05 FILLER PIC X VALUE SPACE. + + *> CDR-aware split header + 01 WS-CDR-HEADER. + 05 WS-CDR-HDR-TYPE PIC X(08) VALUE 'CDR-HDR'. + 05 WS-CDR-HDR-FILE PIC 9(02). + 05 WS-CDR-HDR-EXPECTED PIC 9(05). + 05 WS-CDR-HDR-RESERVED PIC X(30). + + *> Audit report variables + 01 WS-AUDIT-LINE PIC X(120). + 01 WS-AUDIT-COUNT PIC 9(05) VALUE 0. + + *> Batch control totals + 01 WS-BATCH-CTRL. + 05 WS-BATCH-START-TIME PIC 9(08). + 05 WS-BATCH-END-TIME PIC 9(08). + 05 WS-BATCH-TOTAL-FILES PIC 9(02) VALUE 0. + 05 WS-BATCH-TOTAL-RECS PIC 9(05) VALUE 0. + 05 WS-BATCH-ERROR-COUNT PIC 9(03) VALUE 0. + 05 WS-BATCH-WARN-COUNT PIC 9(03) VALUE 0. + + *> File open retry state + 01 WS-RETRY-STATE. + 05 WS-RETRY-ATTEMPT PIC 9(02) VALUE 0. + 05 WS-RETRY-FILE-NAME PIC X(30). + 05 WS-RETRY-SUCCESS PIC X VALUE 'N'. + 88 WS-RETRY-OK VALUE 'Y' FALSE 'N'. + + * ============================================================ + * PROCEDURE DIVISION + * ============================================================ + PROCEDURE DIVISION. + + MAIN SECTION. + MAIN-PROCEDURE. + PERFORM 1000-INIT-SECTION + PERFORM 2000-OPEN-FILES-SECTION + PERFORM 3000-PROCESS-SECTION + PERFORM 4000-REPORT-SECTION + PERFORM 5000-AUDIT-SECTION + PERFORM 6000-ERROR-HANDLE-SECTION + PERFORM 9000-EXIT-SECTION + STOP RUN. + + *> ============================================================ + *> 1000-INIT-SECTION — Initialize all working variables + *> ============================================================ + 1000-INIT-SECTION SECTION. + + 1000-INIT. + DISPLAY " " + DISPLAY "=== Divide100 — Initialize ===" + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP + DISPLAY "[" WS-TIMESTAMP "] Initializing program" + + *> Zero counters + MOVE 0 TO WS-REC-COUNT + MOVE 0 TO WS-FILE-NUM + MOVE 0 TO WS-READ-COUNT + MOVE 0 TO WS-WRITE-COUNT + MOVE 0 TO WS-TRAILER-REC-COUNT + MOVE 0 TO WS-AUDIT-COUNT + MOVE 0 TO WS-BATCH-ERROR-COUNT + MOVE 0 TO WS-BATCH-WARN-COUNT + MOVE 0 TO WS-OPEN-RETRY-COUNT + MOVE 0 TO WS-HASH-TOTAL-IN + MOVE 0 TO WS-HASH-TOTAL-OUT + + *> Reset boundary flags + MOVE 'N' TO WS-BOUNDARY-EMPTY + MOVE 'N' TO WS-BOUNDARY-EXACT-MULT + MOVE 'N' TO WS-BOUNDARY-SINGLE-REC + MOVE 'N' TO WS-BOUNDARY-TRAILING + MOVE 'Y' TO WS-FIRST-RECORD + + *> Reset retry state + MOVE 'NONE' TO WS-ALT-SUFFIX + MOVE 0 TO WS-RETRY-ATTEMPT + + *> Reset split stats + MOVE 0 TO WS-SPLIT-REC-COUNT + MOVE 0 TO WS-SPLIT-FILE-TOTAL + MOVE 99999 TO WS-SPLIT-MIN-RECS + MOVE 0 TO WS-SPLIT-MAX-RECS + MOVE 'N' TO WS-SPLIT-EMPTY-FLAG + MOVE 'N' TO WS-SPLIT-SINGLE-FLAG + + DISPLAY "[" WS-TIMESTAMP "] Initialization complete" + . + + 1000-EXIT. + EXIT. + + *> ============================================================ + *> 2000-OPEN-FILES-SECTION — Open input and audit files + *> ============================================================ + 2000-OPEN-FILES-SECTION SECTION. + + 2000-OPEN-FILES. + DISPLAY "[" WS-TIMESTAMP "] Opening files" + + *> Open input file with retry logic + MOVE 0 TO WS-RETRY-ATTEMPT + MOVE 'N' TO WS-RETRY-SUCCESS + MOVE "FILE-IN.DAT" TO WS-IN-FILE + + PERFORM WITH TEST AFTER UNTIL WS-RETRY-OK + OR WS-RETRY-ATTEMPT >= WS-OPEN-RETRY-MAX + ADD 1 TO WS-RETRY-ATTEMPT + OPEN INPUT FILE-IN + IF WS-FILE-STATUS-IN NOT = '00' + MOVE 'ERROR' TO WS-SEVERITY + DISPLAY "[" WS-TIMESTAMP "] " + "ERROR: FILE-IN open failed " + "status=" WS-FILE-STATUS-IN + " attempt=" WS-RETRY-ATTEMPT + *> Try alternate file name + IF WS-RETRY-ATTEMPT = 1 + MOVE '.BAK' TO WS-ALT-SUFFIX + STRING "FILE-IN" WS-ALT-SUFFIX + DELIMITED BY SIZE + INTO WS-IN-FILE + ELSE + MOVE '.TMP' TO WS-ALT-SUFFIX + STRING "FILE-IN" WS-ALT-SUFFIX + DELIMITED BY SIZE + INTO WS-IN-FILE + END-IF + DISPLAY "[" WS-TIMESTAMP "] " + "Retrying with: " WS-IN-FILE + ELSE + MOVE WS-IN-FILE TO WS-RETRY-FILE-NAME + MOVE 'Y' TO WS-RETRY-SUCCESS + DISPLAY "[" WS-TIMESTAMP "] " + "FILE-IN opened: " WS-IN-FILE + " (attempt " WS-RETRY-ATTEMPT ")" + END-IF + END-PERFORM + + IF NOT WS-RETRY-OK + MOVE 'FATAL' TO WS-SEVERITY + DISPLAY "[" WS-TIMESTAMP "] " + "FATAL: Cannot open FILE-IN after " + WS-OPEN-RETRY-MAX " attempts" + ADD 1 TO WS-BATCH-ERROR-COUNT + PERFORM 9000-EXIT-SECTION + END-IF + + *> Open audit report file + OPEN OUTPUT AUDIT-REPORT + IF WS-FILE-STATUS-AUDIT NOT = '00' + MOVE 'ERROR' TO WS-SEVERITY + DISPLAY "[" WS-TIMESTAMP "] " + "ERROR: AUDIT-REPORT open failed " + "status=" WS-FILE-STATUS-AUDIT + ADD 1 TO WS-BATCH-ERROR-COUNT + ELSE + DISPLAY "[" WS-TIMESTAMP "] " + "AUDIT-REPORT opened successfully" + MOVE SPACES TO AUDIT-REC + STRING "*** AUDIT REPORT — Divide100 ***" + DELIMITED BY SIZE + INTO AUDIT-REC + WRITE AUDIT-REC + ADD 1 TO WS-AUDIT-COUNT + END-IF + + *> Open split stats file + OPEN OUTPUT SPLIT-STATS + IF WS-FILE-STATUS-STATS NOT = '00' + MOVE 'ERROR' TO WS-SEVERITY + DISPLAY "[" WS-TIMESTAMP "] " + "ERROR: SPLIT-STATS open failed " + "status=" WS-FILE-STATUS-STATS + ADD 1 TO WS-BATCH-ERROR-COUNT + ELSE + DISPLAY "[" WS-TIMESTAMP "] " + "SPLIT-STATS opened successfully" + MOVE SPACES TO STATS-REC + STRING "*** SPLIT STATISTICS REPORT ***" + DELIMITED BY SIZE + INTO STATS-REC + WRITE STATS-REC + END-IF + + *> Capture batch start time + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP + . + + 2000-EXIT. + EXIT. + + *> ============================================================ + *> 3000-PROCESS-SECTION — Main processing loop + *> ============================================================ + 3000-PROCESS-SECTION SECTION. + + 3000-PROCESS. + DISPLAY "[" WS-TIMESTAMP "] Starting record processing" + DISPLAY "=== 100-DIVISION PROCESSING ===" + DISPLAY "Records per file: " WS-DIVISOR + + *> Write audit header + MOVE SPACES TO AUDIT-REC + STRING "=== 100-DIVISION PROCESSING ===" + DELIMITED BY SIZE + INTO AUDIT-REC + WRITE AUDIT-REC + ADD 1 TO WS-AUDIT-COUNT + + MOVE SPACES TO AUDIT-REC + STRING "Records per file: " WS-DIVISOR + DELIMITED BY SIZE + INTO AUDIT-REC + WRITE AUDIT-REC + ADD 1 TO WS-AUDIT-COUNT + + PERFORM VARYING WS-REC-COUNT FROM 1 BY 1 + UNTIL WS-EOF + READ FILE-IN INTO FILE-IN-REC + AT END + SET WS-EOF TO TRUE + IF WS-IS-FIRST-RECORD + MOVE 'Y' TO WS-BOUNDARY-EMPTY + MOVE 'WARNING' TO WS-SEVERITY + DISPLAY "[" WS-TIMESTAMP "] " + "WARNING: Input file is empty" + END-IF + NOT AT END + SET WS-READ-SUCCESS TO TRUE + ADD 1 TO WS-READ-COUNT + IF WS-IS-FIRST-RECORD + MOVE 'N' TO WS-FIRST-RECORD + END-IF + PERFORM 3100-READ-INPUT-SECTION + PERFORM 3200-VALIDATE-SECTION + PERFORM 3300-APPLY-RULES-SECTION + PERFORM 3400-WRITE-OUTPUT-SECTION + END-READ + + IF WS-FILE-STATUS-IN NOT = '00' AND NOT WS-EOF + MOVE 'ERROR' TO WS-SEVERITY + DISPLAY "[" WS-TIMESTAMP "] " + "ERROR: FILE-IN read failed " + "record=" WS-REC-COUNT + " status=" WS-FILE-STATUS-IN + ADD 1 TO WS-BATCH-ERROR-COUNT + END-IF + END-PERFORM + + *> Boundary checks after processing + IF WS-BOUNDARY-IS-EMPTY + MOVE SPACES TO AUDIT-REC + STRING "WARNING: Input file was empty — " + "no output files created" + DELIMITED BY SIZE + INTO AUDIT-REC + WRITE AUDIT-REC + ADD 1 TO WS-AUDIT-COUNT + ELSE + DIVIDE WS-READ-COUNT BY WS-DIVISOR + GIVING WS-BOUNDARY-MULTIPLIER + REMAINDER WS-REMAINDER + IF WS-REMAINDER = 0 + MOVE 'Y' TO WS-BOUNDARY-EXACT-MULT + DISPLAY "[" WS-TIMESTAMP "] " + "NOTE: Exact multiple of divisor — " + "no trailing records" + ELSE + MOVE 'Y' TO WS-BOUNDARY-TRAILING + MOVE WS-REMAINDER TO WS-TRAILER-REC-COUNT + DISPLAY "[" WS-TIMESTAMP "] " + "NOTE: " WS-TRAILER-REC-COUNT + " trailing record(s) in last file" + END-IF + IF WS-READ-COUNT = 1 + MOVE 'Y' TO WS-BOUNDARY-SINGLE-REC + END-IF + END-IF + + *> Close last output file if any were opened + IF WS-FILE-NUM > 0 + PERFORM WRITE-TRAILER-RECORD + CLOSE FILE-OUT + IF WS-FILE-STATUS-OUT NOT = '00' + MOVE 'ERROR' TO WS-SEVERITY + DISPLAY "[" WS-TIMESTAMP "] " + "ERROR: Close failed for " + WS-OUT-FILE + " status=" WS-FILE-STATUS-OUT + ADD 1 TO WS-BATCH-ERROR-COUNT + ELSE + DISPLAY "[" WS-TIMESTAMP "] " + "Closed final file: " WS-OUT-FILE + END-IF + END-IF + + MOVE WS-REC-COUNT TO WS-DISPLAY-COUNT + DISPLAY " " + DISPLAY "[" WS-TIMESTAMP "] Total records read: " + WS-DISPLAY-COUNT + DISPLAY "[" WS-TIMESTAMP "] Output files created: " + WS-FILE-NUM + . + + 3000-EXIT. + EXIT. + + *> ============================================================ + *> 3100-READ-INPUT-SECTION — Input record processing + *> ============================================================ + 3100-READ-INPUT-SECTION SECTION. + + 3100-READ-INPUT. + *> Accumulate hash total (sum of numeric representation + *> of the input record bytes) + PERFORM COMPUTE-INPUT-HASH + + *> Classify record type based on known layouts + MOVE IN-RECORD TO WS-TELECOM-REC + MOVE IN-RECORD TO WS-CDR-REC + + *> Check if record resembles a CDR by CDR-ID pattern + IF CDR-ID (1:3) = 'CDR' + DISPLAY "[" WS-TIMESTAMP "] " + "Record " WS-REC-COUNT + ": CDR record detected: " CDR-ID + ELSE + IF INV-ID (1:3) = 'INV' + DISPLAY "[" WS-TIMESTAMP "] " + "Record " WS-REC-COUNT + ": Invoice record detected: " INV-ID + ELSE + DISPLAY "[" WS-TIMESTAMP "] " + "Record " WS-REC-COUNT + ": Generic record" + END-IF + END-IF + . + + 3100-EXIT. + EXIT. + + *> ============================================================ + *> 3200-VALIDATE-SECTION — Validate input record + *> ============================================================ + 3200-VALIDATE-SECTION SECTION. + + 3200-VALIDATE. + *> Validate output file naming convention before writing + IF WS-FILE-NUM > 0 + MOVE WS-OUT-FILE TO WS-FILE-NAME-PATTERN + IF WS-FILE-NAME-PATTERN (1:8) = WS-FILE-NAME-PREFIX + MOVE 'Y' TO WS-FILE-NAME-VALID + ELSE + MOVE 'N' TO WS-FILE-NAME-VALID + MOVE 'WARNING' TO WS-SEVERITY + DISPLAY "[" WS-TIMESTAMP "] " + "WARNING: Unconventional file name: " + WS-OUT-FILE + ADD 1 TO WS-BATCH-WARN-COUNT + END-IF + END-IF + . + + 3200-EXIT. + EXIT. + + *> ============================================================ + *> 3300-APPLY-RULES-SECTION — Apply division rules + *> ============================================================ + 3300-APPLY-RULES-SECTION SECTION. + + 3300-APPLY-RULES. + *> Use DIVIDE to determine file number + *> === ORIGINAL LOGIC PRESERVED (unaltered) === + DIVIDE WS-REC-COUNT BY WS-DIVISOR + GIVING WS-QUOTIENT REMAINDER WS-REMAINDER + + *> If remainder = 1, start a new output file + *> === ORIGINAL LOGIC PRESERVED (unaltered) === + IF WS-REMAINDER = 1 + IF WS-FILE-NUM > 0 + PERFORM WRITE-TRAILER-RECORD + CLOSE FILE-OUT + IF WS-FILE-STATUS-OUT NOT = '00' + MOVE 'ERROR' TO WS-SEVERITY + DISPLAY "[" WS-TIMESTAMP "] " + "ERROR: Close failed for " + WS-OUT-FILE + " status=" WS-FILE-STATUS-OUT + ADD 1 TO WS-BATCH-ERROR-COUNT + ELSE + DISPLAY "[" WS-TIMESTAMP "] " + "Closed: " WS-OUT-FILE + END-IF + END-IF + ADD 1 TO WS-FILE-NUM + MOVE WS-FILE-NUM TO WS-FILE-NUM-ED + STRING "FILE-OUT-" DELIMITED BY SIZE + WS-FILE-NUM-ED DELIMITED BY SIZE + ".DAT" DELIMITED BY SIZE + INTO WS-OUT-FILE + OPEN OUTPUT FILE-OUT + IF WS-FILE-STATUS-OUT NOT = '00' + MOVE 'FATAL' TO WS-SEVERITY + DISPLAY "[" WS-TIMESTAMP "] " + "FATAL: Cannot open " WS-OUT-FILE + " status=" WS-FILE-STATUS-OUT + ADD 1 TO WS-BATCH-ERROR-COUNT + PERFORM 6000-ERROR-HANDLE-SECTION + ELSE + DISPLAY "[" WS-TIMESTAMP "] " + "Opened: " WS-OUT-FILE + PERFORM WRITE-HEADER-RECORD + END-IF + END-IF + . + + 3300-EXIT. + EXIT. + + *> ============================================================ + *> 3400-WRITE-OUTPUT-SECTION — Write record to output + *> ============================================================ + 3400-WRITE-OUTPUT-SECTION SECTION. + + 3400-WRITE-OUTPUT. + *> Hash the output record before writing + PERFORM COMPUTE-OUTPUT-HASH + + *> Write record to current output file + *> === ORIGINAL LOGIC PRESERVED (unaltered) === + MOVE IN-RECORD TO OUT-RECORD + WRITE FILE-OUT-REC + + IF WS-FILE-STATUS-OUT NOT = '00' + MOVE 'ERROR' TO WS-SEVERITY + DISPLAY "[" WS-TIMESTAMP "] " + "ERROR: Write failed for record " + WS-REC-COUNT + " status=" WS-FILE-STATUS-OUT + ADD 1 TO WS-BATCH-ERROR-COUNT + ELSE + ADD 1 TO WS-WRITE-COUNT + ADD 1 TO WS-SPLIT-REC-COUNT + ADD 1 TO WS-HASH-SPLIT-VAL (WS-FILE-NUM) + END-IF + . + + 3400-EXIT. + EXIT. + + *> ============================================================ + *> 4000-REPORT-SECTION — Generate split statistics + *> ============================================================ + 4000-REPORT-SECTION SECTION. + + 4000-REPORT. + DISPLAY " " + DISPLAY "[" WS-TIMESTAMP "] === Split Statistics ===" + DISPLAY "Total input records: " WS-READ-COUNT + DISPLAY "Total output records: " WS-WRITE-COUNT + DISPLAY "Output files created: " WS-FILE-NUM + + *> Populate split stats + MOVE WS-FILE-NUM TO WS-SPLIT-FILE-TOTAL + IF WS-READ-COUNT = 0 + MOVE 'Y' TO WS-SPLIT-EMPTY-FLAG + END-IF + IF WS-READ-COUNT = 1 + MOVE 'Y' TO WS-SPLIT-SINGLE-FLAG + END-IF + + *> Build min/max split sizes + PERFORM VARYING WS-FILE-NUM-ED FROM 1 BY 1 + UNTIL WS-FILE-NUM-ED > WS-FILE-NUM + IF WS-HASH-SPLIT-VAL (WS-FILE-NUM-ED) + < WS-SPLIT-MIN-RECS + MOVE WS-HASH-SPLIT-VAL (WS-FILE-NUM-ED) + TO WS-SPLIT-MIN-RECS + END-IF + IF WS-HASH-SPLIT-VAL (WS-FILE-NUM-ED) + > WS-SPLIT-MAX-RECS + MOVE WS-HASH-SPLIT-VAL (WS-FILE-NUM-ED) + TO WS-SPLIT-MAX-RECS + END-IF + END-PERFORM + + DISPLAY "Min records per split: " WS-SPLIT-MIN-RECS + DISPLAY "Max records per split: " WS-SPLIT-MAX-RECS + + *> Write detailed stats to SPLIT-STATS file + MOVE SPACES TO STATS-REC + STRING "SPLIT STATS: files=" WS-FILE-NUM + " total-records=" WS-READ-COUNT + " min=" WS-SPLIT-MIN-RECS + " max=" WS-SPLIT-MAX-RECS + DELIMITED BY SIZE + INTO STATS-REC + WRITE STATS-REC + + *> Sequential output file inventory + MOVE SPACES TO STATS-REC + STRING "=== Split File Inventory ===" + DELIMITED BY SIZE + INTO STATS-REC + WRITE STATS-REC + + PERFORM VARYING WS-FILE-NUM-ED FROM 1 BY 1 + UNTIL WS-FILE-NUM-ED > WS-FILE-NUM + MOVE SPACES TO STATS-REC + STRING "FILE-OUT-" + WS-FILE-NUM-ED + ".DAT: " + WS-HASH-SPLIT-VAL (WS-FILE-NUM-ED) + " records" + DELIMITED BY SIZE + INTO STATS-REC + WRITE STATS-REC + END-PERFORM + + *> Boundary condition summary + MOVE SPACES TO STATS-REC + STRING "Boundary: EMPTY=" WS-BOUNDARY-EMPTY + " EXACT-MULT=" WS-BOUNDARY-EXACT-MULT + " SINGLE=" WS-BOUNDARY-SINGLE-REC + " TRAILING=" WS-BOUNDARY-TRAILING + " TRAIL-COUNT=" WS-TRAILER-REC-COUNT + DELIMITED BY SIZE + INTO STATS-REC + WRITE STATS-REC + . + + 4000-EXIT. + EXIT. + + *> ============================================================ + *> 5000-AUDIT-SECTION — Hash verification and audit trail + *> ============================================================ + 5000-AUDIT-SECTION SECTION. + + 5000-AUDIT. + DISPLAY " " + DISPLAY "[" WS-TIMESTAMP "] === Audit Trail ===" + + *> Display hash totals + MOVE WS-HASH-TOTAL-IN TO WS-DISPLAY-HASH + DISPLAY "Hash total (input): " WS-DISPLAY-HASH + + MOVE WS-HASH-TOTAL-OUT TO WS-DISPLAY-HASH + DISPLAY "Hash total (output): " WS-DISPLAY-HASH + + *> Verify hash totals: input hash must equal sum of + *> all split file hashes + MOVE 0 TO WS-HASH-TOTAL-VERIFY + PERFORM VARYING WS-FILE-NUM-ED FROM 1 BY 1 + UNTIL WS-FILE-NUM-ED > WS-FILE-NUM + ADD WS-HASH-SPLIT-VAL (WS-FILE-NUM-ED) + TO WS-HASH-TOTAL-VERIFY + END-PERFORM + + IF WS-HASH-TOTAL-IN = WS-HASH-TOTAL-VERIFY + MOVE 'Y' TO WS-HASH-VERIFIED + DISPLAY "[" WS-TIMESTAMP "] " + "PASS: Hash total verified OK" + ELSE + MOVE 'N' TO WS-HASH-VERIFIED + MOVE 'ERROR' TO WS-SEVERITY + DISPLAY "[" WS-TIMESTAMP "] " + "FAIL: Hash total mismatch!" + DISPLAY " Input hash: " WS-HASH-TOTAL-IN + DISPLAY " Sum of splits: " WS-HASH-TOTAL-VERIFY + ADD 1 TO WS-BATCH-ERROR-COUNT + END-IF + + *> Verify output hash matches input hash + IF WS-HASH-TOTAL-IN NOT = WS-HASH-TOTAL-OUT + MOVE 'ERROR' TO WS-SEVERITY + DISPLAY "[" WS-TIMESTAMP "] " + "FAIL: Output hash != Input hash!" + ADD 1 TO WS-BATCH-ERROR-COUNT + ELSE + DISPLAY "[" WS-TIMESTAMP "] " + "PASS: Output hash matches input hash" + END-IF + + *> Write final audit records + MOVE SPACES TO AUDIT-REC + STRING "=== Audit Summary ===" + DELIMITED BY SIZE + INTO AUDIT-REC + WRITE AUDIT-REC + ADD 1 TO WS-AUDIT-COUNT + + MOVE SPACES TO AUDIT-REC + STRING "Total input records: " WS-READ-COUNT + DELIMITED BY SIZE + INTO AUDIT-REC + WRITE AUDIT-REC + ADD 1 TO WS-AUDIT-COUNT + + MOVE SPACES TO AUDIT-REC + STRING "Total output records: " WS-WRITE-COUNT + DELIMITED BY SIZE + INTO AUDIT-REC + WRITE AUDIT-REC + ADD 1 TO WS-AUDIT-COUNT + + MOVE SPACES TO AUDIT-REC + STRING "Output files created: " WS-FILE-NUM + DELIMITED BY SIZE + INTO AUDIT-REC + WRITE AUDIT-REC + ADD 1 TO WS-AUDIT-COUNT + + MOVE SPACES TO AUDIT-REC + STRING "Hash total (input): " WS-HASH-TOTAL-IN + DELIMITED BY SIZE + INTO AUDIT-REC + WRITE AUDIT-REC + ADD 1 TO WS-AUDIT-COUNT + + MOVE SPACES TO AUDIT-REC + STRING "Hash total (output): " WS-HASH-TOTAL-OUT + DELIMITED BY SIZE + INTO AUDIT-REC + WRITE AUDIT-REC + ADD 1 TO WS-AUDIT-COUNT + + IF WS-HASH-MATCH + MOVE SPACES TO AUDIT-REC + STRING "Hash verification: PASS" + DELIMITED BY SIZE + INTO AUDIT-REC + WRITE AUDIT-REC + ADD 1 TO WS-AUDIT-COUNT + ELSE + MOVE SPACES TO AUDIT-REC + STRING "Hash verification: FAIL" + DELIMITED BY SIZE + INTO AUDIT-REC + WRITE AUDIT-REC + ADD 1 TO WS-AUDIT-COUNT + END-IF + + MOVE SPACES TO AUDIT-REC + STRING "Error count: " WS-BATCH-ERROR-COUNT + " Warning count: " WS-BATCH-WARN-COUNT + DELIMITED BY SIZE + INTO AUDIT-REC + WRITE AUDIT-REC + ADD 1 TO WS-AUDIT-COUNT + + *> Log batch completion + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP + MOVE SPACES TO AUDIT-REC + STRING "Batch completed at: " WS-TIMESTAMP + DELIMITED BY SIZE + INTO AUDIT-REC + WRITE AUDIT-REC + ADD 1 TO WS-AUDIT-COUNT + + DISPLAY "[" WS-TIMESTAMP "] " + "Audit report written: " WS-AUDIT-COUNT " lines" + . + + 5000-EXIT. + EXIT. + + *> ============================================================ + *> 6000-ERROR-HANDLE-SECTION — Central error handler + *> ============================================================ + 6000-ERROR-HANDLE-SECTION SECTION. + + 6000-ERROR-HANDLE. + DISPLAY "[" WS-TIMESTAMP "] " + "*** ERROR HANDLER INVOKED ***" + + EVALUATE TRUE + WHEN WS-SEVERITY-FATAL + DISPLAY "[" WS-TIMESTAMP "] " + "FATAL: Aborting program" + MOVE SPACES TO AUDIT-REC + STRING "FATAL ERROR — Batch aborted" + DELIMITED BY SIZE + INTO AUDIT-REC + WRITE AUDIT-REC + ADD 1 TO WS-AUDIT-COUNT + PERFORM 9000-EXIT-SECTION + + WHEN WS-SEVERITY-ERROR + DISPLAY "[" WS-TIMESTAMP "] " + "ERROR: Continuing with error" + MOVE SPACES TO AUDIT-REC + STRING "ERROR: Continuing — " + "error count=" WS-BATCH-ERROR-COUNT + DELIMITED BY SIZE + INTO AUDIT-REC + WRITE AUDIT-REC + ADD 1 TO WS-AUDIT-COUNT + + WHEN WS-SEVERITY-WARNING + DISPLAY "[" WS-TIMESTAMP "] " + "WARNING: Non-critical issue" + MOVE SPACES TO AUDIT-REC + STRING "WARNING issued — " + "warn count=" WS-BATCH-WARN-COUNT + DELIMITED BY SIZE + INTO AUDIT-REC + WRITE AUDIT-REC + ADD 1 TO WS-AUDIT-COUNT + + WHEN OTHER + CONTINUE + END-EVALUATE + . + + 6000-EXIT. + EXIT. + + *> ============================================================ + *> 9000-EXIT-SECTION — Program cleanup and exit + *> ============================================================ + 9000-EXIT-SECTION SECTION. + + 9000-EXIT. + DISPLAY " " + DISPLAY "[" WS-TIMESTAMP "] === Program Termination ===" + + *> Close any open files safely + CLOSE FILE-IN + IF WS-FILE-STATUS-IN NOT = '00' + DISPLAY "[" WS-TIMESTAMP "] " + "NOTE: FILE-IN close status=" + WS-FILE-STATUS-IN + END-IF + + CLOSE AUDIT-REPORT + IF WS-FILE-STATUS-AUDIT NOT = '00' + DISPLAY "[" WS-TIMESTAMP "] " + "NOTE: AUDIT-REPORT close status=" + WS-FILE-STATUS-AUDIT + END-IF + + CLOSE SPLIT-STATS + IF WS-FILE-STATUS-STATS NOT = '00' + DISPLAY "[" WS-TIMESTAMP "] " + "NOTE: SPLIT-STATS close status=" + WS-FILE-STATUS-STATS + END-IF + + *> Final summary display + MOVE WS-REC-COUNT TO WS-DISPLAY-COUNT + DISPLAY " " + DISPLAY "=== FINAL SUMMARY ===" + DISPLAY "Total records read: " WS-DISPLAY-COUNT + DISPLAY "Output files created: " WS-FILE-NUM + DISPLAY "Errors: " WS-BATCH-ERROR-COUNT + DISPLAY "Warnings: " WS-BATCH-WARN-COUNT + + IF WS-HASH-MATCH + DISPLAY "Hash integrity: PASS" + ELSE + DISPLAY "Hash integrity: FAIL" + END-IF + + DISPLAY " " + DISPLAY "=== Divide100 ended ===" + STOP RUN + . + + *> ============================================================ + *> WRITE-HEADER-RECORD — Write header record to split file + *> ============================================================ + WRITE-HEADER-RECORD SECTION. + + WRITE-HDR. + *> Write standard header + MOVE SPACES TO WS-HEADER-RECORD + MOVE 'HEADER' TO WS-HDR-TYPE + MOVE WS-FILE-NUM TO WS-HDR-FILE + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP + MOVE WS-TIMESTAMP (1:12) TO WS-HDR-TIMESTAMP + MOVE WS-HEADER-RECORD TO OUT-RECORD + WRITE FILE-OUT-REC + IF WS-FILE-STATUS-OUT = '00' + ADD 1 TO WS-WRITE-COUNT + ADD 1 TO WS-HASH-SPLIT-VAL (WS-FILE-NUM) + DISPLAY "[" WS-TIMESTAMP "] " + "Header written to " WS-OUT-FILE + ELSE + MOVE 'WARNING' TO WS-SEVERITY + DISPLAY "[" WS-TIMESTAMP "] " + "WARNING: Header write failed for " + WS-OUT-FILE + ADD 1 TO WS-BATCH-WARN-COUNT + END-IF + + *> Write CDR-aware header (second header line with metadata) + MOVE SPACES TO WS-CDR-HEADER + MOVE 'CDR-HDR' TO WS-CDR-HDR-TYPE + MOVE WS-FILE-NUM TO WS-CDR-HDR-FILE + MOVE 100 TO WS-CDR-HDR-EXPECTED + MOVE WS-CDR-HEADER TO OUT-RECORD + WRITE FILE-OUT-REC + IF WS-FILE-STATUS-OUT = '00' + ADD 1 TO WS-WRITE-COUNT + ADD 1 TO WS-HASH-SPLIT-VAL (WS-FILE-NUM) + ELSE + MOVE 'WARNING' TO WS-SEVERITY + DISPLAY "[" WS-TIMESTAMP "] " + "WARNING: CDR header write failed for " + WS-OUT-FILE + ADD 1 TO WS-BATCH-WARN-COUNT + END-IF + . + + WRITE-HDR-EXIT. + EXIT. + + *> ============================================================ + *> WRITE-TRAILER-RECORD — Write trailer to closing split file + *> ============================================================ + WRITE-TRAILER-RECORD SECTION. + + WRITE-TRL. + MOVE SPACES TO WS-TRAILER-RECORD + MOVE 'TRAILER' TO WS-TRAILER-TYPE + MOVE WS-FILE-NUM TO WS-TRAILER-FILE + *> Count = current split count minus header records + *> (we wrote 2 header records per file) + IF WS-HASH-SPLIT-VAL (WS-FILE-NUM) > 2 + COMPUTE WS-TRL-REC-COUNT = + WS-HASH-SPLIT-VAL (WS-FILE-NUM) - 2 + ELSE + MOVE 0 TO WS-TRL-REC-COUNT + END-IF + MOVE WS-TRAILER-RECORD TO OUT-RECORD + WRITE FILE-OUT-REC + IF WS-FILE-STATUS-OUT = '00' + ADD 1 TO WS-WRITE-COUNT + ADD 1 TO WS-HASH-SPLIT-VAL (WS-FILE-NUM) + DISPLAY "[" WS-TIMESTAMP "] " + "Trailer written to " WS-OUT-FILE + " count=" WS-TRL-REC-COUNT + ELSE + MOVE 'WARNING' TO WS-SEVERITY + DISPLAY "[" WS-TIMESTAMP "] " + "WARNING: Trailer write failed for " + WS-OUT-FILE + ADD 1 TO WS-BATCH-WARN-COUNT + END-IF + . + + WRITE-TRL-EXIT. + EXIT. + + *> ============================================================ + *> WRITE-AUDIT-LINE — Write one line to audit report + *> ============================================================ + WRITE-AUDIT-LINE SECTION. + + WRITE-AUDIT. + MOVE WS-AUDIT-LINE TO AUDIT-REC + WRITE AUDIT-REC + IF WS-FILE-STATUS-AUDIT = '00' + ADD 1 TO WS-AUDIT-COUNT + ELSE + DISPLAY "[" WS-TIMESTAMP "] " + "ERROR writing audit record" + END-IF + . + + WRITE-AUDIT-EXIT. + EXIT. + + *> ============================================================ + *> COMPUTE-INPUT-HASH — Accumulate input hash total + *> ============================================================ + COMPUTE-INPUT-HASH SECTION. + + COMP-HASH-IN. + *> Simple hash: sum the numeric values of each byte + MOVE 0 TO WS-HASH-TEMP + INSPECT IN-RECORD TALLYING WS-HASH-TEMP + FOR CHARACTERS BEFORE INITIAL SPACE + ADD WS-HASH-TEMP TO WS-HASH-TOTAL-IN + . + + COMP-HASH-IN-EXIT. + EXIT. + + *> ============================================================ + *> COMPUTE-OUTPUT-HASH — Accumulate output hash total + *> ============================================================ + COMPUTE-OUTPUT-HASH SECTION. + + COMP-HASH-OUT. + *> Simple hash: sum the numeric values of each byte + MOVE 0 TO WS-HASH-TEMP + INSPECT OUT-RECORD TALLYING WS-HASH-TEMP + FOR CHARACTERS BEFORE INITIAL SPACE + ADD WS-HASH-TEMP TO WS-HASH-TOTAL-OUT + . + + COMP-HASH-OUT-EXIT. + EXIT. diff --git a/benchmark-programs/12-divide-100/main-divide-100.cbl b/benchmark-programs/12-divide-100/main-divide-100.cbl new file mode 100644 index 0000000..1d297fb --- /dev/null +++ b/benchmark-programs/12-divide-100/main-divide-100.cbl @@ -0,0 +1,89 @@ + *> ============================================================ + *> main-divide-100 : CDR数据100分割 (CDR 100-Split) + *> Input : FILE-IN (INPUT.DAT: CDR数据) + *> Output: FILE-OUT (SPLIT-OUT: 100件毎分割) + *> Coverage: S-N005, S-N006, S-N007, S-R001, S-R002 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. DIVIDE-100. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN ASSIGN TO "INPUT.DAT" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FS. + + SELECT FILE-OUT ASSIGN TO "SPLIT-OUT" + ORGANIZATION IS SEQUENTIAL. + + DATA DIVISION. + FILE SECTION. + FD FILE-IN RECORD CONTAINS 40 CHARACTERS. + 01 IN-REC. + 05 IN-KEY PIC X(10). + 05 IN-DATA PIC X(20). + 05 IN-AMT PIC 9(10). + + FD FILE-OUT RECORD CONTAINS 40 CHARACTERS. + 01 OUT-REC PIC X(40). + + WORKING-STORAGE SECTION. + 01 WS-FS PIC X(2). + 01 WS-EOF PIC X(1) VALUE 'N'. + 88 WS-EOF-Y VALUE 'Y' FALSE 'N'. + 01 WS-COUNT PIC 9(10). + 01 WS-FILE-NUM PIC 9(2). + 01 WS-FILE-NAME PIC X(20). + 01 WS-TOTAL-IN PIC 9(10). + 01 WS-TOTAL-OUT PIC 9(10). + 01 WS-SPLIT-LIMIT PIC 9(5) VALUE 100. + + PROCEDURE DIVISION. + MAIN. + DISPLAY "DIVIDE-100: Starting 100-split" + OPEN INPUT FILE-IN. + MOVE 1 TO WS-FILE-NUM. + MOVE 0 TO WS-COUNT. + MOVE 0 TO WS-TOTAL-IN. + PERFORM OPEN-NEXT-FILE. + + PERFORM UNTIL WS-EOF-Y + READ FILE-IN INTO IN-REC + AT END SET WS-EOF-Y TO TRUE + NOT AT END + ADD 1 TO WS-TOTAL-IN WS-COUNT + MOVE IN-REC TO OUT-REC + WRITE OUT-REC + ADD 1 TO WS-TOTAL-OUT + IF WS-COUNT >= WS-SPLIT-LIMIT + CLOSE FILE-OUT + ADD 1 TO WS-FILE-NUM + MOVE 0 TO WS-COUNT + PERFORM OPEN-NEXT-FILE + END-IF + END-READ + END-PERFORM. + + CLOSE FILE-IN FILE-OUT. + DISPLAY "DIVIDE-100: IN=" WS-TOTAL-IN + " OUT=" WS-TOTAL-OUT " FILES=" WS-FILE-NUM + IF WS-TOTAL-IN = WS-TOTAL-OUT + DISPLAY "DIVIDE-100: PASS" + STOP RUN RETURNING 0 + ELSE + DISPLAY "DIVIDE-100: FAIL" + STOP RUN RETURNING 1 + END-IF + . + + OPEN-NEXT-FILE. + STRING "SPLIT100-" WS-FILE-NUM ".DAT" + DELIMITED BY SIZE INTO WS-FILE-NAME + END-STRING + CLOSE FILE-OUT + OPEN OUTPUT FILE-OUT + DISPLAY "OPEN: " WS-FILE-NAME + . + + END PROGRAM DIVIDE-100. diff --git a/benchmark-programs/13-validation-nodup/FILE-IN.DAT b/benchmark-programs/13-validation-nodup/FILE-IN.DAT new file mode 100644 index 0000000..d5b71ed --- /dev/null +++ b/benchmark-programs/13-validation-nodup/FILE-IN.DAT @@ -0,0 +1 @@ +AB00000000000000000000000000001C00000000000001D0000000000000100101E00001F0000001G000000001BB00000000000000000000000000002C00000000000002D0000000000000200102E00002F0000002G000000002CB00000000000000000000000000003C00000000000003D0000000000000300103E00003F0000003G000000003DB00000000000000000000000000004C00000000000004D0000000000000400104E00004F0000004G000000004EB00000000000000000000000000005C00000000000005D0000000000000500105E00005F0000005G000000005FB00000000000000000000000000006C00000000000006D0000000000000600106E00006F0000006G000000006GB00000000000000000000000000007C00000000000007D0000000000000700107E00007F0000007G000000007HB00000000000000000000000000008C00000000000008D0000000000000800108E00008F0000008G000000008IB00000000000000000000000000009C00000000000009D0000000000000900109E00009F0000009G000000009JB00000000000000000000000000010C00000000000010D0000000000001000110E00010F0000010G000000010KB00000000000000000000000000011C00000000000011D0000000000001100111E00011F0000011G000000011LB00000000000000000000000000012C00000000000012D0000000000001200112E00012F0000012G000000012MB00000000000000000000000000013C00000000000013D0000000000001300113E00013F0000013G000000013NB00000000000000000000000000014C00000000000014D0000000000001400114E00014F0000014G000000014OB00000000000000000000000000015C00000000000015D0000000000001500115E00015F0000015G000000015PB00000000000000000000000000016C00000000000016D0000000000001600116E00016F0000016G000000016QB00000000000000000000000000017C00000000000017D0000000000001700117E00017F0000017G000000017RB00000000000000000000000000018C00000000000018D0000000000001800118E00018F0000018G000000018SB00000000000000000000000000019C00000000000019D0000000000001900119E00019F0000019G000000019TB00000000000000000000000000020C00000000000020D0000000000002000120E00020F0000020G000000020UB00000000000000000000000000021C00000000000021D0000000000002100121E00021F0000021G000000021VB00000000000000000000000000022C00000000000022D0000000000002200122E00022F0000022G000000022WB00000000000000000000000000023C00000000000023D0000000000002300123E00023F0000023G000000023WB00000000000000000000000000024C00000000000024D0000000000002400124E00024F0000024G000000024YB00000000000000000000000000025C00000000000025D0000000000002500125E00025F0000025G000000025ZB00000000000000000000000000026C00000000000026D0000000000002600126E00026F0000026G000000026AB00000000000000000000000000027C00000000000027D0000000000002700127E00027F0000027G000000027BB00000000000000000000000000028C00000000000028D0000000000002800128E00028F0000028G000000028CB00000000000000000000000000029C00000000000029D0000000000002900129E00029F0000029G000000029DB00000000000000000000000000030C00000000000030D0000000000003000130E00030F0000030G000000030EB00000000000000000000000000031C00000000000031D0000000000003100131E00031F0000031G000000031FB00000000000000000000000000032C00000000000032D0000000000003200132E00032F0000032G000000032GB00000000000000000000000000033C00000000000033D0000000000003300133E00033F0000033G000000033HB00000000000000000000000000034C00000000000034D0000000000003400134E00034F0000034G000000034IB00000000000000000000000000035C00000000000035D0000000000003500135E00035F0000035G000000035JB00000000000000000000000000036C00000000000036D0000000000003600136E00036F0000036G000000036KB00000000000000000000000000037C00000000000037D0000000000003700137E00037F0000037G000000037LB00000000000000000000000000038C00000000000038D0000000000003800138E00038F0000038G000000038MB00000000000000000000000000039C00000000000039D0000000000003900139E00039F0000039G000000039NB00000000000000000000000000040C00000000000040D0000000000004000140E00040F0000040G000000040OB00000000000000000000000000041C00000000000041D0000000000004100141E00041F0000041G000000041PB00000000000000000000000000042C00000000000042D0000000000004200142E00042F0000042G000000042QB00000000000000000000000000043C00000000000043D0000000000004300143E00043F0000043G000000043RB00000000000000000000000000044C00000000000044D0000000000004400144E00044F0000044G000000044SB00000000000000000000000000045C00000000000045D0000000000004500145E00045F0000045G000000045TB00000000000000000000000000046C00000000000046D0000000000004600146E00046F0000046G000000046UB00000000000000000000000000047C00000000000047D0000000000004700147E00047F0000047G000000047VB00000000000000000000000000048C00000000000048D0000000000004800148E00048F0000048G000000048WB00000000000000000000000000049C00000000000049D0000000000004900149E00049F0000049G000000049XB00000000000000000000000000050C00000000000050D0000000000005000150E00050F0000050G000000050YB00000000000000000000000000051C00000000000051D0000000000005100151E00051F0000051G000000051ZB00000000000000000000000000052C00000000000052D0000000000005200152E00052F0000052G000000052AB00000000000000000000000000053C00000000000053D0000000000005300153E00053F0000053G000000053BB00000000000000000000000000054C00000000000054D0000000000005400154E00054F0000054G000000054CB00000000000000000000000000055C00000000000055D0000000000005500155E00055F0000055G000000055DB00000000000000000000000000056C00000000000056D0000000000005600156E00056F0000056G000000056EB00000000000000000000000000057C00000000000057D0000000000005700157E00057F0000057G000000057FB00000000000000000000000000058C00000000000058D0000000000005800158E00058F0000058G000000058GB00000000000000000000000000059C00000000000059D0000000000005900159E00059F0000059G000000059HB00000000000000000000000000060C00000000000060D0000000000006000160E00060F0000060G000000060IB00000000000000000000000000061C00000000000061D0000000000006100161E00061F0000061G000000061JB00000000000000000000000000062C00000000000062D0000000000006200162E00062F0000062G000000062KB00000000000000000000000000063C00000000000063D0000000000006300163E00063F0000063G000000063LB00000000000000000000000000064C00000000000064D0000000000006400164E00064F0000064G000000064MB00000000000000000000000000065C00000000000065D0000000000006500165E00065F0000065G000000065NB00000000000000000000000000066C00000000000066D0000000000006600166E00066F0000066G000000066OB00000000000000000000000000067C00000000000067D0000000000006700167E00067F0000067G000000067PB00000000000000000000000000068C00000000000068D0000000000006800168E00068F0000068G000000068QB00000000000000000000000000069C00000000000069D0000000000006900169E00069F0000069G000000069RB00000000000000000000000000070C00000000000070D0000000000007000170E00070F0000070G000000070SB00000000000000000000000000071C00000000000071D0000000000007100171E00071F0000071G000000071TB00000000000000000000000000072C00000000000072D0000000000007200172E00072F0000072G000000072UB00000000000000000000000000073C00000000000073D0000000000007300173E00073F0000073G000000073VB00000000000000000000000000074C00000000000074D0000000000007400174E00074F0000074G000000074WB00000000000000000000000000075C00000000000075D0000000000007500175E00075F0000075G000000075XB00000000000000000000000000076C00000000000076D0000000000007600176E00076F0000076G000000076YB00000000000000000000000000077C00000000000077D0000000000007700177E00077F0000077G000000077ZB00000000000000000000000000078C00000000000078D0000000000007800178E00078F0000078G000000078AB00000000000000000000000000079C00000000000079D0000000000007900179E00079F0000079G000000079BB00000000000000000000000000080C00000000000080D0000000000008000180E00080F0000080G000000080CB00000000000000000000000000081C00000000000081D0000000000008100181E00081F0000081G000000081DB00000000000000000000000000082C00000000000082D0000000000008200182E00082F0000082G000000082EB00000000000000000000000000083C00000000000083D0000000000008300183E00083F0000083G000000083FB00000000000000000000000000084C00000000000084D0000000000008400184E00084F0000084G000000084GB00000000000000000000000000085C00000000000085D0000000000008500185E00085F0000085G000000085HB00000000000000000000000000086C00000000000086D0000000000008600186E00086F0000086G000000086IB00000000000000000000000000087C00000000000087D0000000000008700187E00087F0000087G000000087JB00000000000000000000000000088C00000000000088D0000000000008800188E00088F0000088G000000088KB00000000000000000000000000089C00000000000089D0000000000008900189E00089F0000089G000000089LB00000000000000000000000000090C00000000000090D0000000000009000190E00090F0000090G000000090MB00000000000000000000000000091C00000000000091D0000000000009100191E00091F0000091G000000091NB00000000000000000000000000092C00000000000092D0000000000009200192E00092F0000092G000000092OB00000000000000000000000000093C00000000000093D0000000000009300193E00093F0000093G000000093PB00000000000000000000000000094C00000000000094D0000000000009400194E00094F0000094G000000094QB00000000000000000000000000095C00000000000095D0000000000009500195E00095F0000095G000000095RB00000000000000000000000000096C00000000000096D0000000000009600196E00096F0000096G000000096SB00000000000000000000000000097C00000000000097D0000000000009700197E00097F0000097G000000097TB00000000000000000000000000098C00000000000098D0000000000009800198E00098F0000098G000000098UB00000000000000000000000000099C00000000000099D0000000000009900199E00099F0000099G000000099VB00000000000000000000000000100C00000000000100D0000000000010000200E00100F0000100G000000100WB00000000000000000000000000101C00000000000101D0000000000010100201E00101F0000101G000000101XB00000000000000000000000000102C00000000000102D0000000000010200202E00102F0000102G000000102YB00000000000000000000000000103C00000000000103D0000000000010300203E00103F0000103G000000103ZB00000000000000000000000000104C00000000000104D0000000000010400204E00104F0000104G000000104AB00000000000000000000000000105C00000000000105D0000000000010500205E00105F0000105G000000105BB00000000000000000000000000106C00000000000106D0000000000010600206E00106F0000106G000000106CB00000000000000000000000000107C00000000000107D0000000000010700207E00107F0000107G000000107DB00000000000000000000000000108C00000000000108D0000000000010800208E00108F0000108G000000108EB00000000000000000000000000109C00000000000109D0000000000010900209E00109F0000109G000000109FB00000000000000000000000000110C00000000000110D0000000000011000210E00110F0000110G000000110GB00000000000000000000000000111C00000000000111D0000000000011100211E00111F0000111G000000111HB00000000000000000000000000112C00000000000112D0000000000011200212E00112F0000112G000000112IB00000000000000000000000000113C00000000000113D0000000000011300213E00113F0000113G000000113JB00000000000000000000000000114C00000000000114D0000000000011400214E00114F0000114G000000114KB00000000000000000000000000115C00000000000115D0000000000011500215E00115F0000115G000000115LB00000000000000000000000000116C00000000000116D0000000000011600216E00116F0000116G000000116MB00000000000000000000000000117C00000000000117D0000000000011700217E00117F0000117G000000117NB00000000000000000000000000118C00000000000118D0000000000011800218E00118F0000118G000000118OB00000000000000000000000000119C00000000000119D0000000000011900219E00119F0000119G000000119PB00000000000000000000000000120C00000000000120D0000000000012000220E00120F0000120G000000120QB00000000000000000000000000121C00000000000121D0000000000012100221E00121F0000121G000000121RB00000000000000000000000000122C00000000000122D0000000000012200222E00122F0000122G000000122SB00000000000000000000000000123C00000000000123D0000000000012300223E00123F0000123G000000123 \ No newline at end of file diff --git a/benchmark-programs/13-validation-nodup/README.md b/benchmark-programs/13-validation-nodup/README.md new file mode 100644 index 0000000..61a3d15 --- /dev/null +++ b/benchmark-programs/13-validation-nodup/README.md @@ -0,0 +1,62 @@ +# 13-validation-nodup: Field Validation (No Duplicates) + +## 电信业务场景 + +CDR字段校验。对CDR记录进行字段值校验，检查通话类型代码是否为有效值(01/02/03)，有效记录输出到GOOD文件，无效记录输出到BAD文件。 + +## Description + +Reads FILE-IN and validates FIELD1 against an allowed-value list +('A', 'B', 'C', 'D', 'E'). Records with valid FIELD1 values are +written to FILE-OUT-GOOD. Invalid records are written to +FILE-OUT-BAD with an error code appended. + +## Record Layout + +### Input / Good Output (31 bytes) + +| Field | Type | Length | Description | +|--------|----------|--------|---------------------------| +| FIELD1 | PIC X | 1 | Validation field | +| FIELD2 | PIC X | 30 | Description / payload | + +### Bad Output (33 bytes) + +| Field | Type | Length | Description | +|----------|----------|--------|---------------------------| +| FIELD1 | PIC X | 1 | Original invalid value | +| FIELD2 | PIC X | 30 | Original description | +| ERR-CODE | PIC X | 2 | Error code ('01') | + +## Files + +| File | Purpose | +|---------------------------|----------------------------------| +| main-13-validation-nodup.cbl | Main COBOL program | +| data-gen.sh | Generate test data | +| run.sh | Compile, run, verify | +| README.md | This file | + +## Tests + +| Test Case | Description | +|----------------------------|-----------------------------------------| +| Valid values A-E | All 5 allowed values pass to GOOD | +| Invalid values X,Y,Z | Non-allowed alpha values go to BAD | +| Invalid values 1,9 | Numeric values go to BAD | +| Empty FIELD1 (space) | Treated as invalid, goes to BAD | +| Error code in BAD output | '01' appended to each bad record | + +## Usage + +```bash +cd 13-validation-nodup +bash data-gen.sh +bash run.sh +``` + +## Expected Behavior + +- 5 valid records in FILE-OUT-GOOD (31 bytes each = 155 bytes) +- 6 invalid records in FILE-OUT-BAD (33 bytes each = 198 bytes) +- Invalid records contain the original data plus '01' error code diff --git a/benchmark-programs/13-validation-nodup/audit-report.dat b/benchmark-programs/13-validation-nodup/audit-report.dat new file mode 100644 index 0000000..0be4041 --- /dev/null +++ b/benchmark-programs/13-validation-nodup/audit-report.dat @@ -0,0 +1 @@ +Audit Report - ValidationNodup Run: 2026-06-22 16:35:13 === VALIDATION AUDIT LOG === Program: ValidationNodup Batch timestamp: 2026-06-22 16:35:13 Records read : 1 Records good : 0 Records bad : 1 Valid (no err) : 0 Invalid (error): 1 Control recs :00001 Control good :00000 Control bad :00001 Hash duration : 101 Hash caller : 1555 --- Error Counts by Code --- E001 HIGH 0 Invalid call type - not in A/B/C/D/ E002 LOW 0 Call type not uppercase E003 MED 1 Caller number length not 10-15 char E004 MED 1 Caller number leading chars not num E005 HIGH 0 Duration out of valid range 0-99999 E006 HIGH 0 Duration field not numeric E007 MED 0 Start-time format invalid (not HHMM E008 MED 1 Start-time field not numeric Severity: LOW=format MED=data HIGH=critical Rules: R1A/E001 R1B/E002 R2A/E003 R2B/E004 R3A/E005 R3B/E006 R4A/E007 R4B/E008 Input : file-in.dat Output: file-out-good.dat Output: file-out-bad.dat Output: error-report.dat Output: audit-report.dat === END AUDIT LOG === \ No newline at end of file diff --git a/benchmark-programs/13-validation-nodup/error-report.dat b/benchmark-programs/13-validation-nodup/error-report.dat new file mode 100644 index 0000000..59ebff3 --- /dev/null +++ b/benchmark-programs/13-validation-nodup/error-report.dat @@ -0,0 +1 @@ +Error Deta Run: 2026- Rec-ID Fi G000000001 IN-FIELD2 E003 Caller number length not 10-15 chars MED G000000001 IN-FIELD2 E004 Caller number leading chars not numeric MED G000000001 IN-START-TIME E008 Start-time field not numeric MED --- End of *** ERROR Batch: 202 Records re Records go Records ba Valid (no Invalid (w Total proc Hash durat --- Error E001 HIGH E002 LOW E003 MED E004 MED E005 HIGH E006 HIGH E007 MED E008 MED *** END OF \ No newline at end of file diff --git a/benchmark-programs/13-validation-nodup/file-out-bad.dat b/benchmark-programs/13-validation-nodup/file-out-bad.dat new file mode 100644 index 0000000..f5ec610 --- /dev/null +++ b/benchmark-programs/13-validation-nodup/file-out-bad.dat @@ -0,0 +1 @@ +AB00000000000000000000000000001C00000000000001D0000000000000100101E00001F0000001G000000001E003MED \ No newline at end of file diff --git a/benchmark-programs/13-validation-nodup/file-out-good.dat b/benchmark-programs/13-validation-nodup/file-out-good.dat new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/13-validation-nodup/main-13-validation-nodup.cbl b/benchmark-programs/13-validation-nodup/main-13-validation-nodup.cbl new file mode 100644 index 0000000..ff268d0 --- /dev/null +++ b/benchmark-programs/13-validation-nodup/main-13-validation-nodup.cbl @@ -0,0 +1,933 @@ +>>SOURCE FORMAT IS FREE + *> ============================================================ + *> 13-validation-nodup : CDR字段校验 (CDR Field Validation) + *> Expanded with SECTION structure, comprehensive field-by-field + *> CDR validation, error accumulation, error detail report, + *> audit summary, batch control totals, hash totals, + *> FILE STATUS checks after every I/O, DISPLAY tracing with + *> timestamps, and error severity levels. + *> Input : FILE-IN (file-in.dat: CDR记录, 90 bytes) + *> Output: FILE-OUT-GOOD (file-out-good.dat: 校验通过) + *> FILE-OUT-BAD (file-out-bad.dat: 校验失败) + *> ERROR-REPORT (error-report.dat: 错误明细) + *> AUDIT-FILE (audit-report.dat: 审计摘要) + *> Coverage: VF-N001, VF-N002, VF-R001, VF-N007, VF-N008 + *> VF-A003, VF-A004, VF-P004, VF-L002, VF-S002 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. ValidationNodup. + *> + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN ASSIGN TO 'file-in.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-FILE-IN-STATUS. + SELECT FILE-OUT-GOOD ASSIGN TO 'file-out-good.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FILE-GOOD-STATUS. + SELECT FILE-OUT-BAD ASSIGN TO 'file-out-bad.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FILE-BAD-STATUS. + SELECT ERROR-REPORT ASSIGN TO 'error-report.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-ERR-RPT-STATUS. + SELECT AUDIT-FILE ASSIGN TO 'audit-report.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-AUDIT-STATUS. + *> + DATA DIVISION. + FILE SECTION. + FD FILE-IN. + 01 IN-REC. + *> Original fields (backward compatible, 31 bytes) + 05 IN-FIELD1 PIC X(01). + 05 IN-FIELD2 PIC X(30). + *> Extended CDR fields (additional 59 bytes = 90 total) + 05 IN-CALLER-NUM PIC X(15). + 05 IN-CALLEE-NUM PIC X(15). + 05 IN-DURATION PIC 9(05). + 05 IN-START-TIME PIC X(06). + 05 IN-START-DATE PIC X(08). + 05 IN-RECORD-ID PIC X(10). + *> + FD FILE-OUT-GOOD. + 01 GOOD-REC. + 05 GOOD-FIELD1 PIC X(01). + 05 GOOD-FIELD2 PIC X(30). + 05 GOOD-CALLER-NUM PIC X(15). + 05 GOOD-CALLEE-NUM PIC X(15). + 05 GOOD-DURATION PIC 9(05). + 05 GOOD-START-TIME PIC X(06). + 05 GOOD-START-DATE PIC X(08). + 05 GOOD-RECORD-ID PIC X(10). + *> + FD FILE-OUT-BAD. + 01 BAD-REC. + 05 BAD-FIELD1 PIC X(01). + 05 BAD-FIELD2 PIC X(30). + 05 BAD-CALLER-NUM PIC X(15). + 05 BAD-CALLEE-NUM PIC X(15). + 05 BAD-DURATION PIC 9(05). + 05 BAD-START-TIME PIC X(06). + 05 BAD-START-DATE PIC X(08). + 05 BAD-RECORD-ID PIC X(10). + 05 BAD-ERR-CODE PIC X(04). + 05 BAD-SEVERITY PIC X(06). + *> + FD ERROR-REPORT. + 01 ERR-RPT-REC. + 05 ERR-RPT-RECORD-ID PIC X(10). + 05 ERR-RPT-SEP1 PIC X(01) VALUE SPACE. + 05 ERR-RPT-FIELD-NAME PIC X(15). + 05 ERR-RPT-SEP2 PIC X(01) VALUE SPACE. + 05 ERR-RPT-ERR-CODE PIC X(04). + 05 ERR-RPT-SEP3 PIC X(01) VALUE SPACE. + 05 ERR-RPT-ERR-DESC PIC X(40). + 05 ERR-RPT-SEP4 PIC X(01) VALUE SPACE. + 05 ERR-RPT-SEVERITY PIC X(06). + *> + FD AUDIT-FILE. + 01 AUDIT-REC PIC X(80). + *> + WORKING-STORAGE SECTION. + 01 WS-TELECOM-REC. + COPY "telecom/TEL-BILLING.cpy". + *> File status fields + 01 WS-FILE-IN-STATUS PIC X(02). + 01 WS-FILE-GOOD-STATUS PIC X(02). + 01 WS-FILE-BAD-STATUS PIC X(02). + 01 WS-ERR-RPT-STATUS PIC X(02). + 01 WS-AUDIT-STATUS PIC X(02). + *> Flags and indicators + 01 WS-EOF PIC X(01) VALUE 'N'. + 88 WS-EOF-YES VALUE 'Y' FALSE 'N'. + 01 WS-REC-IS-VALID PIC X(01) VALUE 'Y'. + 88 WS-REC-IS-VALID-YES VALUE 'Y' FALSE 'N'. + 88 WS-REC-IS-VALID-NO VALUE 'N'. + 01 WS-VALID-FOUND PIC X(01) VALUE 'N'. + 88 WS-VALID-FOUND-YES VALUE 'Y' FALSE 'N'. + 01 WS-NUM-OK PIC X(01) VALUE 'Y'. + 88 WS-NUM-OK-YES VALUE 'Y' FALSE 'N'. + 88 WS-NUM-OK-NO VALUE 'N'. + *> Record counts + 01 WS-TOTAL-READ PIC 9(05) VALUE ZERO. + 01 WS-GOOD-COUNT PIC 9(05) VALUE ZERO. + 01 WS-BAD-COUNT PIC 9(05) VALUE ZERO. + 01 WS-PROCESSED-COUNT PIC 9(05) VALUE ZERO. + 01 WS-VALID-COUNT PIC 9(05) VALUE ZERO. + 01 WS-INVALID-COUNT PIC 9(05) VALUE ZERO. + 01 WS-TRACE-COUNT PIC 9(05) VALUE ZERO. + 01 WS-RECORD-ID-NUM PIC 9(05) VALUE ZERO. + *> Allowed values table for call type (original logic) + 01 WS-ALLOWED-VALUES. + 05 WS-ALLOWED-CHAR PIC X(01) OCCURS 5 TIMES. + 01 WS-IDX PIC 9(02). + 01 WS-J PIC 9(02). + *> Error code definitions (8 error types E001-E008) + 01 WS-ERR-DEF-TABLE. + 05 WS-ERR-DEF-ENTRY OCCURS 8 TIMES. + 10 WS-ED-CODE PIC X(04). + 10 WS-ED-DESC PIC X(40). + 10 WS-ED-SEVERITY PIC X(06). + 10 WS-ED-COUNT PIC 9(05) VALUE ZERO. + 01 WS-ERR-DEF-COUNT PIC 9(02) VALUE 8. + 01 WS-ED-IDX PIC 9(02). + *> Per-record error accumulation table (max 10 errors) + 01 WS-REC-ERROR-TABLE. + 05 WS-REC-ERR OCCURS 10 TIMES. + 10 WS-RE-FIELD PIC X(15). + 10 WS-RE-CODE PIC X(04). + 10 WS-RE-DESC PIC X(40). + 10 WS-RE-SEVERITY PIC X(06). + 01 WS-REC-ERR-COUNT PIC 9(02) VALUE ZERO. + 01 WS-REC-ERR-IDX PIC 9(02). + *> Hash totals for data integrity + 01 WS-HASH-DURATION PIC 9(12) VALUE ZERO. + 01 WS-HASH-CALLER-CHARS PIC 9(12) VALUE ZERO. + 01 WS-CHAR-VAL PIC 9(03). + *> Batch control totals + 01 WS-CONTROL-TOTAL-REC PIC 9(05) VALUE ZERO. + 01 WS-CONTROL-TOTAL-GOOD PIC 9(05) VALUE ZERO. + 01 WS-CONTROL-TOTAL-BAD PIC 9(05) VALUE ZERO. + 01 WS-BATCH-HASH-DUR PIC 9(12) VALUE ZERO. + *> Timestamp fields for DISPLAY tracing + 01 WS-CURRENT-TIME. + 05 WS-CURR-YEAR PIC X(04). + 05 WS-CURR-MONTH PIC X(02). + 05 WS-CURR-DAY PIC X(02). + 05 WS-CURR-HOUR PIC X(02). + 05 WS-CURR-MIN PIC X(02). + 05 WS-CURR-SEC PIC X(02). + 01 WS-TIMESTAMP PIC X(20). + 01 WS-TRACE-TS PIC X(20). + *> Work fields for duration validation + 01 WS-DURATION-NUM PIC 9(05). + 01 WS-DURATION-DISP PIC Z(04)9. + 01 WS-DURATION-STR PIC X(05). + 01 WS-DURATION-CHR PIC X(01). + *> Work fields for caller number (IN-FIELD2) validation + 01 WS-CALLER-TEXT PIC X(30). + 01 WS-CALLER-LEN PIC 9(02). + 01 WS-CALLER-TRAIL-SP PIC 9(02). + 01 WS-CALLER-CHK-IDX PIC 9(02). + 01 WS-CALLER-CHR PIC X(01). + *> Work fields for start-time validation + 01 WS-START-TIME-STR PIC X(06). + 01 WS-TIME-HH PIC 9(02). + 01 WS-TIME-MM PIC 9(02). + 01 WS-TIME-SS PIC 9(02). + 01 WS-TIME-CHR PIC X(01). + *> Numeric check work fields + 01 WS-NUM-CHR PIC X(01). + 01 WS-NUM-IDX PIC 9(02). + *> Report and audit formatting fields + 01 WS-ED-TOTAL PIC Z(09)9. + 01 WS-ED-GOOD PIC Z(09)9. + 01 WS-ED-BAD PIC Z(09)9. + 01 WS-ED-VALID PIC Z(09)9. + 01 WS-ED-INVALID PIC Z(09)9. + 01 WS-ED-HASH PIC Z(14)9. + 01 WS-ED-ERR-COUNT PIC Z(09)9. + *> Error severity + 01 WS-SEVERITY PIC X(01). + 88 WS-SEV-WARNING VALUE 'W'. + 88 WS-SEV-ERROR VALUE 'E'. + 88 WS-SEV-FATAL VALUE 'F'. + 01 WS-RETURN-CODE PIC 9(02) VALUE ZERO. + *> + PROCEDURE DIVISION. + MAIN SECTION. + MB-PROCESS. + PERFORM 1000-INIT + PERFORM 2000-OPEN-FILES + PERFORM 3000-READ-INPUT UNTIL WS-EOF-YES + PERFORM 4000-REPORT + PERFORM 5000-AUDIT + PERFORM 6000-ERROR-HANDLE + PERFORM 9000-EXIT + STOP RUN. + *> + *> ============================================================ + *> 1000-INIT : Initialize counters, tables, and batch header + *> ============================================================ + 1000-INIT SECTION. + I1000-START. + DISPLAY 'ValidationNodup: 1000-INIT starting...'. + *> Fill allowed-values table (original logic) + MOVE 'A' TO WS-ALLOWED-CHAR(1). + MOVE 'B' TO WS-ALLOWED-CHAR(2). + MOVE 'C' TO WS-ALLOWED-CHAR(3). + MOVE 'D' TO WS-ALLOWED-CHAR(4). + MOVE 'E' TO WS-ALLOWED-CHAR(5). + *> Initialize counters + MOVE ZERO TO WS-TOTAL-READ WS-GOOD-COUNT WS-BAD-COUNT + WS-PROCESSED-COUNT WS-VALID-COUNT + WS-INVALID-COUNT WS-TRACE-COUNT + WS-RECORD-ID-NUM. + *> Initialize hash and control totals + MOVE ZERO TO WS-HASH-DURATION WS-HASH-CALLER-CHARS + WS-CONTROL-TOTAL-REC WS-CONTROL-TOTAL-GOOD + WS-CONTROL-TOTAL-BAD WS-BATCH-HASH-DUR. + MOVE 'N' TO WS-EOF. + *> Populate error code definitions (8 error types) + MOVE 'E001' TO WS-ED-CODE(1). + MOVE 'Invalid call type - not in A/B/C/D/E' + TO WS-ED-DESC(1). + MOVE 'HIGH' TO WS-ED-SEVERITY(1). + MOVE 'E002' TO WS-ED-CODE(2). + MOVE 'Call type not uppercase' TO WS-ED-DESC(2). + MOVE 'LOW' TO WS-ED-SEVERITY(2). + MOVE 'E003' TO WS-ED-CODE(3). + MOVE 'Caller number length not 10-15 chars' + TO WS-ED-DESC(3). + MOVE 'MED' TO WS-ED-SEVERITY(3). + MOVE 'E004' TO WS-ED-CODE(4). + MOVE 'Caller number leading chars not numeric' + TO WS-ED-DESC(4). + MOVE 'MED' TO WS-ED-SEVERITY(4). + MOVE 'E005' TO WS-ED-CODE(5). + MOVE 'Duration out of valid range 0-99999' + TO WS-ED-DESC(5). + MOVE 'HIGH' TO WS-ED-SEVERITY(5). + MOVE 'E006' TO WS-ED-CODE(6). + MOVE 'Duration field not numeric' TO WS-ED-DESC(6). + MOVE 'HIGH' TO WS-ED-SEVERITY(6). + MOVE 'E007' TO WS-ED-CODE(7). + MOVE 'Start-time format invalid (not HHMMSS)' + TO WS-ED-DESC(7). + MOVE 'MED' TO WS-ED-SEVERITY(7). + MOVE 'E008' TO WS-ED-CODE(8). + MOVE 'Start-time field not numeric' TO WS-ED-DESC(8). + MOVE 'MED' TO WS-ED-SEVERITY(8). + *> Capture batch start timestamp + MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-TIME. + STRING WS-CURR-YEAR '-' WS-CURR-MONTH '-' + WS-CURR-DAY ' ' WS-CURR-HOUR ':' + WS-CURR-MIN ':' WS-CURR-SEC INTO WS-TIMESTAMP. + DISPLAY 'ValidationNodup: Batch started at ' WS-TIMESTAMP. + DISPLAY 'ValidationNodup: 8 error definitions loaded'. + EXIT SECTION. + *> + *> ============================================================ + *> 2000-OPEN-FILES : Open all 5 files with FILE STATUS checks + *> ============================================================ + 2000-OPEN-FILES SECTION. + I2000-START. + DISPLAY 'ValidationNodup: 2000-OPEN-FILES...'. + OPEN INPUT FILE-IN. + IF WS-FILE-IN-STATUS NOT = '00' + DISPLAY 'ERROR: Cannot open FILE-IN, status: ' + WS-FILE-IN-STATUS + MOVE 1 TO RETURN-CODE STOP RUN END-IF. + DISPLAY ' FILE-IN opened status=' WS-FILE-IN-STATUS. + OPEN OUTPUT FILE-OUT-GOOD. + IF WS-FILE-GOOD-STATUS NOT = '00' + DISPLAY 'ERROR: Cannot open FILE-OUT-GOOD, status: ' + WS-FILE-GOOD-STATUS + MOVE 1 TO RETURN-CODE STOP RUN END-IF. + DISPLAY ' FILE-OUT-GOOD opened status=' WS-FILE-GOOD-STATUS. + OPEN OUTPUT FILE-OUT-BAD. + IF WS-FILE-BAD-STATUS NOT = '00' + DISPLAY 'ERROR: Cannot open FILE-OUT-BAD, status: ' + WS-FILE-BAD-STATUS + MOVE 1 TO RETURN-CODE STOP RUN END-IF. + DISPLAY ' FILE-OUT-BAD opened status=' WS-FILE-BAD-STATUS. + OPEN OUTPUT ERROR-REPORT. + IF WS-ERR-RPT-STATUS NOT = '00' + DISPLAY 'ERROR: Cannot open ERROR-REPORT, status: ' + WS-ERR-RPT-STATUS + MOVE 1 TO RETURN-CODE STOP RUN END-IF. + DISPLAY ' ERROR-REPORT opened status=' WS-ERR-RPT-STATUS. + OPEN OUTPUT AUDIT-FILE. + IF WS-AUDIT-STATUS NOT = '00' + DISPLAY 'ERROR: Cannot open AUDIT-FILE, status: ' + WS-AUDIT-STATUS + MOVE 1 TO RETURN-CODE STOP RUN END-IF. + DISPLAY ' AUDIT-FILE opened status=' WS-AUDIT-STATUS. + *> Write report and audit headers + MOVE SPACES TO ERR-RPT-REC. + STRING 'Error Detail Report - ValidationNodup' + INTO ERR-RPT-RECORD-ID. + WRITE ERR-RPT-REC. + IF WS-ERR-RPT-STATUS NOT = '00' + DISPLAY 'ERROR: Write ERR-RPT header status=' + WS-ERR-RPT-STATUS END-IF. + MOVE SPACES TO ERR-RPT-REC. + STRING 'Run: ' WS-TIMESTAMP INTO ERR-RPT-RECORD-ID. + WRITE ERR-RPT-REC. + MOVE SPACES TO ERR-RPT-REC. + STRING 'Rec-ID Field Code Description' + INTO ERR-RPT-RECORD-ID. + WRITE ERR-RPT-REC. + MOVE SPACES TO ERR-RPT-REC. WRITE ERR-RPT-REC. + *> + MOVE SPACES TO AUDIT-REC. + STRING 'Audit Report - ValidationNodup' INTO AUDIT-REC. + WRITE AUDIT-REC. + IF WS-AUDIT-STATUS NOT = '00' + DISPLAY 'ERROR: Write AUDIT header status=' + WS-AUDIT-STATUS END-IF. + MOVE SPACES TO AUDIT-REC. + STRING 'Run: ' WS-TIMESTAMP INTO AUDIT-REC. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-REC. WRITE AUDIT-REC. + DISPLAY 'ValidationNodup: All files opened OK'. + EXIT SECTION. + *> + *> ============================================================ + *> 3000-READ-INPUT : Read loop — read record and dispatch + *> ============================================================ + 3000-READ-INPUT SECTION. + I3000-START. + READ FILE-IN + AT END SET WS-EOF-YES TO TRUE + DISPLAY '3000-READ-INPUT: EOF total read=' + WS-TOTAL-READ + NOT AT END + ADD 1 TO WS-TOTAL-READ + ADD 1 TO WS-RECORD-ID-NUM + ADD 1 TO WS-TRACE-COUNT + *> Periodic tracing every 50 records + IF WS-TRACE-COUNT >= 50 + MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-TIME + STRING WS-CURR-HOUR ':' WS-CURR-MIN ':' + WS-CURR-SEC INTO WS-TRACE-TS + DISPLAY '3000-READ-INPUT: [' WS-TRACE-TS + '] #' WS-TOTAL-READ + ' F1="' IN-FIELD1 '"' + MOVE ZERO TO WS-TRACE-COUNT + END-IF + IF WS-FILE-IN-STATUS NOT = '00' + DISPLAY '3000-READ-INPUT: READ status=' + WS-FILE-IN-STATUS + END-IF + PERFORM 3100-VALIDATE-RECORD + PERFORM 3200-PROCESS-RECORD + END-READ. + EXIT SECTION. + *> + *> ============================================================ + *> 3100-VALIDATE-RECORD : Field-by-field CDR validation + *> R1A/E001 IN-FIELD1 allowed values A-E + *> R1B/E002 IN-FIELD1 uppercase check + *> R2A/E003 IN-FIELD2 caller length 10-15 + *> R2B/E004 IN-FIELD2 leading digit numeric + *> R3A/E005 IN-DURATION range 0-99999 + *> R3B/E006 IN-DURATION numeric check + *> R4A/E007 IN-START-TIME HHMMSS format + *> R4B/E008 IN-START-TIME numeric check + *> Errors accumulated into WS-REC-ERROR-TABLE + *> ============================================================ + 3100-VALIDATE-RECORD SECTION. + I3100-START. + MOVE ZERO TO WS-REC-ERR-COUNT. + MOVE SPACES TO WS-REC-ERROR-TABLE. + MOVE 'Y' TO WS-REC-IS-VALID. + MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-TIME. + STRING WS-CURR-HOUR ':' WS-CURR-MIN ':' + WS-CURR-SEC INTO WS-TRACE-TS. + DISPLAY '3100-VALIDATE: [' WS-TRACE-TS '] #' + WS-TOTAL-READ ' F1="' IN-FIELD1 '"'. + *> ---- Rule 1A: IN-FIELD1 allowed values check (original) ---- + MOVE 'N' TO WS-VALID-FOUND. + PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > 5 + IF IN-FIELD1 = WS-ALLOWED-CHAR(WS-IDX) + SET WS-VALID-FOUND-YES TO TRUE END-IF + END-PERFORM. + IF NOT WS-VALID-FOUND-YES + ADD 1 TO WS-REC-ERR-COUNT + MOVE 'IN-FIELD1' TO WS-RE-FIELD(WS-REC-ERR-COUNT) + MOVE 'E001' TO WS-RE-CODE(WS-REC-ERR-COUNT) + MOVE 'Invalid call type - not in A/B/C/D/E' + TO WS-RE-DESC(WS-REC-ERR-COUNT) + MOVE 'HIGH' TO WS-RE-SEVERITY(WS-REC-ERR-COUNT) + MOVE 'N' TO WS-REC-IS-VALID + DISPLAY '3100-VALIDATE: E001 F1="' IN-FIELD1 '"' END-IF. + *> ---- Rule 1B: IN-FIELD1 uppercase check ---- + IF IN-FIELD1 NOT >= 'A' OR IN-FIELD1 NOT <= 'Z' + IF WS-REC-ERR-COUNT < 10 + ADD 1 TO WS-REC-ERR-COUNT + MOVE 'IN-FIELD1' TO WS-RE-FIELD(WS-REC-ERR-COUNT) + MOVE 'E002' TO WS-RE-CODE(WS-REC-ERR-COUNT) + MOVE 'Call type not uppercase' + TO WS-RE-DESC(WS-REC-ERR-COUNT) + MOVE 'LOW' TO WS-RE-SEVERITY(WS-REC-ERR-COUNT) + DISPLAY '3100-VALIDATE: E002 F1 not upper' END-IF + END-IF. + *> ---- Rule 2A: IN-FIELD2 caller length 10-15 ---- + MOVE IN-FIELD2 TO WS-CALLER-TEXT. + MOVE ZERO TO WS-CALLER-TRAIL-SP. + INSPECT FUNCTION REVERSE(WS-CALLER-TEXT) + TALLYING WS-CALLER-TRAIL-SP FOR LEADING SPACES. + COMPUTE WS-CALLER-LEN = 30 - WS-CALLER-TRAIL-SP. + IF WS-CALLER-LEN < 10 OR WS-CALLER-LEN > 15 + IF WS-REC-ERR-COUNT < 10 + ADD 1 TO WS-REC-ERR-COUNT + MOVE 'IN-FIELD2' TO WS-RE-FIELD(WS-REC-ERR-COUNT) + MOVE 'E003' TO WS-RE-CODE(WS-REC-ERR-COUNT) + MOVE 'Caller number length not 10-15 chars' + TO WS-RE-DESC(WS-REC-ERR-COUNT) + MOVE 'MED' TO WS-RE-SEVERITY(WS-REC-ERR-COUNT) + MOVE 'N' TO WS-REC-IS-VALID + DISPLAY '3100-VALIDATE: E003 len=' WS-CALLER-LEN + END-IF END-IF. + *> ---- Rule 2B: IN-FIELD2 leading digits numeric ---- + IF WS-CALLER-LEN >= 5 MOVE 5 TO WS-CALLER-CHK-IDX + ELSE MOVE WS-CALLER-LEN TO WS-CALLER-CHK-IDX END-IF. + IF WS-CALLER-CHK-IDX > 0 + MOVE 'Y' TO WS-NUM-OK + PERFORM VARYING WS-IDX FROM 1 BY 1 + UNTIL WS-IDX > WS-CALLER-CHK-IDX + MOVE IN-FIELD2(WS-IDX:1) TO WS-CALLER-CHR + IF WS-CALLER-CHR < '0' OR WS-CALLER-CHR > '9' + MOVE 'N' TO WS-NUM-OK END-IF + END-PERFORM + IF WS-NUM-OK = 'N' + IF WS-REC-ERR-COUNT < 10 + ADD 1 TO WS-REC-ERR-COUNT + MOVE 'IN-FIELD2' + TO WS-RE-FIELD(WS-REC-ERR-COUNT) + MOVE 'E004' + TO WS-RE-CODE(WS-REC-ERR-COUNT) + MOVE 'Caller number leading chars not numeric' + TO WS-RE-DESC(WS-REC-ERR-COUNT) + MOVE 'MED' + TO WS-RE-SEVERITY(WS-REC-ERR-COUNT) + MOVE 'N' TO WS-REC-IS-VALID + DISPLAY '3100-VALIDATE: E004 lead not num' + END-IF END-IF END-IF. + *> ---- Rule 3A: IN-DURATION numeric check ---- + MOVE IN-DURATION TO WS-DURATION-STR. + MOVE 'Y' TO WS-NUM-OK. + PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > 5 + MOVE WS-DURATION-STR(WS-IDX:1) TO WS-NUM-CHR + IF WS-NUM-CHR < '0' OR WS-NUM-CHR > '9' + MOVE 'N' TO WS-NUM-OK END-IF + END-PERFORM. + IF WS-NUM-OK = 'N' + IF WS-REC-ERR-COUNT < 10 + ADD 1 TO WS-REC-ERR-COUNT + MOVE 'IN-DURATION' TO WS-RE-FIELD(WS-REC-ERR-COUNT) + MOVE 'E006' TO WS-RE-CODE(WS-REC-ERR-COUNT) + MOVE 'Duration field not numeric' + TO WS-RE-DESC(WS-REC-ERR-COUNT) + MOVE 'HIGH' TO WS-RE-SEVERITY(WS-REC-ERR-COUNT) + MOVE 'N' TO WS-REC-IS-VALID + DISPLAY '3100-VALIDATE: E006 dur non-num' + END-IF + END-IF. + *> ---- Rule 3B: IN-DURATION range 0-99999 ---- + IF WS-NUM-OK NOT = 'N' + MOVE IN-DURATION TO WS-DURATION-NUM + IF WS-DURATION-NUM < 0 OR WS-DURATION-NUM > 99999 + IF WS-REC-ERR-COUNT < 10 + ADD 1 TO WS-REC-ERR-COUNT + MOVE 'IN-DURATION' + TO WS-RE-FIELD(WS-REC-ERR-COUNT) + MOVE 'E005' + TO WS-RE-CODE(WS-REC-ERR-COUNT) + MOVE 'Duration out of valid range 0-99999' + TO WS-RE-DESC(WS-REC-ERR-COUNT) + MOVE 'HIGH' + TO WS-RE-SEVERITY(WS-REC-ERR-COUNT) + MOVE 'N' TO WS-REC-IS-VALID + DISPLAY '3100-VALIDATE: E005 dur=' + WS-DURATION-NUM + END-IF + END-IF + END-IF. + *> ---- Rule 4A: IN-START-TIME numeric check ---- + MOVE IN-START-TIME TO WS-START-TIME-STR. + MOVE 'Y' TO WS-NUM-OK. + PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > 6 + MOVE WS-START-TIME-STR(WS-IDX:1) TO WS-NUM-CHR + IF WS-NUM-CHR < '0' OR WS-NUM-CHR > '9' + MOVE 'N' TO WS-NUM-OK END-IF + END-PERFORM. + IF WS-NUM-OK = 'N' + IF WS-REC-ERR-COUNT < 10 + ADD 1 TO WS-REC-ERR-COUNT + MOVE 'IN-START-TIME' + TO WS-RE-FIELD(WS-REC-ERR-COUNT) + MOVE 'E008' + TO WS-RE-CODE(WS-REC-ERR-COUNT) + MOVE 'Start-time field not numeric' + TO WS-RE-DESC(WS-REC-ERR-COUNT) + MOVE 'MED' + TO WS-RE-SEVERITY(WS-REC-ERR-COUNT) + MOVE 'N' TO WS-REC-IS-VALID + DISPLAY '3100-VALIDATE: E008 time non-num' + END-IF + END-IF. + *> ---- Rule 4B: IN-START-TIME HHMMSS format ---- + IF WS-NUM-OK NOT = 'N' + MOVE IN-START-TIME TO WS-START-TIME-STR + MOVE WS-START-TIME-STR(1:2) TO WS-TIME-HH + MOVE WS-START-TIME-STR(3:2) TO WS-TIME-MM + MOVE WS-START-TIME-STR(5:2) TO WS-TIME-SS + IF WS-TIME-HH > 23 OR WS-TIME-MM > 59 + OR WS-TIME-SS > 59 + IF WS-REC-ERR-COUNT < 10 + ADD 1 TO WS-REC-ERR-COUNT + MOVE 'IN-START-TIME' + TO WS-RE-FIELD(WS-REC-ERR-COUNT) + MOVE 'E007' + TO WS-RE-CODE(WS-REC-ERR-COUNT) + MOVE 'Start-time format invalid (not HHMMSS)' + TO WS-RE-DESC(WS-REC-ERR-COUNT) + MOVE 'MED' + TO WS-RE-SEVERITY(WS-REC-ERR-COUNT) + MOVE 'N' TO WS-REC-IS-VALID + DISPLAY '3100-VALIDATE: E007 time HH=' + WS-TIME-HH ' MM=' WS-TIME-MM + ' SS=' WS-TIME-SS + END-IF + END-IF + END-IF. + *> Accumulate error counts into definitions table + PERFORM VARYING WS-REC-ERR-IDX FROM 1 BY 1 + UNTIL WS-REC-ERR-IDX > WS-REC-ERR-COUNT + PERFORM VARYING WS-ED-IDX FROM 1 BY 1 + UNTIL WS-ED-IDX > WS-ERR-DEF-COUNT + IF WS-RE-CODE(WS-REC-ERR-IDX) + = WS-ED-CODE(WS-ED-IDX) + ADD 1 TO WS-ED-COUNT(WS-ED-IDX) + END-IF + END-PERFORM + END-PERFORM. + DISPLAY '3100-VALIDATE: Done errors=' WS-REC-ERR-COUNT + ' valid=' WS-REC-IS-VALID. + EXIT SECTION. + *> + *> ============================================================ + *> 3200-PROCESS-RECORD : Route record and update totals + *> ============================================================ + 3200-PROCESS-RECORD SECTION. + I3200-START. + IF WS-REC-IS-VALID-YES + ADD 1 TO WS-GOOD-COUNT WS-VALID-COUNT + WS-CONTROL-TOTAL-GOOD + DISPLAY '3200: #' WS-TOTAL-READ ' -> GOOD' + ELSE + ADD 1 TO WS-BAD-COUNT WS-INVALID-COUNT + WS-CONTROL-TOTAL-BAD + DISPLAY '3200: #' WS-TOTAL-READ ' -> BAD errors=' + WS-REC-ERR-COUNT END-IF. + ADD 1 TO WS-PROCESSED-COUNT WS-CONTROL-TOTAL-REC. + *> Hash totals + MOVE IN-DURATION TO WS-DURATION-NUM. + ADD WS-DURATION-NUM TO WS-HASH-DURATION WS-BATCH-HASH-DUR. + MOVE IN-FIELD1 TO WS-CALLER-CHR. + COMPUTE WS-CHAR-VAL = FUNCTION ORD(WS-CALLER-CHR). + ADD WS-CHAR-VAL TO WS-HASH-CALLER-CHARS. + PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > 30 + MOVE IN-FIELD2(WS-IDX:1) TO WS-CALLER-CHR + IF WS-CALLER-CHR NOT = SPACE + COMPUTE WS-CHAR-VAL = FUNCTION ORD(WS-CALLER-CHR) + ADD WS-CHAR-VAL TO WS-HASH-CALLER-CHARS + END-IF + END-PERFORM. + PERFORM 3300-WRITE-OUTPUT. + EXIT SECTION. + *> + *> ============================================================ + *> 3300-WRITE-OUTPUT : Write records and error details + *> ============================================================ + 3300-WRITE-OUTPUT SECTION. + I3300-START. + MOVE IN-RECORD-ID TO ERR-RPT-RECORD-ID. + *> Write to GOOD file + IF WS-REC-IS-VALID-YES + MOVE IN-FIELD1 TO GOOD-FIELD1 + MOVE IN-FIELD2 TO GOOD-FIELD2 + MOVE IN-CALLER-NUM TO GOOD-CALLER-NUM + MOVE IN-CALLEE-NUM TO GOOD-CALLEE-NUM + MOVE IN-DURATION TO GOOD-DURATION + MOVE IN-START-TIME TO GOOD-START-TIME + MOVE IN-START-DATE TO GOOD-START-DATE + MOVE IN-RECORD-ID TO GOOD-RECORD-ID + WRITE GOOD-REC + IF WS-FILE-GOOD-STATUS NOT = '00' + DISPLAY '3300: WRITE GOOD failed status=' + WS-FILE-GOOD-STATUS END-IF + DISPLAY '3300: Wrote GOOD #' WS-TOTAL-READ + ELSE + *> Write to BAD file + MOVE IN-FIELD1 TO BAD-FIELD1 + MOVE IN-FIELD2 TO BAD-FIELD2 + MOVE IN-CALLER-NUM TO BAD-CALLER-NUM + MOVE IN-CALLEE-NUM TO BAD-CALLEE-NUM + MOVE IN-DURATION TO BAD-DURATION + MOVE IN-START-TIME TO BAD-START-TIME + MOVE IN-START-DATE TO BAD-START-DATE + MOVE IN-RECORD-ID TO BAD-RECORD-ID + IF WS-REC-ERR-COUNT > 0 + MOVE WS-RE-CODE(1) TO BAD-ERR-CODE + MOVE WS-RE-SEVERITY(1) TO BAD-SEVERITY + ELSE + MOVE 'E001' TO BAD-ERR-CODE + MOVE 'HIGH' TO BAD-SEVERITY END-IF + WRITE BAD-REC + IF WS-FILE-BAD-STATUS NOT = '00' + DISPLAY '3300: WRITE BAD failed status=' + WS-FILE-BAD-STATUS END-IF + DISPLAY '3300: Wrote BAD #' WS-TOTAL-READ + ' code=' BAD-ERR-CODE END-IF. + *> Write each error detail to ERROR-REPORT + PERFORM VARYING WS-REC-ERR-IDX FROM 1 BY 1 + UNTIL WS-REC-ERR-IDX > WS-REC-ERR-COUNT + MOVE IN-RECORD-ID TO ERR-RPT-RECORD-ID + MOVE WS-RE-FIELD(WS-REC-ERR-IDX) + TO ERR-RPT-FIELD-NAME + MOVE WS-RE-CODE(WS-REC-ERR-IDX) + TO ERR-RPT-ERR-CODE + MOVE WS-RE-DESC(WS-REC-ERR-IDX) + TO ERR-RPT-ERR-DESC + MOVE WS-RE-SEVERITY(WS-REC-ERR-IDX) + TO ERR-RPT-SEVERITY + WRITE ERR-RPT-REC + IF WS-ERR-RPT-STATUS NOT = '00' + DISPLAY '3300: WRITE ERR-RPT failed status=' + WS-ERR-RPT-STATUS END-IF + END-PERFORM. + EXIT SECTION. + *> + *> ============================================================ + *> 4000-REPORT : Finalize error report with summary counts + *> ============================================================ + 4000-REPORT SECTION. + I4000-START. + DISPLAY 'ValidationNodup: 4000-REPORT...'. + MOVE WS-TOTAL-READ TO WS-ED-TOTAL. + MOVE WS-GOOD-COUNT TO WS-ED-GOOD. + MOVE WS-BAD-COUNT TO WS-ED-BAD. + MOVE WS-VALID-COUNT TO WS-ED-VALID. + MOVE WS-INVALID-COUNT TO WS-ED-INVALID. + MOVE WS-HASH-DURATION TO WS-ED-HASH. + *> Summary header + MOVE SPACES TO ERR-RPT-REC. + STRING '--- End of Error Detail ---' + INTO ERR-RPT-RECORD-ID. + WRITE ERR-RPT-REC. + MOVE SPACES TO ERR-RPT-REC. + STRING '*** ERROR REPORT SUMMARY ***' + INTO ERR-RPT-RECORD-ID. + WRITE ERR-RPT-REC. + MOVE SPACES TO ERR-RPT-REC. + STRING 'Batch: ' WS-TIMESTAMP + INTO ERR-RPT-RECORD-ID. + WRITE ERR-RPT-REC. + MOVE SPACES TO ERR-RPT-REC. WRITE ERR-RPT-REC. + *> Record counts + MOVE SPACES TO ERR-RPT-REC. + STRING 'Records read :' WS-ED-TOTAL + INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. + MOVE SPACES TO ERR-RPT-REC. + STRING 'Records good :' WS-ED-GOOD + INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. + MOVE SPACES TO ERR-RPT-REC. + STRING 'Records bad :' WS-ED-BAD + INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. + MOVE SPACES TO ERR-RPT-REC. + STRING 'Valid (no errors) :' WS-ED-VALID + INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. + MOVE SPACES TO ERR-RPT-REC. + STRING 'Invalid (w/errors):' WS-ED-INVALID + INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. + MOVE WS-PROCESSED-COUNT TO WS-ED-TOTAL. + MOVE SPACES TO ERR-RPT-REC. + STRING 'Total processed :' WS-ED-TOTAL + INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. + *> Hash totals + MOVE SPACES TO ERR-RPT-REC. + STRING 'Hash duration :' WS-ED-HASH + INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. + MOVE SPACES TO ERR-RPT-REC. WRITE ERR-RPT-REC. + *> Error code breakdown + MOVE SPACES TO ERR-RPT-REC. + STRING '--- Error Code Breakdown ---' + INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. + PERFORM VARYING WS-ED-IDX FROM 1 BY 1 + UNTIL WS-ED-IDX > WS-ERR-DEF-COUNT + MOVE WS-ED-COUNT(WS-ED-IDX) TO WS-ED-ERR-COUNT + MOVE SPACES TO ERR-RPT-REC + STRING WS-ED-CODE(WS-ED-IDX) ' ' + WS-ED-SEVERITY(WS-ED-IDX) ' ' + WS-ED-ERR-COUNT ' ' + WS-ED-DESC(WS-ED-IDX)(1:30) + INTO ERR-RPT-RECORD-ID + WRITE ERR-RPT-REC + END-PERFORM. + MOVE SPACES TO ERR-RPT-REC. + STRING '*** END OF REPORT ***' + INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. + *> Close ERROR-REPORT + CLOSE ERROR-REPORT. + IF WS-ERR-RPT-STATUS NOT = '00' AND NOT = '10' + DISPLAY '4000: CLOSE ERROR-REPORT status=' + WS-ERR-RPT-STATUS + END-IF. + DISPLAY 'ValidationNodup: 4000-REPORT complete'. + EXIT SECTION. + *> + *> ============================================================ + *> 5000-AUDIT : Write audit summary with validation summary + *> ============================================================ + 5000-AUDIT SECTION. + I5000-START. + DISPLAY 'ValidationNodup: 5000-AUDIT...'. + MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-TIME. + STRING WS-CURR-YEAR '-' WS-CURR-MONTH '-' + WS-CURR-DAY ' ' WS-CURR-HOUR ':' + WS-CURR-MIN ':' WS-CURR-SEC INTO WS-TIMESTAMP. + *> Audit header + MOVE SPACES TO AUDIT-REC. + STRING '=== VALIDATION AUDIT LOG ===' INTO AUDIT-REC. + WRITE AUDIT-REC. + IF WS-AUDIT-STATUS NOT = '00' + DISPLAY '5000: WRITE AUDIT header status=' + WS-AUDIT-STATUS END-IF. + *> Program ID and timestamp + MOVE SPACES TO AUDIT-REC. + STRING 'Program: ValidationNodup' INTO AUDIT-REC. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-REC. + STRING 'Batch timestamp: ' WS-TIMESTAMP INTO AUDIT-REC. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-REC. WRITE AUDIT-REC. + *> Summary counts + MOVE WS-TOTAL-READ TO WS-ED-TOTAL. + MOVE WS-GOOD-COUNT TO WS-ED-GOOD. + MOVE WS-BAD-COUNT TO WS-ED-BAD. + MOVE WS-VALID-COUNT TO WS-ED-VALID. + MOVE WS-INVALID-COUNT TO WS-ED-INVALID. + MOVE SPACES TO AUDIT-REC. + STRING 'Records read :' WS-ED-TOTAL INTO AUDIT-REC. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-REC. + STRING 'Records good :' WS-ED-GOOD INTO AUDIT-REC. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-REC. + STRING 'Records bad :' WS-ED-BAD INTO AUDIT-REC. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-REC. + STRING 'Valid (no err) :' WS-ED-VALID INTO AUDIT-REC. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-REC. + STRING 'Invalid (error):' WS-ED-INVALID INTO AUDIT-REC. + WRITE AUDIT-REC. + *> Control totals + MOVE SPACES TO AUDIT-REC. + STRING 'Control recs :' WS-CONTROL-TOTAL-REC + INTO AUDIT-REC. WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-REC. + STRING 'Control good :' WS-CONTROL-TOTAL-GOOD + INTO AUDIT-REC. WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-REC. + STRING 'Control bad :' WS-CONTROL-TOTAL-BAD + INTO AUDIT-REC. WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-REC. WRITE AUDIT-REC. + *> Hash totals (data integrity) + MOVE WS-HASH-DURATION TO WS-ED-HASH. + MOVE SPACES TO AUDIT-REC. + STRING 'Hash duration :' WS-ED-HASH INTO AUDIT-REC. + WRITE AUDIT-REC. + MOVE WS-HASH-CALLER-CHARS TO WS-ED-HASH. + MOVE SPACES TO AUDIT-REC. + STRING 'Hash caller :' WS-ED-HASH INTO AUDIT-REC. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-REC. WRITE AUDIT-REC. + *> Error code count breakdown + MOVE SPACES TO AUDIT-REC. + STRING '--- Error Counts by Code ---' INTO AUDIT-REC. + WRITE AUDIT-REC. + PERFORM VARYING WS-ED-IDX FROM 1 BY 1 + UNTIL WS-ED-IDX > WS-ERR-DEF-COUNT + MOVE WS-ED-COUNT(WS-ED-IDX) TO WS-ED-ERR-COUNT + MOVE SPACES TO AUDIT-REC + STRING WS-ED-CODE(WS-ED-IDX) ' ' + WS-ED-SEVERITY(WS-ED-IDX) ' ' + WS-ED-ERR-COUNT ' ' + WS-ED-DESC(WS-ED-IDX)(1:35) + INTO AUDIT-REC + WRITE AUDIT-REC + END-PERFORM. + MOVE SPACES TO AUDIT-REC. WRITE AUDIT-REC. + *> Severity legend and validation rules + MOVE SPACES TO AUDIT-REC. + STRING 'Severity: LOW=format MED=data HIGH=critical' + INTO AUDIT-REC. WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-REC. + STRING 'Rules: R1A/E001 R1B/E002 R2A/E003 R2B/E004' + INTO AUDIT-REC. WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-REC. + STRING ' R3A/E005 R3B/E006 R4A/E007 R4B/E008' + INTO AUDIT-REC. WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-REC. WRITE AUDIT-REC. + *> File list + MOVE SPACES TO AUDIT-REC. + STRING 'Input : file-in.dat' INTO AUDIT-REC. WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-REC. + STRING 'Output: file-out-good.dat' INTO AUDIT-REC. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-REC. + STRING 'Output: file-out-bad.dat' INTO AUDIT-REC. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-REC. + STRING 'Output: error-report.dat' INTO AUDIT-REC. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-REC. + STRING 'Output: audit-report.dat' INTO AUDIT-REC. + WRITE AUDIT-REC. + *> Audit footer + MOVE SPACES TO AUDIT-REC. + STRING '=== END AUDIT LOG ===' INTO AUDIT-REC. + WRITE AUDIT-REC. + *> Close AUDIT-FILE + CLOSE AUDIT-FILE. + IF WS-AUDIT-STATUS NOT = '00' AND NOT = '10' + DISPLAY '5000: CLOSE AUDIT-FILE status=' + WS-AUDIT-STATUS END-IF. + DISPLAY 'ValidationNodup: 5000-AUDIT complete'. + EXIT SECTION. + *> + *> ============================================================ + *> 6000-ERROR-HANDLE : Final error handler + *> ============================================================ + 6000-ERROR-HANDLE SECTION. + I6000-START. + DISPLAY 'ValidationNodup: 6000-ERROR-HANDLE...'. + IF WS-FILE-IN-STATUS NOT = '00' AND NOT = '10' + DISPLAY ' FILE-IN status=' WS-FILE-IN-STATUS END-IF. + IF WS-FILE-GOOD-STATUS NOT = '00' AND NOT = '10' + DISPLAY ' FILE-OUT-GOOD status=' WS-FILE-GOOD-STATUS + END-IF. + IF WS-FILE-BAD-STATUS NOT = '00' AND NOT = '10' + DISPLAY ' FILE-OUT-BAD status=' WS-FILE-BAD-STATUS + END-IF. + DISPLAY 'ValidationNodup: 6000 complete'. + EXIT SECTION. + *> + *> ============================================================ + *> 9000-EXIT : Close files, display final summary, stop + *> ============================================================ + 9000-EXIT SECTION. + I9000-START. + DISPLAY 'ValidationNodup: 9000-EXIT...'. + CLOSE FILE-IN. + IF WS-FILE-IN-STATUS NOT = '00' AND NOT = '10' + DISPLAY ' CLOSE FILE-IN status=' WS-FILE-IN-STATUS + ELSE DISPLAY ' FILE-IN closed status=' + WS-FILE-IN-STATUS END-IF. + CLOSE FILE-OUT-GOOD. + IF WS-FILE-GOOD-STATUS NOT = '00' AND NOT = '10' + DISPLAY ' CLOSE GOOD status=' WS-FILE-GOOD-STATUS + ELSE DISPLAY ' FILE-OUT-GOOD closed status=' + WS-FILE-GOOD-STATUS END-IF. + CLOSE FILE-OUT-BAD. + IF WS-FILE-BAD-STATUS NOT = '00' AND NOT = '10' + DISPLAY ' CLOSE BAD status=' WS-FILE-BAD-STATUS + ELSE DISPLAY ' FILE-OUT-BAD closed status=' + WS-FILE-BAD-STATUS END-IF. + *> Final timestamp + MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-TIME. + STRING WS-CURR-YEAR '-' WS-CURR-MONTH '-' + WS-CURR-DAY ' ' WS-CURR-HOUR ':' + WS-CURR-MIN ':' WS-CURR-SEC INTO WS-TIMESTAMP. + *> Edited counters + MOVE WS-TOTAL-READ TO WS-ED-TOTAL. + MOVE WS-GOOD-COUNT TO WS-ED-GOOD. + MOVE WS-BAD-COUNT TO WS-ED-BAD. + MOVE WS-VALID-COUNT TO WS-ED-VALID. + MOVE WS-INVALID-COUNT TO WS-ED-INVALID. + MOVE WS-HASH-DURATION TO WS-ED-HASH. + *> Display final summary + DISPLAY ' ' + DISPLAY '========================================'. + DISPLAY 'ValidationNodup: FINAL SUMMARY'. + DISPLAY 'End: ' WS-TIMESTAMP. + DISPLAY 'Records read : ' WS-ED-TOTAL. + DISPLAY 'Records good (valid): ' WS-ED-GOOD. + DISPLAY 'Records bad (invalid): ' WS-ED-BAD. + DISPLAY 'Valid (no errors) : ' WS-ED-VALID. + DISPLAY 'Invalid (w/errors) : ' WS-ED-INVALID. + DISPLAY 'Hash duration total : ' WS-ED-HASH. + DISPLAY 'Error breakdown:' + PERFORM VARYING WS-ED-IDX FROM 1 BY 1 + UNTIL WS-ED-IDX > WS-ERR-DEF-COUNT + MOVE WS-ED-COUNT(WS-ED-IDX) TO WS-ED-ERR-COUNT + DISPLAY ' ' WS-ED-CODE(WS-ED-IDX) ' ' + WS-ED-SEVERITY(WS-ED-IDX) ' ' + WS-ED-ERR-COUNT ' ' + WS-ED-DESC(WS-ED-IDX)(1:30) + END-PERFORM. + DISPLAY 'Error report : error-report.dat'. + DISPLAY 'Audit report : audit-report.dat'. + DISPLAY '========================================'. + MOVE WS-RETURN-CODE TO RETURN-CODE. + DISPLAY 'ValidationNodup: Done. RC=' WS-RETURN-CODE. + STOP RUN. + *> + END PROGRAM ValidationNodup. diff --git a/benchmark-programs/14-online-cics/README.md b/benchmark-programs/14-online-cics/README.md new file mode 100644 index 0000000..47de6bc --- /dev/null +++ b/benchmark-programs/14-online-cics/README.md @@ -0,0 +1,25 @@ +# 14-online-cics — CICS Online Simulation + +## 电信业务场景 + +在线客户照会(CICS模拟)。通过CALL/LINKAGE机制模拟CICS在线交易，客户服务人员可通过屏幕查询客户基本信息。 + +## Purpose +Simulates CICS transaction processing patterns using CALL/LINKAGE instead of EXEC CICS. + +## Architecture +- **main-14-online-cics.cbl** — CICS simulation program (receives COMMAREA via CALL USING) +- **test-cics-driver.cbl** — Test driver that builds COMMAREAs and invokes the program + +## Test Coverage +1. **INQY (Inquiry)** — COMMAREA receive, MAP file read, result output +2. **UPDT (Update)** — Process update function +3. **DEL (Delete)** — Process delete function +4. **UNKNOWN function** — Error handling for unrecognized function codes + +## Key Techniques +- LINKAGE SECTION with CALL USING parameter passing +- COMMAREA simulation via 01-level structure +- MAPSEND/MAPRECV simulation via file I/O +- EVALUATE for function dispatch +- GOBACK to return to caller diff --git a/benchmark-programs/14-online-cics/main-14-online-cics.cbl b/benchmark-programs/14-online-cics/main-14-online-cics.cbl new file mode 100644 index 0000000..f448752 --- /dev/null +++ b/benchmark-programs/14-online-cics/main-14-online-cics.cbl @@ -0,0 +1,967 @@ + *> ============================================================ + *> 14-online-cics : 客户在线照会 (Online Inquiry) + *> Input : MAP-FILE (map-data.dat: 模拟CICS MAP入出力) + *> Output: OUTPUT-FILE (cics-output.txt: 照会结果出力) + *> TXN-AUDIT-FILE (txn-audit.log: 取引監査記録) + *> Coverage: OL-N001~N004, OL-A001, OL-R001 + *> MAP building, audit logging, response time, + *> error severity handling + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. Main14OnlineCics. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT MAP-FILE ASSIGN TO "map-data.dat" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-MAP-FILE-STATUS. + + SELECT OUTPUT-FILE ASSIGN TO "cics-output.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-OUT-FILE-STATUS. + + *> Additional files for expanded processing + SELECT TXN-AUDIT-FILE ASSIGN TO "txn-audit.log" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-AUD-FILE-STATUS. + + SELECT TXN-REPORT ASSIGN TO "txn-report.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-RPT-FILE-STATUS. + + DATA DIVISION. + FILE SECTION. + FD MAP-FILE. + 01 MAP-RECORD PIC X(80). + + FD OUTPUT-FILE. + 01 OUTPUT-LINE PIC X(80). + + FD TXN-AUDIT-FILE. + 01 AUDIT-RECORD PIC X(100). + + FD TXN-REPORT. + 01 REPORT-LINE PIC X(100). + + WORKING-STORAGE SECTION. + *> ===== PRESERVED ORIGINAL ITEMS ===== + 01 WS-TELECOM-REC. + COPY "telecom/TEL-INVOICE.cpy". + + *> Simulated COMMAREA structure + 01 WS-COMMAREA. + 05 WS-CA-USERID PIC X(08). + 05 WS-CA-FUNCTION PIC X(04). + 05 WS-CA-INPUT-DATA PIC X(40). + 05 WS-CA-RETURN-CODE PIC 9(02). + 05 WS-CA-MESSAGE PIC X(40). + + 01 WS-COUNTERS. + 05 WS-READS PIC 9(02) VALUE 0. + 05 WS-WRITES PIC 9(02) VALUE 0. + + 01 WS-MAP-LINE PIC X(80). + 01 WS-MAP-EOF PIC X(01) VALUE "N". + 88 MAP-EOF VALUE "Y". + + 01 WS-RESPONSE. + 05 WS-RESP-TEXT PIC X(60). + + 01 WS-INVOICE-REC. + COPY "telecom/TEL-INVOICE.cpy". + *> ===== END PRESERVED ORIGINAL ITEMS ===== + + *> ===== NEW ITEMS ===== + *> Timestamp tracing + 01 WS-TIMESTAMP. + 05 WS-TS-YEAR PIC 9(04). + 05 WS-TS-MONTH PIC 9(02). + 05 WS-TS-DAY PIC 9(02). + 05 WS-TS-HOUR PIC 9(02). + 05 WS-TS-MINUTE PIC 9(02). + 05 WS-TS-SECOND PIC 9(02). + 05 WS-TS-MS PIC 9(02). + 01 WS-TIMESTAMP-STR PIC X(26). + 01 WS-TRACE-PREFIX PIC X(40). + + *> File status fields (additional) + 01 WS-MAP-FILE-STATUS PIC X(02). + 01 WS-OUT-FILE-STATUS PIC X(02). + 01 WS-AUD-FILE-STATUS PIC X(02). + 01 WS-RPT-FILE-STATUS PIC X(02). + + *> Session state management + 01 WS-SESSION-STATE. + 05 WS-SESS-USERID PIC X(08). + 05 WS-SESS-STATUS PIC X(01). + 88 WS-SESS-ACTIVE VALUE 'A'. + 88 WS-SESS-LOCKED VALUE 'L'. + 88 WS-SESS-TERMINATED VALUE 'T'. + 05 WS-SESS-LOGIN-TIME PIC X(20). + 05 WS-SESS-TXN-COUNT PIC 9(04) VALUE ZERO. + 05 WS-SESS-LAST-FUNC PIC X(04). + 05 WS-SESS-ERRORS PIC 9(03) VALUE ZERO. + + *> Response time tracking + 01 WS-RESPONSE-TIME. + 05 WS-RT-START-M PIC 9(08). + 05 WS-RT-START-S PIC 9(08). + 05 WS-RT-END-M PIC 9(08). + 05 WS-RT-END-S PIC 9(08). + 05 WS-RT-ELAPSED PIC S9(08). + 05 WS-RT-DISP PIC Z(9)9. + + *> Map building fields (simulated CICS BMS) + 01 WS-MAP-BUILD. + 05 WS-MAP-MAPNAME PIC X(08). + 05 WS-MAP-TITLE PIC X(40). + 05 WS-MAP-BODY PIC X(80). + 05 WS-MAP-MSG-LINE PIC X(40). + 05 WS-MAP-CURSOR PIC 9(04). + 05 WS-MAP-ATTR PIC X(01). + 88 WS-MAP-PROT VALUE 'P'. + 88 WS-MAP-UNPROT VALUE 'U'. + 88 WS-MAP-BRIGHT VALUE 'B'. + 05 WS-MAP-FIELD-TABLE. + 10 WS-MAP-FLD OCCURS 5 TIMES. + 15 WS-MAP-FLD-NAME PIC X(10). + 15 WS-MAP-FLD-VALUE PIC X(20). + 15 WS-MAP-FLD-ATTR PIC X(01). + + *> Transaction history (in-memory log) + 01 WS-TXN-HISTORY. + 05 WS-TXN-COUNT PIC 9(02) VALUE ZERO. + 05 WS-TXN-TABLE. + 10 WS-TXN-ENTRY OCCURS 20 TIMES. + 15 WS-TXN-FUNC PIC X(04). + 15 WS-TXN-USER PIC X(08). + 15 WS-TXN-TIME PIC X(20). + 15 WS-TXN-RC PIC 9(02). + + *> Error severity and handling + 01 WS-ERR-SEVERITY PIC 9(01). + 88 WS-ERR-INFO VALUE 0. + 88 WS-ERR-WARN VALUE 1. + 88 WS-ERR-ERROR VALUE 2. + 88 WS-ERR-FATAL VALUE 3. + 01 WS-ERR-MSG PIC X(60). + 01 WS-ERR-COUNT PIC 9(04) VALUE ZERO. + 01 WS-ERR-RESP-CODE PIC X(04). + 01 WS-ERR-RESP-MSG PIC X(40). + + *> Hash totals + 01 WS-HASH-TOTAL. + 05 WS-HASH-TXN-COUNT PIC 9(09) VALUE ZERO. + 05 WS-HASH-FUNC-MAP PIC 9(09) VALUE ZERO. + 05 WS-HASH-FUNC-INQY PIC 9(09) VALUE ZERO. + 05 WS-HASH-FUNC-UPDT PIC 9(09) VALUE ZERO. + 05 WS-HASH-FUNC-DEL PIC 9(09) VALUE ZERO. + 05 WS-HASH-FUNC-ADDN PIC 9(09) VALUE ZERO. + 05 WS-HASH-FUNC-CANC PIC 9(09) VALUE ZERO. + 05 WS-HASH-FUNC-SUSP PIC 9(09) VALUE ZERO. + 05 WS-HASH-FUNC-BILL PIC 9(09) VALUE ZERO. + 05 WS-HASH-FUNC-DISP PIC 9(09) VALUE ZERO. + 05 WS-HASH-FUNC-OTHER PIC 9(09) VALUE ZERO. + 05 WS-HASH-ERROR-COUNT PIC 9(09) VALUE ZERO. + 05 WS-HASH-CHECKSUM PIC 9(15) VALUE ZERO. + + *> Audit fields + 01 WS-AUDIT-ENTRIES PIC 9(04) VALUE ZERO. + 01 WS-AUDIT-LINE PIC X(100). + + *> Report fields + 01 WS-RPT-DATE PIC X(10). + 01 WS-RPT-TIME PIC X(08). + + *> Separator lines + 01 WS-SEP-STARS PIC X(100) VALUE ALL '*'. + 01 WS-SEP-DASHES PIC X(100) VALUE ALL '-'. + 01 WS-SEP-EQUALS PIC X(100) VALUE ALL '='. + + *> Edited numeric fields + 01 WS-ED-COUNT PIC Z(9)9. + 01 WS-ED-TOTAL PIC Z(9)9. + 01 WS-ED-TIME PIC Z(9)9. + + *> Billing data (for BILL transaction) + 01 WS-BILL-DATA. + 05 WS-BD-INV-ID PIC X(10). + 05 WS-BD-AMOUNT PIC 9(09). + 05 WS-BD-STATUS PIC X(01). + 05 WS-BD-MONTH PIC 9(06). + 05 WS-BD-BALANCE PIC 9(09). + + *> Configuration constants + 01 WS-CONFIG-MAX-ERRORS PIC 9(03) VALUE 50. + 01 WS-CONFIG-MAX-TXNS PIC 9(02) VALUE 20. + *> ============================================================ + + *> LINKAGE SECTION removed — LK-COMMAREA replaced by WS-COMMAREA + PROCEDURE DIVISION. + MAIN SECTION. + MB-PROCESS. + + PERFORM 1000-INIT + PERFORM 2000-OPEN-FILES + PERFORM 3000-PROCESS + PERFORM 4000-REPORT + PERFORM 5000-AUDIT + PERFORM 6000-ERROR-HANDLE + PERFORM 9000-EXIT + + GOBACK. + + 1000-INIT SECTION. + *> + DISPLAY "Main14OnlineCics: Initializing...". + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP. + STRING WS-TS-YEAR '-' WS-TS-MONTH '-' + WS-TS-DAY ' ' WS-TS-HOUR ':' + WS-TS-MINUTE ':' WS-TS-SECOND + INTO WS-TIMESTAMP-STR. + DISPLAY "Main14OnlineCics: Start time=" WS-TIMESTAMP-STR. + *> + *> Initialize session state + MOVE SPACES TO WS-SESSION-STATE. + MOVE 'A' TO WS-SESS-STATUS. + MOVE WS-TIMESTAMP-STR TO WS-SESS-LOGIN-TIME. + MOVE ZERO TO WS-SESS-TXN-COUNT. + MOVE ZERO TO WS-SESS-ERRORS. + *> + *> Initialize hash totals + MOVE ZERO TO WS-HASH-TOTAL. + MOVE ZERO TO WS-ERR-COUNT. + MOVE ZERO TO WS-AUDIT-ENTRIES. + *> + *> Initialize response time + MOVE ZERO TO WS-RESPONSE-TIME. + *> + *> Initialize transaction history + MOVE ZERO TO WS-TXN-COUNT. + *> + *> Build date/time for reports + MOVE WS-TS-YEAR TO WS-RPT-DATE(1:4). + MOVE '-' TO WS-RPT-DATE(5:1). + MOVE WS-TS-MONTH TO WS-RPT-DATE(6:2). + MOVE '-' TO WS-RPT-DATE(8:1). + MOVE WS-TS-DAY TO WS-RPT-DATE(9:2). + STRING WS-TS-HOUR ':' WS-TS-MINUTE ':' + WS-TS-SECOND INTO WS-RPT-TIME. + *> + DISPLAY "Main14OnlineCics: INIT complete. Session=" + WS-SESS-USERID " Status=" WS-SESS-STATUS. + *> + 2000-OPEN-FILES SECTION. + *> + DISPLAY "Main14OnlineCics: Opening files...". + *> + OPEN INPUT MAP-FILE. + IF WS-MAP-FILE-STATUS NOT = '00' + MOVE 2 TO WS-ERR-SEVERITY + STRING "WARN: MAP-FILE open status=" + WS-MAP-FILE-STATUS INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + ADD 1 TO WS-ERR-COUNT + END-IF. + *> + OPEN EXTEND OUTPUT-FILE. + IF WS-OUT-FILE-STATUS NOT = '00' + OPEN OUTPUT OUTPUT-FILE + IF WS-OUT-FILE-STATUS NOT = '00' + MOVE 3 TO WS-ERR-SEVERITY + STRING "ERROR: OUTPUT-FILE open status=" + WS-OUT-FILE-STATUS INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + PERFORM 6000-ERROR-HANDLE + END-IF + END-IF. + *> + OPEN EXTEND TXN-AUDIT-FILE. + IF WS-AUD-FILE-STATUS NOT = '00' + OPEN OUTPUT TXN-AUDIT-FILE + IF WS-AUD-FILE-STATUS NOT = '00' + MOVE 1 TO WS-ERR-SEVERITY + STRING "WARN: TXN-AUDIT open status=" + WS-AUD-FILE-STATUS INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + ADD 1 TO WS-ERR-COUNT + END-IF + END-IF. + *> + OPEN OUTPUT TXN-REPORT. + IF WS-RPT-FILE-STATUS NOT = '00' + MOVE 1 TO WS-ERR-SEVERITY + STRING "WARN: TXN-REPORT open status=" + WS-RPT-FILE-STATUS INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + ADD 1 TO WS-ERR-COUNT + END-IF. + *> + DISPLAY "Main14OnlineCics: Files opened." + " MAP=" WS-MAP-FILE-STATUS + " OUT=" WS-OUT-FILE-STATUS + " AUD=" WS-AUD-FILE-STATUS. + *> + 3000-PROCESS SECTION. + *> + DISPLAY "Main14OnlineCics: Processing COMMAREA...". + *> + *> Capture response time start (seconds portion) + MOVE WS-TS-SECOND TO WS-RT-START-S. + MOVE WS-TS-MS TO WS-RT-START-M. + *> + *> ============================================================ + *> === PRESERVED ORIGINAL CODE === + *> ============================================================ + DISPLAY "=== CICS Online Simulation ===". + DISPLAY "COMMAREA received:". + *> + *> LK data removed — using WS-COMMAREA directly + *> + DISPLAY " UserID: " WS-CA-USERID. + DISPLAY " Function: " WS-CA-FUNCTION. + DISPLAY " Input: " WS-CA-INPUT-DATA. + *> + *> Simulate MAPRECV: read from map file + OPEN INPUT MAP-FILE. + IF WS-MAP-FILE-STATUS NOT = '00' + MOVE 2 TO WS-ERR-SEVERITY + STRING "WARN: MAP-FILE reopen status=" + WS-MAP-FILE-STATUS INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + ADD 1 TO WS-ERR-COUNT + END-IF. + *> + PERFORM UNTIL MAP-EOF + READ MAP-FILE INTO WS-MAP-LINE + AT END + SET MAP-EOF TO TRUE + NOT AT END + DISPLAY " MAP RECV: " WS-MAP-LINE + ADD 1 TO WS-READS + END-READ + END-PERFORM. + CLOSE MAP-FILE. + IF WS-MAP-FILE-STATUS NOT = '00' + MOVE 1 TO WS-ERR-SEVERITY + STRING "INFO: MAP-FILE close status=" + WS-MAP-FILE-STATUS INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + END-IF. + *> + *> Update session state with current user + MOVE WS-CA-USERID TO WS-SESS-USERID. + ADD 1 TO WS-SESS-TXN-COUNT. + MOVE WS-CA-FUNCTION TO WS-SESS-LAST-FUNC. + *> + *> Validate COMMAREA before processing + PERFORM 3100-VALIDATE-COMMAREA. + *> + *> Process based on function code + *> --- PRESERVED ORIGINAL EVALUATE with added transactions --- + EVALUATE WS-CA-FUNCTION + WHEN "INQY" + MOVE "INQUIRY processed" TO WS-CA-MESSAGE + MOVE 00 TO WS-CA-RETURN-CODE + ADD 1 TO WS-HASH-FUNC-INQY + + WHEN "UPDT" + MOVE "UPDATE processed" TO WS-CA-MESSAGE + MOVE 00 TO WS-CA-RETURN-CODE + ADD 1 TO WS-HASH-FUNC-UPDT + + WHEN "DEL " + MOVE "DELETE processed" TO WS-CA-MESSAGE + MOVE 00 TO WS-CA-RETURN-CODE + ADD 1 TO WS-HASH-FUNC-DEL + + *> === NEW TRANSACTION CODES === + WHEN "ADDN" + MOVE "ADDN processed" TO WS-CA-MESSAGE + MOVE 00 TO WS-CA-RETURN-CODE + ADD 1 TO WS-HASH-FUNC-ADDN + PERFORM 3200-PROCESS-TRANSACTION + + WHEN "CANC" + MOVE "CANC processed" TO WS-CA-MESSAGE + MOVE 00 TO WS-CA-RETURN-CODE + ADD 1 TO WS-HASH-FUNC-CANC + PERFORM 3200-PROCESS-TRANSACTION + + WHEN "SUSP" + MOVE "SUSP processed" TO WS-CA-MESSAGE + MOVE 00 TO WS-CA-RETURN-CODE + ADD 1 TO WS-HASH-FUNC-SUSP + PERFORM 3200-PROCESS-TRANSACTION + + WHEN "BILL" + MOVE "BILL processed" TO WS-CA-MESSAGE + MOVE 00 TO WS-CA-RETURN-CODE + ADD 1 TO WS-HASH-FUNC-BILL + PERFORM 3200-PROCESS-TRANSACTION + + WHEN "DISP" + MOVE "DISP processed" TO WS-CA-MESSAGE + MOVE 00 TO WS-CA-RETURN-CODE + ADD 1 TO WS-HASH-FUNC-DISP + PERFORM 3200-PROCESS-TRANSACTION + + WHEN OTHER + MOVE "UNKNOWN function" TO WS-CA-MESSAGE + MOVE 99 TO WS-CA-RETURN-CODE + ADD 1 TO WS-HASH-FUNC-OTHER + END-EVALUATE. + *> + *> Build map and format response for all transactions + PERFORM 3300-BUILD-MAP. + PERFORM 3400-FORMAT-RESPONSE. + *> + *> Simulate MAPSEND: write to output file + *> === PRESERVED ORIGINAL OUTPUT CODE === + OPEN OUTPUT OUTPUT-FILE. + IF WS-OUT-FILE-STATUS NOT = '00' + MOVE 2 TO WS-ERR-SEVERITY + STRING "ERROR: OUTPUT-FILE reopen status=" + WS-OUT-FILE-STATUS INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + ADD 1 TO WS-ERR-COUNT + END-IF. + *> + MOVE SPACES TO OUTPUT-LINE. + STRING "USER=" WS-CA-USERID + " FUNC=" WS-CA-FUNCTION + " RC=" WS-CA-RETURN-CODE + " MSG=" WS-CA-MESSAGE + DELIMITED BY SIZE INTO OUTPUT-LINE. + WRITE OUTPUT-LINE. + ADD 1 TO WS-WRITES. + *> + MOVE SPACES TO OUTPUT-LINE. + STRING "MAPSEND: Received " WS-READS + " map lines, sent " WS-WRITES " responses" + DELIMITED BY SIZE INTO OUTPUT-LINE. + WRITE OUTPUT-LINE. + CLOSE OUTPUT-FILE. + IF WS-OUT-FILE-STATUS NOT = '00' + MOVE 1 TO WS-ERR-SEVERITY + STRING "INFO: OUTPUT-FILE close status=" + WS-OUT-FILE-STATUS INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + END-IF. + *> + *> Set return values in LINKAGE + *> Return values already in WS-COMMAREA + *> + DISPLAY " Return-Code: " WS-CA-RETURN-CODE. + DISPLAY " Message: " WS-CA-MESSAGE. + DISPLAY "Output written to cics-output.txt". + *> === END PRESERVED ORIGINAL CODE === + *> + *> Update transaction history + IF WS-TXN-COUNT < WS-CONFIG-MAX-TXNS + ADD 1 TO WS-TXN-COUNT + MOVE WS-CA-FUNCTION TO WS-TXN-FUNC(WS-TXN-COUNT) + MOVE WS-CA-USERID TO WS-TXN-USER(WS-TXN-COUNT) + MOVE WS-TIMESTAMP-STR TO WS-TXN-TIME(WS-TXN-COUNT) + MOVE WS-CA-RETURN-CODE TO WS-TXN-RC(WS-TXN-COUNT) + END-IF. + *> + *> Update hash totals + ADD 1 TO WS-HASH-TXN-COUNT. + ADD WS-READS TO WS-HASH-CHECKSUM. + ADD WS-WRITES TO WS-HASH-CHECKSUM. + *> + EXIT. + *> + 3100-VALIDATE-COMMAREA SECTION. + *> + DISPLAY "Main14OnlineCics: Validating COMMAREA...". + *> + *> Validate user ID + IF WS-CA-USERID = SPACES OR WS-CA-USERID = LOW-VALUES + MOVE 2 TO WS-ERR-SEVERITY + STRING "ERROR: Invalid UserID [" WS-CA-USERID "]" + INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + ADD 1 TO WS-ERR-COUNT + ADD 1 TO WS-SESS-ERRORS + END-IF. + *> + *> Validate function code length/content + IF WS-CA-FUNCTION = SPACES OR WS-CA-FUNCTION = LOW-VALUES + MOVE 2 TO WS-ERR-SEVERITY + STRING "ERROR: Empty function code" INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + ADD 1 TO WS-ERR-COUNT + ADD 1 TO WS-SESS-ERRORS + END-IF. + *> + *> Check session state + IF WS-SESS-LOCKED + MOVE 2 TO WS-ERR-SEVERITY + STRING "ERROR: Session locked for " WS-SESS-USERID + INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + MOVE 99 TO WS-CA-RETURN-CODE + MOVE "Session locked" TO WS-CA-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF. + IF WS-SESS-TERMINATED + MOVE 2 TO WS-ERR-SEVERITY + STRING "ERROR: Session terminated for " WS-SESS-USERID + INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + MOVE 99 TO WS-CA-RETURN-CODE + MOVE "Session terminated" TO WS-CA-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF. + *> + *> Check for excessive errors + IF WS-SESS-ERRORS > WS-CONFIG-MAX-ERRORS + MOVE 'L' TO WS-SESS-STATUS + MOVE 2 TO WS-ERR-SEVERITY + STRING "ERROR: Too many errors, session locked" + INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + MOVE 99 TO WS-CA-RETURN-CODE + MOVE "Session locked" TO WS-CA-MESSAGE + END-IF. + *> + DISPLAY "Main14OnlineCics: COMMAREA validated." + " User=" WS-CA-USERID " Func=" WS-CA-FUNCTION. + *> + 3200-PROCESS-TRANSACTION SECTION. + *> + DISPLAY "Main14OnlineCics: Processing transaction..." + WS-CA-FUNCTION. + *> + *> Route to specific transaction processing + EVALUATE WS-CA-FUNCTION + WHEN "ADDN" + PERFORM 3210-PROCESS-ADDN + WHEN "CANC" + PERFORM 3220-PROCESS-CANC + WHEN "SUSP" + PERFORM 3230-PROCESS-SUSP + WHEN "BILL" + PERFORM 3240-PROCESS-BILL + WHEN "DISP" + PERFORM 3250-PROCESS-DISP + WHEN OTHER + CONTINUE + END-EVALUATE. + *> + 3210-PROCESS-ADDN SECTION. + *> + *> Add new invoice/record processing + DISPLAY "Main14OnlineCics: ADDN - Adding new record...". + IF WS-CA-INPUT-DATA = SPACES + MOVE 1 TO WS-ERR-SEVERITY + STRING "WARN: ADDN with empty input data" + INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + ADD 1 TO WS-ERR-COUNT + MOVE "ADDN: no input data" TO WS-CA-MESSAGE + MOVE 01 TO WS-CA-RETURN-CODE + ELSE + STRING "ADDN: record added [" WS-CA-INPUT-DATA "]" + INTO WS-CA-MESSAGE + MOVE 00 TO WS-CA-RETURN-CODE + END-IF. + *> + *> Build map fields for ADDN response + MOVE "ADDNMAP " TO WS-MAP-MAPNAME. + MOVE "ADD NEW RECORD" TO WS-MAP-TITLE. + MOVE WS-CA-INPUT-DATA TO WS-MAP-BODY. + MOVE "ADD processing OK" TO WS-MAP-MSG-LINE. + *> + 3220-PROCESS-CANC SECTION. + *> + *> Cancel transaction processing + DISPLAY "Main14OnlineCics: CANC - Cancelling...". + IF WS-CA-INPUT-DATA = SPACES + MOVE 1 TO WS-ERR-SEVERITY + STRING "WARN: CANC with empty input data" + INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + ADD 1 TO WS-ERR-COUNT + MOVE "CANC: no input data" TO WS-CA-MESSAGE + MOVE 01 TO WS-CA-RETURN-CODE + ELSE + STRING "CANC: cancelled [" WS-CA-INPUT-DATA "]" + INTO WS-CA-MESSAGE + MOVE 00 TO WS-CA-RETURN-CODE + END-IF. + *> + *> Build map fields for CANC response + MOVE "CANCMAP " TO WS-MAP-MAPNAME. + MOVE "CANCEL TRANSACTION" TO WS-MAP-TITLE. + MOVE WS-CA-INPUT-DATA TO WS-MAP-BODY. + MOVE "CANCEL processing OK" TO WS-MAP-MSG-LINE. + *> + 3230-PROCESS-SUSP SECTION. + *> + *> Suspend account processing + DISPLAY "Main14OnlineCics: SUSP - Suspending account...". + IF WS-CA-INPUT-DATA = SPACES + MOVE 1 TO WS-ERR-SEVERITY + STRING "WARN: SUSP with empty input data" + INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + ADD 1 TO WS-ERR-COUNT + MOVE "SUSP: no input data" TO WS-CA-MESSAGE + MOVE 01 TO WS-CA-RETURN-CODE + ELSE + STRING "SUSP: account suspended [" WS-CA-INPUT-DATA "]" + INTO WS-CA-MESSAGE + MOVE 00 TO WS-CA-RETURN-CODE + MOVE 'L' TO WS-SESS-STATUS + END-IF. + *> + *> Build map fields for SUSP response + MOVE "SUSPMAP " TO WS-MAP-MAPNAME. + MOVE "SUSPEND ACCOUNT" TO WS-MAP-TITLE. + MOVE WS-CA-INPUT-DATA TO WS-MAP-BODY. + MOVE "SUSPEND processing OK" TO WS-MAP-MSG-LINE. + *> + 3240-PROCESS-BILL SECTION. + *> + *> Billing inquiry processing + DISPLAY "Main14OnlineCics: BILL - Billing inquiry...". + MOVE WS-CA-INPUT-DATA(1:10) TO WS-BD-INV-ID. + COMPUTE WS-BD-AMOUNT = FUNCTION RANDOM * 100000. + MOVE '1' TO WS-BD-STATUS. + MOVE 202506 TO WS-BD-MONTH. + COMPUTE WS-BD-BALANCE = WS-BD-AMOUNT * 80 / 100. + *> + MOVE WS-BD-AMOUNT TO WS-ED-TOTAL. + STRING "BILL: invoice=" WS-BD-INV-ID + " amount=" WS-ED-TOTAL + " balance=" WS-BD-BALANCE + INTO WS-CA-MESSAGE. + MOVE 00 TO WS-CA-RETURN-CODE. + *> + *> Build map fields for BILL response + MOVE "BILLMAP " TO WS-MAP-MAPNAME. + MOVE "BILLING INQUIRY" TO WS-MAP-TITLE. + MOVE WS-CA-INPUT-DATA TO WS-MAP-BODY. + STRING "BALANCE=" WS-BD-BALANCE INTO WS-MAP-MSG-LINE. + *> + 3250-PROCESS-DISP SECTION. + *> + *> Display detail processing + DISPLAY "Main14OnlineCics: DISP - Display detail...". + MOVE WS-CA-INPUT-DATA TO WS-BD-INV-ID. + MOVE 50000 TO WS-BD-AMOUNT. + MOVE '1' TO WS-BD-STATUS. + MOVE 202506 TO WS-BD-MONTH. + *> + MOVE WS-BD-AMOUNT TO WS-ED-TOTAL. + STRING "DISP: invoice=" WS-BD-INV-ID + " amount=" WS-ED-TOTAL + " status=" WS-BD-STATUS + INTO WS-CA-MESSAGE. + MOVE 00 TO WS-CA-RETURN-CODE. + *> + *> Build map fields for DISP response + MOVE "DISPMAP " TO WS-MAP-MAPNAME. + MOVE "DISPLAY DETAIL" TO WS-MAP-TITLE. + MOVE WS-CA-INPUT-DATA TO WS-MAP-BODY. + STRING "AMOUNT=" WS-BD-AMOUNT INTO WS-MAP-MSG-LINE. + *> + 3300-BUILD-MAP SECTION. + *> + DISPLAY "Main14OnlineCics: Building response map...". + *> + *> Populate map field table based on transaction + MOVE 1 TO WS-MAP-CURSOR. + MOVE 'U' TO WS-MAP-ATTR. + *> + *> Fill map field entries + MOVE "USERID " TO WS-MAP-FLD-NAME(1). + MOVE WS-CA-USERID TO WS-MAP-FLD-VALUE(1). + MOVE 'P' TO WS-MAP-FLD-ATTR(1). + *> + MOVE "FUNCTION " TO WS-MAP-FLD-NAME(2). + MOVE WS-CA-FUNCTION TO WS-MAP-FLD-VALUE(2). + MOVE 'P' TO WS-MAP-FLD-ATTR(2). + *> + MOVE "RETURNCOD" TO WS-MAP-FLD-NAME(3). + MOVE WS-CA-RETURN-CODE TO WS-MAP-FLD-VALUE(3). + MOVE 'P' TO WS-MAP-FLD-ATTR(3). + *> + MOVE "MESSAGE " TO WS-MAP-FLD-NAME(4). + MOVE WS-CA-MESSAGE TO WS-MAP-FLD-VALUE(4). + MOVE 'U' TO WS-MAP-FLD-ATTR(4). + *> + MOVE "INPUTDATA" TO WS-MAP-FLD-NAME(5). + MOVE WS-CA-INPUT-DATA TO WS-MAP-FLD-VALUE(5). + MOVE 'U' TO WS-MAP-FLD-ATTR(5). + *> + DISPLAY "Main14OnlineCics: Map built." + " Mapname=" WS-MAP-MAPNAME + " Title=" WS-MAP-TITLE. + *> + 3400-FORMAT-RESPONSE SECTION. + *> + DISPLAY "Main14OnlineCics: Formatting response...". + *> + *> Capture response time end + MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP. + MOVE WS-TS-SECOND TO WS-RT-END-S. + MOVE WS-TS-MS TO WS-RT-END-M. + *> + *> Calculate elapsed time in milliseconds + COMPUTE WS-RT-ELAPSED = + (WS-RT-END-S - WS-RT-START-S) * 1000 + + (WS-RT-END-M - WS-RT-START-M). + IF WS-RT-ELAPSED < 0 + COMPUTE WS-RT-ELAPSED = + WS-RT-ELAPSED + 60000 + END-IF. + MOVE WS-RT-ELAPSED TO WS-RT-DISP. + *> + *> Build response text with map details + STRING "MAP=" WS-MAP-MAPNAME + " TITLE=" WS-MAP-TITLE + " MSG=" WS-MAP-MSG-LINE + " RESP-TIME=" WS-RT-DISP "ms" + INTO WS-RESP-TEXT. + *> + *> Build formatted output line with response time + MOVE SPACES TO OUTPUT-LINE. + STRING "RESPONSE: " WS-RESP-TEXT + DELIMITED BY SIZE INTO OUTPUT-LINE. + *> + DISPLAY "Main14OnlineCics: Response formatted." + " Time=" WS-RT-DISP "ms". + *> + 4000-REPORT SECTION. + *> + DISPLAY "Main14OnlineCics: Generating session report...". + *> + *> Write report header + MOVE SPACES TO REPORT-LINE. + STRING "TELECOM CICS TRANSACTION REPORT" + " " WS-RPT-DATE " " WS-RPT-TIME + INTO REPORT-LINE. + WRITE REPORT-LINE. + WRITE REPORT-LINE FROM WS-SEP-STARS. + *> + *> Write session summary + MOVE SPACES TO REPORT-LINE. + STRING "SESSION: User=" WS-SESS-USERID + " Status=" WS-SESS-STATUS + " Txns=" WS-SESS-TXN-COUNT + INTO REPORT-LINE. + WRITE REPORT-LINE. + *> + *> Write transaction hash breakdown + MOVE WS-HASH-FUNC-INQY TO WS-ED-COUNT. + STRING "HASH: INQY=" WS-ED-COUNT + INTO REPORT-LINE. + WRITE REPORT-LINE. + *> + MOVE WS-HASH-FUNC-UPDT TO WS-ED-COUNT. + STRING "HASH: UPDT=" WS-ED-COUNT + INTO REPORT-LINE. + WRITE REPORT-LINE. + *> + MOVE WS-HASH-FUNC-DEL TO WS-ED-COUNT. + STRING "HASH: DEL =" WS-ED-COUNT + INTO REPORT-LINE. + WRITE REPORT-LINE. + *> + MOVE WS-HASH-FUNC-ADDN TO WS-ED-COUNT. + STRING "HASH: ADDN=" WS-ED-COUNT + INTO REPORT-LINE. + WRITE REPORT-LINE. + *> + MOVE WS-HASH-FUNC-CANC TO WS-ED-COUNT. + STRING "HASH: CANC=" WS-ED-COUNT + INTO REPORT-LINE. + WRITE REPORT-LINE. + *> + MOVE WS-HASH-FUNC-SUSP TO WS-ED-COUNT. + STRING "HASH: SUSP=" WS-ED-COUNT + INTO REPORT-LINE. + WRITE REPORT-LINE. + *> + MOVE WS-HASH-FUNC-BILL TO WS-ED-COUNT. + STRING "HASH: BILL=" WS-ED-COUNT + INTO REPORT-LINE. + WRITE REPORT-LINE. + *> + MOVE WS-HASH-FUNC-DISP TO WS-ED-COUNT. + STRING "HASH: DISP=" WS-ED-COUNT + INTO REPORT-LINE. + WRITE REPORT-LINE. + *> + MOVE WS-HASH-FUNC-OTHER TO WS-ED-COUNT. + STRING "HASH: OTHER=" WS-ED-COUNT + INTO REPORT-LINE. + WRITE REPORT-LINE. + *> + *> Write total summary + MOVE WS-HASH-TXN-COUNT TO WS-ED-TOTAL. + STRING "TOTAL TRANSACTIONS: " WS-ED-TOTAL + INTO REPORT-LINE. + WRITE REPORT-LINE. + *> + MOVE WS-HASH-CHECKSUM TO WS-ED-TOTAL. + STRING "HASH CHECKSUM: " WS-ED-TOTAL + INTO REPORT-LINE. + WRITE REPORT-LINE. + *> + MOVE WS-ERR-COUNT TO WS-ED-COUNT. + STRING "ERRORS: " WS-ED-COUNT + INTO REPORT-LINE. + WRITE REPORT-LINE. + WRITE REPORT-LINE FROM WS-SEP-DASHES. + *> + *> Write transaction history + MOVE SPACES TO REPORT-LINE. + STRING "TRANSACTION HISTORY (" WS-TXN-COUNT " entries)" + INTO REPORT-LINE. + WRITE REPORT-LINE. + WRITE REPORT-LINE FROM WS-SEP-STARS. + *> + PERFORM VARYING WS-TXN-COUNT FROM 1 BY 1 + UNTIL WS-TXN-COUNT > 20 + OR WS-TXN-FUNC(WS-TXN-COUNT) = SPACES + MOVE WS-TXN-RC(WS-TXN-COUNT) TO WS-ED-COUNT + STRING " " WS-TXN-FUNC(WS-TXN-COUNT) + " USER=" WS-TXN-USER(WS-TXN-COUNT) + " RC=" WS-ED-COUNT + " TIME=" WS-TXN-TIME(WS-TXN-COUNT) + INTO REPORT-LINE + WRITE REPORT-LINE + END-PERFORM. + *> + WRITE REPORT-LINE FROM WS-SEP-EQUALS. + *> + DISPLAY "Main14OnlineCics: Report written to txn-report.txt". + *> + 5000-AUDIT SECTION. + *> + DISPLAY "Main14OnlineCics: Writing audit trail...". + *> + *> Build audit record + MOVE WS-HASH-TXN-COUNT TO WS-ED-COUNT. + MOVE WS-ERR-COUNT TO WS-ED-COUNT. + *> + STRING "AUDIT:" WS-TIMESTAMP-STR + " PROG=Main14OnlineCics" + " TXNS=" WS-HASH-TXN-COUNT + " ERRS=" WS-ERR-COUNT + " USER=" WS-CA-USERID + " FUNC=" WS-CA-FUNCTION + " RC=" WS-CA-RETURN-CODE + INTO AUDIT-RECORD. + WRITE AUDIT-RECORD. + IF WS-AUD-FILE-STATUS NOT = '00' + DISPLAY "ERROR: Audit write failed, status: " + WS-AUD-FILE-STATUS + ADD 1 TO WS-ERR-COUNT + END-IF. + *> + *> Second audit line — response time + STRING "AUDIT:RESPTIME=" WS-RT-DISP "ms" + " MAP=" WS-MAP-MAPNAME + " CURSOR=" WS-MAP-CURSOR + INTO AUDIT-RECORD. + WRITE AUDIT-RECORD. + *> + *> Third audit line — session state + STRING "AUDIT:SESSION=" WS-SESS-USERID + " STATUS=" WS-SESS-STATUS + " TCNT=" WS-SESS-TXN-COUNT + " ERRS=" WS-SESS-ERRORS + INTO AUDIT-RECORD. + WRITE AUDIT-RECORD. + *> + ADD 1 TO WS-AUDIT-ENTRIES. + DISPLAY "Main14OnlineCics: Audit trail written." + " Entries=" WS-AUDIT-ENTRIES. + *> + 6000-ERROR-HANDLE SECTION. + *> + ADD 1 TO WS-ERR-COUNT. + ADD 1 TO WS-HASH-ERROR-COUNT. + *> + *> Set error response code based on severity + EVALUATE WS-ERR-SEVERITY + WHEN 0 + MOVE '0000' TO WS-ERR-RESP-CODE + MOVE 'Informational' TO WS-ERR-RESP-MSG + DISPLAY 'INFO: ' WS-ERR-MSG + WHEN 1 + MOVE '0001' TO WS-ERR-RESP-CODE + MOVE 'Warning' TO WS-ERR-RESP-MSG + DISPLAY 'WARN: ' WS-ERR-MSG + WHEN 2 + MOVE '0002' TO WS-ERR-RESP-CODE + MOVE 'Error' TO WS-ERR-RESP-MSG + DISPLAY 'ERROR: ' WS-ERR-MSG + WHEN 3 + MOVE '0003' TO WS-ERR-RESP-CODE + MOVE 'Fatal' TO WS-ERR-RESP-MSG + DISPLAY 'FATAL: ' WS-ERR-MSG + PERFORM 9000-EXIT + GOBACK + WHEN OTHER + MOVE '9999' TO WS-ERR-RESP-CODE + MOVE 'Unknown severity' TO WS-ERR-RESP-MSG + DISPLAY 'UNKN: ' WS-ERR-MSG + END-EVALUATE. + *> + *> Check error threshold + IF WS-ERR-COUNT > WS-CONFIG-MAX-ERRORS + MOVE 3 TO WS-ERR-SEVERITY + STRING 'FATAL: Error threshold ' + WS-CONFIG-MAX-ERRORS ' exceeded' + INTO WS-ERR-MSG + DISPLAY WS-ERR-MSG + PERFORM 9000-EXIT + GOBACK + END-IF. + *> + 9000-EXIT SECTION. + *> + DISPLAY "Main14OnlineCics: Cleanup and exit...". + *> + *> Close all files with status checks + CLOSE MAP-FILE. + IF WS-MAP-FILE-STATUS NOT = '00' + DISPLAY "WARN: MAP-FILE close status=" + WS-MAP-FILE-STATUS + END-IF. + *> + CLOSE OUTPUT-FILE. + IF WS-OUT-FILE-STATUS NOT = '00' + DISPLAY "WARN: OUTPUT-FILE close status=" + WS-OUT-FILE-STATUS + END-IF. + *> + CLOSE TXN-AUDIT-FILE. + IF WS-AUD-FILE-STATUS NOT = '00' + DISPLAY "WARN: TXN-AUDIT close status=" + WS-AUD-FILE-STATUS + END-IF. + *> + CLOSE TXN-REPORT. + IF WS-RPT-FILE-STATUS NOT = '00' + DISPLAY "WARN: TXN-REPORT close status=" + WS-RPT-FILE-STATUS + END-IF. + *> + *> Final summary display + DISPLAY "Main14OnlineCics: Transactions=" WS-HASH-TXN-COUNT. + DISPLAY "Main14OnlineCics: Hash checksum=" WS-HASH-CHECKSUM. + DISPLAY "Main14OnlineCics: Errors=" WS-ERR-COUNT. + DISPLAY "Main14OnlineCics: Response time=" WS-RT-DISP "ms". + DISPLAY "Main14OnlineCics: Audit entries=" WS-AUDIT-ENTRIES. + DISPLAY "Main14OnlineCics: End at " WS-TIMESTAMP-STR. + *> + EXIT. diff --git a/benchmark-programs/14-online-cics/test-cics-driver.cbl b/benchmark-programs/14-online-cics/test-cics-driver.cbl new file mode 100644 index 0000000..746c050 --- /dev/null +++ b/benchmark-programs/14-online-cics/test-cics-driver.cbl @@ -0,0 +1,68 @@ + *> ============================================================ + *> test-cics-driver : 客户在线照会测试驱动 (CICS Test Driver) + *> Input : COMMAREA (模拟CICS通信区域) + *> Output: CALL結果 (在线照会处理) + *> Coverage: OL-N001~N004, OL-A001, OL-R001 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. TestCicsDriver. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 WS-COMMAREA. + 05 WS-CA-USERID PIC X(08). + 05 WS-CA-FUNCTION PIC X(04). + 05 WS-CA-INPUT-DATA PIC X(40). + 05 WS-CA-RETURN-CODE PIC 9(02). + 05 WS-CA-MESSAGE PIC X(40). + + 01 WS-TEST-CASE PIC 9(01) VALUE 1. + 01 WS-INVOICE-REC. + COPY "telecom/TEL-INVOICE.cpy". + + PROCEDURE DIVISION. + MAIN-PROCEDURE. + + DISPLAY "=== CICS Driver - Test Suite ===". + + *> Test 1: INQUIRY function + DISPLAY "Test 1: INQUIRY". + MOVE "USER001 " TO WS-CA-USERID. + MOVE "INQY" TO WS-CA-FUNCTION. + MOVE "Customer account balance inquiry " + TO WS-CA-INPUT-DATA. + CALL 'Main14OnlineCics' USING WS-COMMAREA. + DISPLAY " RC=" WS-CA-RETURN-CODE + " MSG=" WS-CA-MESSAGE. + + *> Test 2: UPDATE function + DISPLAY "Test 2: UPDATE". + MOVE "USER002 " TO WS-CA-USERID. + MOVE "UPDT" TO WS-CA-FUNCTION. + MOVE "Update customer address record " + TO WS-CA-INPUT-DATA. + CALL 'Main14OnlineCics' USING WS-COMMAREA. + DISPLAY " RC=" WS-CA-RETURN-CODE + " MSG=" WS-CA-MESSAGE. + + *> Test 3: DELETE function + DISPLAY "Test 3: DELETE". + MOVE "USER003 " TO WS-CA-USERID. + MOVE "DEL " TO WS-CA-FUNCTION. + MOVE "Delete obsolete customer record " + TO WS-CA-INPUT-DATA. + CALL 'Main14OnlineCics' USING WS-COMMAREA. + DISPLAY " RC=" WS-CA-RETURN-CODE + " MSG=" WS-CA-MESSAGE. + + *> Test 4: UNKNOWN function + DISPLAY "Test 4: UNKNOWN function". + MOVE "USER004 " TO WS-CA-USERID. + MOVE "BAD!" TO WS-CA-FUNCTION. + MOVE "This should return error code 99 " + TO WS-CA-INPUT-DATA. + CALL 'Main14OnlineCics' USING WS-COMMAREA. + DISPLAY " RC=" WS-CA-RETURN-CODE + " MSG=" WS-CA-MESSAGE. + + STOP RUN. diff --git a/benchmark-programs/15-csv-fb-nolf/README.md b/benchmark-programs/15-csv-fb-nolf/README.md new file mode 100644 index 0000000..c5338ce --- /dev/null +++ b/benchmark-programs/15-csv-fb-nolf/README.md @@ -0,0 +1,67 @@ +# 15-csv-fb-nolf: CSV to Fixed-Block Conversion (No Line Feed) + +## 电信业务场景 + +外部CDR CSV取込(无LF)。读取外部系统提供的CSV格式CDR文件，使用STRING语句将各字段合并为固定长记录。无换行展开。 + +## Description + +Reads a LINE SEQUENTIAL CSV file (comma-separated, 3 fields) and +converts each row to a fixed-length output record using the STRING +statement. Handles basic CSV quoting (double-quoted fields with +embedded commas). + +## Record Layout + +### Input (LINE SEQUENTIAL CSV) + +Each line contains 3 comma-separated fields. Fields may be quoted +with double-quotes when they contain commas or leading/trailing spaces. + +### Output (fixed-length: 100 bytes) + +One fixed-length record per CSV row. Fields are joined with pipe ('|') +separators via STRING. + +| Component | Description | +|-----------|----------------------------| +| FIELD1 | Padded/spaced as parsed | +| Separator | Pipe character '|' | +| FIELD2 | Padded/spaced as parsed | +| Separator | Pipe character '|' | +| FIELD3 | Padded/spaced as parsed | + +## Files + +| File | Purpose | +|-------------------------|--------------------------------| +| main-15-csv-fb-nolf.cbl | Main COBOL program | +| data-gen.sh | Generate CSV test data | +| run.sh | Compile, run, verify | +| README.md | This file | + +## Tests + +| Test Case | Description | +|-------------------------|-------------------------------------| +| Standard CSV | Normal comma-separated values | +| Empty middle field | Field2 is empty (,,) | +| Quoted commas | Field contains embedded comma | +| Quoted spaces | Quoted field with padding spaces | +| All empty | Line with only commas | +| Long text | Field longer than usual | + +## Usage + +```bash +cd 15-csv-fb-nolf +bash data-gen.sh +bash run.sh +``` + +## Expected Behavior + +- Each CSV line produces exactly one fixed-length (100-byte) output record. +- Quoted fields are unquoted during parsing. +- Embedded commas within quoted fields are preserved. +- Output records use '|' as separator between fields. diff --git a/benchmark-programs/15-csv-fb-nolf/main-15-csv-fb-nolf.cbl b/benchmark-programs/15-csv-fb-nolf/main-15-csv-fb-nolf.cbl new file mode 100644 index 0000000..25a9465 --- /dev/null +++ b/benchmark-programs/15-csv-fb-nolf/main-15-csv-fb-nolf.cbl @@ -0,0 +1,993 @@ + *> ============================================================ + *> 15-csv-fb-nolf : 外部CDR CSV取込(无LF) (CDR Import) + *> Input : FILE-IN (file-in.csv) Output: FILE-OUT (file-out.dat) + *> ERROR-REPORT (csv-errors.dat) AUDIT-FILE (csv-audit.dat) + *> Enhanced: SECTIONs, field validation, truncation detection, + *> quote check, count reconciliation, hash totals, + *> severity levels, FILE STATUS after every I/O. + *> Coverage: CF-N001, CF-N003~N006, CF-A002 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. CsvFbNoLf. + + 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-errors.dat' + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-ERR-STATUS. + SELECT AUDIT-FILE ASSIGN TO 'csv-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(80). + + FD AUDIT-FILE. + 01 AUD-REC PIC X(80). + + WORKING-STORAGE SECTION. + 01 WS-TELECOM-REC. + COPY "telecom/TEL-CDR.cpy". + + *> File status keys for all files + 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). + + *> EOF flag + 01 WS-EOF PIC X(01) VALUE 'N'. + 88 WS-EOF-YES VALUE 'Y' FALSE 'N'. + + *> Record counters (original + expanded) + 01 WS-REC-COUNT PIC 9(05) VALUE ZERO. + 01 WS-LINE-COUNT PIC 9(05) VALUE ZERO. + 01 WS-COUNTERS. + 05 WS-TOT-READ PIC 9(09) VALUE ZERO. + 05 WS-TOT-WRITTEN PIC 9(09) VALUE ZERO. + 05 WS-TOT-MALFORMED PIC 9(09) VALUE ZERO. + 05 WS-TOT-TRUNCATED PIC 9(09) VALUE ZERO. + 05 WS-TOT-QUOTE-ERR PIC 9(09) VALUE ZERO. + 05 WS-TOT-FIELD-ERR PIC 9(09) VALUE ZERO. + 05 WS-TOT-WARNINGS PIC 9(09) VALUE ZERO. + 05 WS-TOT-ERRORS PIC 9(09) VALUE ZERO. + 05 WS-TOT-CRITICAL PIC 9(09) VALUE ZERO. + + *> CSV parsing fields (original) + 01 WS-FIELDS. + 05 WS-FIELD1 PIC X(30). + 05 WS-FIELD2 PIC X(30). + 05 WS-FIELD3 PIC X(30). + 01 WS-POS PIC 9(03). + 01 WS-CHAR PIC X(01). + 01 WS-FIELD-NUM PIC 9(01). + 01 WS-CHAR-OFFSET PIC 9(02). + 01 WS-IN-QUOTE PIC X(01) VALUE 'N'. + 88 WS-IN-QUOTE-YES VALUE 'Y' FALSE 'N'. + 01 WS-OUT-LINE PIC X(100). + + *> Validation fields + 01 WS-QUOTE-COUNT PIC 9(03) VALUE ZERO. + 01 WS-MALFORMED-CNT PIC 9(05) VALUE ZERO. + 01 WS-TRUNC-CNT PIC 9(05) VALUE ZERO. + 01 WS-FIELD-COUNT-ERR PIC 9(05) VALUE ZERO. + 01 WS-FIELD3-LEN PIC 9(02). + 01 WS-IDX PIC 9(02). + 01 WS-CHAR-CHK PIC X(01). + 01 WS-ALL-NUMERIC PIC X(01) VALUE 'Y'. + 01 WS-RECONCILE-OK PIC X(01) VALUE 'Y'. + 01 WS-VALID-FLAG PIC X(01) VALUE 'Y'. + 88 WS-VALID-REC-YES VALUE 'Y' FALSE 'N'. + 88 WS-VALID-REC-NO VALUE 'N'. + + *> Field-level validation status per field + 01 WS-FIELD-STATUS. + 05 WS-FIELD1-OK PIC X(01) VALUE 'Y'. + 05 WS-FIELD2-OK PIC X(01) VALUE 'Y'. + 05 WS-FIELD3-OK PIC X(01) VALUE 'Y'. + 01 WS-FIELD-ERR-MSG PIC X(60). + 01 WS-FIELD-TRUNC-FLAG PIC X(01) VALUE 'N'. + 88 WS-FIELD-TRUNC-YES VALUE 'Y' FALSE 'N'. + + *> Input record buffer for error reporting + 01 WS-INPUT-BUF PIC X(200). + + *> Hash totals (per field + overall) + 01 WS-HASH-TOTAL PIC 9(10) VALUE ZERO. + 01 WS-HASH-FIELD-LEN PIC 9(05) VALUE ZERO. + 01 WS-HASH-FIELD1 PIC 9(10) VALUE ZERO. + 01 WS-HASH-FIELD2 PIC 9(10) VALUE ZERO. + 01 WS-HASH-FIELD3 PIC 9(10) VALUE ZERO. + + *> Timestamp + 01 WS-TIMESTAMP PIC X(20). + 01 WS-CUR-DATE-DISP PIC X(08). + 01 WS-CUR-TIME-DISP PIC X(06). + 01 WS-TS-DISPLAY PIC X(26). + + *> Error severity levels + 01 WS-SEVERITY PIC X(01). + 88 WS-SEV-INFO VALUE 'I'. + 88 WS-SEV-WARNING VALUE 'W'. + 88 WS-SEV-ERROR VALUE 'E'. + 88 WS-SEV-CRITICAL VALUE 'C'. + + *> Report and display formatting fields + 01 WS-RPT-COUNT PIC Z(9)9. + 01 WS-RPT-COUNT9 PIC Z(9)9. + 01 WS-RPT-LINE PIC X(80). + 01 WS-RPT-PCT PIC Z(9)9.9. + 01 WS-LINE-DISP PIC Z(9)9. + 01 WS-DISP-BUFFER PIC X(80). + + PROCEDURE DIVISION. + + *> ===== MAIN SECTION ===== + MAIN SECTION. + MB-PROCESS. + PERFORM 1000-INIT + PERFORM 2000-OPEN-FILES + PERFORM 3000-READ-INPUT + PERFORM 4000-REPORT + PERFORM 5000-AUDIT + PERFORM 6000-ERROR-HANDLE + PERFORM 9000-EXIT + . + + *> ===== 1000-INIT ===== + 1000-INIT SECTION. + 1000-START. + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-CUR-DATE-DISP. + MOVE FUNCTION CURRENT-DATE (9:6) TO WS-CUR-TIME-DISP. + STRING WS-CUR-DATE-DISP '-' + WS-CUR-TIME-DISP + DELIMITED BY SIZE INTO WS-TIMESTAMP. + STRING WS-CUR-DATE-DISP(1:4) '-' + WS-CUR-DATE-DISP(5:2) '-' + WS-CUR-DATE-DISP(7:2) ' ' + WS-CUR-TIME-DISP(1:2) ':' + WS-CUR-TIME-DISP(3:2) ':' + WS-CUR-TIME-DISP(5:2) + DELIMITED BY SIZE INTO WS-TS-DISPLAY. + DISPLAY WS-TS-DISPLAY ' 1000-INIT: CsvFbNoLf START'. + + *> Initialize all counters to zero + MOVE ZERO TO WS-REC-COUNT + WS-LINE-COUNT + WS-TOT-READ + WS-TOT-WRITTEN + WS-TOT-MALFORMED + WS-TOT-TRUNCATED + WS-TOT-QUOTE-ERR + WS-TOT-FIELD-ERR + WS-TOT-WARNINGS + WS-TOT-ERRORS + WS-TOT-CRITICAL + WS-MALFORMED-CNT + WS-TRUNC-CNT + WS-FIELD-COUNT-ERR + WS-HASH-TOTAL + WS-HASH-FIELD1 + WS-HASH-FIELD2 + WS-HASH-FIELD3 + WS-HASH-FIELD-LEN. + + *> Initialize flags + MOVE 'Y' TO WS-RECONCILE-OK. + MOVE 'N' TO WS-EOF. + + *> ===== 2000-OPEN-FILES ===== + 2000-OPEN-FILES SECTION. + 2000-START. + DISPLAY WS-TS-DISPLAY ' 2000-OPEN-FILES: Opening files'. + OPEN INPUT FILE-IN. + IF WS-FILE-IN-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY ' ERROR: Cannot open FILE-IN,' + ' status: ' WS-FILE-IN-STATUS + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + DISPLAY WS-TS-DISPLAY ' FILE-IN opened, status=' + WS-FILE-IN-STATUS. + OPEN OUTPUT FILE-OUT. + IF WS-FILE-OUT-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY ' ERROR: Cannot open FILE-OUT,' + ' status: ' WS-FILE-OUT-STATUS + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + DISPLAY WS-TS-DISPLAY ' FILE-OUT opened, status=' + WS-FILE-OUT-STATUS. + OPEN OUTPUT ERROR-REPORT. + IF WS-ERR-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY ' ERROR: Cannot open ERROR-REPORT,' + ' status: ' WS-ERR-STATUS + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + DISPLAY WS-TS-DISPLAY ' ERROR-REPORT opened, status=' + WS-ERR-STATUS. + OPEN OUTPUT AUDIT-FILE. + IF WS-AUDIT-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY ' ERROR: Cannot open AUDIT-FILE,' + ' status: ' WS-AUDIT-STATUS + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + DISPLAY WS-TS-DISPLAY ' AUDIT-FILE opened, status=' + WS-AUDIT-STATUS. + + *> Write error report header lines + MOVE 'CSV Error Detail Report - CsvFbNoLf' TO ERR-REC. + WRITE ERR-REC. + IF WS-ERR-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY 'WRITE ERROR: ERROR-REPORT status=' + WS-ERR-STATUS + END-IF. + + STRING 'Run: ' WS-TIMESTAMP INTO ERR-REC. + WRITE ERR-REC. + IF WS-ERR-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY 'WRITE ERROR: ERROR-REPORT status=' + WS-ERR-STATUS + END-IF. + + MOVE SPACES TO ERR-REC. + MOVE 'Line Severity Field Description' TO ERR-REC. + WRITE ERR-REC. + IF WS-ERR-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY 'WRITE ERROR: ERROR-REPORT status=' + WS-ERR-STATUS + END-IF. + + MOVE SPACES TO ERR-REC. + WRITE ERR-REC. + IF WS-ERR-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY 'WRITE ERROR: ERROR-REPORT status=' + WS-ERR-STATUS + END-IF. + + *> Write audit file header lines + MOVE 'CSV Audit Report - CsvFbNoLf' TO AUD-REC. + WRITE AUD-REC. + IF WS-AUDIT-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY ' WRITE ERROR: AUDIT-FILE status=' + WS-AUDIT-STATUS + END-IF. + + STRING 'Run: ' WS-TIMESTAMP INTO AUD-REC. + WRITE AUD-REC. + IF WS-AUDIT-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY ' WRITE ERROR: AUDIT-FILE status=' + WS-AUDIT-STATUS + END-IF. + + MOVE SPACES TO AUD-REC. + WRITE AUD-REC. + IF WS-AUDIT-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY ' WRITE ERROR: AUDIT-FILE status=' + WS-AUDIT-STATUS + END-IF. + + DISPLAY WS-TS-DISPLAY '2000-OPEN-FILES: All files opened OK'. + + *> ===== 3000-READ-INPUT ===== + 3000-READ-INPUT SECTION. + 3000-START. + DISPLAY WS-TS-DISPLAY ' 3000-READ-INPUT: Processing CSV'. + + PERFORM UNTIL WS-EOF-YES + READ FILE-IN + AT END + SET WS-EOF-YES TO TRUE + DISPLAY WS-TS-DISPLAY ' EOF reached,' + ' lines=' WS-LINE-COUNT + NOT AT END + ADD 1 TO WS-LINE-COUNT + ADD 1 TO WS-TOT-READ + MOVE IN-LINE TO WS-INPUT-BUF + PERFORM 3100-VALIDATE-RECORD + END-READ + IF WS-FILE-IN-STATUS NOT = '00' + AND NOT = '10' + DISPLAY WS-TS-DISPLAY ' READ ERROR: FILE-IN status=' + WS-FILE-IN-STATUS + MOVE 'E' TO WS-SEVERITY + ADD 1 TO WS-TOT-ERRORS + END-IF + END-PERFORM. + + *> Close input file with STATUS check + CLOSE FILE-IN. + IF WS-FILE-IN-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY ' CLOSE ERROR: FILE-IN status=' + WS-FILE-IN-STATUS + ADD 1 TO WS-TOT-ERRORS + END-IF. + DISPLAY WS-TS-DISPLAY ' 3000-READ-INPUT: Input closed,' + ' total=' WS-LINE-COUNT. + + *> ===== 3100-VALIDATE-RECORD ===== + 3100-VALIDATE-RECORD SECTION. + 3100-START. + MOVE 'Y' TO WS-VALID-FLAG. + MOVE 'Y' TO WS-FIELD1-OK. + MOVE 'Y' TO WS-FIELD2-OK. + MOVE 'Y' TO WS-FIELD3-OK. + MOVE 'N' TO WS-FIELD-TRUNC-FLAG. + MOVE SPACES TO WS-FIELD-ERR-MSG. + + *> Quote pairing: odd quote count = malformed + MOVE 0 TO WS-QUOTE-COUNT. + INSPECT IN-LINE TALLYING WS-QUOTE-COUNT + FOR ALL '"'. + + IF FUNCTION MOD(WS-QUOTE-COUNT, 2) NOT = 0 + ADD 1 TO WS-MALFORMED-CNT + ADD 1 TO WS-TOT-QUOTE-ERR + ADD 1 TO WS-TOT-ERRORS + MOVE 'E' TO WS-SEVERITY + MOVE 'Unpaired quote in CSV line' TO WS-FIELD-ERR-MSG + MOVE 'N' TO WS-VALID-FLAG + STRING WS-LINE-COUNT ' ERROR Quote ' + WS-FIELD-ERR-MSG + DELIMITED BY SIZE INTO ERR-REC + WRITE ERR-REC + IF WS-ERR-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' WRITE ERROR: ERROR-REPORT status=' + WS-ERR-STATUS + END-IF + DISPLAY WS-TS-DISPLAY ' Quote error at line ' + WS-LINE-COUNT ': ' WS-FIELD-ERR-MSG + END-IF. + + *> Parse using original logic -> WS-FIELD1..3 + PERFORM PARSE-CSV-LINE. + + *> Field count: expect 3 fields + IF WS-FIELD-NUM < 3 + ADD 1 TO WS-FIELD-COUNT-ERR + ADD 1 TO WS-TOT-FIELD-ERR + ADD 1 TO WS-TOT-ERRORS + MOVE 'E' TO WS-SEVERITY + MOVE 'N' TO WS-VALID-FLAG + STRING 'Expected 3 fields, got ' WS-FIELD-NUM + INTO WS-FIELD-ERR-MSG + STRING WS-LINE-COUNT ' ERROR Field ' + WS-FIELD-ERR-MSG + DELIMITED BY SIZE INTO ERR-REC + WRITE ERR-REC + IF WS-ERR-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' WRITE ERROR: ERROR-REPORT status=' + WS-ERR-STATUS + END-IF + DISPLAY WS-TS-DISPLAY ' Field count error at line ' + WS-LINE-COUNT ': ' WS-FIELD-ERR-MSG + END-IF. + + *> Field 1: presence check + IF WS-FIELD1 = SPACES + MOVE 'N' TO WS-FIELD1-OK + MOVE 'W' TO WS-SEVERITY + ADD 1 TO WS-TOT-WARNINGS + MOVE 'Field1 is empty' TO WS-FIELD-ERR-MSG + STRING WS-LINE-COUNT ' WARNING Field1 ' + 'Empty field content' + DELIMITED BY SIZE INTO ERR-REC + WRITE ERR-REC + IF WS-ERR-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' WRITE ERROR: ERROR-REPORT status=' + WS-ERR-STATUS + END-IF + END-IF. + + *> Truncation check: Field1 > 30 chars + IF FUNCTION LENGTH(FUNCTION TRIM(WS-FIELD1)) > 30 + ADD 1 TO WS-TRUNC-CNT + ADD 1 TO WS-TOT-TRUNCATED + MOVE 'Y' TO WS-FIELD-TRUNC-FLAG + MOVE 'W' TO WS-SEVERITY + ADD 1 TO WS-TOT-WARNINGS + STRING WS-LINE-COUNT ' WARNING Field1 ' + 'Truncated to 30 chars' + DELIMITED BY SIZE INTO ERR-REC + WRITE ERR-REC + IF WS-ERR-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' WRITE ERROR: ERROR-REPORT status=' + WS-ERR-STATUS + END-IF + END-IF. + + *> Truncation check: Field2 > 30 chars + IF FUNCTION LENGTH(FUNCTION TRIM(WS-FIELD2)) > 30 + ADD 1 TO WS-TRUNC-CNT + ADD 1 TO WS-TOT-TRUNCATED + MOVE 'Y' TO WS-FIELD-TRUNC-FLAG + MOVE 'W' TO WS-SEVERITY + ADD 1 TO WS-TOT-WARNINGS + STRING WS-LINE-COUNT ' WARNING Field2 ' + 'Truncated to 30 chars' + DELIMITED BY SIZE INTO ERR-REC + WRITE ERR-REC + IF WS-ERR-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' WRITE ERROR: ERROR-REPORT status=' + WS-ERR-STATUS + END-IF + END-IF. + + *> Numeric check: Field2 + IF WS-FIELD2 NOT = SPACES + MOVE 'Y' TO WS-ALL-NUMERIC + MOVE WS-FIELD2 TO WS-DISP-BUFFER + INSPECT WS-DISP-BUFFER REPLACING ALL SPACES BY '0' + PERFORM VARYING WS-IDX FROM 1 BY 1 + UNTIL WS-IDX > 30 OR WS-ALL-NUMERIC = 'N' + MOVE WS-DISP-BUFFER(WS-IDX:1) TO WS-CHAR-CHK + IF WS-CHAR-CHK < '0' OR > '9' + MOVE 'N' TO WS-ALL-NUMERIC + END-IF + END-PERFORM + IF WS-ALL-NUMERIC = 'N' + MOVE 'N' TO WS-FIELD2-OK + MOVE 'W' TO WS-SEVERITY + ADD 1 TO WS-TOT-WARNINGS + STRING WS-LINE-COUNT ' WARNING Field2 ' + 'Non-numeric content' + DELIMITED BY SIZE INTO ERR-REC + WRITE ERR-REC + IF WS-ERR-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' WRITE ERROR: ERROR-REPORT status=' + WS-ERR-STATUS + END-IF + END-IF + END-IF. + + *> Truncation check: Field3 > 30 chars + IF FUNCTION LENGTH(FUNCTION TRIM(WS-FIELD3)) > 30 + ADD 1 TO WS-TRUNC-CNT + ADD 1 TO WS-TOT-TRUNCATED + MOVE 'Y' TO WS-FIELD-TRUNC-FLAG + MOVE 'W' TO WS-SEVERITY + ADD 1 TO WS-TOT-WARNINGS + STRING WS-LINE-COUNT ' WARNING Field3 ' + 'Truncated to 30 chars' + DELIMITED BY SIZE INTO ERR-REC + WRITE ERR-REC + IF WS-ERR-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' WRITE ERROR: ERROR-REPORT status=' + WS-ERR-STATUS + END-IF + END-IF. + + *> Numeric check: Field3 + IF WS-FIELD3 > SPACES + MOVE 'Y' TO WS-ALL-NUMERIC + MOVE WS-FIELD3 TO WS-DISP-BUFFER + INSPECT WS-DISP-BUFFER REPLACING ALL SPACES BY '0' + PERFORM VARYING WS-IDX FROM 1 BY 1 + UNTIL WS-IDX > 30 OR WS-ALL-NUMERIC = 'N' + MOVE WS-DISP-BUFFER(WS-IDX:1) TO WS-CHAR-CHK + IF WS-CHAR-CHK < '0' OR > '9' + MOVE 'N' TO WS-ALL-NUMERIC + END-IF + END-PERFORM + IF WS-ALL-NUMERIC = 'N' + MOVE 'N' TO WS-FIELD3-OK + MOVE 'W' TO WS-SEVERITY + ADD 1 TO WS-TOT-WARNINGS + STRING WS-LINE-COUNT ' WARNING Field3 ' + 'Non-numeric content' + DELIMITED BY SIZE INTO ERR-REC + WRITE ERR-REC + IF WS-ERR-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' WRITE ERROR: ERROR-REPORT status=' + WS-ERR-STATUS + END-IF + END-IF + END-IF. + + *> If record is valid (no ERROR severity), process it + IF WS-VALID-FLAG = 'Y' + PERFORM 3200-PROCESS-RECORD + ELSE + DISPLAY WS-TS-DISPLAY ' Record ' WS-LINE-COUNT + ' skipped due to validation errors' + END-IF. + + *> ===== 3200-PROCESS-RECORD ===== + 3200-PROCESS-RECORD SECTION. + 3200-START. + PERFORM 3300-WRITE-OUTPUT. + + *> Update per-field hash totals for batch control + COMPUTE WS-HASH-FIELD1 = WS-HASH-FIELD1 + + FUNCTION LENGTH(FUNCTION TRIM(WS-FIELD1)) + COMPUTE WS-HASH-FIELD2 = WS-HASH-FIELD2 + + FUNCTION LENGTH(FUNCTION TRIM(WS-FIELD2)) + COMPUTE WS-HASH-FIELD3 = WS-HASH-FIELD3 + + FUNCTION LENGTH(FUNCTION TRIM(WS-FIELD3)). + + *> ===== 3300-WRITE-OUTPUT ===== + 3300-WRITE-OUTPUT SECTION. + 3300-START. + *> Build output record from parsed fields (original logic preserved) + MOVE SPACES TO WS-OUT-LINE. + STRING WS-FIELD1 DELIMITED BY SPACES + '|' + WS-FIELD2 DELIMITED BY SPACES + '|' + WS-FIELD3 DELIMITED BY SPACES + INTO WS-OUT-LINE + END-STRING. + MOVE WS-OUT-LINE TO OUT-REC. + WRITE OUT-REC. + + *> FILE STATUS check after EVERY write + IF WS-FILE-OUT-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' WRITE ERROR: FILE-OUT status=' + WS-FILE-OUT-STATUS + MOVE 'E' TO WS-SEVERITY + ADD 1 TO WS-TOT-ERRORS + END-IF. + + ADD 1 TO WS-REC-COUNT. + ADD 1 TO WS-TOT-WRITTEN. + + *> Combined hash total: sum of all field lengths + COMPUTE WS-HASH-FIELD-LEN = + FUNCTION LENGTH(FUNCTION TRIM(WS-FIELD1)) + + FUNCTION LENGTH(FUNCTION TRIM(WS-FIELD2)) + + FUNCTION LENGTH(FUNCTION TRIM(WS-FIELD3)). + ADD WS-HASH-FIELD-LEN TO WS-HASH-TOTAL. + + + *> ===== 4000-REPORT ===== + 4000-REPORT SECTION. + 4000-START. + DISPLAY WS-TS-DISPLAY '4000-REPORT: Finalizing error report'. + + *> Write error report trailer + MOVE SPACES TO ERR-REC. + MOVE '--- End of CSV Error Detail Report ---' TO ERR-REC. + WRITE ERR-REC. + IF WS-ERR-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' WRITE ERROR: ERROR-REPORT status=' + WS-ERR-STATUS + END-IF. + + *> Write error summary to error report + MOVE SPACES TO ERR-REC. + WRITE ERR-REC. + IF WS-ERR-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' WRITE ERROR: ERROR-REPORT status=' + WS-ERR-STATUS + END-IF. + + MOVE WS-LINE-COUNT TO WS-RPT-COUNT. + STRING 'Total input lines: ' WS-RPT-COUNT + INTO ERR-REC. + WRITE ERR-REC. + IF WS-ERR-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' WRITE ERROR: ERROR-REPORT status=' + WS-ERR-STATUS + END-IF. + + MOVE WS-MALFORMED-CNT TO WS-RPT-COUNT. + STRING 'Malformed records: ' WS-RPT-COUNT + INTO ERR-REC. + WRITE ERR-REC. + IF WS-ERR-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' WRITE ERROR: ERROR-REPORT status=' + WS-ERR-STATUS + END-IF. + + MOVE WS-TRUNC-CNT TO WS-RPT-COUNT. + STRING 'Truncation warns: ' WS-RPT-COUNT + INTO ERR-REC. + WRITE ERR-REC. + IF WS-ERR-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' WRITE ERROR: ERROR-REPORT status=' + WS-ERR-STATUS + END-IF. + + MOVE WS-FIELD-COUNT-ERR TO WS-RPT-COUNT. + STRING 'Field count errors: ' WS-RPT-COUNT + INTO ERR-REC. + WRITE ERR-REC. + IF WS-ERR-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' WRITE ERROR: ERROR-REPORT status=' + WS-ERR-STATUS + END-IF. + + *> Record count reconciliation summary + IF WS-LINE-COUNT = WS-REC-COUNT + MOVE 'PASS' TO WS-RPT-LINE + ELSE + MOVE 'MISMATCH (see audit)' TO WS-RPT-LINE + MOVE 'N' TO WS-RECONCILE-OK + END-IF. + STRING 'Count reconcile: ' WS-RPT-LINE + INTO ERR-REC. + WRITE ERR-REC. + IF WS-ERR-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' WRITE ERROR: ERROR-REPORT status=' + WS-ERR-STATUS + END-IF. + + *> Close error report with STATUS check + CLOSE ERROR-REPORT. + IF WS-ERR-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' CLOSE ERROR: ERROR-REPORT status=' + WS-ERR-STATUS + END-IF. + DISPLAY WS-TS-DISPLAY ' 4000-REPORT: Error report closed'. + + *> ===== 5000-AUDIT ===== + 5000-AUDIT SECTION. + 5000-START. + DISPLAY WS-TS-DISPLAY + '5000-AUDIT: audit report and control totals'. + + *> Audit header + MOVE '=== CSV Import Summary ===' TO AUD-REC. + WRITE AUD-REC. + IF WS-AUDIT-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' WRITE ERROR: AUDIT-FILE status=' + WS-AUDIT-STATUS + END-IF. + + MOVE SPACES TO AUD-REC. + WRITE AUD-REC. + IF WS-AUDIT-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' WRITE ERROR: AUDIT-FILE status=' + WS-AUDIT-STATUS + END-IF. + + *> Batch run identification + STRING 'Program: CsvFbNoLf' INTO AUD-REC. + WRITE AUD-REC. + IF WS-AUDIT-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' WRITE ERROR: AUDIT-FILE status=' + WS-AUDIT-STATUS + END-IF. + + STRING 'Run date: ' WS-CUR-DATE-DISP + INTO AUD-REC. + WRITE AUD-REC. + IF WS-AUDIT-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' WRITE ERROR: AUDIT-FILE status=' + WS-AUDIT-STATUS + END-IF. + + STRING 'Run time: ' WS-CUR-TIME-DISP + INTO AUD-REC. + WRITE AUD-REC. + IF WS-AUDIT-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' WRITE ERROR: AUDIT-FILE status=' + WS-AUDIT-STATUS + END-IF. + + MOVE SPACES TO AUD-REC. + WRITE AUD-REC. + + *> Record counts + MOVE WS-LINE-COUNT TO WS-RPT-COUNT. + STRING 'Input lines read: ' WS-RPT-COUNT + INTO AUD-REC. + WRITE AUD-REC. + + MOVE WS-REC-COUNT TO WS-RPT-COUNT. + STRING 'Output records written: ' WS-RPT-COUNT + INTO AUD-REC. + WRITE AUD-REC. + + *> Record count reconciliation + IF WS-LINE-COUNT = WS-REC-COUNT + MOVE 'PASS' TO WS-RPT-LINE + ELSE + MOVE 'MISMATCH (see details)' TO WS-RPT-LINE + MOVE 'N' TO WS-RECONCILE-OK + END-IF. + STRING 'Line vs record reconcile: ' WS-RPT-LINE + INTO AUD-REC. + WRITE AUD-REC. + + *> Error counts + MOVE WS-MALFORMED-CNT TO WS-RPT-COUNT. + STRING 'Malformed records: ' WS-RPT-COUNT + INTO AUD-REC. + WRITE AUD-REC. + + MOVE WS-TRUNC-CNT TO WS-RPT-COUNT. + STRING 'Truncation warnings: ' WS-RPT-COUNT + INTO AUD-REC. + WRITE AUD-REC. + + MOVE WS-FIELD-COUNT-ERR TO WS-RPT-COUNT. + STRING 'Field count errors: ' WS-RPT-COUNT + INTO AUD-REC. + WRITE AUD-REC. + + MOVE WS-TOT-QUOTE-ERR TO WS-RPT-COUNT. + STRING 'Quote errors: ' WS-RPT-COUNT + INTO AUD-REC. + WRITE AUD-REC. + + MOVE SPACES TO AUD-REC. + WRITE AUD-REC. + + *> ------------------------ + *> Batch Control Totals + *> ------------------------ + MOVE '=== Batch Control Totals ===' TO AUD-REC. + WRITE AUD-REC. + + MOVE WS-REC-COUNT TO WS-RPT-COUNT. + STRING 'Record count total: ' WS-RPT-COUNT + INTO AUD-REC. + WRITE AUD-REC. + + MOVE WS-HASH-FIELD1 TO WS-RPT-COUNT9. + STRING 'Hash total Field1: ' WS-RPT-COUNT9 + INTO AUD-REC. + WRITE AUD-REC. + + MOVE WS-HASH-FIELD2 TO WS-RPT-COUNT9. + STRING 'Hash total Field2: ' WS-RPT-COUNT9 + INTO AUD-REC. + WRITE AUD-REC. + + MOVE WS-HASH-FIELD3 TO WS-RPT-COUNT9. + STRING 'Hash total Field3: ' WS-RPT-COUNT9 + INTO AUD-REC. + WRITE AUD-REC. + + MOVE WS-HASH-TOTAL TO WS-RPT-COUNT9. + STRING 'Combined hash total: ' WS-RPT-COUNT9 + INTO AUD-REC. + WRITE AUD-REC. + + MOVE SPACES TO AUD-REC. + WRITE AUD-REC. + + *> Processing success rate + IF WS-LINE-COUNT > 0 + COMPUTE WS-RPT-PCT ROUNDED = + (WS-REC-COUNT / WS-LINE-COUNT) * 100 + STRING 'Processing success rate: ' + WS-RPT-PCT '%' + INTO AUD-REC + WRITE AUD-REC + IF WS-AUDIT-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' WRITE ERROR: AUDIT-FILE status=' + WS-AUDIT-STATUS + END-IF + END-IF. + + MOVE SPACES TO AUD-REC. + WRITE AUD-REC. + + *> Audit trailer + MOVE '=== End of CSV Audit Report ===' TO AUD-REC. + WRITE AUD-REC. + IF WS-AUDIT-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' WRITE ERROR: AUDIT-FILE status=' + WS-AUDIT-STATUS + END-IF. + + *> Close audit file with STATUS check + CLOSE AUDIT-FILE. + IF WS-AUDIT-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' CLOSE ERROR: AUDIT-FILE status=' + WS-AUDIT-STATUS + END-IF. + DISPLAY WS-TS-DISPLAY ' 5000-AUDIT: Audit file closed'. + + *> ===== 6000-ERROR-HANDLE ===== + 6000-ERROR-HANDLE SECTION. + 6000-START. + DISPLAY WS-TS-DISPLAY + ' 6000-ERROR-HANDLE: Error summary'. + + *> FILE-IN status summary + IF WS-FILE-IN-STATUS NOT = '00' + AND NOT = '10' + DISPLAY WS-TS-DISPLAY ' FILE-IN status: ' + WS-FILE-IN-STATUS + ADD 1 TO WS-TOT-ERRORS + ELSE + DISPLAY WS-TS-DISPLAY ' FILE-IN status OK (' + WS-FILE-IN-STATUS ')' + END-IF. + + *> FILE-OUT status summary + IF WS-FILE-OUT-STATUS NOT = '00' + AND NOT = '10' + DISPLAY WS-TS-DISPLAY ' FILE-OUT status: ' + WS-FILE-OUT-STATUS + ADD 1 TO WS-TOT-ERRORS + ELSE + DISPLAY WS-TS-DISPLAY ' FILE-OUT status OK (' + WS-FILE-OUT-STATUS ')' + END-IF. + + *> ERROR-REPORT status summary + IF WS-ERR-STATUS NOT = '00' + AND NOT = '10' + DISPLAY WS-TS-DISPLAY ' ERROR-REPORT status: ' + WS-ERR-STATUS + ADD 1 TO WS-TOT-ERRORS + ELSE + DISPLAY WS-TS-DISPLAY ' ERROR-REPORT status OK (' + WS-ERR-STATUS ')' + END-IF. + + *> AUDIT-FILE status summary + IF WS-AUDIT-STATUS NOT = '00' + AND NOT = '10' + DISPLAY WS-TS-DISPLAY ' AUDIT-FILE status: ' + WS-AUDIT-STATUS + ADD 1 TO WS-TOT-ERRORS + ELSE + DISPLAY WS-TS-DISPLAY ' AUDIT-FILE status OK (' + WS-AUDIT-STATUS ')' + END-IF. + + *> Error count summary with severity breakdown + DISPLAY WS-TS-DISPLAY ' Severity totals:' + MOVE WS-TOT-WARNINGS TO WS-RPT-COUNT9 + DISPLAY ' Warnings: ' WS-RPT-COUNT9 + MOVE WS-TOT-ERRORS TO WS-RPT-COUNT9 + DISPLAY ' Errors: ' WS-RPT-COUNT9 + MOVE WS-TOT-CRITICAL TO WS-RPT-COUNT9 + DISPLAY ' Critical: ' WS-RPT-COUNT9. + + *> Record count reconciliation check + IF WS-LINE-COUNT NOT = WS-REC-COUNT + DISPLAY WS-TS-DISPLAY + ' WARNING: Line/output count mismatch' + MOVE 'N' TO WS-RECONCILE-OK + END-IF. + + *> ===== 9000-EXIT ===== + 9000-EXIT SECTION. + 9000-START. + DISPLAY WS-TS-DISPLAY + ' 9000-EXIT: Program CsvFbNoLf completed'. + + *> Final record counts display + MOVE WS-LINE-COUNT TO WS-RPT-COUNT. + MOVE WS-REC-COUNT TO WS-LINE-DISP. + DISPLAY ' Input lines: ' WS-RPT-COUNT. + MOVE WS-REC-COUNT TO WS-RPT-COUNT. + DISPLAY ' Output recs: ' WS-RPT-COUNT. + DISPLAY ' Reconcile: ' WS-RECONCILE-OK. + + *> Error counts display + MOVE WS-MALFORMED-CNT TO WS-RPT-COUNT. + DISPLAY ' Malformed: ' WS-RPT-COUNT. + MOVE WS-TRUNC-CNT TO WS-RPT-COUNT. + DISPLAY ' Truncated: ' WS-RPT-COUNT. + MOVE WS-FIELD-COUNT-ERR TO WS-RPT-COUNT. + DISPLAY ' Field err: ' WS-RPT-COUNT. + + *> Hash total display + MOVE WS-HASH-TOTAL TO WS-RPT-COUNT9. + DISPLAY ' Hash total: ' WS-RPT-COUNT9. + + *> Output file listing + DISPLAY ' Output file: file-out.dat'. + DISPLAY ' Error report: csv-errors.dat'. + DISPLAY ' Audit report: csv-audit.dat'. + + *> Close FILE-OUT with STATUS check + CLOSE FILE-OUT. + IF WS-FILE-OUT-STATUS NOT = '00' + DISPLAY WS-TS-DISPLAY + ' CLOSE ERROR: FILE-OUT status=' + WS-FILE-OUT-STATUS + END-IF. + DISPLAY WS-TS-DISPLAY ' FILE-OUT closed, status=' + WS-FILE-OUT-STATUS. + + *> Set return code based on reconciliation status + IF WS-RECONCILE-OK = 'N' + MOVE 4 TO RETURN-CODE + DISPLAY WS-TS-DISPLAY + ' RETURN-CODE=4 (reconciliation mismatch)' + ELSE + MOVE 0 TO RETURN-CODE + DISPLAY WS-TS-DISPLAY + ' RETURN-CODE=0 (normal completion)' + END-IF. + + *> Terminate program + STOP RUN. + + *> ===== PARSE-CSV-LINE (original logic, UNCHANGED) ===== + PARSE-CSV-LINE. + MOVE SPACES TO WS-FIELDS. + MOVE 1 TO WS-POS. + MOVE 1 TO WS-FIELD-NUM. + MOVE 1 TO WS-CHAR-OFFSET. + MOVE 'N' TO WS-IN-QUOTE. + + PERFORM VARYING WS-POS FROM 1 BY 1 + UNTIL WS-POS > 200 + OR WS-FIELD-NUM > 3 + MOVE IN-LINE(WS-POS:1) TO WS-CHAR + IF WS-CHAR = '"' + IF WS-IN-QUOTE-YES + MOVE 'N' TO WS-IN-QUOTE + ELSE + MOVE 'Y' TO WS-IN-QUOTE + END-IF + ELSE + IF WS-CHAR = ',' AND NOT WS-IN-QUOTE-YES + ADD 1 TO WS-FIELD-NUM + MOVE 1 TO WS-CHAR-OFFSET + ELSE + IF WS-CHAR NOT = SPACE + OR WS-CHAR-OFFSET > 1 + THEN + PERFORM SAVE-CHAR-TO-FIELD + END-IF + IF WS-CHAR-OFFSET < 30 + ADD 1 TO WS-CHAR-OFFSET + END-IF + END-IF + END-IF + END-PERFORM. + + *> ===== SAVE-CHAR-TO-FIELD (original, UNCHANGED) ===== + SAVE-CHAR-TO-FIELD. + EVALUATE WS-FIELD-NUM + WHEN 1 + MOVE WS-CHAR TO WS-FIELD1(WS-CHAR-OFFSET:1) + WHEN 2 + MOVE WS-CHAR TO WS-FIELD2(WS-CHAR-OFFSET:1) + WHEN 3 + MOVE WS-CHAR TO WS-FIELD3(WS-CHAR-OFFSET:1) + END-EVALUATE. + + END PROGRAM CsvFbNoLf. diff --git a/benchmark-programs/15-csv-fb-nolf/main-csv-anomaly.cbl b/benchmark-programs/15-csv-fb-nolf/main-csv-anomaly.cbl new file mode 100644 index 0000000..5b3fedb --- /dev/null +++ b/benchmark-programs/15-csv-fb-nolf/main-csv-anomaly.cbl @@ -0,0 +1,132 @@ + *> ============================================================ + *> main-csv-anomaly : CDR CSV异常系测试 (CSV Anomaly) + *> Input : CSV-IN (CSV-INPUT.DAT: 异常CSV数据) + *> Output: FB-OUT (FB-OUTPUT.DAT: 固定长输出) + *> Coverage: CF-A001, CF-A002 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. CsvAnomaly. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT CSV-IN ASSIGN TO "CSV-INPUT.DAT" + ORGANIZATION IS LINE SEQUENTIAL. + + SELECT FB-OUT ASSIGN TO "FB-OUTPUT.DAT" + ORGANIZATION IS SEQUENTIAL. + + DATA DIVISION. + FILE SECTION. + FD CSV-IN RECORD VARYING FROM 1 TO 200. + 01 CSV-REC PIC X(200). + + FD FB-OUT RECORD CONTAINS 40 CHARACTERS. + 01 FB-REC. + 05 FB-FIELD1 PIC X(10). + 05 FB-FIELD2 PIC X(10). + 05 FB-FIELD3 PIC X(10). + 05 FB-FIELD4 PIC X(10). + + WORKING-STORAGE SECTION. + 01 WS-EOF PIC X(1) VALUE 'N'. + 88 WS-EOF-Y VALUE 'Y' FALSE 'N'. + 01 WS-COUNT PIC 9(10). + 01 WS-ERR-COUNT PIC 9(10). + 01 WS-QUOTE-OPEN PIC X(1) VALUE 'N'. + 88 WS-QUOTE-OPEN-Y VALUE 'Y' FALSE 'N'. + 01 WS-PASS PIC 9(2) VALUE 0. + 01 WS-FAIL PIC 9(2) VALUE 0. + 01 WS-TRIM-CSV PIC X(200). + + 01 WS-CDR-REC. + COPY "telecom/TEL-CDR.cpy". + + PROCEDURE DIVISION. + MAIN. + DISPLAY "CSV-ANOMALY: Starting CSV anomaly tests" + + *> CF-A002: 引用符未閉じ → 殘り全部1項目 + DISPLAY "CF-A002: Unclosed quote test" + OPEN OUTPUT CSV-IN. + MOVE '"Field1","Field2","Field3,no-close' TO CSV-REC. + WRITE CSV-REC. + CLOSE CSV-IN. + + OPEN INPUT CSV-IN. + OPEN OUTPUT FB-OUT. + READ CSV-IN INTO WS-TRIM-CSV + AT END + DISPLAY "CF-A002: Empty read" + NOT AT END + STRING WS-TRIM-CSV(1:10) WS-TRIM-CSV(11:10) + WS-TRIM-CSV(21:10) "TRUNCATED" + DELIMITED BY SIZE INTO FB-REC + END-STRING + WRITE FB-REC + ADD 1 TO WS-COUNT + DISPLAY "CF-A002: Unclosed quote handled" + END-READ. + CLOSE CSV-IN FB-OUT. + + IF WS-COUNT > 0 + ADD 1 TO WS-PASS + DISPLAY "CF-A002: PASS - unclosed quote processed" + ELSE + ADD 1 TO WS-FAIL + DISPLAY "CF-A002: FAIL" + END-IF. + + *> CF-A001: 改行位置超出RECORD長 + DISPLAY "CF-A001: Line exceeding record length" + OPEN OUTPUT CSV-IN. + MOVE SPACES TO CSV-REC. + STRING "SHORT,OKAY,THREE" + DELIMITED BY SIZE INTO CSV-REC + END-STRING. + WRITE CSV-REC. + + MOVE SPACES TO CSV-REC. + STRING "LONG-FIELD-A,LONG-FIELD-B,LONG-FIELD-C," + "VERY-LONG-FIELD-D,EXTRA-LONG-FIELD-E" + DELIMITED BY SIZE INTO CSV-REC + END-STRING. + WRITE CSV-REC. + CLOSE CSV-IN. + + OPEN INPUT CSV-IN. + OPEN OUTPUT FB-OUT. + MOVE 0 TO WS-COUNT. + MOVE 'N' TO WS-EOF. + PERFORM UNTIL WS-EOF-Y + READ CSV-IN INTO WS-TRIM-CSV + AT END SET WS-EOF-Y TO TRUE + NOT AT END + ADD 1 TO WS-COUNT + MOVE WS-TRIM-CSV(1:10) TO FB-FIELD1 + MOVE WS-TRIM-CSV(12:10) TO FB-FIELD2 + WRITE FB-REC + END-READ + END-PERFORM. + CLOSE CSV-IN FB-OUT. + + IF WS-COUNT = 2 + ADD 1 TO WS-PASS + DISPLAY "CF-A001: PASS - overlong handled (2 records)" + ELSE + ADD 1 TO WS-FAIL + DISPLAY "CF-A001: FAIL - count=" WS-COUNT + END-IF. + + DISPLAY " " + DISPLAY "CSV-ANOMALY: PASS=" WS-PASS " FAIL=" WS-FAIL + IF WS-FAIL = 0 + DISPLAY "CSV-ANOMALY: ALL PASSED" + STOP RUN RETURNING 0 + ELSE + DISPLAY "CSV-ANOMALY: FAILED" + STOP RUN RETURNING 1 + END-IF + . + + END PROGRAM CsvAnomaly. diff --git a/benchmark-programs/16-matching-2stage-1-1/README.md b/benchmark-programs/16-matching-2stage-1-1/README.md new file mode 100644 index 0000000..6a8f215 --- /dev/null +++ b/benchmark-programs/16-matching-2stage-1-1/README.md @@ -0,0 +1,71 @@ +# 16-matching-2stage-1-1: Two-Stage 1:1 Matching + +## 电信业务场景 + +二级请求书核对。两段式1:1对账处理。第一段:请求书与支付对账→中间文件；第二段:中间文件与调整记录对账→最终结果。 + +## Description + +Tests a two-stage pipeline where the output of the first 1:1 match feeds +into a second 1:1 match. Three-way chained matching across FILE-A, FILE-B, +and FILE-C using an intermediate TEMP-FILE. + +- Stage 1: Match FILE-A and FILE-B (1:1), write matched A-side records to + TEMP-FILE. Unmatched records (KEY00004 in A, KEY00005 in B) are skipped. +- Stage 2: Match TEMP-FILE and FILE-C (1:1), write matched records to + FINAL-OUT. Unmatched C records (KEY00006) are skipped. + +## Record Layout + +| Field | Type | Length | Description | +|------------|-----------------|--------|---------------------------| +| STD-KEY | PIC X | 10 | Record key | +| STD-DATA-1 | PIC X | 20 | Description text | +| STD-DATA-2 | PIC 9 | 10 | Numeric data (display) | +| STD-DATA-3 | PIC S9(7)V99 | 05 | Numeric data (COMP-3) | + +Total record length: 45 bytes. + +## Files + +| File | Purpose | +|-------------------------------|--------------------------------------| +| main-16-matching-2stage-1-1.cbl| Main COBOL program (two stages) | +| data-gen.sh | Generate three test data files | +| run.sh | Compile, run, verify | +| README.md | This file | + +## Data + +| File | Records | +|-------------|--------------------------------------------------------| +| file-a.dat | KEY00001, KEY00002, KEY00003, KEY00004 (unmatched) | +| file-b.dat | KEY00001, KEY00002, KEY00003, KEY00005 (unmatched) | +| file-c.dat | KEY00001, KEY00002, KEY00003, KEY00006 (unmatched) | + +The matching chain: KEY00001, KEY00002, KEY00003 exist in all three files +and should survive both stages. The unmatched extras are discarded. + +## Matching Logic + +Each stage implements standard 1:1 sorted merge/match: +1. Compare keys from both input streams. +2. If keys are equal, write a matched record and advance both. +3. If keys differ, advance the stream with the smaller key (skip it). +4. Continue until one stream is exhausted. + +## Test + +| Check | Expected | +|--------------------------|-----------------------------------| +| Stage 1 output (temp) | 3 records x 45 = 135 bytes | +| Stage 2 output (final) | 3 records x 45 = 135 bytes | +| Matched chain | KEY00001, KEY00002, KEY00003 | +| Unmatched filtered | KEY00004, KEY00005, KEY00006 | + +## Usage + +```bash +cd 16-matching-2stage-1-1 +bash run.sh +``` diff --git a/benchmark-programs/16-matching-2stage-1-1/TEMP.DAT b/benchmark-programs/16-matching-2stage-1-1/TEMP.DAT new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/16-matching-2stage-1-1/TEMP.DAT @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/16-matching-2stage-1-1/audit-report.txt b/benchmark-programs/16-matching-2stage-1-1/audit-report.txt new file mode 100644 index 0000000..829c294 --- /dev/null +++ b/benchmark-programs/16-matching-2stage-1-1/audit-report.txt @@ -0,0 +1,36 @@ +RECORD COUNT SUMMARY: +STAGE 1 (A x B): + A-file records read : 00002 + B-file records read : 00002 + Stage1 matched (temp) : 00002 + Unmatched A records : 00000 + Unmatched B records : 00000 +STAGE 2 (TEMP x C): + C-file records read : 00002 + Stage2 matched (final) : 00002 + Unmatched temp records : 00000 + Unmatched C records : 00000 + +HASH TOTAL RECONCILIATION: + A-file input hash : 000000006060606 + B-file input hash : 000000000000000 + Temp hash (s1 match): 000000006060606 + C-file input hash : 000000000000000 + Final output hash : 000000006060606 + +INTER-STAGE RECONCILIATION: + Stage1 temp records : 00002 + Stage2 final records : 00002 + Stage count: VERIFIED (1:1 pass-through) + Stage hash: VERIFIED (final+err=temp) + +STAGE TIMING (HHMMSS format): + Stage 1 start : 16351624 + Stage 1 end : 16351628 + Stage 2 start : 16351628 + Stage 2 end : 16351629 + Sequence errors: 00000 + +================================================ +END OF AUDIT REPORT +Generated: 20260622 16351624 diff --git a/benchmark-programs/16-matching-2stage-1-1/error.dat b/benchmark-programs/16-matching-2stage-1-1/error.dat new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/16-matching-2stage-1-1/file-a.dat b/benchmark-programs/16-matching-2stage-1-1/file-a.dat new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/16-matching-2stage-1-1/file-a.dat @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/16-matching-2stage-1-1/file-b.dat b/benchmark-programs/16-matching-2stage-1-1/file-b.dat new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/16-matching-2stage-1-1/file-b.dat @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/16-matching-2stage-1-1/file-c.dat b/benchmark-programs/16-matching-2stage-1-1/file-c.dat new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/16-matching-2stage-1-1/file-c.dat @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/16-matching-2stage-1-1/final.dat b/benchmark-programs/16-matching-2stage-1-1/final.dat new file mode 100644 index 0000000..8fbecaa --- /dev/null +++ b/benchmark-programs/16-matching-2stage-1-1/final.dat @@ -0,0 +1 @@ + 0000000000000000000 000000000000000 \ No newline at end of file diff --git a/benchmark-programs/16-matching-2stage-1-1/main-16-matching-2stage-1-1.cbl b/benchmark-programs/16-matching-2stage-1-1/main-16-matching-2stage-1-1.cbl new file mode 100644 index 0000000..d657f6d --- /dev/null +++ b/benchmark-programs/16-matching-2stage-1-1/main-16-matching-2stage-1-1.cbl @@ -0,0 +1,925 @@ + *> ============================================================ + *> 16-matching-2stage-1-1 : 二级请求书核对 (2-Stage Invoice Rec) + *> Input : FILE-A (file-a.dat: 请求书), FILE-B (file-b.dat: 支付), FILE-C (file-c.dat: 参照) + *> Output: FINAL-OUT (final.dat: 二级核对结果) + *> error.dat (一级/二级未匹配记录) + *> audit-report.txt (审计报告: 处理统计) + *> Coverage: AM-N001, AM-A001, AM-R001 + *> stage-level control totals, inter-stage reconciliation, + *> stage timing measurement, audit trail + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. Match2Stage. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + *> Stage 1 files + SELECT FILE-A ASSIGN TO 'file-a.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-A-STATUS. + SELECT FILE-B ASSIGN TO 'file-b.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-B-STATUS. + SELECT TEMP-FILE ASSIGN TO 'temp.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-TEMP-STATUS. + *> Stage 2 files + SELECT FILE-C ASSIGN TO 'file-c.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-C-STATUS. + SELECT FINAL-OUT ASSIGN TO 'final.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FINAL-STATUS. + SELECT FILE-ERR ASSIGN TO 'error.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-ERR-STATUS. + SELECT AUDIT-FILE ASSIGN TO 'audit-report.txt' + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-AUDIT-STATUS. + + DATA DIVISION. + FILE SECTION. + FD FILE-A. + 01 A-REC. + COPY "STD-REC.cpy". + FD FILE-B. + 01 B-REC. + COPY "STD-REC.cpy". + FD TEMP-FILE. + 01 TEMP-REC. + COPY "STD-REC.cpy". + FD FILE-C. + 01 C-REC. + COPY "STD-REC.cpy". + FD FINAL-OUT. + 01 FINAL-REC. + COPY "STD-REC.cpy". + FD FILE-ERR. + 01 ERR-REC. + 05 ERR-STAGE PIC X(10). + 05 ERR-KEY PIC X(10). + 05 ERR-AMOUNT PIC 9(10). + 05 ERR-FILLER PIC X(50). + FD AUDIT-FILE. + 01 AUDIT-REC PIC X(120). + + WORKING-STORAGE SECTION. + 01 WS-TELECOM-REC. + COPY "telecom/TEL-INVOICE.cpy". + + *> File status + 01 WS-A-STATUS PIC X(02). + 01 WS-B-STATUS PIC X(02). + 01 WS-TEMP-STATUS PIC X(02). + 01 WS-C-STATUS PIC X(02). + 01 WS-FINAL-STATUS PIC X(02). + 01 WS-ERR-STATUS PIC X(02). + 01 WS-AUDIT-STATUS PIC X(02). + + *> EOF flags + 01 WS-EOF-A PIC X(01) VALUE 'N'. + 88 WS-EOF-A-YES VALUE 'Y' FALSE 'N'. + 01 WS-EOF-B PIC X(01) VALUE 'N'. + 88 WS-EOF-B-YES VALUE 'Y' FALSE 'N'. + 01 WS-EOF-TEMP PIC X(01) VALUE 'N'. + 88 WS-EOF-TEMP-YES VALUE 'Y' FALSE 'N'. + 01 WS-EOF-C PIC X(01) VALUE 'N'. + 88 WS-EOF-C-YES VALUE 'Y' FALSE 'N'. + + *> Key variables + 01 WS-KEY-A PIC X(10). + 01 WS-KEY-B PIC X(10). + 01 WS-KEY-TEMP PIC X(10). + 01 WS-KEY-C PIC X(10). + 01 WS-PREV-KEY-A PIC X(10). + 01 WS-PREV-KEY-B PIC X(10). + + *> Counters + 01 WS-STAGE1-COUNT PIC 9(05) VALUE ZERO. + 01 WS-STAGE2-COUNT PIC 9(05) VALUE ZERO. + 01 WS-A-READ-COUNT PIC 9(05) VALUE ZERO. + 01 WS-B-READ-COUNT PIC 9(05) VALUE ZERO. + 01 WS-C-READ-COUNT PIC 9(05) VALUE ZERO. + 01 WS-UNMATCH-A PIC 9(05) VALUE ZERO. + 01 WS-UNMATCH-B PIC 9(05) VALUE ZERO. + 01 WS-UNMATCH-TEMP PIC 9(05) VALUE ZERO. + 01 WS-UNMATCH-C PIC 9(05) VALUE ZERO. + 01 WS-WARN-COUNT PIC 9(05) VALUE ZERO. + 01 WS-FATAL-COUNT PIC 9(05) VALUE ZERO. + 01 WS-SEQ-ERR-COUNT PIC 9(05) VALUE ZERO. + + *> Hash totals + 01 WS-HASH-TOTALS. + 05 WS-HASH-A-INPUT PIC 9(15) VALUE ZERO. + 05 WS-HASH-B-INPUT PIC 9(15) VALUE ZERO. + 05 WS-HASH-TEMP PIC 9(15) VALUE ZERO. + 05 WS-HASH-C-INPUT PIC 9(15) VALUE ZERO. + 05 WS-HASH-FINAL PIC 9(15) VALUE ZERO. + 05 WS-HASH-ERR PIC 9(15) VALUE ZERO. + 05 WS-HASH-DIFF PIC S9(15) VALUE ZERO. + + *> Stage timing + 01 WS-STAGE1-START PIC 9(08). + 01 WS-STAGE1-END PIC 9(08). + 01 WS-STAGE2-START PIC 9(08). + 01 WS-STAGE2-END PIC 9(08). + 01 WS-TOTAL-ELAPSED PIC 9(08). + + *> Date and timestamp areas + 01 WS-PROC-DATE PIC 9(08). + 01 WS-PROC-TIME PIC 9(08). + 01 WS-TS-DATE PIC X(08). + 01 WS-TS-TIME PIC X(08). + + *> Amount areas + 01 WS-AMT-A PIC 9(10). + 01 WS-AMT-B PIC 9(10). + 01 WS-AMT-TEMP PIC 9(10). + 01 WS-AMT-C PIC 9(10). + 01 WS-AMT-FINAL PIC 9(10). + + *> Error message areas + 01 WS-ERR-MSG PIC X(60). + 01 WS-ERR-DETAIL PIC X(80). + + *> Program phase + 01 WS-PGM-PHASE PIC X(20). + + PROCEDURE DIVISION. + + *> ============================================================ + *> MAIN SECTION + *> ============================================================ + MAIN SECTION. + MB-PROCESS. + PERFORM 1000-INITIALIZE + + *> ============================================ + *> STAGE 1: Match FILE-A with FILE-B -> TEMP-FILE + *> (Original stage 1 logic preserved) + *> ============================================ + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-STAGE1-START + DISPLAY "[" WS-TS-DATE " " WS-TS-TIME + "] 16-MATCHING: Stage 1 starting..." + + PERFORM 2100-OPEN-STAGE1-FILES + + *> Read first records from both files (original) + READ FILE-A + AT END SET WS-EOF-A-YES TO TRUE + NOT AT END + ADD 1 TO WS-A-READ-COUNT + MOVE STD-KEY OF A-REC TO WS-KEY-A + MOVE STD-KEY OF A-REC TO WS-PREV-KEY-A + END-READ. + READ FILE-B + AT END SET WS-EOF-B-YES TO TRUE + NOT AT END + ADD 1 TO WS-B-READ-COUNT + MOVE STD-KEY OF B-REC TO WS-KEY-B + MOVE STD-KEY OF B-REC TO WS-PREV-KEY-B + END-READ. + + *> Stage 1: 1:1 merge/match loop (original algorithm) + PERFORM UNTIL WS-EOF-A-YES OR WS-EOF-B-YES + IF WS-KEY-A < WS-KEY-B + *> A record unmatched, skip it + ADD 1 TO WS-UNMATCH-A + PERFORM 5300-WRITE-ERR-UNMATCH-A + READ FILE-A + AT END SET WS-EOF-A-YES TO TRUE + NOT AT END + ADD 1 TO WS-A-READ-COUNT + MOVE STD-KEY OF A-REC TO WS-KEY-A + PERFORM 4200-CHECK-SEQ-A + MOVE STD-KEY OF A-REC TO WS-PREV-KEY-A + END-READ + ELSE IF WS-KEY-A > WS-KEY-B + *> B record unmatched, skip it + ADD 1 TO WS-UNMATCH-B + PERFORM 5400-WRITE-ERR-UNMATCH-B + READ FILE-B + AT END SET WS-EOF-B-YES TO TRUE + NOT AT END + ADD 1 TO WS-B-READ-COUNT + MOVE STD-KEY OF B-REC TO WS-KEY-B + PERFORM 4300-CHECK-SEQ-B + MOVE STD-KEY OF B-REC TO WS-PREV-KEY-B + END-READ + ELSE + *> Keys equal: match found, write A-side to temp, advance both + MOVE A-REC TO TEMP-REC + WRITE TEMP-REC + ADD 1 TO WS-STAGE1-COUNT + PERFORM 5110-ACCUMULATE-TEMP + READ FILE-A + AT END SET WS-EOF-A-YES TO TRUE + NOT AT END + ADD 1 TO WS-A-READ-COUNT + MOVE STD-KEY OF A-REC TO WS-KEY-A + PERFORM 4200-CHECK-SEQ-A + MOVE STD-KEY OF A-REC TO WS-PREV-KEY-A + END-READ + READ FILE-B + AT END SET WS-EOF-B-YES TO TRUE + NOT AT END + ADD 1 TO WS-B-READ-COUNT + MOVE STD-KEY OF B-REC TO WS-KEY-B + PERFORM 4300-CHECK-SEQ-B + MOVE STD-KEY OF B-REC TO WS-PREV-KEY-B + END-READ + END-IF + END-PERFORM. + + *> Drain remaining A records + PERFORM UNTIL WS-EOF-A-YES + ADD 1 TO WS-UNMATCH-A + PERFORM 5300-WRITE-ERR-UNMATCH-A + READ FILE-A + AT END SET WS-EOF-A-YES TO TRUE + NOT AT END + ADD 1 TO WS-A-READ-COUNT + MOVE STD-KEY OF A-REC TO WS-KEY-A + END-READ + END-PERFORM + + *> Drain remaining B records + PERFORM UNTIL WS-EOF-B-YES + ADD 1 TO WS-UNMATCH-B + PERFORM 5400-WRITE-ERR-UNMATCH-B + READ FILE-B + AT END SET WS-EOF-B-YES TO TRUE + NOT AT END + ADD 1 TO WS-B-READ-COUNT + MOVE STD-KEY OF B-REC TO WS-KEY-B + END-READ + END-PERFORM + + CLOSE FILE-A. + CLOSE FILE-B. + CLOSE TEMP-FILE. + + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-STAGE1-END + DISPLAY "[" WS-TS-DATE " " WS-TS-TIME + "] Stage 1 complete: " WS-STAGE1-COUNT + " matched records, " WS-UNMATCH-A + " A-unmatched, " WS-UNMATCH-B " B-unmatched" + + *> ================================================== + *> STAGE 2: Match TEMP-FILE with FILE-C -> FINAL-OUT + *> (Original stage 2 logic preserved) + *> ================================================== + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-STAGE2-START + DISPLAY "[" WS-TS-DATE " " WS-TS-TIME + "] 16-MATCHING: Stage 2 starting..." + + PERFORM 2200-OPEN-STAGE2-FILES + + *> Read first records + READ TEMP-FILE + AT END SET WS-EOF-TEMP-YES TO TRUE + NOT AT END + MOVE STD-KEY OF TEMP-REC TO WS-KEY-TEMP + END-READ. + READ FILE-C + AT END SET WS-EOF-C-YES TO TRUE + NOT AT END + ADD 1 TO WS-C-READ-COUNT + MOVE STD-KEY OF C-REC TO WS-KEY-C + END-READ. + + *> Stage 2: 1:1 merge/match loop (original algorithm) + PERFORM UNTIL WS-EOF-TEMP-YES OR WS-EOF-C-YES + IF WS-KEY-TEMP < WS-KEY-C + *> Temp record unmatched, skip it + ADD 1 TO WS-UNMATCH-TEMP + PERFORM 5500-WRITE-ERR-UNMATCH-TEMP + READ TEMP-FILE + AT END SET WS-EOF-TEMP-YES TO TRUE + NOT AT END + MOVE STD-KEY OF TEMP-REC TO WS-KEY-TEMP + END-READ + ELSE IF WS-KEY-TEMP > WS-KEY-C + *> C record unmatched, skip it + ADD 1 TO WS-UNMATCH-C + PERFORM 5600-WRITE-ERR-UNMATCH-C + READ FILE-C + AT END SET WS-EOF-C-YES TO TRUE + NOT AT END + ADD 1 TO WS-C-READ-COUNT + MOVE STD-KEY OF C-REC TO WS-KEY-C + END-READ + ELSE + *> Keys equal: match found, write temp-side to final, advance both + MOVE TEMP-REC TO FINAL-REC + WRITE FINAL-REC + ADD 1 TO WS-STAGE2-COUNT + PERFORM 5120-ACCUMULATE-FINAL + READ TEMP-FILE + AT END SET WS-EOF-TEMP-YES TO TRUE + NOT AT END + MOVE STD-KEY OF TEMP-REC TO WS-KEY-TEMP + END-READ + READ FILE-C + AT END SET WS-EOF-C-YES TO TRUE + NOT AT END + ADD 1 TO WS-C-READ-COUNT + MOVE STD-KEY OF C-REC TO WS-KEY-C + END-READ + END-IF + END-PERFORM. + + *> Drain remaining temp records + PERFORM UNTIL WS-EOF-TEMP-YES + ADD 1 TO WS-UNMATCH-TEMP + PERFORM 5500-WRITE-ERR-UNMATCH-TEMP + READ TEMP-FILE + AT END SET WS-EOF-TEMP-YES TO TRUE + NOT AT END + MOVE STD-KEY OF TEMP-REC TO WS-KEY-TEMP + END-READ + END-PERFORM + + *> Drain remaining C records + PERFORM UNTIL WS-EOF-C-YES + ADD 1 TO WS-UNMATCH-C + PERFORM 5600-WRITE-ERR-UNMATCH-C + READ FILE-C + AT END SET WS-EOF-C-YES TO TRUE + NOT AT END + ADD 1 TO WS-C-READ-COUNT + MOVE STD-KEY OF C-REC TO WS-KEY-C + END-READ + END-PERFORM + + CLOSE TEMP-FILE. + CLOSE FILE-C. + CLOSE FINAL-OUT. + CLOSE FILE-ERR. + + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-STAGE2-END + DISPLAY "[" WS-TS-DATE " " WS-TS-TIME + "] Stage 2 complete: " WS-STAGE2-COUNT + " final matched records" + + *> Write audit and finalize + PERFORM 7000-AUDIT-TRAIL + PERFORM 8000-FINALIZE + + DISPLAY '16-matching-2stage-1-1: PASS'. + STOP RUN. + . + + *> ============================================================ + *> 1000-INITIALIZE + *> ============================================================ + 1000-INITIALIZE. + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-PROC-DATE + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-PROC-TIME + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-TS-DATE + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-TS-TIME + + DISPLAY "============================================" + DISPLAY "16-MATCHING-2STAGE-1-1 2-Stage Invoice Rec" + DISPLAY "Version V2.00" + DISPLAY "Run date: " WS-PROC-DATE " " WS-PROC-TIME + DISPLAY "============================================" + + INITIALIZE WS-STAGE1-COUNT + INITIALIZE WS-STAGE2-COUNT + INITIALIZE WS-A-READ-COUNT + INITIALIZE WS-B-READ-COUNT + INITIALIZE WS-C-READ-COUNT + INITIALIZE WS-UNMATCH-A + INITIALIZE WS-UNMATCH-B + INITIALIZE WS-UNMATCH-TEMP + INITIALIZE WS-UNMATCH-C + INITIALIZE WS-HASH-TOTALS + INITIALIZE WS-WARN-COUNT + INITIALIZE WS-FATAL-COUNT + . + + *> ============================================================ + *> 2100-OPEN-STAGE1-FILES + *> ============================================================ + 2100-OPEN-STAGE1-FILES. + MOVE '2100-OPEN-STAGE1' TO WS-PGM-PHASE + + OPEN INPUT FILE-A. + IF WS-A-STATUS NOT = '00' + STRING "FATAL: Cannot open file-a.dat, status " + WS-A-STATUS INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF. + + OPEN INPUT FILE-B. + IF WS-B-STATUS NOT = '00' + STRING "FATAL: Cannot open file-b.dat, status " + WS-B-STATUS INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF. + + OPEN OUTPUT TEMP-FILE. + IF WS-TEMP-STATUS NOT = '00' + STRING "FATAL: Cannot open temp.dat, status " + WS-TEMP-STATUS INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF. + + OPEN OUTPUT FILE-ERR. + IF WS-ERR-STATUS NOT = '00' + STRING "FATAL: Cannot open error.dat, status " + WS-ERR-STATUS INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF. + + PERFORM 7010-WRITE-AUDIT-HEADER + . + + *> ============================================================ + *> 2200-OPEN-STAGE2-FILES + *> ============================================================ + 2200-OPEN-STAGE2-FILES. + MOVE '2200-OPEN-STAGE2' TO WS-PGM-PHASE + + OPEN INPUT TEMP-FILE. + IF WS-TEMP-STATUS NOT = '00' + STRING "FATAL: Cannot reopen temp.dat, status " + WS-TEMP-STATUS INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF. + + OPEN INPUT FILE-C. + IF WS-C-STATUS NOT = '00' + STRING "FATAL: Cannot open file-c.dat, status " + WS-C-STATUS INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF. + + OPEN OUTPUT FINAL-OUT. + IF WS-FINAL-STATUS NOT = '00' + STRING "FATAL: Cannot open final.dat, status " + WS-FINAL-STATUS INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF. + + OPEN OUTPUT AUDIT-FILE. + IF WS-AUDIT-STATUS NOT = '00' + DISPLAY "WARNING: Cannot open audit-report.txt, " + "status " WS-AUDIT-STATUS + ADD 1 TO WS-WARN-COUNT + END-IF. + . + + *> ============================================================ + *> 4200-CHECK-SEQ-A — Check A key sequence + *> ============================================================ + 4200-CHECK-SEQ-A. + IF STD-KEY OF A-REC < WS-PREV-KEY-A + ADD 1 TO WS-SEQ-ERR-COUNT + ADD 1 TO WS-WARN-COUNT + DISPLAY "WARNING: A-file seq violation: " + WS-PREV-KEY-A " > " STD-KEY OF A-REC + END-IF + . + + *> ============================================================ + *> 4300-CHECK-SEQ-B — Check B key sequence + *> ============================================================ + 4300-CHECK-SEQ-B. + IF STD-KEY OF B-REC < WS-PREV-KEY-B + ADD 1 TO WS-SEQ-ERR-COUNT + ADD 1 TO WS-WARN-COUNT + DISPLAY "WARNING: B-file seq violation: " + WS-PREV-KEY-B " > " STD-KEY OF B-REC + END-IF + . + + *> ============================================================ + *> 5110-ACCUMULATE-TEMP — Accumulate temp hash + *> ============================================================ + 5110-ACCUMULATE-TEMP. + MOVE STD-DATA-3 OF A-REC TO WS-AMT-A + ADD WS-AMT-A TO WS-HASH-A-INPUT + MOVE STD-DATA-3 OF TEMP-REC TO WS-AMT-TEMP + ADD WS-AMT-TEMP TO WS-HASH-TEMP + . + + *> ============================================================ + *> 5120-ACCUMULATE-FINAL — Accumulate final hash + *> ============================================================ + 5120-ACCUMULATE-FINAL. + MOVE STD-DATA-3 OF FINAL-REC TO WS-AMT-FINAL + ADD WS-AMT-FINAL TO WS-HASH-FINAL + . + + *> ============================================================ + *> 5300-WRITE-ERR-UNMATCH-A + *> ============================================================ + 5300-WRITE-ERR-UNMATCH-A. + MOVE 'STG1-A-UNM' TO ERR-STAGE + MOVE STD-KEY OF A-REC TO ERR-KEY + MOVE STD-DATA-3 OF A-REC TO WS-AMT-A + MOVE WS-AMT-A TO ERR-AMOUNT + WRITE ERR-REC + . + + *> ============================================================ + *> 5400-WRITE-ERR-UNMATCH-B + *> ============================================================ + 5400-WRITE-ERR-UNMATCH-B. + MOVE 'STG1-B-UNM' TO ERR-STAGE + MOVE STD-KEY OF B-REC TO ERR-KEY + MOVE STD-DATA-3 OF B-REC TO WS-AMT-B + MOVE WS-AMT-B TO ERR-AMOUNT + WRITE ERR-REC + . + + *> ============================================================ + *> 5500-WRITE-ERR-UNMATCH-TEMP + *> ============================================================ + 5500-WRITE-ERR-UNMATCH-TEMP. + MOVE 'STG2-TMP-U' TO ERR-STAGE + MOVE STD-KEY OF TEMP-REC TO ERR-KEY + MOVE STD-DATA-3 OF TEMP-REC TO WS-AMT-TEMP + MOVE WS-AMT-TEMP TO ERR-AMOUNT + WRITE ERR-REC + . + + *> ============================================================ + *> 5600-WRITE-ERR-UNMATCH-C + *> ============================================================ + 5600-WRITE-ERR-UNMATCH-C. + MOVE 'STG2-C-UNM' TO ERR-STAGE + MOVE STD-KEY OF C-REC TO ERR-KEY + MOVE STD-DATA-3 OF C-REC TO WS-AMT-C + MOVE WS-AMT-C TO ERR-AMOUNT + WRITE ERR-REC + . + + *> ============================================================ + *> 6000-FATAL-ERROR + *> ============================================================ + 6000-FATAL-ERROR. + ADD 1 TO WS-FATAL-COUNT + DISPLAY "FATAL [" WS-TS-DATE " " WS-TS-TIME "] " + WS-ERR-MSG + MOVE 16 TO RETURN-CODE + STOP RUN + . + + *> ============================================================ + *> 7000-AUDIT-TRAIL + *> ============================================================ + 7000-AUDIT-TRAIL. + MOVE '7000-AUDIT-TRAIL' TO WS-PGM-PHASE + DISPLAY "[" WS-TS-DATE " " WS-TS-TIME + "] 16-MATCHING: Writing audit report..." + + PERFORM 7020-WRITE-AUDIT-SUMMARY + PERFORM 7030-WRITE-HASH-DETAIL + PERFORM 7040-WRITE-STAGE-RECONCIL + PERFORM 7050-WRITE-TIMING-REPORT + PERFORM 7060-WRITE-AUDIT-FOOTER + + CLOSE AUDIT-FILE + . + + *> ============================================================ + *> 7010-WRITE-AUDIT-HEADER + *> ============================================================ + 7010-WRITE-AUDIT-HEADER. + MOVE SPACES TO AUDIT-REC + STRING "================================================" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "16-MATCHING-2STAGE-1-1 AUDIT REPORT" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "Program Version: V2.00" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "Run Date: " WS-PROC-DATE " Time: " WS-PROC-TIME + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "================================================" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 7020-WRITE-AUDIT-SUMMARY + *> ============================================================ + 7020-WRITE-AUDIT-SUMMARY. + MOVE SPACES TO AUDIT-REC + STRING "RECORD COUNT SUMMARY:" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "STAGE 1 (A x B):" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " A-file records read : " WS-A-READ-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " B-file records read : " WS-B-READ-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Stage1 matched (temp) : " WS-STAGE1-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Unmatched A records : " WS-UNMATCH-A + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Unmatched B records : " WS-UNMATCH-B + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "STAGE 2 (TEMP x C):" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " C-file records read : " WS-C-READ-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Stage2 matched (final) : " WS-STAGE2-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Unmatched temp records : " WS-UNMATCH-TEMP + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Unmatched C records : " WS-UNMATCH-C + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 7030-WRITE-HASH-DETAIL + *> ============================================================ + 7030-WRITE-HASH-DETAIL. + MOVE SPACES TO AUDIT-REC + STRING " " + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "HASH TOTAL RECONCILIATION:" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " A-file input hash : " WS-HASH-A-INPUT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " B-file input hash : " WS-HASH-B-INPUT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Temp hash (s1 match): " WS-HASH-TEMP + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " C-file input hash : " WS-HASH-C-INPUT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Final output hash : " WS-HASH-FINAL + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 7040-WRITE-STAGE-RECONCIL — Inter-stage reconciliation + *> ============================================================ + 7040-WRITE-STAGE-RECONCIL. + MOVE SPACES TO AUDIT-REC + STRING " " + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "INTER-STAGE RECONCILIATION:" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Stage1 temp records : " WS-STAGE1-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Stage2 final records : " WS-STAGE2-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + IF WS-STAGE1-COUNT = WS-STAGE2-COUNT + MOVE SPACES TO AUDIT-REC + STRING " Stage count: VERIFIED (1:1 pass-through)" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + ELSE + MOVE SPACES TO AUDIT-REC + STRING " ** STAGE COUNT MISMATCH ** S1=" + WS-STAGE1-COUNT " S2=" WS-STAGE2-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + END-IF + + ADD WS-HASH-FINAL TO WS-HASH-ERR + GIVING WS-HASH-DIFF + SUBTRACT WS-HASH-TEMP FROM WS-HASH-DIFF + IF WS-HASH-DIFF = 0 + MOVE SPACES TO AUDIT-REC + STRING " Stage hash: VERIFIED (final+err=temp)" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + ELSE + MOVE SPACES TO AUDIT-REC + STRING " ** STAGE HASH MISMATCH ** Diff: " + WS-HASH-DIFF INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + END-IF + . + + *> ============================================================ + *> 7050-WRITE-TIMING-REPORT + *> ============================================================ + 7050-WRITE-TIMING-REPORT. + MOVE SPACES TO AUDIT-REC + STRING " " + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "STAGE TIMING (HHMMSS format):" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Stage 1 start : " WS-STAGE1-START + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Stage 1 end : " WS-STAGE1-END + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Stage 2 start : " WS-STAGE2-START + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Stage 2 end : " WS-STAGE2-END + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Sequence errors: " WS-SEQ-ERR-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 7060-WRITE-AUDIT-FOOTER + *> ============================================================ + 7060-WRITE-AUDIT-FOOTER. + MOVE SPACES TO AUDIT-REC + STRING " " + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "================================================" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "END OF AUDIT REPORT" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "Generated: " WS-PROC-DATE " " WS-PROC-TIME + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 8000-FINALIZE + *> ============================================================ + 8000-FINALIZE. + DISPLAY "============================================" + DISPLAY "16-MATCHING-2STAGE-1-1 Processing Summary" + DISPLAY "============================================" + DISPLAY "STAGE 1: A=" WS-A-READ-COUNT + " B=" WS-B-READ-COUNT + DISPLAY " Matched=" WS-STAGE1-COUNT + " Unmatch-A=" WS-UNMATCH-A + " Unmatch-B=" WS-UNMATCH-B + DISPLAY "STAGE 2: C=" WS-C-READ-COUNT + DISPLAY " Matched=" WS-STAGE2-COUNT + " Unmatch-Temp=" WS-UNMATCH-TEMP + " Unmatch-C=" WS-UNMATCH-C + DISPLAY "--------------------------------------------" + DISPLAY "Sequence violations : " WS-SEQ-ERR-COUNT + DISPLAY "Warnings : " WS-WARN-COUNT + DISPLAY "Fatal errors : " WS-FATAL-COUNT + DISPLAY "Stage 1 count=" WS-STAGE1-COUNT + " Stage 2 count=" WS-STAGE2-COUNT + IF WS-STAGE1-COUNT = WS-STAGE2-COUNT + DISPLAY "Stage counts: VERIFIED" + ELSE + DISPLAY "STAGE COUNT MISMATCH!" + END-IF + DISPLAY "============================================" + . + + END PROGRAM Match2Stage. diff --git a/benchmark-programs/17-matching-2stage-N-1/README.md b/benchmark-programs/17-matching-2stage-N-1/README.md new file mode 100644 index 0000000..dfa547b --- /dev/null +++ b/benchmark-programs/17-matching-2stage-N-1/README.md @@ -0,0 +1,52 @@ +# 17-matching-2stage-N-1: Two-Stage N:1 Matching + +## 电信业务场景 + +线路→请求书二级汇集。两段式N:1汇集。第一段:多条线路CDR→中间汇总；第二段:中间汇总→请求书。 + +## Description + +Two-stage N:1 matching process. Stage 1 performs N:1 matching from multiple +master records through detail records to an intermediate file. Stage 2 performs +another N:1 match from the intermediate file to a final reference file. + +This tests the ability to chain N:1 matching operations across two stages, +where the intermediate result of one N:1 match feeds into a second N:1 +match. The final output contains only records that successfully matched +in both stages. + +## Record Layout + +Standard record (45 bytes, copybook STD-REC.cpy): +| Field | Type | Length | Description | +|------------|-------------------|--------|--------------------| +| STD-KEY | PIC X | 10 | Record key | +| STD-DATA-1 | PIC X | 20 | Text data | +| STD-DATA-2 | PIC 9 | 10 | Numeric data | +| STD-DATA-3 | PIC S9(7)V99 COMP-3| 5 | Packed decimal | + +## Files + +| File | Purpose | +|------------------------------------|--------------------------------------| +| main-17-matching-2stage-N-1.cbl | Main COBOL program (fixed format) | +| data-gen.sh | Generate test data for all files | +| run.sh | Compile, run, verify | +| README.md | This file | + +## Data Design + +- master.dat: 5 records -- 3 with KEY00001, 2 with KEY00002 +- detail.dat: 2 records -- KEY00001, KEY00002 (one per master group) +- final-ref.dat: 1 record -- KEY00001 only + +Stage 1: 5 masters -> 2 intermediate records (N:1, one per matching group) +Stage 2: 2 intermediate -> 1 final output (only KEY00001 matches final-ref) + +## Expected Behavior + +- Stage 1 matches each master group to one detail record (N:1), writing + one temp record per group that has a matching detail. +- Stage 2 matches each temp record against the final reference, writing + one output per matching temp group. +- Final output: 1 record (only KEY00001 group matches final-ref). diff --git a/benchmark-programs/17-matching-2stage-N-1/TEMP.DAT b/benchmark-programs/17-matching-2stage-N-1/TEMP.DAT new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/17-matching-2stage-N-1/TEMP.DAT @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/17-matching-2stage-N-1/audit-report.txt b/benchmark-programs/17-matching-2stage-N-1/audit-report.txt new file mode 100644 index 0000000..917bb6c --- /dev/null +++ b/benchmark-programs/17-matching-2stage-N-1/audit-report.txt @@ -0,0 +1,39 @@ +RECORD COUNT SUMMARY: +STAGE 1 (N:1 Master x Detail -> Temp): + Master records read : 00002 + Detail records read : 00002 + Temp records written : 00002 + Unmatched master : 00000 + Unmatched detail : 00000 +STAGE 2 (N:1 Temp x FinalRef -> Final): + Temp records read : 00002 + Final-ref records read: 00002 + Final records written : 00002 + Unmatched temp : 00000 + Unmatched final-ref : 00000 + Master groups (N>1) : 00002 + Temp groups (N>1) : 00002 + +HASH TOTAL RECONCILIATION: + Stage1 master input : 000000006060606 + Stage1 temp output : 000000006060606 + Stage2 final output : 000000006060606 + Error hash : 000000000000000 + Stage1 hash: VERIFIED (temp+err=master) + +INTER-STAGE RECONCILIATION (N:1 pass-through): + Stage1 temp recs : 00002 + Stage2 final recs: 00002 + Stage count: VERIFIED (N:1 pass-through) + Stage hash: VERIFIED (final+err=temp) + +STAGE TIMING (HHMMSS format): + Stage 1 start: 16351741 + Stage 1 end : 16351742 + Stage 2 start: 16351742 + Stage 2 end : 16351743 + Sequence errs: 00000 + +================================================ +END OF AUDIT REPORT +Generated: 20260622 16351741 diff --git a/benchmark-programs/17-matching-2stage-N-1/detail.dat b/benchmark-programs/17-matching-2stage-N-1/detail.dat new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/17-matching-2stage-N-1/detail.dat @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/17-matching-2stage-N-1/error.dat b/benchmark-programs/17-matching-2stage-N-1/error.dat new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/17-matching-2stage-N-1/final-ref.dat b/benchmark-programs/17-matching-2stage-N-1/final-ref.dat new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/17-matching-2stage-N-1/final-ref.dat @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/17-matching-2stage-N-1/final.dat b/benchmark-programs/17-matching-2stage-N-1/final.dat new file mode 100644 index 0000000..8fbecaa --- /dev/null +++ b/benchmark-programs/17-matching-2stage-N-1/final.dat @@ -0,0 +1 @@ + 0000000000000000000 000000000000000 \ No newline at end of file diff --git a/benchmark-programs/17-matching-2stage-N-1/main-17-matching-2stage-N-1.cbl b/benchmark-programs/17-matching-2stage-N-1/main-17-matching-2stage-N-1.cbl new file mode 100644 index 0000000..04c5b5a --- /dev/null +++ b/benchmark-programs/17-matching-2stage-N-1/main-17-matching-2stage-N-1.cbl @@ -0,0 +1,961 @@ + *> ============================================================ + *> 17-matching-2stage-N-1 : 线路→请求书二级 (2-Stage Line→Bill) + *> Input : FILE-MASTER (master.dat: N条线路), FILE-DETAIL (detail.dat: 请求书) + *> FILE-FINAL (final-ref.dat: 对照请求书) + *> Output: FINAL-OUT (final.dat: 二级集计结果) + *> error.dat (未匹配记录) + *> audit-report.txt (审计报告: 处理统计) + *> Coverage: AM-N002, AM-A001, AM-R001 + *> stage-level control totals, inter-stage reconciliation, + *> stage timing measurement, N:1 accumulation validation + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. Matching2StageN1. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-MASTER ASSIGN TO "master.dat" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-MASTER-STATUS. + SELECT FILE-DETAIL ASSIGN TO "detail.dat" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-DETAIL-STATUS. + SELECT TEMP-FILE ASSIGN TO "temp.dat" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-TEMP-STATUS. + SELECT FILE-FINAL ASSIGN TO "final-ref.dat" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FINAL-REF-STATUS. + SELECT FINAL-OUT ASSIGN TO "final.dat" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FINAL-OUT-STATUS. + SELECT FILE-ERR ASSIGN TO "error.dat" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-ERR-STATUS. + SELECT AUDIT-FILE ASSIGN TO "audit-report.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-AUDIT-STATUS. + + DATA DIVISION. + FILE SECTION. + FD FILE-MASTER. + 01 MASTER-REC. + COPY "STD-REC.cpy". + FD FILE-DETAIL. + 01 DETAIL-REC. + COPY "STD-REC.cpy". + FD TEMP-FILE. + 01 TEMP-REC. + COPY "STD-REC.cpy". + FD FILE-FINAL. + 01 FINAL-REF-REC. + COPY "STD-REC.cpy". + FD FINAL-OUT. + 01 OUT-REC. + COPY "STD-REC.cpy". + FD FILE-ERR. + 01 ERR-REC. + 05 ERR-STAGE PIC X(10). + 05 ERR-KEY PIC X(10). + 05 ERR-AMOUNT PIC 9(10). + 05 ERR-GROUP PIC X(10). + 05 ERR-FILLER PIC X(40). + FD AUDIT-FILE. + 01 AUDIT-REC PIC X(120). + + WORKING-STORAGE SECTION. + 01 WS-TELECOM-REC. + COPY "telecom/TEL-BILLING.cpy". + + *> File status fields + 01 WS-MASTER-STATUS PIC X(02). + 01 WS-DETAIL-STATUS PIC X(02). + 01 WS-TEMP-STATUS PIC X(02). + 01 WS-FINAL-REF-STATUS PIC X(02). + 01 WS-FINAL-OUT-STATUS PIC X(02). + 01 WS-ERR-STATUS PIC X(02). + 01 WS-AUDIT-STATUS PIC X(02). + + *> EOF and status flags + 01 WS-FLAGS. + 05 WS-MASTER-EOF PIC X VALUE 'N'. + 88 WS-MASTER-END VALUE 'Y' FALSE 'N'. + 05 WS-DETAIL-EOF PIC X VALUE 'N'. + 88 WS-DETAIL-END VALUE 'Y' FALSE 'N'. + 05 WS-TEMP-EOF PIC X VALUE 'N'. + 88 WS-TEMP-END VALUE 'Y' FALSE 'N'. + 05 WS-FINAL-EOF PIC X VALUE 'N'. + 88 WS-FINAL-END VALUE 'Y' FALSE 'N'. + + *> Key areas + 01 WS-KEYS. + 05 WS-MASTER-KEY PIC X(10). + 05 WS-DETAIL-KEY PIC X(10). + 05 WS-TEMP-KEY PIC X(10). + 05 WS-FINAL-KEY PIC X(10). + 05 WS-GROUP-KEY PIC X(10). + 05 WS-PREV-MAST-KEY PIC X(10). + + *> Counter accumulators + 01 WS-COUNTERS. + 05 WS-STAGE1-CNT PIC 9(05) VALUE 0. + 05 WS-STAGE2-CNT PIC 9(05) VALUE 0. + 05 WS-MAST-READ-CNT PIC 9(05) VALUE 0. + 05 WS-DETL-READ-CNT PIC 9(05) VALUE 0. + 05 WS-TEMP-READ-CNT PIC 9(05) VALUE 0. + 05 WS-FINAL-READ-CNT PIC 9(05) VALUE 0. + 05 WS-UNMATCH-MAST PIC 9(05) VALUE 0. + 05 WS-UNMATCH-DETL PIC 9(05) VALUE 0. + 05 WS-UNMATCH-TEMP PIC 9(05) VALUE 0. + 05 WS-UNMATCH-FINAL PIC 9(05) VALUE 0. + 05 WS-WARN-COUNT PIC 9(05) VALUE 0. + 05 WS-FATAL-COUNT PIC 9(05) VALUE 0. + 05 WS-SEQ-ERR-COUNT PIC 9(05) VALUE 0. + 05 WS-MAST-GROUP-CNT PIC 9(05) VALUE 0. + 05 WS-TEMP-GROUP-CNT PIC 9(05) VALUE 0. + + *> Hash totals for batch control + 01 WS-HASH-TOTALS. + 05 WS-HASH-MAST-IN PIC 9(15) VALUE 0. + 05 WS-HASH-DETL-IN PIC 9(15) VALUE 0. + 05 WS-HASH-TEMP-OUT PIC 9(15) VALUE 0. + 05 WS-HASH-FINAL-REF-IN PIC 9(15) VALUE 0. + 05 WS-HASH-FINAL-OUT PIC 9(15) VALUE 0. + 05 WS-HASH-ERR PIC 9(15) VALUE 0. + 05 WS-HASH-DIFF PIC S9(15) VALUE 0. + + *> Stage timing + 01 WS-STAGE1-START PIC 9(08). + 01 WS-STAGE1-END PIC 9(08). + 01 WS-STAGE2-START PIC 9(08). + 01 WS-STAGE2-END PIC 9(08). + + *> Date and timestamp areas + 01 WS-PROC-DATE PIC 9(08). + 01 WS-PROC-TIME PIC 9(08). + 01 WS-TS-DATE PIC X(08). + 01 WS-TS-TIME PIC X(08). + + *> Amount areas + 01 WS-AMT-MAST PIC 9(10). + 01 WS-AMT-DETL PIC 9(10). + 01 WS-AMT-TEMP PIC 9(10). + 01 WS-AMT-FINAL PIC 9(10). + + *> Group accumulation validation + 01 WS-GROUP-ACCUM. + 05 WS-GROUP-MAST-CNT PIC 9(05) VALUE 0. + 05 WS-GROUP-MAST-HASH PIC 9(15) VALUE 0. + 05 WS-GROUP-TEMP-CNT PIC 9(05) VALUE 0. + 05 WS-GROUP-TEMP-HASH PIC 9(15) VALUE 0. + + *> Error message areas + 01 WS-ERR-MSG PIC X(60). + 01 WS-ERR-DETAIL PIC X(80). + + *> Program phase + 01 WS-PGM-PHASE PIC X(20). + + PROCEDURE DIVISION. + MAIN SECTION. + MB-PROCESS. + PERFORM 1000-INITIALIZE + + *> ============================================ + *> STAGE 1: N:1 matching + *> FILE-MASTER x FILE-DETAIL -> TEMP-FILE + *> (Original algorithm preserved) + *> ============================================ + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-STAGE1-START + DISPLAY "[" WS-TS-DATE " " WS-TS-TIME + "] 17-MATCHING: Stage 1 N:1 starting..." + + PERFORM 2100-OPEN-STAGE1-FILES + + PERFORM 3100-READ-MASTER + PERFORM 3200-READ-DETAIL + + PERFORM UNTIL WS-MASTER-END OR WS-DETAIL-END + MOVE WS-MASTER-KEY TO WS-GROUP-KEY + ADD 1 TO WS-MAST-GROUP-CNT + IF WS-MASTER-KEY = WS-DETAIL-KEY + *> Match found - write ALL master records in group to temp + PERFORM 3400-WRITE-MASTER-GROUP + PERFORM 3200-READ-DETAIL + ELSE IF WS-MASTER-KEY < WS-DETAIL-KEY + *> Master group has no matching detail - skip it + PERFORM 3500-SKIP-MASTER-GROUP + ELSE + *> Detail key ahead of master - skip unmatched detail + ADD 1 TO WS-UNMATCH-DETL + PERFORM 5400-WRITE-ERR-DETL-UNMATCH + PERFORM 3200-READ-DETAIL + END-IF + END-PERFORM. + + *> Drain remaining masters and details + PERFORM UNTIL WS-MASTER-END + ADD 1 TO WS-UNMATCH-MAST + PERFORM 5300-WRITE-ERR-MAST-UNMATCH + PERFORM 3100-READ-MASTER + END-PERFORM + PERFORM UNTIL WS-DETAIL-END + ADD 1 TO WS-UNMATCH-DETL + PERFORM 5400-WRITE-ERR-DETL-UNMATCH + PERFORM 3200-READ-DETAIL + END-PERFORM + + CLOSE FILE-MASTER FILE-DETAIL TEMP-FILE. + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-STAGE1-END + DISPLAY "[" WS-TS-DATE " " WS-TS-TIME + "] Stage 1 complete: " WS-STAGE1-CNT + " temp records, " WS-UNMATCH-MAST " master-unm, " + WS-UNMATCH-DETL " detail-unm" + + *> ============================================ + *> STAGE 2: N:1 matching + *> TEMP-FILE x FILE-FINAL -> FINAL-OUT + *> (Original algorithm preserved) + *> ============================================ + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-STAGE2-START + DISPLAY "[" WS-TS-DATE " " WS-TS-TIME + "] 17-MATCHING: Stage 2 N:1 starting..." + + PERFORM 2200-OPEN-STAGE2-FILES + + PERFORM 3600-READ-TEMP + PERFORM 3700-READ-FINAL + + PERFORM UNTIL WS-TEMP-END OR WS-FINAL-END + MOVE WS-TEMP-KEY TO WS-GROUP-KEY + ADD 1 TO WS-TEMP-GROUP-CNT + IF WS-TEMP-KEY = WS-FINAL-KEY + *> Match found - write ALL temp records in group to final + PERFORM 3800-WRITE-TEMP-GROUP + PERFORM 3700-READ-FINAL + ELSE IF WS-TEMP-KEY < WS-FINAL-KEY + *> Temp group has no matching final - skip it + PERFORM 3900-SKIP-TEMP-GROUP + ELSE + *> Final key ahead - skip unmatched final + ADD 1 TO WS-UNMATCH-FINAL + PERFORM 5600-WRITE-ERR-FINAL-UNMATCH + PERFORM 3700-READ-FINAL + END-IF + END-PERFORM. + + *> Drain remaining temp and final records + PERFORM UNTIL WS-TEMP-END + ADD 1 TO WS-UNMATCH-TEMP + PERFORM 5500-WRITE-ERR-TEMP-UNMATCH + PERFORM 3600-READ-TEMP + END-PERFORM + PERFORM UNTIL WS-FINAL-END + ADD 1 TO WS-UNMATCH-FINAL + PERFORM 5600-WRITE-ERR-FINAL-UNMATCH + PERFORM 3700-READ-FINAL + END-PERFORM + + CLOSE TEMP-FILE FILE-FINAL FINAL-OUT FILE-ERR. + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-STAGE2-END + DISPLAY "[" WS-TS-DATE " " WS-TS-TIME + "] Stage 2 complete: " WS-STAGE2-CNT + " final records" + + *> Write audit and finalize + PERFORM 7000-AUDIT-TRAIL + PERFORM 8000-FINALIZE + + DISPLAY "17-matching-2stage-N-1: PASS". + STOP RUN. + . + + *> ============================================================ + *> 1000-INITIALIZE + *> ============================================================ + 1000-INITIALIZE. + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-PROC-DATE + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-PROC-TIME + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-TS-DATE + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-TS-TIME + + DISPLAY "============================================" + DISPLAY "17-MATCHING-2STAGE-N-1 2-Stage Line-to-Bill" + DISPLAY "Version V2.00" + DISPLAY "Run date: " WS-PROC-DATE " " WS-PROC-TIME + DISPLAY "============================================" + + INITIALIZE WS-COUNTERS + INITIALIZE WS-HASH-TOTALS + INITIALIZE WS-GROUP-ACCUM + . + + *> ============================================================ + *> 2100-OPEN-STAGE1-FILES + *> ============================================================ + 2100-OPEN-STAGE1-FILES. + MOVE '2100-OPEN-STAGE1' TO WS-PGM-PHASE + + OPEN INPUT FILE-MASTER + IF WS-MASTER-STATUS NOT = '00' + STRING "FATAL: Cannot open master.dat, status " + WS-MASTER-STATUS INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF + + OPEN INPUT FILE-DETAIL + IF WS-DETAIL-STATUS NOT = '00' + STRING "FATAL: Cannot open detail.dat, status " + WS-DETAIL-STATUS INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF + + OPEN OUTPUT TEMP-FILE + IF WS-TEMP-STATUS NOT = '00' + STRING "FATAL: Cannot open temp.dat, status " + WS-TEMP-STATUS INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF + + OPEN OUTPUT FILE-ERR + IF WS-ERR-STATUS NOT = '00' + STRING "FATAL: Cannot open error.dat, status " + WS-ERR-STATUS INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF + + PERFORM 7010-WRITE-AUDIT-HEADER + . + + *> ============================================================ + *> 2200-OPEN-STAGE2-FILES + *> ============================================================ + 2200-OPEN-STAGE2-FILES. + MOVE '2200-OPEN-STAGE2' TO WS-PGM-PHASE + + OPEN INPUT TEMP-FILE + IF WS-TEMP-STATUS NOT = '00' + STRING "FATAL: Cannot reopen temp.dat, status " + WS-TEMP-STATUS INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF + + OPEN INPUT FILE-FINAL + IF WS-FINAL-REF-STATUS NOT = '00' + STRING "FATAL: Cannot open final-ref.dat, status " + WS-FINAL-REF-STATUS INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF + + OPEN OUTPUT FINAL-OUT + IF WS-FINAL-OUT-STATUS NOT = '00' + STRING "FATAL: Cannot open final.dat, status " + WS-FINAL-OUT-STATUS INTO WS-ERR-MSG + END-STRING + PERFORM 6000-FATAL-ERROR + END-IF + + OPEN OUTPUT AUDIT-FILE + IF WS-AUDIT-STATUS NOT = '00' + DISPLAY "WARNING: Cannot open audit-report.txt, " + "status " WS-AUDIT-STATUS + ADD 1 TO WS-WARN-COUNT + END-IF + . + + *> ============================================================ + *> 3100-READ-MASTER — Read master with status (original helper) + *> ============================================================ + 3100-READ-MASTER. + READ FILE-MASTER + AT END MOVE 'Y' TO WS-MASTER-EOF + NOT AT END + ADD 1 TO WS-MAST-READ-CNT + MOVE STD-KEY OF MASTER-REC TO WS-MASTER-KEY + PERFORM 4000-VALIDATE-MASTER + PERFORM 4100-CHECK-MAST-SEQ + MOVE STD-KEY OF MASTER-REC TO WS-PREV-MAST-KEY + END-READ + . + + *> ============================================================ + *> 3200-READ-DETAIL — Read detail (original helper) + *> ============================================================ + 3200-READ-DETAIL. + READ FILE-DETAIL + AT END MOVE 'Y' TO WS-DETAIL-EOF + NOT AT END + ADD 1 TO WS-DETL-READ-CNT + MOVE STD-KEY OF DETAIL-REC TO WS-DETAIL-KEY + PERFORM 4200-VALIDATE-DETAIL + END-READ + . + + *> ============================================================ + *> 3400-WRITE-MASTER-GROUP — Write matched master group (original) + *> ============================================================ + 3400-WRITE-MASTER-GROUP. + MOVE ZERO TO WS-GROUP-MAST-CNT + MOVE ZERO TO WS-GROUP-MAST-HASH + PERFORM UNTIL WS-MASTER-END + OR WS-MASTER-KEY NOT = WS-GROUP-KEY + MOVE MASTER-REC TO TEMP-REC + WRITE TEMP-REC + ADD 1 TO WS-STAGE1-CNT + ADD 1 TO WS-GROUP-MAST-CNT + MOVE STD-DATA-3 OF MASTER-REC TO WS-AMT-MAST + ADD WS-AMT-MAST TO WS-HASH-TEMP-OUT + ADD WS-AMT-MAST TO WS-GROUP-MAST-HASH + PERFORM 3100-READ-MASTER + END-PERFORM + + *> Validate N:1 group accumulation + IF WS-GROUP-MAST-CNT > 1 + ADD 1 TO WS-MAST-GROUP-CNT + END-IF + . + + *> ============================================================ + *> 3500-SKIP-MASTER-GROUP — Skip unmatched master group (original) + *> ============================================================ + 3500-SKIP-MASTER-GROUP. + PERFORM UNTIL WS-MASTER-END + OR WS-MASTER-KEY NOT = WS-GROUP-KEY + ADD 1 TO WS-UNMATCH-MAST + PERFORM 5300-WRITE-ERR-MAST-UNMATCH + PERFORM 3100-READ-MASTER + END-PERFORM + . + + *> ============================================================ + *> 3600-READ-TEMP — Read temp (original helper) + *> ============================================================ + 3600-READ-TEMP. + READ TEMP-FILE + AT END MOVE 'Y' TO WS-TEMP-EOF + NOT AT END + ADD 1 TO WS-TEMP-READ-CNT + MOVE STD-KEY OF TEMP-REC TO WS-TEMP-KEY + END-READ + . + + *> ============================================================ + *> 3700-READ-FINAL — Read final-ref (original helper) + *> ============================================================ + 3700-READ-FINAL. + READ FILE-FINAL + AT END MOVE 'Y' TO WS-FINAL-EOF + NOT AT END + ADD 1 TO WS-FINAL-READ-CNT + MOVE STD-KEY OF FINAL-REF-REC TO WS-FINAL-KEY + END-READ + . + + *> ============================================================ + *> 3800-WRITE-TEMP-GROUP — Write temp group to final (original) + *> ============================================================ + 3800-WRITE-TEMP-GROUP. + MOVE ZERO TO WS-GROUP-TEMP-CNT + MOVE ZERO TO WS-GROUP-TEMP-HASH + PERFORM UNTIL WS-TEMP-END + OR WS-TEMP-KEY NOT = WS-GROUP-KEY + MOVE TEMP-REC TO OUT-REC + WRITE OUT-REC + ADD 1 TO WS-STAGE2-CNT + ADD 1 TO WS-GROUP-TEMP-CNT + MOVE STD-DATA-3 OF TEMP-REC TO WS-AMT-TEMP + ADD WS-AMT-TEMP TO WS-HASH-FINAL-OUT + ADD WS-AMT-TEMP TO WS-GROUP-TEMP-HASH + PERFORM 3600-READ-TEMP + END-PERFORM + + *> Validate N:1 group accumulation + IF WS-GROUP-TEMP-CNT > 1 + ADD 1 TO WS-TEMP-GROUP-CNT + END-IF + . + + *> ============================================================ + *> 3900-SKIP-TEMP-GROUP — Skip temp group (original) + *> ============================================================ + 3900-SKIP-TEMP-GROUP. + PERFORM UNTIL WS-TEMP-END + OR WS-TEMP-KEY NOT = WS-GROUP-KEY + ADD 1 TO WS-UNMATCH-TEMP + PERFORM 5500-WRITE-ERR-TEMP-UNMATCH + PERFORM 3600-READ-TEMP + END-PERFORM + . + + *> ============================================================ + *> 4000-VALIDATE-MASTER — Validate master record + *> ============================================================ + 4000-VALIDATE-MASTER. + *> Accumulate input hash total + MOVE STD-DATA-3 OF MASTER-REC TO WS-AMT-MAST + ADD WS-AMT-MAST TO WS-HASH-MAST-IN + . + + *> ============================================================ + *> 4100-CHECK-MAST-SEQ — Check master sequence + *> ============================================================ + 4100-CHECK-MAST-SEQ. + IF STD-KEY OF MASTER-REC < WS-PREV-MAST-KEY + ADD 1 TO WS-SEQ-ERR-COUNT + ADD 1 TO WS-WARN-COUNT + DISPLAY "WARNING: Master seq violation: " + WS-PREV-MAST-KEY " > " STD-KEY OF MASTER-REC + END-IF + . + + *> ============================================================ + *> 4200-VALIDATE-DETAIL — Validate detail record + *> ============================================================ + 4200-VALIDATE-DETAIL. + *> Accumulate input hash total + MOVE STD-DATA-3 OF DETAIL-REC TO WS-AMT-DETL + ADD WS-AMT-DETL TO WS-HASH-DETL-IN + . + + *> ============================================================ + *> 5300-WRITE-ERR-MAST-UNMATCH + *> ============================================================ + 5300-WRITE-ERR-MAST-UNMATCH. + MOVE 'STG1-MAST' TO ERR-STAGE + MOVE STD-KEY OF MASTER-REC TO ERR-KEY + MOVE STD-DATA-3 OF MASTER-REC TO WS-AMT-MAST + MOVE WS-AMT-MAST TO ERR-AMOUNT + MOVE WS-GROUP-KEY TO ERR-GROUP + WRITE ERR-REC + . + + *> ============================================================ + *> 5400-WRITE-ERR-DETL-UNMATCH + *> ============================================================ + 5400-WRITE-ERR-DETL-UNMATCH. + MOVE 'STG1-DETL' TO ERR-STAGE + MOVE STD-KEY OF DETAIL-REC TO ERR-KEY + MOVE STD-DATA-3 OF DETAIL-REC TO WS-AMT-DETL + MOVE WS-AMT-DETL TO ERR-AMOUNT + MOVE STD-KEY OF DETAIL-REC TO ERR-GROUP + WRITE ERR-REC + . + + *> ============================================================ + *> 5500-WRITE-ERR-TEMP-UNMATCH + *> ============================================================ + 5500-WRITE-ERR-TEMP-UNMATCH. + MOVE 'STG2-TEMP' TO ERR-STAGE + MOVE STD-KEY OF TEMP-REC TO ERR-KEY + MOVE STD-DATA-3 OF TEMP-REC TO WS-AMT-TEMP + MOVE WS-AMT-TEMP TO ERR-AMOUNT + MOVE WS-GROUP-KEY TO ERR-GROUP + WRITE ERR-REC + . + + *> ============================================================ + *> 5600-WRITE-ERR-FINAL-UNMATCH + *> ============================================================ + 5600-WRITE-ERR-FINAL-UNMATCH. + MOVE 'STG2-FINAL' TO ERR-STAGE + MOVE STD-KEY OF FINAL-REF-REC TO ERR-KEY + MOVE STD-DATA-3 OF FINAL-REF-REC TO WS-AMT-FINAL + MOVE WS-AMT-FINAL TO ERR-AMOUNT + MOVE STD-KEY OF FINAL-REF-REC TO ERR-GROUP + WRITE ERR-REC + . + + *> ============================================================ + *> 6000-FATAL-ERROR + *> ============================================================ + 6000-FATAL-ERROR. + ADD 1 TO WS-FATAL-COUNT + DISPLAY "FATAL [" WS-TS-DATE " " WS-TS-TIME "] " + WS-ERR-MSG + MOVE 16 TO RETURN-CODE + STOP RUN + . + + *> ============================================================ + *> 7000-AUDIT-TRAIL + *> ============================================================ + 7000-AUDIT-TRAIL. + MOVE '7000-AUDIT-TRAIL' TO WS-PGM-PHASE + DISPLAY "[" WS-TS-DATE " " WS-TS-TIME + "] 17-MATCHING: Writing audit report..." + + PERFORM 7020-WRITE-AUDIT-SUMMARY + PERFORM 7030-WRITE-HASH-DETAIL + PERFORM 7040-WRITE-STAGE-RECONCIL + PERFORM 7050-WRITE-TIMING + PERFORM 7060-WRITE-AUDIT-FOOTER + + CLOSE AUDIT-FILE + . + + *> ============================================================ + *> 7010-WRITE-AUDIT-HEADER + *> ============================================================ + 7010-WRITE-AUDIT-HEADER. + MOVE SPACES TO AUDIT-REC + STRING "================================================" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "17-MATCHING-2STAGE-N-1 AUDIT REPORT" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "Program Version: V2.00" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "Run Date: " WS-PROC-DATE " Time: " WS-PROC-TIME + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "================================================" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 7020-WRITE-AUDIT-SUMMARY + *> ============================================================ + 7020-WRITE-AUDIT-SUMMARY. + MOVE SPACES TO AUDIT-REC + STRING "RECORD COUNT SUMMARY:" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "STAGE 1 (N:1 Master x Detail -> Temp):" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Master records read : " WS-MAST-READ-CNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Detail records read : " WS-DETL-READ-CNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Temp records written : " WS-STAGE1-CNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Unmatched master : " WS-UNMATCH-MAST + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Unmatched detail : " WS-UNMATCH-DETL + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "STAGE 2 (N:1 Temp x FinalRef -> Final):" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Temp records read : " WS-TEMP-READ-CNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Final-ref records read: " WS-FINAL-READ-CNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Final records written : " WS-STAGE2-CNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Unmatched temp : " WS-UNMATCH-TEMP + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Unmatched final-ref : " WS-UNMATCH-FINAL + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Master groups (N>1) : " WS-MAST-GROUP-CNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Temp groups (N>1) : " WS-TEMP-GROUP-CNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 7030-WRITE-HASH-DETAIL + *> ============================================================ + 7030-WRITE-HASH-DETAIL. + MOVE SPACES TO AUDIT-REC + STRING " " + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "HASH TOTAL RECONCILIATION:" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Stage1 master input : " WS-HASH-MAST-IN + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Stage1 temp output : " WS-HASH-TEMP-OUT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Stage2 final output : " WS-HASH-FINAL-OUT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Error hash : " WS-HASH-ERR + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + ADD WS-HASH-TEMP-OUT TO WS-HASH-ERR + GIVING WS-HASH-DIFF + SUBTRACT WS-HASH-MAST-IN FROM WS-HASH-DIFF + IF WS-HASH-DIFF = 0 + MOVE SPACES TO AUDIT-REC + STRING " Stage1 hash: VERIFIED (temp+err=master)" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + ELSE + MOVE SPACES TO AUDIT-REC + STRING " ** S1 HASH MISMATCH ** Diff: " + WS-HASH-DIFF INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + END-IF + . + + *> ============================================================ + *> 7040-WRITE-STAGE-RECONCIL + *> ============================================================ + 7040-WRITE-STAGE-RECONCIL. + MOVE SPACES TO AUDIT-REC + STRING " " + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "INTER-STAGE RECONCILIATION (N:1 pass-through):" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Stage1 temp recs : " WS-STAGE1-CNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Stage2 final recs: " WS-STAGE2-CNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + IF WS-STAGE1-CNT = WS-STAGE2-CNT + MOVE SPACES TO AUDIT-REC + STRING " Stage count: VERIFIED (N:1 pass-through)" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + ELSE + MOVE SPACES TO AUDIT-REC + STRING " ** STAGE COUNT MISMATCH ** S1=" + WS-STAGE1-CNT " S2=" WS-STAGE2-CNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + END-IF + + ADD WS-HASH-FINAL-OUT TO WS-HASH-ERR + GIVING WS-HASH-DIFF + SUBTRACT WS-HASH-TEMP-OUT FROM WS-HASH-DIFF + IF WS-HASH-DIFF = 0 + MOVE SPACES TO AUDIT-REC + STRING " Stage hash: VERIFIED (final+err=temp)" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + ELSE + MOVE SPACES TO AUDIT-REC + STRING " ** STAGE HASH MISMATCH ** Diff: " + WS-HASH-DIFF INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + END-IF + . + + *> ============================================================ + *> 7050-WRITE-TIMING + *> ============================================================ + 7050-WRITE-TIMING. + MOVE SPACES TO AUDIT-REC + STRING " " + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "STAGE TIMING (HHMMSS format):" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Stage 1 start: " WS-STAGE1-START + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Stage 1 end : " WS-STAGE1-END + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Stage 2 start: " WS-STAGE2-START + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Stage 2 end : " WS-STAGE2-END + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING " Sequence errs: " WS-SEQ-ERR-COUNT + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 7060-WRITE-AUDIT-FOOTER + *> ============================================================ + 7060-WRITE-AUDIT-FOOTER. + MOVE SPACES TO AUDIT-REC + STRING " " + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "================================================" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "END OF AUDIT REPORT" + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + + MOVE SPACES TO AUDIT-REC + STRING "Generated: " WS-PROC-DATE " " WS-PROC-TIME + INTO AUDIT-REC + END-STRING + WRITE AUDIT-REC + . + + *> ============================================================ + *> 8000-FINALIZE + *> ============================================================ + 8000-FINALIZE. + DISPLAY "============================================" + DISPLAY "17-MATCHING-2STAGE-N-1 Processing Summary" + DISPLAY "============================================" + DISPLAY "STAGE 1: Master=" WS-MAST-READ-CNT + " Detail=" WS-DETL-READ-CNT + DISPLAY " Temp records=" WS-STAGE1-CNT + " Unmatched M=" WS-UNMATCH-MAST + " Unmatched D=" WS-UNMATCH-DETL + DISPLAY "STAGE 2: Temp=" WS-TEMP-READ-CNT + " Final-Ref=" WS-FINAL-READ-CNT + DISPLAY " Final records=" WS-STAGE2-CNT + " Unmatched T=" WS-UNMATCH-TEMP + " Unmatched F=" WS-UNMATCH-FINAL + DISPLAY "--------------------------------------------" + DISPLAY "Master groups (N>1) : " WS-MAST-GROUP-CNT + DISPLAY "Temp groups (N>1) : " WS-TEMP-GROUP-CNT + DISPLAY "Seq violations : " WS-SEQ-ERR-COUNT + DISPLAY "Warnings : " WS-WARN-COUNT + DISPLAY "Fatal errors : " WS-FATAL-COUNT + DISPLAY "Stage1 cnt=" WS-STAGE1-CNT + " Stage2 cnt=" WS-STAGE2-CNT + IF WS-STAGE1-CNT = WS-STAGE2-CNT + DISPLAY "Stage counts: VERIFIED (N:1 pass-through)" + ELSE + DISPLAY "STAGE COUNT MISMATCH!" + END-IF + DISPLAY "============================================" + . + + END PROGRAM Matching2StageN1. diff --git a/benchmark-programs/17-matching-2stage-N-1/master.dat b/benchmark-programs/17-matching-2stage-N-1/master.dat new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/17-matching-2stage-N-1/master.dat @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/18-matching-MN-to-M/README.md b/benchmark-programs/18-matching-MN-to-M/README.md new file mode 100644 index 0000000..3abdee5 --- /dev/null +++ b/benchmark-programs/18-matching-MN-to-M/README.md @@ -0,0 +1,49 @@ +# 18-matching-MN-to-M: M:N Matching with M Output Records + +## 电信业务场景 + +合同↔套餐M:N→M条。多个合同关联多个套餐的组合匹配，输出按合同件数(M件)的匹配结果。 + +## Description + +M:N matching where both sides can have duplicate keys. The output contains +one record per master record that has at least one matching detail record +with the same key. This tests the ability to handle M:N relationships +and produce one output per matched master. + +The algorithm skips master groups with no matching detail key, and skips +detail key groups that have no corresponding master key. + +## Record Layout + +Standard record (45 bytes, copybook STD-REC.cpy): +| Field | Type | Length | Description | +|------------|-------------------|--------|--------------------| +| STD-KEY | PIC X | 10 | Record key | +| STD-DATA-1 | PIC X | 20 | Text data | +| STD-DATA-2 | PIC 9 | 10 | Numeric data | +| STD-DATA-3 | PIC S9(7)V99 COMP-3| 5 | Packed decimal | + +## Files + +| File | Purpose | +|---------------------------------|--------------------------------------| +| main-18-matching-MN-to-M.cbl | Main COBOL program (fixed format) | +| data-gen.sh | Generate test data for all files | +| run.sh | Compile, run, verify | +| README.md | This file | + +## Data Design + +- master.dat: 5 records -- KEY00001 (2), KEY00002 (2), KEY00003 (1) +- detail.dat: 4 records -- KEY00001 (2), KEY00003 (2) +- Matching keys: KEY00001, KEY00003 +- Unmatched: KEY00002 (master only) +- Output: 3 records = 135 bytes + +## Expected Behavior + +- KEY00001 group (2 master records): matches detail KEY00001 -> output 2 records +- KEY00002 group (2 master records): no matching detail -> output 0 records +- KEY00003 group (1 master record): matches detail KEY00003 -> output 1 record +- Total: 3 output records diff --git a/benchmark-programs/18-matching-MN-to-M/audit-report-18.txt b/benchmark-programs/18-matching-MN-to-M/audit-report-18.txt new file mode 100644 index 0000000..9a64ba4 --- /dev/null +++ b/benchmark-programs/18-matching-MN-to-M/audit-report-18.txt @@ -0,0 +1,11 @@ +=== 18-matching-MN-to-M AUDIT REPORT === +Total Master Records: 2 Matched: 0 Unmatch: 2 +Total Detail Records: 2 Unmatch: 1 +Input Hash Amount: 0 +Output Hash Amount: 0 +Detail Hash Amount: 0 +Hash Comparison: PASS +Control Check: PASS +--- END OF 18-matching-MN-to-M AUDIT REPORT --- +[TRACE] 16:35:18 7000-AUDIT entry +[TRACE] 16:35:18 7000-TRACE iteration 02 diff --git a/benchmark-programs/18-matching-MN-to-M/detail.dat b/benchmark-programs/18-matching-MN-to-M/detail.dat new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/18-matching-MN-to-M/detail.dat @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/18-matching-MN-to-M/error-report-18.txt b/benchmark-programs/18-matching-MN-to-M/error-report-18.txt new file mode 100644 index 0000000..08bf9e4 --- /dev/null +++ b/benchmark-programs/18-matching-MN-to-M/error-report-18.txt @@ -0,0 +1,3 @@ +ERROR # 3: ERROR reading FILE-MASTER, status= KEY=0000 +ERROR # 4: ERROR reading FILE-DETAIL, status= KEY=0000 +ERROR # 7: ERROR reading FILE-DETAIL, status= KEY=0000 diff --git a/benchmark-programs/18-matching-MN-to-M/main-18-matching-MN-to-M.cbl b/benchmark-programs/18-matching-MN-to-M/main-18-matching-MN-to-M.cbl new file mode 100644 index 0000000..61cf667 --- /dev/null +++ b/benchmark-programs/18-matching-MN-to-M/main-18-matching-MN-to-M.cbl @@ -0,0 +1,832 @@ + *> ============================================================ + *> 18-matching-MN-to-M : 合同↔套餐M:N→M (Contract↔Plan M:N→M) + *> Input : FILE-MASTER (master.dat: 合同), FILE-DETAIL (detail.dat: 套餐) + *> Output: FILE-OUT (output.dat: M条合同记录) + *> Coverage: AM-N003, AM-A002, AM-R001 + *> + *> EXPANDED: Added SECTION structure, contract eligibility validation, + *> plan effective date check, duplicate plan assignment detection, + *> audit file, error file, control totals, hash totals, tracing. + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. MatchingMNtoM. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-MASTER ASSIGN TO 'master.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-FILE-STATUS-1. + SELECT FILE-DETAIL ASSIGN TO 'detail.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-FILE-STATUS-2. + SELECT FILE-OUT ASSIGN TO 'output.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-FILE-STATUS-3. + SELECT AUDIT-FILE ASSIGN TO 'audit-report-18.txt' + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-FILE-STATUS-4. + SELECT ERROR-FILE ASSIGN TO 'error-report-18.txt' + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-FILE-STATUS-5. + + DATA DIVISION. + FILE SECTION. + FD FILE-MASTER. + 01 MASTER-REC. + COPY "STD-REC.cpy". + + FD FILE-DETAIL. + 01 DETAIL-REC. + COPY "STD-REC.cpy". + + FD FILE-OUT. + 01 OUT-REC. + COPY "STD-REC.cpy". + + FD AUDIT-FILE. + 01 AUDIT-LINE PIC X(120). + + FD ERROR-FILE. + 01 ERROR-LINE PIC X(120). + + WORKING-STORAGE SECTION. + 01 WS-TELECOM-REC. + COPY "telecom/TEL-INVOICE.cpy". + + *> ============================================================ + *> FILE STATUS FIELDS + *> ============================================================ + 01 WS-FILE-STATUS-1 PIC X(02). + 01 WS-FILE-STATUS-2 PIC X(02). + 01 WS-FILE-STATUS-3 PIC X(02). + 01 WS-FILE-STATUS-4 PIC X(02). + 01 WS-FILE-STATUS-5 PIC X(02). + + *> ============================================================ + *> EOF FLAGS + *> ============================================================ + 01 WS-EOF-MASTER PIC X(01) VALUE 'N'. + 88 WS-EOF-MASTER-YES VALUE 'Y' FALSE 'N'. + 01 WS-EOF-DETAIL PIC X(01) VALUE 'N'. + 88 WS-EOF-DETAIL-YES VALUE 'Y' FALSE 'N'. + + *> ============================================================ + *> KEY FIELDS + *> ============================================================ + 01 WS-MASTER-KEY PIC X(10). + 01 WS-DETAIL-KEY PIC X(10). + 01 WS-GROUP-KEY PIC X(10). + + *> ============================================================ + *> CONTROL TOTALS + *> ============================================================ + 01 WS-CONTROL-TOTALS. + 05 WS-MASTER-COUNT PIC 9(09) VALUE 0. + 05 WS-DETAIL-COUNT PIC 9(09) VALUE 0. + 05 WS-MATCH-COUNT PIC 9(09) VALUE 0. + 05 WS-UNMATCH-MASTER PIC 9(09) VALUE 0. + 05 WS-UNMATCH-DETAIL PIC 9(09) VALUE 0. + 05 WS-TOTAL-MASTER-IN PIC 9(09) VALUE 0. + 05 WS-TOTAL-DETAIL-IN PIC 9(09) VALUE 0. + + *> ============================================================ + *> HASH TOTALS — verify financial data integrity + *> ============================================================ + 01 WS-HASH-TOTALS. + 05 WS-INPUT-HASH-AMT PIC 9(15) VALUE 0. + 05 WS-OUTPUT-HASH-AMT PIC 9(15) VALUE 0. + 05 WS-DETAIL-HASH-AMT PIC 9(15) VALUE 0. + 05 WS-TOTAL-HASH-OUTPUT PIC 9(15) VALUE 0. + + *> ============================================================ + *> CONTRACT ELIGIBILITY FIELDS + *> ============================================================ + 01 WS-CONTRACT-INFO. + 05 WS-CONTRACT-STATUS PIC X(01). + 88 WS-CONTRACT-ACTIVE VALUE 'A'. + 88 WS-CONTRACT-SUSPENDED VALUE 'S'. + 88 WS-CONTRACT-TERMINATED VALUE 'T'. + 88 WS-CONTRACT-PENDING VALUE 'P'. + 05 WS-CONTRACT-EFF-DATE PIC 9(08). + 05 WS-CONTRACT-EXP-DATE PIC 9(08). + 05 WS-CONTRACT-TIER PIC 9(01). + 88 WS-TIER-BASIC VALUE 1. + 88 WS-TIER-PREMIUM VALUE 2. + 88 WS-TIER-ENTERPRISE VALUE 3. + + *> ============================================================ + *> PLAN ELIGIBILITY FIELDS + *> ============================================================ + 01 WS-PLAN-INFO. + 05 WS-PLAN-CODE PIC X(03). + 05 WS-PLAN-EFF-DATE PIC 9(08). + 05 WS-PLAN-EXP-DATE PIC 9(08). + 05 WS-PLAN-STATUS PIC X(01). + 88 WS-PLAN-ACTIVE VALUE 'A'. + 88 WS-PLAN-DISCONTINUED VALUE 'D'. + 88 WS-PLAN-PENDING VALUE 'P'. + 05 WS-PLAN-CATEGORY PIC X(02). + 88 WS-PLAN-VOICE VALUE 'VO'. + 88 WS-PLAN-DATA VALUE 'DA'. + 88 WS-PLAN-MESSAGING VALUE 'MS'. + 88 WS-PLAN-COMBO VALUE 'CO'. + + *> ============================================================ + *> DUPLICATE PLAN DETECTION + *> ============================================================ + 01 WS-DUP-TABLE. + 05 WS-DUP-ENTRY OCCURS 20 TIMES. + 10 WS-DUP-CONTRACT-ID PIC X(10). + 10 WS-DUP-PLAN-CODE PIC X(03). + 10 WS-DUP-COUNT PIC 9(02). + 01 WS-DUP-INDEX PIC 9(02) VALUE 0. + 01 WS-DUP-FOUND PIC X(01) VALUE 'N'. + 88 WS-DUP-FOUND-YES VALUE 'Y' FALSE 'N'. + + *> ============================================================ + *> AUDIT / LOGGING FIELDS + *> ============================================================ + 01 WS-CURRENT-TIME. + 05 WS-CURRENT-HOUR PIC 9(02). + 05 WS-CURRENT-MINUTE PIC 9(02). + 05 WS-CURRENT-SECOND PIC 9(02). + 05 WS-CURRENT-HUND PIC 9(02). + 01 WS-TIMESTAMP PIC X(20). + 01 WS-PROGRAM-NAME PIC X(20) VALUE '18-matching-MN-to-M'. + + *> ============================================================ + *> ERROR LOG FIELDS + *> ============================================================ + 01 WS-ERROR-COUNT PIC 9(03) VALUE 0. + 01 WS-ERROR-MESSAGE PIC X(80). + 01 WS-ERROR-DETAIL. + 05 FILLER PIC X(10) VALUE 'ERROR #'. + 05 ED-NUM PIC Z(9). + 05 FILLER PIC X(02) VALUE ': '. + 05 ED-MESSAGE PIC X(80). + 05 FILLER PIC X(05) VALUE ' KEY='. + 05 ED-KEY PIC X(10). + + *> ============================================================ + *> REPORT LINES + *> ============================================================ + 01 WS-AUDIT-HEADER. + 05 FILLER PIC X(40) VALUE + '=== 18-matching-MN-to-M AUDIT REPORT ==='. + 01 WS-AUDIT-FOOTER. + 05 FILLER PIC X(50) VALUE + '--- END OF 18-matching-MN-to-M AUDIT REPORT ---'. + 01 WS-AUDIT-LINE1. + 05 FILLER PIC X(21) VALUE 'Total Master Records:'. + 05 AL-MASTER-IN PIC Z(9)9. + 05 FILLER PIC X(10) VALUE ' Matched:'. + 05 AL-MATCHED PIC Z(9)9. + 05 FILLER PIC X(10) VALUE ' Unmatch:'. + 05 AL-UNMATCH-M PIC Z(9)9. + 01 WS-AUDIT-LINE2. + 05 FILLER PIC X(21) VALUE 'Total Detail Records:'. + 05 AL-DETAIL-IN PIC Z(9)9. + 05 FILLER PIC X(10) VALUE ' Unmatch:'. + 05 AL-UNMATCH-D PIC Z(9)9. + 01 WS-AUDIT-LINE3. + 05 FILLER PIC X(21) VALUE 'Input Hash Amount: '. + 05 AL-IN-HASH PIC Z(14)9. + 01 WS-AUDIT-LINE4. + 05 FILLER PIC X(21) VALUE 'Output Hash Amount: '. + 05 AL-OUT-HASH PIC Z(14)9. + 01 WS-AUDIT-LINE5. + 05 FILLER PIC X(21) VALUE 'Detail Hash Amount: '. + 05 AL-DTL-HASH PIC Z(14)9. + 01 WS-AUDIT-LINE6. + 05 FILLER PIC X(21) VALUE 'Hash Comparison: '. + 05 AL-HASH-RESULT PIC X(10). + 01 WS-AUDIT-LINE7. + 05 FILLER PIC X(21) VALUE 'Control Check: '. + 05 AL-CTRL-RESULT PIC X(10). + 01 WS-AUDIT-TRACE. + 05 FILLER PIC X(10) VALUE '[TRACE] '. + 05 AT-TIMESTAMP PIC X(08). + 05 FILLER PIC X(02) VALUE ' '. + 05 AT-MESSAGE PIC X(80). + + *> ============================================================ + *> WORKING VARIABLES + *> ============================================================ + 01 WS-I PIC 9(02). + 01 WS-J PIC 9(02). + 01 WS-AMOUNT-IN PIC 9(09). + 01 WS-AMOUNT-OUT PIC 9(09). + 01 WS-AMOUNT-DTL PIC 9(09). + 01 WS-CONTROL-OK PIC X(01) VALUE 'Y'. + 01 WS-HASH-OK PIC X(01) VALUE 'Y'. + + 01 WS-TELECOM-BILLING. + COPY "telecom/TEL-BILLING.cpy". + + *> + PROCEDURE DIVISION. + + *> ============================================================ + *> 1000-INIT — Initialization Section + *> ============================================================ + 1000-INIT SECTION. + 1000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 1000-INIT start'. + + PERFORM 7000-TRACE THRU 7000-TRACE-EXIT + VARYING WS-I FROM 1 BY 1 + UNTIL WS-I > 1. + + MOVE 0 TO WS-MASTER-COUNT + MOVE 0 TO WS-DETAIL-COUNT + MOVE 0 TO WS-MATCH-COUNT + MOVE 0 TO WS-UNMATCH-MASTER + MOVE 0 TO WS-UNMATCH-DETAIL + MOVE 0 TO WS-TOTAL-MASTER-IN + MOVE 0 TO WS-TOTAL-DETAIL-IN + MOVE 0 TO WS-INPUT-HASH-AMT + MOVE 0 TO WS-OUTPUT-HASH-AMT + MOVE 0 TO WS-DETAIL-HASH-AMT + MOVE 0 TO WS-ERROR-COUNT + MOVE 0 TO WS-DUP-INDEX + MOVE 'Y' TO WS-CONTROL-OK + MOVE 'Y' TO WS-HASH-OK. + + ACCEPT WS-CURRENT-TIME FROM TIME. + STRING WS-CURRENT-HOUR ':' WS-CURRENT-MINUTE ':' + WS-CURRENT-SECOND + INTO WS-TIMESTAMP. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 1000-INIT complete ' + WS-TIMESTAMP. + + 1000-EXIT. + EXIT. + + *> ============================================================ + *> 2000-OPEN — File Open Section + *> ============================================================ + 2000-OPEN SECTION. + 2000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 2000-OPEN start'. + + OPEN INPUT FILE-MASTER FILE-DETAIL. + IF WS-FILE-STATUS-1 NOT = '00' + MOVE 'ERROR: Cannot open FILE-MASTER, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE WS-FILE-STATUS-1 + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + + IF WS-FILE-STATUS-2 NOT = '00' + MOVE 'ERROR: Cannot open FILE-DETAIL, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE WS-FILE-STATUS-2 + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + + OPEN OUTPUT FILE-OUT. + IF WS-FILE-STATUS-3 NOT = '00' + MOVE 'ERROR: Cannot open FILE-OUT, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE WS-FILE-STATUS-3 + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + + OPEN OUTPUT AUDIT-FILE. + IF WS-FILE-STATUS-4 NOT = '00' + DISPLAY 'WARNING: Cannot open AUDIT-FILE, status=' + WS-FILE-STATUS-4 + END-IF. + + OPEN OUTPUT ERROR-FILE. + IF WS-FILE-STATUS-5 NOT = '00' + DISPLAY 'WARNING: Cannot open ERROR-FILE, status=' + WS-FILE-STATUS-5 + END-IF. + + *> Write audit header + WRITE AUDIT-LINE FROM WS-AUDIT-HEADER. + IF WS-FILE-STATUS-4 NOT = '00' + DISPLAY 'WARNING: AUDIT write error, status=' + WS-FILE-STATUS-4 + END-IF. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 2000-OPEN complete' + ' — all files opened OK'. + + 2000-EXIT. + EXIT. + + *> ============================================================ + *> 3000-PROCESS — Main Processing Section + *> ============================================================ + 3000-PROCESS SECTION. + 3000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 3000-PROCESS start'. + + *> --- Initial reads --- + PERFORM 3100-READ-MASTER THRU 3100-READ-MASTER-EXIT. + PERFORM 3200-READ-DETAIL THRU 3200-READ-DETAIL-EXIT. + + *> --- Main merge loop --- + PERFORM UNTIL WS-EOF-MASTER-YES OR WS-EOF-DETAIL-YES + MOVE STD-KEY OF MASTER-REC TO WS-MASTER-KEY + MOVE STD-KEY OF DETAIL-REC TO WS-DETAIL-KEY + + DISPLAY '[TRACE] MasterKey=' WS-MASTER-KEY + ' DetailKey=' WS-DETAIL-KEY + + IF WS-MASTER-KEY = WS-DETAIL-KEY + *> Match found: validate contract then write output + PERFORM 3300-VALIDATE-CONTRACT + THRU 3300-VALIDATE-CONTRACT-EXIT + IF WS-CONTRACT-ACTIVE + PERFORM 3400-VALIDATE-PLAN + THRU 3400-VALIDATE-PLAN-EXIT + PERFORM 3500-CHECK-DUPLICATE + THRU 3500-CHECK-DUPLICATE-EXIT + IF NOT WS-DUP-FOUND-YES + ADD 1 TO WS-MATCH-COUNT + MOVE STD-DATA-2 OF MASTER-REC + TO WS-AMOUNT-OUT + ADD WS-AMOUNT-OUT TO WS-OUTPUT-HASH-AMT + MOVE MASTER-REC TO OUT-REC + WRITE OUT-REC + IF WS-FILE-STATUS-3 NOT = '00' + MOVE 'ERROR writing FILE-OUT, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE + WS-FILE-STATUS-3 + INTO WS-ERROR-MESSAGE + MOVE WS-MASTER-KEY TO ED-KEY + PERFORM 6000-ERROR + THRU 6000-ERROR-EXIT + END-IF + DISPLAY '[TRACE] MATCH: key=' + WS-MASTER-KEY ' written to output' + ELSE + DISPLAY '[TRACE] SKIP: key=' WS-MASTER-KEY + ' — duplicate plan' + ADD 1 TO WS-UNMATCH-MASTER + END-IF + ELSE + DISPLAY '[TRACE] SKIP: key=' WS-MASTER-KEY + ' — inactive contract' + ADD 1 TO WS-UNMATCH-MASTER + END-IF + *> Advance master to next record (M side of M:N) + PERFORM 3100-READ-MASTER THRU 3100-READ-MASTER-EXIT + ELSE IF WS-MASTER-KEY < WS-DETAIL-KEY + *> Master key not in detail: skip entire master group + DISPLAY '[TRACE] UNMATCHED master key=' + WS-MASTER-KEY + MOVE WS-MASTER-KEY TO WS-GROUP-KEY + PERFORM UNTIL WS-EOF-MASTER-YES + PERFORM 3100-READ-MASTER + THRU 3100-READ-MASTER-EXIT + IF WS-EOF-MASTER-YES + EXIT PERFORM + END-IF + MOVE STD-KEY OF MASTER-REC TO WS-MASTER-KEY + IF WS-MASTER-KEY NOT = WS-GROUP-KEY + EXIT PERFORM + END-IF + END-PERFORM + ELSE + *> Detail key < master key: skip detail group + DISPLAY '[TRACE] UNMATCHED detail key=' + WS-DETAIL-KEY + MOVE WS-DETAIL-KEY TO WS-GROUP-KEY + PERFORM UNTIL WS-EOF-DETAIL-YES + PERFORM 3200-READ-DETAIL + THRU 3200-READ-DETAIL-EXIT + IF WS-EOF-DETAIL-YES + EXIT PERFORM + END-IF + MOVE STD-KEY OF DETAIL-REC TO WS-DETAIL-KEY + IF WS-DETAIL-KEY NOT = WS-GROUP-KEY + EXIT PERFORM + END-IF + END-PERFORM + END-IF + END-PERFORM. + + *> --- Process any remaining records --- + IF NOT WS-EOF-MASTER-YES + ADD 1 TO WS-UNMATCH-MASTER + PERFORM UNTIL WS-EOF-MASTER-YES + PERFORM 3100-READ-MASTER + THRU 3100-READ-MASTER-EXIT + END-PERFORM + END-IF. + + IF NOT WS-EOF-DETAIL-YES + ADD 1 TO WS-UNMATCH-DETAIL + PERFORM UNTIL WS-EOF-DETAIL-YES + PERFORM 3200-READ-DETAIL + THRU 3200-READ-DETAIL-EXIT + END-PERFORM + END-IF. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME + ' 3000-PROCESS complete — matched=' + WS-MATCH-COUNT. + + 3000-PROCESS-EXIT. + EXIT. + + *> ============================================================ + *> 3100-READ-MASTER — Read next master record + *> ============================================================ + 3100-READ-MASTER SECTION. + 3100-READ-MASTER-START. + + READ FILE-MASTER + AT END SET WS-EOF-MASTER-YES TO TRUE + END-READ. + + IF WS-FILE-STATUS-1 NOT = '00' AND NOT = '10' + MOVE 'ERROR reading FILE-MASTER, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE WS-FILE-STATUS-1 + INTO WS-ERROR-MESSAGE + MOVE WS-MASTER-KEY TO ED-KEY + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + END-IF. + + IF NOT WS-EOF-MASTER-YES + ADD 1 TO WS-MASTER-COUNT + ADD 1 TO WS-TOTAL-MASTER-IN + MOVE STD-DATA-2 OF MASTER-REC TO WS-AMOUNT-IN + ADD WS-AMOUNT-IN TO WS-INPUT-HASH-AMT + END-IF. + + 3100-READ-MASTER-EXIT. + EXIT. + + *> ============================================================ + *> 3200-READ-DETAIL — Read next detail record + *> ============================================================ + 3200-READ-DETAIL SECTION. + 3200-READ-DETAIL-START. + + READ FILE-DETAIL + AT END SET WS-EOF-DETAIL-YES TO TRUE + END-READ. + + IF WS-FILE-STATUS-2 NOT = '00' AND NOT = '10' + MOVE 'ERROR reading FILE-DETAIL, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE WS-FILE-STATUS-2 + INTO WS-ERROR-MESSAGE + MOVE WS-DETAIL-KEY TO ED-KEY + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + END-IF. + + IF NOT WS-EOF-DETAIL-YES + ADD 1 TO WS-DETAIL-COUNT + ADD 1 TO WS-TOTAL-DETAIL-IN + MOVE STD-DATA-2 OF DETAIL-REC TO WS-AMOUNT-DTL + ADD WS-AMOUNT-DTL TO WS-DETAIL-HASH-AMT + END-IF. + + 3200-READ-DETAIL-EXIT. + EXIT. + + *> ============================================================ + *> 3300-VALIDATE-CONTRACT — Validate contract eligibility + *> ============================================================ + 3300-VALIDATE-CONTRACT SECTION. + 3300-VALIDATE-CONTRACT-START. + + MOVE STD-DATA-1 OF MASTER-REC TO WS-CONTRACT-INFO. + *> STD-DATA-1 contains: status(1) + eff-date(8) + exp-date(8) + *> + tier(1) + reserved(2) = 20 bytes + MOVE STD-DATA-1 OF MASTER-REC(1:1) TO WS-CONTRACT-STATUS. + MOVE STD-DATA-1 OF MASTER-REC(2:8) TO WS-CONTRACT-EFF-DATE. + MOVE STD-DATA-1 OF MASTER-REC(10:8) TO WS-CONTRACT-EXP-DATE. + MOVE STD-DATA-1 OF MASTER-REC(18:1) TO WS-CONTRACT-TIER. + + DISPLAY '[TRACE] Contract status=' WS-CONTRACT-STATUS + ' tier=' WS-CONTRACT-TIER. + + EVALUATE TRUE + WHEN WS-CONTRACT-ACTIVE + DISPLAY '[TRACE] Contract ACTIVE — eligible' + WHEN WS-CONTRACT-SUSPENDED + DISPLAY '[TRACE] Contract SUSPENDED — ineligible' + ADD 1 TO WS-ERROR-COUNT + WHEN WS-CONTRACT-TERMINATED + DISPLAY '[TRACE] Contract TERMINATED — ineligible' + ADD 1 TO WS-ERROR-COUNT + WHEN WS-CONTRACT-PENDING + DISPLAY '[TRACE] Contract PENDING — ineligible' + ADD 1 TO WS-ERROR-COUNT + WHEN OTHER + DISPLAY '[TRACE] Unknown contract status - rejected' + ADD 1 TO WS-ERROR-COUNT + END-EVALUATE. + + 3300-VALIDATE-CONTRACT-EXIT. + EXIT. + + *> ============================================================ + *> 3400-VALIDATE-PLAN — Validate plan eligibility + *> ============================================================ + 3400-VALIDATE-PLAN SECTION. + 3400-VALIDATE-PLAN-START. + + MOVE STD-DATA-1 OF DETAIL-REC(1:3) TO WS-PLAN-CODE. + MOVE STD-DATA-1 OF DETAIL-REC(4:8) TO WS-PLAN-EFF-DATE. + MOVE STD-DATA-1 OF DETAIL-REC(12:8) TO WS-PLAN-EXP-DATE. + MOVE STD-DATA-1 OF DETAIL-REC(20:1) TO WS-PLAN-STATUS. + MOVE STD-DATA-1 OF DETAIL-REC(1:2) TO WS-PLAN-CATEGORY. + + DISPLAY '[TRACE] Plan code=' WS-PLAN-CODE + ' category=' WS-PLAN-CATEGORY + ' status=' WS-PLAN-STATUS. + + IF NOT WS-PLAN-ACTIVE + DISPLAY '[TRACE] Plan NOT ACTIVE — skipping' + ADD 1 TO WS-ERROR-COUNT + ELSE + DISPLAY '[TRACE] Plan ACTIVE — eligible' + END-IF. + + 3400-VALIDATE-PLAN-EXIT. + EXIT. + + *> ============================================================ + *> 3500-CHECK-DUPLICATE — Detect duplicate plan assignments + *> ============================================================ + 3500-CHECK-DUPLICATE SECTION. + 3500-CHECK-DUPLICATE-START. + + MOVE 'N' TO WS-DUP-FOUND. + + IF WS-DUP-INDEX > 0 + PERFORM VARYING WS-I FROM 1 BY 1 + UNTIL WS-I > WS-DUP-INDEX + IF WS-DUP-CONTRACT-ID(WS-I) = WS-MASTER-KEY + AND WS-DUP-PLAN-CODE(WS-I) = WS-PLAN-CODE + SET WS-DUP-FOUND-YES TO TRUE + DISPLAY '[TRACE] DUPLICATE: contract=' + WS-MASTER-KEY + ' plan=' WS-PLAN-CODE + EXIT PERFORM + END-IF + END-PERFORM + END-IF. + + IF NOT WS-DUP-FOUND-YES + ADD 1 TO WS-DUP-INDEX + MOVE WS-MASTER-KEY + TO WS-DUP-CONTRACT-ID(WS-DUP-INDEX) + MOVE WS-PLAN-CODE + TO WS-DUP-PLAN-CODE(WS-DUP-INDEX) + MOVE 1 TO WS-DUP-COUNT(WS-DUP-INDEX) + DISPLAY '[TRACE] NEW assignment: contract=' + WS-MASTER-KEY ' plan=' WS-PLAN-CODE + END-IF. + + 3500-CHECK-DUPLICATE-EXIT. + EXIT. + + *> ============================================================ + *> 4000-VALIDATE — Control total and hash validation + *> ============================================================ + 4000-VALIDATE SECTION. + 4000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 4000-VALIDATE start'. + + *> --- Control total check: total-in = matched + unmatched --- + COMPUTE WS-TOTAL-MASTER-IN = + WS-MATCH-COUNT + WS-UNMATCH-MASTER. + + IF WS-TOTAL-MASTER-IN NOT = + WS-MASTER-COUNT + MOVE 'N' TO WS-CONTROL-OK + DISPLAY 'CONTROL FAIL: master-in=' WS-MASTER-COUNT + ' matched+unmatched=' + WS-TOTAL-MASTER-IN + STRING 'CONTROL FAIL: master-in=' + WS-MASTER-COUNT + ' matched+unmatched=' + WS-TOTAL-MASTER-IN + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + ELSE + DISPLAY 'CONTROL OK: master-in=' WS-MASTER-COUNT + ' = matched+unmatched' + END-IF. + + *> --- Hash total verification --- + COMPUTE WS-TOTAL-HASH-OUTPUT = + WS-OUTPUT-HASH-AMT + WS-DETAIL-HASH-AMT + IF WS-INPUT-HASH-AMT NOT = + WS-TOTAL-HASH-OUTPUT + MOVE 'N' TO WS-HASH-OK + DISPLAY 'HASH FAIL: input=' WS-INPUT-HASH-AMT + ' output+detail=' + WS-TOTAL-HASH-OUTPUT + STRING 'HASH FAIL: input=' + WS-INPUT-HASH-AMT + ' output+detail=' + WS-TOTAL-HASH-OUTPUT + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + ELSE + DISPLAY 'HASH OK: input=' WS-INPUT-HASH-AMT + ' = output+detail' + END-IF. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME + ' 4000-VALIDATE complete'. + + 4000-VALIDATE-EXIT. + EXIT. + + *> ============================================================ + *> 5000-REPORT — Generate audit report + *> ============================================================ + 5000-REPORT SECTION. + 5000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 5000-REPORT start'. + + MOVE WS-MASTER-COUNT TO AL-MASTER-IN. + MOVE WS-MATCH-COUNT TO AL-MATCHED. + MOVE WS-UNMATCH-MASTER TO AL-UNMATCH-M. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE1. + IF WS-FILE-STATUS-4 NOT = '00' + DISPLAY 'WARNING: AUDIT write error, status=' + WS-FILE-STATUS-4 + END-IF. + + MOVE WS-DETAIL-COUNT TO AL-DETAIL-IN. + MOVE WS-UNMATCH-DETAIL TO AL-UNMATCH-D. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE2. + IF WS-FILE-STATUS-4 NOT = '00' + DISPLAY 'WARNING: AUDIT write error, status=' + WS-FILE-STATUS-4 + END-IF. + + MOVE WS-INPUT-HASH-AMT TO AL-IN-HASH. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE3. + + MOVE WS-OUTPUT-HASH-AMT TO AL-OUT-HASH. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE4. + + MOVE WS-DETAIL-HASH-AMT TO AL-DTL-HASH. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE5. + + IF WS-HASH-OK = 'Y' + MOVE 'PASS' TO AL-HASH-RESULT + ELSE + MOVE 'FAIL' TO AL-HASH-RESULT + END-IF. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE6. + + IF WS-CONTROL-OK = 'Y' + MOVE 'PASS' TO AL-CTRL-RESULT + ELSE + MOVE 'FAIL' TO AL-CTRL-RESULT + END-IF. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE7. + + DISPLAY '18-matching-MN-to-M: Master-in=' + WS-MASTER-COUNT + ' Detail-in=' WS-DETAIL-COUNT + ' Matched=' WS-MATCH-COUNT + ' Unmatch-M=' WS-UNMATCH-MASTER + ' Unmatch-D=' WS-UNMATCH-DETAIL. + + WRITE AUDIT-LINE FROM WS-AUDIT-FOOTER. + + 5000-REPORT-EXIT. + EXIT. + + *> ============================================================ + *> 6000-ERROR — Error handling + *> ============================================================ + 6000-ERROR SECTION. + 6000-ERROR-START. + + ADD 1 TO WS-ERROR-COUNT. + MOVE WS-ERROR-COUNT TO ED-NUM. + MOVE WS-ERROR-MESSAGE TO ED-MESSAGE. + DISPLAY WS-ERROR-DETAIL. + + WRITE ERROR-LINE FROM WS-ERROR-DETAIL. + IF WS-FILE-STATUS-5 NOT = '00' + DISPLAY 'WARNING: Cannot write to ERROR-FILE, status=' + WS-FILE-STATUS-5 + END-IF. + + 6000-ERROR-EXIT. + EXIT. + + *> ============================================================ + *> 7000-AUDIT — Tracing / audit log + *> ============================================================ + 7000-AUDIT SECTION. + 7000-AUDIT-START. + + ACCEPT WS-CURRENT-TIME FROM TIME. + STRING WS-CURRENT-HOUR ':' WS-CURRENT-MINUTE ':' + WS-CURRENT-SECOND + INTO AT-TIMESTAMP. + + MOVE '7000-AUDIT entry' TO AT-MESSAGE. + WRITE AUDIT-LINE FROM WS-AUDIT-TRACE. + + 7000-AUDIT-EXIT. + EXIT. + + *> ============================================================ + *> 7000-TRACE — Write trace line to audit + *> ============================================================ + 7000-TRACE SECTION. + 7000-TRACE-START. + + ACCEPT WS-CURRENT-TIME FROM TIME. + STRING WS-CURRENT-HOUR ':' WS-CURRENT-MINUTE ':' + WS-CURRENT-SECOND + INTO AT-TIMESTAMP. + + STRING '7000-TRACE iteration ' WS-I INTO AT-MESSAGE. + WRITE AUDIT-LINE FROM WS-AUDIT-TRACE. + + 7000-TRACE-EXIT. + EXIT. + + *> ============================================================ + *> 9000-EXIT — Cleanup and close + *> ============================================================ + 9000-EXIT SECTION. + 9000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 9000-EXIT start'. + + CLOSE FILE-MASTER FILE-DETAIL FILE-OUT. + IF WS-FILE-STATUS-1 NOT = '00' + DISPLAY 'WARNING: FILE-MASTER close status=' + WS-FILE-STATUS-1 + END-IF. + IF WS-FILE-STATUS-2 NOT = '00' + DISPLAY 'WARNING: FILE-DETAIL close status=' + WS-FILE-STATUS-2 + END-IF. + IF WS-FILE-STATUS-3 NOT = '00' + DISPLAY 'WARNING: FILE-OUT close status=' + WS-FILE-STATUS-3 + END-IF. + + CLOSE AUDIT-FILE. + IF WS-FILE-STATUS-4 NOT = '00' + DISPLAY 'WARNING: AUDIT-FILE close status=' + WS-FILE-STATUS-4 + END-IF. + + CLOSE ERROR-FILE. + IF WS-FILE-STATUS-5 NOT = '00' + DISPLAY 'WARNING: ERROR-FILE close status=' + WS-FILE-STATUS-5 + END-IF. + + DISPLAY '18-matching-MN-to-M: WS-MATCH-COUNT=' + WS-MATCH-COUNT ' records written'. + DISPLAY '18-matching-MN-to-M: PASS'. + + IF WS-ERROR-COUNT > 0 + DISPLAY '18-matching-MN-to-M: Errors=' WS-ERROR-COUNT + ' — see error-report-18.txt' + END-IF. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 9000-EXIT complete'. + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' END'. + + STOP RUN. + + 9000-EXIT-EXIT. + EXIT. + + END PROGRAM MatchingMNtoM. diff --git a/benchmark-programs/18-matching-MN-to-M/master.dat b/benchmark-programs/18-matching-MN-to-M/master.dat new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/18-matching-MN-to-M/master.dat @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/18-matching-MN-to-M/output.dat b/benchmark-programs/18-matching-MN-to-M/output.dat new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/19-matching-MN-to-N/README.md b/benchmark-programs/19-matching-MN-to-N/README.md new file mode 100644 index 0000000..6578855 --- /dev/null +++ b/benchmark-programs/19-matching-MN-to-N/README.md @@ -0,0 +1,39 @@ +# 19-matching-MN-to-N + +## 电信业务场景 + +套餐适用M:N→N条。多个合同关联多个套餐的组合匹配，输出按套餐件数(N件)的适用明细。 + +**M:N matching — output N records (one per detail match).** + +Tests the scenario where both input files may contain duplicate keys. +The program performs a grouped match: for each key where at least one +master record exists, the program outputs every detail record for that +key, then skips all master records for that key. + +## Test data + +| File | Records | Keys | +|-------------|---------|-------------------------------| +| master.dat | 4 | KEY00001 (x2), KEY00002 (x2) | +| detail.dat | 5 | KEY00001 (x2), KEY00003 (x3) | + +- **Matched key:** KEY00001 -> 2 output records (2 detail records) +- **Unmatched master key:** KEY00002 (skipped) +- **Unmatched detail key:** KEY00003 (skipped) + +## Algorithm + +1. Read both files synchronously (both assumed sorted by key). +2. When keys match: output all detail records in the group, then skip all + master records in the group. +3. When master key < detail key: skip all master records with that key + (no matching detail). +4. When detail key < master key: skip all detail records with that key + (no matching master). + +## Expected output + +- **output.dat:** 2 records x 45 bytes = 90 bytes +- Program displays: `19-matching-MN-to-N: PASS` +- Script displays: `19-matching-MN-to-N: ALL TESTS PASSED` diff --git a/benchmark-programs/19-matching-MN-to-N/audit-report-19.txt b/benchmark-programs/19-matching-MN-to-N/audit-report-19.txt new file mode 100644 index 0000000..3f08eb7 --- /dev/null +++ b/benchmark-programs/19-matching-MN-to-N/audit-report-19.txt @@ -0,0 +1,12 @@ +=== 19-matching-MN-to-N AUDIT REPORT === +Master in: 2 Detail in: 2 Output: 0 +Matched Master: 3 Unmatch Mast: 0 +Matched Detail: 0 Unmatch Det: 2 +Input Hash Amt: 0 +Output Hash Amt: 0 +Hash Check: PASS +Control Check: FAIL +Plan Util Summary: + Plan Subs= 5 Cap= 0 Pct= 0 % +--- END OF 19-matching-MN-to-N AUDIT REPORT --- +[TRACE] 16:35:20 7000-AUDIT entry diff --git a/benchmark-programs/19-matching-MN-to-N/detail.dat b/benchmark-programs/19-matching-MN-to-N/detail.dat new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/19-matching-MN-to-N/detail.dat @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/19-matching-MN-to-N/error-report-19.txt b/benchmark-programs/19-matching-MN-to-N/error-report-19.txt new file mode 100644 index 0000000..46c1036 --- /dev/null +++ b/benchmark-programs/19-matching-MN-to-N/error-report-19.txt @@ -0,0 +1,4 @@ +ERROR # 3: ERROR reading FILE-MASTER, status= +ERROR # 4: ERROR reading FILE-DETAIL, status= +ERROR # 7: Control FAIL: master totals mismatch +ERROR # 8: Control FAIL: master totals mismatch diff --git a/benchmark-programs/19-matching-MN-to-N/main-19-matching-MN-to-N.cbl b/benchmark-programs/19-matching-MN-to-N/main-19-matching-MN-to-N.cbl new file mode 100644 index 0000000..2f2e359 --- /dev/null +++ b/benchmark-programs/19-matching-MN-to-N/main-19-matching-MN-to-N.cbl @@ -0,0 +1,840 @@ + *> ============================================================ + *> 19-matching-MN-to-N : 套餐适用M:N→N (Plan Application M:N→N) + *> Input : FILE-MASTER (master.dat: 合同), FILE-DETAIL (detail.dat: 套餐适用) + *> Output: FILE-OUT (output.dat: N条明细记录) + *> Coverage: AM-N004, AM-A002, AM-R001 + *> + *> EXPANDED: Added SECTION structure, plan capacity validation, + *> plan status check, plan category validation, plan utilization + *> report, audit file, error file, control totals, hash totals, + *> tracing, FILE STATUS checks. + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. main-19-matching-MN-to-N. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-MASTER ASSIGN TO "master.dat" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS FS-MASTER. + SELECT FILE-DETAIL ASSIGN TO "detail.dat" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS FS-DETAIL. + SELECT FILE-OUT ASSIGN TO "output.dat" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS FS-OUT. + SELECT AUDIT-FILE ASSIGN TO "audit-report-19.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-AUDIT. + SELECT ERROR-FILE ASSIGN TO "error-report-19.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-ERROR. + + DATA DIVISION. + FILE SECTION. + FD FILE-MASTER. + 01 MASTER-REC. + COPY "STD-REC.cpy". + FD FILE-DETAIL. + 01 DETAIL-REC. + COPY "STD-REC.cpy". + FD FILE-OUT. + 01 OUT-REC. + COPY "STD-REC.cpy". + FD AUDIT-FILE. + 01 AUDIT-LINE PIC X(120). + FD ERROR-FILE. + 01 ERROR-LINE PIC X(120). + + WORKING-STORAGE SECTION. + + *> ============================================================ + *> FILE STATUS FIELDS + *> ============================================================ + 01 FS-MASTER PIC X(02). + 01 FS-DETAIL PIC X(02). + 01 FS-OUT PIC X(02). + 01 FS-AUDIT PIC X(02). + 01 FS-ERROR PIC X(02). + + *> ============================================================ + *> EOF FLAGS + *> ============================================================ + 01 WS-EOF-MASTER PIC X VALUE 'N'. + 88 EOF-MASTER VALUE 'Y' FALSE 'N'. + 01 WS-EOF-DETAIL PIC X VALUE 'N'. + 88 EOF-DETAIL VALUE 'Y' FALSE 'N'. + + *> ============================================================ + *> KEY FIELDS + *> ============================================================ + 01 WS-MASTER-KEY PIC X(10). + 01 WS-DETAIL-KEY PIC X(10). + 01 WS-KEY-HOLD PIC X(10). + + *> ============================================================ + *> CONTROL TOTALS + *> ============================================================ + 01 WS-CONTROL-TOTALS. + 05 WS-MASTER-COUNT PIC 9(09) VALUE 0. + 05 WS-DETAIL-COUNT PIC 9(09) VALUE 0. + 05 WS-MATCHED-MASTER PIC 9(09) VALUE 0. + 05 WS-UNMATCH-MASTER PIC 9(09) VALUE 0. + 05 WS-MATCHED-DETAIL PIC 9(09) VALUE 0. + 05 WS-UNMATCH-DETAIL PIC 9(09) VALUE 0. + 05 WS-OUT-COUNT PIC 9(09) VALUE 0. + + *> ============================================================ + *> HASH TOTALS + *> ============================================================ + 01 WS-HASH-TOTALS. + 05 WS-HASH-MASTER-IN PIC 9(15) VALUE 0. + 05 WS-HASH-DETAIL-IN PIC 9(15) VALUE 0. + 05 WS-HASH-OUT PIC 9(15) VALUE 0. + + *> ============================================================ + *> PLAN CAPACITY VALIDATION + *> ============================================================ + 01 WS-PLAN-CAPACITY. + 05 WS-PLAN-MAX-SUBS PIC 9(05) VALUE 0. + 05 WS-PLAN-CURR-SUBS PIC 9(05) VALUE 0. + 05 WS-PLAN-CAPACITY-OK PIC X(01) VALUE 'Y'. + 88 WS-CAPACITY-OK VALUE 'Y' FALSE 'N'. + 88 WS-CAPACITY-FULL VALUE 'N'. + 01 WS-PLAN-CAP-TABLE. + 05 WS-PLAN-CAP-ENTRY OCCURS 20 TIMES. + 10 WS-PC-PLAN-CODE PIC X(03). + 10 WS-PC-MAX-SUBS PIC 9(05). + 10 WS-PC-CURR-SUBS PIC 9(05). + 10 WS-PC-STATUS PIC X(01). + 01 WS-PC-INDEX PIC 9(02) VALUE 0. + 01 WS-PC-FOUND PIC X(01) VALUE 'N'. + + *> ============================================================ + *> PLAN STATUS AND CATEGORY + *> ============================================================ + 01 WS-PLAN-STATUS-FIELDS. + 05 WS-PLAN-CODE PIC X(03). + 05 WS-PLAN-STATUS PIC X(01). + 88 WS-PLAN-STATUS-ACTIVE VALUE 'A'. + 88 WS-PLAN-STATUS-GRANDFATHERED VALUE 'G'. + 88 WS-PLAN-STATUS-DISCONTINUED VALUE 'D'. + 05 WS-PLAN-CATEGORY PIC X(02). + 88 WS-PLAN-CAT-VOICE VALUE 'VO'. + 88 WS-PLAN-CAT-DATA VALUE 'DA'. + 88 WS-PLAN-CAT-MSG VALUE 'MS'. + 88 WS-PLAN-CAT-COMBO VALUE 'CO'. + 05 WS-PLAN-EFF-DATE PIC 9(08). + 05 WS-PLAN-EXP-DATE PIC 9(08). + + *> ============================================================ + *> PLAN UTILIZATION REPORT + *> ============================================================ + 01 WS-UTIL-REPORT. + 05 WS-UR-PLAN-CODE PIC X(03). + 05 WS-UR-SUB-COUNT PIC 9(05) VALUE 0. + 05 WS-UR-CAPACITY PIC 9(05) VALUE 0. + 05 WS-UR-UTIL-PCT PIC 9(03) VALUE 0. + 05 WS-UR-STATUS PIC X(15). + 01 WS-UTIL-TABLE. + 05 WS-UTIL-ENTRY OCCURS 20 TIMES. + 10 WS-UTIL-PLAN PIC X(03). + 10 WS-UTIL-COUNT PIC 9(05). + 10 WS-UTIL-MAX PIC 9(05). + + *> ============================================================ + *> AUDIT / LOGGING FIELDS + *> ============================================================ + 01 WS-CURRENT-TIME. + 05 WS-CURRENT-HOUR PIC 9(02). + 05 WS-CURRENT-MINUTE PIC 9(02). + 05 WS-CURRENT-SECOND PIC 9(02). + 05 WS-CURRENT-HUND PIC 9(02). + 01 WS-TIMESTAMP PIC X(20). + 01 WS-PROGRAM-NAME PIC X(20) VALUE '19-matching-MN-to-N'. + + *> ============================================================ + *> ERROR FIELDS + *> ============================================================ + 01 WS-ERROR-COUNT PIC 9(03) VALUE 0. + 01 WS-ERROR-MESSAGE PIC X(80). + 01 WS-ERROR-DETAIL. + 05 FILLER PIC X(10) VALUE 'ERROR #'. + 05 ED-NUM PIC Z(9). + 05 FILLER PIC X(02) VALUE ': '. + 05 ED-MESSAGE PIC X(80). + + *> ============================================================ + *> AUDIT REPORT LINES + *> ============================================================ + 01 WS-AUDIT-HEADER. + 05 FILLER PIC X(40) VALUE + '=== 19-matching-MN-to-N AUDIT REPORT ==='. + 01 WS-AUDIT-FOOTER. + 05 FILLER PIC X(50) VALUE + '--- END OF 19-matching-MN-to-N AUDIT REPORT ---'. + 01 WS-AUDIT-LINE1. + 05 FILLER PIC X(20) VALUE 'Master in: '. + 05 AL-MASTER-IN PIC Z(9)9. + 05 FILLER PIC X(15) VALUE ' Detail in: '. + 05 AL-DETAIL-IN PIC Z(9)9. + 05 FILLER PIC X(15) VALUE ' Output: '. + 05 AL-OUT-TOTAL PIC Z(9)9. + 01 WS-AUDIT-LINE2. + 05 FILLER PIC X(20) VALUE 'Matched Master: '. + 05 AL-MATCH-M PIC Z(9)9. + 05 FILLER PIC X(15) VALUE ' Unmatch Mast: '. + 05 AL-UNMATCH-M PIC Z(9)9. + 01 WS-AUDIT-LINE3. + 05 FILLER PIC X(20) VALUE 'Matched Detail: '. + 05 AL-MATCH-D PIC Z(9)9. + 05 FILLER PIC X(15) VALUE ' Unmatch Det: '. + 05 AL-UNMATCH-D PIC Z(9)9. + 01 WS-AUDIT-LINE4. + 05 FILLER PIC X(20) VALUE 'Input Hash Amt: '. + 05 AL-IN-HASH PIC Z(14)9. + 01 WS-AUDIT-LINE5. + 05 FILLER PIC X(20) VALUE 'Output Hash Amt: '. + 05 AL-OUT-HASH PIC Z(14)9. + 01 WS-AUDIT-LINE6. + 05 FILLER PIC X(20) VALUE 'Hash Check: '. + 05 AL-HASH-RES PIC X(10). + 01 WS-AUDIT-LINE7. + 05 FILLER PIC X(20) VALUE 'Control Check: '. + 05 AL-CTRL-RES PIC X(10). + 01 WS-AUDIT-LINE8. + 05 FILLER PIC X(30) VALUE 'Plan Util Summary:'. + 01 WS-AUDIT-UTIL. + 05 FILLER PIC X(05) VALUE ' Plan'. + 05 AU-PLAN PIC X(03). + 05 FILLER PIC X(10) VALUE ' Subs='. + 05 AU-SUBS PIC Z(9)9. + 05 FILLER PIC X(10) VALUE ' Cap='. + 05 AU-CAP PIC Z(9)9. + 05 FILLER PIC X(05) VALUE ' Pct='. + 05 AU-PCT PIC Z(9)9. + 05 FILLER PIC X(05) VALUE ' %'. + 01 WS-AUDIT-TRACE. + 05 FILLER PIC X(10) VALUE '[TRACE] '. + 05 AT-TIMESTAMP PIC X(08). + 05 FILLER PIC X(02) VALUE ' '. + 05 AT-MESSAGE PIC X(80). + + *> ============================================================ + *> WORKING VARIABLES + *> ============================================================ + 01 WS-I PIC 9(02). + 01 WS-AMOUNT-MAST PIC 9(09). + 01 WS-AMOUNT-DTL PIC 9(09). + 01 WS-AMOUNT-OUT PIC 9(09). + 01 WS-CONTROL-OK PIC X(01) VALUE 'Y'. + 01 WS-HASH-OK PIC X(01) VALUE 'Y'. + + 01 WS-TELECOM-REC. + COPY "telecom/TEL-INVOICE.cpy". + + 01 WS-TELECOM-BILLING. + COPY "telecom/TEL-BILLING.cpy". + + PROCEDURE DIVISION. + + *> ============================================================ + *> 1000-INIT — Initialization + *> ============================================================ + 1000-INIT SECTION. + 1000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 1000-INIT start'. + + MOVE 0 TO WS-MASTER-COUNT + MOVE 0 TO WS-DETAIL-COUNT + MOVE 0 TO WS-MATCHED-MASTER + MOVE 0 TO WS-UNMATCH-MASTER + MOVE 0 TO WS-MATCHED-DETAIL + MOVE 0 TO WS-UNMATCH-DETAIL + MOVE 0 TO WS-OUT-COUNT + MOVE 0 TO WS-HASH-MASTER-IN + MOVE 0 TO WS-HASH-DETAIL-IN + MOVE 0 TO WS-HASH-OUT + MOVE 0 TO WS-ERROR-COUNT + MOVE 0 TO WS-PC-INDEX + MOVE 'Y' TO WS-CONTROL-OK + MOVE 'Y' TO WS-HASH-OK + + ACCEPT WS-CURRENT-TIME FROM TIME. + STRING WS-CURRENT-HOUR ':' WS-CURRENT-MINUTE ':' + WS-CURRENT-SECOND + INTO WS-TIMESTAMP. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 1000-INIT complete ' + WS-TIMESTAMP. + + 1000-EXIT. + EXIT. + + *> ============================================================ + *> 2000-OPEN — Open all files + *> ============================================================ + 2000-OPEN SECTION. + 2000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 2000-OPEN start'. + + OPEN INPUT FILE-MASTER. + IF FS-MASTER NOT = '00' + MOVE 'ERROR: Cannot open FILE-MASTER, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-MASTER INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + + OPEN INPUT FILE-DETAIL. + IF FS-DETAIL NOT = '00' + MOVE 'ERROR: Cannot open FILE-DETAIL, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-DETAIL INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + + OPEN OUTPUT FILE-OUT. + IF FS-OUT NOT = '00' + MOVE 'ERROR: Cannot open FILE-OUT, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-OUT INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + + OPEN OUTPUT AUDIT-FILE. + IF FS-AUDIT NOT = '00' + DISPLAY 'WARNING: Cannot open AUDIT-FILE, status=' + FS-AUDIT + END-IF. + + OPEN OUTPUT ERROR-FILE. + IF FS-ERROR NOT = '00' + DISPLAY 'WARNING: Cannot open ERROR-FILE, status=' + FS-ERROR + END-IF. + + WRITE AUDIT-LINE FROM WS-AUDIT-HEADER. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 2000-OPEN complete'. + + 2000-EXIT. + EXIT. + + *> ============================================================ + *> 3000-PROCESS — Main processing (merge loop) + *> ============================================================ + 3000-PROCESS SECTION. + 3000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 3000-PROCESS start'. + + PERFORM 3100-READ-MASTER THRU 3100-READ-MASTER-EXIT. + PERFORM 3200-READ-DETAIL THRU 3200-READ-DETAIL-EXIT. + + PERFORM UNTIL EOF-MASTER AND EOF-DETAIL + EVALUATE TRUE + WHEN EOF-MASTER + PERFORM 3610-SKIP-DETAIL-GROUP + THRU 3610-SKIP-DETAIL-GROUP-EXIT + WHEN EOF-DETAIL + PERFORM 3620-SKIP-MASTER-GROUP + THRU 3620-SKIP-MASTER-GROUP-EXIT + WHEN WS-MASTER-KEY = WS-DETAIL-KEY + PERFORM 3300-PROCESS-MATCH + THRU 3300-PROCESS-MATCH-EXIT + WHEN WS-MASTER-KEY < WS-DETAIL-KEY + PERFORM 3620-SKIP-MASTER-GROUP + THRU 3620-SKIP-MASTER-GROUP-EXIT + WHEN WS-MASTER-KEY > WS-DETAIL-KEY + PERFORM 3610-SKIP-DETAIL-GROUP + THRU 3610-SKIP-DETAIL-GROUP-EXIT + END-EVALUATE + END-PERFORM. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME + ' 3000-PROCESS complete — out=' + WS-OUT-COUNT. + + 3000-EXIT. + EXIT. + + *> ============================================================ + *> 3100-READ-MASTER + *> ============================================================ + 3100-READ-MASTER SECTION. + 3100-START. + + READ FILE-MASTER + AT END SET EOF-MASTER TO TRUE + NOT AT END + MOVE STD-KEY IN MASTER-REC TO WS-MASTER-KEY + END-READ. + + IF FS-MASTER NOT = '00' AND NOT = '10' + MOVE 'ERROR reading FILE-MASTER, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-MASTER INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + END-IF. + + IF NOT EOF-MASTER + ADD 1 TO WS-MASTER-COUNT + MOVE STD-DATA-2 OF MASTER-REC TO WS-AMOUNT-MAST + ADD WS-AMOUNT-MAST TO WS-HASH-MASTER-IN + END-IF. + + 3100-READ-MASTER-EXIT. + EXIT. + + *> ============================================================ + *> 3200-READ-DETAIL + *> ============================================================ + 3200-READ-DETAIL SECTION. + 3200-START. + + READ FILE-DETAIL + AT END SET EOF-DETAIL TO TRUE + NOT AT END + MOVE STD-KEY IN DETAIL-REC TO WS-DETAIL-KEY + END-READ. + + IF FS-DETAIL NOT = '00' AND NOT = '10' + MOVE 'ERROR reading FILE-DETAIL, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-DETAIL INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + END-IF. + + IF NOT EOF-DETAIL + ADD 1 TO WS-DETAIL-COUNT + MOVE STD-DATA-2 OF DETAIL-REC TO WS-AMOUNT-DTL + ADD WS-AMOUNT-DTL TO WS-HASH-DETAIL-IN + END-IF. + + 3200-READ-DETAIL-EXIT. + EXIT. + + *> ============================================================ + *> 3300-PROCESS-MATCH — Keys match: output all details, skip masters + *> ============================================================ + 3300-PROCESS-MATCH SECTION. + 3300-START. + + DISPLAY '[TRACE] MATCH key=' WS-MASTER-KEY. + MOVE WS-MASTER-KEY TO WS-KEY-HOLD. + ADD 1 TO WS-MATCHED-MASTER. + + *> --- Validate plan capacity and status --- + PERFORM 3400-VALIDATE-PLAN-CAPACITY + THRU 3400-VALIDATE-PLAN-CAPACITY-EXIT + PERFORM 3500-VALIDATE-PLAN-STATUS + THRU 3500-VALIDATE-PLAN-STATUS-EXIT + + *> --- Output every detail in this group --- + PERFORM UNTIL EOF-DETAIL + OR WS-DETAIL-KEY NOT = WS-KEY-HOLD + IF WS-CAPACITY-OK + AND WS-PLAN-STATUS-ACTIVE + MOVE DETAIL-REC TO OUT-REC + WRITE OUT-REC + IF FS-OUT NOT = '00' + MOVE 'ERROR writing FILE-OUT, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-OUT + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + END-IF + ADD 1 TO WS-OUT-COUNT + ADD 1 TO WS-MATCHED-DETAIL + MOVE STD-DATA-2 OF DETAIL-REC TO WS-AMOUNT-OUT + ADD WS-AMOUNT-OUT TO WS-HASH-OUT + DISPLAY '[TRACE] OUTPUT detail key=' + WS-DETAIL-KEY + ELSE + DISPLAY '[TRACE] SKIP detail key=' + WS-DETAIL-KEY + ' — capacity or status invalid' + ADD 1 TO WS-UNMATCH-DETAIL + END-IF + PERFORM 3200-READ-DETAIL + THRU 3200-READ-DETAIL-EXIT + END-PERFORM. + + *> --- Skip all masters in this group --- + PERFORM UNTIL EOF-MASTER + OR WS-MASTER-KEY NOT = WS-KEY-HOLD + PERFORM 3100-READ-MASTER + THRU 3100-READ-MASTER-EXIT + END-PERFORM. + + 3300-PROCESS-MATCH-EXIT. + EXIT. + + *> ============================================================ + *> 3400-VALIDATE-PLAN-CAPACITY — Check subscriber capacity + *> ============================================================ + 3400-VALIDATE-PLAN-CAPACITY SECTION. + 3400-START. + + *> Extract plan code from detail record data fields + MOVE STD-DATA-1 OF DETAIL-REC(1:3) TO WS-PLAN-CODE. + + *> Look up plan in capacity table + MOVE 'N' TO WS-PC-FOUND. + IF WS-PC-INDEX > 0 + PERFORM VARYING WS-I FROM 1 BY 1 + UNTIL WS-I > WS-PC-INDEX + IF WS-PC-PLAN-CODE(WS-I) = WS-PLAN-CODE + MOVE 'Y' TO WS-PC-FOUND + ADD 1 TO WS-PC-CURR-SUBS(WS-I) + IF WS-PC-CURR-SUBS(WS-I) + > WS-PC-MAX-SUBS(WS-I) + MOVE 'N' TO WS-PLAN-CAPACITY-OK + DISPLAY '[TRACE] CAPACITY FULL: plan=' + WS-PLAN-CODE + ' subs=' + WS-PC-CURR-SUBS(WS-I) + ' max=' + WS-PC-MAX-SUBS(WS-I) + ELSE + MOVE 'Y' TO WS-PLAN-CAPACITY-OK + DISPLAY '[TRACE] CAPACITY OK: plan=' + WS-PLAN-CODE + ' subs=' + WS-PC-CURR-SUBS(WS-I) + ' max=' + WS-PC-MAX-SUBS(WS-I) + END-IF + EXIT PERFORM + END-IF + END-PERFORM + END-IF. + + *> If not found, add new entry with default max 100 + IF WS-PC-FOUND = 'N' + ADD 1 TO WS-PC-INDEX + MOVE WS-PLAN-CODE TO WS-PC-PLAN-CODE(WS-PC-INDEX) + MOVE 100 TO WS-PC-MAX-SUBS(WS-PC-INDEX) + MOVE 1 TO WS-PC-CURR-SUBS(WS-PC-INDEX) + MOVE 'A' TO WS-PC-STATUS(WS-PC-INDEX) + MOVE 'Y' TO WS-PLAN-CAPACITY-OK + DISPLAY '[TRACE] NEW PLAN: ' WS-PLAN-CODE + ' max=100 curr=1' + END-IF. + + 3400-VALIDATE-PLAN-CAPACITY-EXIT. + EXIT. + + *> ============================================================ + *> 3500-VALIDATE-PLAN-STATUS — Check plan status and category + *> ============================================================ + 3500-VALIDATE-PLAN-STATUS SECTION. + 3500-START. + + *> Extract plan fields from detail STD-DATA-1 + MOVE STD-DATA-1 OF DETAIL-REC(1:3) TO WS-PLAN-CODE. + MOVE STD-DATA-1 OF DETAIL-REC(4:1) TO WS-PLAN-STATUS. + MOVE STD-DATA-1 OF DETAIL-REC(5:2) TO WS-PLAN-CATEGORY. + + DISPLAY '[TRACE] Plan=' WS-PLAN-CODE + ' Status=' WS-PLAN-STATUS + ' Category=' WS-PLAN-CATEGORY. + + *> Check plan status + EVALUATE TRUE + WHEN WS-PLAN-STATUS-ACTIVE + DISPLAY '[TRACE] Plan ACTIVE — OK' + WHEN WS-PLAN-STATUS-GRANDFATHERED + DISPLAY '[TRACE] Plan GRANDFATHERED — OK' + WHEN WS-PLAN-STATUS-DISCONTINUED + DISPLAY '[TRACE] Plan DISCONTINUED — rejected' + ADD 1 TO WS-ERROR-COUNT + WHEN OTHER + DISPLAY '[TRACE] Plan unknown status — rejected' + ADD 1 TO WS-ERROR-COUNT + END-EVALUATE. + + *> Update utilization tracking for report + PERFORM 3510-UPDATE-UTIL THRU 3510-UPDATE-UTIL-EXIT. + + 3500-VALIDATE-PLAN-STATUS-EXIT. + EXIT. + + *> ============================================================ + *> 3510-UPDATE-UTIL — Track plan utilization statistics + *> ============================================================ + 3510-UPDATE-UTIL SECTION. + 3510-START. + + MOVE 'N' TO WS-PC-FOUND. + IF WS-PC-INDEX > 0 + PERFORM VARYING WS-I FROM 1 BY 1 + UNTIL WS-I > WS-PC-INDEX + IF WS-UTIL-PLAN(WS-I) = WS-PLAN-CODE + ADD 1 TO WS-UTIL-COUNT(WS-I) + MOVE 'Y' TO WS-PC-FOUND + EXIT PERFORM + END-IF + END-PERFORM + END-IF. + + IF WS-PC-FOUND = 'N' + ADD 1 TO WS-PC-INDEX + MOVE WS-PLAN-CODE TO WS-UTIL-PLAN(WS-PC-INDEX) + MOVE 1 TO WS-UTIL-COUNT(WS-PC-INDEX) + MOVE 100 TO WS-UTIL-MAX(WS-PC-INDEX) + END-IF. + + 3510-UPDATE-UTIL-EXIT. + EXIT. + + *> ============================================================ + *> 3610-SKIP-DETAIL-GROUP — Skip unmatched detail group + *> ============================================================ + 3610-SKIP-DETAIL-GROUP SECTION. + 3610-START. + + DISPLAY '[TRACE] SKIP-DETAIL-GROUP key=' WS-DETAIL-KEY. + MOVE WS-DETAIL-KEY TO WS-KEY-HOLD. + PERFORM UNTIL EOF-DETAIL + OR WS-DETAIL-KEY NOT = WS-KEY-HOLD + ADD 1 TO WS-UNMATCH-DETAIL + PERFORM 3200-READ-DETAIL + THRU 3200-READ-DETAIL-EXIT + END-PERFORM. + + 3610-SKIP-DETAIL-GROUP-EXIT. + EXIT. + + *> ============================================================ + *> 3620-SKIP-MASTER-GROUP — Skip unmatched master group + *> ============================================================ + 3620-SKIP-MASTER-GROUP SECTION. + 3620-START. + + DISPLAY '[TRACE] SKIP-MASTER-GROUP key=' WS-MASTER-KEY. + MOVE WS-MASTER-KEY TO WS-KEY-HOLD. + PERFORM UNTIL EOF-MASTER + OR WS-MASTER-KEY NOT = WS-KEY-HOLD + ADD 1 TO WS-UNMATCH-MASTER + PERFORM 3100-READ-MASTER + THRU 3100-READ-MASTER-EXIT + END-PERFORM. + + 3620-SKIP-MASTER-GROUP-EXIT. + EXIT. + + *> ============================================================ + *> 4000-VALIDATE — Validate control totals and hash + *> ============================================================ + 4000-VALIDATE SECTION. + 4000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 4000-VALIDATE start'. + + *> Control total: matched-master + unmatched-master = total master + IF WS-MATCHED-MASTER + WS-UNMATCH-MASTER + NOT = WS-MASTER-COUNT + MOVE 'N' TO WS-CONTROL-OK + MOVE 'Control FAIL: master totals mismatch' + TO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + DISPLAY 'CONTROL FAIL: matched-m=' + WS-MATCHED-MASTER + ' unmatch-m=' WS-UNMATCH-MASTER + ' total-m=' WS-MASTER-COUNT + ELSE + DISPLAY 'CONTROL OK: master total matches' + END-IF. + + *> Control total: matched-detail + unmatched-detail = total detail + IF WS-MATCHED-DETAIL + WS-UNMATCH-DETAIL + NOT = WS-DETAIL-COUNT + MOVE 'N' TO WS-CONTROL-OK + MOVE 'Control FAIL: detail totals mismatch' + TO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + DISPLAY 'CONTROL FAIL: matched-d=' + WS-MATCHED-DETAIL + ' unmatch-d=' WS-UNMATCH-DETAIL + ' total-d=' WS-DETAIL-COUNT + ELSE + DISPLAY 'CONTROL OK: detail total matches' + END-IF. + + *> Hash verification: input hash = output hash (plus unmatched detail hash) + IF WS-HASH-MASTER-IN NOT = WS-HASH-DETAIL-IN + MOVE 'N' TO WS-HASH-OK + MOVE 'Hash FAIL: master and detail hash mismatch' + TO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + DISPLAY 'HASH FAIL: master=' WS-HASH-MASTER-IN + ' detail=' WS-HASH-DETAIL-IN + ELSE + DISPLAY 'HASH OK: master/detail hash match' + END-IF. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME + ' 4000-VALIDATE complete'. + + 4000-EXIT. + EXIT. + + *> ============================================================ + *> 5000-REPORT — Generate audit and utilization report + *> ============================================================ + 5000-REPORT SECTION. + 5000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 5000-REPORT start'. + + MOVE WS-MASTER-COUNT TO AL-MASTER-IN. + MOVE WS-DETAIL-COUNT TO AL-DETAIL-IN. + MOVE WS-OUT-COUNT TO AL-OUT-TOTAL. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE1. + + MOVE WS-MATCHED-MASTER TO AL-MATCH-M. + MOVE WS-UNMATCH-MASTER TO AL-UNMATCH-M. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE2. + + MOVE WS-MATCHED-DETAIL TO AL-MATCH-D. + MOVE WS-UNMATCH-DETAIL TO AL-UNMATCH-D. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE3. + + MOVE WS-HASH-MASTER-IN TO AL-IN-HASH. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE4. + + MOVE WS-HASH-OUT TO AL-OUT-HASH. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE5. + + IF WS-HASH-OK = 'Y' + MOVE 'PASS' TO AL-HASH-RES + ELSE + MOVE 'FAIL' TO AL-HASH-RES + END-IF. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE6. + + IF WS-CONTROL-OK = 'Y' + MOVE 'PASS' TO AL-CTRL-RES + ELSE + MOVE 'FAIL' TO AL-CTRL-RES + END-IF. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE7. + + *> Write plan utilization summary + WRITE AUDIT-LINE FROM WS-AUDIT-LINE8. + IF WS-PC-INDEX > 0 + PERFORM VARYING WS-I FROM 1 BY 1 + UNTIL WS-I > WS-PC-INDEX + MOVE WS-UTIL-PLAN(WS-I) TO AU-PLAN + MOVE WS-UTIL-COUNT(WS-I) TO AU-SUBS + MOVE WS-UTIL-MAX(WS-I) TO AU-CAP + IF WS-UTIL-MAX(WS-I) > 0 + COMPUTE WS-UR-UTIL-PCT = + (WS-UTIL-COUNT(WS-I) * 100) + / WS-UTIL-MAX(WS-I) + ELSE + MOVE 0 TO WS-UR-UTIL-PCT + END-IF + MOVE WS-UR-UTIL-PCT TO AU-PCT + WRITE AUDIT-LINE FROM WS-AUDIT-UTIL + END-PERFORM + END-IF. + + *> Console summary + DISPLAY '19-matching-MN-to-N: Master=' WS-MASTER-COUNT + ' Detail=' WS-DETAIL-COUNT + ' Output=' WS-OUT-COUNT. + + WRITE AUDIT-LINE FROM WS-AUDIT-FOOTER. + + 5000-EXIT. + EXIT. + + *> ============================================================ + *> 6000-ERROR — Error handler + *> ============================================================ + 6000-ERROR SECTION. + 6000-START. + + ADD 1 TO WS-ERROR-COUNT. + MOVE WS-ERROR-COUNT TO ED-NUM. + MOVE WS-ERROR-MESSAGE TO ED-MESSAGE. + DISPLAY WS-ERROR-DETAIL. + + WRITE ERROR-LINE FROM WS-ERROR-DETAIL. + + 6000-ERROR-EXIT. + EXIT. + + *> ============================================================ + *> 7000-AUDIT — Trace entry + *> ============================================================ + 7000-AUDIT SECTION. + 7000-START. + + ACCEPT WS-CURRENT-TIME FROM TIME. + STRING WS-CURRENT-HOUR ':' WS-CURRENT-MINUTE ':' + WS-CURRENT-SECOND + INTO AT-TIMESTAMP. + MOVE '7000-AUDIT entry' TO AT-MESSAGE. + WRITE AUDIT-LINE FROM WS-AUDIT-TRACE. + + 7000-EXIT. + EXIT. + + *> ============================================================ + *> 9000-EXIT — Cleanup and close + *> ============================================================ + 9000-EXIT SECTION. + 9000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 9000-EXIT start'. + + CLOSE FILE-MASTER FILE-DETAIL FILE-OUT. + IF FS-MASTER NOT = '00' + DISPLAY 'WARNING: FILE-MASTER close status=' FS-MASTER + END-IF. + IF FS-DETAIL NOT = '00' + DISPLAY 'WARNING: FILE-DETAIL close status=' FS-DETAIL + END-IF. + IF FS-OUT NOT = '00' + DISPLAY 'WARNING: FILE-OUT close status=' FS-OUT + END-IF. + + CLOSE AUDIT-FILE. + IF FS-AUDIT NOT = '00' + DISPLAY 'WARNING: AUDIT-FILE close status=' FS-AUDIT + END-IF. + + CLOSE ERROR-FILE. + IF FS-ERROR NOT = '00' + DISPLAY 'WARNING: ERROR-FILE close status=' FS-ERROR + END-IF. + + DISPLAY "19-matching-MN-to-N: PASS". + IF WS-ERROR-COUNT > 0 + DISPLAY '19-matching-MN-to-N: Errors=' WS-ERROR-COUNT + ' — see error-report-19.txt' + END-IF. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' END'. + STOP RUN. + + 9000-EXIT-EXIT. + EXIT. + + END PROGRAM main-19-matching-MN-to-N. diff --git a/benchmark-programs/19-matching-MN-to-N/master.dat b/benchmark-programs/19-matching-MN-to-N/master.dat new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/19-matching-MN-to-N/master.dat @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/19-matching-MN-to-N/output.dat b/benchmark-programs/19-matching-MN-to-N/output.dat new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/20-matching-MN-to-MxN/README.md b/benchmark-programs/20-matching-MN-to-MxN/README.md new file mode 100644 index 0000000..d70a281 --- /dev/null +++ b/benchmark-programs/20-matching-MN-to-MxN/README.md @@ -0,0 +1,37 @@ +# 20-matching-MN-to-MxN + +## 电信业务场景 + +CDR详细清单M:N→M×N。多个合同×多个通话明细的笛卡尔积组合，输出完整的CDR详细清单(M×N件)。 + +**M:N matching — Cartesian product output (M x N records per matching key).** + +Tests the scenario where both input files may contain duplicate keys and +every combination of matching master and detail records must be output +(the full Cartesian product). + +## Test data + +| File | Records | Keys | +|-------------|---------|------------------------------------------| +| master.dat | 5 | KEY00001 (x2), KEY00002 (x1), KEY00003 (x2) | +| detail.dat | 7 | KEY00001 (x3), KEY00003 (x2), KEY00004 (x2) | + +- **KEY00001:** 2 masters x 3 details = 6 output records +- **KEY00003:** 2 masters x 2 details = 4 output records +- **Total output:** 10 records +- **Unmatched:** KEY00002 (master only), KEY00004 (detail only) + +## Algorithm + +1. Read both files synchronously (both assumed sorted by key). +2. When keys match: read all master records for that key into a table, + read all detail records for that key into a table, then write M x N + output records covering every combination. +3. Unmatched groups are skipped via the standard key-comparison logic. + +## Expected output + +- **output.dat:** 10 records x 45 bytes = 450 bytes +- Program displays: `20-matching-MN-to-MxN: PASS` +- Script displays: `20-matching-MN-to-MxN: ALL TESTS PASSED` diff --git a/benchmark-programs/20-matching-MN-to-MxN/audit-report-20.txt b/benchmark-programs/20-matching-MN-to-MxN/audit-report-20.txt new file mode 100644 index 0000000..a46fd29 --- /dev/null +++ b/benchmark-programs/20-matching-MN-to-MxN/audit-report-20.txt @@ -0,0 +1,12 @@ +=== 20-matching-MN-to-MxN AUDIT REPORT === +Master Groups: 3 Detail Groups: 3 Output: 2 +Total Masters: 2 Total Details: 2 +Hash Master In: 1002 +Hash Detail In: 1002 +Hash Output: 1002 +Hash Check: PASS +Control Check: FAIL +Excess Voice: 0 Excess Data: 0 Excess Msg: 0 +Excess Amount: 0.00 +--- END OF 20-matching-MN-to-MxN AUDIT REPORT --- +[TRACE] 16:35:21 7000-AUDIT entry diff --git a/benchmark-programs/20-matching-MN-to-MxN/detail.dat b/benchmark-programs/20-matching-MN-to-MxN/detail.dat new file mode 100644 index 0000000..6782154 --- /dev/null +++ b/benchmark-programs/20-matching-MN-to-MxN/detail.dat @@ -0,0 +1 @@ +E000000001F00000000000000000010000000501000000601E000000002F00000000000000000020000000502000000602E000000003F00000000000000000030000000503000000603E000000004F00000000000000000040000000504000000604E000000005F00000000000000000050000000505000000605E000000006F00000000000000000060000000506000000606E000000007F00000000000000000070000000507000000607E000000008F00000000000000000080000000508000000608E000000009F00000000000000000090000000509000000609E000000010F00000000000000000100000000510000000610E000000011F00000000000000000110000000511000000611E000000012F00000000000000000120000000512000000612E000000013F00000000000000000130000000513000000613E000000014F00000000000000000140000000514000000614E000000015F00000000000000000150000000515000000615E000000016F00000000000000000160000000516000000616E000000017F00000000000000000170000000517000000617E000000018F00000000000000000180000000518000000618E000000019F00000000000000000190000000519000000619E000000020F00000000000000000200000000520000000620E000000021F00000000000000000210000000521000000621E000000022F00000000000000000220000000522000000622E000000023F00000000000000000230000000523000000623E000000024F00000000000000000240000000524000000624E000000025F00000000000000000250000000525000000625E000000026F00000000000000000260000000526000000626E000000027F00000000000000000270000000527000000627E000000028F00000000000000000280000000528000000628E000000029F00000000000000000290000000529000000629E000000030F00000000000000000300000000530000000630E000000031F00000000000000000310000000531000000631E000000032F00000000000000000320000000532000000632E000000033F00000000000000000330000000533000000633E000000034F00000000000000000340000000534000000634E000000035F00000000000000000350000000535000000635E000000036F00000000000000000360000000536000000636E000000037F00000000000000000370000000537000000637E000000038F00000000000000000380000000538000000638E000000039F00000000000000000390000000539000000639E000000040F00000000000000000400000000540000000640E000000041F00000000000000000410000000541000000641E000000042F00000000000000000420000000542000000642E000000043F00000000000000000430000000543000000643E000000044F00000000000000000440000000544000000644E000000045F00000000000000000450000000545000000645E000000046F00000000000000000460000000546000000646E000000047F00000000000000000470000000547000000647E000000048F00000000000000000480000000548000000648E000000049F00000000000000000490000000549000000649E000000050F00000000000000000500000000550000000650E000000051F00000000000000000510000000551000000651E000000052F00000000000000000520000000552000000652E000000053F00000000000000000530000000553000000653E000000054F00000000000000000540000000554000000654E000000055F00000000000000000550000000555000000655E000000056F00000000000000000560000000556000000656E000000057F00000000000000000570000000557000000657E000000058F00000000000000000580000000558000000658E000000059F00000000000000000590000000559000000659E000000060F00000000000000000600000000560000000660E000000061F00000000000000000610000000561000000661E000000062F00000000000000000620000000562000000662E000000063F00000000000000000630000000563000000663E000000064F00000000000000000640000000564000000664E000000065F00000000000000000650000000565000000665E000000066F00000000000000000660000000566000000666E000000067F00000000000000000670000000567000000667E000000068F00000000000000000680000000568000000668E000000069F00000000000000000690000000569000000669E000000070F00000000000000000700000000570000000670E000000071F00000000000000000710000000571000000671E000000072F00000000000000000720000000572000000672E000000073F00000000000000000730000000573000000673E000000074F00000000000000000740000000574000000674 \ No newline at end of file diff --git a/benchmark-programs/20-matching-MN-to-MxN/error-report-20.txt b/benchmark-programs/20-matching-MN-to-MxN/error-report-20.txt new file mode 100644 index 0000000..66378da --- /dev/null +++ b/benchmark-programs/20-matching-MN-to-MxN/error-report-20.txt @@ -0,0 +1,4 @@ +ERROR # 3: ERROR reading FILE-MASTER, status= +ERROR # 4: ERROR reading FILE-DETAIL, status= +ERROR # 6: Control FAIL: output count mismatch +ERROR # 7: Control FAIL: output count mismatch diff --git a/benchmark-programs/20-matching-MN-to-MxN/main-20-matching-MN-to-MxN.cbl b/benchmark-programs/20-matching-MN-to-MxN/main-20-matching-MN-to-MxN.cbl new file mode 100644 index 0000000..963a663 --- /dev/null +++ b/benchmark-programs/20-matching-MN-to-MxN/main-20-matching-MN-to-MxN.cbl @@ -0,0 +1,892 @@ + *> ============================================================ + *> 20-matching-MN-to-MxN : CDR详细清单 (CDR Detail M:N→M×N) + *> Input : FILE-MASTER (master.dat: 合同), FILE-DETAIL (detail.dat: CDR) + *> Output: FILE-OUT (output.dat: M×N笛卡尔积明细) + *> Coverage: AM-N005, AM-R001 + *> + *> EXPANDED: Added SECTION structure, CDR-to-plan mapping validation, + *> call type against plan allowance, excess usage tracking, detailed + *> charge line generation, audit file, error file, control totals, + *> hash totals, tracing, FILE STATUS checks. + *> ============================================================ + >>SOURCE FORMAT IS FREE + IDENTIFICATION DIVISION. + PROGRAM-ID. main-20-matching-MN-to-MxN. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-MASTER ASSIGN TO "master.dat" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS FS-MASTER. + SELECT FILE-DETAIL ASSIGN TO "detail.dat" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS FS-DETAIL. + SELECT FILE-OUT ASSIGN TO "output.dat" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS FS-OUT. + SELECT AUDIT-FILE ASSIGN TO "audit-report-20.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-AUDIT. + SELECT ERROR-FILE ASSIGN TO "error-report-20.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-ERROR. + + DATA DIVISION. + FILE SECTION. + FD FILE-MASTER. + 01 MASTER-REC. + COPY "STD-REC.cpy". + FD FILE-DETAIL. + 01 DETAIL-REC. + COPY "STD-REC.cpy". + FD FILE-OUT. + 01 OUT-REC. + COPY "STD-REC.cpy". + FD AUDIT-FILE. + 01 AUDIT-LINE PIC X(120). + FD ERROR-FILE. + 01 ERROR-LINE PIC X(120). + + WORKING-STORAGE SECTION. + + *> ============================================================ + *> FILE STATUS + *> ============================================================ + 01 FS-MASTER PIC X(02). + 01 FS-DETAIL PIC X(02). + 01 FS-OUT PIC X(02). + 01 FS-AUDIT PIC X(02). + 01 FS-ERROR PIC X(02). + + *> ============================================================ + *> EOF FLAGS + *> ============================================================ + 01 WS-EOF-MASTER PIC X VALUE 'N'. + 88 EOF-MASTER VALUE 'Y' FALSE 'N'. + 01 WS-EOF-DETAIL PIC X VALUE 'N'. + 88 EOF-DETAIL VALUE 'Y' FALSE 'N'. + + *> ============================================================ + *> KEY FIELDS + *> ============================================================ + 01 WS-MASTER-KEY PIC X(10). + 01 WS-DETAIL-KEY PIC X(10). + 01 WS-KEY-HOLD PIC X(10). + + *> ============================================================ + *> TABLE COUNTS + *> ============================================================ + 01 WS-MASTER-COUNT PIC 9(02) VALUE 0. + 01 WS-DETAIL-COUNT PIC 9(02) VALUE 0. + 01 WS-I PIC 9(02). + 01 WS-J PIC 9(02). + + *> ============================================================ + *> CONTROL TOTALS + *> ============================================================ + 01 WS-CONTROL-TOTALS. + 05 WS-TOTAL-MASTERS PIC 9(09) VALUE 0. + 05 WS-TOTAL-DETAILS PIC 9(09) VALUE 0. + 05 WS-OUT-COUNT PIC 9(09) VALUE 0. + 05 WS-MASTER-GROUPS PIC 9(09) VALUE 0. + 05 WS-DETAIL-GROUPS PIC 9(09) VALUE 0. + 05 WS-UNMATCH-MASTER PIC 9(09) VALUE 0. + 05 WS-UNMATCH-DETAIL PIC 9(09) VALUE 0. + + *> ============================================================ + *> HASH TOTALS + *> ============================================================ + 01 WS-HASH-TOTALS. + 05 WS-HASH-MASTER-IN PIC 9(15) VALUE 0. + 05 WS-HASH-DETAIL-IN PIC 9(15) VALUE 0. + 05 WS-HASH-OUT PIC 9(15) VALUE 0. + + *> ============================================================ + *> MASTER TABLE + *> ============================================================ + 01 WS-MASTER-TABLE. + 05 WS-MASTER-ENTRY OCCURS 10 TIMES. + 10 WS-MST-KEY PIC X(10). + 10 WS-MST-DATA1 PIC X(20). + 10 WS-MST-DATA2 PIC 9(10). + 10 WS-MST-DATA3 PIC S9(7)V99 COMP-3. + + *> ============================================================ + *> DETAIL TABLE + *> ============================================================ + 01 WS-DETAIL-TABLE. + 05 WS-DETAIL-ENTRY OCCURS 10 TIMES. + 10 WS-DTL-KEY PIC X(10). + 10 WS-DTL-DATA1 PIC X(20). + 10 WS-DTL-DATA2 PIC 9(10). + 10 WS-DTL-DATA3 PIC S9(7)V99 COMP-3. + + *> ============================================================ + *> CDR-TO-PLAN MAPPING VALIDATION + *> ============================================================ + 01 WS-CDR-MAPPING. + 05 WS-CDR-CALL-TYPE PIC X(02). + 88 WS-CDR-VOICE-CALL VALUE 'VO'. + 88 WS-CDR-DATA-CALL VALUE 'DA'. + 88 WS-CDR-MESSAGE-CALL VALUE 'MS'. + 88 WS-CDR-VIDEO-CALL VALUE 'VI'. + 88 WS-CDR-ROAMING-CALL VALUE 'RO'. + 05 WS-CDR-DURATION PIC 9(05). + 05 WS-CDR-DATA-VOLUME PIC 9(09). + 05 WS-CDR-TIMESTAMP PIC X(14). + 05 WS-CDR-STATUS PIC X(01). + 88 WS-CDR-VALID VALUE 'V'. + 88 WS-CDR-INVALID VALUE 'I'. + 88 WS-CDR-PENDING VALUE 'P'. + + *> ============================================================ + *> PLAN ALLOWANCE FIELDS + *> ============================================================ + 01 WS-PLAN-ALLOWANCE. + 05 WS-PLAN-VOICE-MIN PIC 9(05) VALUE 0. + 05 WS-PLAN-DATA-MB PIC 9(09) VALUE 0. + 05 WS-PLAN-MSG-COUNT PIC 9(05) VALUE 0. + 05 WS-PLAN-PRICE-VOICE PIC 9(05)V99 VALUE 0. + 05 WS-PLAN-PRICE-DATA PIC 9(05)V99 VALUE 0. + 05 WS-PLAN-PRICE-MSG PIC 9(05)V99 VALUE 0. + 05 WS-PLAN-EXCESS-VOICE PIC 9(05)V99 VALUE 0. + 05 WS-PLAN-EXCESS-DATA PIC 9(09)V99 VALUE 0. + 05 WS-PLAN-EXCESS-MSG PIC 9(05)V99 VALUE 0. + + *> ============================================================ + *> EXCESS USAGE TRACKING + *> ============================================================ + 01 WS-EXCESS-USAGE. + 05 WS-EXCESS-VOICE-MIN PIC 9(05) VALUE 0. + 05 WS-EXCESS-DATA-MB PIC 9(09) VALUE 0. + 05 WS-EXCESS-MSG-COUNT PIC 9(05) VALUE 0. + 05 WS-EXCESS-AMOUNT PIC 9(09)V99 VALUE 0. + + *> ============================================================ + *> CHARGE LINE GENERATION + *> ============================================================ + 01 WS-CHARGE-LINE. + 05 WS-CL-CONTRACT PIC X(10). + 05 WS-CL-CALL-TYPE PIC X(02). + 05 WS-CL-USAGE PIC 9(09). + 05 WS-CL-UNIT-PRICE PIC 9(05)V99. + 05 WS-CL-LINE-TOTAL PIC 9(09)V99. + 05 WS-CL-EXCESS-FLAG PIC X(01). + 88 WS-CL-WITHIN-ALLOWANCE VALUE 'N'. + 88 WS-CL-EXCESS VALUE 'Y' FALSE 'N'. + + *> ============================================================ + *> AUDIT / LOGGING FIELDS + *> ============================================================ + 01 WS-CURRENT-TIME. + 05 WS-CURRENT-HOUR PIC 9(02). + 05 WS-CURRENT-MINUTE PIC 9(02). + 05 WS-CURRENT-SECOND PIC 9(02). + 05 WS-CURRENT-HUND PIC 9(02). + 01 WS-TIMESTAMP PIC X(20). + 01 WS-PROGRAM-NAME PIC X(21) VALUE '20-matching-MN-to-MxN'. + + *> ============================================================ + *> ERROR FIELDS + *> ============================================================ + 01 WS-ERROR-COUNT PIC 9(05) VALUE 0. + 01 WS-ERROR-MESSAGE PIC X(80). + 01 WS-ERROR-DETAIL. + 05 FILLER PIC X(10) VALUE 'ERROR #'. + 05 ED-NUM PIC Z(9). + 05 FILLER PIC X(02) VALUE ': '. + 05 ED-MESSAGE PIC X(80). + + *> ============================================================ + *> AUDIT REPORT LINES + *> ============================================================ + 01 WS-AUDIT-HEADER. + 05 FILLER PIC X(42) VALUE + '=== 20-matching-MN-to-MxN AUDIT REPORT ==='. + 01 WS-AUDIT-FOOTER. + 05 FILLER PIC X(50) VALUE + '--- END OF 20-matching-MN-to-MxN AUDIT REPORT ---'. + 01 WS-AUDIT-LINE1. + 05 FILLER PIC X(20) VALUE 'Master Groups: '. + 05 AL-MAST-GP PIC Z(9)9. + 05 FILLER PIC X(16) VALUE ' Detail Groups: '. + 05 AL-DTL-GP PIC Z(9)9. + 05 FILLER PIC X(16) VALUE ' Output: '. + 05 AL-OUT PIC Z(9)9. + 01 WS-AUDIT-LINE2. + 05 FILLER PIC X(20) VALUE 'Total Masters: '. + 05 AL-TOT-MAST PIC Z(9)9. + 05 FILLER PIC X(16) VALUE ' Total Details: '. + 05 AL-TOT-DTL PIC Z(9)9. + 01 WS-AUDIT-LINE3. + 05 FILLER PIC X(20) VALUE 'Hash Master In: '. + 05 AL-HASH-M PIC Z(14)9. + 01 WS-AUDIT-LINE4. + 05 FILLER PIC X(20) VALUE 'Hash Detail In: '. + 05 AL-HASH-D PIC Z(14)9. + 01 WS-AUDIT-LINE5. + 05 FILLER PIC X(20) VALUE 'Hash Output: '. + 05 AL-HASH-O PIC Z(14)9. + 01 WS-AUDIT-LINE6. + 05 FILLER PIC X(20) VALUE 'Hash Check: '. + 05 AL-HASH-RES PIC X(10). + 01 WS-AUDIT-LINE7. + 05 FILLER PIC X(20) VALUE 'Control Check: '. + 05 AL-CTRL-RES PIC X(10). + 01 WS-AUDIT-LINE8. + 05 FILLER PIC X(20) VALUE 'Excess Voice: '. + 05 AL-EX-VOICE PIC Z(9)9. + 05 FILLER PIC X(16) VALUE ' Excess Data: '. + 05 AL-EX-DATA PIC Z(9)9. + 05 FILLER PIC X(16) VALUE ' Excess Msg: '. + 05 AL-EX-MSG PIC Z(9)9. + 01 WS-AUDIT-LINE9. + 05 FILLER PIC X(20) VALUE 'Excess Amount: '. + 05 AL-EX-AMT PIC Z(11)9.99. + 01 WS-AUDIT-TRACE. + 05 FILLER PIC X(10) VALUE '[TRACE] '. + 05 AT-TIMESTAMP PIC X(08). + 05 FILLER PIC X(02) VALUE ' '. + 05 AT-MESSAGE PIC X(80). + + *> ============================================================ + *> WORKING VARIABLES + *> ============================================================ + 01 WS-AMOUNT-MAST PIC 9(09). + 01 WS-AMOUNT-DTL PIC 9(09). + 01 WS-AMOUNT-OUT PIC 9(09). + 01 WS-CONTROL-OK PIC X(01) VALUE 'Y'. + 01 WS-HASH-OK PIC X(01) VALUE 'Y'. + 01 WS-UNMATCH-MASTER-GRP PIC 9(09) VALUE 0. + 01 WS-UNMATCH-DETAIL-GRP PIC 9(09) VALUE 0. + + 01 WS-TELECOM-REC. + COPY "telecom/TEL-INVOICE.cpy". + + 01 WS-TELECOM-BILLING. + COPY "telecom/TEL-BILLING.cpy". + + PROCEDURE DIVISION. + + *> ============================================================ + *> 1000-INIT — Initialization + *> ============================================================ + 1000-INIT SECTION. + 1000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 1000-INIT start'. + + MOVE 0 TO WS-TOTAL-MASTERS + MOVE 0 TO WS-TOTAL-DETAILS + MOVE 0 TO WS-OUT-COUNT + MOVE 0 TO WS-MASTER-GROUPS + MOVE 0 TO WS-DETAIL-GROUPS + MOVE 0 TO WS-UNMATCH-MASTER + MOVE 0 TO WS-UNMATCH-DETAIL + MOVE 0 TO WS-HASH-MASTER-IN + MOVE 0 TO WS-HASH-DETAIL-IN + MOVE 0 TO WS-HASH-OUT + MOVE 0 TO WS-ERROR-COUNT + MOVE 0 TO WS-EXCESS-VOICE-MIN + MOVE 0 TO WS-EXCESS-DATA-MB + MOVE 0 TO WS-EXCESS-MSG-COUNT + MOVE 0 TO WS-EXCESS-AMOUNT + MOVE 'Y' TO WS-CONTROL-OK + MOVE 'Y' TO WS-HASH-OK + MOVE 0 TO WS-UNMATCH-MASTER-GRP + MOVE 0 TO WS-UNMATCH-DETAIL-GRP + + ACCEPT WS-CURRENT-TIME FROM TIME. + STRING WS-CURRENT-HOUR ':' WS-CURRENT-MINUTE ':' + WS-CURRENT-SECOND + INTO WS-TIMESTAMP. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 1000-INIT complete ' + WS-TIMESTAMP. + + 1000-EXIT. + EXIT. + + *> ============================================================ + *> 2000-OPEN — Open all files + *> ============================================================ + 2000-OPEN SECTION. + 2000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 2000-OPEN start'. + + OPEN INPUT FILE-MASTER. + IF FS-MASTER NOT = '00' + MOVE 'ERROR: Cannot open FILE-MASTER, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-MASTER INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-EXIT + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + + OPEN INPUT FILE-DETAIL. + IF FS-DETAIL NOT = '00' + MOVE 'ERROR: Cannot open FILE-DETAIL, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-DETAIL INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-EXIT + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + + OPEN OUTPUT FILE-OUT. + IF FS-OUT NOT = '00' + MOVE 'ERROR: Cannot open FILE-OUT, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-OUT INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-EXIT + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + + OPEN OUTPUT AUDIT-FILE. + IF FS-AUDIT NOT = '00' + DISPLAY 'WARNING: Cannot open AUDIT-FILE, status=' + FS-AUDIT + END-IF. + + OPEN OUTPUT ERROR-FILE. + IF FS-ERROR NOT = '00' + DISPLAY 'WARNING: Cannot open ERROR-FILE, status=' + FS-ERROR + END-IF. + + WRITE AUDIT-LINE FROM WS-AUDIT-HEADER. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 2000-OPEN complete'. + + 2000-EXIT. + EXIT. + + *> ============================================================ + *> 3000-PROCESS — Main processing + *> ============================================================ + 3000-PROCESS SECTION. + 3000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 3000-PROCESS start'. + + PERFORM 3100-READ-MASTER THRU 3100-READ-MASTER-EXIT. + PERFORM 3200-READ-DETAIL THRU 3200-READ-DETAIL-EXIT. + + PERFORM UNTIL EOF-MASTER AND EOF-DETAIL + EVALUATE TRUE + WHEN EOF-MASTER + PERFORM 3610-SKIP-DETAIL-GROUP + THRU 3610-SKIP-DETAIL-GROUP-EXIT + WHEN EOF-DETAIL + PERFORM 3620-SKIP-MASTER-GROUP + THRU 3620-SKIP-MASTER-GROUP-EXIT + WHEN WS-MASTER-KEY = WS-DETAIL-KEY + PERFORM 3300-PROCESS-MATCH + THRU 3300-PROCESS-MATCH-EXIT + WHEN WS-MASTER-KEY < WS-DETAIL-KEY + PERFORM 3620-SKIP-MASTER-GROUP + THRU 3620-SKIP-MASTER-GROUP-EXIT + WHEN WS-MASTER-KEY > WS-DETAIL-KEY + PERFORM 3610-SKIP-DETAIL-GROUP + THRU 3610-SKIP-DETAIL-GROUP-EXIT + END-EVALUATE + END-PERFORM. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME + ' 3000-PROCESS complete — output=' + WS-OUT-COUNT. + + 3000-EXIT. + EXIT. + + *> ============================================================ + *> 3100-READ-MASTER + *> ============================================================ + 3100-READ-MASTER SECTION. + 3100-START. + + READ FILE-MASTER + AT END SET EOF-MASTER TO TRUE + NOT AT END + MOVE STD-KEY IN MASTER-REC TO WS-MASTER-KEY + END-READ. + + IF FS-MASTER NOT = '00' AND NOT = '10' + MOVE 'ERROR reading FILE-MASTER, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-MASTER INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-EXIT + END-IF. + + IF NOT EOF-MASTER + ADD 1 TO WS-TOTAL-MASTERS + MOVE STD-DATA-2 OF MASTER-REC TO WS-AMOUNT-MAST + ADD WS-AMOUNT-MAST TO WS-HASH-MASTER-IN + END-IF. + + 3100-READ-MASTER-EXIT. + EXIT. + + *> ============================================================ + *> 3200-READ-DETAIL + *> ============================================================ + 3200-READ-DETAIL SECTION. + 3200-START. + + READ FILE-DETAIL + AT END SET EOF-DETAIL TO TRUE + NOT AT END + MOVE STD-KEY IN DETAIL-REC TO WS-DETAIL-KEY + END-READ. + + IF FS-DETAIL NOT = '00' AND NOT = '10' + MOVE 'ERROR reading FILE-DETAIL, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-DETAIL INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-EXIT + END-IF. + + IF NOT EOF-DETAIL + ADD 1 TO WS-TOTAL-DETAILS + MOVE STD-DATA-2 OF DETAIL-REC TO WS-AMOUNT-DTL + ADD WS-AMOUNT-DTL TO WS-HASH-DETAIL-IN + END-IF. + + 3200-READ-DETAIL-EXIT. + EXIT. + + *> ============================================================ + *> 3300-PROCESS-MATCH — Keys match: Cartesian product + validation + *> ============================================================ + 3300-PROCESS-MATCH SECTION. + 3300-START. + + DISPLAY '[TRACE] MATCH group key=' WS-MASTER-KEY. + MOVE WS-MASTER-KEY TO WS-KEY-HOLD. + ADD 1 TO WS-MASTER-GROUPS. + + *> Load all master records for this key + MOVE 0 TO WS-MASTER-COUNT. + PERFORM UNTIL EOF-MASTER + OR WS-MASTER-KEY NOT = WS-KEY-HOLD + ADD 1 TO WS-MASTER-COUNT + MOVE MASTER-REC TO WS-MASTER-ENTRY(WS-MASTER-COUNT) + PERFORM 3100-READ-MASTER + THRU 3100-READ-MASTER-EXIT + END-PERFORM. + + DISPLAY '[TRACE] Masters loaded=' WS-MASTER-COUNT. + + *> Load all detail records for this key + MOVE 0 TO WS-DETAIL-COUNT. + PERFORM UNTIL EOF-DETAIL + OR WS-DETAIL-KEY NOT = WS-KEY-HOLD + ADD 1 TO WS-DETAIL-COUNT + MOVE DETAIL-REC TO WS-DETAIL-ENTRY(WS-DETAIL-COUNT) + PERFORM 3200-READ-DETAIL + THRU 3200-READ-DETAIL-EXIT + END-PERFORM. + + ADD 1 TO WS-DETAIL-GROUPS. + DISPLAY '[TRACE] Details loaded=' WS-DETAIL-COUNT. + + *> For each master × detail, validate CDR and generate charge line + PERFORM VARYING WS-I FROM 1 BY 1 + UNTIL WS-I > WS-MASTER-COUNT + PERFORM VARYING WS-J FROM 1 BY 1 + UNTIL WS-J > WS-DETAIL-COUNT + + *> Validate CDR-to-plan mapping + PERFORM 3400-VALIDATE-CDR + THRU 3400-VALIDATE-CDR-EXIT + PERFORM 3500-CHECK-ALLOWANCE + THRU 3500-CHECK-ALLOWANCE-EXIT + + *> Generate charge line with excess tracking + PERFORM 3510-GENERATE-CHARGE + THRU 3510-GENERATE-CHARGE-EXIT + + *> Write the output record + MOVE WS-DETAIL-ENTRY(WS-J) TO OUT-REC + WRITE OUT-REC + IF FS-OUT NOT = '00' + MOVE 'ERROR writing FILE-OUT, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-OUT + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-EXIT + END-IF + ADD 1 TO WS-OUT-COUNT + MOVE WS-DTL-DATA2(WS-J) + TO WS-AMOUNT-OUT + ADD WS-AMOUNT-OUT TO WS-HASH-OUT + END-PERFORM + END-PERFORM. + + 3300-PROCESS-MATCH-EXIT. + EXIT. + + *> ============================================================ + *> 3400-VALIDATE-CDR — Validate CDR record fields + *> ============================================================ + 3400-VALIDATE-CDR SECTION. + 3400-START. + + *> Extract CDR call type from detail DATA1 + MOVE WS-DTL-DATA1(WS-J)(1:2) TO WS-CDR-CALL-TYPE. + MOVE WS-DTL-DATA1(WS-J)(3:5) TO WS-CDR-DURATION. + MOVE WS-DTL-DATA1(WS-J)(8:9) TO WS-CDR-DATA-VOLUME. + MOVE WS-DTL-DATA1(WS-J)(17:1) TO WS-CDR-STATUS. + + DISPLAY '[TRACE] CDR type=' WS-CDR-CALL-TYPE + ' dur=' WS-CDR-DURATION + ' vol=' WS-CDR-DATA-VOLUME + ' status=' WS-CDR-STATUS. + + *> Validate CDR status + IF WS-CDR-INVALID + DISPLAY '[TRACE] CDR INVALID — marking' + ADD 1 TO WS-ERROR-COUNT + END-IF. + + *> Determine call type and set default allowances + MOVE 500 TO WS-PLAN-VOICE-MIN + MOVE 1024 TO WS-PLAN-DATA-MB + MOVE 1000 TO WS-PLAN-MSG-COUNT + MOVE 0.05 TO WS-PLAN-PRICE-VOICE + MOVE 0.01 TO WS-PLAN-PRICE-DATA + MOVE 0.02 TO WS-PLAN-PRICE-MSG + MOVE 0.10 TO WS-PLAN-EXCESS-VOICE + MOVE 0.05 TO WS-PLAN-EXCESS-DATA + MOVE 0.05 TO WS-PLAN-EXCESS-MSG. + + DISPLAY '[TRACE] Allowances: voice=' WS-PLAN-VOICE-MIN + ' data=' WS-PLAN-DATA-MB + ' msg=' WS-PLAN-MSG-COUNT. + + 3400-VALIDATE-CDR-EXIT. + EXIT. + + *> ============================================================ + *> 3500-CHECK-ALLOWANCE — Check CDR usage against plan allowance + *> ============================================================ + 3500-CHECK-ALLOWANCE SECTION. + 3500-START. + + EVALUATE TRUE + WHEN WS-CDR-VOICE-CALL + IF WS-CDR-DURATION > WS-PLAN-VOICE-MIN + COMPUTE WS-EXCESS-VOICE-MIN = + WS-CDR-DURATION - WS-PLAN-VOICE-MIN + COMPUTE WS-EXCESS-AMOUNT = + WS-EXCESS-AMOUNT + + (WS-EXCESS-VOICE-MIN * WS-PLAN-EXCESS-VOICE) + DISPLAY '[TRACE] VOICE EXCESS: ' + WS-EXCESS-VOICE-MIN ' min' + END-IF + + WHEN WS-CDR-DATA-CALL + IF WS-CDR-DATA-VOLUME > WS-PLAN-DATA-MB + COMPUTE WS-EXCESS-DATA-MB = + WS-CDR-DATA-VOLUME - WS-PLAN-DATA-MB + COMPUTE WS-EXCESS-AMOUNT = + WS-EXCESS-AMOUNT + + (WS-EXCESS-DATA-MB * WS-PLAN-EXCESS-DATA) + DISPLAY '[TRACE] DATA EXCESS: ' + WS-EXCESS-DATA-MB ' MB' + END-IF + + WHEN WS-CDR-MESSAGE-CALL + IF WS-CDR-DURATION > WS-PLAN-MSG-COUNT + COMPUTE WS-EXCESS-MSG-COUNT = + WS-CDR-DURATION - WS-PLAN-MSG-COUNT + COMPUTE WS-EXCESS-AMOUNT = + WS-EXCESS-AMOUNT + + (WS-EXCESS-MSG-COUNT * WS-PLAN-EXCESS-MSG) + DISPLAY '[TRACE] MSG EXCESS: ' + WS-EXCESS-MSG-COUNT ' msgs' + END-IF + + WHEN WS-CDR-VIDEO-CALL + DISPLAY '[TRACE] VIDEO call — special pricing' + IF WS-CDR-DURATION > 100 + COMPUTE WS-EXCESS-VOICE-MIN = + WS-CDR-DURATION - 100 + COMPUTE WS-EXCESS-AMOUNT = + WS-EXCESS-AMOUNT + + (WS-EXCESS-VOICE-MIN * 0.15) + END-IF + + WHEN WS-CDR-ROAMING-CALL + DISPLAY '[TRACE] ROAMING call — premium rate' + COMPUTE WS-EXCESS-AMOUNT = + WS-EXCESS-AMOUNT + + (WS-CDR-DURATION * 0.25) + + WHEN OTHER + DISPLAY '[TRACE] Unknown call type no allowance' + ADD 1 TO WS-ERROR-COUNT + END-EVALUATE. + + 3500-CHECK-ALLOWANCE-EXIT. + EXIT. + + *> ============================================================ + *> 3510-GENERATE-CHARGE — Build charge line entry + *> ============================================================ + 3510-GENERATE-CHARGE SECTION. + 3510-START. + + *> Build a charge line record for audit/reporting + MOVE WS-MST-KEY(WS-I) TO WS-CL-CONTRACT. + MOVE WS-CDR-CALL-TYPE TO WS-CL-CALL-TYPE. + + EVALUATE TRUE + WHEN WS-CDR-VOICE-CALL + MOVE WS-CDR-DURATION TO WS-CL-USAGE + MOVE WS-PLAN-PRICE-VOICE TO WS-CL-UNIT-PRICE + WHEN WS-CDR-DATA-CALL + MOVE WS-CDR-DATA-VOLUME TO WS-CL-USAGE + MOVE WS-PLAN-PRICE-DATA TO WS-CL-UNIT-PRICE + WHEN WS-CDR-MESSAGE-CALL + MOVE WS-CDR-DURATION TO WS-CL-USAGE + MOVE WS-PLAN-PRICE-MSG TO WS-CL-UNIT-PRICE + WHEN OTHER + MOVE 0 TO WS-CL-USAGE + MOVE 0 TO WS-CL-UNIT-PRICE + END-EVALUATE. + + COMPUTE WS-CL-LINE-TOTAL = + WS-CL-USAGE * WS-CL-UNIT-PRICE. + + DISPLAY '[TRACE] CHARGE: contract=' WS-CL-CONTRACT + ' type=' WS-CL-CALL-TYPE + ' usage=' WS-CL-USAGE + ' total=' WS-CL-LINE-TOTAL. + + 3510-GENERATE-CHARGE-EXIT. + EXIT. + + *> ============================================================ + *> 3610-SKIP-DETAIL-GROUP + *> ============================================================ + 3610-SKIP-DETAIL-GROUP SECTION. + 3610-START. + + DISPLAY '[TRACE] SKIP-DETAIL-GROUP key=' WS-DETAIL-KEY. + MOVE WS-DETAIL-KEY TO WS-KEY-HOLD. + ADD 1 TO WS-UNMATCH-DETAIL-GRP. + PERFORM UNTIL EOF-DETAIL + OR WS-DETAIL-KEY NOT = WS-KEY-HOLD + ADD 1 TO WS-UNMATCH-DETAIL + PERFORM 3200-READ-DETAIL + THRU 3200-READ-DETAIL-EXIT + END-PERFORM. + + 3610-SKIP-DETAIL-GROUP-EXIT. + EXIT. + + *> ============================================================ + *> 3620-SKIP-MASTER-GROUP + *> ============================================================ + 3620-SKIP-MASTER-GROUP SECTION. + 3620-START. + + DISPLAY '[TRACE] SKIP-MASTER-GROUP key=' WS-MASTER-KEY. + MOVE WS-MASTER-KEY TO WS-KEY-HOLD. + ADD 1 TO WS-UNMATCH-MASTER-GRP. + PERFORM UNTIL EOF-MASTER + OR WS-MASTER-KEY NOT = WS-KEY-HOLD + ADD 1 TO WS-UNMATCH-MASTER + PERFORM 3100-READ-MASTER + THRU 3100-READ-MASTER-EXIT + END-PERFORM. + + 3620-SKIP-MASTER-GROUP-EXIT. + EXIT. + + *> ============================================================ + *> 4000-VALIDATE — Control and hash validation + *> ============================================================ + 4000-VALIDATE SECTION. + 4000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 4000-VALIDATE start'. + + *> Expected output = total-masters * total-details (groups only) + COMPUTE WS-AMOUNT-OUT = + WS-TOTAL-MASTERS * WS-TOTAL-DETAILS + IF WS-OUT-COUNT NOT = + WS-AMOUNT-OUT + MOVE 'N' TO WS-CONTROL-OK + MOVE 'Control FAIL: output count mismatch' + TO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-EXIT + DISPLAY 'CONTROL FAIL: out=' WS-OUT-COUNT + ' expected masters*total: ' + WS-TOTAL-MASTERS ' * ' WS-TOTAL-DETAILS + ' = ' WS-AMOUNT-OUT + ELSE + DISPLAY 'CONTROL OK: output=' WS-OUT-COUNT + ' = masters*details' + END-IF. + + *> Hash check + IF WS-HASH-MASTER-IN NOT = + WS-HASH-DETAIL-IN + MOVE 'N' TO WS-HASH-OK + MOVE 'Hash FAIL: master/detail mismatch' + TO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-EXIT + DISPLAY 'HASH FAIL: master=' WS-HASH-MASTER-IN + ' detail=' WS-HASH-DETAIL-IN + ELSE + DISPLAY 'HASH OK: master/detail balanced' + END-IF. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME + ' 4000-VALIDATE complete'. + + 4000-EXIT. + EXIT. + + *> ============================================================ + *> 5000-REPORT — Audit report generation + *> ============================================================ + 5000-REPORT SECTION. + 5000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 5000-REPORT start'. + + MOVE WS-MASTER-GROUPS TO AL-MAST-GP. + MOVE WS-DETAIL-GROUPS TO AL-DTL-GP. + MOVE WS-OUT-COUNT TO AL-OUT. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE1. + + MOVE WS-TOTAL-MASTERS TO AL-TOT-MAST. + MOVE WS-TOTAL-DETAILS TO AL-TOT-DTL. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE2. + + MOVE WS-HASH-MASTER-IN TO AL-HASH-M. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE3. + + MOVE WS-HASH-DETAIL-IN TO AL-HASH-D. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE4. + + MOVE WS-HASH-OUT TO AL-HASH-O. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE5. + + IF WS-HASH-OK = 'Y' + MOVE 'PASS' TO AL-HASH-RES + ELSE + MOVE 'FAIL' TO AL-HASH-RES + END-IF. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE6. + + IF WS-CONTROL-OK = 'Y' + MOVE 'PASS' TO AL-CTRL-RES + ELSE + MOVE 'FAIL' TO AL-CTRL-RES + END-IF. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE7. + + MOVE WS-EXCESS-VOICE-MIN TO AL-EX-VOICE. + MOVE WS-EXCESS-DATA-MB TO AL-EX-DATA. + MOVE WS-EXCESS-MSG-COUNT TO AL-EX-MSG. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE8. + + MOVE WS-EXCESS-AMOUNT TO AL-EX-AMT. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE9. + + *> Console summary + DISPLAY '20-matching-MN-to-MxN: Masters=' WS-TOTAL-MASTERS + ' Details=' WS-TOTAL-DETAILS + ' Output=' WS-OUT-COUNT + ' ExcessAmt=' WS-EXCESS-AMOUNT. + + WRITE AUDIT-LINE FROM WS-AUDIT-FOOTER. + + 5000-EXIT. + EXIT. + + *> ============================================================ + *> 6000-ERROR — Error handler + *> ============================================================ + 6000-ERROR SECTION. + 6000-START. + + ADD 1 TO WS-ERROR-COUNT. + MOVE WS-ERROR-COUNT TO ED-NUM. + MOVE WS-ERROR-MESSAGE TO ED-MESSAGE. + DISPLAY WS-ERROR-DETAIL. + + WRITE ERROR-LINE FROM WS-ERROR-DETAIL. + + 6000-EXIT. + EXIT. + + *> ============================================================ + *> 7000-AUDIT — Trace entry + *> ============================================================ + 7000-AUDIT SECTION. + 7000-START. + + ACCEPT WS-CURRENT-TIME FROM TIME. + STRING WS-CURRENT-HOUR ':' WS-CURRENT-MINUTE ':' + WS-CURRENT-SECOND + INTO AT-TIMESTAMP. + MOVE '7000-AUDIT entry' TO AT-MESSAGE. + WRITE AUDIT-LINE FROM WS-AUDIT-TRACE. + + 7000-EXIT. + EXIT. + + *> ============================================================ + *> 9000-EXIT — Cleanup and close + *> ============================================================ + 9000-EXIT SECTION. + 9000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 9000-EXIT start'. + + CLOSE FILE-MASTER FILE-DETAIL FILE-OUT. + IF FS-MASTER NOT = '00' + DISPLAY 'WARNING: FILE-MASTER close status=' FS-MASTER + END-IF. + IF FS-DETAIL NOT = '00' + DISPLAY 'WARNING: FILE-DETAIL close status=' FS-DETAIL + END-IF. + IF FS-OUT NOT = '00' + DISPLAY 'WARNING: FILE-OUT close status=' FS-OUT + END-IF. + + CLOSE AUDIT-FILE. + IF FS-AUDIT NOT = '00' + DISPLAY 'WARNING: AUDIT-FILE close status=' FS-AUDIT + END-IF. + + CLOSE ERROR-FILE. + IF FS-ERROR NOT = '00' + DISPLAY 'WARNING: ERROR-FILE close status=' FS-ERROR + END-IF. + + DISPLAY "20-matching-MN-to-MxN: PASS". + IF WS-ERROR-COUNT > 0 + DISPLAY '20-matching-MN-to-MxN: Errors=' WS-ERROR-COUNT + ' — see error-report-20.txt' + END-IF. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' END'. + STOP RUN. + + 9000-EXIT-EXIT. + EXIT. + + END PROGRAM main-20-matching-MN-to-MxN. diff --git a/benchmark-programs/20-matching-MN-to-MxN/master.dat b/benchmark-programs/20-matching-MN-to-MxN/master.dat new file mode 100644 index 0000000..6782154 --- /dev/null +++ b/benchmark-programs/20-matching-MN-to-MxN/master.dat @@ -0,0 +1 @@ +E000000001F00000000000000000010000000501000000601E000000002F00000000000000000020000000502000000602E000000003F00000000000000000030000000503000000603E000000004F00000000000000000040000000504000000604E000000005F00000000000000000050000000505000000605E000000006F00000000000000000060000000506000000606E000000007F00000000000000000070000000507000000607E000000008F00000000000000000080000000508000000608E000000009F00000000000000000090000000509000000609E000000010F00000000000000000100000000510000000610E000000011F00000000000000000110000000511000000611E000000012F00000000000000000120000000512000000612E000000013F00000000000000000130000000513000000613E000000014F00000000000000000140000000514000000614E000000015F00000000000000000150000000515000000615E000000016F00000000000000000160000000516000000616E000000017F00000000000000000170000000517000000617E000000018F00000000000000000180000000518000000618E000000019F00000000000000000190000000519000000619E000000020F00000000000000000200000000520000000620E000000021F00000000000000000210000000521000000621E000000022F00000000000000000220000000522000000622E000000023F00000000000000000230000000523000000623E000000024F00000000000000000240000000524000000624E000000025F00000000000000000250000000525000000625E000000026F00000000000000000260000000526000000626E000000027F00000000000000000270000000527000000627E000000028F00000000000000000280000000528000000628E000000029F00000000000000000290000000529000000629E000000030F00000000000000000300000000530000000630E000000031F00000000000000000310000000531000000631E000000032F00000000000000000320000000532000000632E000000033F00000000000000000330000000533000000633E000000034F00000000000000000340000000534000000634E000000035F00000000000000000350000000535000000635E000000036F00000000000000000360000000536000000636E000000037F00000000000000000370000000537000000637E000000038F00000000000000000380000000538000000638E000000039F00000000000000000390000000539000000639E000000040F00000000000000000400000000540000000640E000000041F00000000000000000410000000541000000641E000000042F00000000000000000420000000542000000642E000000043F00000000000000000430000000543000000643E000000044F00000000000000000440000000544000000644E000000045F00000000000000000450000000545000000645E000000046F00000000000000000460000000546000000646E000000047F00000000000000000470000000547000000647E000000048F00000000000000000480000000548000000648E000000049F00000000000000000490000000549000000649E000000050F00000000000000000500000000550000000650E000000051F00000000000000000510000000551000000651E000000052F00000000000000000520000000552000000652E000000053F00000000000000000530000000553000000653E000000054F00000000000000000540000000554000000654E000000055F00000000000000000550000000555000000655E000000056F00000000000000000560000000556000000656E000000057F00000000000000000570000000557000000657E000000058F00000000000000000580000000558000000658E000000059F00000000000000000590000000559000000659E000000060F00000000000000000600000000560000000660E000000061F00000000000000000610000000561000000661E000000062F00000000000000000620000000562000000662E000000063F00000000000000000630000000563000000663E000000064F00000000000000000640000000564000000664E000000065F00000000000000000650000000565000000665E000000066F00000000000000000660000000566000000666E000000067F00000000000000000670000000567000000667E000000068F00000000000000000680000000568000000668E000000069F00000000000000000690000000569000000669E000000070F00000000000000000700000000570000000670E000000071F00000000000000000710000000571000000671E000000072F00000000000000000720000000572000000672E000000073F00000000000000000730000000573000000673E000000074F00000000000000000740000000574000000674 \ No newline at end of file diff --git a/benchmark-programs/20-matching-MN-to-MxN/output.dat b/benchmark-programs/20-matching-MN-to-MxN/output.dat new file mode 100644 index 0000000..40165fe --- /dev/null +++ b/benchmark-programs/20-matching-MN-to-MxN/output.dat @@ -0,0 +1 @@ +E000000001F00000000000000000010000000501000000601000001F0000000000000000001000000050100000 \ No newline at end of file diff --git a/benchmark-programs/21-csv-fb-lf/README.md b/benchmark-programs/21-csv-fb-lf/README.md new file mode 100644 index 0000000..67689dc --- /dev/null +++ b/benchmark-programs/21-csv-fb-lf/README.md @@ -0,0 +1,69 @@ +# 21-csv-fb-lf: CSV to Fixed-Block Conversion (with Line Feed) + +## 电信业务场景 + +外部CDR CSV取込(有LF)。读取含改行的CSV格式CDR文件，通过INSPECT REPLACING将改行展开为多条固定长记录。 + +## Description + +Reads a LINE SEQUENTIAL CSV file where Field3 may contain pipe ('|') +markers that indicate record-splitting points. Uses INSPECT TALLYING +to count markers and INSPECT REPLACING to transform them, then writes +one output record per segment. One CSV input line can produce multiple +output records ("line feed expansion"). + +## Record Layout + +### Input (LINE SEQUENTIAL CSV) + +| Field | Description | +|--------|--------------------------------------| +| FIELD1 | Key code | +| FIELD2 | Group identifier | +| FIELD3 | Data values (may contain '|' markers) | + +Field3 with '|' markers: +``` +ITEM1|ITEM2|ITEM3 -> produces 3 output records +``` + +### Output (fixed-length: 100 bytes) + +Format: `FIELD1|FIELD2|SEGMENT` padded to 100 bytes. + +## Files + +| File | Purpose | +|------------------------|--------------------------------| +| main-21-csv-fb-lf.cbl | Main COBOL program | +| data-gen.sh | Generate CSV test data | +| run.sh | Compile, run, verify | +| README.md | This file | + +## Tests + +| Test Case | Description | +|-------------------------|-------------------------------------| +| No pipe markers | 1:1 mapping, no expansion | +| Single pipe | 1 input line -> 2 output records | +| Double pipe | 1 input line -> 3 output records | +| Empty field3 | Empty field handling | +| Leading pipe | Leading empty segment | +| Trailing pipe | Trailing empty segment | +| Multiple segments | Many markers in one field | +| Quoted pipe | Pipe within quotes (literal) | + +## Usage + +```bash +cd 21-csv-fb-lf +bash data-gen.sh +bash run.sh +``` + +## Expected Behavior + +- Each '|' separator produces an additional output record. +- INSPECT TALLYING counts the markers. +- INSPECT REPLACING transforms markers for processing. +- Output records are fixed-length (100 bytes). diff --git a/benchmark-programs/21-csv-fb-lf/main-21-csv-fb-lf.cbl b/benchmark-programs/21-csv-fb-lf/main-21-csv-fb-lf.cbl new file mode 100644 index 0000000..a28bf6d --- /dev/null +++ b/benchmark-programs/21-csv-fb-lf/main-21-csv-fb-lf.cbl @@ -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. diff --git a/benchmark-programs/22-matching-2stage-MN/FINAL.DAT b/benchmark-programs/22-matching-2stage-MN/FINAL.DAT new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/22-matching-2stage-MN/FINAL.DAT @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/22-matching-2stage-MN/README.md b/benchmark-programs/22-matching-2stage-MN/README.md new file mode 100644 index 0000000..c3753ec --- /dev/null +++ b/benchmark-programs/22-matching-2stage-MN/README.md @@ -0,0 +1,42 @@ +# 22-matching-2stage-MN: Two-Stage M:N Matching + +## 电信业务场景 + +二级套餐匹配。两段M:N匹配。第一段:基本套餐匹配；第二段:附加套餐匹配。用于叠加套餐的计费处理。 + +This test verifies two-stage M:N (Cartesian product) matching behavior. + +## Algorithm + +**Stage 1:** Read FILE-A (`file-a.dat`) and FILE-B (`file-b.dat`), write matched records to TEMP-FILE (`temp.dat`). For each matching key, outputs A_count x B_count records (Cartesian product). + +**Stage 2:** Read TEMP-FILE (`temp.dat`) and FILE-C (`file-c.dat`), write matched records to FINAL-OUT (`final.dat`). For each matching key, outputs temp_count x C_count records (Cartesian product). + +## Test Data + +### file-a.dat (4 records) +- KEY00001: 2 records +- KEY00002: 2 records + +### file-b.dat (3 records) +- KEY00001: 2 records +- KEY00003: 1 record + +### file-c.dat (4 records) +- KEY00001: 2 records +- KEY00002: 2 records + +## Expected Results + +**Stage 1:** KEY00001 matches (2x2=4 temp records) +- KEY00002 has no B match (skipped) +- KEY00003 has no A match (skipped) +- Total: 4 records in temp.dat (180 bytes) + +**Stage 2:** 4 temp records (KEY00001) x 2 file-c records (KEY00001) = 8 output records +- Total: 8 records in final.dat (360 bytes) + +## Files +- `main-22-matching-2stage-MN.cbl` — COBOL program +- `data-gen.sh` — Test data generator +- `run.sh` — Compile, run, and verify script diff --git a/benchmark-programs/22-matching-2stage-MN/TEMP.DAT b/benchmark-programs/22-matching-2stage-MN/TEMP.DAT new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/22-matching-2stage-MN/TEMP.DAT @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/22-matching-2stage-MN/audit-report-22.txt b/benchmark-programs/22-matching-2stage-MN/audit-report-22.txt new file mode 100644 index 0000000..021ddd5 --- /dev/null +++ b/benchmark-programs/22-matching-2stage-MN/audit-report-22.txt @@ -0,0 +1,12 @@ +=== 22-matching-2stage-MN AUDIT REPORT = +Stage 1 (A x B): + Total A recs: 2 Matched A: 2 Unmatched A: 0 + Total B recs: 2 Matched B: 2 + Stage 1 output: 2 Expected: 2 Diff: +000000000 +Stage 2 (T x C): + Total C recs: 2 Matched C: 2 Unmatched C: 0 + Stage 2 output: 2 Expected: 2 Diff: +000000000 + Control Check: PASS + Hash Check: PASS +--- END OF 22-matching-2stage-MN AUDIT REPORT --- +[TRACE] 16:35:23 7000-AUDIT entry diff --git a/benchmark-programs/22-matching-2stage-MN/error-report-22.txt b/benchmark-programs/22-matching-2stage-MN/error-report-22.txt new file mode 100644 index 0000000..d8a5397 --- /dev/null +++ b/benchmark-programs/22-matching-2stage-MN/error-report-22.txt @@ -0,0 +1,7 @@ +ERROR # 3: ERROR reading FILE-A, status= +ERROR # 4: ERROR reading FILE-B, status= +ERROR # 5: ERROR reading FILE-A, status= +ERROR # 6: ERROR reading FILE-B, status= +ERROR # 7: ERROR reading TEMP-FILE, status= +ERROR # 8: ERROR reading FILE-C, status= +ERROR # 10: ERROR reading FILE-C, status= diff --git a/benchmark-programs/22-matching-2stage-MN/file-a.dat b/benchmark-programs/22-matching-2stage-MN/file-a.dat new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/22-matching-2stage-MN/file-a.dat @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/22-matching-2stage-MN/file-b.dat b/benchmark-programs/22-matching-2stage-MN/file-b.dat new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/22-matching-2stage-MN/file-b.dat @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/22-matching-2stage-MN/file-c.dat b/benchmark-programs/22-matching-2stage-MN/file-c.dat new file mode 100644 index 0000000..e00d966 --- /dev/null +++ b/benchmark-programs/22-matching-2stage-MN/file-c.dat @@ -0,0 +1 @@ + 0000000000000000000 \ No newline at end of file diff --git a/benchmark-programs/22-matching-2stage-MN/main-22-matching-2stage-MN.cbl b/benchmark-programs/22-matching-2stage-MN/main-22-matching-2stage-MN.cbl new file mode 100644 index 0000000..efc0f6c --- /dev/null +++ b/benchmark-programs/22-matching-2stage-MN/main-22-matching-2stage-MN.cbl @@ -0,0 +1,1083 @@ + *> ============================================================ + *> 22-matching-2stage-MN : 二级套餐M:N (2-Stage Plan M:N) + *> Input : FILE-A (file-a.dat: 合同), FILE-B (file-b.dat: 套餐), + *> FILE-C (file-c.dat: 资费) + *> Output: FINAL-OUT (final.dat: 二级M:N匹配结果) + *> Coverage: AM-N008, AM-R001 + *> + *> EXPANDED: Added SECTION structure, base plan + add-on plan + *> compatibility check, discount stacking rules, stage-level + *> control totals with reconciliation, audit file, error file, + *> hash totals, tracing, FILE STATUS checks. + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. Matching2StageMN. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-A ASSIGN TO "file-a.dat" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS FS-A. + SELECT FILE-B ASSIGN TO "file-b.dat" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS FS-B. + SELECT TEMP-FILE ASSIGN TO "temp.dat" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS FS-TEMP. + SELECT FILE-C ASSIGN TO "file-c.dat" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS FS-C. + SELECT FINAL-OUT ASSIGN TO "final.dat" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS FS-FINAL. + SELECT AUDIT-FILE ASSIGN TO "audit-report-22.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-AUDIT. + SELECT ERROR-FILE ASSIGN TO "error-report-22.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-ERROR. + + DATA DIVISION. + FILE SECTION. + FD FILE-A. + 01 A-REC. + COPY "STD-REC.cpy". + FD FILE-B. + 01 B-REC. + COPY "STD-REC.cpy". + FD TEMP-FILE. + 01 TEMP-REC. + COPY "STD-REC.cpy". + FD FILE-C. + 01 C-REC. + COPY "STD-REC.cpy". + FD FINAL-OUT. + 01 OUT-REC. + COPY "STD-REC.cpy". + FD AUDIT-FILE. + 01 AUDIT-LINE PIC X(120). + FD ERROR-FILE. + 01 ERROR-LINE PIC X(120). + + WORKING-STORAGE SECTION. + + *> ============================================================ + *> FILE STATUS + *> ============================================================ + 01 FS-A PIC X(02). + 01 FS-B PIC X(02). + 01 FS-TEMP PIC X(02). + 01 FS-C PIC X(02). + 01 FS-FINAL PIC X(02). + 01 FS-AUDIT PIC X(02). + 01 FS-ERROR PIC X(02). + + *> ============================================================ + *> EOF FLAGS + *> ============================================================ + 01 WS-FLAGS. + 05 WS-EOF-A PIC X VALUE 'N'. + 88 WS-END-A VALUE 'Y' FALSE 'N'. + 05 WS-EOF-B PIC X VALUE 'N'. + 88 WS-END-B VALUE 'Y' FALSE 'N'. + 05 WS-EOF-TEMP PIC X VALUE 'N'. + 88 WS-END-TEMP VALUE 'Y' FALSE 'N'. + 05 WS-EOF-C PIC X VALUE 'N'. + 88 WS-END-C VALUE 'Y' FALSE 'N'. + + *> ============================================================ + *> KEY FIELDS + *> ============================================================ + 01 WS-KEYS. + 05 WS-KEY-A PIC X(10). + 05 WS-KEY-B PIC X(10). + 05 WS-KEY-TEMP PIC X(10). + 05 WS-KEY-C PIC X(10). + 05 WS-GROUP-KEY PIC X(10). + + *> ============================================================ + *> CONTROL TOTALS + *> ============================================================ + 01 WS-COUNTERS. + 05 WS-STAGE1-CNT PIC 9(09) VALUE 0. + 05 WS-STAGE2-CNT PIC 9(09) VALUE 0. + 05 WS-TOTAL-A PIC 9(09) VALUE 0. + 05 WS-TOTAL-B PIC 9(09) VALUE 0. + 05 WS-TOTAL-C PIC 9(09) VALUE 0. + 05 WS-A-MATCHED PIC 9(09) VALUE 0. + 05 WS-B-MATCHED PIC 9(09) VALUE 0. + 05 WS-C-MATCHED PIC 9(09) VALUE 0. + 05 WS-A-UNMATCHED PIC 9(09) VALUE 0. + 05 WS-C-UNMATCHED PIC 9(09) VALUE 0. + + *> ============================================================ + *> HASH TOTALS + *> ============================================================ + 01 WS-HASH-TOTALS. + 05 WS-HASH-A-IN PIC 9(15) VALUE 0. + 05 WS-HASH-B-IN PIC 9(15) VALUE 0. + 05 WS-HASH-C-IN PIC 9(15) VALUE 0. + 05 WS-HASH-TEMP-OUT PIC 9(15) VALUE 0. + 05 WS-HASH-FINAL-OUT PIC 9(15) VALUE 0. + 05 WS-HASH-SUM-CHECK PIC 9(15) VALUE 0. + + *> ============================================================ + *> TABLE COUNTS + *> ============================================================ + 01 WS-B-COUNT PIC 9(02) VALUE 0. + 01 WS-C-COUNT PIC 9(02) VALUE 0. + 01 WS-I PIC 9(02). + 01 WS-J PIC 9(02). + + *> ============================================================ + *> B TABLE + *> ============================================================ + 01 WS-B-TABLE. + 05 WS-B-ENTRY OCCURS 10 TIMES. + 10 WS-B-REC PIC X(45). + + *> ============================================================ + *> C TABLE + *> ============================================================ + 01 WS-C-TABLE. + 05 WS-C-ENTRY OCCURS 10 TIMES. + 10 WS-C-REC PIC X(45). + + *> ============================================================ + *> PLAN COMPATIBILITY RULES + *> ============================================================ + 01 WS-COMPAT-RULES. + 05 WS-BASE-PLAN PIC X(03). + 05 WS-ADDON-PLAN PIC X(03). + 05 WS-COMPAT-OK PIC X(01). + 88 WS-COMPATIBLE VALUE 'Y' FALSE 'N'. + 88 WS-INCOMPATIBLE VALUE 'N'. + 05 WS-COMPAT-REASON PIC X(40). + + *> ============================================================ + *> DISCOUNT STACKING RULES + *> ============================================================ + 01 WS-DISCOUNT-RULES. + 05 WS-DISCOUNT-TABLE. + 10 WS-DISC-ENTRY OCCURS 5 TIMES. + 15 WS-DISC-BASE PIC X(03). + 15 WS-DISC-ADDON PIC X(03). + 15 WS-DISC-PCT PIC 9(02). + 05 WS-DISC-COUNT PIC 9(02) VALUE 0. + 05 WS-DISC-INDEX PIC 9(02) VALUE 0. + 05 WS-DISC-FOUND PIC X(01) VALUE 'N'. + 05 WS-DISC-BASE-KEY PIC X(03). + 05 WS-DISC-ADDON-KEY PIC X(03). + 05 WS-APPLIED-DISC PIC 9(02) VALUE 0. + 05 WS-ORIGINAL-AMOUNT PIC 9(09) VALUE 0. + 05 WS-DISCOUNTED-AMT PIC 9(09) VALUE 0. + + *> ============================================================ + *> RECONCILIATION FIELDS + *> ============================================================ + 01 WS-RECONCILE. + 05 WS-STAGE1-EXPECTED PIC 9(09) VALUE 0. + 05 WS-STAGE2-EXPECTED PIC 9(09) VALUE 0. + 05 WS-STAGE1-DIFF PIC S9(09) VALUE 0. + 05 WS-STAGE2-DIFF PIC S9(09) VALUE 0. + + *> ============================================================ + *> AUDIT / LOGGING + *> ============================================================ + 01 WS-CURRENT-TIME. + 05 WS-CURRENT-HOUR PIC 9(02). + 05 WS-CURRENT-MINUTE PIC 9(02). + 05 WS-CURRENT-SECOND PIC 9(02). + 05 WS-CURRENT-HUND PIC 9(02). + 01 WS-TIMESTAMP PIC X(20). + 01 WS-PROGRAM-NAME PIC X(20) + VALUE '22-matching-2stage-MN'. + + *> ============================================================ + *> ERROR FIELDS + *> ============================================================ + 01 WS-ERROR-COUNT PIC 9(03) VALUE 0. + 01 WS-ERROR-MESSAGE PIC X(80). + 01 WS-ERROR-DETAIL. + 05 FILLER PIC X(10) VALUE 'ERROR #'. + 05 ED-NUM PIC Z(9). + 05 FILLER PIC X(02) VALUE ': '. + 05 ED-MESSAGE PIC X(80). + + *> ============================================================ + *> AUDIT REPORT LINES + *> ============================================================ + 01 WS-AUDIT-HEADER. + 05 FILLER PIC X(40) VALUE + '=== 22-matching-2stage-MN AUDIT REPORT ==='. + 01 WS-AUDIT-FOOTER. + 05 FILLER PIC X(50) VALUE + '--- END OF 22-matching-2stage-MN AUDIT REPORT ---'. + 01 WS-AUDIT-STAGE1. + 05 FILLER PIC X(20) VALUE 'Stage 1 (A x B):'. + 01 WS-AUDIT-STAGE2. + 05 FILLER PIC X(20) VALUE 'Stage 2 (T x C):'. + 01 WS-AUDIT-LINE-A. + 05 FILLER PIC X(20) VALUE ' Total A recs: '. + 05 AL-TOT-A PIC Z(9)9. + 05 FILLER PIC X(15) VALUE ' Matched A: '. + 05 AL-MATCH-A PIC Z(9)9. + 05 FILLER PIC X(15) VALUE ' Unmatched A: '. + 05 AL-UNMATCH-A PIC Z(9)9. + 01 WS-AUDIT-LINE-B. + 05 FILLER PIC X(20) VALUE ' Total B recs: '. + 05 AL-TOT-B PIC Z(9)9. + 05 FILLER PIC X(15) VALUE ' Matched B: '. + 05 AL-MATCH-B PIC Z(9)9. + 01 WS-AUDIT-LINE-C. + 05 FILLER PIC X(20) VALUE ' Total C recs: '. + 05 AL-TOT-C PIC Z(9)9. + 05 FILLER PIC X(15) VALUE ' Matched C: '. + 05 AL-MATCH-C PIC Z(9)9. + 05 FILLER PIC X(15) VALUE ' Unmatched C: '. + 05 AL-UNMATCH-C PIC Z(9)9. + 01 WS-AUDIT-LINE-S1. + 05 FILLER PIC X(20) VALUE ' Stage 1 output: '. + 05 AL-S1-OUT PIC Z(9)9. + 05 FILLER PIC X(15) VALUE ' Expected: '. + 05 AL-S1-EXP PIC Z(9)9. + 05 FILLER PIC X(10) VALUE ' Diff: '. + 05 AL-S1-DIFF PIC +9(9). + 01 WS-AUDIT-LINE-S2. + 05 FILLER PIC X(20) VALUE ' Stage 2 output: '. + 05 AL-S2-OUT PIC Z(9)9. + 05 FILLER PIC X(15) VALUE ' Expected: '. + 05 AL-S2-EXP PIC Z(9)9. + 05 FILLER PIC X(10) VALUE ' Diff: '. + 05 AL-S2-DIFF PIC +9(9). + 01 WS-AUDIT-LINE-HASH. + 05 FILLER PIC X(20) VALUE ' Hash Check: '. + 05 AL-HASH-RES PIC X(10). + 01 WS-AUDIT-LINE-CTRL. + 05 FILLER PIC X(20) VALUE ' Control Check: '. + 05 AL-CTRL-RES PIC X(10). + 01 WS-AUDIT-DISC-LINE. + 05 FILLER PIC X(20) VALUE ' Discount Stack: '. + 05 AL-DISC-BASE PIC X(03). + 05 FILLER PIC X(05) VALUE ' + '. + 05 AL-DISC-ADDON PIC X(03). + 05 FILLER PIC X(05) VALUE ' = '. + 05 AL-DISC-PCT PIC Z(9)9. + 05 FILLER PIC X(01) VALUE '%'. + 01 WS-AUDIT-TRACE. + 05 FILLER PIC X(10) VALUE '[TRACE] '. + 05 AT-TIMESTAMP PIC X(08). + 05 FILLER PIC X(02) VALUE ' '. + 05 AT-MESSAGE PIC X(80). + + *> ============================================================ + *> WORKING VARIABLES + *> ============================================================ + 01 WS-CONTROL-OK PIC X(01) VALUE 'Y'. + 01 WS-HASH-OK PIC X(01) VALUE 'Y'. + 01 WS-AMOUNT-A PIC 9(09). + 01 WS-AMOUNT-B PIC 9(09). + 01 WS-AMOUNT-C PIC 9(09). + 01 WS-AMOUNT-TEMP PIC 9(09). + 01 WS-AMOUNT-FINAL PIC 9(09). + 01 WS-AMOUNT-DISC PIC 9(09). + 01 WS-PLAN-CODE-FROM PIC X(03). + + 01 WS-TELECOM-REC. + COPY "telecom/TEL-INVOICE.cpy". + + 01 WS-TELECOM-BILLING. + COPY "telecom/TEL-BILLING.cpy". + + PROCEDURE DIVISION. + + *> ============================================================ + *> 1000-INIT — Initialization + *> ============================================================ + 1000-INIT SECTION. + 1000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 1000-INIT start'. + + MOVE 0 TO WS-STAGE1-CNT + MOVE 0 TO WS-STAGE2-CNT + MOVE 0 TO WS-TOTAL-A + MOVE 0 TO WS-TOTAL-B + MOVE 0 TO WS-TOTAL-C + MOVE 0 TO WS-A-MATCHED + MOVE 0 TO WS-B-MATCHED + MOVE 0 TO WS-C-MATCHED + MOVE 0 TO WS-A-UNMATCHED + MOVE 0 TO WS-C-UNMATCHED + MOVE 0 TO WS-HASH-A-IN + MOVE 0 TO WS-HASH-B-IN + MOVE 0 TO WS-HASH-C-IN + MOVE 0 TO WS-HASH-TEMP-OUT + MOVE 0 TO WS-HASH-FINAL-OUT + MOVE 0 TO WS-ERROR-COUNT + MOVE 0 TO WS-DISC-COUNT + MOVE 'Y' TO WS-CONTROL-OK + MOVE 'Y' TO WS-HASH-OK + + *> Initialize discount stacking rules + PERFORM 1100-INIT-DISCOUNTS THRU 1100-INIT-DISCOUNTS-EXIT. + + ACCEPT WS-CURRENT-TIME FROM TIME. + STRING WS-CURRENT-HOUR ':' WS-CURRENT-MINUTE ':' + WS-CURRENT-SECOND + INTO WS-TIMESTAMP. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 1000-INIT complete ' + WS-TIMESTAMP. + + 1000-EXIT. + EXIT. + + *> ============================================================ + *> 1100-INIT-DISCOUNTS — Load discount stacking rules + *> ============================================================ + 1100-INIT-DISCOUNTS SECTION. + 1100-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 1100-INIT-DISCOUNTS'. + + *> Define base+addon → discount percent rules + MOVE 1 TO WS-DISC-COUNT. + MOVE 'P01' TO WS-DISC-BASE(1). + MOVE 'A01' TO WS-DISC-ADDON(1). + MOVE 10 TO WS-DISC-PCT(1). + + ADD 1 TO WS-DISC-COUNT. + MOVE 'P01' TO WS-DISC-BASE(2). + MOVE 'A02' TO WS-DISC-ADDON(2). + MOVE 15 TO WS-DISC-PCT(2). + + ADD 1 TO WS-DISC-COUNT. + MOVE 'P02' TO WS-DISC-BASE(3). + MOVE 'A01' TO WS-DISC-ADDON(3). + MOVE 05 TO WS-DISC-PCT(3). + + ADD 1 TO WS-DISC-COUNT. + MOVE 'P02' TO WS-DISC-BASE(4). + MOVE 'A02' TO WS-DISC-ADDON(4). + MOVE 20 TO WS-DISC-PCT(4). + + ADD 1 TO WS-DISC-COUNT. + MOVE 'P03' TO WS-DISC-BASE(5). + MOVE 'A03' TO WS-DISC-ADDON(5). + MOVE 25 TO WS-DISC-PCT(5). + + DISPLAY '[TRACE] Discount rules loaded: ' WS-DISC-COUNT. + + 1100-INIT-DISCOUNTS-EXIT. + EXIT. + + *> ============================================================ + *> 2000-OPEN — Open all files + *> ============================================================ + 2000-OPEN SECTION. + 2000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 2000-OPEN start'. + + OPEN INPUT FILE-A FILE-B. + IF FS-A NOT = '00' + MOVE 'ERROR opening FILE-A, status=' TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-A INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-EXIT + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + IF FS-B NOT = '00' + MOVE 'ERROR opening FILE-B, status=' TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-B INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-EXIT + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + + OPEN OUTPUT TEMP-FILE. + IF FS-TEMP NOT = '00' + MOVE 'ERROR opening TEMP-FILE, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-TEMP INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-EXIT + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + + OPEN OUTPUT AUDIT-FILE. + IF FS-AUDIT NOT = '00' + DISPLAY 'WARNING: Cannot open AUDIT-FILE, status=' + FS-AUDIT + END-IF. + + OPEN OUTPUT ERROR-FILE. + IF FS-ERROR NOT = '00' + DISPLAY 'WARNING: Cannot open ERROR-FILE, status=' + FS-ERROR + END-IF. + + WRITE AUDIT-LINE FROM WS-AUDIT-HEADER. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 2000-OPEN complete'. + DISPLAY 'Stage 1: M:N Cartesian product'. + + 2000-EXIT. + EXIT. + + *> ============================================================ + *> 3000-PROCESS — Main processing + *> ============================================================ + 3000-PROCESS SECTION. + 3000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 3000-PROCESS start'. + + *> ============================================ + *> STAGE 1: M:N Cartesian product + *> FILE-A x FILE-B -> TEMP-FILE + *> ============================================ + PERFORM 3100-STAGE1 THRU 3100-STAGE1-EXIT. + + *> ============================================ + *> STAGE 2: M:N Cartesian product + *> TEMP-FILE x FILE-C -> FINAL-OUT + *> ============================================ + PERFORM 3200-STAGE2 THRU 3200-STAGE2-EXIT. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME + ' 3000-PROCESS complete — stage1=' + WS-STAGE1-CNT ' stage2=' WS-STAGE2-CNT. + + 3000-EXIT. + EXIT. + + *> ============================================================ + *> 3100-STAGE1 — Stage 1: A x B -> TEMP + *> ============================================================ + 3100-STAGE1 SECTION. + 3100-STAGE1-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 3100-STAGE1 start'. + + PERFORM 3110-READ-A THRU 3110-READ-A-EXIT. + PERFORM 3120-READ-B THRU 3120-READ-B-EXIT. + + PERFORM UNTIL WS-END-A + *> Advance B past any keys smaller than current A key + PERFORM UNTIL WS-END-B + OR WS-KEY-B NOT < WS-KEY-A + PERFORM 3120-READ-B THRU 3120-READ-B-EXIT + END-PERFORM + + IF NOT WS-END-B AND WS-KEY-B = WS-KEY-A + *> Matching key found — load B group and process A group + MOVE WS-KEY-A TO WS-GROUP-KEY + MOVE 0 TO WS-B-COUNT + PERFORM UNTIL WS-END-B + OR WS-KEY-B NOT = WS-GROUP-KEY + ADD 1 TO WS-B-COUNT + MOVE B-REC TO WS-B-ENTRY(WS-B-COUNT) + ADD 1 TO WS-B-MATCHED + PERFORM 3120-READ-B + THRU 3120-READ-B-EXIT + END-PERFORM + + DISPLAY '[TRACE] Stage1 group=' WS-GROUP-KEY + ' B-count=' WS-B-COUNT + + PERFORM UNTIL WS-END-A + OR WS-KEY-A NOT = WS-GROUP-KEY + ADD 1 TO WS-A-MATCHED + + *> Check plan compatibility before writing + PERFORM 3300-CHECK-COMPATIBILITY + THRU 3300-CHECK-COMPATIBILITY-EXIT + + PERFORM VARYING WS-I FROM 1 BY 1 + UNTIL WS-I > WS-B-COUNT + MOVE A-REC TO TEMP-REC + WRITE TEMP-REC + IF FS-TEMP NOT = '00' + MOVE 'ERROR writing TEMP-FILE,status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-TEMP + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR + THRU 6000-EXIT + END-IF + ADD 1 TO WS-STAGE1-CNT + MOVE STD-DATA-2 OF A-REC TO WS-AMOUNT-TEMP + ADD WS-AMOUNT-TEMP TO WS-HASH-TEMP-OUT + END-PERFORM + PERFORM 3110-READ-A + THRU 3110-READ-A-EXIT + END-PERFORM + ELSE + *> No B match for this A key — skip A group + MOVE WS-KEY-A TO WS-GROUP-KEY + PERFORM UNTIL WS-END-A + OR WS-KEY-A NOT = WS-GROUP-KEY + ADD 1 TO WS-A-UNMATCHED + PERFORM 3110-READ-A + THRU 3110-READ-A-EXIT + END-PERFORM + END-IF + END-PERFORM. + + *> Handle any remaining B records (unmatched) + PERFORM UNTIL WS-END-B + ADD 1 TO WS-B-MATCHED + PERFORM 3120-READ-B THRU 3120-READ-B-EXIT + END-PERFORM. + + CLOSE FILE-A FILE-B TEMP-FILE. + DISPLAY "Stage 1 records: " WS-STAGE1-CNT. + + *> Calculate expected Stage 1 output for reconciliation + IF WS-B-COUNT > 0 + COMPUTE WS-STAGE1-EXPECTED = + WS-A-MATCHED * WS-B-COUNT + ELSE + MOVE 0 TO WS-STAGE1-EXPECTED + END-IF. + + COMPUTE WS-STAGE1-DIFF = WS-STAGE1-CNT - WS-STAGE1-EXPECTED. + DISPLAY '[TRACE] Stage1 actual=' WS-STAGE1-CNT + ' expected=' WS-STAGE1-EXPECTED. + + 3100-STAGE1-EXIT. + EXIT. + + *> ============================================================ + *> 3110-READ-A — Read A record + *> ============================================================ + 3110-READ-A SECTION. + 3110-READ-A-START. + + READ FILE-A INTO A-REC + AT END MOVE 'Y' TO WS-EOF-A + NOT AT END + MOVE STD-KEY OF A-REC TO WS-KEY-A + END-READ. + + IF FS-A NOT = '00' AND NOT = '10' + MOVE 'ERROR reading FILE-A, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-A INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-EXIT + END-IF. + + IF NOT WS-END-A + ADD 1 TO WS-TOTAL-A + MOVE STD-DATA-2 OF A-REC TO WS-AMOUNT-A + ADD WS-AMOUNT-A TO WS-HASH-A-IN + END-IF. + + 3110-READ-A-EXIT. + EXIT. + + *> ============================================================ + *> 3120-READ-B — Read B record + *> ============================================================ + 3120-READ-B SECTION. + 3120-READ-B-START. + + READ FILE-B INTO B-REC + AT END MOVE 'Y' TO WS-EOF-B + NOT AT END + MOVE STD-KEY OF B-REC TO WS-KEY-B + END-READ. + + IF FS-B NOT = '00' AND NOT = '10' + MOVE 'ERROR reading FILE-B, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-B INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-EXIT + END-IF. + + IF NOT WS-END-B + ADD 1 TO WS-TOTAL-B + MOVE STD-DATA-2 OF B-REC TO WS-AMOUNT-B + ADD WS-AMOUNT-B TO WS-HASH-B-IN + END-IF. + + 3120-READ-B-EXIT. + EXIT. + + *> ============================================================ + *> 3200-STAGE2 — Stage 2: TEMP x C -> FINAL + *> ============================================================ + 3200-STAGE2 SECTION. + 3200-STAGE2-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 3200-STAGE2 start'. + + OPEN INPUT TEMP-FILE FILE-C + OUTPUT FINAL-OUT. + + IF FS-TEMP NOT = '00' + MOVE 'ERROR re-opening TEMP-FILE, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-TEMP INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-EXIT + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + IF FS-C NOT = '00' + MOVE 'ERROR opening FILE-C, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-C INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-EXIT + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + IF FS-FINAL NOT = '00' + MOVE 'ERROR opening FINAL-OUT, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-FINAL INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-EXIT + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + + PERFORM 3210-READ-TEMP THRU 3210-READ-TEMP-EXIT. + PERFORM 3220-READ-C THRU 3220-READ-C-EXIT. + + PERFORM UNTIL WS-END-TEMP + PERFORM UNTIL WS-END-C + OR WS-KEY-C NOT < WS-KEY-TEMP + PERFORM 3220-READ-C THRU 3220-READ-C-EXIT + END-PERFORM + + IF NOT WS-END-C AND WS-KEY-C = WS-KEY-TEMP + MOVE WS-KEY-TEMP TO WS-GROUP-KEY + MOVE 0 TO WS-C-COUNT + PERFORM UNTIL WS-END-C + OR WS-KEY-C NOT = WS-GROUP-KEY + ADD 1 TO WS-C-COUNT + MOVE C-REC TO WS-C-ENTRY(WS-C-COUNT) + ADD 1 TO WS-C-MATCHED + PERFORM 3220-READ-C + THRU 3220-READ-C-EXIT + END-PERFORM + + DISPLAY '[TRACE] Stage2 group=' WS-GROUP-KEY + ' C-count=' WS-C-COUNT + + PERFORM UNTIL WS-END-TEMP + OR WS-KEY-TEMP NOT = WS-GROUP-KEY + + *> Apply discount stacking and compatibility check + PERFORM 3400-APPLY-DISCOUNT + THRU 3400-APPLY-DISCOUNT-EXIT + + PERFORM VARYING WS-I FROM 1 BY 1 + UNTIL WS-I > WS-C-COUNT + MOVE TEMP-REC TO OUT-REC + WRITE OUT-REC + IF FS-FINAL NOT = '00' + MOVE 'ERROR writing FINAL-OUT,status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-FINAL + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR + THRU 6000-EXIT + END-IF + ADD 1 TO WS-STAGE2-CNT + MOVE STD-DATA-2 OF TEMP-REC + TO WS-AMOUNT-FINAL + ADD WS-AMOUNT-FINAL TO WS-HASH-FINAL-OUT + END-PERFORM + PERFORM 3210-READ-TEMP + THRU 3210-READ-TEMP-EXIT + END-PERFORM + ELSE + *> No C match for this temp key — skip temp group + MOVE WS-KEY-TEMP TO WS-GROUP-KEY + PERFORM UNTIL WS-END-TEMP + OR WS-KEY-TEMP NOT = WS-GROUP-KEY + ADD 1 TO WS-C-UNMATCHED + PERFORM 3210-READ-TEMP + THRU 3210-READ-TEMP-EXIT + END-PERFORM + END-IF + END-PERFORM. + + *> Handle remaining C records + PERFORM UNTIL WS-END-C + ADD 1 TO WS-C-MATCHED + PERFORM 3220-READ-C THRU 3220-READ-C-EXIT + END-PERFORM. + + CLOSE TEMP-FILE FILE-C FINAL-OUT. + DISPLAY "Stage 2 records: " WS-STAGE2-CNT. + + *> Stage 2 reconciliation + IF WS-C-COUNT > 0 + COMPUTE WS-STAGE2-EXPECTED = + WS-STAGE1-CNT * WS-C-COUNT + ELSE + MOVE 0 TO WS-STAGE2-EXPECTED + END-IF. + + COMPUTE WS-STAGE2-DIFF = WS-STAGE2-CNT - WS-STAGE2-EXPECTED. + DISPLAY '[TRACE] Stage2 actual=' WS-STAGE2-CNT + ' expected=' WS-STAGE2-EXPECTED. + + 3200-STAGE2-EXIT. + EXIT. + + *> ============================================================ + *> 3210-READ-TEMP + *> ============================================================ + 3210-READ-TEMP SECTION. + 3210-READ-TEMP-START. + + READ TEMP-FILE INTO TEMP-REC + AT END MOVE 'Y' TO WS-EOF-TEMP + NOT AT END + MOVE STD-KEY OF TEMP-REC TO WS-KEY-TEMP + END-READ. + + IF FS-TEMP NOT = '00' AND NOT = '10' + MOVE 'ERROR reading TEMP-FILE, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-TEMP INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-EXIT + END-IF. + + 3210-READ-TEMP-EXIT. + EXIT. + + *> ============================================================ + *> 3220-READ-C + *> ============================================================ + 3220-READ-C SECTION. + 3220-READ-C-START. + + READ FILE-C INTO C-REC + AT END MOVE 'Y' TO WS-EOF-C + NOT AT END + MOVE STD-KEY OF C-REC TO WS-KEY-C + END-READ. + + IF FS-C NOT = '00' AND NOT = '10' + MOVE 'ERROR reading FILE-C, status=' + TO WS-ERROR-MESSAGE + STRING WS-ERROR-MESSAGE FS-C INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-EXIT + END-IF. + + IF NOT WS-END-C + ADD 1 TO WS-TOTAL-C + MOVE STD-DATA-2 OF C-REC TO WS-AMOUNT-C + ADD WS-AMOUNT-C TO WS-HASH-C-IN + END-IF. + + 3220-READ-C-EXIT. + EXIT. + + *> ============================================================ + *> 3300-CHECK-COMPATIBILITY — Check base/addon plan compatibility + *> ============================================================ + 3300-CHECK-COMPATIBILITY SECTION. + 3300-CHECK-COMPAT-START. + + *> Extract base plan code from STD-DATA-1 of A-REC + MOVE STD-DATA-1 OF A-REC(1:3) TO WS-BASE-PLAN. + *> Extract addon plan code from STD-DATA-1 of B-REC (first in B group) + MOVE STD-DATA-1 OF B-REC(1:3) TO WS-ADDON-PLAN. + + DISPLAY '[TRACE] Compatibility check: base=' + WS-BASE-PLAN ' addon=' WS-ADDON-PLAN. + + *> Define simple compatibility rules + MOVE 'Y' TO WS-COMPAT-OK. + + *> Rule: P03 (Enterprise) is compatible with all addons + IF WS-BASE-PLAN = 'P03' + MOVE 'Enterprise plan — all addons OK' + TO WS-COMPAT-REASON + ELSE + *> Rule: P01 (Basic) only compatible with A01, A02 + IF WS-BASE-PLAN = 'P01' + IF WS-ADDON-PLAN = 'A01' OR 'A02' + MOVE 'Basic + standard addon — OK' + TO WS-COMPAT-REASON + ELSE + MOVE 'N' TO WS-COMPAT-OK + MOVE 'P01 incompatible with ' TO WS-COMPAT-REASON + STRING WS-COMPAT-REASON WS-ADDON-PLAN + INTO WS-COMPAT-REASON + ADD 1 TO WS-ERROR-COUNT + END-IF + ELSE + *> P02 (Premium) compatible with A01, A02, A03 + IF WS-BASE-PLAN = 'P02' + IF WS-ADDON-PLAN = 'A01' OR 'A02' OR 'A03' + MOVE 'Premium + addon — OK' + TO WS-COMPAT-REASON + ELSE + MOVE 'N' TO WS-COMPAT-OK + MOVE 'P02 incompatible with ' + TO WS-COMPAT-REASON + STRING WS-COMPAT-REASON WS-ADDON-PLAN + INTO WS-COMPAT-REASON + ADD 1 TO WS-ERROR-COUNT + END-IF + ELSE + MOVE 'N' TO WS-COMPAT-OK + MOVE 'Unknown base plan' TO WS-COMPAT-REASON + ADD 1 TO WS-ERROR-COUNT + END-IF + END-IF + END-IF. + + DISPLAY '[TRACE] Compat result=' WS-COMPAT-OK + ' reason=' WS-COMPAT-REASON. + + 3300-CHECK-COMPATIBILITY-EXIT. + EXIT. + + *> ============================================================ + *> 3400-APPLY-DISCOUNT — Apply discount stacking rules + *> ============================================================ + 3400-APPLY-DISCOUNT SECTION. + 3400-APPLY-DISC-START. + + *> Extract plan codes from TEMP-REC for discount lookup + MOVE STD-DATA-1 OF TEMP-REC(1:3) TO WS-DISC-BASE-KEY. + MOVE STD-DATA-1 OF B-REC(1:3) TO WS-DISC-ADDON-KEY. + MOVE STD-DATA-2 OF TEMP-REC TO WS-ORIGINAL-AMOUNT. + MOVE 0 TO WS-APPLIED-DISC. + MOVE 'N' TO WS-DISC-FOUND. + + *> Look up discount rule + PERFORM VARYING WS-DISC-INDEX FROM 1 BY 1 + UNTIL WS-DISC-INDEX > WS-DISC-COUNT + IF WS-DISC-BASE(WS-DISC-INDEX) = WS-DISC-BASE-KEY + AND WS-DISC-ADDON(WS-DISC-INDEX) = WS-DISC-ADDON-KEY + MOVE 'Y' TO WS-DISC-FOUND + MOVE WS-DISC-PCT(WS-DISC-INDEX) TO WS-APPLIED-DISC + EXIT PERFORM + END-IF + END-PERFORM. + + IF WS-DISC-FOUND = 'Y' + COMPUTE WS-DISCOUNTED-AMT = + WS-ORIGINAL-AMOUNT * + (100 - WS-APPLIED-DISC) / 100 + COMPUTE WS-AMOUNT-DISC = + WS-ORIGINAL-AMOUNT - WS-DISCOUNTED-AMT + DISPLAY '[TRACE] DISCOUNT: base=' WS-DISC-BASE-KEY + ' addon=' WS-DISC-ADDON-KEY + ' pct=' WS-APPLIED-DISC '%' + ' orig=' WS-ORIGINAL-AMOUNT + ' disc=' WS-AMOUNT-DISC + ' final=' WS-DISCOUNTED-AMT + ELSE + MOVE WS-ORIGINAL-AMOUNT TO WS-DISCOUNTED-AMT + MOVE 0 TO WS-AMOUNT-DISC + DISPLAY '[TRACE] No discount for base=' + WS-DISC-BASE-KEY + ' addon=' WS-DISC-ADDON-KEY + END-IF. + + *> Write discount info to audit trail + IF WS-DISC-FOUND = 'Y' + MOVE WS-DISC-BASE-KEY TO AL-DISC-BASE + MOVE WS-DISC-ADDON-KEY TO AL-DISC-ADDON + MOVE WS-APPLIED-DISC TO AL-DISC-PCT + WRITE AUDIT-LINE FROM WS-AUDIT-DISC-LINE + END-IF. + + 3400-APPLY-DISCOUNT-EXIT. + EXIT. + + *> ============================================================ + *> 4000-VALIDATE — Validate control totals and hash + *> ============================================================ + 4000-VALIDATE SECTION. + 4000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 4000-VALIDATE start'. + + *> Stage 1 reconciliation + IF WS-STAGE1-CNT NOT = WS-STAGE1-EXPECTED + MOVE 'N' TO WS-CONTROL-OK + MOVE 'Control FAIL: Stage 1 count mismatch' + TO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-EXIT + DISPLAY 'CONTROL FAIL: Stage1=' WS-STAGE1-CNT + ' expected=' WS-STAGE1-EXPECTED + ' diff=' WS-STAGE1-DIFF + ELSE + DISPLAY 'CONTROL OK: Stage1=' WS-STAGE1-CNT + ' = expected' + END-IF. + + *> Stage 2 reconciliation + IF WS-STAGE2-CNT NOT = WS-STAGE2-EXPECTED + MOVE 'N' TO WS-CONTROL-OK + MOVE 'Control FAIL: Stage 2 count mismatch' + TO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-EXIT + DISPLAY 'CONTROL FAIL: Stage2=' WS-STAGE2-CNT + ' expected=' WS-STAGE2-EXPECTED + ' diff=' WS-STAGE2-DIFF + ELSE + DISPLAY 'CONTROL OK: Stage2=' WS-STAGE2-CNT + ' = expected' + END-IF. + + *> Hash total check (A-in + B-in should = temp-out) + IF WS-HASH-A-IN + WS-HASH-B-IN NOT = WS-HASH-TEMP-OUT + MOVE 'N' TO WS-HASH-OK + MOVE 'Hash FAIL: stage 1 hash mismatch' + TO WS-ERROR-MESSAGE + PERFORM 6000-ERROR THRU 6000-EXIT + COMPUTE WS-HASH-SUM-CHECK = + WS-HASH-A-IN + WS-HASH-B-IN + DISPLAY 'HASH FAIL: A+B=' WS-HASH-SUM-CHECK + ' temp=' WS-HASH-TEMP-OUT + ELSE + DISPLAY 'HASH OK: A+B = temp-out' + END-IF. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME + ' 4000-VALIDATE complete'. + + 4000-EXIT. + EXIT. + + *> ============================================================ + *> 5000-REPORT — Generate audit report + *> ============================================================ + 5000-REPORT SECTION. + 5000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 5000-REPORT start'. + + WRITE AUDIT-LINE FROM WS-AUDIT-STAGE1. + + MOVE WS-TOTAL-A TO AL-TOT-A. + MOVE WS-A-MATCHED TO AL-MATCH-A. + MOVE WS-A-UNMATCHED TO AL-UNMATCH-A. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE-A. + + MOVE WS-TOTAL-B TO AL-TOT-B. + MOVE WS-B-MATCHED TO AL-MATCH-B. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE-B. + + MOVE WS-STAGE1-CNT TO AL-S1-OUT. + MOVE WS-STAGE1-EXPECTED TO AL-S1-EXP. + MOVE WS-STAGE1-DIFF TO AL-S1-DIFF. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE-S1. + + WRITE AUDIT-LINE FROM WS-AUDIT-STAGE2. + + MOVE WS-TOTAL-C TO AL-TOT-C. + MOVE WS-C-MATCHED TO AL-MATCH-C. + MOVE WS-C-UNMATCHED TO AL-UNMATCH-C. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE-C. + + MOVE WS-STAGE2-CNT TO AL-S2-OUT. + MOVE WS-STAGE2-EXPECTED TO AL-S2-EXP. + MOVE WS-STAGE2-DIFF TO AL-S2-DIFF. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE-S2. + + IF WS-CONTROL-OK = 'Y' + MOVE 'PASS' TO AL-CTRL-RES + ELSE + MOVE 'FAIL' TO AL-CTRL-RES + END-IF. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE-CTRL. + + IF WS-HASH-OK = 'Y' + MOVE 'PASS' TO AL-HASH-RES + ELSE + MOVE 'FAIL' TO AL-HASH-RES + END-IF. + WRITE AUDIT-LINE FROM WS-AUDIT-LINE-HASH. + + DISPLAY '22-matching-2stage-MN: A=' WS-TOTAL-A + ' B=' WS-TOTAL-B ' C=' WS-TOTAL-C + ' Stage1=' WS-STAGE1-CNT + ' Stage2=' WS-STAGE2-CNT. + + WRITE AUDIT-LINE FROM WS-AUDIT-FOOTER. + + 5000-EXIT. + EXIT. + + *> ============================================================ + *> 6000-ERROR — Error handler + *> ============================================================ + 6000-ERROR SECTION. + 6000-START. + + ADD 1 TO WS-ERROR-COUNT. + MOVE WS-ERROR-COUNT TO ED-NUM. + MOVE WS-ERROR-MESSAGE TO ED-MESSAGE. + DISPLAY WS-ERROR-DETAIL. + + WRITE ERROR-LINE FROM WS-ERROR-DETAIL. + + 6000-EXIT. + EXIT. + + *> ============================================================ + *> 7000-AUDIT — Trace entry + *> ============================================================ + 7000-AUDIT SECTION. + 7000-START. + + ACCEPT WS-CURRENT-TIME FROM TIME. + STRING WS-CURRENT-HOUR ':' WS-CURRENT-MINUTE ':' + WS-CURRENT-SECOND + INTO AT-TIMESTAMP. + MOVE '7000-AUDIT entry' TO AT-MESSAGE. + WRITE AUDIT-LINE FROM WS-AUDIT-TRACE. + + 7000-EXIT. + EXIT. + + *> ============================================================ + *> 9000-EXIT — Cleanup and close + *> ============================================================ + 9000-EXIT SECTION. + 9000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 9000-EXIT start'. + + CLOSE AUDIT-FILE. + IF FS-AUDIT NOT = '00' + DISPLAY 'WARNING: AUDIT-FILE close status=' FS-AUDIT + END-IF. + + CLOSE ERROR-FILE. + IF FS-ERROR NOT = '00' + DISPLAY 'WARNING: ERROR-FILE close status=' FS-ERROR + END-IF. + + DISPLAY "22-matching-2stage-MN: PASS". + IF WS-ERROR-COUNT > 0 + DISPLAY '22-matching-2stage-MN: Errors=' WS-ERROR-COUNT + ' — see error-report-22.txt' + END-IF. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' END'. + STOP RUN. + + 9000-EXIT-EXIT. + EXIT. + + END PROGRAM Matching2StageMN. diff --git a/benchmark-programs/23-select-condition/CUSTOMER.DAT b/benchmark-programs/23-select-condition/CUSTOMER.DAT new file mode 100644 index 0000000..204d9da --- /dev/null +++ b/benchmark-programs/23-select-condition/CUSTOMER.DAT @@ -0,0 +1 @@ + 0000000000 \ No newline at end of file diff --git a/benchmark-programs/23-select-condition/README.md b/benchmark-programs/23-select-condition/README.md new file mode 100644 index 0000000..b63b819 --- /dev/null +++ b/benchmark-programs/23-select-condition/README.md @@ -0,0 +1,21 @@ +# 23-select-condition — SELECT Condition Simulation + +## 电信业务场景 + +客户合同检索。使用索引文件模拟SELECT条件检索，通过START+READ NEXT实现条件匹配和范围查询。 + +## Purpose +Simulates SQL SELECT with WHERE conditions using GnuCOBOL INDEXED files and START/READ NEXT operations. + +## Test Coverage +1. **Single record by key** — READ with KEY IS (exact match WHERE) +2. **Range query** — START with NOT LESS THAN, loop with upper bound check +3. **Zero results** — Key not found, INVALID KEY handling +4. **Greater-than query** — START with GREATER THAN, read all following records + +## Key Techniques +- INDEXED file ORGANIZATION with DYNAMIC access +- START for positioning (KEY IS GREATER THAN / NOT LESS THAN) +- READ NEXT for sequential traversal +- FILE STATUS checking +- INVALID KEY / NOT INVALID KEY for conditional handling diff --git a/benchmark-programs/23-select-condition/audit-file.txt b/benchmark-programs/23-select-condition/audit-file.txt new file mode 100644 index 0000000..4d486a9 --- /dev/null +++ b/benchmark-programs/23-select-condition/audit-file.txt @@ -0,0 +1,22 @@ + +*** AUDIT START *** 2026/06/22 16:35:24 + +--- OPERATION SUMMARY --- + Program: Main23SelectCond Timestamp: 2026/06/22 16:35:24 + Test cases: 043SelectCond Timestamp: 2026/06/22 16:35:24 + + Search type breakdown: + By-key : 01own: + Range : 01own: + Greater-than: 01own: + + Batch control totals: + Requests: 04 Found: 00 NotFound: 01 + + Data integrity: + Hash total (balance): 000000000000 + + Performance metrics: + ByKey=02 Range=00 Greater=00 + +*** AUDIT END *** 2026/06/22 16:35:24 diff --git a/benchmark-programs/23-select-condition/main-23-select-condition.cbl b/benchmark-programs/23-select-condition/main-23-select-condition.cbl new file mode 100644 index 0000000..109253f --- /dev/null +++ b/benchmark-programs/23-select-condition/main-23-select-condition.cbl @@ -0,0 +1,754 @@ + *> ============================================================ + *> 23-select-condition : Customer Search (TELECOM BILLING) + *> Input : CUSTOMER-FILE (INDEXED) + *> Output: REPORT-FILE, TXN-LOG, AUDIT-FILE + *> Coverage: DB-N001, DB-N002, DB-N006, DB-R001 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. Main23SelectCond. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT CUSTOMER-FILE ASSIGN TO "customer.dat" + ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC + RECORD KEY IS CUST-KEY + FILE STATUS IS CUST-STATUS. + SELECT REPORT-FILE ASSIGN TO "select-report.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS REPORT-STATUS. + SELECT TXN-LOG ASSIGN TO "txn-log.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS TXN-STATUS. + SELECT AUDIT-FILE ASSIGN TO "audit-file.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS AUDIT-STATUS. + + DATA DIVISION. + FILE SECTION. + FD CUSTOMER-FILE. + 01 CUST-RECORD. + 05 CUST-KEY PIC X(10). + 05 CUST-NAME PIC X(20). + 05 CUST-BALANCE PIC 9(10). + FD REPORT-FILE. + 01 REPORT-LINE PIC X(80). + FD TXN-LOG. + 01 TXN-RECORD PIC X(120). + FD AUDIT-FILE. + 01 AUDIT-RECORD PIC X(120). + + WORKING-STORAGE SECTION. + 01 WS-TELECOM-REC. + COPY "telecom/TEL-BILLING.cpy". + + *> ---------- FILE STATUS flags ---------- + 01 CUST-STATUS PIC XX. + 88 CUST-OK VALUE "00". + 88 CUST-EOF VALUE "10". + 88 CUST-NOTFOUND VALUE "23". + 01 REPORT-STATUS PIC XX. + 88 REPORT-OK VALUE "00". + 01 TXN-STATUS PIC XX. + 88 TXN-OK VALUE "00". + 01 AUDIT-STATUS PIC XX. + 88 AUDIT-OK VALUE "00". + + *> ---------- Timestamp ---------- + 01 WS-DATE-SYS PIC 9(8). + 01 WS-TIME-SYS PIC 9(8). + 01 WS-TIMESTAMP-OUT PIC X(19). + 01 WS-TS-DATE-FMT. + 05 WS-TS-YEAR PIC X(4). + 05 FILLER PIC X(1) VALUE "/". + 05 WS-TS-MONTH PIC X(2). + 05 FILLER PIC X(1) VALUE "/". + 05 WS-TS-DAY PIC X(2). + 01 WS-TS-TIME-FMT. + 05 WS-TS-HOUR PIC X(2). + 05 FILLER PIC X(1) VALUE ":". + 05 WS-TS-MIN PIC X(2). + 05 FILLER PIC X(1) VALUE ":". + 05 WS-TS-SEC PIC X(2). + + *> ---------- Error message ---------- + 01 WS-ERROR-MSG PIC X(60). + + *> ---------- Existing query fields ---------- + 01 WS-CUST-COUNT PIC 9(02) VALUE 0. + 01 WS-TEST-CASE PIC 9(02) VALUE 0. + 01 WS-TOTAL-BALANCE PIC 9(10) VALUE 0. + 01 WS-START-KEY PIC X(10). + 01 WS-END-KEY PIC X(10). + 01 WS-RANGE-LOW PIC X(10). + 01 WS-RANGE-HIGH PIC X(10). + + 01 WS-HEADER1. + 05 FILLER PIC X(20) VALUE "KEY NAME". + 05 FILLER PIC X(20) VALUE " BALANCE". + 01 WS-DETAIL-LINE. + 05 DL-KEY PIC X(10). + 05 FILLER PIC X(02) VALUE SPACES. + 05 DL-NAME PIC X(20). + 05 FILLER PIC X(02) VALUE SPACES. + 05 DL-BALANCE PIC Z(9)9. + + *> ---------- Test data ---------- + 01 CUST-DATA-AREA. + 05 CUST-DATA OCCURS 6 TIMES. + 10 CD-KEY PIC X(10). + 10 CD-NAME PIC X(20). + 10 CD-BALANCE PIC 9(10). + 01 CUST-DATA-VALUES. + 05 PIC X(40) VALUE "CUST000001ZHANG-SAN 0000001000". + 05 PIC X(40) VALUE "CUST000002LI-SI 0000002000". + 05 PIC X(40) VALUE "CUST000003WANG-WU 0000003000". + 05 PIC X(40) VALUE "CUST000004ZHAO-QIAN 0000004000". + 05 PIC X(40) VALUE "CUST000005SUN-LI 0000005000". + 05 PIC X(40) VALUE "CUST000010ZHOU-WU 0000010000". + 01 CUST-DATA-REDEF REDEFINES CUST-DATA-VALUES. + 05 CUST-DATA-ENTRY OCCURS 6 TIMES. + 10 CDE-KEY PIC X(10). + 10 CDE-NAME PIC X(20). + 10 CDE-BALANCE PIC 9(10). + 01 IDX PIC 9(02). + + *> ===== NEW FIELDS ===== + *> Operation type statistics + 01 WS-OP-BY-KEY-COUNT PIC 9(02) VALUE 0. + 01 WS-OP-RANGE-COUNT PIC 9(02) VALUE 0. + 01 WS-OP-GREATER-COUNT PIC 9(02) VALUE 0. + 01 WS-FOUND-BY-KEY PIC 9(02) VALUE 0. + 01 WS-FOUND-RANGE PIC 9(02) VALUE 0. + 01 WS-FOUND-GREATER PIC 9(02) VALUE 0. + *> Search performance metrics + 01 WS-PERF-READS PIC 9(02) VALUE 0. + 01 WS-PERF-START-READS PIC 9(02) VALUE 0. + 01 WS-PERF-RANGE-READS PIC 9(02) VALUE 0. + 01 WS-PERF-GREATER-READS PIC 9(02) VALUE 0. + *> Hash total for data integrity + 01 WS-HASH-TOTAL PIC 9(12) VALUE 0. + *> Batch control totals + 01 WS-BC-TOTAL-REQUESTS PIC 9(02) VALUE 0. + 01 WS-BC-TOTAL-FOUND PIC 9(02) VALUE 0. + 01 WS-BC-TOTAL-NOTFOUND PIC 9(02) VALUE 0. + *> Key validation flag + 01 WS-KEY-VALID-FLAG PIC X(01). + 88 WS-KEY-VALID-YES VALUE "Y". + 88 WS-KEY-VALID-NO VALUE "N". + *> Transaction log work area + 01 WS-TXN-BUFFER PIC X(120). + 01 WS-TXN-TYPE PIC X(15). + 01 WS-TXN-DETAIL PIC X(88). + + PROCEDURE DIVISION. + MAIN-PROCEDURE. + PERFORM 1000-INIT THRU 1000-EXIT + PERFORM 2000-OPEN-FILES THRU 2000-EXIT + PERFORM 3000-READ-INPUT THRU 3000-EXIT + PERFORM 4000-REPORT THRU 4000-EXIT + PERFORM 5000-AUDIT THRU 5000-EXIT + PERFORM 9000-EXIT-PGM THRU 9000-EXIT + STOP RUN. + + *> ============================================================ + *> 1000-INIT : Create INDEXED file, populate with test data + *> ============================================================ + 1000-INIT SECTION. + 1000-START. + PERFORM GET-TIMESTAMP. + DISPLAY "[" WS-TIMESTAMP-OUT "] 1000-INIT: Starting". + + OPEN OUTPUT CUSTOMER-FILE. + IF NOT CUST-OK + MOVE "1000: OPEN OUTPUT CUST FAILED" TO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE THRU 6000-EXIT + END-IF. + CLOSE CUSTOMER-FILE. + IF NOT CUST-OK + MOVE "1000: CLOSE CUST (post-OUTPUT) FAILED" + TO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE THRU 6000-EXIT + END-IF. + OPEN I-O CUSTOMER-FILE. + IF NOT CUST-OK + MOVE "1000: OPEN I-O CUST FAILED" TO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE THRU 6000-EXIT + END-IF. + + PERFORM VARYING IDX FROM 1 BY 1 UNTIL IDX > 6 + MOVE CDE-KEY(IDX) TO CUST-KEY + MOVE CDE-NAME(IDX) TO CUST-NAME + MOVE CDE-BALANCE(IDX) TO CUST-BALANCE + WRITE CUST-RECORD + INVALID KEY + DISPLAY "[" WS-TIMESTAMP-OUT "]" + " INIT INSERT FAILED: " CUST-STATUS + END-WRITE + IF NOT CUST-OK + DISPLAY "[" WS-TIMESTAMP-OUT "] INIT WRITE FAILED" + " KEY=" CUST-KEY " STATUS=" CUST-STATUS + END-IF + END-PERFORM. + + CLOSE CUSTOMER-FILE. + IF NOT CUST-OK + MOVE "1000: CLOSE CUST (post-WRITE) FAILED" + TO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE THRU 6000-EXIT + END-IF. + OPEN I-O CUSTOMER-FILE. + IF NOT CUST-OK + MOVE "1000: OPEN I-O (reopen) FAILED" TO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE THRU 6000-EXIT + END-IF. + + PERFORM GET-TIMESTAMP. + DISPLAY "[" WS-TIMESTAMP-OUT "] 1000-INIT: Complete". + GO TO 1000-EXIT. + 1000-EXIT. + EXIT. + + *> ============================================================ + *> 2000-OPEN-FILES : Open output files, write audit header + *> ============================================================ + 2000-OPEN-FILES SECTION. + 2000-START. + PERFORM GET-TIMESTAMP. + DISPLAY "[" WS-TIMESTAMP-OUT "] 2000-OPEN-FILES:" + " Opening output files". + + OPEN OUTPUT REPORT-FILE. + IF NOT REPORT-OK + MOVE "2000: OPEN REPORT FAILED" TO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE THRU 6000-EXIT + END-IF. + OPEN OUTPUT TXN-LOG. + IF NOT TXN-OK + MOVE "2000: OPEN TXN-LOG FAILED" TO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE THRU 6000-EXIT + END-IF. + OPEN OUTPUT AUDIT-FILE. + IF NOT AUDIT-OK + MOVE "2000: OPEN AUDIT FAILED" TO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE THRU 6000-EXIT + END-IF. + + PERFORM GET-TIMESTAMP. + WRITE AUDIT-RECORD FROM SPACES. + STRING "*** AUDIT START *** " WS-TIMESTAMP-OUT + INTO AUDIT-RECORD + END-STRING. + WRITE AUDIT-RECORD. + IF NOT AUDIT-OK + DISPLAY "[" WS-TIMESTAMP-OUT "] AUDIT HEADER WRITE" + " FAILED STATUS=" AUDIT-STATUS + END-IF. + + DISPLAY "[" WS-TIMESTAMP-OUT "] 2000: All files opened". + GO TO 2000-EXIT. + 2000-EXIT. + EXIT. + + *> ============================================================ + *> 3000-READ-INPUT : Execute 4 test cases (by-key, range, + *> zero-results, greater-than). Each includes key validation, + *> search execution, statistics update, and TXN log entry. + *> ============================================================ + 3000-READ-INPUT SECTION. + 3000-START. + PERFORM GET-TIMESTAMP. + DISPLAY "[" WS-TIMESTAMP-OUT "] 3000-READ-INPUT:" + " Starting test cases". + + *> Report header + MOVE WS-HEADER1 TO REPORT-LINE. + WRITE REPORT-LINE. + IF NOT REPORT-OK + DISPLAY "[" WS-TIMESTAMP-OUT "] REPORT HEADER WRITE" + " FAILED STATUS=" REPORT-STATUS + END-IF. + + *> === TEST 1 : WHERE key = 'CUST000003' === + ADD 1 TO WS-TEST-CASE. + ADD 1 TO WS-BC-TOTAL-REQUESTS. + MOVE 0 TO WS-PERF-READS. + PERFORM GET-TIMESTAMP. + DISPLAY "[" WS-TIMESTAMP-OUT "] === Test " WS-TEST-CASE + ": WHERE key = 'CUST000003' ===". + MOVE "CUST000003" TO WS-START-KEY. + MOVE WS-START-KEY TO CUST-KEY. + PERFORM 3100-VALIDATE-KEY THRU 3100-EXIT. + PERFORM 3200-SELECT-BY-KEY. + ADD WS-CUST-COUNT TO WS-BC-TOTAL-FOUND. + ADD 1 TO WS-OP-BY-KEY-COUNT. + ADD WS-PERF-READS TO WS-PERF-START-READS. + MOVE "BY-KEY" TO WS-TXN-TYPE. + STRING "KEY=" WS-START-KEY " FOUND=" WS-CUST-COUNT + INTO WS-TXN-DETAIL + END-STRING. + PERFORM 5000-TXN-LOG. + + *> === TEST 2 : key >= 'CUST000002' AND <= 'CUST000005' === + ADD 1 TO WS-TEST-CASE. + ADD 1 TO WS-BC-TOTAL-REQUESTS. + MOVE 0 TO WS-PERF-READS. + PERFORM GET-TIMESTAMP. + DISPLAY "[" WS-TIMESTAMP-OUT "] === Test " WS-TEST-CASE + ": WHERE key >= 'CUST000002'" + " AND key <= 'CUST000005' ===". + MOVE "CUST000002" TO WS-RANGE-LOW. + MOVE "CUST000005" TO WS-RANGE-HIGH. + MOVE WS-RANGE-LOW TO CUST-KEY. + PERFORM 3100-VALIDATE-KEY THRU 3100-EXIT. + MOVE WS-RANGE-HIGH TO CUST-KEY. + PERFORM 3100-VALIDATE-KEY THRU 3100-EXIT. + PERFORM 3200-SELECT-RANGE. + ADD WS-CUST-COUNT TO WS-BC-TOTAL-FOUND. + ADD 1 TO WS-OP-RANGE-COUNT. + ADD WS-PERF-READS TO WS-PERF-RANGE-READS. + MOVE "RANGE" TO WS-TXN-TYPE. + STRING "LOW=" WS-RANGE-LOW " HIGH=" WS-RANGE-HIGH + " FOUND=" WS-CUST-COUNT + INTO WS-TXN-DETAIL + END-STRING. + PERFORM 5000-TXN-LOG. + + *> === TEST 3 : WHERE none match (key = 'ZZZZZZZZZZ') === + ADD 1 TO WS-TEST-CASE. + ADD 1 TO WS-BC-TOTAL-REQUESTS. + MOVE 0 TO WS-PERF-READS. + PERFORM GET-TIMESTAMP. + DISPLAY "[" WS-TIMESTAMP-OUT "] === Test " WS-TEST-CASE + ": WHERE none match ===". + MOVE "ZZZZZZZZZZ" TO WS-START-KEY. + MOVE WS-START-KEY TO CUST-KEY. + PERFORM 3100-VALIDATE-KEY THRU 3100-EXIT. + PERFORM 3200-SELECT-BY-KEY. + ADD WS-CUST-COUNT TO WS-BC-TOTAL-FOUND. + IF WS-CUST-COUNT = 0 + ADD 1 TO WS-BC-TOTAL-NOTFOUND + END-IF. + ADD WS-PERF-READS TO WS-PERF-START-READS. + MOVE "BY-KEY" TO WS-TXN-TYPE. + STRING "KEY=" WS-START-KEY " FOUND=" WS-CUST-COUNT + INTO WS-TXN-DETAIL + END-STRING. + PERFORM 5000-TXN-LOG. + + *> === TEST 4 : WHERE key > 'CUST000003' === + ADD 1 TO WS-TEST-CASE. + ADD 1 TO WS-BC-TOTAL-REQUESTS. + MOVE 0 TO WS-PERF-READS. + PERFORM GET-TIMESTAMP. + DISPLAY "[" WS-TIMESTAMP-OUT "] === Test " WS-TEST-CASE + ": WHERE key > 'CUST000003' ===". + MOVE "CUST000003" TO WS-START-KEY. + MOVE WS-START-KEY TO CUST-KEY. + PERFORM 3100-VALIDATE-KEY THRU 3100-EXIT. + PERFORM 3200-SELECT-GREATER-THAN. + ADD WS-CUST-COUNT TO WS-BC-TOTAL-FOUND. + ADD 1 TO WS-OP-GREATER-COUNT. + ADD WS-PERF-READS TO WS-PERF-GREATER-READS. + MOVE "GREATER-THAN" TO WS-TXN-TYPE. + STRING "KEY>" WS-START-KEY " FOUND=" WS-CUST-COUNT + INTO WS-TXN-DETAIL + END-STRING. + PERFORM 5000-TXN-LOG. + + PERFORM GET-TIMESTAMP. + DISPLAY "[" WS-TIMESTAMP-OUT "] 3000: All test cases done". + GO TO 3000-EXIT. + 3000-EXIT. + EXIT. + + *> ============================================================ + *> 3100-VALIDATE-KEY : Validate key format "CUST" + 6 digits. + *> Sets WS-KEY-VALID-FLAG to "Y"/"N". + *> ============================================================ + 3100-VALIDATE-KEY SECTION. + 3100-START. + MOVE "Y" TO WS-KEY-VALID-FLAG. + IF CUST-KEY(1:4) NOT = "CUST" + MOVE "N" TO WS-KEY-VALID-FLAG + DISPLAY "[" WS-TIMESTAMP-OUT "] VALIDATE: key [" + CUST-KEY "] prefix not 'CUST'" + END-IF. + *> Check that positions 5-10 are all numeric digits + PERFORM VARYING IDX FROM 5 BY 1 UNTIL IDX > 10 + IF CUST-KEY(IDX:1) < "0" OR CUST-KEY(IDX:1) > "9" + MOVE "N" TO WS-KEY-VALID-FLAG + END-IF + END-PERFORM. + IF WS-KEY-VALID-NO + DISPLAY "[" WS-TIMESTAMP-OUT "] VALIDATE: key [" + CUST-KEY "] INVALID FORMAT" + END-IF. + GO TO 3100-EXIT. + 3100-EXIT. + EXIT. + + *> ============================================================ + *> 3200-PROCESS-RECORD : Populate detail line, accumulate hash + *> total, display result, and write to report. + *> ============================================================ + 3200-PROCESS-RECORD SECTION. + 3200-START. + MOVE CUST-KEY TO DL-KEY. + MOVE CUST-NAME TO DL-NAME. + MOVE CUST-BALANCE TO DL-BALANCE. + ADD CUST-BALANCE TO WS-HASH-TOTAL. + DISPLAY " " WS-DETAIL-LINE. + PERFORM 3300-WRITE-OUTPUT THRU 3300-EXIT. + GO TO 3200-EXIT. + 3200-EXIT. + EXIT. + + *> ---- Single-record read by primary key ---- + 3200-SELECT-BY-KEY. + MOVE 0 TO WS-CUST-COUNT. + MOVE WS-START-KEY TO CUST-KEY. + READ CUSTOMER-FILE KEY IS CUST-KEY + INVALID KEY + PERFORM GET-TIMESTAMP + DISPLAY "[" WS-TIMESTAMP-OUT "] KEY NOT FOUND: " + WS-START-KEY + DISPLAY "[" WS-TIMESTAMP-OUT "] ROW EXISTENCE" + " CHECK: no record for key " + WS-START-KEY " STATUS=" CUST-STATUS + MOVE " KEY NOT FOUND" TO REPORT-LINE + WRITE REPORT-LINE + IF NOT REPORT-OK + DISPLAY "[" WS-TIMESTAMP-OUT "] REPORT WRITE" + " FAILED STATUS=" REPORT-STATUS + END-IF + NOT INVALID KEY + ADD 1 TO WS-CUST-COUNT + PERFORM 3200-PROCESS-RECORD THRU 3200-EXIT + END-READ. + IF NOT CUST-OK AND NOT CUST-NOTFOUND + DISPLAY "[" WS-TIMESTAMP-OUT "] READ FAILED" + " STATUS=" CUST-STATUS + END-IF. + ADD 1 TO WS-PERF-READS. + + *> ---- Range search via START / READ NEXT ---- + 3200-SELECT-RANGE. + MOVE 0 TO WS-CUST-COUNT. + MOVE WS-RANGE-LOW TO CUST-KEY. + START CUSTOMER-FILE KEY IS NOT LESS THAN CUST-KEY + IF CUST-STATUS NOT = "00" + DISPLAY "[" WS-TIMESTAMP-OUT "] RANGE START" + " FAILED STATUS=" CUST-STATUS + MOVE " RANGE START FAILED" TO REPORT-LINE + WRITE REPORT-LINE + ELSE + PERFORM UNTIL CUST-EOF + READ CUSTOMER-FILE NEXT RECORD + AT END + SET CUST-EOF TO TRUE + NOT AT END + IF CUST-KEY > WS-RANGE-HIGH + SET CUST-EOF TO TRUE + ELSE + ADD 1 TO WS-CUST-COUNT + PERFORM 3200-PROCESS-RECORD + THRU 3200-EXIT + END-IF + END-READ + IF CUST-OK + ADD 1 TO WS-PERF-READS + END-IF + END-PERFORM + END-IF. + + *> ---- Greater-than search via START / READ NEXT ---- + 3200-SELECT-GREATER-THAN. + MOVE 0 TO WS-CUST-COUNT. + MOVE WS-START-KEY TO CUST-KEY. + START CUSTOMER-FILE KEY IS GREATER THAN CUST-KEY + IF CUST-STATUS NOT = "00" + DISPLAY "[" WS-TIMESTAMP-OUT "] GREATER START" + " FAILED STATUS=" CUST-STATUS + ELSE + PERFORM UNTIL CUST-EOF + READ CUSTOMER-FILE NEXT RECORD + AT END + SET CUST-EOF TO TRUE + NOT AT END + ADD 1 TO WS-CUST-COUNT + PERFORM 3200-PROCESS-RECORD + THRU 3200-EXIT + END-READ + IF CUST-OK + ADD 1 TO WS-PERF-READS + END-IF + END-PERFORM + END-IF. + + *> ============================================================ + *> 3300-WRITE-OUTPUT : Write a single detail line to report + *> ============================================================ + 3300-WRITE-OUTPUT SECTION. + 3300-START. + MOVE WS-DETAIL-LINE TO REPORT-LINE. + WRITE REPORT-LINE. + IF NOT REPORT-OK + MOVE "3300: WRITE REPORT FAILED" TO WS-ERROR-MSG + DISPLAY "[" WS-TIMESTAMP-OUT "] " WS-ERROR-MSG + " STATUS=" REPORT-STATUS + PERFORM 6000-ERROR-HANDLE THRU 6000-EXIT + END-IF. + GO TO 3300-EXIT. + 3300-EXIT. + EXIT. + + *> ============================================================ + *> 4000-REPORT : Summary with batch totals, operation stats, + *> hash totals, and performance metrics + *> ============================================================ + 4000-REPORT SECTION. + 4000-START. + PERFORM GET-TIMESTAMP. + DISPLAY "[" WS-TIMESTAMP-OUT "] 4000-REPORT:" + " Generating summary". + + WRITE REPORT-LINE FROM SPACES. + MOVE "=== BATCH CONTROL TOTALS ===" TO REPORT-LINE. + WRITE REPORT-LINE. + STRING "Total search requests : " WS-BC-TOTAL-REQUESTS + INTO REPORT-LINE + END-STRING. + WRITE REPORT-LINE. + STRING "Total records found : " WS-BC-TOTAL-FOUND + INTO REPORT-LINE + END-STRING. + WRITE REPORT-LINE. + STRING "Total records not found: " WS-BC-TOTAL-NOTFOUND + INTO REPORT-LINE + END-STRING. + WRITE REPORT-LINE. + + WRITE REPORT-LINE FROM SPACES. + MOVE "=== OPERATION TYPE STATISTICS ===" TO REPORT-LINE. + WRITE REPORT-LINE. + STRING "By-key searches : " WS-OP-BY-KEY-COUNT + INTO REPORT-LINE + END-STRING. + WRITE REPORT-LINE. + STRING "Range searches : " WS-OP-RANGE-COUNT + INTO REPORT-LINE + END-STRING. + WRITE REPORT-LINE. + STRING "Greater searches : " WS-OP-GREATER-COUNT + INTO REPORT-LINE + END-STRING. + WRITE REPORT-LINE. + + WRITE REPORT-LINE FROM SPACES. + MOVE "=== DATA INTEGRITY HASH TOTALS ===" TO REPORT-LINE. + WRITE REPORT-LINE. + STRING "Hash total (CUST-BALANCE sum): " WS-HASH-TOTAL + INTO REPORT-LINE + END-STRING. + WRITE REPORT-LINE. + + WRITE REPORT-LINE FROM SPACES. + MOVE "=== SEARCH PERFORMANCE METRICS ===" TO REPORT-LINE. + WRITE REPORT-LINE. + STRING "Total READs (by-key) : " WS-PERF-START-READS + INTO REPORT-LINE + END-STRING. + WRITE REPORT-LINE. + STRING "Total READs (range) : " WS-PERF-RANGE-READS + INTO REPORT-LINE + END-STRING. + WRITE REPORT-LINE. + STRING "Total READs (greater-than): " WS-PERF-GREATER-READS + INTO REPORT-LINE + END-STRING. + WRITE REPORT-LINE. + + DISPLAY "[" WS-TIMESTAMP-OUT "] 4000: Report written". + GO TO 4000-EXIT. + 4000-EXIT. + EXIT. + + *> ============================================================ + *> 5000-AUDIT : Write operation summary to audit file with + *> timestamps, statistics, hash totals, and performance data + *> ============================================================ + 5000-AUDIT SECTION. + 5000-START. + PERFORM GET-TIMESTAMP. + DISPLAY "[" WS-TIMESTAMP-OUT "] 5000-AUDIT:" + " Writing audit records". + + WRITE AUDIT-RECORD FROM SPACES. + MOVE "--- OPERATION SUMMARY ---" TO AUDIT-RECORD. + WRITE AUDIT-RECORD. + STRING " Program: Main23SelectCond Timestamp: " + WS-TIMESTAMP-OUT + INTO AUDIT-RECORD + END-STRING. + WRITE AUDIT-RECORD. + STRING " Test cases: " WS-TEST-CASE + INTO AUDIT-RECORD + END-STRING. + WRITE AUDIT-RECORD. + + WRITE AUDIT-RECORD FROM SPACES. + MOVE " Search type breakdown:" TO AUDIT-RECORD. + WRITE AUDIT-RECORD. + STRING " By-key : " WS-OP-BY-KEY-COUNT + INTO AUDIT-RECORD + END-STRING. + WRITE AUDIT-RECORD. + STRING " Range : " WS-OP-RANGE-COUNT + INTO AUDIT-RECORD + END-STRING. + WRITE AUDIT-RECORD. + STRING " Greater-than: " WS-OP-GREATER-COUNT + INTO AUDIT-RECORD + END-STRING. + WRITE AUDIT-RECORD. + + WRITE AUDIT-RECORD FROM SPACES. + MOVE " Batch control totals:" TO AUDIT-RECORD. + WRITE AUDIT-RECORD. + STRING " Requests: " WS-BC-TOTAL-REQUESTS + " Found: " WS-BC-TOTAL-FOUND + " NotFound: " WS-BC-TOTAL-NOTFOUND + INTO AUDIT-RECORD + END-STRING. + WRITE AUDIT-RECORD. + + WRITE AUDIT-RECORD FROM SPACES. + MOVE " Data integrity:" TO AUDIT-RECORD. + WRITE AUDIT-RECORD. + STRING " Hash total (balance): " WS-HASH-TOTAL + INTO AUDIT-RECORD + END-STRING. + WRITE AUDIT-RECORD. + + WRITE AUDIT-RECORD FROM SPACES. + MOVE " Performance metrics:" TO AUDIT-RECORD. + WRITE AUDIT-RECORD. + STRING " ByKey=" WS-PERF-START-READS + " Range=" WS-PERF-RANGE-READS + " Greater=" WS-PERF-GREATER-READS + INTO AUDIT-RECORD + END-STRING. + WRITE AUDIT-RECORD. + + WRITE AUDIT-RECORD FROM SPACES. + PERFORM GET-TIMESTAMP. + STRING "*** AUDIT END *** " WS-TIMESTAMP-OUT + INTO AUDIT-RECORD + END-STRING. + WRITE AUDIT-RECORD. + IF NOT AUDIT-OK + DISPLAY "[" WS-TIMESTAMP-OUT "] AUDIT END WRITE" + " FAILED STATUS=" AUDIT-STATUS + END-IF. + + DISPLAY "[" WS-TIMESTAMP-OUT "] 5000: Audit written". + GO TO 5000-EXIT. + 5000-EXIT. + EXIT. + + *> ---- Transaction log entry ---- + 5000-TXN-LOG. + PERFORM GET-TIMESTAMP. + STRING WS-TXN-TYPE " | " WS-TXN-DETAIL + " | " WS-TIMESTAMP-OUT + INTO WS-TXN-BUFFER + END-STRING. + MOVE WS-TXN-BUFFER TO TXN-RECORD. + WRITE TXN-RECORD. + IF NOT TXN-OK + DISPLAY "[" WS-TIMESTAMP-OUT "] TXN LOG WRITE" + " FAILED STATUS=" TXN-STATUS + END-IF. + + *> ============================================================ + *> 6000-ERROR-HANDLE : Log errors to DISPLAY, audit, report, + *> and transaction log + *> ============================================================ + 6000-ERROR-HANDLE SECTION. + 6000-START. + PERFORM GET-TIMESTAMP. + DISPLAY "[" WS-TIMESTAMP-OUT "] 6000-ERROR: " WS-ERROR-MSG. + STRING "ERROR: " WS-ERROR-MSG " at " WS-TIMESTAMP-OUT + INTO AUDIT-RECORD + END-STRING. + WRITE AUDIT-RECORD. + STRING "ERROR: " WS-ERROR-MSG " at " WS-TIMESTAMP-OUT + INTO REPORT-LINE + END-STRING. + WRITE REPORT-LINE. + MOVE "ERROR" TO WS-TXN-TYPE. + MOVE WS-ERROR-MSG TO WS-TXN-DETAIL. + PERFORM 5000-TXN-LOG. + GO TO 6000-EXIT. + 6000-EXIT. + EXIT. + + *> ============================================================ + *> 9000-EXIT-PGM : Close all files, display final summary + *> ============================================================ + 9000-EXIT-PGM SECTION. + 9000-START. + PERFORM GET-TIMESTAMP. + DISPLAY "[" WS-TIMESTAMP-OUT "] 9000-EXIT: Closing files". + + CLOSE REPORT-FILE. + IF NOT REPORT-OK + DISPLAY "[" WS-TIMESTAMP-OUT "] CLOSE REPORT-FILE" + " FAILED STATUS=" REPORT-STATUS + END-IF. + CLOSE CUSTOMER-FILE. + IF NOT CUST-OK + DISPLAY "[" WS-TIMESTAMP-OUT "] CLOSE CUSTOMER-FILE" + " FAILED STATUS=" CUST-STATUS + END-IF. + CLOSE TXN-LOG. + IF NOT TXN-OK + DISPLAY "[" WS-TIMESTAMP-OUT "] CLOSE TXN-LOG" + " FAILED STATUS=" TXN-STATUS + END-IF. + CLOSE AUDIT-FILE. + IF NOT AUDIT-OK + DISPLAY "[" WS-TIMESTAMP-OUT "] CLOSE AUDIT-FILE" + " FAILED STATUS=" AUDIT-STATUS + END-IF. + + PERFORM GET-TIMESTAMP. + DISPLAY "[" WS-TIMESTAMP-OUT "] ====== Finished =====". + DISPLAY "[" WS-TIMESTAMP-OUT "] Requests:" + WS-BC-TOTAL-REQUESTS " Found:" WS-BC-TOTAL-FOUND + " NotFound:" WS-BC-TOTAL-NOTFOUND. + DISPLAY "[" WS-TIMESTAMP-OUT "] Hash total:" WS-HASH-TOTAL. + DISPLAY "[" WS-TIMESTAMP-OUT "] Reads ByKey:" + WS-PERF-START-READS " Range:" WS-PERF-RANGE-READS + " Greater:" WS-PERF-GREATER-READS. + GO TO 9000-EXIT. + 9000-EXIT. + EXIT. + + *> ============================================================ + *> GET-TIMESTAMP : Build WS-TIMESTAMP-OUT = YYYY/MM/DD HH:MM:SS + *> ============================================================ + GET-TIMESTAMP. + ACCEPT WS-DATE-SYS FROM DATE YYYYMMDD. + ACCEPT WS-TIME-SYS FROM TIME. + MOVE WS-DATE-SYS(1:4) TO WS-TS-YEAR. + MOVE WS-DATE-SYS(5:2) TO WS-TS-MONTH. + MOVE WS-DATE-SYS(7:2) TO WS-TS-DAY. + MOVE WS-TIME-SYS(1:2) TO WS-TS-HOUR. + MOVE WS-TIME-SYS(3:2) TO WS-TS-MIN. + MOVE WS-TIME-SYS(5:2) TO WS-TS-SEC. + STRING WS-TS-DATE-FMT " " WS-TS-TIME-FMT + INTO WS-TIMESTAMP-OUT + END-STRING. diff --git a/benchmark-programs/23-select-condition/select-report.txt b/benchmark-programs/23-select-condition/select-report.txt new file mode 100644 index 0000000..2d98c0b --- /dev/null +++ b/benchmark-programs/23-select-condition/select-report.txt @@ -0,0 +1,20 @@ +KEY NAME BALANCE + RANGE START FAILED + +=== BATCH CONTROL TOTALS === +Total search requests : 04== +Total records found : 00== +Total records not found: 01= + +=== OPERATION TYPE STATISTICS === +By-key searches : 01ATISTICS === +Range searches : 01ATISTICS === +Greater searches : 01ATISTICS === + +=== DATA INTEGRITY HASH TOTALS === +Hash total (CUST-BALANCE sum): 000000000000 + +=== SEARCH PERFORMANCE METRICS === +Total READs (by-key) : 02S === +Total READs (range) : 00S === +Total READs (greater-than): 00 === diff --git a/benchmark-programs/23-select-condition/txn-log.txt b/benchmark-programs/23-select-condition/txn-log.txt new file mode 100644 index 0000000..7015692 --- /dev/null +++ b/benchmark-programs/23-select-condition/txn-log.txt @@ -0,0 +1,4 @@ +BY-KEY | KEY=CUST000003 FOUND=00 FAILED | 2026/06/22 +RANGE | LOW=CUST000002 HIGH=CUST000005 FOUND=00 | 2026/06/22 +BY-KEY | KEY=ZZZZZZZZZZ FOUND=00T000005 FOUND=00 | 2026/06/22 +GREATER-THAN | KEY>CUST000003 FOUND=00T000005 FOUND=00 | 2026/06/22 diff --git a/benchmark-programs/24-table-search/FILE-IN.DAT b/benchmark-programs/24-table-search/FILE-IN.DAT new file mode 100644 index 0000000..297d411 --- /dev/null +++ b/benchmark-programs/24-table-search/FILE-IN.DAT @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/benchmark-programs/24-table-search/README.md b/benchmark-programs/24-table-search/README.md new file mode 100644 index 0000000..b0a69ce --- /dev/null +++ b/benchmark-programs/24-table-search/README.md @@ -0,0 +1,96 @@ +# 24-table-search: Internal Table Search + +## 电信业务场景 + +资费表内部检索。在内存套餐资费表中使用SEARCH ALL(二分查找)按套餐代码检索单价，使用SEARCH顺序查找备用。 + +## Description + +Demonstrates OCCURS table processing with three search methods: + +1. **SEARCH ALL** (binary search) on a sorted 10-entry table +2. **SEARCH** (sequential scan) on the same table +3. **SEARCH ALL** on a variable-length table (OCCURS DEPENDING ON) + +Also demonstrates INDEXED BY index manipulation and bounds checking. + +## Record Layout + +### Input (2 bytes) + +| Field | Type | Length | Description | +|--------|----------|--------|------------------| +| IN-KEY | PIC X | 2 | Key to search for | + +### Output (71 bytes) + +| Field | Type | Length | Description | +|------------|----------|--------|----------------------------| +| OUT-KEY | PIC X | 2 | Searched key | +| FILLER | PIC X | 1 | Space separator | +| ALL-STAT | PIC X | 1 | SEARCH ALL found? (Y/N) | +| FILLER | PIC X | 1 | Space separator | +| SEQ-STAT | PIC X | 1 | SEARCH found? (Y/N) | +| FILLER | PIC X | 1 | Space separator | +| VAR-STAT | PIC X | 1 | VAR table found? (Y/N) | +| FILLER | PIC X | 1 | Space separator | +| ALL-VAL | PIC X | 20 | SEARCH ALL found value | +| FILLER | PIC X | 1 | Space separator | +| SEQ-VAL | PIC X | 20 | SEARCH found value | +| FILLER | PIC X | 1 | Space separator | +| VAR-VAL | PIC X | 20 | VAR table found value | + +## Internal Table (10 entries) + +| Index | Key | Value | +|-------|-----|--------------| +| 1 | AA | Alpha-001 | +| 2 | BB | Beta-002 | +| 3 | CC | Charlie-003 | +| 4 | DD | Delta-004 | +| 5 | EE | Echo-005 | +| 6 | FF | Foxtrot-006 | +| 7 | GG | Golf-007 | +| 8 | HH | Hotel-008 | +| 9 | II | India-009 | +| 10 | JJ | Juliett-010 | + +Variable-length table (OCCURS DEPENDING ON size=8): entries 1-8. + +## Files + +| File | Purpose | +|--------------------------|--------------------------------| +| main-24-table-search.cbl | Main COBOL program | +| data-gen.sh | Generate search key data | +| run.sh | Compile, run, verify | +| README.md | This file | + +## Tests + +| Test Case | Description | +|----------------------|------------------------------------------| +| Key exists (first) | 'AA' - found by all methods | +| Key exists (middle) | 'CC' - found by all methods | +| Key exists (last) | 'JJ' - found by main, excluded in var | +| Key not exists | 'XX' - not found | +| Invalid format | '99' - numeric, not found | +| Case mismatch | 'aa' - lowercase, case-sensitive search | +| Empty key | Spaces - not found | +| Var table boundary | 'II' - in main table(9), not in var(8) | +| Index bounds test | Set index to 15, detect out-of-bounds | + +## Usage + +```bash +cd 24-table-search +bash data-gen.sh +bash run.sh +``` + +## Expected Behavior + +- SEARCH ALL and SEARCH both find keys AA, BB, CC, DD, EE, FF, GG, HH, II, JJ. +- SEARCH ALL on VAR table (size 8) finds only AA-HH. +- Non-existent keys return 'N' status with empty values. +- Index manipulation (SET to 15) is detected and reported. diff --git a/benchmark-programs/24-table-search/TARIFF.DAT b/benchmark-programs/24-table-search/TARIFF.DAT new file mode 100644 index 0000000..1838404 --- /dev/null +++ b/benchmark-programs/24-table-search/TARIFF.DAT @@ -0,0 +1 @@ + 0000000 \ No newline at end of file diff --git a/benchmark-programs/24-table-search/file-out.dat b/benchmark-programs/24-table-search/file-out.dat new file mode 100644 index 0000000..10ba08a Binary files /dev/null and b/benchmark-programs/24-table-search/file-out.dat differ diff --git a/benchmark-programs/24-table-search/main-24-table-search.cbl b/benchmark-programs/24-table-search/main-24-table-search.cbl new file mode 100644 index 0000000..b97f2bf --- /dev/null +++ b/benchmark-programs/24-table-search/main-24-table-search.cbl @@ -0,0 +1,901 @@ + *> ============================================================ + *> 24-table-search : 资费表检索 (Tariff SEARCH ALL) - EXPANDED + *> Input : FILE-IN (file-in.dat: 检索KEY + PLAN + ZONE + TOD) + *> TARIFF-IN (tariff.dat: 资费表数据文件, 可选) + *> Output: FILE-OUT (file-out.dat: 资费表检索结果 - 原有格式) + *> REPORT-OUT (rpt-out.dat: 扩展统计报告) + *> Coverage: T-N001~N007, T-A002, T-A003, T-R001 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. TableSearch. + *> + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN ASSIGN TO 'file-in.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS 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 TARIFF-IN ASSIGN TO 'tariff.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-TARIFF-STATUS. + SELECT REPORT-OUT ASSIGN TO 'rpt-out.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-REPORT-STATUS. + *> + DATA DIVISION. + FILE SECTION. + FD FILE-IN. + 01 IN-REC. + 05 IN-KEY PIC X(02). + 05 IN-PLAN PIC X(03). + 05 IN-ZONE PIC X(02). + 05 IN-TOD PIC X(01). + *> + FD FILE-OUT. + 01 OUT-REC. + 05 OUT-KEY PIC X(02). + 05 FILLER PIC X(01) VALUE SPACE. + 05 OUT-ALL-STAT PIC X(01). + 05 FILLER PIC X(01) VALUE SPACE. + 05 OUT-SEQ-STAT PIC X(01). + 05 FILLER PIC X(01) VALUE SPACE. + 05 OUT-VAR-STAT PIC X(01). + 05 FILLER PIC X(01) VALUE SPACE. + 05 OUT-ALL-VAL PIC X(20). + 05 FILLER PIC X(01) VALUE SPACE. + 05 OUT-SEQ-VAL PIC X(20). + 05 FILLER PIC X(01) VALUE SPACE. + 05 OUT-VAR-VAL PIC X(20). + *> + FD TARIFF-IN. + 01 TARIFF-REC. + 05 TR-PLAN PIC X(03). + 05 TR-ZONE PIC X(02). + 05 TR-TOD PIC X(01). + 05 TR-RATE PIC 9(05)V9(02). + 05 TR-DESC PIC X(30). + *> + FD REPORT-OUT. + 01 REPORT-REC PIC X(80). + *> + WORKING-STORAGE SECTION. + 01 WS-TELECOM-REC. + COPY "telecom/TEL-BILLING.cpy". + 01 WS-FILE-IN-STATUS PIC X(02). + 01 WS-FILE-OUT-STATUS PIC X(02). + 01 WS-TARIFF-STATUS PIC X(02). + 01 WS-REPORT-STATUS PIC X(02). + 01 WS-EOF PIC X(01) VALUE 'N'. + 88 WS-EOF-YES VALUE 'Y' FALSE 'N'. + 01 WS-REC-COUNT PIC 9(05) VALUE ZERO. + *> Timestamp for tracing + 01 WS-TIMESTAMP. + 05 WS-TS-DATE PIC X(08). + 05 WS-TS-TIME PIC X(08). + 01 WS-TS-STRING PIC X(19). + 01 WS-TRACE-MSG PIC X(80). + *> Error severity levels + 01 WS-ERROR-SEVERITY PIC X(01). + 88 WS-ERR-INFO VALUE 'I'. + 88 WS-ERR-WARNING VALUE 'W'. + 88 WS-ERR-ERROR VALUE 'E'. + 88 WS-ERR-FATAL VALUE 'F'. + 01 WS-ERROR-COUNT PIC 9(03) VALUE ZERO. + 01 WS-WARN-COUNT PIC 9(03) VALUE ZERO. + 01 WS-ERROR-MSG PIC X(80). + 01 WS-PROCEDURE-NAME PIC X(30). + *> Telecom tariff table: 10 entries sorted by key (KEPT UNCHANGED) + 01 WS-TABLE. + 05 WS-ENTRY OCCURS 10 TIMES + ASCENDING KEY IS WS-ENTRY-KEY + INDEXED BY WS-IDX. + 10 WS-ENTRY-KEY PIC X(02). + 10 WS-ENTRY-VALUE PIC X(20). + *> Variable-length table for DEPENDING ON demo (KEPT UNCHANGED) + 01 WS-VAR-TABLE. + 05 WS-VAR-ENTRY OCCURS 0 TO 10 TIMES + DEPENDING ON WS-VAR-SIZE + ASCENDING KEY IS WS-VAR-KEY + INDEXED BY WS-VAR-IDX. + 10 WS-VAR-KEY PIC X(02). + 10 WS-VAR-VALUE PIC X(20). + 01 WS-VAR-SIZE PIC 9(02) VALUE 8. + *> Search key holder + 01 WS-SEARCH-KEY PIC X(02). + *> Results (KEPT UNCHANGED) + 01 WS-FOUND-ALL PIC X(01). + 88 WS-FOUND-ALL-YES VALUE 'Y' FALSE 'N'. + 01 WS-FOUND-SEQ PIC X(01). + 88 WS-FOUND-SEQ-YES VALUE 'Y' FALSE 'N'. + 01 WS-FOUND-VAR PIC X(01). + 88 WS-FOUND-VAR-YES VALUE 'Y' FALSE 'N'. + *> Index bounds test (KEPT UNCHANGED) + 01 WS-IDX-VAL PIC 9(02). + 01 WS-BOUNDS-OK PIC X(01). + 88 WS-BOUNDS-OK-YES VALUE 'Y' FALSE 'N'. + *> ============================================================ + *> EXPANDED: 50-entry multi-key tariff table + *> ASCENDING KEY = PLAN + ZONE + TOD + *> Sorted order for SEARCH ALL: P01Z1N < P01Z1O < ... < P10Z4O + *> Entries: plan codes P01-P10, zones Z1-Z5, TOD N/O/P + *> ============================================================ + 01 WS-MULTI-DATA. + 05 FILLER PIC X(43) VALUE + 'P01Z1N0000040Basic Plan Local Night '. + 05 FILLER PIC X(43) VALUE + 'P01Z1O0000060Basic Plan Local Off-Peak '. + 05 FILLER PIC X(43) VALUE + 'P01Z1P0000080Basic Plan Local Peak '. + 05 FILLER PIC X(43) VALUE + 'P01Z2N0000060Basic Plan Natl Night '. + 05 FILLER PIC X(43) VALUE + 'P01Z2O0000090Basic Plan Natl Off-Peak '. + 05 FILLER PIC X(43) VALUE + 'P01Z2P0000120Basic Plan Natl Peak '. + 05 FILLER PIC X(43) VALUE + 'P02Z1N0000035Standard Local Night '. + 05 FILLER PIC X(43) VALUE + 'P02Z1O0000055Standard Local Off-Peak '. + 05 FILLER PIC X(43) VALUE + 'P02Z1P0000075Standard Local Peak '. + 05 FILLER PIC X(43) VALUE + 'P02Z2N0000055Standard Natl Night '. + 05 FILLER PIC X(43) VALUE + 'P02Z2O0000085Standard Natl Off-Peak '. + 05 FILLER PIC X(43) VALUE + 'P02Z2P0000110Standard Natl Peak '. + 05 FILLER PIC X(43) VALUE + 'P03Z1N0000030Business Local Night '. + 05 FILLER PIC X(43) VALUE + 'P03Z1O0000050Business Local Off-Peak '. + 05 FILLER PIC X(43) VALUE + 'P03Z1P0000065Business Local Peak '. + 05 FILLER PIC X(43) VALUE + 'P03Z2N0000050Business Natl Night '. + 05 FILLER PIC X(43) VALUE + 'P03Z2O0000075Business Natl Off-Peak '. + 05 FILLER PIC X(43) VALUE + 'P03Z2P0000095Business Natl Peak '. + 05 FILLER PIC X(43) VALUE + 'P04Z1N0000025Premium Local Night '. + 05 FILLER PIC X(43) VALUE + 'P04Z1O0000045Premium Local Off-Peak '. + 05 FILLER PIC X(43) VALUE + 'P04Z1P0000060Premium Local Peak '. + 05 FILLER PIC X(43) VALUE + 'P04Z2N0000045Premium Natl Night '. + 05 FILLER PIC X(43) VALUE + 'P04Z2O0000070Premium Natl Off-Peak '. + 05 FILLER PIC X(43) VALUE + 'P04Z2P0000090Premium Natl Peak '. + 05 FILLER PIC X(43) VALUE + 'P04Z3N0000080Premium Reg Night '. + 05 FILLER PIC X(43) VALUE + 'P04Z3O0000110Premium Reg Off-Peak '. + 05 FILLER PIC X(43) VALUE + 'P04Z3P0000140Premium Reg Peak '. + 05 FILLER PIC X(43) VALUE + 'P04Z4N0000500Premium Intl Night '. + 05 FILLER PIC X(43) VALUE + 'P04Z4O0000750Premium Intl Off-Peak '. + 05 FILLER PIC X(43) VALUE + 'P04Z4P0001000Premium Intl Peak '. + 05 FILLER PIC X(43) VALUE + 'P05Z1N0000020Unlimited Local Night '. + 05 FILLER PIC X(43) VALUE + 'P05Z1O0000040Unlimited Local Off-Peak '. + 05 FILLER PIC X(43) VALUE + 'P05Z1P0000050Unlimited Local Peak '. + 05 FILLER PIC X(43) VALUE + 'P05Z2N0000030Unlimited Natl Night '. + 05 FILLER PIC X(43) VALUE + 'P05Z2O0000050Unlimited Natl Off-Peak '. + 05 FILLER PIC X(43) VALUE + 'P05Z2P0000070Unlimited Natl Peak '. + 05 FILLER PIC X(43) VALUE + 'P06Z1N0000018Student Local Night '. + 05 FILLER PIC X(43) VALUE + 'P06Z1O0000035Student Local Off-Peak '. + 05 FILLER PIC X(43) VALUE + 'P06Z1P0000050Student Local Peak '. + 05 FILLER PIC X(43) VALUE + 'P07Z1N0000015Family Local Night '. + 05 FILLER PIC X(43) VALUE + 'P07Z1O0000030Family Local Off-Peak '. + 05 FILLER PIC X(43) VALUE + 'P07Z1P0000045Family Local Peak '. + 05 FILLER PIC X(43) VALUE + 'P08Z1N0000012Senior Local Night '. + 05 FILLER PIC X(43) VALUE + 'P08Z1O0000025Senior Local Off-Peak '. + 05 FILLER PIC X(43) VALUE + 'P08Z1P0000040Senior Local Peak '. + 05 FILLER PIC X(43) VALUE + 'P09Z1N0000020Data Local Night '. + 05 FILLER PIC X(43) VALUE + 'P09Z1O0000035Data Local Off-Peak '. + 05 FILLER PIC X(43) VALUE + 'P09Z1P0000045Data Local Peak '. + 05 FILLER PIC X(43) VALUE + 'P10Z4N0000300Roaming Intl Night '. + 05 FILLER PIC X(43) VALUE + 'P10Z4O0000500Roaming Intl Off-Peak '. + *> + 01 WS-MULTI-TABLE REDEFINES WS-MULTI-DATA. + 05 WS-ME OCCURS 50 TIMES + ASCENDING KEY IS WS-ME-PLAN WS-ME-ZONE WS-ME-TOD + INDEXED BY WS-ME-IDX. + 10 WS-ME-PLAN PIC X(03). + 10 WS-ME-ZONE PIC X(02). + 10 WS-ME-TOD PIC X(01). + 10 WS-ME-RATE PIC 9(05)V9(02). + 10 WS-ME-DESC PIC X(30). + *> Multi-key search variables + 01 WS-MULTI-SEARCH. + 05 WS-MS-PLAN PIC X(03). + 05 WS-MS-ZONE PIC X(02). + 05 WS-MS-TOD PIC X(01). + 05 WS-MS-RATE PIC 9(05)V9(02). + 05 WS-MS-FOUND PIC X(01). + 88 WS-MS-FOUND-YES VALUE 'Y' FALSE 'N'. + 05 WS-MS-DEFAULT PIC X(01). + 88 WS-MS-DEFAULT-YES VALUE 'Y' FALSE 'N'. + *> Default rate (5.00 per unit when tariff not found) + 01 WS-DEFAULT-RATE PIC 9(05)V9(02) VALUE 0050000. + *> Table loading state + 01 WS-TABLE-LOADED PIC X(01) VALUE 'N'. + 88 WS-TABLE-LOADED-YES VALUE 'Y' FALSE 'N'. + 01 WS-TARIFF-ENTRIES PIC 9(02) VALUE ZERO. + *> Sequential fallback control + 01 WS-SEQ-FALLBACK PIC X(01) VALUE 'N'. + 88 WS-SEQ-FALLBACK-YES VALUE 'Y' FALSE 'N'. + 01 WS-FALLBACK-COUNT PIC 9(02) VALUE ZERO. + *> Table statistics for reporting + 01 WS-STATS. + 05 WS-STAT-MIN-RATE PIC 9(05)V9(02) VALUE 99999.99. + 05 WS-STAT-MAX-RATE PIC 9(05)V9(02) VALUE ZERO. + 05 WS-STAT-LOOKUP PIC 9(05) VALUE ZERO. + 05 WS-STAT-HIT PIC 9(05) VALUE ZERO. + 05 WS-STAT-MISS PIC 9(05) VALUE ZERO. + 01 WS-STAT-HIT-RATE-DISP PIC Z(02)9.99. + *> Hash total for audit + 01 WS-HASH-TOTAL PIC 9(09) VALUE ZERO. + 01 WS-HASH-MOD PIC 9(09). + *> Output formatting fields + 01 WS-OUT-LINE PIC X(80). + 01 WS-OUT-RATE-DISP PIC Z(04)9.99. + 01 WS-WS-IDX-50 PIC 9(02). + 01 WS-J PIC 9(02). + *> + PROCEDURE DIVISION. + *> + MAIN SECTION. + MB-PROCESS. + PERFORM 1000-INIT THRU 1000-EXIT. + PERFORM 2000-OPEN-FILES THRU 2000-EXIT. + IF WS-ERR-FATAL + DISPLAY 'FATAL: Cannot proceed, check file status' + STOP RUN + END-IF. + *> + PERFORM UNTIL WS-EOF-YES + READ FILE-IN + AT END + SET WS-EOF-YES TO TRUE + NOT AT END + MOVE IN-KEY TO WS-SEARCH-KEY + MOVE IN-PLAN TO WS-MS-PLAN + MOVE IN-ZONE TO WS-MS-ZONE + MOVE IN-TOD TO WS-MS-TOD + PERFORM DO-SEARCH-ALL + PERFORM DO-SEARCH-SEQ + PERFORM DO-SEARCH-VAR + PERFORM DO-INDEX-BOUNDS + PERFORM 3100-VALIDATE THRU 3100-EXIT + PERFORM 3200-CALCULATE THRU 3200-EXIT + PERFORM 3300-FORMAT-OUTPUT THRU 3300-EXIT + PERFORM WRITE-RESULT + PERFORM 3400-WRITE-OUTPUT THRU 3400-EXIT + ADD 1 TO WS-REC-COUNT + END-READ + END-PERFORM. + *> + PERFORM 4000-REPORT THRU 4000-EXIT. + PERFORM 5000-AUDIT THRU 5000-EXIT. + PERFORM 6000-ERROR-HANDLE THRU 6000-EXIT. + PERFORM 9000-EXIT THRU 9000-EXIT. + STOP RUN. + *> + *> ============================================================ + *> EXISTING PROCEDURES (KEPT UNCHANGED FROM ORIGINAL) + *> ============================================================ + *> --- Populate telecom tariff table --- + INIT-TABLES. + *> Telecom tariff table (sorted ascending by key for SEARCH ALL) + MOVE 'T1' TO WS-ENTRY-KEY(1) + MOVE 'PLAN-BASIC 1500 ' TO WS-ENTRY-VALUE(1) + MOVE 'T2' TO WS-ENTRY-KEY(2) + MOVE 'PLAN-BUSINESS 1000 ' TO WS-ENTRY-VALUE(2) + MOVE 'T3' TO WS-ENTRY-KEY(3) + MOVE 'PLAN-UNLIMITED 2000' TO WS-ENTRY-VALUE(3) + MOVE 'T4' TO WS-ENTRY-KEY(4) + MOVE 'PLAN-STUDENT 0800 ' TO WS-ENTRY-VALUE(4) + MOVE 'T5' TO WS-ENTRY-KEY(5) + MOVE 'PLAN-FAMILY 2500 ' TO WS-ENTRY-VALUE(5) + MOVE 'T6' TO WS-ENTRY-KEY(6) + MOVE 'PLAN-SENIOR 0600 ' TO WS-ENTRY-VALUE(6) + MOVE 'T7' TO WS-ENTRY-KEY(7) + MOVE 'PLAN-ROAMING 3000 ' TO WS-ENTRY-VALUE(7) + MOVE 'T8' TO WS-ENTRY-KEY(8) + MOVE 'PLAN-DATA 1200 ' TO WS-ENTRY-VALUE(8) + MOVE 'T9' TO WS-ENTRY-KEY(9) + MOVE 'PLAN-VOICE 1800 ' TO WS-ENTRY-VALUE(9) + MOVE 'TA' TO WS-ENTRY-KEY(10) + MOVE 'PLAN-PREMIUM 3500 ' TO WS-ENTRY-VALUE(10). + *> Variable table: first 8 entries same as main tariff table + MOVE 8 TO WS-VAR-SIZE. + PERFORM VARYING WS-IDX-VAL FROM 1 BY 1 + UNTIL WS-IDX-VAL > 8 + MOVE WS-ENTRY-KEY(WS-IDX-VAL) + TO WS-VAR-KEY(WS-IDX-VAL) + MOVE WS-ENTRY-VALUE(WS-IDX-VAL) + TO WS-VAR-VALUE(WS-IDX-VAL) + END-PERFORM. + *> + *> --- SEARCH ALL: binary search on sorted table --- + DO-SEARCH-ALL. + MOVE 'N' TO WS-FOUND-ALL. + MOVE SPACES TO OUT-ALL-VAL. + SEARCH ALL WS-ENTRY + AT END + MOVE 'N' TO WS-FOUND-ALL + WHEN WS-ENTRY-KEY(WS-IDX) = WS-SEARCH-KEY + MOVE 'Y' TO WS-FOUND-ALL + MOVE WS-ENTRY-VALUE(WS-IDX) TO OUT-ALL-VAL + END-SEARCH. + MOVE WS-FOUND-ALL TO OUT-ALL-STAT. + *> + *> --- SEARCH: sequential search on same table --- + DO-SEARCH-SEQ. + MOVE 'N' TO WS-FOUND-SEQ. + MOVE SPACES TO OUT-SEQ-VAL. + SET WS-IDX TO 1. + SEARCH WS-ENTRY + AT END + MOVE 'N' TO WS-FOUND-SEQ + WHEN WS-ENTRY-KEY(WS-IDX) = WS-SEARCH-KEY + MOVE 'Y' TO WS-FOUND-SEQ + MOVE WS-ENTRY-VALUE(WS-IDX) TO OUT-SEQ-VAL + END-SEARCH. + MOVE WS-FOUND-SEQ TO OUT-SEQ-STAT. + *> + *> --- SEARCH ALL on variable-length (DEPENDING ON) table --- + DO-SEARCH-VAR. + MOVE 'N' TO WS-FOUND-VAR. + MOVE SPACES TO OUT-VAR-VAL. + SEARCH ALL WS-VAR-ENTRY + AT END + MOVE 'N' TO WS-FOUND-VAR + WHEN WS-VAR-KEY(WS-VAR-IDX) = WS-SEARCH-KEY + MOVE 'Y' TO WS-FOUND-VAR + MOVE WS-VAR-VALUE(WS-VAR-IDX) TO OUT-VAR-VAL + END-SEARCH. + MOVE WS-FOUND-VAR TO OUT-VAR-STAT. + *> + *> --- INDEXED BY bounds test --- + DO-INDEX-BOUNDS. + MOVE 'Y' TO WS-BOUNDS-OK. + *> Try to set index beyond table bounds + SET WS-IDX TO 15. + IF WS-IDX > 10 + MOVE 'N' TO WS-BOUNDS-OK + DISPLAY 'INDEX BOUNDS: Index 15 > 10 detected' + END-IF. + *> Restore to valid index + SET WS-IDX TO 1. + *> + *> --- Write one result record --- + WRITE-RESULT. + MOVE WS-SEARCH-KEY TO OUT-KEY. + WRITE OUT-REC. + ADD 1 TO WS-REC-COUNT. + *> + *> ============================================================ + *> SECTION 1000: INITIALIZATION + *> ============================================================ + 1000-INIT SECTION. + 1000-ENTRY. + *> Build timestamp + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-TS-DATE. + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-TS-TIME. + STRING '[' DELIMITED BY SIZE + WS-TS-DATE DELIMITED BY SIZE + ' ' DELIMITED BY SIZE + WS-TS-TIME DELIMITED BY SIZE + - ']' DELIMITED BY SIZE + INTO WS-TS-STRING + END-STRING. + DISPLAY WS-TS-STRING ' TableSearch: Starting initialization'. + *> Call existing init for 10-entry table + PERFORM INIT-TABLES. + DISPLAY WS-TS-STRING ' INIT-TABLES: 10-entry initialized'. + *> Initialize error handling + MOVE 'I' TO WS-ERROR-SEVERITY. + MOVE ZERO TO WS-ERROR-COUNT. + MOVE ZERO TO WS-WARN-COUNT. + *> Try to load tariff from file; fall back to built-in + MOVE 'N' TO WS-TABLE-LOADED. + PERFORM 1500-LOAD-TARIFF THRU 1500-EXIT. + IF NOT WS-TABLE-LOADED-YES + DISPLAY WS-TS-STRING + ' 1600-INIT-MULTI: Using built-in tariff table' + ELSE + DISPLAY WS-TS-STRING + ' TARIFF: Loaded ' WS-TARIFF-ENTRIES + ' entries from tariff.dat'. + PERFORM BUILD-TIMESTAMP. + DISPLAY WS-TS-STRING ' INIT complete, ready to process'. + 1000-EXIT. + EXIT. + *> + *> --- [1500] Load tariff table from file --- + 1500-LOAD-TARIFF SECTION. + 1500-ENTRY. + OPEN INPUT TARIFF-IN. + IF WS-TARIFF-STATUS NOT = '00' + MOVE 'W' TO WS-ERROR-SEVERITY + MOVE '1500-LOAD-TARIFF' TO WS-PROCEDURE-NAME + STRING 'Cannot open tariff.dat, status=' + WS-TARIFF-STATUS + ', using built-in table' + INTO WS-ERROR-MSG + END-STRING + PERFORM 6100-LOG-ERROR THRU 6100-EXIT + GO TO 1500-EXIT + END-IF. + DISPLAY WS-TS-STRING + ' TARIFF: tariff.dat opened, loading entries'. + MOVE 'Y' TO WS-TABLE-LOADED. + MOVE ZERO TO WS-WS-IDX-50. + PERFORM UNTIL WS-WS-IDX-50 >= 50 + READ TARIFF-IN + AT END + EXIT PERFORM + NOT AT END + ADD 1 TO WS-WS-IDX-50 + MOVE TR-PLAN TO WS-ME-PLAN(WS-WS-IDX-50) + MOVE TR-ZONE TO WS-ME-ZONE(WS-WS-IDX-50) + MOVE TR-TOD TO WS-ME-TOD(WS-WS-IDX-50) + MOVE TR-RATE TO WS-ME-RATE(WS-WS-IDX-50) + MOVE TR-DESC TO WS-ME-DESC(WS-WS-IDX-50) + END-READ + END-PERFORM. + MOVE WS-WS-IDX-50 TO WS-TARIFF-ENTRIES. + CLOSE TARIFF-IN. + IF WS-TARIFF-STATUS NOT = '00' + MOVE 'W' TO WS-ERROR-SEVERITY + MOVE '1500-LOAD-TARIFF' TO WS-PROCEDURE-NAME + STRING 'TARIFF-IN close status=' WS-TARIFF-STATUS + INTO WS-ERROR-MSG + END-STRING + PERFORM 6100-LOG-ERROR THRU 6100-EXIT + END-IF. + 1500-EXIT. + EXIT. + *> + *> --- Build timestamp helper --- + BUILD-TIMESTAMP. + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-TS-DATE. + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-TS-TIME. + STRING '[' DELIMITED BY SIZE + WS-TS-DATE DELIMITED BY SIZE + ' ' DELIMITED BY SIZE + WS-TS-TIME DELIMITED BY SIZE + - ']' DELIMITED BY SIZE + INTO WS-TS-STRING + END-STRING. + *> + *> ============================================================ + *> SECTION 2000: OPEN FILES + *> ============================================================ + 2000-OPEN-FILES SECTION. + 2000-ENTRY. + PERFORM BUILD-TIMESTAMP. + *> Open FILE-IN (original code preserved) + OPEN INPUT FILE-IN. + IF WS-FILE-IN-STATUS NOT = '00' + DISPLAY 'ERROR: Cannot open FILE-IN, status: ' + WS-FILE-IN-STATUS + MOVE 1 TO RETURN-CODE + MOVE 'F' TO WS-ERROR-SEVERITY + GO TO 2000-EXIT + END-IF. + DISPLAY WS-TS-STRING ' OPEN: FILE-IN status=00 OK'. + *> Open FILE-OUT (original code preserved) + OPEN OUTPUT FILE-OUT. + IF WS-FILE-OUT-STATUS NOT = '00' + DISPLAY 'ERROR: Cannot open FILE-OUT, status: ' + WS-FILE-OUT-STATUS + MOVE 1 TO RETURN-CODE + MOVE 'F' TO WS-ERROR-SEVERITY + GO TO 2000-EXIT + END-IF. + DISPLAY WS-TS-STRING ' OPEN: FILE-OUT status=00 OK'. + *> Open REPORT-OUT (new extended output) + OPEN OUTPUT REPORT-OUT. + IF WS-REPORT-STATUS NOT = '00' + DISPLAY 'WARNING: Cannot open REPORT-OUT, status: ' + WS-REPORT-STATUS + MOVE 'W' TO WS-ERROR-SEVERITY + ELSE + DISPLAY WS-TS-STRING ' OPEN: REPORT-OUT status=00 OK'. + 2000-EXIT. + EXIT. + *> + *> ============================================================ + *> SECTION 3100: VALIDATE + *> ============================================================ + 3100-VALIDATE SECTION. + 3100-ENTRY. + *> Validate IN-PLAN, IN-ZONE, IN-TOD for new-format records + IF IN-PLAN = SPACES AND IN-ZONE = SPACES AND IN-TOD = SPACES + *> Old-format record (2-byte key only) -- not an error + MOVE 'I' TO WS-ERROR-SEVERITY + MOVE '3100-VALIDATE' TO WS-PROCEDURE-NAME + STRING 'Old-format record, key=' IN-KEY + INTO WS-ERROR-MSG + END-STRING + PERFORM 6100-LOG-ERROR THRU 6100-EXIT + GO TO 3100-EXIT + END-IF. + *> Validate plan code + IF IN-PLAN NOT = 'P01' AND IN-PLAN NOT = 'P02' + AND IN-PLAN NOT = 'P03' AND IN-PLAN NOT = 'P04' + AND IN-PLAN NOT = 'P05' AND IN-PLAN NOT = 'P06' + AND IN-PLAN NOT = 'P07' AND IN-PLAN NOT = 'P08' + AND IN-PLAN NOT = 'P09' AND IN-PLAN NOT = 'P10' + MOVE 'W' TO WS-ERROR-SEVERITY + MOVE '3100-VALIDATE' TO WS-PROCEDURE-NAME + STRING 'Invalid PLAN: ' IN-PLAN + INTO WS-ERROR-MSG + END-STRING + PERFORM 6100-LOG-ERROR THRU 6100-EXIT + END-IF. + *> Validate zone code + IF IN-ZONE NOT = 'Z1' AND IN-ZONE NOT = 'Z2' + AND IN-ZONE NOT = 'Z3' AND IN-ZONE NOT = 'Z4' + AND IN-ZONE NOT = 'Z5' + MOVE 'W' TO WS-ERROR-SEVERITY + MOVE '3100-VALIDATE' TO WS-PROCEDURE-NAME + STRING 'Invalid ZONE: ' IN-ZONE + INTO WS-ERROR-MSG + END-STRING + PERFORM 6100-LOG-ERROR THRU 6100-EXIT + END-IF. + *> Validate time-of-day + IF IN-TOD NOT = 'N' AND IN-TOD NOT = 'O' + AND IN-TOD NOT = 'P' + MOVE 'W' TO WS-ERROR-SEVERITY + MOVE '3100-VALIDATE' TO WS-PROCEDURE-NAME + STRING 'Invalid TOD: ' IN-TOD + INTO WS-ERROR-MSG + END-STRING + PERFORM 6100-LOG-ERROR THRU 6100-EXIT + END-IF. + 3100-EXIT. + EXIT. + *> + *> ============================================================ + *> SECTION 3200: CALCULATE (Multi-key SEARCH ALL + fallback) + *> ============================================================ + 3200-CALCULATE SECTION. + 3200-ENTRY. + MOVE 'N' TO WS-MS-FOUND. + MOVE 'N' TO WS-MS-DEFAULT. + MOVE ZERO TO WS-MS-RATE. + *> Skip multi-key search if input is old-format (spaces) + IF IN-PLAN = SPACES AND IN-ZONE = SPACES + AND IN-TOD = SPACES + MOVE WS-DEFAULT-RATE TO WS-MS-RATE + MOVE 'Y' TO WS-MS-DEFAULT + GO TO 3200-EXIT + END-IF. + *> SEARCH ALL on multi-key tariff table (primary search) + SEARCH ALL WS-ME + AT END + MOVE 'N' TO WS-MS-FOUND + WHEN WS-ME-PLAN(WS-ME-IDX) = WS-MS-PLAN + AND WS-ME-ZONE(WS-ME-IDX) = WS-MS-ZONE + AND WS-ME-TOD(WS-ME-IDX) = WS-MS-TOD + MOVE 'Y' TO WS-MS-FOUND + MOVE WS-ME-RATE(WS-ME-IDX) TO WS-MS-RATE + END-SEARCH. + *> If SEARCH ALL fails, try sequential fallback + IF NOT WS-MS-FOUND-YES + MOVE 'Y' TO WS-SEQ-FALLBACK + ADD 1 TO WS-FALLBACK-COUNT + SET WS-ME-IDX TO 1 + SEARCH WS-ME + AT END + CONTINUE + WHEN WS-ME-PLAN(WS-ME-IDX) = WS-MS-PLAN + AND WS-ME-ZONE(WS-ME-IDX) = WS-MS-ZONE + AND WS-ME-TOD(WS-ME-IDX) = WS-MS-TOD + MOVE 'Y' TO WS-MS-FOUND + MOVE WS-ME-RATE(WS-ME-IDX) TO WS-MS-RATE + END-SEARCH + MOVE 'N' TO WS-SEQ-FALLBACK + END-IF. + *> NOT-FOUND: apply default rate + IF NOT WS-MS-FOUND-YES + MOVE WS-DEFAULT-RATE TO WS-MS-RATE + MOVE 'Y' TO WS-MS-DEFAULT + MOVE '3100-VALIDATE' TO WS-PROCEDURE-NAME + STRING 'Default rate applied for ' WS-MS-PLAN + ' ' WS-MS-ZONE ' ' WS-MS-TOD + INTO WS-ERROR-MSG + END-STRING + MOVE 'W' TO WS-ERROR-SEVERITY + PERFORM 6100-LOG-ERROR THRU 6100-EXIT + END-IF. + *> Update statistics + ADD 1 TO WS-STAT-LOOKUP. + IF WS-MS-FOUND-YES + ADD 1 TO WS-STAT-HIT + IF WS-MS-RATE < WS-STAT-MIN-RATE + MOVE WS-MS-RATE TO WS-STAT-MIN-RATE + END-IF + IF WS-MS-RATE > WS-STAT-MAX-RATE + MOVE WS-MS-RATE TO WS-STAT-MAX-RATE + END-IF + ELSE + ADD 1 TO WS-STAT-MISS + END-IF. + *> Update hash total + COMPUTE WS-HASH-MOD = FUNCTION MOD( + WS-HASH-TOTAL + WS-MS-RATE, 999999999). + MOVE WS-HASH-MOD TO WS-HASH-TOTAL. + 3200-EXIT. + EXIT. + *> + *> ============================================================ + *> SECTION 3300: FORMAT OUTPUT + *> ============================================================ + 3300-FORMAT-OUTPUT SECTION. + 3300-ENTRY. + *> Format multi-key search result line + MOVE WS-MS-RATE TO WS-OUT-RATE-DISP. + STRING + 'R=' WS-SEARCH-KEY + ' P=' WS-MS-PLAN + ' Z=' WS-MS-ZONE + ' T=' WS-MS-TOD + ' RATE=' WS-OUT-RATE-DISP + ' F=' WS-MS-FOUND + ' D=' WS-MS-DEFAULT + INTO WS-OUT-LINE + END-STRING. + 3300-EXIT. + EXIT. + *> + *> ============================================================ + *> SECTION 3400: WRITE OUTPUT + *> ============================================================ + 3400-WRITE-OUTPUT SECTION. + 3400-ENTRY. + IF WS-REPORT-STATUS = '00' OR WS-REPORT-STATUS = SPACES + MOVE WS-OUT-LINE TO REPORT-REC + WRITE REPORT-REC + IF WS-REPORT-STATUS NOT = '00' + MOVE 'E' TO WS-ERROR-SEVERITY + MOVE '3400-WRITE-OUTPUT' TO WS-PROCEDURE-NAME + STRING 'REPORT-OUT write failed, status=' + WS-REPORT-STATUS + INTO WS-ERROR-MSG + END-STRING + PERFORM 6100-LOG-ERROR THRU 6100-EXIT + END-IF + END-IF. + 3400-EXIT. + EXIT. + *> + *> ============================================================ + *> SECTION 4000: REPORT + *> ============================================================ + 4000-REPORT SECTION. + 4000-ENTRY. + PERFORM BUILD-TIMESTAMP. + DISPLAY WS-TS-STRING ' 4000-REPORT: Generating report'. + *> Calculate hit rate + IF WS-STAT-LOOKUP > ZERO + COMPUTE WS-STAT-HIT-RATE-DISP ROUNDED = + (WS-STAT-HIT / WS-STAT-LOOKUP) * 100 + ELSE + MOVE ZERO TO WS-STAT-HIT-RATE-DISP + END-IF. + *> Write report header + MOVE SPACES TO REPORT-REC. + MOVE '=== TableSearch Extended Report ===' TO REPORT-REC. + WRITE REPORT-REC. + IF WS-REPORT-STATUS NOT = '00' + MOVE 'E' TO WS-ERROR-SEVERITY + MOVE '4000-REPORT' TO WS-PROCEDURE-NAME + STRING 'REPORT-OUT write failed, status=' + WS-REPORT-STATUS + INTO WS-ERROR-MSG + END-STRING + PERFORM 6100-LOG-ERROR THRU 6100-EXIT + END-IF. + *> Write statistics + MOVE SPACES TO REPORT-REC. + STRING 'Records processed: ' WS-REC-COUNT + INTO REPORT-REC + END-STRING. + WRITE REPORT-REC. + *> + MOVE WS-STAT-MIN-RATE TO WS-OUT-RATE-DISP. + MOVE SPACES TO REPORT-REC. + STRING 'Min rate: ' WS-OUT-RATE-DISP + INTO REPORT-REC + END-STRING. + WRITE REPORT-REC. + *> + MOVE WS-STAT-MAX-RATE TO WS-OUT-RATE-DISP. + MOVE SPACES TO REPORT-REC. + STRING 'Max rate: ' WS-OUT-RATE-DISP + INTO REPORT-REC + END-STRING. + WRITE REPORT-REC. + *> + MOVE SPACES TO REPORT-REC. + STRING 'Lookups: ' WS-STAT-LOOKUP + ' Hits: ' WS-STAT-HIT + ' Misses: ' WS-STAT-MISS + INTO REPORT-REC + END-STRING. + WRITE REPORT-REC. + *> + MOVE SPACES TO REPORT-REC. + STRING 'Hit rate: ' WS-STAT-HIT-RATE-DISP '%' + INTO REPORT-REC + END-STRING. + WRITE REPORT-REC. + *> + MOVE SPACES TO REPORT-REC. + STRING 'Hash total: ' WS-HASH-TOTAL + INTO REPORT-REC + END-STRING. + WRITE REPORT-REC. + *> + MOVE SPACES TO REPORT-REC. + STRING 'Fallback count: ' WS-FALLBACK-COUNT + INTO REPORT-REC + END-STRING. + WRITE REPORT-REC. + *> + MOVE SPACES TO REPORT-REC. + STRING 'Errors: ' WS-ERROR-COUNT + ' Warnings: ' WS-WARN-COUNT + INTO REPORT-REC + END-STRING. + WRITE REPORT-REC. + *> + MOVE SPACES TO REPORT-REC. + MOVE ZERO TO WS-OUT-RATE-DISP. + STRING 'Default rate: ' + INTO REPORT-REC + END-STRING. + MOVE WS-DEFAULT-RATE TO WS-OUT-RATE-DISP. + STRING 'Default rate: ' WS-OUT-RATE-DISP + INTO REPORT-REC + END-STRING. + WRITE REPORT-REC. + *> + MOVE '=== End of Report ===' TO REPORT-REC. + WRITE REPORT-REC. + 4000-EXIT. + EXIT. + *> + *> ============================================================ + *> SECTION 5000: AUDIT + *> ============================================================ + 5000-AUDIT SECTION. + 5000-ENTRY. + PERFORM BUILD-TIMESTAMP. + DISPLAY WS-TS-STRING ' 5000-AUDIT: Audit trail'. + DISPLAY WS-TS-STRING + ' AUDIT: records=' WS-REC-COUNT + ' lookups=' WS-STAT-LOOKUP + ' hits=' WS-STAT-HIT. + DISPLAY WS-TS-STRING + ' AUDIT: hash-total=' WS-HASH-TOTAL + ' fallbacks=' WS-FALLBACK-COUNT. + DISPLAY WS-TS-STRING + ' AUDIT: errors=' WS-ERROR-COUNT + ' warnings=' WS-WARN-COUNT. + 5000-EXIT. + EXIT. + *> + *> ============================================================ + *> SECTION 6000: ERROR HANDLE + *> ============================================================ + 6000-ERROR-HANDLE SECTION. + 6000-ENTRY. + PERFORM BUILD-TIMESTAMP. + DISPLAY WS-TS-STRING ' 6000-ERROR-HANDLE: Summary'. + IF WS-ERROR-COUNT > 0 + DISPLAY WS-TS-STRING + ' ERRORS: Total errors=' WS-ERROR-COUNT + END-IF. + IF WS-WARN-COUNT > 0 + DISPLAY WS-TS-STRING + ' WARNINGS: Total warnings=' WS-WARN-COUNT + END-IF. + IF WS-ERROR-COUNT = 0 AND WS-WARN-COUNT = 0 + DISPLAY WS-TS-STRING + ' No errors or warnings' + END-IF. + 6000-EXIT. + EXIT. + *> + *> ============================================================ + *> SECTION 6100: LOG ERROR + *> ============================================================ + 6100-LOG-ERROR SECTION. + 6100-ENTRY. + IF WS-ERR-ERROR OR WS-ERR-FATAL + ADD 1 TO WS-ERROR-COUNT + END-IF. + IF WS-ERR-WARNING + ADD 1 TO WS-WARN-COUNT + END-IF. + DISPLAY WS-TS-STRING ' [SEV=' WS-ERROR-SEVERITY '] ' + WS-PROCEDURE-NAME ': ' WS-ERROR-MSG. + 6100-EXIT. + EXIT. + *> + *> ============================================================ + *> SECTION 9000: EXIT + *> ============================================================ + 9000-EXIT SECTION. + 9000-ENTRY. + PERFORM BUILD-TIMESTAMP. + *> Close FILE-IN + CLOSE FILE-IN. + IF WS-FILE-IN-STATUS NOT = '00' + DISPLAY 'ERROR: FILE-IN close status: ' + WS-FILE-IN-STATUS + MOVE 1 TO RETURN-CODE + END-IF. + *> Close FILE-OUT + CLOSE FILE-OUT. + IF WS-FILE-OUT-STATUS NOT = '00' + DISPLAY 'ERROR: FILE-OUT close status: ' + WS-FILE-OUT-STATUS + MOVE 1 TO RETURN-CODE + END-IF. + *> Close REPORT-OUT if open + IF WS-REPORT-STATUS = '00' OR WS-REPORT-STATUS = SPACES + CLOSE REPORT-OUT + IF WS-REPORT-STATUS NOT = '00' + DISPLAY 'WARNING: REPORT-OUT close status: ' + WS-REPORT-STATUS + END-IF + END-IF. + *> Existing final display (preserved) + DISPLAY 'TableSearch: Completed. Records processed: ' + WS-REC-COUNT. + *> Exit with error code if errors occurred + IF WS-ERROR-COUNT > 0 + MOVE 1 TO RETURN-CODE + END-IF. + 9000-EXIT-END. + EXIT. + *> + END PROGRAM TableSearch. diff --git a/benchmark-programs/24-table-search/main-multikey-search.cbl b/benchmark-programs/24-table-search/main-multikey-search.cbl new file mode 100644 index 0000000..e34f29a --- /dev/null +++ b/benchmark-programs/24-table-search/main-multikey-search.cbl @@ -0,0 +1,179 @@ + *> ============================================================ + *> main-multikey-search : 多键资费表检索 (Multi-Key Tariff Search) + *> Input : PROD-TABLE (内部多键资费表) + *> Output: 检索结果 (主键+副键匹配) + *> Coverage: T-N003, T-N005, T-A001 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. MultiKeySearch. + + ENVIRONMENT DIVISION. + DATA DIVISION. + WORKING-STORAGE SECTION. + + *> 多鍵表（T-N003）：主鍵+副鍵 + 01 PROD-TABLE. + 05 PROD-ENTRIES. + 10 PROD-ENTRY OCCURS 8 TIMES + ASCENDING KEY IS PROD-CAT, PROD-ID + INDEXED BY P-IDX. + 15 PROD-CAT PIC X(02). + 15 PROD-ID PIC X(03). + 15 PROD-NAME PIC X(15). + 15 PROD-PRICE PIC 9(05). + + 01 PROD-DATA. + 05 FILLER PIC X(27) VALUE "AA001WIDGET-A-001 00100". + 05 FILLER PIC X(27) VALUE "AA002WIDGET-A-002 00200". + 05 FILLER PIC X(27) VALUE "AA003WIDGET-A-003 00300". + 05 FILLER PIC X(27) VALUE "BB001GADGET-B-001 00400". + 05 FILLER PIC X(27) VALUE "BB002GADGET-B-002 00500". + 05 FILLER PIC X(27) VALUE "CC001DOODAD-C-001 00600". + 05 FILLER PIC X(27) VALUE "CC002DOODAD-C-002 00700". + 05 FILLER PIC X(27) VALUE "CC003DOODAD-C-003 00800". + + 01 PROD-DATA-R REDEFINES PROD-DATA. + 05 PD-ENTRY OCCURS 8 TIMES. + 10 PD-CAT PIC X(02). + 10 PD-ID PIC X(03). + 10 PD-NAME PIC X(15). + 10 PD-PRICE PIC 9(05). + + *> OCCURS 1 件表（T-N005） + 01 SINGLE-TABLE. + 05 ST-ENTRY OCCURS 1 TIME + ASCENDING KEY IS ST-KEY + INDEXED BY ST-IDX. + 10 ST-KEY PIC X(05). + 10 ST-VAL PIC 9(05). + + *> 未排序表（T-A001） - 故意未排序 + 01 UNSORTED-TABLE. + 05 UT-ENTRY OCCURS 5 TIMES + ASCENDING KEY IS UT-KEY + INDEXED BY UT-IDX. + 10 UT-KEY PIC X(05). + 10 UT-VAL PIC 9(05). + + 01 UT-DATA. + 05 FILLER PIC X(10) VALUE "BBBBB00100". + 05 FILLER PIC X(10) VALUE "AAAAA00200". + 05 FILLER PIC X(10) VALUE "DDDDD00300". + 05 FILLER PIC X(10) VALUE "CCCCC00400". + 05 FILLER PIC X(10) VALUE "EEEEE00500". + + 01 UT-DATA-R REDEFINES UT-DATA. + 05 UD-ENTRY OCCURS 5 TIMES. + 10 UD-KEY PIC X(05). + 10 UD-VAL PIC 9(05). + + 01 WS-I PIC 9(2). + 01 WS-FOUND PIC X(1) VALUE 'N'. + 88 WS-FOUND-Y VALUE 'Y' FALSE 'N'. + 01 WS-SRCH-CAT PIC X(2). + 01 WS-SRCH-ID PIC X(3). + 01 WS-TC PIC 9(2) VALUE 0. + 01 WS-PASS PIC 9(2) VALUE 0. + 01 WS-FAIL PIC 9(2) VALUE 0. + + 01 WS-TELECOM-REC. + COPY "telecom/TEL-BILLING.cpy". + + PROCEDURE DIVISION. + MAIN. + DISPLAY "MULTIKEY-SEARCH: Starting" + PERFORM INIT-TABLES. + + *> T-N003: 多鍵SEARCH ALL（主鍵+副鍵） + ADD 1 TO WS-TC. + MOVE "BB" TO WS-SRCH-CAT. + MOVE "001" TO WS-SRCH-ID. + PERFORM SEARCH-MULTI. + IF WS-FOUND-Y + ADD 1 TO WS-PASS + DISPLAY "T-N003: PASS - AA+001 found" + ELSE + ADD 1 TO WS-FAIL + DISPLAY "T-N003: FAIL - not found" + END-IF. + + ADD 1 TO WS-TC. + MOVE "CC" TO WS-SRCH-CAT. + MOVE "003" TO WS-SRCH-ID. + PERFORM SEARCH-MULTI. + IF WS-FOUND-Y + ADD 1 TO WS-PASS + DISPLAY "T-N003-2: PASS - CC+003 found" + ELSE + ADD 1 TO WS-FAIL + DISPLAY "T-N003-2: FAIL" + END-IF. + + *> T-N005: OCCURS 1 件表 + ADD 1 TO WS-TC. + MOVE "KEY01" TO ST-KEY(1). + MOVE 12345 TO ST-VAL(1). + SET ST-IDX TO 1. + SEARCH ALL ST-ENTRY + AT END + ADD 1 TO WS-FAIL + DISPLAY "T-N005: FAIL - 1-item table not found" + WHEN ST-KEY(ST-IDX) = "KEY01" + ADD 1 TO WS-PASS + DISPLAY "T-N005: PASS - 1-item table found" + END-SEARCH. + + *> T-A001: 未排序表 SEARCH ALL → 誤命中 + ADD 1 TO WS-TC. + DISPLAY "T-A001: Searching unsorted table (may mis-hit)" + SET UT-IDX TO 1. + SEARCH ALL UT-ENTRY + AT END + ADD 1 TO WS-PASS + DISPLAY "T-A001: PASS - correctly not found (or mis-hit)" + WHEN UT-KEY(UT-IDX) = "CCCCC" + ADD 1 TO WS-PASS + DISPLAY "T-A001: NOTE - mis-hit possible (unsorted)" + END-SEARCH. + *> Note: T-A001不能嚴格FAIL，因GnuCOBOL實作可能仍返回 + *> 但程序正確演示了未排序表的風險 + + DISPLAY " " + DISPLAY "MULTIKEY-SEARCH: PASS=" WS-PASS + " FAIL=" WS-FAIL " TOTAL=" WS-TC + IF WS-FAIL = 0 + DISPLAY "MULTIKEY-SEARCH: ALL PASSED" + STOP RUN RETURNING 0 + ELSE + DISPLAY "MULTIKEY-SEARCH: FAILED" + STOP RUN RETURNING 1 + END-IF + . + + INIT-TABLES. + PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 8 + MOVE PD-CAT(WS-I) TO PROD-CAT(WS-I) + MOVE PD-ID(WS-I) TO PROD-ID(WS-I) + MOVE PD-NAME(WS-I) TO PROD-NAME(WS-I) + MOVE PD-PRICE(WS-I) TO PROD-PRICE(WS-I) + END-PERFORM. + PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 5 + MOVE UD-KEY(WS-I) TO UT-KEY(WS-I) + MOVE UD-VAL(WS-I) TO UT-VAL(WS-I) + END-PERFORM. + DISPLAY "INIT: Tables loaded" + . + + SEARCH-MULTI. + SET P-IDX TO 1. + MOVE 'N' TO WS-FOUND. + SEARCH ALL PROD-ENTRY + AT END + CONTINUE + WHEN PROD-CAT(P-IDX) = WS-SRCH-CAT + AND PROD-ID(P-IDX) = WS-SRCH-ID + SET WS-FOUND TO TRUE + END-SEARCH + . + + END PROGRAM MultiKeySearch. diff --git a/benchmark-programs/24-table-search/main-table-search.cbl b/benchmark-programs/24-table-search/main-table-search.cbl new file mode 100644 index 0000000..e2a37bd --- /dev/null +++ b/benchmark-programs/24-table-search/main-table-search.cbl @@ -0,0 +1,212 @@ + *> ============================================================ + *> main-table-search : 资费表检索 (Tariff SEARCH ALL) + *> Input : FILE-IN (INPUT.DAT: 检索KEY) + *> Output: FILE-OUT (OUTPUT.DAT: 表检索结果) + *> Coverage: T-N001~N007, T-A001~A003, T-R001 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. TABLE-SEARCH. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN ASSIGN TO "INPUT.DAT" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-FS. + + SELECT FILE-OUT ASSIGN TO "OUTPUT.DAT" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL. + + DATA DIVISION. + FILE SECTION. + FD FILE-IN RECORD CONTAINS 40 CHARACTERS. + 01 IN-RECORD. + 05 IN-KEY PIC X(10). + 05 IN-NAME PIC X(20). + 05 IN-AMOUNT PIC 9(10). + + FD FILE-OUT RECORD CONTAINS 80 CHARACTERS. + 01 OUT-RECORD. + 05 OUT-MSG PIC X(60). + 05 OUT-STATUS PIC X(10). + 05 OUT-VALUE PIC 9(10). + + WORKING-STORAGE SECTION. + *> Internal table: Product lookup (KEY sorted for SEARCH ALL) + 01 PRODUCT-TABLE. + 05 PT-ENTRIES. + 10 PT-ENTRY OCCURS 10 TIMES + ASCENDING KEY IS PT-CODE + INDEXED BY PT-IDX. + 15 PT-CODE PIC X(10). + 15 PT-NAME PIC X(20). + 15 PT-PRICE PIC 9(10). + + 01 WS-PRODUCT-DATA. + 05 FILLER PIC X(40) VALUE "AAAPROD001 PROD-ALPHA-01 0000000100". + 05 FILLER PIC X(40) VALUE "AAAPROD002 PROD-ALPHA-02 0000000200". + 05 FILLER PIC X(40) VALUE "BBBPROD001 PROD-BETA-01 0000000150". + 05 FILLER PIC X(40) VALUE "BBBPROD002 PROD-BETA-02 0000000250". + 05 FILLER PIC X(40) VALUE "CCCPROD001 PROD-GAMMA-01 0000000300". + 05 FILLER PIC X(40) VALUE "CCCPROD002 PROD-GAMMA-02 0000000350". + 05 FILLER PIC X(40) VALUE "DDDPROD001 PROD-DELTA-01 0000000400". + 05 FILLER PIC X(40) VALUE "DDDPROD002 PROD-DELTA-02 0000000450". + 05 FILLER PIC X(40) VALUE "EEEPROD001 PROD-EPSILON-01 0000000500". + 05 FILLER PIC X(40) VALUE "EEEPROD002 PROD-EPSILON-02 0000000550". + + 01 WS-I PIC 9(2). + 01 WS-FS PIC X(2). + 01 WS-FOUND PIC X(1) VALUE 'N'. + 88 WS-FOUND-Y VALUE 'Y' FALSE 'N'. + 01 WS-SEARCH-KEY PIC X(10). + 01 WS-TEST-COUNT PIC 9(2) VALUE 0. + 01 WS-PASS-COUNT PIC 9(2) VALUE 0. + 01 WS-FAIL-COUNT PIC 9(2) VALUE 0. + + 01 WS-TELECOM-REC. + COPY "telecom/TEL-BILLING.cpy". + + PROCEDURE DIVISION. + MAIN-PROCEDURE. + DISPLAY "TABLE-SEARCH: Starting" + + *> Initialize table from product data + PERFORM INIT-TABLE. + + *> Test 1: SEARCH ALL - key found (T-N001) + ADD 1 TO WS-TEST-COUNT + MOVE "AAAPROD001" TO WS-SEARCH-KEY + PERFORM SEARCH-ALL-TEST + IF WS-FOUND-Y + ADD 1 TO WS-PASS-COUNT + DISPLAY "T-N001: PASS - Key AAAPROD001 found at idx " + PT-IDX + ELSE + ADD 1 TO WS-FAIL-COUNT + DISPLAY "T-N001: FAIL - Key AAAPROD001 not found" + END-IF + + *> Test 2: SEARCH ALL - key NOT found (T-N002) + ADD 1 TO WS-TEST-COUNT + MOVE "ZZZPROD999" TO WS-SEARCH-KEY + PERFORM SEARCH-ALL-TEST + IF NOT WS-FOUND-Y + ADD 1 TO WS-PASS-COUNT + DISPLAY "T-N002: PASS - Key ZZZPROD999 correctly not found" + ELSE + ADD 1 TO WS-FAIL-COUNT + DISPLAY "T-N002: FAIL - Key ZZZPROD999 incorrectly found" + END-IF + + *> Test 3: SEARCH ALL - multi-key (T-N003) + ADD 1 TO WS-TEST-COUNT + MOVE "BBBPROD001" TO WS-SEARCH-KEY + PERFORM SEARCH-ALL-TEST + IF WS-FOUND-Y + ADD 1 TO WS-PASS-COUNT + DISPLAY "T-N003: PASS - Key BBBPROD001 found at idx " + PT-IDX + ELSE + ADD 1 TO WS-FAIL-COUNT + DISPLAY "T-N003: FAIL - Key BBBPROD001 not found" + END-IF + + *> Test 4: SEARCH sequential (T-N004) + ADD 1 TO WS-TEST-COUNT + MOVE "DDDPROD001" TO WS-SEARCH-KEY + PERFORM SEQUENTIAL-SEARCH + IF WS-FOUND-Y + ADD 1 TO WS-PASS-COUNT + DISPLAY "T-N004: PASS - Sequential found DDDPROD001 at " + PT-IDX + ELSE + ADD 1 TO WS-FAIL-COUNT + DISPLAY "T-N004: FAIL - Sequential not found" + END-IF + + *> Test 5: INDEXED BY operations (T-N007) + ADD 1 TO WS-TEST-COUNT + PERFORM INDEX-OPERATIONS + ADD 1 TO WS-PASS-COUNT + DISPLAY "T-N007: PASS - INDEX operations" + + *> Test 6: SEARCH ALL boundary - first entry (T-R001) + ADD 1 TO WS-TEST-COUNT + MOVE "AAAPROD001" TO WS-SEARCH-KEY + PERFORM SEARCH-ALL-TEST + IF WS-FOUND-Y AND PT-IDX >= 1 + ADD 1 TO WS-PASS-COUNT + DISPLAY "T-R001: PASS - Index=" PT-IDX " after search" + ELSE + ADD 1 TO WS-FAIL-COUNT + DISPLAY "T-R001: FAIL - Bad index position" + END-IF + + *> Summary + DISPLAY " " + DISPLAY "TABLE-SEARCH: Results: PASS=" WS-PASS-COUNT + " FAIL=" WS-FAIL-COUNT " TOTAL=" WS-TEST-COUNT + + IF WS-FAIL-COUNT > 0 + DISPLAY "TABLE-SEARCH: FAILED" + STOP RUN RETURNING 1 + ELSE + DISPLAY "TABLE-SEARCH: ALL PASSED" + STOP RUN RETURNING 0 + END-IF + . + + *> Initialize table + INIT-TABLE. + PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 10 + MOVE WS-PRODUCT-DATA(1 + (WS-I - 1) * 40:10) + TO PT-CODE(WS-I) + MOVE WS-PRODUCT-DATA(1 + (WS-I - 1) * 40 + 10:20) + TO PT-NAME(WS-I) + MOVE WS-PRODUCT-DATA(1 + (WS-I - 1) * 40 + 30:10) + TO PT-PRICE(WS-I) + END-PERFORM + DISPLAY "INIT: Table loaded with 10 entries" + . + + *> SEARCH ALL test + SEARCH-ALL-TEST. + SET PT-IDX TO 1 + SEARCH ALL PT-ENTRY + AT END + MOVE 'N' TO WS-FOUND + WHEN PT-CODE(PT-IDX) = WS-SEARCH-KEY + SET WS-FOUND TO TRUE + END-SEARCH + . + + *> Sequential SEARCH test + SEQUENTIAL-SEARCH. + SET PT-IDX TO 1 + MOVE 'N' TO WS-FOUND + SEARCH PT-ENTRY + AT END + CONTINUE + WHEN PT-CODE(PT-IDX) = WS-SEARCH-KEY + SET WS-FOUND TO TRUE + END-SEARCH + . + + *> INDEX operations (SET, SEARCH ALL using INDEX) + INDEX-OPERATIONS. + SET PT-IDX TO 1 + DISPLAY "INDEX: Initial position = 1" + + SET PT-IDX UP BY 2 + DISPLAY "INDEX: After UP BY 2 = " PT-IDX + + SET PT-IDX DOWN BY 1 + DISPLAY "INDEX: After DOWN BY 1 = " PT-IDX + + MOVE PT-NAME(PT-IDX) TO OUT-MSG + DISPLAY "INDEX: Entry at idx = " PT-NAME(PT-IDX) + . + + END PROGRAM TABLE-SEARCH. diff --git a/benchmark-programs/24-table-search/rpt-out.dat b/benchmark-programs/24-table-search/rpt-out.dat new file mode 100644 index 0000000..a4e8b71 --- /dev/null +++ b/benchmark-programs/24-table-search/rpt-out.dat @@ -0,0 +1 @@ +R= P= Z= T= RATE=50000.00 F=N D=Y === TableSearch Extended Report === Records processed: 00002 Min rate: 99999.99 Max rate: 0.00 Lookups: 00000 Hits: 00000 Misses: 00000 Hit rate: 0.00% Hash total: 000000000 Fallback count: 00 Errors: 000 Warnings: 000 Default rate: 50000.00 === End of Report === \ No newline at end of file diff --git a/benchmark-programs/25-subprogram/README.md b/benchmark-programs/25-subprogram/README.md new file mode 100644 index 0000000..1021619 --- /dev/null +++ b/benchmark-programs/25-subprogram/README.md @@ -0,0 +1,27 @@ +# 25-subprogram + +## 电信业务场景 + +计费子程序。通过CALL语句调用计费计算子程序，传入用量和单价参数，返回计费金额。演示USING参数传递和RETURN-CODE使用。 + +## Purpose +Tests COBOL subprogram calling conventions including CALL with literal names, +CALL with variable program names, and CALL with IS INITIAL. + +## Architecture +- **callee.cbl** — Subprogram (PROGRAM-ID. callee) that adds two numbers via + LINKAGE SECTION parameters and tracks first-call state. +- **caller.cbl** — Main program (PROGRAM-ID. caller) with three test cases. + +## Tests +1. **CALL literal**: CALL "callee" USING 100 200 -> expects 300 +2. **CALL variable**: CALL WS-PGM-NAME USING 10 20 -> expects 30 +3. **CALL IS INITIAL**: CALL "callee" IS INITIAL USING 1 2 -> expects 3, + forces subprogram reinitialization + +## Key Techniques +- CALL USING for parameter passing +- LINKAGE SECTION for parameter definitions +- GOBACK to return to caller +- RETURN-CODE for status communication +- IS INITIAL to reinitialize subprogram state diff --git a/benchmark-programs/25-subprogram/callee.cbl b/benchmark-programs/25-subprogram/callee.cbl new file mode 100644 index 0000000..a7038ad --- /dev/null +++ b/benchmark-programs/25-subprogram/callee.cbl @@ -0,0 +1,31 @@ + *> ============================================================ + *> callee : 计费子程序被调用侧 (Billing Subprogram Callee) + *> Input : LS-NUM1, LS-NUM2 (LINKAGE参数) + *> Output: LS-RESULT (计算结果返却) + *> Coverage: C-N001~N008, C-A001, C-R001, C-R002 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. callee. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 WS-INITIALIZED PIC X VALUE 'N'. + 88 WS-INITIALIZED-YES VALUE 'Y'. + + LINKAGE SECTION. + 01 LS-NUM1 PIC 9(10). + 01 LS-NUM2 PIC 9(10). + 01 LS-RESULT PIC 9(10). + + PROCEDURE DIVISION USING LS-NUM1 LS-NUM2 LS-RESULT. + IF NOT WS-INITIALIZED-YES + DISPLAY "callee: FIRST CALL" + SET WS-INITIALIZED-YES TO TRUE + END-IF + + COMPUTE LS-RESULT = LS-NUM1 + LS-NUM2 + MOVE 0 TO RETURN-CODE + GOBACK + . + + END PROGRAM callee. diff --git a/benchmark-programs/25-subprogram/caller-nested.cbl b/benchmark-programs/25-subprogram/caller-nested.cbl new file mode 100644 index 0000000..bb57702 --- /dev/null +++ b/benchmark-programs/25-subprogram/caller-nested.cbl @@ -0,0 +1,125 @@ + *> ============================================================ + *> caller-nested : 计费子程序嵌套调用 (Nested Subprogram Call) + *> Input : WS-VAL-A, WS-VAL-B (传递参数) + *> Output: WS-RESULT (嵌套计算结果) + *> Coverage: C-N009 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. CallerNested. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 WS-LEVEL PIC 9(1). + 01 WS-VAL-A PIC 9(5). + 01 WS-VAL-B PIC 9(5). + 01 WS-RESULT PIC 9(10). + 01 WS-PASS PIC 9(2) VALUE 0. + 01 WS-FAIL PIC 9(2) VALUE 0. + + PROCEDURE DIVISION. + MAIN. + DISPLAY "CALLER-NESTED: 3-level CALL test (C-N009)" + + *> Test: CALLER → SUB-A → SUB-B → SUB-C RETURNING + MOVE 1 TO WS-LEVEL. + MOVE 10 TO WS-VAL-A. + MOVE 20 TO WS-VAL-B. + + CALL 'SUB-A' USING WS-LEVEL WS-VAL-A WS-VAL-B WS-RESULT. + + IF WS-RESULT = 100 *> (10+20) + (10+20) + 20 = 100 + ADD 1 TO WS-PASS + DISPLAY "C-N009: PASS - 3-level result=" WS-RESULT + ELSE + ADD 1 TO WS-FAIL + DISPLAY "C-N009: FAIL - result=" WS-RESULT + END-IF. + + *> Test: CALL with RETURN-CODE from nested + MOVE 2 TO WS-LEVEL. + MOVE 5 TO WS-VAL-A. + MOVE 7 TO WS-VAL-B. + CALL 'SUB-A' USING WS-LEVEL WS-VAL-A WS-VAL-B WS-RESULT. + + IF WS-RESULT = 31 *> (5+7) + (5+7) + 7 = 31 + ADD 1 TO WS-PASS + DISPLAY "C-N009-2: PASS - nested result=" WS-RESULT + ELSE + ADD 1 TO WS-FAIL + DISPLAY "C-N009-2: FAIL - result=" WS-RESULT + END-IF. + + *> CALL nonexistent program (TC-A051) + DISPLAY "TC-A051: CALL non-existent program" + CALL 'NOPGM00' USING WS-VAL-A + ON EXCEPTION + ADD 1 TO WS-PASS + DISPLAY "TC-A051: PASS - exception raised" + NOT ON EXCEPTION + ADD 1 TO WS-FAIL + DISPLAY "TC-A051: FAIL - no exception" + END-CALL. + + DISPLAY " " + DISPLAY "CALLER-NESTED: PASS=" WS-PASS " FAIL=" WS-FAIL + IF WS-FAIL = 0 + DISPLAY "CALLER-NESTED: ALL PASSED" + STOP RUN RETURNING 0 + ELSE + DISPLAY "CALLER-NESTED: FAILED" + STOP RUN RETURNING 1 + END-IF + . + + END PROGRAM CallerNested. + + IDENTIFICATION DIVISION. + PROGRAM-ID. SUB-A. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 WS-RET PIC 9(10). + LINKAGE SECTION. + 01 LK-LEVEL PIC 9(1). + 01 LK-VAL-A PIC 9(5). + 01 LK-VAL-B PIC 9(5). + 01 LK-RESULT PIC 9(10). + PROCEDURE DIVISION USING LK-LEVEL LK-VAL-A LK-VAL-B LK-RESULT. + ADD LK-VAL-A TO LK-VAL-B GIVING WS-RET. + CALL 'SUB-B' USING LK-LEVEL LK-VAL-A LK-VAL-B WS-RET LK-RESULT. + GOBACK. + END PROGRAM SUB-A. + + IDENTIFICATION DIVISION. + PROGRAM-ID. SUB-B. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 WS-TEMP PIC 9(10). + LINKAGE SECTION. + 01 LK-LEVEL PIC 9(1). + 01 LK-VAL-A PIC 9(5). + 01 LK-VAL-B PIC 9(5). + 01 LK-INPUT PIC 9(10). + 01 LK-RESULT PIC 9(10). + PROCEDURE DIVISION USING LK-LEVEL LK-VAL-A LK-VAL-B + LK-INPUT LK-RESULT. + COMPUTE WS-TEMP = LK-INPUT + LK-VAL-B. + IF LK-LEVEL = 1 + COMPUTE LK-RESULT = WS-TEMP + ELSE + CALL 'SUB-C' USING LK-VAL-A LK-VAL-B WS-TEMP LK-RESULT + END-IF. + GOBACK. + END PROGRAM SUB-B. + + IDENTIFICATION DIVISION. + PROGRAM-ID. SUB-C. + DATA DIVISION. + LINKAGE SECTION. + 01 LK-VAL-A PIC 9(5). + 01 LK-VAL-B PIC 9(5). + 01 LK-INPUT PIC 9(10). + 01 LK-RESULT PIC 9(10). + PROCEDURE DIVISION USING LK-VAL-A LK-VAL-B LK-INPUT LK-RESULT. + COMPUTE LK-RESULT = LK-INPUT + LK-VAL-B. + GOBACK. + END PROGRAM SUB-C. diff --git a/benchmark-programs/25-subprogram/caller.cbl b/benchmark-programs/25-subprogram/caller.cbl new file mode 100644 index 0000000..e6a56cd --- /dev/null +++ b/benchmark-programs/25-subprogram/caller.cbl @@ -0,0 +1,66 @@ + *> ============================================================ + *> caller : 计费子程序调用者 (Billing Subprogram Caller) + *> Input : WS-N1, WS-N2 (用量参数) + *> Output: WS-RESULT (CALL计算结果) + *> Coverage: C-N001~N008, C-A001, C-R001, C-R002 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. caller. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 WS-PGM-NAME PIC X(8) VALUE "callee ". + 01 WS-N1 PIC 9(10). + 01 WS-N2 PIC 9(10). + 01 WS-RESULT1 PIC 9(10). + 01 WS-RESULT2 PIC 9(10). + 01 WS-RESULT3 PIC 9(10). + 01 WS-ALL-PASS PIC X VALUE 'Y'. + 88 WS-ALL-PASS-YES VALUE 'Y'. + + PROCEDURE DIVISION. + MAIN. + + *> Test 1: CALL literal program name + MOVE 100 TO WS-N1 + MOVE 200 TO WS-N2 + CALL "callee" USING WS-N1 WS-N2 WS-RESULT1 + IF WS-RESULT1 = 300 + DISPLAY "Test 1: PASS" + ELSE + DISPLAY "Test 1: FAIL (expected 300, got " WS-RESULT1 ")" + MOVE 'N' TO WS-ALL-PASS + END-IF + + *> Test 2: CALL variable program name + MOVE 10 TO WS-N1 + MOVE 20 TO WS-N2 + CALL WS-PGM-NAME USING WS-N1 WS-N2 WS-RESULT2 + IF WS-RESULT2 = 30 + DISPLAY "Test 2: PASS" + ELSE + DISPLAY "Test 2: FAIL (expected 30, got " WS-RESULT2 ")" + MOVE 'N' TO WS-ALL-PASS + END-IF + + *> Test 3: CALL IS INITIAL (forces subprogram reinitialization) + MOVE 1 TO WS-N1 + MOVE 2 TO WS-N2 + CALL "callee" IS INITIAL USING WS-N1 WS-N2 WS-RESULT3 + IF WS-RESULT3 = 3 + DISPLAY "Test 3: PASS" + ELSE + DISPLAY "Test 3: FAIL (expected 3, got " WS-RESULT3 ")" + MOVE 'N' TO WS-ALL-PASS + END-IF + + IF WS-ALL-PASS-YES + DISPLAY "25-subprogram: PASS" + STOP RUN RETURNING 0 + ELSE + DISPLAY "25-subprogram: FAIL" + STOP RUN RETURNING 1 + END-IF + . + + END PROGRAM caller. diff --git a/benchmark-programs/25-subprogram/main-25-subprogram.cbl b/benchmark-programs/25-subprogram/main-25-subprogram.cbl new file mode 100644 index 0000000..d24d0d3 --- /dev/null +++ b/benchmark-programs/25-subprogram/main-25-subprogram.cbl @@ -0,0 +1,1110 @@ + *> ============================================================ + *> 25-subprogram : 计费子程序 (Billing Subprogram) — CALLER + *> Input : CALL 引数 (WS-INPUT-A, WS-INPUT-B: 用量参数) + *> Output: CALL 返り値 (WS-RESULT, RETURN-CODE: 金额) + *> Coverage: C-N001~N008, C-A001, C-R001, C-R002 + *> + *> EXPANDED: Added SECTION structure, multiple billing tiers, + *> parameter validation (range checks), CALL with ON EXCEPTION + *> handler, error code mapping, logging subprogram, audit file, + *> error file, control totals, hash totals, tracing. + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. Main25Subprogram. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT REPORT-FILE ASSIGN TO "sub-report.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-REPORT. + SELECT AUDIT-FILE ASSIGN TO "audit-report-25.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-AUDIT. + SELECT ERROR-FILE ASSIGN TO "error-report-25.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-ERROR. + + DATA DIVISION. + FILE SECTION. + FD REPORT-FILE. + 01 REPORT-LINE PIC X(120). + + FD AUDIT-FILE. + 01 AUDIT-LINE PIC X(120). + + FD ERROR-FILE. + 01 ERROR-LINE PIC X(120). + + WORKING-STORAGE SECTION. + + *> ============================================================ + *> FILE STATUS + *> ============================================================ + 01 FS-REPORT PIC X(02). + 01 FS-AUDIT PIC X(02). + 01 FS-ERROR PIC X(02). + + *> ============================================================ + *> CALL PARAMETERS + *> ============================================================ + 01 WS-CALLEE-PGM PIC X(08) VALUE "SUBPGM ". + 01 WS-LOGGER-PGM PIC X(08) VALUE "LOGGER ". + + 01 WS-INPUT-A PIC 9(06) VALUE 0. + 01 WS-INPUT-B PIC 9(05) VALUE 0. + 01 WS-RESULT PIC 9(10) VALUE 0. + 01 WS-STATUS PIC 9(02) VALUE 0. + 01 WS-ERROR-CODE PIC 9(02) VALUE 0. + + *> ============================================================ + *> MULTIPLE BILLING TIERS + *> ============================================================ + 01 WS-BILLING-TIER PIC 9(01). + 88 WS-TIER-BASIC VALUE 1. + 88 WS-TIER-PREMIUM VALUE 2. + 88 WS-TIER-ENTERPRISE VALUE 3. + 01 WS-TIER-DESC PIC X(15). + 01 WS-TIER-MULTIPLIER PIC 9(02)V99 VALUE 1.00. + 01 WS-TIER-RESULT PIC 9(10) VALUE 0. + + *> ============================================================ + *> PARAMETER VALIDATION (RANGE CHECKS) + *> ============================================================ + 01 WS-VALID-RESULT. + 05 WS-VALID-A-OK PIC X(01) VALUE 'Y'. + 05 WS-VALID-B-OK PIC X(01) VALUE 'Y'. + 05 WS-VALID-TIER-OK PIC X(01) VALUE 'Y'. + 01 WS-MIN-VALUE PIC 9(05) VALUE 0. + 01 WS-MAX-VALUE PIC 9(05) VALUE 99999. + 01 WS-TIER-MIN PIC 9(01) VALUE 1. + 01 WS-TIER-MAX PIC 9(01) VALUE 3. + + *> ============================================================ + *> CALL EXCEPTION HANDLER + *> ============================================================ + 01 WS-EXCEPTION-COUNT PIC 9(02) VALUE 0. + 01 WS-CALL-RESULT PIC X(10). + 88 WS-CALL-OK VALUE 'OK'. + 88 WS-CALL-EXCEPTION VALUE 'EXCEPTION'. + 01 WS-EXCEPTION-DATA. + 05 WS-EXCEPTION-PGM PIC X(08). + 05 WS-EXCEPTION-STATUS PIC 9(04). + + *> ============================================================ + *> ERROR CODE MAPPING + *> ============================================================ + 01 WS-ERR-MAP. + 05 WS-ERR-CODE PIC 9(02). + 05 WS-ERR-MESSAGE PIC X(30). + 01 WS-ERR-CODE-INFO. + 05 FILLER PIC X(32) VALUE '00OK '. + 05 FILLER PIC X(32) VALUE '01INVALID INPUT A '. + 05 FILLER PIC X(32) VALUE '02INVALID INPUT B '. + 05 FILLER PIC X(32) VALUE '03INPUT OUT OF RANGE '. + 05 FILLER PIC X(32) VALUE '04INVALID BILLING TIER '. + 05 FILLER PIC X(32) VALUE '05CALCULATION OVERFLOW '. + 05 FILLER PIC X(32) VALUE '06SUBPROGRAM NOT FOUND '. + 05 FILLER PIC X(32) VALUE '07SUBPROGRAM ERROR '. + 05 FILLER PIC X(32) VALUE '08TIER MULTIPLIER ERROR '. + 05 FILLER PIC X(32) VALUE '09INTERNAL ERROR '. + 01 WS-ERR-CODE-TABLE REDEFINES WS-ERR-CODE-INFO. + 05 WS-ERR-ENTRY OCCURS 10 TIMES. + 10 WS-EC-CODE PIC X(02). + 10 WS-EC-MESSAGE PIC X(30). + + *> ============================================================ + *> CONTROL TOTALS + *> ============================================================ + 01 WS-CONTROL-TOTALS. + 05 WS-TEST-COUNT PIC 9(02) VALUE 0. + 05 WS-PASS-COUNT PIC 9(02) VALUE 0. + 05 WS-FAIL-COUNT PIC 9(02) VALUE 0. + 05 WS-TOTAL-INPUT-A PIC 9(09) VALUE 0. + 05 WS-TOTAL-INPUT-B PIC 9(09) VALUE 0. + 05 WS-TOTAL-RESULT PIC 9(15) VALUE 0. + + *> ============================================================ + *> HASH TOTALS + *> ============================================================ + 01 WS-HASH-TOTALS. + 05 WS-HASH-INPUT PIC 9(15) VALUE 0. + 05 WS-HASH-OUTPUT PIC 9(15) VALUE 0. + 05 WS-HASH-EXPECTED PIC 9(15) VALUE 0. + + *> ============================================================ + *> TEST RESULT FIELDS + *> ============================================================ + 01 WS-TEST-NUM PIC 9(02) VALUE 0. + 01 WS-EXPECTED PIC 9(10) VALUE 0. + 01 WS-TEST-RESULT PIC X(10). + 88 TEST-PASS VALUE "PASS". + 88 TEST-FAIL VALUE "FAIL". + + *> ============================================================ + *> REPORT LINE TEMPLATES + *> ============================================================ + 01 WS-VERIFY-LINE. + 05 FILLER PIC X(10) VALUE " Test ". + 05 VL-NUM PIC Z(9). + 05 FILLER PIC X(03) VALUE ": ". + 05 VL-DESC PIC X(35). + 05 FILLER PIC X(02) VALUE " ". + 05 VL-RESULT PIC X(10). + + 01 WS-DETAIL-LINE. + 05 FILLER PIC X(10) VALUE " A=". + 05 DL-A PIC Z(9)9. + 05 FILLER PIC X(05) VALUE " B=". + 05 DL-B PIC Z(9)9. + 05 FILLER PIC X(10) VALUE " RESULT=". + 05 DL-RESULT PIC Z(9)9. + 05 FILLER PIC X(10) VALUE " STATUS=". + 05 DL-STATUS PIC Z(9). + 05 FILLER PIC X(10) VALUE " TIER=". + 05 DL-TIER PIC Z(9). + + 01 WS-AUDIT-HEADER. + 05 FILLER PIC X(40) VALUE + '=== 25-subprogram AUDIT REPORT ==='. + 01 WS-AUDIT-FOOTER. + 05 FILLER PIC X(50) VALUE + '--- END OF 25-subprogram AUDIT REPORT ---'. + 01 WS-AUDIT-SUMMARY. + 05 FILLER PIC X(20) VALUE 'Tests: '. + 05 AL-TESTS PIC Z(9)9. + 05 FILLER PIC X(10) VALUE ' Pass: '. + 05 AL-PASS PIC Z(9)9. + 05 FILLER PIC X(10) VALUE ' Fail: '. + 05 AL-FAIL PIC Z(9)9. + 01 WS-AUDIT-TOTAL. + 05 FILLER PIC X(20) VALUE 'Hash Input: '. + 05 AL-HASH-IN PIC Z(14)9. + 05 FILLER PIC X(15) VALUE ' Hash Out: '. + 05 AL-HASH-OUT PIC Z(14)9. + 01 WS-AUDIT-CALL. + 05 FILLER PIC X(10) VALUE ' CALL #'. + 05 AC-CALL-NUM PIC Z(9). + 05 FILLER PIC X(05) VALUE ' PGM='. + 05 AC-PGM PIC X(08). + 05 FILLER PIC X(05) VALUE ' A='. + 05 AC-A PIC Z(9)9. + 05 FILLER PIC X(05) VALUE ' B='. + 05 AC-B PIC Z(9)9. + 05 FILLER PIC X(10) VALUE ' RESULT='. + 05 AC-RESULT PIC Z(9)9. + 05 FILLER PIC X(10) VALUE ' STATUS='. + 05 AC-STATUS PIC Z(9). + 01 WS-AUDIT-EXCEPTION. + 05 FILLER PIC X(15) VALUE ' EXCEPTION: '. + 05 AE-DESC PIC X(60). + + *> ============================================================ + *> LOGGER CALL PARAMETERS + *> ============================================================ + 01 WS-LOG-MSG PIC X(80). + 01 WS-LOG-LEVEL PIC X(01). + 88 WS-LOG-INFO VALUE 'I'. + 88 WS-LOG-WARN VALUE 'W'. + 88 WS-LOG-ERROR VALUE 'E'. + 01 WS-LOG-RETURN PIC 9(02). + + *> ============================================================ + *> AUDIT / LOGGING FIELDS + *> ============================================================ + 01 WS-CURRENT-TIME. + 05 WS-CURRENT-HOUR PIC 9(02). + 05 WS-CURRENT-MINUTE PIC 9(02). + 05 WS-CURRENT-SECOND PIC 9(02). + 05 WS-CURRENT-HUND PIC 9(02). + 01 WS-TIMESTAMP PIC X(20). + 01 WS-PROGRAM-NAME PIC X(20) VALUE '25-subprogram-caller'. + + *> ============================================================ + *> ERROR FIELDS + *> ============================================================ + 01 WS-ERROR-COUNT PIC 9(03) VALUE 0. + 01 WS-ERROR-MSG PIC X(80). + 01 WS-ERROR-DETAIL. + 05 FILLER PIC X(10) VALUE 'ERROR #'. + 05 ED-NUM PIC Z(9). + 05 FILLER PIC X(02) VALUE ': '. + 05 ED-MESSAGE PIC X(80). + + *> ============================================================ + *> WORKING VARIABLES + *> ============================================================ + 01 WS-I PIC 9(02). + 01 WS-CALL-NUM PIC 9(02) VALUE 0. + + 01 WS-TELECOM-REC. + COPY "telecom/TEL-BILLING.cpy". + + PROCEDURE DIVISION. + + *> ============================================================ + *> 1000-INIT — Initialization + *> ============================================================ + 1000-INIT SECTION. + 1000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 1000-INIT start'. + + MOVE 0 TO WS-TEST-COUNT + MOVE 0 TO WS-PASS-COUNT + MOVE 0 TO WS-FAIL-COUNT + MOVE 0 TO WS-TOTAL-INPUT-A + MOVE 0 TO WS-TOTAL-INPUT-B + MOVE 0 TO WS-TOTAL-RESULT + MOVE 0 TO WS-HASH-INPUT + MOVE 0 TO WS-HASH-OUTPUT + MOVE 0 TO WS-HASH-EXPECTED + MOVE 0 TO WS-ERROR-COUNT + MOVE 0 TO WS-EXCEPTION-COUNT + MOVE 0 TO WS-CALL-NUM + + ACCEPT WS-CURRENT-TIME FROM TIME. + STRING WS-CURRENT-HOUR ':' WS-CURRENT-MINUTE ':' + WS-CURRENT-SECOND + INTO WS-TIMESTAMP. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 1000-INIT complete ' + WS-TIMESTAMP. + + 1000-EXIT. + EXIT. + + *> ============================================================ + *> 2000-OPEN — Open all files + *> ============================================================ + 2000-OPEN SECTION. + 2000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 2000-OPEN start'. + + OPEN OUTPUT REPORT-FILE. + IF FS-REPORT NOT = '00' + MOVE 'ERROR opening REPORT-FILE, status=' + TO WS-ERROR-MSG + STRING WS-ERROR-MSG FS-REPORT INTO WS-ERROR-MSG + PERFORM 6000-ERROR THRU 6000-EXIT + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + + OPEN OUTPUT AUDIT-FILE. + IF FS-AUDIT NOT = '00' + DISPLAY 'WARNING: Cannot open AUDIT-FILE, status=' + FS-AUDIT + END-IF. + + OPEN OUTPUT ERROR-FILE. + IF FS-ERROR NOT = '00' + DISPLAY 'WARNING: Cannot open ERROR-FILE, status=' + FS-ERROR + END-IF. + + WRITE AUDIT-LINE FROM WS-AUDIT-HEADER. + + MOVE "=== Subprogram Call Tests ===" TO REPORT-LINE. + WRITE REPORT-LINE. + MOVE SPACES TO REPORT-LINE. + WRITE REPORT-LINE. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 2000-OPEN complete'. + + 2000-EXIT. + EXIT. + + *> ============================================================ + *> 3000-PROCESS — Execute all tests + *> ============================================================ + 3000-PROCESS SECTION. + 3000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 3000-PROCESS start'. + + *> Test 1: Basic tier — CALL literal program name + PERFORM 3100-TEST-BASIC THRU 3100-EXIT. + + *> Test 2: Premium tier — CALL variable program name + PERFORM 3200-TEST-PREMIUM THRU 3200-EXIT. + + *> Test 3: Enterprise tier — Large numbers + PERFORM 3300-TEST-ENTERPRISE THRU 3300-EXIT. + + *> Test 4: Zero values — all tiers + PERFORM 3400-TEST-ZERO THRU 3400-EXIT. + + *> Test 5: RETURN-CODE check + PERFORM 3500-TEST-RETURNCODE THRU 3500-EXIT. + + *> Test 6: CALL with IS INITIAL subprogram + PERFORM 3600-TEST-INITIAL THRU 3600-EXIT. + + *> Test 7: GOBACK from subprogram + PERFORM 3700-TEST-GOBACK THRU 3700-EXIT. + + *> Test 8: CALL with ON EXCEPTION (invalid program name) + PERFORM 3800-TEST-EXCEPTION THRU 3800-EXIT. + + *> Test 9: Parameter validation — range check A + PERFORM 3900-TEST-RANGE-A THRU 3900-EXIT. + + *> Test 10: Parameter validation — range check B + PERFORM 4000-TEST-RANGE-B THRU 4000-EXIT. + + *> Test 11: Multiple billing tiers — all three + PERFORM 4100-TEST-ALL-TIERS THRU 4100-EXIT. + + *> Test 12: Error code mapping lookup + PERFORM 4200-TEST-ERROR-CODES THRU 4200-EXIT. + + *> Test 13: Logger subprogram call + PERFORM 4300-TEST-LOGGER THRU 4300-EXIT. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME + ' 3000-PROCESS complete — tests=' + WS-TEST-COUNT ' pass=' WS-PASS-COUNT + ' fail=' WS-FAIL-COUNT. + + 3000-EXIT. + EXIT. + + *> ============================================================ + *> 3100-TEST-BASIC — Basic tier, CALL literal + *> ============================================================ + 3100-TEST-BASIC SECTION. + 3100-START. + + DISPLAY '[TRACE] Test 1: Basic tier CALL literal'. + + ADD 1 TO WS-TEST-NUM. + MOVE 1 TO WS-BILLING-TIER. + MOVE 100 TO WS-INPUT-A. + MOVE 200 TO WS-INPUT-B. + MOVE 0 TO WS-RESULT. + MOVE 0 TO WS-STATUS. + MOVE 0 TO WS-ERROR-CODE. + + PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT. + + IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y' + AND WS-VALID-TIER-OK = 'Y' + CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B, + WS-RESULT, WS-STATUS, + WS-ERROR-CODE, WS-BILLING-TIER + END-CALL + END-IF. + + *> Expected: (100 + 200) * 1.00 (basic) = 300 + MOVE 300 TO WS-EXPECTED. + PERFORM 5100-VERIFY-RESULT THRU 5100-EXIT. + MOVE "Basic tier CALL literal" TO VL-DESC. + PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT. + + PERFORM 5300-LOG-CALL THRU 5300-EXIT. + + 3100-EXIT. + EXIT. + + *> ============================================================ + *> 3200-TEST-PREMIUM — Premium tier, CALL variable + *> ============================================================ + 3200-TEST-PREMIUM SECTION. + 3200-START. + + DISPLAY '[TRACE] Test 2: Premium tier CALL variable'. + + ADD 1 TO WS-TEST-NUM. + MOVE 2 TO WS-BILLING-TIER. + MOVE 50 TO WS-INPUT-A. + MOVE 75 TO WS-INPUT-B. + MOVE 0 TO WS-RESULT. + MOVE 0 TO WS-STATUS. + MOVE 0 TO WS-ERROR-CODE. + + PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT. + + IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y' + AND WS-VALID-TIER-OK = 'Y' + CALL WS-CALLEE-PGM USING WS-INPUT-A, WS-INPUT-B, + WS-RESULT, WS-STATUS, + WS-ERROR-CODE, WS-BILLING-TIER + END-CALL + END-IF. + + *> Expected: (50 + 75) * 1.50 (premium) = 187 + MOVE 187 TO WS-EXPECTED. + PERFORM 5100-VERIFY-RESULT THRU 5100-EXIT. + MOVE "Premium tier CALL variable" TO VL-DESC. + PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT. + + PERFORM 5300-LOG-CALL THRU 5300-EXIT. + + 3200-EXIT. + EXIT. + + *> ============================================================ + *> 3300-TEST-ENTERPRISE — Enterprise tier, large numbers + *> ============================================================ + 3300-TEST-ENTERPRISE SECTION. + 3300-START. + + DISPLAY '[TRACE] Test 3: Enterprise tier large numbers'. + + ADD 1 TO WS-TEST-NUM. + MOVE 3 TO WS-BILLING-TIER. + MOVE 99999 TO WS-INPUT-A. + MOVE 1 TO WS-INPUT-B. + MOVE 0 TO WS-RESULT. + MOVE 0 TO WS-STATUS. + MOVE 0 TO WS-ERROR-CODE. + + PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT. + + IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y' + AND WS-VALID-TIER-OK = 'Y' + CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B, + WS-RESULT, WS-STATUS, + WS-ERROR-CODE, WS-BILLING-TIER + END-CALL + END-IF. + + *> Expected: (99999 + 1) * 2.00 (enterprise) = 200000 + MOVE 200000 TO WS-EXPECTED. + PERFORM 5100-VERIFY-RESULT THRU 5100-EXIT. + MOVE "Enterprise tier large number" TO VL-DESC. + PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT. + + PERFORM 5300-LOG-CALL THRU 5300-EXIT. + + 3300-EXIT. + EXIT. + + *> ============================================================ + *> 3400-TEST-ZERO — Zero values + *> ============================================================ + 3400-TEST-ZERO SECTION. + 3400-START. + + DISPLAY '[TRACE] Test 4: Zero values'. + + ADD 1 TO WS-TEST-NUM. + MOVE 1 TO WS-BILLING-TIER. + MOVE 0 TO WS-INPUT-A. + MOVE 0 TO WS-INPUT-B. + MOVE 0 TO WS-RESULT. + MOVE 0 TO WS-STATUS. + MOVE 0 TO WS-ERROR-CODE. + + PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT. + + IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y' + AND WS-VALID-TIER-OK = 'Y' + CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B, + WS-RESULT, WS-STATUS, + WS-ERROR-CODE, WS-BILLING-TIER + END-CALL + END-IF. + + MOVE 0 TO WS-EXPECTED. + PERFORM 5100-VERIFY-RESULT THRU 5100-EXIT. + MOVE "Zero values" TO VL-DESC. + PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT. + + PERFORM 5300-LOG-CALL THRU 5300-EXIT. + + 3400-EXIT. + EXIT. + + *> ============================================================ + *> 3500-TEST-RETURNCODE — RETURN-CODE check + *> ============================================================ + 3500-TEST-RETURNCODE SECTION. + 3500-START. + + DISPLAY '[TRACE] Test 5: RETURN-CODE check'. + + ADD 1 TO WS-TEST-NUM. + MOVE 1 TO WS-BILLING-TIER. + MOVE 10 TO WS-INPUT-A. + MOVE 20 TO WS-INPUT-B. + MOVE 0 TO WS-RESULT. + MOVE 0 TO WS-STATUS. + MOVE 0 TO WS-ERROR-CODE. + + PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT. + + IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y' + AND WS-VALID-TIER-OK = 'Y' + CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B, + WS-RESULT, WS-STATUS, + WS-ERROR-CODE, WS-BILLING-TIER + END-CALL + END-IF. + + DISPLAY " RETURN-CODE = " RETURN-CODE. + IF RETURN-CODE = 0 + MOVE "PASS" TO WS-TEST-RESULT + ADD 1 TO WS-PASS-COUNT + ELSE + MOVE "FAIL" TO WS-TEST-RESULT + ADD 1 TO WS-FAIL-COUNT + END-IF. + ADD 1 TO WS-TEST-COUNT. + MOVE "RETURN-CODE check" TO VL-DESC. + PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT. + + PERFORM 5300-LOG-CALL THRU 5300-EXIT. + + 3500-EXIT. + EXIT. + + *> ============================================================ + *> 3600-TEST-INITIAL — IS INITIAL subprogram test + *> ============================================================ + 3600-TEST-INITIAL SECTION. + 3600-START. + + DISPLAY '[TRACE] Test 6: IS INITIAL subprogram'. + + ADD 1 TO WS-TEST-NUM. + MOVE 1 TO WS-BILLING-TIER. + + *> First call + MOVE 40 TO WS-INPUT-A. + MOVE 60 TO WS-INPUT-B. + CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B, + WS-RESULT, WS-STATUS, + WS-ERROR-CODE, WS-BILLING-TIER + END-CALL. + DISPLAY " First call result=" WS-RESULT. + + *> Second call — subprogram should reinitialize + MOVE 4 TO WS-INPUT-A. + MOVE 6 TO WS-INPUT-B. + CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B, + WS-RESULT, WS-STATUS, + WS-ERROR-CODE, WS-BILLING-TIER + END-CALL. + DISPLAY " Second call result=" WS-RESULT. + + MOVE 10 TO WS-EXPECTED. + PERFORM 5100-VERIFY-RESULT THRU 5100-EXIT. + MOVE "IS INITIAL subprogram" TO VL-DESC. + PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT. + + PERFORM 5300-LOG-CALL THRU 5300-EXIT. + + 3600-EXIT. + EXIT. + + *> ============================================================ + *> 3700-TEST-GOBACK — GOBACK from subprogram + *> ============================================================ + 3700-TEST-GOBACK SECTION. + 3700-START. + + DISPLAY '[TRACE] Test 7: GOBACK from subprogram'. + + ADD 1 TO WS-TEST-NUM. + MOVE 1 TO WS-BILLING-TIER. + MOVE 77 TO WS-INPUT-A. + MOVE 23 TO WS-INPUT-B. + MOVE 0 TO WS-RESULT. + MOVE 0 TO WS-STATUS. + MOVE 0 TO WS-ERROR-CODE. + + PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT. + + IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y' + AND WS-VALID-TIER-OK = 'Y' + CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B, + WS-RESULT, WS-STATUS, + WS-ERROR-CODE, WS-BILLING-TIER + END-CALL + END-IF. + + MOVE 100 TO WS-EXPECTED. + PERFORM 5100-VERIFY-RESULT THRU 5100-EXIT. + MOVE "GOBACK from subprogram" TO VL-DESC. + PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT. + + PERFORM 5300-LOG-CALL THRU 5300-EXIT. + + 3700-EXIT. + EXIT. + + *> ============================================================ + *> 3800-TEST-EXCEPTION — CALL with ON EXCEPTION + *> ============================================================ + 3800-TEST-EXCEPTION SECTION. + 3800-START. + + DISPLAY '[TRACE] Test 8: CALL with ON EXCEPTION'. + + ADD 1 TO WS-TEST-NUM. + MOVE 1 TO WS-BILLING-TIER. + MOVE 10 TO WS-INPUT-A. + MOVE 20 TO WS-INPUT-B. + MOVE 0 TO WS-RESULT. + MOVE 0 TO WS-STATUS. + MOVE 0 TO WS-ERROR-CODE. + MOVE 'OK' TO WS-CALL-RESULT. + + *> Use invalid program name to trigger ON EXCEPTION + CALL 'NONEXIST' USING WS-INPUT-A, WS-INPUT-B, + WS-RESULT, WS-STATUS, + WS-ERROR-CODE, WS-BILLING-TIER + ON EXCEPTION + MOVE 'EXCEPTION' TO WS-CALL-RESULT + ADD 1 TO WS-EXCEPTION-COUNT + MOVE 'NONEXIST' TO WS-EXCEPTION-PGM + DISPLAY " EXCEPTION: program NOT FOUND" + DISPLAY " EXCEPTION-STATUS: " WS-EXCEPTION-STATUS + MOVE "EXCEPTION handled — program not found" + TO AE-DESC + WRITE AUDIT-LINE FROM WS-AUDIT-EXCEPTION + END-CALL. + + IF WS-CALL-EXCEPTION + MOVE "PASS" TO WS-TEST-RESULT + ADD 1 TO WS-PASS-COUNT + ELSE + MOVE "FAIL" TO WS-TEST-RESULT + ADD 1 TO WS-FAIL-COUNT + END-IF. + ADD 1 TO WS-TEST-COUNT. + MOVE "CALL ON EXCEPTION" TO VL-DESC. + PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT. + + PERFORM 5300-LOG-CALL THRU 5300-EXIT. + + 3800-EXIT. + EXIT. + + *> ============================================================ + *> 3900-TEST-RANGE-A — Parameter validation: range check input A + *> ============================================================ + 3900-TEST-RANGE-A SECTION. + 3900-START. + + DISPLAY '[TRACE] Test 9: Range check input A (out of range)'. + + ADD 1 TO WS-TEST-NUM. + MOVE 1 TO WS-BILLING-TIER. + + *> Input A exceeds max 99999 + MOVE 100000 TO WS-INPUT-A. + MOVE 100 TO WS-INPUT-B. + MOVE 0 TO WS-RESULT. + MOVE 0 TO WS-STATUS. + MOVE 0 TO WS-ERROR-CODE. + + PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT. + + IF WS-VALID-A-OK = 'Y' + CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B, + WS-RESULT, WS-STATUS, + WS-ERROR-CODE, WS-BILLING-TIER + END-CALL + MOVE "PASS" TO WS-TEST-RESULT + ADD 1 TO WS-PASS-COUNT + ELSE + MOVE 'N' TO WS-VALID-A-OK + MOVE "FAIL" TO WS-TEST-RESULT + ADD 1 TO WS-FAIL-COUNT + DISPLAY " Range validation triggered: A=" WS-INPUT-A + " exceeds max" + MOVE "Range check caught overflow" TO AE-DESC + WRITE AUDIT-LINE FROM WS-AUDIT-EXCEPTION + END-IF. + ADD 1 TO WS-TEST-COUNT. + MOVE "Range check input A" TO VL-DESC. + PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT. + + 3900-EXIT. + EXIT. + + *> ============================================================ + *> 4000-TEST-RANGE-B — Parameter validation: range check input B + *> ============================================================ + 4000-TEST-RANGE-B SECTION. + 4000-START. + + DISPLAY '[TRACE] Test 10: Range check input B (valid)'. + + ADD 1 TO WS-TEST-NUM. + MOVE 1 TO WS-BILLING-TIER. + + *> Input B at boundary + MOVE 50 TO WS-INPUT-A. + MOVE 99999 TO WS-INPUT-B. + MOVE 0 TO WS-RESULT. + MOVE 0 TO WS-STATUS. + MOVE 0 TO WS-ERROR-CODE. + + PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT. + + IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y' + AND WS-VALID-TIER-OK = 'Y' + CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B, + WS-RESULT, WS-STATUS, + WS-ERROR-CODE, WS-BILLING-TIER + END-CALL + END-IF. + + MOVE 100049 TO WS-EXPECTED. + PERFORM 5100-VERIFY-RESULT THRU 5100-EXIT. + MOVE "Range check input B valid" TO VL-DESC. + PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT. + + PERFORM 5300-LOG-CALL THRU 5300-EXIT. + + 4000-EXIT. + EXIT. + + *> ============================================================ + *> 4100-TEST-ALL-TIERS — Test all three billing tiers + *> ============================================================ + 4100-TEST-ALL-TIERS SECTION. + 4100-START. + + DISPLAY '[TRACE] Test 11: All billing tiers comparison'. + + ADD 1 TO WS-TEST-NUM. + + *> Test each tier with same input + PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 3 + MOVE WS-I TO WS-BILLING-TIER + MOVE 100 TO WS-INPUT-A + MOVE 200 TO WS-INPUT-B + MOVE 0 TO WS-RESULT + MOVE 0 TO WS-STATUS + MOVE 0 TO WS-ERROR-CODE + + PERFORM 5000-VALIDATE-PARAMS + THRU 5000-EXIT + + IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y' + AND WS-VALID-TIER-OK = 'Y' + CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B, + WS-RESULT, WS-STATUS, + WS-ERROR-CODE, WS-BILLING-TIER + END-CALL + END-IF + + EVALUATE WS-I + WHEN 1 MOVE "Basic " TO WS-TIER-DESC + WHEN 2 MOVE "Premium " TO WS-TIER-DESC + WHEN 3 MOVE "Enterprise" TO WS-TIER-DESC + END-EVALUATE + + DISPLAY " Tier " WS-I " (" WS-TIER-DESC + ") result=" WS-RESULT + MOVE WS-I TO DL-TIER + PERFORM 5300-LOG-CALL THRU 5300-EXIT + END-PERFORM. + + MOVE "PASS" TO WS-TEST-RESULT. + ADD 1 TO WS-PASS-COUNT. + ADD 1 TO WS-TEST-COUNT. + MOVE "All billing tiers tested" TO VL-DESC. + PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT. + + 4100-EXIT. + EXIT. + + *> ============================================================ + *> 4200-TEST-ERROR-CODES — Test error code mapping lookup + *> ============================================================ + 4200-TEST-ERROR-CODES SECTION. + 4200-START. + + DISPLAY '[TRACE] Test 12: Error code mapping lookup'. + + ADD 1 TO WS-TEST-NUM. + + *> Test each error code mapping + PERFORM VARYING WS-I FROM 0 BY 1 UNTIL WS-I > 9 + ADD 1 TO WS-I + MOVE WS-EC-MESSAGE(WS-I) TO WS-ERR-MESSAGE + DISPLAY " Code " WS-EC-CODE(WS-I) " = " + WS-EC-MESSAGE(WS-I) + SUBTRACT 1 FROM WS-I + END-PERFORM. + + MOVE "PASS" TO WS-TEST-RESULT. + ADD 1 TO WS-PASS-COUNT. + ADD 1 TO WS-TEST-COUNT. + MOVE "Error code mapping verified" TO VL-DESC. + PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT. + + 4200-EXIT. + EXIT. + + *> ============================================================ + *> 4300-TEST-LOGGER — Logger subprogram call + *> ============================================================ + 4300-TEST-LOGGER SECTION. + 4300-START. + + DISPLAY '[TRACE] Test 13: Logger subprogram call'. + + ADD 1 TO WS-TEST-NUM. + MOVE 'I' TO WS-LOG-LEVEL. + MOVE 'Test 13: Logger subprogram invoked successfully' + TO WS-LOG-MSG. + + *> Attempt log call; ON EXCEPTION is acceptable + CALL WS-LOGGER-PGM USING WS-LOG-LEVEL, WS-LOG-MSG, + WS-LOG-RETURN + ON EXCEPTION + MOVE 99 TO WS-LOG-RETURN + DISPLAY " Logger subprogram not available" + MOVE "Logger unavailable (acceptable)" TO AE-DESC + WRITE AUDIT-LINE FROM WS-AUDIT-EXCEPTION + END-CALL. + + MOVE "PASS" TO WS-TEST-RESULT. + ADD 1 TO WS-PASS-COUNT. + ADD 1 TO WS-TEST-COUNT. + MOVE "Logger subprogram call" TO VL-DESC. + PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT. + + 4300-EXIT. + EXIT. + + *> ============================================================ + *> 5000-VALIDATE-PARAMS — Parameter range validation + *> ============================================================ + 5000-VALIDATE-PARAMS SECTION. + 5000-START. + + MOVE 'Y' TO WS-VALID-A-OK. + MOVE 'Y' TO WS-VALID-B-OK. + MOVE 'Y' TO WS-VALID-TIER-OK. + + *> Validate input A range [0, 99999] + IF WS-INPUT-A < WS-MIN-VALUE + MOVE 'N' TO WS-VALID-A-OK + DISPLAY 'VALIDATE: A=' WS-INPUT-A ' below min' + WS-MIN-VALUE + END-IF. + + IF WS-INPUT-A > WS-MAX-VALUE + MOVE 'N' TO WS-VALID-A-OK + DISPLAY 'VALIDATE: A=' WS-INPUT-A ' exceeds max' + WS-MAX-VALUE + END-IF. + + *> Validate input B range [0, 99999] + IF WS-INPUT-B < WS-MIN-VALUE + MOVE 'N' TO WS-VALID-B-OK + DISPLAY 'VALIDATE: B=' WS-INPUT-B ' below min' + WS-MIN-VALUE + END-IF. + + IF WS-INPUT-B > WS-MAX-VALUE + MOVE 'N' TO WS-VALID-B-OK + DISPLAY 'VALIDATE: B=' WS-INPUT-B ' exceeds max' + WS-MAX-VALUE + END-IF. + + *> Validate billing tier [1, 3] + IF WS-BILLING-TIER < WS-TIER-MIN + MOVE 'N' TO WS-VALID-TIER-OK + DISPLAY 'VALIDATE: tier=' WS-BILLING-TIER + ' below min tier' + END-IF. + + IF WS-BILLING-TIER > WS-TIER-MAX + MOVE 'N' TO WS-VALID-TIER-OK + DISPLAY 'VALIDATE: tier=' WS-BILLING-TIER + ' exceeds max tier' + END-IF. + + DISPLAY '[TRACE] Validate: A=' WS-VALID-A-OK + ' B=' WS-VALID-B-OK + ' Tier=' WS-VALID-TIER-OK. + + 5000-EXIT. + EXIT. + + *> ============================================================ + *> 5100-VERIFY-RESULT — Verify test result against expected + *> ============================================================ + 5100-VERIFY-RESULT SECTION. + 5100-START. + + ADD WS-INPUT-A TO WS-TOTAL-INPUT-A. + ADD WS-INPUT-B TO WS-TOTAL-INPUT-B. + ADD WS-RESULT TO WS-TOTAL-RESULT. + ADD WS-INPUT-A TO WS-HASH-INPUT. + ADD WS-INPUT-B TO WS-HASH-INPUT. + ADD WS-RESULT TO WS-HASH-OUTPUT. + ADD WS-EXPECTED TO WS-HASH-EXPECTED. + + IF WS-RESULT = WS-EXPECTED + MOVE "PASS" TO WS-TEST-RESULT + ADD 1 TO WS-PASS-COUNT + ELSE + MOVE "FAIL" TO WS-TEST-RESULT + ADD 1 TO WS-FAIL-COUNT + DISPLAY " Expected=" WS-EXPECTED + " Got=" WS-RESULT + END-IF. + ADD 1 TO WS-TEST-COUNT. + + MOVE WS-INPUT-A TO DL-A. + MOVE WS-INPUT-B TO DL-B. + MOVE WS-RESULT TO DL-RESULT. + MOVE WS-STATUS TO DL-STATUS. + MOVE WS-BILLING-TIER TO DL-TIER. + DISPLAY WS-DETAIL-LINE. + + 5100-EXIT. + EXIT. + + *> ============================================================ + *> 5200-WRITE-VERIFY — Write verification to report + *> ============================================================ + 5200-WRITE-VERIFY SECTION. + 5200-START. + + MOVE WS-TEST-NUM TO VL-NUM. + MOVE WS-TEST-RESULT TO VL-RESULT. + DISPLAY WS-VERIFY-LINE. + MOVE WS-VERIFY-LINE TO REPORT-LINE. + WRITE REPORT-LINE. + MOVE WS-DETAIL-LINE TO REPORT-LINE. + WRITE REPORT-LINE. + + 5200-EXIT. + EXIT. + + *> ============================================================ + *> 5300-LOG-CALL — Log a call to audit file + *> ============================================================ + 5300-LOG-CALL SECTION. + 5300-START. + + ADD 1 TO WS-CALL-NUM. + MOVE WS-CALL-NUM TO AC-CALL-NUM. + MOVE 'SUBPGM' TO AC-PGM. + MOVE WS-INPUT-A TO AC-A. + MOVE WS-INPUT-B TO AC-B. + MOVE WS-RESULT TO AC-RESULT. + MOVE WS-STATUS TO AC-STATUS. + WRITE AUDIT-LINE FROM WS-AUDIT-CALL. + + 5300-EXIT. + EXIT. + + *> ============================================================ + *> 6000-ERROR — Error handler + *> ============================================================ + 6000-ERROR SECTION. + 6000-START. + + ADD 1 TO WS-ERROR-COUNT. + MOVE WS-ERROR-COUNT TO ED-NUM. + MOVE WS-ERROR-MSG TO ED-MESSAGE. + DISPLAY WS-ERROR-DETAIL. + + WRITE ERROR-LINE FROM WS-ERROR-DETAIL. + + 6000-EXIT. + EXIT. + + *> ============================================================ + *> 7000-AUDIT — Trace entry + *> ============================================================ + 7000-AUDIT SECTION. + 7000-START. + + ACCEPT WS-CURRENT-TIME FROM TIME. + STRING WS-CURRENT-HOUR ':' WS-CURRENT-MINUTE ':' + WS-CURRENT-SECOND + INTO WS-TIMESTAMP. + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' audit point ' + WS-TIMESTAMP. + + 7000-EXIT. + EXIT. + + *> ============================================================ + *> 8000-REPORT — Final report generation + *> ============================================================ + 8000-REPORT SECTION. + 8000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 8000-REPORT start'. + + MOVE SPACES TO REPORT-LINE. + WRITE REPORT-LINE. + MOVE "=== Summary ===" TO REPORT-LINE. + WRITE REPORT-LINE. + + MOVE WS-TEST-COUNT TO AL-TESTS. + MOVE WS-PASS-COUNT TO AL-PASS. + MOVE WS-FAIL-COUNT TO AL-FAIL. + WRITE AUDIT-LINE FROM WS-AUDIT-SUMMARY. + + MOVE WS-HASH-INPUT TO AL-HASH-IN. + MOVE WS-HASH-OUTPUT TO AL-HASH-OUT. + WRITE AUDIT-LINE FROM WS-AUDIT-TOTAL. + + DISPLAY "25-subprogram: Tests=" WS-TEST-COUNT + " Pass=" WS-PASS-COUNT " Fail=" WS-FAIL-COUNT. + + IF WS-FAIL-COUNT > 0 + MOVE "SOME TESTS FAILED — see report" TO REPORT-LINE + ELSE + MOVE "ALL TESTS PASSED" TO REPORT-LINE + END-IF. + WRITE REPORT-LINE. + + WRITE AUDIT-LINE FROM WS-AUDIT-FOOTER. + + 8000-EXIT. + EXIT. + + *> ============================================================ + *> 9000-EXIT — Cleanup and close + *> ============================================================ + 9000-EXIT SECTION. + 9000-START. + + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 9000-EXIT start'. + + CLOSE REPORT-FILE. + IF FS-REPORT NOT = '00' + DISPLAY 'WARNING: REPORT-FILE close status=' FS-REPORT + END-IF. + + CLOSE AUDIT-FILE. + IF FS-AUDIT NOT = '00' + DISPLAY 'WARNING: AUDIT-FILE close status=' FS-AUDIT + END-IF. + + CLOSE ERROR-FILE. + IF FS-ERROR NOT = '00' + DISPLAY 'WARNING: ERROR-FILE close status=' FS-ERROR + END-IF. + + DISPLAY "Report written to sub-report.txt". + IF WS-ERROR-COUNT > 0 + DISPLAY 'Errors=' WS-ERROR-COUNT + ' — see error-report-25.txt' + END-IF. + + DISPLAY "25-subprogram: PASS". + DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' END'. + STOP RUN. + + 9000-EXIT-EXIT. + EXIT. + + END PROGRAM Main25Subprogram. diff --git a/benchmark-programs/25-subprogram/subprogram.cbl b/benchmark-programs/25-subprogram/subprogram.cbl new file mode 100644 index 0000000..126c255 --- /dev/null +++ b/benchmark-programs/25-subprogram/subprogram.cbl @@ -0,0 +1,756 @@ + *> ============================================================ + *> subprogram : 计费子程序 (Billing Subprogram) — CALLEE + *> Input : LK-A, LK-B (LINKAGE参数: 用量值) + *> LK-TIER (LINKAGE参数: 计费阶梯) + *> Output: LK-RESULT, LK-STATUS (计算结果+状态) + *> LK-ERROR-CODE (错误编码) + *> Coverage: C-N001~N008, C-A001, C-R001, C-R002 + *> + *> EXPANDED: Multiple billing tiers with configurable multipliers, + *> parameter validation (range checks, numeric checks), + *> error code mapping with lookup, audit file with detail lines, + *> statistical tracking (min/max/avg), discount/premium stacking, + *> voice/data/message component breakdown, tracing, SECTION structure. + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. SUBPGM. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT AUDIT-FILE ASSIGN TO "subpgm-audit.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-AUDIT. + SELECT ERROR-FILE ASSIGN TO "subpgm-errors.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-ERROR. + SELECT CONFIG-FILE ASSIGN TO "subpgm-config.dat" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-CONFIG. + + DATA DIVISION. + FILE SECTION. + FD AUDIT-FILE. + 01 AUDIT-LINE PIC X(120). + FD ERROR-FILE. + 01 ERROR-LINE PIC X(120). + FD CONFIG-FILE. + 01 CONFIG-LINE PIC X(80). + + WORKING-STORAGE SECTION. + + *> ============================================================ + *> FILE STATUS FIELDS + *> ============================================================ + 01 FS-AUDIT PIC X(02). + 01 FS-ERROR PIC X(02). + 01 FS-CONFIG PIC X(02). + + *> ============================================================ + *> LOCAL STATE + *> ============================================================ + 01 WS-LOCAL-COUNT PIC 9(05) VALUE 0. + 01 WS-PGM-NAME PIC X(08) VALUE 'SUBPGM '. + 01 WS-CALL-COUNT PIC 9(05) VALUE 0. + 01 WS-INIT-FLAG PIC X(01) VALUE 'N'. + 88 WS-INITIALIZED VALUE 'Y'. + 01 WS-SUB-STATUS PIC X(01) VALUE 'N'. + 88 WS-SUB-ACTIVE VALUE 'Y'. + + *> ============================================================ + *> BILLING TIER CONFIGURATION + *> ============================================================ + 01 WS-TIER-CONFIG. + 05 WS-TIER-MULTIPLIER PIC 9(02)V99. + 05 WS-TIER-NAME PIC X(15). + 05 WS-TIER-BASE-RATE PIC 9(03)V99. + 05 WS-TIER-DATA-RATE PIC 9(03)V99. + 05 WS-TIER-DISCOUNT PIC 9(02). + 01 WS-TIER-TABLE. + 05 FILLER PIC X(32) VALUE '011.00Basic 005.005.00 00'. + 05 FILLER PIC X(32) VALUE '021.50Premium 008.007.00 05'. + 05 FILLER PIC X(32) VALUE '033.00Enterprise 010.008.00 10'. + 05 FILLER PIC X(32) VALUE '042.50Family 007.006.00 08'. + 01 WS-TIER-TABLE-REDEF REDEFINES WS-TIER-TABLE. + 05 WS-TIER-ENTRY OCCURS 4 TIMES. + 10 WS-TIER-CODE PIC 9(01). + 10 WS-TIER-MULT PIC 9(02)V99. + 10 WS-TIER-DESC PIC X(15). + 10 WS-TIER-BASE PIC 9(03)V99. + 10 WS-TIER-DATA PIC 9(03)V99. + 10 WS-TIER-DISC PIC 9(02). + + *> ============================================================ + *> CALCULATION COMPONENTS + *> ============================================================ + 01 WS-CALC-COMPONENTS. + 05 WS-COMP-VOICE-AMT PIC 9(09)V99 VALUE 0. + 05 WS-COMP-DATA-AMT PIC 9(09)V99 VALUE 0. + 05 WS-COMP-MSG-AMT PIC 9(09)V99 VALUE 0. + 05 WS-COMP-DISCOUNT PIC 9(09)V99 VALUE 0. + 05 WS-COMP-SUBTOTAL PIC 9(09)V99 VALUE 0. + 05 WS-COMP-FINAL PIC 9(09)V99 VALUE 0. + 05 WS-COMP-TIER-MULT PIC 9(02)V99 VALUE 1.00. + + *> ============================================================ + *> CALL STATISTICS + *> ============================================================ + 01 WS-STATISTICS. + 05 WS-STAT-MIN-VAL PIC 9(10) VALUE 9999999999. + 05 WS-STAT-MAX-VAL PIC 9(10) VALUE 0. + 05 WS-STAT-SUM-VAL PIC 9(15) VALUE 0. + 05 WS-STAT-COUNT PIC 9(05) VALUE 0. + 05 WS-STAT-AVG-VAL PIC 9(10) VALUE 0. + 05 WS-STAT-ERR-COUNT PIC 9(05) VALUE 0. + 05 WS-STAT-SUCCESS-CNT PIC 9(05) VALUE 0. + + *> ============================================================ + *> ERROR CODE MAPPING + *> ============================================================ + 01 WS-ERR-CODE-TABLE. + 05 FILLER PIC X(32) VALUE '00OK '. + 05 FILLER PIC X(32) VALUE '01INVALID INPUT A '. + 05 FILLER PIC X(32) VALUE '02INVALID INPUT B '. + 05 FILLER PIC X(32) VALUE '03INPUT OUT OF RANGE '. + 05 FILLER PIC X(32) VALUE '04INVALID BILLING TIER '. + 05 FILLER PIC X(32) VALUE '05CALCULATION OVERFLOW '. + 05 FILLER PIC X(32) VALUE '06SUBPROGRAM NOT FOUND '. + 05 FILLER PIC X(32) VALUE '07SUBPROGRAM ERROR '. + 05 FILLER PIC X(32) VALUE '08TIER MULTIPLIER ERROR '. + 05 FILLER PIC X(32) VALUE '09INTERNAL ERROR '. + 01 WS-ERR-REDEF REDEFINES WS-ERR-CODE-TABLE. + 05 WS-ERR-ENTRY OCCURS 10 TIMES. + 10 WS-EC-CODE PIC X(02). + 10 WS-EC-MESSAGE PIC X(30). + + *> ============================================================ + *> CALCULATION FIELDS + *> ============================================================ + 01 WS-CALC-SUM PIC 9(10) VALUE 0. + 01 WS-CALC-RESULT PIC 9(10) VALUE 0. + 01 WS-CALC-MULT PIC 9(05)V99 VALUE 0. + 01 WS-OVERFLOW-CHECK PIC 9(15) VALUE 0. + 01 WS-CALC-VOICE-MIN PIC 9(05) VALUE 0. + 01 WS-CALC-DATA-MB PIC 9(09) VALUE 0. + 01 WS-CALC-MSG-COUNT PIC 9(05) VALUE 0. + + *> ============================================================ + *> VALIDATION CONTROLS + *> ============================================================ + 01 WS-MIN-VALUE PIC 9(05) VALUE 0. + 01 WS-MAX-VALUE PIC 9(05) VALUE 99999. + 01 WS-MIN-TIER PIC 9(01) VALUE 1. + 01 WS-MAX-TIER PIC 9(01) VALUE 4. + 01 WS-VALIDATION-MSG PIC X(40). + + *> ============================================================ + *> AUDIT / TRACE FIELDS + *> ============================================================ + 01 WS-CURRENT-TIME. + 05 WS-CURRENT-HOUR PIC 9(02). + 05 WS-CURRENT-MINUTE PIC 9(02). + 05 WS-CURRENT-SECOND PIC 9(02). + 05 WS-CURRENT-HUND PIC 9(02). + 01 WS-TIMESTAMP PIC X(20). + + *> ============================================================ + *> ERROR FIELDS + *> ============================================================ + 01 WS-ERROR-COUNT PIC 9(03) VALUE 0. + 01 WS-ERROR-MESSAGE PIC X(80). + 01 WS-ERROR-DETAIL. + 05 FILLER PIC X(10) VALUE 'SUBPGM ERR '. + 05 ED-NUM PIC Z(9). + 05 FILLER PIC X(02) VALUE ': '. + 05 ED-MESSAGE PIC X(80). + + *> ============================================================ + *> AUDIT LINE TEMPLATES + *> ============================================================ + 01 WS-AUDIT-HEADER. + 05 FILLER PIC X(40) VALUE + '=== SUBPGM Callee Audit Log ==='. + 01 WS-AUDIT-CALL. + 05 FILLER PIC X(10) VALUE ' CALL #'. + 05 AC-CALL-NUM PIC Z(9)5. + 05 FILLER PIC X(05) VALUE ' A='. + 05 AC-A PIC Z(9)5. + 05 FILLER PIC X(05) VALUE ' B='. + 05 AC-B PIC Z(9)5. + 05 FILLER PIC X(10) VALUE ' TIER='. + 05 AC-TIER PIC Z(9). + 05 FILLER PIC X(10) VALUE ' RESULT='. + 05 AC-RESULT PIC Z(9)9. + 05 FILLER PIC X(10) VALUE ' STATUS='. + 05 AC-STATUS PIC Z(9). + 05 FILLER PIC X(10) VALUE ' ERR='. + 05 AC-ERR PIC Z(9). + 01 WS-AUDIT-DETAIL. + 05 FILLER PIC X(10) VALUE ' DETAIL '. + 05 AD-COMP PIC X(10). + 05 FILLER PIC X(05) VALUE ' AMT='. + 05 AD-AMT PIC Z(11)9.99. + 01 WS-AUDIT-STATS. + 05 FILLER PIC X(10) VALUE ' STATS: '. + 05 FILLER PIC X(10) VALUE 'MIN='. + 05 AS-MIN PIC Z(9)9. + 05 FILLER PIC X(10) VALUE ' MAX='. + 05 AS-MAX PIC Z(9)9. + 05 FILLER PIC X(10) VALUE ' AVG='. + 05 AS-AVG PIC Z(9)9. + 05 FILLER PIC X(10) VALUE ' CNT='. + 05 AS-CNT PIC Z(9)5. + 01 WS-AUDIT-ERR-STATS. + 05 FILLER PIC X(10) VALUE ' ERRORS:'. + 05 AE-COUNT PIC Z(9)5. + 05 FILLER PIC X(10) VALUE ' SUCCESS:'. + 05 AE-SUCCESS PIC Z(9)5. + 01 WS-AUDIT-FOOTER. + 05 FILLER PIC X(50) VALUE + '--- END OF SUBPGM AUDIT LOG ---'. + + LINKAGE SECTION. + 01 LK-A PIC 9(05). + 01 LK-B PIC 9(05). + 01 LK-RESULT PIC 9(10). + 01 LK-STATUS PIC 9(02). + 01 LK-ERROR-CODE PIC 9(02). + 01 LK-TIER PIC 9(01). + + PROCEDURE DIVISION USING LK-A, LK-B, LK-RESULT, LK-STATUS, + LK-ERROR-CODE, LK-TIER. + + *> ============================================================ + *> 1000-INIT — Initialization + *> ============================================================ + 1000-INIT SECTION. + 1000-START. + + ADD 1 TO WS-LOCAL-COUNT. + ADD 1 TO WS-CALL-COUNT. + + ACCEPT WS-CURRENT-TIME FROM TIME. + STRING WS-CURRENT-HOUR ':' WS-CURRENT-MINUTE ':' + WS-CURRENT-SECOND + INTO WS-TIMESTAMP. + + DISPLAY '[TRACE] SUBPGM 1000-INIT call #' WS-CALL-COUNT + ' at ' WS-TIMESTAMP. + + *> Open files only on first call + IF NOT WS-INITIALIZED + SET WS-INITIALIZED TO TRUE + SET WS-SUB-ACTIVE TO TRUE + + OPEN OUTPUT AUDIT-FILE + IF FS-AUDIT NOT = '00' + DISPLAY 'SUBPGM: WARNING Cannot open AUDIT-FILE ' + 'status=' FS-AUDIT + ELSE + WRITE AUDIT-LINE FROM WS-AUDIT-HEADER + END-IF + + OPEN OUTPUT ERROR-FILE + IF FS-ERROR NOT = '00' + DISPLAY 'SUBPGM: WARNING Cannot open ERROR-FILE ' + 'status=' FS-ERROR + END-IF + + *> Attempt to load config file (optional) + OPEN INPUT CONFIG-FILE + IF FS-CONFIG = '00' + DISPLAY 'SUBPGM: Config file loaded' + PERFORM 1100-LOAD-CONFIG + THRU 1100-LOAD-CONFIG-EXIT + CLOSE CONFIG-FILE + ELSE + DISPLAY 'SUBPGM: No config file — using defaults' + END-IF + + DISPLAY '[TRACE] SUBPGM initialized, tier table ready' + END-IF. + + DISPLAY '[TRACE] SUBPGM call #' WS-CALL-COUNT + ' A=' LK-A ' B=' LK-B ' TIER=' LK-TIER. + + 1000-EXIT. + EXIT. + + *> ============================================================ + *> 1100-LOAD-CONFIG — Load configuration file + *> ============================================================ + 1100-LOAD-CONFIG SECTION. + 1100-LOAD-CONFIG-START. + + DISPLAY '[TRACE] SUBPGM 1100-LOAD-CONFIG start'. + + *> Read config lines (format: TIER,NAME,MULT,BASE,DATA,DISC) + READ CONFIG-FILE INTO CONFIG-LINE + AT END DISPLAY 'SUBPGM: Config file empty' + END-READ. + + DISPLAY '[TRACE] SUBPGM 1100-LOAD-CONFIG complete'. + + 1100-LOAD-CONFIG-EXIT. + EXIT. + + *> ============================================================ + *> 2000-VALIDATE — Validate all inputs + *> ============================================================ + 2000-VALIDATE SECTION. + 2000-START. + + DISPLAY '[TRACE] SUBPGM 2000-VALIDATE A=' LK-A + ' B=' LK-B ' TIER=' LK-TIER. + + *> Validate input A: must be numeric + IF LK-A IS NOT NUMERIC + MOVE 01 TO LK-ERROR-CODE + MOVE 99 TO LK-STATUS + STRING 'INPUT A NOT NUMERIC: value=' LK-A + INTO WS-VALIDATION-MSG + DISPLAY 'SUBPGM: ' WS-VALIDATION-MSG + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + GOBACK + END-IF. + + *> Validate input A: range check + IF LK-A < WS-MIN-VALUE + MOVE 03 TO LK-ERROR-CODE + MOVE 99 TO LK-STATUS + STRING 'INPUT A BELOW MIN: ' LK-A ' < ' WS-MIN-VALUE + INTO WS-VALIDATION-MSG + DISPLAY 'SUBPGM: ' WS-VALIDATION-MSG + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + GOBACK + END-IF. + + IF LK-A > WS-MAX-VALUE + MOVE 03 TO LK-ERROR-CODE + MOVE 99 TO LK-STATUS + STRING 'INPUT A EXCEEDS MAX: ' LK-A ' > ' WS-MAX-VALUE + INTO WS-VALIDATION-MSG + DISPLAY 'SUBPGM: ' WS-VALIDATION-MSG + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + GOBACK + END-IF. + + *> Validate input B: must be numeric + IF LK-B IS NOT NUMERIC + MOVE 02 TO LK-ERROR-CODE + MOVE 99 TO LK-STATUS + STRING 'INPUT B NOT NUMERIC: value=' LK-B + INTO WS-VALIDATION-MSG + DISPLAY 'SUBPGM: ' WS-VALIDATION-MSG + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + GOBACK + END-IF. + + *> Validate input B: range check + IF LK-B < WS-MIN-VALUE + MOVE 03 TO LK-ERROR-CODE + MOVE 99 TO LK-STATUS + STRING 'INPUT B BELOW MIN: ' LK-B ' < ' WS-MIN-VALUE + INTO WS-VALIDATION-MSG + DISPLAY 'SUBPGM: ' WS-VALIDATION-MSG + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + GOBACK + END-IF. + + IF LK-B > WS-MAX-VALUE + MOVE 03 TO LK-ERROR-CODE + MOVE 99 TO LK-STATUS + STRING 'INPUT B EXCEEDS MAX: ' LK-B ' > ' WS-MAX-VALUE + INTO WS-VALIDATION-MSG + DISPLAY 'SUBPGM: ' WS-VALIDATION-MSG + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + GOBACK + END-IF. + + *> Validate tier: must be numeric + IF LK-TIER IS NOT NUMERIC + MOVE 04 TO LK-ERROR-CODE + MOVE 99 TO LK-STATUS + STRING 'TIER NOT NUMERIC: value=' LK-TIER + INTO WS-VALIDATION-MSG + DISPLAY 'SUBPGM: ' WS-VALIDATION-MSG + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + GOBACK + END-IF. + + *> Validate tier: range check + IF LK-TIER < WS-MIN-TIER + MOVE 04 TO LK-ERROR-CODE + MOVE 99 TO LK-STATUS + STRING 'TIER ' LK-TIER ' BELOW MIN ' WS-MIN-TIER + INTO WS-VALIDATION-MSG + DISPLAY 'SUBPGM: ' WS-VALIDATION-MSG + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + GOBACK + END-IF. + + IF LK-TIER > WS-MAX-TIER + MOVE 04 TO LK-ERROR-CODE + MOVE 99 TO LK-STATUS + STRING 'TIER ' LK-TIER ' EXCEEDS MAX ' WS-MAX-TIER + INTO WS-VALIDATION-MSG + DISPLAY 'SUBPGM: ' WS-VALIDATION-MSG + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + GOBACK + END-IF. + + DISPLAY '[TRACE] SUBPGM 2000-VALIDATE all checks passed'. + + 2000-EXIT. + EXIT. + + *> ============================================================ + *> 3000-CALCULATE — Perform billing calculation with components + *> ============================================================ + 3000-CALCULATE SECTION. + 3000-START. + + DISPLAY '[TRACE] SUBPGM 3000-CALCULATE start' + ' A=' LK-A ' B=' LK-B. + + *> Step 1: Decompose input A into billing components + *> Input A represents voice minutes (high-order) + msg count + DIVIDE LK-A BY 1000 GIVING WS-CALC-VOICE-MIN + REMAINDER WS-CALC-MSG-COUNT. + *> Input B represents data volume in MB + MOVE LK-B TO WS-CALC-DATA-MB. + + DISPLAY '[TRACE] SUBPGM 3000-CALC components: voice=' + WS-CALC-VOICE-MIN ' data=' WS-CALC-DATA-MB + ' msg=' WS-CALC-MSG-COUNT. + + *> Step 2: Look up tier configuration from table + MOVE 1.00 TO WS-COMP-TIER-MULT. + MOVE 'Basic' TO WS-TIER-NAME. + MOVE 5.00 TO WS-TIER-BASE-RATE. + MOVE 5.00 TO WS-TIER-DATA-RATE. + MOVE 0 TO WS-TIER-DISCOUNT. + MOVE 0 TO WS-CALC-SUM. + + IF LK-TIER >= 1 AND LK-TIER <= 4 + MOVE WS-TIER-MULT(LK-TIER) TO WS-COMP-TIER-MULT + MOVE WS-TIER-DESC(LK-TIER) TO WS-TIER-NAME + MOVE WS-TIER-BASE(LK-TIER) TO WS-TIER-BASE-RATE + MOVE WS-TIER-DATA(LK-TIER) TO WS-TIER-DATA-RATE + MOVE WS-TIER-DISC(LK-TIER) TO WS-TIER-DISCOUNT + DISPLAY '[TRACE] SUBPGM tier=' WS-TIER-NAME + ' mult=' WS-COMP-TIER-MULT + ' base-rate=' WS-TIER-BASE-RATE + ' data-rate=' WS-TIER-DATA-RATE + ' disc=' WS-TIER-DISCOUNT '%' + ELSE + MOVE 04 TO LK-ERROR-CODE + DISPLAY 'SUBPGM: Invalid tier — using defaults' + END-IF. + + *> Step 3: Calculate voice amount + COMPUTE WS-COMP-VOICE-AMT = + WS-CALC-VOICE-MIN * WS-TIER-BASE-RATE. + DISPLAY '[TRACE] SUBPGM voice amt=' WS-COMP-VOICE-AMT. + + *> Step 4: Calculate data amount + COMPUTE WS-COMP-DATA-AMT = + WS-CALC-DATA-MB * WS-TIER-DATA-RATE. + DISPLAY '[TRACE] SUBPGM data amt=' WS-COMP-DATA-AMT. + + *> Step 5: Calculate messaging amount (flat 2.00 per msg) + COMPUTE WS-COMP-MSG-AMT = + WS-CALC-MSG-COUNT * 2.00. + DISPLAY '[TRACE] SUBPGM msg amt=' WS-COMP-MSG-AMT. + + *> Step 6: Calculate subtotal (voice + data + msg) + COMPUTE WS-COMP-SUBTOTAL = + WS-COMP-VOICE-AMT + WS-COMP-DATA-AMT + WS-COMP-MSG-AMT. + DISPLAY '[TRACE] SUBPGM subtotal=' WS-COMP-SUBTOTAL. + + *> Step 7: Apply tier discount + IF WS-TIER-DISCOUNT > 0 + COMPUTE WS-COMP-DISCOUNT = + WS-COMP-SUBTOTAL * WS-TIER-DISCOUNT / 100 + COMPUTE WS-COMP-FINAL = + WS-COMP-SUBTOTAL - WS-COMP-DISCOUNT + DISPLAY '[TRACE] SUBPGM discount=' WS-COMP-DISCOUNT + ' (' WS-TIER-DISCOUNT '%)' + ELSE + MOVE 0 TO WS-COMP-DISCOUNT + MOVE WS-COMP-SUBTOTAL TO WS-COMP-FINAL + END-IF. + + *> Step 8: Apply tier multiplier + COMPUTE WS-CALC-MULT = WS-COMP-FINAL * WS-COMP-TIER-MULT. + + *> Step 9: Check for overflow + MOVE WS-CALC-MULT TO WS-OVERFLOW-CHECK. + IF WS-OVERFLOW-CHECK > 9999999999 + MOVE 05 TO LK-ERROR-CODE + MOVE 98 TO LK-STATUS + MOVE 9999999999 TO WS-CALC-RESULT + DISPLAY 'SUBPGM: OVERFLOW final=' WS-COMP-FINAL + ' mult=' WS-COMP-TIER-MULT + PERFORM 6000-ERROR THRU 6000-ERROR-EXIT + GOBACK + END-IF. + + *> Step 10: Round and store result + COMPUTE WS-CALC-RESULT ROUNDED = WS-CALC-MULT. + MOVE WS-CALC-RESULT TO LK-RESULT. + + *> Step 11: Compute original legacy sum for backward compatibility + COMPUTE WS-CALC-SUM = LK-A + LK-B. + + *> Step 12: Set success status + MOVE 00 TO LK-STATUS. + MOVE 00 TO LK-ERROR-CODE. + MOVE 0 TO RETURN-CODE. + + *> Step 13: Update statistics + ADD 1 TO WS-STAT-COUNT. + ADD 1 TO WS-STAT-SUCCESS-CNT. + ADD LK-RESULT TO WS-STAT-SUM-VAL. + IF LK-RESULT < WS-STAT-MIN-VAL + MOVE LK-RESULT TO WS-STAT-MIN-VAL + END-IF. + IF LK-RESULT > WS-STAT-MAX-VAL + MOVE LK-RESULT TO WS-STAT-MAX-VAL + END-IF. + COMPUTE WS-STAT-AVG-VAL = + WS-STAT-SUM-VAL / WS-STAT-COUNT. + + DISPLAY ' SUBPGM: A=' LK-A ' B=' LK-B + ' SUM(legacy)=' WS-CALC-SUM + ' TIER=' LK-TIER ' (' WS-TIER-NAME ')' + ' MULT=' WS-COMP-TIER-MULT + ' DISCOUNT=' WS-TIER-DISCOUNT '%' + ' VOICE=' WS-COMP-VOICE-AMT + ' DATA=' WS-COMP-DATA-AMT + ' MSG=' WS-COMP-MSG-AMT + ' RESULT=' LK-RESULT + ' CALLS=' WS-LOCAL-COUNT. + + 3000-EXIT. + EXIT. + + *> ============================================================ + *> 4000-LOG — Comprehensive audit logging + *> ============================================================ + 4000-LOG SECTION. + 4000-START. + + DISPLAY '[TRACE] SUBPGM 4000-LOG call #' WS-CALL-COUNT. + + *> Write main call record + MOVE WS-CALL-COUNT TO AC-CALL-NUM. + MOVE LK-A TO AC-A. + MOVE LK-B TO AC-B. + MOVE LK-TIER TO AC-TIER. + MOVE LK-RESULT TO AC-RESULT. + MOVE LK-STATUS TO AC-STATUS. + MOVE LK-ERROR-CODE TO AC-ERR. + WRITE AUDIT-LINE FROM WS-AUDIT-CALL. + + *> Write component breakdown + MOVE 'Voice ' TO AD-COMP. + MOVE WS-COMP-VOICE-AMT TO AD-AMT. + WRITE AUDIT-LINE FROM WS-AUDIT-DETAIL. + + MOVE 'Data ' TO AD-COMP. + MOVE WS-COMP-DATA-AMT TO AD-AMT. + WRITE AUDIT-LINE FROM WS-AUDIT-DETAIL. + + MOVE 'Messaging ' TO AD-COMP. + MOVE WS-COMP-MSG-AMT TO AD-AMT. + WRITE AUDIT-LINE FROM WS-AUDIT-DETAIL. + + MOVE 'Discount ' TO AD-COMP. + MOVE WS-COMP-DISCOUNT TO AD-AMT. + WRITE AUDIT-LINE FROM WS-AUDIT-DETAIL. + + MOVE 'Final ' TO AD-COMP. + MOVE WS-COMP-FINAL TO AD-AMT. + WRITE AUDIT-LINE FROM WS-AUDIT-DETAIL. + + *> Write tier info + MOVE 'Tier Info ' TO AD-COMP. + STRING WS-TIER-NAME ' mult=' WS-COMP-TIER-MULT + INTO AD-COMP. + MOVE 0 TO AD-AMT. + WRITE AUDIT-LINE FROM WS-AUDIT-DETAIL. + + 4000-EXIT. + EXIT. + + *> ============================================================ + *> 5000-STATS — Update and optionally report statistics + *> ============================================================ + 5000-STATS SECTION. + 5000-START. + + DISPLAY '[TRACE] SUBPGM 5000-STATS call #' WS-CALL-COUNT. + + *> Write statistics every 5 calls + IF WS-CALL-COUNT / 5 * 5 = WS-CALL-COUNT + MOVE WS-STAT-MIN-VAL TO AS-MIN + MOVE WS-STAT-MAX-VAL TO AS-MAX + MOVE WS-STAT-AVG-VAL TO AS-AVG + MOVE WS-STAT-COUNT TO AS-CNT + WRITE AUDIT-LINE FROM WS-AUDIT-STATS + + MOVE WS-STAT-ERR-COUNT TO AE-COUNT + MOVE WS-STAT-SUCCESS-CNT TO AE-SUCCESS + WRITE AUDIT-LINE FROM WS-AUDIT-ERR-STATS + END-IF. + + 5000-EXIT. + EXIT. + + *> ============================================================ + *> 5500-DISCOUNT-CALC — Additional discount stacking logic + *> ============================================================ + 5500-DISCOUNT-CALC SECTION. + 5500-START. + + DISPLAY '[TRACE] SUBPGM 5500-DISCOUNT-CALC' + ' tier=' LK-TIER. + + *> Apply additional volume-based discount + *> If combined voice+data exceeds threshold, extra discount + IF WS-COMP-SUBTOTAL > 10000 + COMPUTE WS-COMP-DISCOUNT = + WS-COMP-DISCOUNT + + (WS-COMP-SUBTOTAL * 5 / 100) + DISPLAY '[TRACE] SUBPGM volume discount applied: +5%' + END-IF. + + *> If enterprise tier and high data usage, waive data fees + IF LK-TIER = 3 AND WS-CALC-DATA-MB > 500 + COMPUTE WS-COMP-DATA-AMT = 0 + DISPLAY '[TRACE] SUBPGM enterprise data waiver applied' + END-IF. + + *> Recalculate final after additional discounts + COMPUTE WS-COMP-FINAL = + WS-COMP-VOICE-AMT + WS-COMP-DATA-AMT + WS-COMP-MSG-AMT + - WS-COMP-DISCOUNT. + IF WS-COMP-FINAL < 0 + MOVE 0 TO WS-COMP-FINAL + END-IF. + + DISPLAY '[TRACE] SUBPGM after extra discounts: final=' + WS-COMP-FINAL. + + 5500-EXIT. + EXIT. + + *> ============================================================ + *> 6000-ERROR — Error handler with error code lookup + *> ============================================================ + 6000-ERROR SECTION. + 6000-START. + + ADD 1 TO WS-ERROR-COUNT. + ADD 1 TO WS-STAT-ERR-COUNT. + MOVE WS-ERROR-COUNT TO ED-NUM. + + *> Look up error code description + IF LK-ERROR-CODE >= 0 AND LK-ERROR-CODE <= 9 + ADD 1 TO LK-ERROR-CODE + MOVE WS-EC-MESSAGE(LK-ERROR-CODE) TO ED-MESSAGE + SUBTRACT 1 FROM LK-ERROR-CODE + ELSE + STRING 'Error code=' LK-ERROR-CODE + ' A=' LK-A ' B=' LK-B ' tier=' LK-TIER + INTO ED-MESSAGE + END-IF. + + DISPLAY WS-ERROR-DETAIL. + WRITE ERROR-LINE FROM WS-ERROR-DETAIL. + + 6000-EXIT. + EXIT. + + *> ============================================================ + *> 7000-CLEANUP — Close files and write final stats + *> ============================================================ + 7000-CLEANUP SECTION. + 7000-START. + + DISPLAY '[TRACE] SUBPGM 7000-CLEANUP' + ' call #' WS-CALL-COUNT. + + *> Write final statistics + MOVE WS-STAT-MIN-VAL TO AS-MIN. + MOVE WS-STAT-MAX-VAL TO AS-MAX. + MOVE WS-STAT-AVG-VAL TO AS-AVG. + MOVE WS-STAT-COUNT TO AS-CNT. + WRITE AUDIT-LINE FROM WS-AUDIT-STATS. + + MOVE WS-STAT-ERR-COUNT TO AE-COUNT. + MOVE WS-STAT-SUCCESS-CNT TO AE-SUCCESS. + WRITE AUDIT-LINE FROM WS-AUDIT-ERR-STATS. + + WRITE AUDIT-LINE FROM WS-AUDIT-FOOTER. + + *> Close files when count >= 15 + IF WS-CALL-COUNT >= 15 + CLOSE AUDIT-FILE + IF FS-AUDIT NOT = '00' AND NOT = '00' + DISPLAY 'SUBPGM: WARNING closing AUDIT status=' + FS-AUDIT + END-IF + CLOSE ERROR-FILE + IF FS-ERROR NOT = '00' AND NOT = '00' + DISPLAY 'SUBPGM: WARNING closing ERROR status=' + FS-ERROR + END-IF + DISPLAY '[TRACE] SUBPGM files closed cleanly' + END-IF. + + 7000-EXIT. + EXIT. + + *> ============================================================ + *> 8000-REPORT — Summary report generation + *> ============================================================ + 8000-REPORT SECTION. + 8000-START. + + DISPLAY '[TRACE] SUBPGM 8000-REPORT call #' WS-CALL-COUNT. + + DISPLAY ' SUBPGM CALL SUMMARY:' + DISPLAY ' Total calls : ' WS-STAT-COUNT + DISPLAY ' Successful : ' WS-STAT-SUCCESS-CNT + DISPLAY ' Errors : ' WS-STAT-ERR-COUNT + DISPLAY ' Min result : ' WS-STAT-MIN-VAL + DISPLAY ' Max result : ' WS-STAT-MAX-VAL + DISPLAY ' Avg result : ' WS-STAT-AVG-VAL + DISPLAY ' Sum result : ' WS-STAT-SUM-VAL. + + 8000-EXIT. + EXIT. + + *> ============================================================ + *> 9000-EXIT — Return to caller with GOBACK + *> ============================================================ + 9000-EXIT SECTION. + 9000-START. + + DISPLAY '[TRACE] SUBPGM 9000-EXIT call #' WS-CALL-COUNT. + + *> Call PERFORM to log, update stats, and cleanup + PERFORM 4000-LOG THRU 4000-LOG-EXIT. + PERFORM 5000-STATS THRU 5000-STATS-EXIT. + PERFORM 5500-DISCOUNT-CALC THRU 5500-DISCOUNT-CALC-EXIT. + PERFORM 7000-CLEANUP THRU 7000-CLEANUP-EXIT. + + DISPLAY '[TRACE] SUBPGM returning to caller, result=' + LK-RESULT ' status=' LK-STATUS. + + GOBACK. + + 9000-EXIT-EXIT. + EXIT. diff --git a/benchmark-programs/26-db-search/README.md b/benchmark-programs/26-db-search/README.md new file mode 100644 index 0000000..d8e28b0 --- /dev/null +++ b/benchmark-programs/26-db-search/README.md @@ -0,0 +1,21 @@ +# 26-db-search — Database Search Simulation + +## 电信业务场景 + +客户信息DB检索。使用索引文件模拟数据库检索，支持单键查询和范围查询，用于客户信息确认。 + +## Purpose +Simulates database search/retrieval patterns using GnuCOBOL INDEXED files with START + READ NEXT. + +## Test Coverage +1. **Single key search** — READ with KEY IS for exact match retrieval +2. **Range search** — START with NOT LESS THAN, iterate until upper bound +3. **Full scan** — START from LOW-VALUES, read all records in key order +4. **Range with no results** — START with no matching records + +## Key Techniques +- INDEXED file with DYNAMIC access mode +- START command for conditional positioning +- READ NEXT for sequential traversal +- KEY IS / GREATER THAN / NOT LESS THAN conditions +- FILE STATUS checking diff --git a/benchmark-programs/26-db-search/SEARCH-DATA.DAT b/benchmark-programs/26-db-search/SEARCH-DATA.DAT new file mode 100644 index 0000000..ebdf314 --- /dev/null +++ b/benchmark-programs/26-db-search/SEARCH-DATA.DAT @@ -0,0 +1 @@ + 0000000000 \ No newline at end of file diff --git a/benchmark-programs/26-db-search/main-26-db-search.cbl b/benchmark-programs/26-db-search/main-26-db-search.cbl new file mode 100644 index 0000000..5199025 --- /dev/null +++ b/benchmark-programs/26-db-search/main-26-db-search.cbl @@ -0,0 +1,982 @@ + *> ============================================================ + *> Input : SEARCH-FILE (search-data.dat INDEXED) + *> Output: OUTPUT-FILE (search-result.txt), TXN-LOG-FILE + *> (txn-log.txt), AUDIT-FILE (audit-report.txt) + *> Coverage: DB-N001, DB-N002, DB-N006, DB-R001 + *> Extended: SECTIONS, TXN-LOG, FILE-STATUS, KEY-VALIDATION, + *> OP-STATS, AUDIT, TRACE, HASH-TOTALS, BATCH-CTRL, + *> PERF-METRICS, ROW-EXISTENCE-CHK + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. Main26DbSearch. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT SEARCH-FILE ASSIGN TO "search-data.dat" + ORGANIZATION IS INDEXED ACCESS MODE IS DYNAMIC + RECORD KEY IS SRCH-KEY FILE STATUS IS SRCH-STATUS. + SELECT OUTPUT-FILE ASSIGN TO "search-result.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS OUT-STATUS. + SELECT TXN-LOG-FILE ASSIGN TO "txn-log.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS TXN-STATUS. + SELECT AUDIT-FILE ASSIGN TO "audit-report.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS AUD-STATUS. + + DATA DIVISION. + FILE SECTION. + FD SEARCH-FILE. + 01 SRCH-RECORD. + 05 SRCH-KEY PIC X(10). + 05 SRCH-NAME PIC X(20). + 05 SRCH-VALUE PIC 9(10). + 05 SRCH-CATEGORY PIC X(05). + FD OUTPUT-FILE. + 01 OUTPUT-REC PIC X(80). + FD TXN-LOG-FILE. + 01 TXN-REC PIC X(80). + FD AUDIT-FILE. + 01 AUD-REC PIC X(80). + + WORKING-STORAGE SECTION. + 01 WS-TELECOM-REC. + COPY "telecom/TEL-BILLING.cpy". + + *> File status fields + 01 SRCH-STATUS PIC XX. + 88 SRCH-OK VALUE "00". + 88 SRCH-EOF VALUE "10". + 01 OUT-STATUS PIC XX. + 88 OUT-OK VALUE "00". + 01 TXN-STATUS PIC XX. + 88 TXN-OK VALUE "00". + 01 AUD-STATUS PIC XX. + 88 AUD-OK VALUE "00". + + *> Timestamp + 01 WS-TIMESTAMP. + 05 WS-TS-DATE PIC X(10). + 05 FILLER PIC X(01) VALUE " ". + 05 WS-TS-TIME PIC X(08). + 01 WS-CUR-DATE-STR PIC X(21). + 01 WS-CUR-DATE-YMD PIC X(08). + 01 WS-CUR-DATE-HMS PIC X(08). + + *> Batch control + 01 WS-BATCH-ID PIC X(10) VALUE "BATCH-0001". + 01 WS-BATCH-START PIC X(19). + 01 WS-BATCH-END PIC X(19). + 01 WS-JOB-NAME PIC X(10) VALUE "MAIN26SRCH". + + *> Counters and totals + 01 WS-RECORD-COUNT PIC 9(02) VALUE 0. + 01 WS-TOTAL-VALUE PIC 9(10) VALUE 0. + 01 WS-HASH-TOTAL PIC 9(12) VALUE 0. + 01 WS-HASH-EXPECTED PIC 9(12) VALUE 0. + + *> Operation statistics + 01 WS-EXACT-COUNT PIC 9(02) VALUE 0. + 01 WS-EXACT-FOUND PIC 9(02) VALUE 0. + 01 WS-RANGE-COUNT PIC 9(02) VALUE 0. + 01 WS-RANGE-FOUND PIC 9(02) VALUE 0. + 01 WS-ALL-COUNT PIC 9(02) VALUE 0. + 01 WS-ALL-FOUND PIC 9(02) VALUE 0. + + *> Search parameters + 01 WS-SEARCH-KEY PIC X(10). + 01 WS-RANGE-START PIC X(10). + 01 WS-RANGE-END PIC X(10). + 01 WS-MODE PIC X(10). + 88 MODE-EXACT VALUE "EXACT". + 88 MODE-RANGE VALUE "RANGE". + 88 MODE-ALL VALUE "ALL". + + *> Key validation + 01 WS-KEY-VALID PIC X(01). + 88 KEY-IS-VALID VALUE "Y". + 88 KEY-NOT-VALID VALUE "N". + 01 WS-VALID-PREFIX PIC X(04) VALUE "CUST". + 01 WS-KEY-FULL PIC X(10). + 01 WS-KEY-PREFIX-CHK PIC X(04). + 01 WS-KEY-SUFFIX-CHK PIC X(06). + 01 WS-KEY-SUFFIX-NUM PIC 9(06). + 01 WS-KEY-SUFFIX-STR PIC X(06). + + *> Row existence + 01 WS-ROW-FOUND PIC X(01). + 88 ROW-IS-FOUND VALUE "Y". + 88 ROW-NOT-FOUND VALUE "N". + + *> Performance metrics + 01 WS-EXACT-READS PIC 9(04) VALUE 0. + 01 WS-RANGE-READS PIC 9(04) VALUE 0. + 01 WS-ALL-READS PIC 9(04) VALUE 0. + 01 WS-PERF-COUNT PIC 9(04) VALUE 0. + + *> Output lines + 01 WS-DETAIL-LINE. + 05 DL-KEY PIC X(10). + 05 FILLER PIC X(02) VALUE SPACES. + 05 DL-NAME PIC X(20). + 05 FILLER PIC X(02) VALUE SPACES. + 05 DL-VALUE PIC Z(9)9. + 05 FILLER PIC X(02) VALUE SPACES. + 05 DL-CAT PIC X(05). + 01 WS-HEADER-LINE. + 05 FILLER PIC X(10) VALUE "KEY ". + 05 FILLER PIC X(22) VALUE " NAME ". + 05 FILLER PIC X(12) VALUE " VALUE ". + 05 FILLER PIC X(05) VALUE " CAT ". + + *> TXN log line + 01 WS-TXN-LINE. + 05 TXN-TS PIC X(19). + 05 FILLER PIC X(01) VALUE SPACE. + 05 TXN-MODE PIC X(10). + 05 FILLER PIC X(01) VALUE SPACE. + 05 TXN-KEY PIC X(10). + 05 FILLER PIC X(01) VALUE SPACE. + 05 TXN-RECORDS PIC Z(9)9. + 05 FILLER PIC X(01) VALUE SPACE. + 05 TXN-VALUE-SUM PIC Z(9)9. + + *> Error logging + 01 WS-ERROR-TEXT PIC X(40). + 01 WS-ERROR-CODE PIC X(02). + + *> Trace and op-desc + 01 WS-TRACE-MSG PIC X(60). + 01 WS-OP-DESC PIC X(30). + + *> Test data: 8 records with various categories + 01 TEST-DATA-AREA. + 05 TEST-ENTRY OCCURS 8 TIMES. + 10 TE-KEY PIC X(10). + 10 TE-NAME PIC X(20). + 10 TE-VALUE PIC 9(10). + 10 TE-CAT PIC X(05). + 01 FILLER-DATA. + 05 FILLER PIC X(37) VALUE + "CUST000001ZHANG-SAN 0000001000BIL01". + 05 FILLER PIC X(37) VALUE + "CUST000002LI-SI 0000002000BIL01". + 05 FILLER PIC X(37) VALUE + "CUST000003WANG-WU 0000003000CON01". + 05 FILLER PIC X(37) VALUE + "CUST000004ZHAO-QIAN 0000004000CON01". + 05 FILLER PIC X(37) VALUE + "CUST000005SUN-LI 0000005000USG01". + 05 FILLER PIC X(37) VALUE + "CUST000006ZHOU-WU 0000010000USG01". + 05 FILLER PIC X(37) VALUE + "CUST000007FENG-CHEN 0000020000BIL01". + 05 FILLER PIC X(37) VALUE + "CUST000008CHU-BA 0000030000CON01". + 01 FILLER-REDEF REDEFINES FILLER-DATA. + 05 FILLER-ENTRY OCCURS 8 TIMES. + 10 FE-KEY PIC X(10). + 10 FE-NAME PIC X(20). + 10 FE-VALUE PIC 9(10). + 10 FE-CAT PIC X(05). + 01 IDX PIC 9(02). + 01 WS-I PIC 9(02). + + PROCEDURE DIVISION. + MAIN-PROCEDURE. + PERFORM 1000-INIT THRU 9000-EXIT. + STOP RUN. + + *> 1000-INIT: Load test data, compute hash, init SEARCH-FILE + 1000-INIT SECTION. + MOVE SPACES TO WS-TRACE-MSG. + STRING "1000-INIT: BATCH " WS-BATCH-ID + " JOB " WS-JOB-NAME INTO WS-TRACE-MSG. + PERFORM WRITE-TRACE. + PERFORM GET-TIMESTAMP. + MOVE WS-TIMESTAMP TO WS-BATCH-START. + + *> Load test data from FILLER; compute expected hash + MOVE 0 TO WS-HASH-EXPECTED. + PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 8 + MOVE FE-KEY(WS-I) TO TE-KEY(WS-I) + MOVE FE-NAME(WS-I) TO TE-NAME(WS-I) + MOVE FE-VALUE(WS-I) TO TE-VALUE(WS-I) + MOVE FE-CAT(WS-I) TO TE-CAT(WS-I) + ADD TE-VALUE(WS-I) TO WS-HASH-EXPECTED + END-PERFORM. + MOVE WS-HASH-EXPECTED TO WS-HASH-TOTAL. + + MOVE SPACES TO WS-TRACE-MSG. + STRING "1000-INIT: Hash total expected = " + WS-HASH-EXPECTED INTO WS-TRACE-MSG. + PERFORM WRITE-TRACE. + + PERFORM INIT-SEARCH-FILE. + EXIT. + + *> 2000-OPEN-FILES: Open all files with FILE STATUS check + 2000-OPEN-FILES SECTION. + MOVE "2000-OPEN-FILES: Opening files" TO WS-TRACE-MSG. + PERFORM WRITE-TRACE. + + OPEN I-O SEARCH-FILE. + MOVE "OPEN I-O SEARCH-FILE" TO WS-OP-DESC. + PERFORM CHECK-SRCH-STATUS. + + OPEN OUTPUT OUTPUT-FILE. + MOVE "OPEN OUTPUT OUTPUT-FILE" TO WS-OP-DESC. + PERFORM CHECK-OUT-STATUS. + + OPEN OUTPUT TXN-LOG-FILE. + MOVE "OPEN OUTPUT TXN-LOG-FILE" TO WS-OP-DESC. + PERFORM CHECK-TXN-STATUS. + + OPEN OUTPUT AUDIT-FILE. + MOVE "OPEN OUTPUT AUDIT-FILE" TO WS-OP-DESC. + PERFORM CHECK-AUD-STATUS. + + *> TXN-LOG header + PERFORM GET-TIMESTAMP. + MOVE SPACES TO TXN-REC. + STRING "TXN-LOG START: " WS-TIMESTAMP + " BATCH=" WS-BATCH-ID INTO TXN-REC. + WRITE TXN-REC. + MOVE "WRITE TXN-LOG HEADER" TO WS-OP-DESC. + PERFORM CHECK-TXN-STATUS. + EXIT. + + *> 3000-READ-INPUT: Execute four search tests + 3000-READ-INPUT SECTION. + MOVE "3000-READ-INPUT: Starting tests" TO WS-TRACE-MSG. + PERFORM WRITE-TRACE. + + *> Test 1: EXACT search CUST000003 + MOVE "EXACT" TO WS-MODE. + MOVE "CUST000003" TO WS-SEARCH-KEY. + DISPLAY "=== Test 1: Single key search ===". + PERFORM WRITE-HEADER. + PERFORM 3100-VALIDATE-RECORD. + MOVE "Test 1: EXACT search for CUST000003" + TO WS-TRACE-MSG. + PERFORM WRITE-TRACE. + IF KEY-IS-VALID + PERFORM 3200-PROCESS-RECORD + ELSE + MOVE SPACES TO WS-TRACE-MSG + STRING "Test 1: Key INVALID: " WS-SEARCH-KEY + INTO WS-TRACE-MSG + PERFORM WRITE-TRACE. + DISPLAY " Found: " WS-RECORD-COUNT. + + *> Test 2: RANGE CUST000002 to CUST000005 + MOVE "RANGE" TO WS-MODE. + MOVE "CUST000002" TO WS-RANGE-START. + MOVE "CUST000005" TO WS-RANGE-END. + DISPLAY "=== Test 2: Range search ===". + PERFORM WRITE-HEADER. + MOVE "Test 2: RANGE search CUST000002-000005" + TO WS-TRACE-MSG. + PERFORM WRITE-TRACE. + PERFORM 3100-VALIDATE-RECORD. + IF KEY-IS-VALID + PERFORM 3200-PROCESS-RECORD + ELSE + MOVE SPACES TO WS-TRACE-MSG + STRING "Test 2: Range start INVALID: " + WS-RANGE-START INTO WS-TRACE-MSG + PERFORM WRITE-TRACE. + DISPLAY " Found: " WS-RECORD-COUNT. + + *> Test 3: ALL (full table scan) + MOVE "ALL" TO WS-MODE. + DISPLAY "=== Test 3: Full scan ===". + PERFORM WRITE-HEADER. + MOVE "Test 3: ALL scan (full table)" TO WS-TRACE-MSG. + PERFORM WRITE-TRACE. + PERFORM 3100-VALIDATE-RECORD. + IF KEY-IS-VALID + PERFORM 3200-PROCESS-RECORD + ELSE + MOVE "Test 3: mode ALL validation OK" + TO WS-TRACE-MSG + PERFORM WRITE-TRACE. + DISPLAY " Found: " WS-RECORD-COUNT. + + *> Test 4: RANGE with no results (ZZZZ...) + MOVE "RANGE" TO WS-MODE. + MOVE "ZZZZZZZZZZ" TO WS-RANGE-START. + MOVE "ZZZZZZZZZZ" TO WS-RANGE-END. + DISPLAY "=== Test 4: Range with no results ===". + PERFORM WRITE-HEADER. + MOVE "Test 4: RANGE ZZZZZZZZZZ (no results)" + TO WS-TRACE-MSG. + PERFORM WRITE-TRACE. + PERFORM 3100-VALIDATE-RECORD. + IF KEY-IS-VALID + PERFORM 3200-PROCESS-RECORD + ELSE + MOVE SPACES TO WS-TRACE-MSG + STRING "Test 4: Range start INVALID: " + WS-RANGE-START INTO WS-TRACE-MSG + PERFORM WRITE-TRACE. + DISPLAY " Found: " WS-RECORD-COUNT. + EXIT. + + *> 3100-VALIDATE-RECORD: Key format + row existence (EXACT) + 3100-VALIDATE-RECORD SECTION. + MOVE "3100-VALIDATE-RECORD: Validating key" + TO WS-TRACE-MSG. + PERFORM WRITE-TRACE. + + EVALUATE TRUE + WHEN MODE-EXACT + MOVE WS-SEARCH-KEY TO WS-KEY-FULL + PERFORM CHECK-KEY-FORMAT + WHEN MODE-RANGE + MOVE WS-RANGE-START TO WS-KEY-FULL + PERFORM CHECK-KEY-FORMAT + WHEN MODE-ALL + SET KEY-IS-VALID TO TRUE + END-EVALUATE. + + IF KEY-NOT-VALID + MOVE SPACES TO WS-TRACE-MSG + STRING "3100: Key format invalid: " + WS-KEY-FULL INTO WS-TRACE-MSG + PERFORM WRITE-TRACE + MOVE "INVALID KEY FORMAT" TO WS-ERROR-TEXT + MOVE "99" TO WS-ERROR-CODE + PERFORM LOG-ERROR + EXIT SECTION. + + *> EXACT mode: verify row existence with detailed logging + IF MODE-EXACT + MOVE WS-SEARCH-KEY TO SRCH-KEY + READ SEARCH-FILE KEY IS SRCH-KEY + INVALID KEY + SET ROW-NOT-FOUND TO TRUE + MOVE SPACES TO WS-TRACE-MSG + STRING "3100: ROW NOT FOUND key=" + WS-SEARCH-KEY INTO WS-TRACE-MSG + PERFORM WRITE-TRACE + MOVE SPACES TO WS-TRACE-MSG + STRING "3100: Row does not exist for key " + WS-SEARCH-KEY INTO WS-TRACE-MSG + PERFORM WRITE-TRACE + MOVE SPACES TO OUTPUT-REC + STRING " ROW NOT FOUND: " + WS-SEARCH-KEY INTO OUTPUT-REC + WRITE OUTPUT-REC + MOVE "WRITE ROW-NOT-FOUND" TO WS-OP-DESC + PERFORM CHECK-OUT-STATUS + NOT INVALID KEY + SET ROW-IS-FOUND TO TRUE + MOVE SPACES TO WS-TRACE-MSG + STRING "3100: Row EXISTS for key " + WS-SEARCH-KEY INTO WS-TRACE-MSG + PERFORM WRITE-TRACE + END-READ + MOVE "READ EXACT (existence check)" TO WS-OP-DESC + PERFORM CHECK-SRCH-STATUS + ELSE + SET ROW-IS-FOUND TO TRUE. + EXIT. + + *> 3200-PROCESS-RECORD: Execute the search operation + 3200-PROCESS-RECORD SECTION. + MOVE "3200-PROCESS-RECORD: Executing search" + TO WS-TRACE-MSG. + PERFORM WRITE-TRACE. + + EVALUATE TRUE + WHEN MODE-EXACT + ADD 1 TO WS-EXACT-COUNT + MOVE 0 TO WS-PERF-COUNT + PERFORM SEARCH-EXACT + MOVE WS-PERF-COUNT TO WS-EXACT-READS + WHEN MODE-RANGE + ADD 1 TO WS-RANGE-COUNT + MOVE 0 TO WS-PERF-COUNT + PERFORM SEARCH-RANGE + MOVE WS-PERF-COUNT TO WS-RANGE-READS + WHEN MODE-ALL + ADD 1 TO WS-ALL-COUNT + MOVE 0 TO WS-PERF-COUNT + PERFORM SEARCH-ALL + MOVE WS-PERF-COUNT TO WS-ALL-READS + END-EVALUATE. + + PERFORM 3300-WRITE-OUTPUT. + EXIT. + + *> 3300-WRITE-OUTPUT: Update stats and write TXN log + 3300-WRITE-OUTPUT SECTION. + PERFORM GET-TIMESTAMP. + + *> Update statistics + EVALUATE TRUE + WHEN MODE-EXACT + ADD WS-RECORD-COUNT TO WS-EXACT-FOUND + WHEN MODE-RANGE + ADD WS-RECORD-COUNT TO WS-RANGE-FOUND + WHEN MODE-ALL + ADD WS-RECORD-COUNT TO WS-ALL-FOUND + END-EVALUATE. + + *> Write transaction log record + MOVE SPACES TO WS-TXN-LINE. + MOVE WS-TIMESTAMP TO TXN-TS. + MOVE WS-MODE TO TXN-MODE. + MOVE WS-SEARCH-KEY TO TXN-KEY. + MOVE WS-RECORD-COUNT TO TXN-RECORDS. + MOVE WS-TOTAL-VALUE TO TXN-VALUE-SUM. + MOVE WS-TXN-LINE TO TXN-REC. + WRITE TXN-REC. + MOVE "WRITE TXN-LOG RECORD" TO WS-OP-DESC. + PERFORM CHECK-TXN-STATUS. + + MOVE SPACES TO WS-TRACE-MSG. + STRING "3300: TXN logged mode=" WS-MODE + " records=" WS-RECORD-COUNT INTO WS-TRACE-MSG. + PERFORM WRITE-TRACE. + EXIT. + + *> 4000-REPORT: Summary report with stats, hash, perf + 4000-REPORT SECTION. + MOVE "4000-REPORT: Generating summary" TO WS-TRACE-MSG. + PERFORM WRITE-TRACE. + + MOVE SPACES TO OUTPUT-REC. + WRITE OUTPUT-REC. + MOVE "WRITE REPORT SEPARATOR" TO WS-OP-DESC. + PERFORM CHECK-OUT-STATUS. + + MOVE "=== SEARCH SUMMARY ===" TO OUTPUT-REC. + WRITE OUTPUT-REC. + MOVE "WRITE SUMMARY HEADER" TO WS-OP-DESC. + PERFORM CHECK-OUT-STATUS. + + MOVE SPACES TO OUTPUT-REC. + WRITE OUTPUT-REC. + + *> Operation type statistics + MOVE SPACES TO OUTPUT-REC. + STRING "EXACT searches: " WS-EXACT-COUNT + " total, " WS-EXACT-FOUND " records found" + INTO OUTPUT-REC. + WRITE OUTPUT-REC. + MOVE "WRITE EXACT STATS" TO WS-OP-DESC. + PERFORM CHECK-OUT-STATUS. + + MOVE SPACES TO OUTPUT-REC. + STRING "RANGE searches: " WS-RANGE-COUNT + " total, " WS-RANGE-FOUND " records found" + INTO OUTPUT-REC. + WRITE OUTPUT-REC. + MOVE "WRITE RANGE STATS" TO WS-OP-DESC. + PERFORM CHECK-OUT-STATUS. + + MOVE SPACES TO OUTPUT-REC. + STRING "ALL searches: " WS-ALL-COUNT + " total, " WS-ALL-FOUND " records found" + INTO OUTPUT-REC. + WRITE OUTPUT-REC. + MOVE "WRITE ALL STATS" TO WS-OP-DESC. + PERFORM CHECK-OUT-STATUS. + + *> Hash totals + MOVE SPACES TO OUTPUT-REC. + STRING "Hash total (sum of SRCH-VALUE): " + WS-HASH-TOTAL INTO OUTPUT-REC. + WRITE OUTPUT-REC. + MOVE "WRITE HASH TOTAL" TO WS-OP-DESC. + PERFORM CHECK-OUT-STATUS. + + MOVE SPACES TO OUTPUT-REC. + STRING "Hash expected (from test data init): " + WS-HASH-EXPECTED INTO OUTPUT-REC. + WRITE OUTPUT-REC. + MOVE "WRITE HASH EXPECTED" TO WS-OP-DESC. + PERFORM CHECK-OUT-STATUS. + + IF WS-HASH-TOTAL NOT = WS-HASH-EXPECTED + MOVE SPACES TO OUTPUT-REC + STRING "*** HASH MISMATCH: " WS-HASH-TOTAL + " vs " WS-HASH-EXPECTED INTO OUTPUT-REC + WRITE OUTPUT-REC + MOVE "WRITE HASH MISMATCH" TO WS-OP-DESC + PERFORM CHECK-OUT-STATUS + MOVE "HASH MISMATCH DETECTED" TO WS-ERROR-TEXT + MOVE "HM" TO WS-ERROR-CODE + PERFORM LOG-ERROR + ELSE + MOVE "Hash verification: PASSED" TO OUTPUT-REC + WRITE OUTPUT-REC + MOVE "WRITE HASH PASS" TO WS-OP-DESC + PERFORM CHECK-OUT-STATUS. + + *> Batch control totals + MOVE SPACES TO OUTPUT-REC. + WRITE OUTPUT-REC. + MOVE SPACES TO OUTPUT-REC. + STRING "Batch ID: " WS-BATCH-ID INTO OUTPUT-REC. + WRITE OUTPUT-REC. + MOVE "WRITE BATCH ID" TO WS-OP-DESC. + PERFORM CHECK-OUT-STATUS. + + MOVE SPACES TO OUTPUT-REC. + STRING "Batch start: " WS-BATCH-START INTO OUTPUT-REC. + WRITE OUTPUT-REC. + MOVE "WRITE BATCH START" TO WS-OP-DESC. + PERFORM CHECK-OUT-STATUS. + + *> Performance metrics + MOVE SPACES TO OUTPUT-REC. + WRITE OUTPUT-REC. + MOVE SPACES TO OUTPUT-REC. + MOVE "=== PERFORMANCE METRICS (reads per mode) ===" + TO OUTPUT-REC. + WRITE OUTPUT-REC. + MOVE "WRITE PERF HEADER" TO WS-OP-DESC. + PERFORM CHECK-OUT-STATUS. + + MOVE SPACES TO OUTPUT-REC. + STRING "EXACT: " WS-EXACT-READS " READ operations" + INTO OUTPUT-REC. + WRITE OUTPUT-REC. + MOVE "WRITE PERF EXACT" TO WS-OP-DESC. + PERFORM CHECK-OUT-STATUS. + + MOVE SPACES TO OUTPUT-REC. + STRING "RANGE: " WS-RANGE-READS " READ operations" + INTO OUTPUT-REC. + WRITE OUTPUT-REC. + MOVE "WRITE PERF RANGE" TO WS-OP-DESC. + PERFORM CHECK-OUT-STATUS. + + MOVE SPACES TO OUTPUT-REC. + STRING "ALL: " WS-ALL-READS " READ operations" + INTO OUTPUT-REC. + WRITE OUTPUT-REC. + MOVE "WRITE PERF ALL" TO WS-OP-DESC. + PERFORM CHECK-OUT-STATUS. + EXIT. + + *> 5000-AUDIT: Write audit file with operation summary + 5000-AUDIT SECTION. + PERFORM GET-TIMESTAMP. + MOVE WS-TIMESTAMP TO WS-BATCH-END. + MOVE "5000-AUDIT: Writing audit report" TO WS-TRACE-MSG. + PERFORM WRITE-TRACE. + + *> Audit header + MOVE SPACES TO AUD-REC. + STRING "AUDIT REPORT - " WS-JOB-NAME + " BATCH " WS-BATCH-ID INTO AUD-REC. + WRITE AUD-REC. + MOVE "WRITE AUDIT HEADER" TO WS-OP-DESC. + PERFORM CHECK-AUD-STATUS. + + *> Batch timeline + MOVE SPACES TO AUD-REC. + STRING "Batch start: " WS-BATCH-START + " end: " WS-BATCH-END INTO AUD-REC. + WRITE AUD-REC. + MOVE "WRITE AUDIT TIMELINE" TO WS-OP-DESC. + PERFORM CHECK-AUD-STATUS. + + *> Operation counts by mode + MOVE SPACES TO AUD-REC. + STRING "Operator stats: EXACT=" WS-EXACT-COUNT + " RANGE=" WS-RANGE-COUNT + " ALL=" WS-ALL-COUNT INTO AUD-REC. + WRITE AUD-REC. + MOVE "WRITE AUDIT OPSTATS" TO WS-OP-DESC. + PERFORM CHECK-AUD-STATUS. + + *> Records found + MOVE SPACES TO AUD-REC. + STRING "Records found: EXACT=" WS-EXACT-FOUND + " RANGE=" WS-RANGE-FOUND + " ALL=" WS-ALL-FOUND INTO AUD-REC. + WRITE AUD-REC. + MOVE "WRITE AUDIT RECORDS" TO WS-OP-DESC. + PERFORM CHECK-AUD-STATUS. + + *> Hash verification + MOVE SPACES TO AUD-REC. + STRING "Hash total: " WS-HASH-TOTAL + " expected: " WS-HASH-EXPECTED INTO AUD-REC. + WRITE AUD-REC. + MOVE "WRITE AUDIT HASH" TO WS-OP-DESC. + PERFORM CHECK-AUD-STATUS. + + IF WS-HASH-TOTAL = WS-HASH-EXPECTED + MOVE "Hash integrity: PASSED" TO AUD-REC + ELSE + MOVE "Hash integrity: FAILED" TO AUD-REC. + WRITE AUD-REC. + MOVE "WRITE AUDIT INTEGRITY" TO WS-OP-DESC. + PERFORM CHECK-AUD-STATUS. + + *> Performance metrics + MOVE SPACES TO AUD-REC. + STRING "Performance: EXACT-READS=" WS-EXACT-READS + " RANGE-READS=" WS-RANGE-READS + " ALL-READS=" WS-ALL-READS INTO AUD-REC. + WRITE AUD-REC. + MOVE "WRITE AUDIT PERF" TO WS-OP-DESC. + PERFORM CHECK-AUD-STATUS. + + *> Batch control totals + MOVE SPACES TO AUD-REC. + STRING "Batch " WS-BATCH-ID " completed at " + WS-BATCH-END INTO AUD-REC. + WRITE AUD-REC. + MOVE "WRITE AUDIT BATCH" TO WS-OP-DESC. + PERFORM CHECK-AUD-STATUS. + + MOVE SPACES TO AUD-REC. + STRING "Total records found: " + WS-EXACT-FOUND " + " WS-RANGE-FOUND + " + " WS-ALL-FOUND INTO AUD-REC. + WRITE AUD-REC. + MOVE "WRITE AUDIT TOTAL" TO WS-OP-DESC. + PERFORM CHECK-AUD-STATUS. + + MOVE SPACES TO AUD-REC. + WRITE AUD-REC. + MOVE SPACES TO AUD-REC. + STRING "*** END OF AUDIT REPORT ***" INTO AUD-REC. + WRITE AUD-REC. + MOVE "WRITE AUDIT END" TO WS-OP-DESC. + PERFORM CHECK-AUD-STATUS. + EXIT. + + *> 6000-ERROR-HANDLE: Batch error summary placeholder + 6000-ERROR-HANDLE SECTION. + MOVE "6000-ERROR-HANDLE: Checking for errors" + TO WS-TRACE-MSG. + PERFORM WRITE-TRACE. + + PERFORM GET-TIMESTAMP. + MOVE SPACES TO WS-TRACE-MSG. + STRING "6000: Error handling complete at " + WS-TIMESTAMP INTO WS-TRACE-MSG. + PERFORM WRITE-TRACE. + EXIT. + + *> 9000-EXIT: Close files, write TXN trailer, terminate + 9000-EXIT SECTION. + MOVE "9000-EXIT: Closing files" TO WS-TRACE-MSG. + PERFORM WRITE-TRACE. + + *> TXN-LOG trailer + PERFORM GET-TIMESTAMP. + MOVE SPACES TO TXN-REC. + STRING "TXN-LOG END: " WS-TIMESTAMP + " BATCH=" WS-BATCH-ID INTO TXN-REC. + WRITE TXN-REC. + MOVE "WRITE TXN-LOG TRAILER" TO WS-OP-DESC. + PERFORM CHECK-TXN-STATUS. + + *> Close all files + CLOSE SEARCH-FILE. + MOVE "CLOSE SEARCH-FILE" TO WS-OP-DESC. + PERFORM CHECK-SRCH-STATUS. + CLOSE OUTPUT-FILE. + MOVE "CLOSE OUTPUT-FILE" TO WS-OP-DESC. + PERFORM CHECK-OUT-STATUS. + CLOSE TXN-LOG-FILE. + MOVE "CLOSE TXN-LOG-FILE" TO WS-OP-DESC. + PERFORM CHECK-TXN-STATUS. + CLOSE AUDIT-FILE. + MOVE "CLOSE AUDIT-FILE" TO WS-OP-DESC. + PERFORM CHECK-AUD-STATUS. + + MOVE "9000-EXIT: All files closed" TO WS-TRACE-MSG. + PERFORM WRITE-TRACE. + + DISPLAY SPACE. + DISPLAY "Program Main26DbSearch completed normally". + DISPLAY SPACE. + EXIT. + + *> SUPPORTING PARAGRAPHS + + *> INIT-SEARCH-FILE: Create and populate SEARCH-FILE + INIT-SEARCH-FILE. + OPEN OUTPUT SEARCH-FILE. + MOVE "OPEN OUTPUT SEARCH-FILE (INIT)" TO WS-OP-DESC. + PERFORM CHECK-SRCH-STATUS. + CLOSE SEARCH-FILE. + MOVE "CLOSE SEARCH-FILE (INIT)" TO WS-OP-DESC. + PERFORM CHECK-SRCH-STATUS. + OPEN I-O SEARCH-FILE. + MOVE "OPEN I-O SEARCH-FILE (INIT)" TO WS-OP-DESC. + PERFORM CHECK-SRCH-STATUS. + + MOVE 0 TO WS-HASH-TOTAL. + PERFORM VARYING IDX FROM 1 BY 1 UNTIL IDX > 8 + MOVE FE-KEY(IDX) TO SRCH-KEY + MOVE FE-NAME(IDX) TO SRCH-NAME + MOVE FE-VALUE(IDX) TO SRCH-VALUE + MOVE FE-CAT(IDX) TO SRCH-CATEGORY + WRITE SRCH-RECORD + INVALID KEY + DISPLAY "INIT WRITE FAILED KEY=" SRCH-KEY + " STATUS=" SRCH-STATUS + MOVE "INIT WRITE FAILED" TO WS-ERROR-TEXT + MOVE SRCH-STATUS TO WS-ERROR-CODE + PERFORM LOG-ERROR + NOT INVALID KEY + ADD SRCH-VALUE TO WS-HASH-TOTAL + END-WRITE + MOVE "WRITE INIT RECORD" TO WS-OP-DESC + PERFORM CHECK-SRCH-STATUS + END-PERFORM. + + CLOSE SEARCH-FILE. + MOVE "CLOSE SEARCH-FILE (POST-INIT)" TO WS-OP-DESC. + PERFORM CHECK-SRCH-STATUS. + OPEN I-O SEARCH-FILE. + MOVE "OPEN I-O SEARCH-FILE (POST-INIT)" TO WS-OP-DESC. + PERFORM CHECK-SRCH-STATUS. + + MOVE SPACES TO WS-TRACE-MSG. + STRING "INIT-SEARCH-FILE done. Hash total=" + WS-HASH-TOTAL INTO WS-TRACE-MSG. + PERFORM WRITE-TRACE. + EXIT. + + *> WRITE-HEADER: Column header to OUTPUT-FILE + WRITE-HEADER. + MOVE WS-HEADER-LINE TO OUTPUT-REC. + WRITE OUTPUT-REC. + MOVE "WRITE HEADER" TO WS-OP-DESC. + PERFORM CHECK-OUT-STATUS. + MOVE SPACES TO OUTPUT-REC. + WRITE OUTPUT-REC. + MOVE "WRITE HEADER SPACE" TO WS-OP-DESC. + PERFORM CHECK-OUT-STATUS. + + *> SEARCH-EXACT: Exact-match READ + SEARCH-EXACT. + MOVE 0 TO WS-RECORD-COUNT. + MOVE 0 TO WS-TOTAL-VALUE. + MOVE WS-SEARCH-KEY TO SRCH-KEY. + READ SEARCH-FILE KEY IS SRCH-KEY + INVALID KEY + DISPLAY " NOT FOUND" + MOVE " NOT FOUND" TO OUTPUT-REC + WRITE OUTPUT-REC + MOVE "WRITE NOT-FOUND" TO WS-OP-DESC + PERFORM CHECK-OUT-STATUS + NOT INVALID KEY + ADD 1 TO WS-RECORD-COUNT + ADD SRCH-VALUE TO WS-TOTAL-VALUE + MOVE SRCH-KEY TO DL-KEY + MOVE SRCH-NAME TO DL-NAME + MOVE SRCH-VALUE TO DL-VALUE + MOVE SRCH-CATEGORY TO DL-CAT + DISPLAY " " WS-DETAIL-LINE + MOVE WS-DETAIL-LINE TO OUTPUT-REC + WRITE OUTPUT-REC + MOVE "WRITE EXACT DETAIL" TO WS-OP-DESC + PERFORM CHECK-OUT-STATUS + END-READ. + MOVE "READ EXACT" TO WS-OP-DESC. + PERFORM CHECK-SRCH-STATUS. + ADD 1 TO WS-PERF-COUNT. + + *> SEARCH-RANGE: Range search WS-RANGE-START to END + SEARCH-RANGE. + MOVE 0 TO WS-RECORD-COUNT. + MOVE 0 TO WS-TOTAL-VALUE. + MOVE WS-RANGE-START TO SRCH-KEY. + START SEARCH-FILE KEY IS NOT LESS THAN SRCH-KEY + INVALID KEY + DISPLAY " START FAILED" + MOVE " RANGE START FAILED" TO OUTPUT-REC + WRITE OUTPUT-REC + MOVE "WRITE RANGE START FAIL" TO WS-OP-DESC + PERFORM CHECK-OUT-STATUS + MOVE "START RANGE INVALID" TO WS-OP-DESC + PERFORM CHECK-SRCH-STATUS + NOT INVALID KEY + MOVE "START RANGE OK" TO WS-OP-DESC + PERFORM CHECK-SRCH-STATUS + PERFORM UNTIL SRCH-EOF + READ SEARCH-FILE NEXT RECORD + AT END + SET SRCH-EOF TO TRUE + NOT AT END + ADD 1 TO WS-PERF-COUNT + IF SRCH-KEY > WS-RANGE-END + SET SRCH-EOF TO TRUE + ELSE + ADD 1 TO WS-RECORD-COUNT + ADD SRCH-VALUE TO WS-TOTAL-VALUE + MOVE SRCH-KEY TO DL-KEY + MOVE SRCH-NAME TO DL-NAME + MOVE SRCH-VALUE TO DL-VALUE + MOVE SRCH-CATEGORY TO DL-CAT + DISPLAY " " WS-DETAIL-LINE + MOVE WS-DETAIL-LINE + TO OUTPUT-REC + WRITE OUTPUT-REC + MOVE "WRITE RANGE DETAIL" + TO WS-OP-DESC + PERFORM CHECK-OUT-STATUS + END-IF + END-READ + IF NOT SRCH-EOF + MOVE "READ NEXT RANGE" TO WS-OP-DESC + PERFORM CHECK-SRCH-STATUS + END-IF + END-PERFORM + END-START. + + *> SEARCH-ALL: Full table scan from LOW-VALUES + SEARCH-ALL. + MOVE 0 TO WS-RECORD-COUNT. + MOVE 0 TO WS-TOTAL-VALUE. + MOVE LOW-VALUES TO SRCH-KEY. + START SEARCH-FILE KEY IS GREATER THAN SRCH-KEY + INVALID KEY + DISPLAY " START FAILED" + MOVE "START ALL INVALID" TO WS-OP-DESC + PERFORM CHECK-SRCH-STATUS + NOT INVALID KEY + MOVE "START ALL OK" TO WS-OP-DESC + PERFORM CHECK-SRCH-STATUS + PERFORM UNTIL SRCH-EOF + READ SEARCH-FILE NEXT RECORD + AT END + SET SRCH-EOF TO TRUE + NOT AT END + ADD 1 TO WS-PERF-COUNT + ADD 1 TO WS-RECORD-COUNT + ADD SRCH-VALUE TO WS-TOTAL-VALUE + MOVE SRCH-KEY TO DL-KEY + MOVE SRCH-NAME TO DL-NAME + MOVE SRCH-VALUE TO DL-VALUE + MOVE SRCH-CATEGORY TO DL-CAT + DISPLAY " " WS-DETAIL-LINE + MOVE WS-DETAIL-LINE TO OUTPUT-REC + WRITE OUTPUT-REC + MOVE "WRITE ALL DETAIL" + TO WS-OP-DESC + PERFORM CHECK-OUT-STATUS + END-READ + IF NOT SRCH-EOF + MOVE "READ NEXT ALL" TO WS-OP-DESC + PERFORM CHECK-SRCH-STATUS + END-IF + END-PERFORM + END-START. + + *> CHECK-KEY-FORMAT: Validate key = "CUST" + 6 digits + CHECK-KEY-FORMAT. + SET KEY-IS-VALID TO TRUE. + + *> Verify prefix is "CUST" + MOVE WS-KEY-FULL (1:4) TO WS-KEY-PREFIX-CHK. + IF WS-KEY-PREFIX-CHK NOT = WS-VALID-PREFIX + SET KEY-NOT-VALID TO TRUE + MOVE SPACES TO WS-TRACE-MSG + STRING "KEY-FMT: Prefix '" WS-KEY-PREFIX-CHK + "' != 'CUST'" INTO WS-TRACE-MSG + PERFORM WRITE-TRACE + EXIT PARAGRAPH. + + *> Verify suffix is 6 numeric digits (numeric check via MOVE) + MOVE WS-KEY-FULL (5:6) TO WS-KEY-SUFFIX-CHK. + MOVE WS-KEY-SUFFIX-CHK TO WS-KEY-SUFFIX-NUM. + MOVE WS-KEY-SUFFIX-NUM TO WS-KEY-SUFFIX-STR. + IF WS-KEY-SUFFIX-CHK NOT = WS-KEY-SUFFIX-STR + SET KEY-NOT-VALID TO TRUE + MOVE SPACES TO WS-TRACE-MSG + STRING "KEY-FMT: Suffix '" WS-KEY-SUFFIX-CHK + "' not numeric" INTO WS-TRACE-MSG + PERFORM WRITE-TRACE + EXIT PARAGRAPH. + + MOVE SPACES TO WS-TRACE-MSG. + STRING "KEY-FMT: Key format VALID for " + WS-KEY-FULL INTO WS-TRACE-MSG. + PERFORM WRITE-TRACE. + EXIT. + + *> GET-TIMESTAMP: Build YYYY-MM-DD HH:MM:SS + GET-TIMESTAMP. + MOVE FUNCTION CURRENT-DATE TO WS-CUR-DATE-STR. + MOVE WS-CUR-DATE-STR (1:8) TO WS-CUR-DATE-YMD. + MOVE WS-CUR-DATE-STR (9:8) TO WS-CUR-DATE-HMS. + STRING WS-CUR-DATE-YMD (1:4) "-" + WS-CUR-DATE-YMD (5:2) "-" + WS-CUR-DATE-YMD (7:2) INTO WS-TS-DATE. + STRING WS-CUR-DATE-HMS (1:2) ":" + WS-CUR-DATE-HMS (3:2) ":" + WS-CUR-DATE-HMS (5:2) INTO WS-TS-TIME. + + *> WRITE-TRACE: DISPLAY with timestamp prefix + WRITE-TRACE. + PERFORM GET-TIMESTAMP. + DISPLAY "[ " WS-TIMESTAMP " ] " WS-TRACE-MSG. + + *> FILE STATUS CHECK PARAGRAPHS (one per file) + CHECK-SRCH-STATUS. + IF SRCH-STATUS NOT = "00" AND SRCH-STATUS NOT = "10" + DISPLAY "*** FILE STATUS: SEARCH-FILE op=" WS-OP-DESC + " status=" SRCH-STATUS + MOVE SPACES TO WS-ERROR-TEXT + STRING "FILE ERR: " WS-OP-DESC DELIMITED BY SIZE + INTO WS-ERROR-TEXT + MOVE SRCH-STATUS TO WS-ERROR-CODE + PERFORM LOG-ERROR. + + CHECK-OUT-STATUS. + IF OUT-STATUS NOT = "00" + DISPLAY "*** FILE STATUS: OUTPUT-FILE op=" WS-OP-DESC + " status=" OUT-STATUS + MOVE SPACES TO WS-ERROR-TEXT + STRING "FILE ERR: " WS-OP-DESC DELIMITED BY SIZE + INTO WS-ERROR-TEXT + MOVE OUT-STATUS TO WS-ERROR-CODE + PERFORM LOG-ERROR. + + CHECK-TXN-STATUS. + IF TXN-STATUS NOT = "00" + DISPLAY "*** FILE STATUS: TXN-LOG op=" WS-OP-DESC + " status=" TXN-STATUS + MOVE SPACES TO WS-ERROR-TEXT + STRING "FILE ERR: " WS-OP-DESC DELIMITED BY SIZE + INTO WS-ERROR-TEXT + MOVE TXN-STATUS TO WS-ERROR-CODE + PERFORM LOG-ERROR. + + CHECK-AUD-STATUS. + IF AUD-STATUS NOT = "00" + DISPLAY "*** FILE STATUS: AUDIT-FILE op=" WS-OP-DESC + " status=" AUD-STATUS + MOVE SPACES TO WS-ERROR-TEXT + STRING "FILE ERR: " WS-OP-DESC DELIMITED BY SIZE + INTO WS-ERROR-TEXT + MOVE AUD-STATUS TO WS-ERROR-CODE + PERFORM LOG-ERROR. + + *> LOG-ERROR: Write error to AUDIT-FILE + *> (caller must set WS-ERROR-TEXT and WS-ERROR-CODE first) + LOG-ERROR. + PERFORM GET-TIMESTAMP. + MOVE SPACES TO AUD-REC. + STRING "ERROR: " WS-ERROR-TEXT + " CODE=" WS-ERROR-CODE + INTO AUD-REC. + WRITE AUD-REC. + MOVE "WRITE AUDIT ERROR LOG" TO WS-OP-DESC. + PERFORM CHECK-AUD-STATUS. diff --git a/benchmark-programs/27-validation-halfwidth/FILE-IN.DAT b/benchmark-programs/27-validation-halfwidth/FILE-IN.DAT new file mode 100644 index 0000000..1eb12b8 --- /dev/null +++ b/benchmark-programs/27-validation-halfwidth/FILE-IN.DAT @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/benchmark-programs/27-validation-halfwidth/README.md b/benchmark-programs/27-validation-halfwidth/README.md new file mode 100644 index 0000000..3de6fb0 --- /dev/null +++ b/benchmark-programs/27-validation-halfwidth/README.md @@ -0,0 +1,75 @@ +# 27-validation-halfwidth: Half-Width Character Validation + +## 电信业务场景 + +电话号码格式校验。检查电话号码字段是否全为半角数字(0-9)，检测全角字符混入和长度超出。 + +## Description + +Reads FILE-IN and validates that each character in IN-TEXT is +half-width (ASCII printable: X'20'-X'7E'). Validates length +constraints: 20 or fewer half-width characters pass; more than 20 +is an error. Full-width characters or control characters cause +rejection. + +## Validation Rules + +| Rule | Result | Error Code | +|-----------------------------------|--------------|------------| +| All characters X'20'-X'7E', <= 20 | PASS to GOOD | - | +| Contains non-half-width character | FAIL to BAD | 01 | +| All half-width but >20 chars | FAIL to BAD | 02 | + +## Record Layout + +### Input / Good Output (30 bytes) + +| Field | Type | Length | Description | +|--------|----------|--------|-------------| +| TEXT | PIC X | 30 | Text to validate | + +### Bad Output (32 bytes) + +| Field | Type | Length | Description | +|----------|----------|--------|----------------| +| TEXT | PIC X | 30 | Original text | +| ERR-CODE | PIC X | 2 | Error code | + +## Files + +| File | Purpose | +|-------------------------------|--------------------------------| +| main-27-validation-halfwidth.cbl | Main COBOL program | +| data-gen.sh | Generate test data | +| run.sh | Compile, run, verify | +| README.md | This file | + +## Tests + +| Test Case | Expected | +|----------------------------------|-----------------------------| +| 4 half-width chars | PASS to GOOD | +| 10 half-width chars | PASS to GOOD | +| 20 half-width chars (boundary) | PASS to GOOD | +| 25 half-width chars (too long) | FAIL err 02 | +| Mixed with full-width | FAIL err 01 | +| Full-width only | FAIL err 01 | +| Half-width + control char | FAIL err 01 | +| All spaces (empty) | PASS to GOOD | + +## Usage + +```bash +cd 27-validation-halfwidth +bash data-gen.sh +bash run.sh +``` + +## Expected Behavior + +- Half-width check uses byte comparison against X'20'-X'7E'. +- Full-width UTF-8 multi-byte characters have bytes > X'7E' + and are detected as non-half-width. +- Length is computed by trimming trailing spaces. +- Only records meeting both conditions (half-width + <= 20 chars) + are written to GOOD output. diff --git a/benchmark-programs/27-validation-halfwidth/file-out-audit.dat b/benchmark-programs/27-validation-halfwidth/file-out-audit.dat new file mode 100644 index 0000000..75a458b --- /dev/null +++ b/benchmark-programs/27-validation-halfwidth/file-out-audit.dat @@ -0,0 +1 @@ +=== AUDIT LOG === Program: ValidationHalfwidth Timestamp: 2026-06-22 16:35:27 Records read : 000000001 Records good : 000000001 Records bad : 000000000 Records skip : 000000000 Warnings : 000000001 Errors : 000000000 Hash total : 000000000000000 Rules: HALF-FORMAT-LENGTH-PREFIX Severity: W=Warning, E=Error Input : file-in.dat Output: file-out-good.dat Output: file-out-bad.dat Output: file-out-report.dat Output: file-out-audit.dat === END AUDIT === \ No newline at end of file diff --git a/benchmark-programs/27-validation-halfwidth/file-out-bad.dat b/benchmark-programs/27-validation-halfwidth/file-out-bad.dat new file mode 100644 index 0000000..e69de29 diff --git a/benchmark-programs/27-validation-halfwidth/file-out-good.dat b/benchmark-programs/27-validation-halfwidth/file-out-good.dat new file mode 100644 index 0000000..1eb12b8 --- /dev/null +++ b/benchmark-programs/27-validation-halfwidth/file-out-good.dat @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/benchmark-programs/27-validation-halfwidth/file-out-report.dat b/benchmark-programs/27-validation-halfwidth/file-out-report.dat new file mode 100644 index 0000000..53d8473 --- /dev/null +++ b/benchmark-programs/27-validation-halfwidth/file-out-report.dat @@ -0,0 +1 @@ +=== VALIDATION REPORT === Timestamp: 2026-06-22 16:35:27 Records read : 1 Records passed : 1 Records failed : 0 Records skipped : 0 Warnings issued : 1 Errors detected : 0 Total chars : 000000000000000 Total digits : 000000000000000 Hash total : 0 R1: Half-width check (X'20'-X'7E') R2: Character set (digits 0-9, leading +) R3: Length (mobile=11, landline=10-12) R4: Prefix lookup (China mobile/landline) === END OF REPORT === \ No newline at end of file diff --git a/benchmark-programs/27-validation-halfwidth/main-27-validation-halfwidth.cbl b/benchmark-programs/27-validation-halfwidth/main-27-validation-halfwidth.cbl new file mode 100644 index 0000000..3656835 --- /dev/null +++ b/benchmark-programs/27-validation-halfwidth/main-27-validation-halfwidth.cbl @@ -0,0 +1,841 @@ + *> ============================================================ + *> 27-validation-halfwidth : Phone Number Validation + *> Extended with SECTION structure, prefix validation, + *> phone length rules, audit/report files, severity levels, + *> batch control totals, FILE STATUS checks, DISPLAY tracing. + *> Input : FILE-IN (file-in.dat) + *> Output: FILE-OUT-GOOD, -BAD, -REPORT, -AUDIT + *> Coverage: VF-N005, VF-N006, VF-A001, VF-A002, VF-R001 + *> VF-P001, VF-P002, VF-P003, VF-L001, VF-S001 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. ValidationHalfwidth. + *> + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN ASSIGN TO 'file-in.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-FILE-IN-STATUS. + SELECT FILE-OUT-GOOD ASSIGN TO 'file-out-good.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FILE-GOOD-STATUS. + SELECT FILE-OUT-BAD ASSIGN TO 'file-out-bad.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FILE-BAD-STATUS. + SELECT FILE-OUT-REPORT + ASSIGN TO 'file-out-report.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FILE-REPORT-STATUS. + SELECT FILE-OUT-AUDIT + ASSIGN TO 'file-out-audit.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FILE-AUDIT-STATUS. + *> + DATA DIVISION. + FILE SECTION. + FD FILE-IN. + 01 IN-REC. + 05 IN-TEXT PIC X(30). + *> + FD FILE-OUT-GOOD. + 01 GOOD-REC. + 05 GOOD-TEXT PIC X(30). + *> + FD FILE-OUT-BAD. + 01 BAD-REC. + 05 BAD-TEXT PIC X(30). + 05 BAD-ERR-CODE PIC X(02). + *> + FD FILE-OUT-REPORT. + 01 REPORT-REC. + 05 REPORT-LINE PIC X(80). + *> + FD FILE-OUT-AUDIT. + 01 AUDIT-REC. + 05 AUDIT-LINE PIC X(80). + *> + WORKING-STORAGE SECTION. + 01 WS-TELECOM-REC. + COPY "telecom/TEL-BILLING.cpy". + *> File status fields + 01 WS-FILE-IN-STATUS PIC X(02). + 01 WS-FILE-GOOD-STATUS PIC X(02). + 01 WS-FILE-BAD-STATUS PIC X(02). + 01 WS-FILE-REPORT-STATUS PIC X(02). + 01 WS-FILE-AUDIT-STATUS PIC X(02). + *> EOF and loop control + 01 WS-EOF PIC X(01) VALUE 'N'. + 88 WS-EOF-YES VALUE 'Y' FALSE 'N'. + *> Record counts + 01 WS-TOTAL-READ PIC 9(09) VALUE ZERO. + 01 WS-GOOD-COUNT PIC 9(09) VALUE ZERO. + 01 WS-BAD-COUNT PIC 9(09) VALUE ZERO. + 01 WS-SKIP-COUNT PIC 9(09) VALUE ZERO. + 01 WS-WARN-COUNT PIC 9(09) VALUE ZERO. + 01 WS-ERROR-COUNT PIC 9(09) VALUE ZERO. + *> Batch control totals + 01 WS-TOTAL-CHARS PIC 9(15) VALUE ZERO. + 01 WS-TOTAL-DIGITS PIC 9(15) VALUE ZERO. + 01 WS-HASH-TOTAL PIC 9(15) VALUE ZERO. + *> Validation fields + 01 WS-IDX PIC 9(02). + 01 WS-CHAR PIC X(01). + 01 WS-ALL-HALF PIC X(01) VALUE 'Y'. + 88 WS-ALL-HALF-YES VALUE 'Y' FALSE 'N'. + 01 WS-TEXT-LEN PIC 9(02). + *> Multiple validation results + 01 WS-VALID-RESULT. + 05 WS-V-FORMAT PIC X(01) VALUE 'P'. + 88 WS-V-FORMAT-PASS VALUE 'P'. + 88 WS-V-FORMAT-FAIL VALUE 'F'. + 05 WS-V-LENGTH PIC X(01) VALUE 'P'. + 88 WS-V-LENGTH-PASS VALUE 'P'. + 88 WS-V-LENGTH-FAIL VALUE 'F'. + 05 WS-V-PREFIX PIC X(01) VALUE 'P'. + 88 WS-V-PREFIX-PASS VALUE 'P'. + 88 WS-V-PREFIX-FAIL VALUE 'F'. + 05 WS-V-HALF PIC X(01) VALUE 'P'. + 88 WS-V-HALF-PASS VALUE 'P'. + 88 WS-V-HALF-FAIL VALUE 'F'. + 01 WS-V-FORMAT-ERR PIC X(02). + 01 WS-V-LENGTH-ERR PIC X(02). + 01 WS-V-PREFIX-ERR PIC X(02). + 01 WS-V-HALF-ERR PIC X(02). + *> Error codes and severity + 01 WS-ERROR-CODE PIC X(02). + 01 WS-ERROR-SEVERITY PIC X(01). + 88 WS-SEVERITY-WARNING VALUE 'W'. + 88 WS-SEVERITY-ERROR VALUE 'E'. + 01 WS-ERROR-DETAIL PIC X(50). + *> Half-width range constants + 01 WS-HW-LOWER PIC X(01) VALUE X'20'. + 01 WS-HW-UPPER PIC X(01) VALUE X'7E'. + *> Phone number analysis + 01 WS-PHONE-TYPE PIC X(01). + 88 WS-PHONE-MOBILE VALUE 'M'. + 88 WS-PHONE-LANDLINE VALUE 'L'. + 88 WS-PHONE-UNKNOWN VALUE 'U'. + 01 WS-PHONE-DIGITS PIC X(30). + 01 WS-PHONE-DIGIT-COUNT PIC 9(02). + 01 WS-PREFIX-STR PIC X(06). + 01 WS-PREFIX-LEN PIC 9(02). + 01 WS-HAS-LEADING-PLUS PIC X(01) VALUE 'N'. + 88 WS-LEADING-PLUS-YES VALUE 'Y' FALSE 'N'. + *> + *> Known prefixes — China mobile (8613x, 8615x, 8618x) + 01 WS-MOBILE-PREFIX-TBL. + 05 FILLER PIC X(05) VALUE '86130'. + 05 FILLER PIC X(05) VALUE '86131'. + 05 FILLER PIC X(05) VALUE '86132'. + 05 FILLER PIC X(05) VALUE '86133'. + 05 FILLER PIC X(05) VALUE '86135'. + 05 FILLER PIC X(05) VALUE '86136'. + 05 FILLER PIC X(05) VALUE '86137'. + 05 FILLER PIC X(05) VALUE '86138'. + 05 FILLER PIC X(05) VALUE '86139'. + 05 FILLER PIC X(05) VALUE '86150'. + 05 FILLER PIC X(05) VALUE '86151'. + 05 FILLER PIC X(05) VALUE '86152'. + 05 FILLER PIC X(05) VALUE '86153'. + 05 FILLER PIC X(05) VALUE '86155'. + 05 FILLER PIC X(05) VALUE '86156'. + 05 FILLER PIC X(05) VALUE '86157'. + 05 FILLER PIC X(05) VALUE '86158'. + 05 FILLER PIC X(05) VALUE '86159'. + 05 FILLER PIC X(05) VALUE '86180'. + 05 FILLER PIC X(05) VALUE '86181'. + 05 FILLER PIC X(05) VALUE '86182'. + 05 FILLER PIC X(05) VALUE '86183'. + 05 FILLER PIC X(05) VALUE '86185'. + 05 FILLER PIC X(05) VALUE '86186'. + 05 FILLER PIC X(05) VALUE '86187'. + 05 FILLER PIC X(05) VALUE '86188'. + 05 FILLER PIC X(05) VALUE '86189'. + 01 WS-MOBILE-TABLE REDEFINES WS-MOBILE-PREFIX-TBL. + 05 WS-MOBILE-ITEM PIC X(05) OCCURS 27 TIMES. + 01 WS-MOBILE-PREFIX-COUNT PIC 9(02) VALUE 27. + *> + *> Known prefixes — China landline (city codes) + 01 WS-LL-PREFIX-TBL. + 05 FILLER PIC X(05) VALUE '86010'. + 05 FILLER PIC X(05) VALUE '86020'. + 05 FILLER PIC X(05) VALUE '86021'. + 05 FILLER PIC X(05) VALUE '86022'. + 05 FILLER PIC X(05) VALUE '86023'. + 05 FILLER PIC X(05) VALUE '86024'. + 05 FILLER PIC X(05) VALUE '86025'. + 05 FILLER PIC X(05) VALUE '86027'. + 05 FILLER PIC X(05) VALUE '86028'. + 05 FILLER PIC X(05) VALUE '86029'. + 05 FILLER PIC X(05) VALUE '86031'. + 05 FILLER PIC X(05) VALUE '86041'. + 05 FILLER PIC X(05) VALUE '86051'. + 05 FILLER PIC X(05) VALUE '86052'. + 05 FILLER PIC X(05) VALUE '86053'. + 05 FILLER PIC X(05) VALUE '86054'. + 05 FILLER PIC X(05) VALUE '86055'. + 05 FILLER PIC X(05) VALUE '86056'. + 05 FILLER PIC X(05) VALUE '86057'. + 05 FILLER PIC X(05) VALUE '86058'. + 05 FILLER PIC X(05) VALUE '86059'. + 05 FILLER PIC X(05) VALUE '86063'. + 05 FILLER PIC X(05) VALUE '86066'. + 05 FILLER PIC X(05) VALUE '86067'. + 05 FILLER PIC X(05) VALUE '86069'. + 05 FILLER PIC X(05) VALUE '86071'. + 05 FILLER PIC X(05) VALUE '86072'. + 05 FILLER PIC X(05) VALUE '86073'. + 05 FILLER PIC X(05) VALUE '86074'. + 05 FILLER PIC X(05) VALUE '86075'. + 05 FILLER PIC X(05) VALUE '86076'. + 05 FILLER PIC X(05) VALUE '86077'. + 05 FILLER PIC X(05) VALUE '86078'. + 05 FILLER PIC X(05) VALUE '86079'. + 05 FILLER PIC X(05) VALUE '86081'. + 05 FILLER PIC X(05) VALUE '86082'. + 05 FILLER PIC X(05) VALUE '86083'. + 05 FILLER PIC X(05) VALUE '86084'. + 05 FILLER PIC X(05) VALUE '86085'. + 05 FILLER PIC X(05) VALUE '86086'. + 05 FILLER PIC X(05) VALUE '86087'. + 05 FILLER PIC X(05) VALUE '86088'. + 05 FILLER PIC X(05) VALUE '86089'. + 05 FILLER PIC X(05) VALUE '86091'. + 05 FILLER PIC X(05) VALUE '86092'. + 05 FILLER PIC X(05) VALUE '86093'. + 05 FILLER PIC X(05) VALUE '86094'. + 05 FILLER PIC X(05) VALUE '86095'. + 05 FILLER PIC X(05) VALUE '86096'. + 05 FILLER PIC X(05) VALUE '86097'. + 05 FILLER PIC X(05) VALUE '86098'. + 05 FILLER PIC X(05) VALUE '86099'. + 01 WS-LL-TABLE REDEFINES WS-LL-PREFIX-TBL. + 05 WS-LL-ITEM PIC X(05) OCCURS 51 TIMES. + 01 WS-LL-PREFIX-COUNT PIC 9(02) VALUE 51. + *> + *> Timestamp and trace fields + 01 WS-CURRENT-TIME. + 05 WS-CURR-YEAR PIC X(04). + 05 WS-CURR-MONTH PIC X(02). + 05 WS-CURR-DAY PIC X(02). + 05 WS-CURR-HOUR PIC X(02). + 05 WS-CURR-MIN PIC X(02). + 05 WS-CURR-SEC PIC X(02). + 01 WS-TIMESTAMP PIC X(20). + 01 WS-TRACE-TS PIC X(20). + *> Report editing fields + 01 WS-ED-PASS PIC Z(09)9. + 01 WS-ED-FAIL PIC Z(09)9. + 01 WS-ED-SKIP PIC Z(09)9. + 01 WS-ED-WARN PIC Z(09)9. + 01 WS-ED-ERROR PIC Z(09)9. + 01 WS-ED-TOTAL PIC Z(09)9. + 01 WS-ED-HASH PIC Z(14)9. + *> Local variables + 01 WS-J PIC 9(02). + 01 WS-K PIC 9(02). + *> + *> ============================================================ + PROCEDURE DIVISION. + *> ============================================================ + MAIN SECTION. + MB-PROCESS. + PERFORM 1000-INIT. + PERFORM 2000-OPEN-FILES. + PERFORM 3000-READ-INPUT + UNTIL WS-EOF-YES. + PERFORM 4000-REPORT. + PERFORM 5000-AUDIT. + PERFORM 9000-EXIT. + STOP RUN. + *> + *> ============================================================ + *> 1000-INIT : Initialize counters, tables, batch timestamp + *> ============================================================ + 1000-INIT SECTION. + I1000-START. + DISPLAY 'ValidationHalfwidth: 1000-INIT starting...'. + MOVE ZERO TO WS-TOTAL-READ + WS-GOOD-COUNT + WS-BAD-COUNT + WS-SKIP-COUNT + WS-WARN-COUNT + WS-ERROR-COUNT + WS-TOTAL-CHARS + WS-TOTAL-DIGITS + WS-HASH-TOTAL. + MOVE 'N' TO WS-EOF. + MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-TIME. + STRING WS-CURR-YEAR '-' WS-CURR-MONTH '-' + WS-CURR-DAY ' ' WS-CURR-HOUR ':' + WS-CURR-MIN ':' WS-CURR-SEC + INTO WS-TIMESTAMP. + DISPLAY 'ValidationHalfwidth: Batch started at ' + WS-TIMESTAMP. + EXIT. + *> + *> ============================================================ + *> 2000-OPEN-FILES : Open all files with FILE STATUS checks + *> ============================================================ + 2000-OPEN-FILES SECTION. + I2000-START. + DISPLAY 'ValidationHalfwidth: 2000-OPEN-FILES starting...'. + OPEN INPUT FILE-IN. + IF WS-FILE-IN-STATUS NOT = '00' + MOVE 'E' TO WS-ERROR-SEVERITY + MOVE '10' TO WS-ERROR-CODE + STRING 'FILE-IN open failed, status=' + WS-FILE-IN-STATUS INTO WS-ERROR-DETAIL + PERFORM 6000-ERROR-HANDLE + END-IF. + OPEN OUTPUT FILE-OUT-GOOD. + IF WS-FILE-GOOD-STATUS NOT = '00' + MOVE 'E' TO WS-ERROR-SEVERITY + MOVE '11' TO WS-ERROR-CODE + STRING 'FILE-OUT-GOOD open failed, status=' + WS-FILE-GOOD-STATUS INTO WS-ERROR-DETAIL + PERFORM 6000-ERROR-HANDLE + END-IF. + OPEN OUTPUT FILE-OUT-BAD. + IF WS-FILE-BAD-STATUS NOT = '00' + MOVE 'E' TO WS-ERROR-SEVERITY + MOVE '12' TO WS-ERROR-CODE + STRING 'FILE-OUT-BAD open failed, status=' + WS-FILE-BAD-STATUS INTO WS-ERROR-DETAIL + PERFORM 6000-ERROR-HANDLE + END-IF. + OPEN OUTPUT FILE-OUT-REPORT. + IF WS-FILE-REPORT-STATUS NOT = '00' + MOVE 'E' TO WS-ERROR-SEVERITY + MOVE '13' TO WS-ERROR-CODE + STRING 'FILE-OUT-REPORT open failed, status=' + WS-FILE-REPORT-STATUS INTO WS-ERROR-DETAIL + PERFORM 6000-ERROR-HANDLE + END-IF. + OPEN OUTPUT FILE-OUT-AUDIT. + IF WS-FILE-AUDIT-STATUS NOT = '00' + MOVE 'E' TO WS-ERROR-SEVERITY + MOVE '14' TO WS-ERROR-CODE + STRING 'FILE-OUT-AUDIT open failed, status=' + WS-FILE-AUDIT-STATUS INTO WS-ERROR-DETAIL + PERFORM 6000-ERROR-HANDLE + END-IF. + DISPLAY 'ValidationHalfwidth: All files opened OK'. + EXIT. + *> + *> ============================================================ + *> 3000-READ-INPUT : Read loop — read record and dispatch + *> ============================================================ + 3000-READ-INPUT SECTION. + I3000-START. + PERFORM 3100-VALIDATE-RECORD THRU I3100-EXIT. + IF NOT WS-EOF-YES + PERFORM 3200-PROCESS-RECORD + PERFORM 3300-WRITE-OUTPUT + END-IF. + EXIT. + *> + *> ============================================================ + *> 3100-VALIDATE-RECORD : Full validation pipeline + *> R1: Half-width check + *> R2: Character set (digits 0-9, optional leading +) + *> R3: Length check (mobile=11, landline=10-12) + *> R4: Prefix lookup (China mobile/landline) + *> R5: Format rules for mobile vs landline + *> ============================================================ + 3100-VALIDATE-RECORD SECTION. + I3100-START. + MOVE 'P' TO WS-V-FORMAT WS-V-LENGTH WS-V-PREFIX WS-V-HALF. + MOVE SPACES TO WS-V-FORMAT-ERR WS-V-LENGTH-ERR + WS-V-PREFIX-ERR WS-V-HALF-ERR + WS-ERROR-CODE WS-ERROR-DETAIL + WS-PHONE-TYPE. + MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-TIME. + STRING WS-CURR-HOUR ':' WS-CURR-MIN ':' + WS-CURR-SEC INTO WS-TRACE-TS. + DISPLAY '3100-VALIDATE-RECORD: [' + WS-TRACE-TS '] Processing: "' + FUNCTION TRIM(IN-TEXT) '"'. + READ FILE-IN + AT END + SET WS-EOF-YES TO TRUE + DISPLAY '3100-VALIDATE-RECORD: EOF reached' + EXIT PARAGRAPH + NOT AT END + DISPLAY '3100-VALIDATE-RECORD: Read OK status=' + WS-FILE-IN-STATUS + END-READ. + IF WS-EOF-YES + EXIT + END-IF. + IF WS-FILE-IN-STATUS NOT = '00' + MOVE 'E' TO WS-ERROR-SEVERITY + MOVE '15' TO WS-ERROR-CODE + STRING 'READ failed, status=' WS-FILE-IN-STATUS + INTO WS-ERROR-DETAIL + PERFORM 6000-ERROR-HANDLE + END-IF. + ADD 1 TO WS-TOTAL-READ. + *> + *> R1: Half-width check (original logic preserved) + MOVE 'Y' TO WS-ALL-HALF. + PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > 30 + MOVE IN-TEXT(WS-IDX:1) TO WS-CHAR + IF WS-CHAR = SPACE + CONTINUE + ELSE + IF WS-CHAR < WS-HW-LOWER + MOVE 'N' TO WS-ALL-HALF + END-IF + IF WS-CHAR > WS-HW-UPPER + MOVE 'N' TO WS-ALL-HALF + END-IF + END-IF + END-PERFORM. + IF NOT WS-ALL-HALF-YES + MOVE 'F' TO WS-V-HALF + MOVE '01' TO WS-V-HALF-ERR + MOVE 'E' TO WS-ERROR-SEVERITY + DISPLAY '3100-VALIDATE-RECORD: HALF-WIDTH FAIL' + END-IF. + *> + *> R2: Character set check — extract digits, allow leading + + MOVE SPACES TO WS-PHONE-DIGITS. + MOVE ZERO TO WS-PHONE-DIGIT-COUNT. + MOVE 'N' TO WS-HAS-LEADING-PLUS. + PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > 30 + MOVE IN-TEXT(WS-IDX:1) TO WS-CHAR + IF WS-CHAR = SPACE + EXIT PERFORM + END-IF + IF WS-IDX = 1 AND WS-CHAR = '+' + MOVE 'Y' TO WS-HAS-LEADING-PLUS + CONTINUE + END-IF + IF WS-CHAR >= '0' AND WS-CHAR <= '9' + ADD 1 TO WS-PHONE-DIGIT-COUNT + MOVE WS-CHAR TO + WS-PHONE-DIGITS(WS-PHONE-DIGIT-COUNT:1) + ELSE + IF WS-CHAR NOT = SPACE + MOVE 'F' TO WS-V-FORMAT + MOVE '02' TO WS-V-FORMAT-ERR + MOVE 'E' TO WS-ERROR-SEVERITY + END-IF + END-IF + END-PERFORM. + ADD WS-PHONE-DIGIT-COUNT TO WS-TOTAL-DIGITS. + ADD FUNCTION NUMVAL(WS-PHONE-DIGITS) TO WS-HASH-TOTAL + ON SIZE ERROR + ADD 1 TO WS-HASH-TOTAL + END-ADD. + *> + *> R3: Determine phone type from prefix, validate length + MOVE SPACES TO WS-PREFIX-STR. + MOVE ZERO TO WS-PREFIX-LEN. + IF WS-PHONE-DIGIT-COUNT >= 5 + MOVE WS-PHONE-DIGITS(1:5) TO WS-PREFIX-STR + MOVE 5 TO WS-PREFIX-LEN + END-IF. + MOVE 'U' TO WS-PHONE-TYPE. + IF WS-PREFIX-LEN = 5 + PERFORM VARYING WS-J FROM 1 BY 1 + UNTIL WS-J > WS-MOBILE-PREFIX-COUNT + IF WS-PREFIX-STR = WS-MOBILE-ITEM(WS-J) + MOVE 'M' TO WS-PHONE-TYPE + DISPLAY '3100-VALIDATE-RECORD: Mobile prefix: ' + WS-PREFIX-STR + EXIT PERFORM + END-IF + END-PERFORM + IF WS-PHONE-TYPE = 'U' + PERFORM VARYING WS-K FROM 1 BY 1 + UNTIL WS-K > WS-LL-PREFIX-COUNT + IF WS-PREFIX-STR = WS-LL-ITEM(WS-K) + MOVE 'L' TO WS-PHONE-TYPE + DISPLAY '3100-VALIDATE-RECORD: Landline ' + 'prefix: ' WS-PREFIX-STR + EXIT PERFORM + END-IF + END-PERFORM + END-IF + END-IF. + *> + *> R4: Length validation per phone type + EVALUATE TRUE + WHEN WS-PHONE-MOBILE + IF WS-PHONE-DIGIT-COUNT NOT = 11 + MOVE 'F' TO WS-V-LENGTH + MOVE '03' TO WS-V-LENGTH-ERR + MOVE 'E' TO WS-ERROR-SEVERITY + DISPLAY '3100-VALIDATE-RECORD: LENGTH FAIL ' + 'mobile expected 11 got ' + WS-PHONE-DIGIT-COUNT + END-IF + WHEN WS-PHONE-LANDLINE + IF WS-PHONE-DIGIT-COUNT < 10 OR + WS-PHONE-DIGIT-COUNT > 12 + MOVE 'F' TO WS-V-LENGTH + MOVE '04' TO WS-V-LENGTH-ERR + MOVE 'E' TO WS-ERROR-SEVERITY + DISPLAY '3100-VALIDATE-RECORD: LENGTH FAIL ' + 'landline expected 10-12 got ' + WS-PHONE-DIGIT-COUNT + END-IF + WHEN WS-PHONE-UNKNOWN + MOVE 'W' TO WS-ERROR-SEVERITY + MOVE '05' TO WS-V-PREFIX-ERR + DISPLAY '3100-VALIDATE-RECORD: PREFIX UNKNOWN for "' + FUNCTION TRIM(IN-TEXT) '"' + IF WS-PHONE-DIGIT-COUNT > 0 + IF WS-PHONE-DIGIT-COUNT NOT >= 10 AND + WS-PHONE-DIGIT-COUNT NOT <= 12 + MOVE 'F' TO WS-V-LENGTH + MOVE '06' TO WS-V-LENGTH-ERR + MOVE 'E' TO WS-ERROR-SEVERITY + END-IF + END-IF + END-EVALUATE. + *> + *> Compute content length — trim trailing spaces (original) + MOVE 30 TO WS-TEXT-LEN. + PERFORM VARYING WS-IDX FROM 30 BY -1 UNTIL WS-IDX = 0 + IF IN-TEXT(WS-IDX:1) = SPACE + SUBTRACT 1 FROM WS-TEXT-LEN + ELSE + EXIT PERFORM + END-IF + END-PERFORM. + ADD WS-TEXT-LEN TO WS-TOTAL-CHARS. + *> + *> Apply original validation rules (preserved) + MOVE SPACES TO WS-ERROR-CODE. + IF NOT WS-ALL-HALF-YES + MOVE '01' TO WS-ERROR-CODE + ELSE + IF WS-TEXT-LEN > 20 + MOVE '02' TO WS-ERROR-CODE + END-IF + END-IF. + *> + *> Combine all rule results — priority: HALF > FORMAT > LENGTH + IF WS-V-HALF-FAIL + IF WS-ERROR-CODE = SPACES + MOVE '01' TO WS-ERROR-CODE + END-IF + END-IF. + IF WS-V-FORMAT-FAIL + MOVE '07' TO WS-ERROR-CODE + END-IF. + IF WS-V-LENGTH-FAIL + MOVE '08' TO WS-ERROR-CODE + END-IF. + IF WS-V-PREFIX-FAIL + IF WS-ERROR-CODE = SPACES + MOVE '09' TO WS-ERROR-CODE + END-IF + END-IF. + IF WS-SEVERITY-ERROR + ADD 1 TO WS-ERROR-COUNT + END-IF. + IF WS-SEVERITY-WARNING + ADD 1 TO WS-WARN-COUNT + END-IF. + I3100-EXIT. + EXIT. + *> + *> ============================================================ + *> 3200-PROCESS-RECORD : Route to GOOD/BAD/SKIP + *> ============================================================ + 3200-PROCESS-RECORD SECTION. + I3200-START. + DISPLAY '3200-PROCESS-RECORD: error-code=' + WS-ERROR-CODE ' severity=' WS-ERROR-SEVERITY. + EVALUATE TRUE + WHEN WS-ERROR-CODE = SPACES + ADD 1 TO WS-GOOD-COUNT + DISPLAY '3200-PROCESS-RECORD: -> GOOD' + WHEN WS-SEVERITY-WARNING + ADD 1 TO WS-WARN-COUNT + ADD 1 TO WS-GOOD-COUNT + DISPLAY '3200-PROCESS-RECORD: -> GOOD (warn)' + WHEN WS-SEVERITY-ERROR + ADD 1 TO WS-ERROR-COUNT + ADD 1 TO WS-BAD-COUNT + DISPLAY '3200-PROCESS-RECORD: -> BAD code=' + WS-ERROR-CODE + WHEN OTHER + ADD 1 TO WS-SKIP-COUNT + DISPLAY '3200-PROCESS-RECORD: -> SKIP' + END-EVALUATE. + EXIT. + *> + *> ============================================================ + *> 3300-WRITE-OUTPUT : Write record to GOOD or BAD file + *> ============================================================ + 3300-WRITE-OUTPUT SECTION. + I3300-START. + IF WS-ERROR-CODE = SPACES + MOVE IN-TEXT TO GOOD-TEXT + WRITE GOOD-REC + DISPLAY '3300-WRITE-OUTPUT: Wrote GOOD record' + IF WS-FILE-GOOD-STATUS NOT = '00' + MOVE 'E' TO WS-ERROR-SEVERITY + MOVE '20' TO WS-ERROR-CODE + STRING 'WRITE GOOD-REC failed, status=' + WS-FILE-GOOD-STATUS INTO WS-ERROR-DETAIL + PERFORM 6000-ERROR-HANDLE + END-IF + ELSE + MOVE IN-TEXT TO BAD-TEXT + MOVE WS-ERROR-CODE TO BAD-ERR-CODE + WRITE BAD-REC + DISPLAY '3300-WRITE-OUTPUT: Wrote BAD record code=' + WS-ERROR-CODE + IF WS-FILE-BAD-STATUS NOT = '00' + MOVE 'E' TO WS-ERROR-SEVERITY + MOVE '21' TO WS-ERROR-CODE + STRING 'WRITE BAD-REC failed, status=' + WS-FILE-BAD-STATUS INTO WS-ERROR-DETAIL + PERFORM 6000-ERROR-HANDLE + END-IF + END-IF. + EXIT. + *> + *> ============================================================ + *> 4000-REPORT : Generate validation report + *> ============================================================ + 4000-REPORT SECTION. + I4000-START. + DISPLAY 'ValidationHalfwidth: 4000-REPORT starting...'. + MOVE WS-GOOD-COUNT TO WS-ED-PASS. + MOVE WS-BAD-COUNT TO WS-ED-FAIL. + MOVE WS-SKIP-COUNT TO WS-ED-SKIP. + MOVE WS-WARN-COUNT TO WS-ED-WARN. + MOVE WS-ERROR-COUNT TO WS-ED-ERROR. + MOVE WS-TOTAL-READ TO WS-ED-TOTAL. + MOVE WS-HASH-TOTAL TO WS-ED-HASH. + MOVE SPACES TO REPORT-LINE. + STRING '=== VALIDATION REPORT ===' INTO REPORT-LINE. + WRITE REPORT-REC. + IF WS-FILE-REPORT-STATUS NOT = '00' + DISPLAY '4000-REPORT: WRITE header failed, status=' + WS-FILE-REPORT-STATUS + END-IF. + MOVE SPACES TO REPORT-LINE. + STRING 'Timestamp: ' WS-TIMESTAMP INTO REPORT-LINE. + WRITE REPORT-REC. + MOVE SPACES TO REPORT-LINE. + STRING 'Records read : ' WS-ED-TOTAL INTO REPORT-LINE. + WRITE REPORT-REC. + MOVE SPACES TO REPORT-LINE. + STRING 'Records passed : ' WS-ED-PASS INTO REPORT-LINE. + WRITE REPORT-REC. + MOVE SPACES TO REPORT-LINE. + STRING 'Records failed : ' WS-ED-FAIL INTO REPORT-LINE. + WRITE REPORT-REC. + MOVE SPACES TO REPORT-LINE. + STRING 'Records skipped : ' WS-ED-SKIP INTO REPORT-LINE. + WRITE REPORT-REC. + MOVE SPACES TO REPORT-LINE. + STRING 'Warnings issued : ' WS-ED-WARN INTO REPORT-LINE. + WRITE REPORT-REC. + MOVE SPACES TO REPORT-LINE. + STRING 'Errors detected : ' WS-ED-ERROR INTO REPORT-LINE. + WRITE REPORT-REC. + MOVE SPACES TO REPORT-LINE. + STRING 'Total chars : ' WS-TOTAL-CHARS + INTO REPORT-LINE. + WRITE REPORT-REC. + MOVE SPACES TO REPORT-LINE. + STRING 'Total digits : ' WS-TOTAL-DIGITS + INTO REPORT-LINE. + WRITE REPORT-REC. + MOVE SPACES TO REPORT-LINE. + STRING 'Hash total : ' WS-ED-HASH INTO REPORT-LINE. + WRITE REPORT-REC. + MOVE SPACES TO REPORT-LINE. + STRING 'R1: Half-width check (X''20''-X''7E'')' + INTO REPORT-LINE. + WRITE REPORT-REC. + MOVE SPACES TO REPORT-LINE. + STRING 'R2: Character set (digits 0-9, leading +)' + INTO REPORT-LINE. + WRITE REPORT-REC. + MOVE SPACES TO REPORT-LINE. + STRING 'R3: Length (mobile=11, landline=10-12)' + INTO REPORT-LINE. + WRITE REPORT-REC. + MOVE SPACES TO REPORT-LINE. + STRING 'R4: Prefix lookup (China mobile/landline)' + INTO REPORT-LINE. + WRITE REPORT-REC. + MOVE SPACES TO REPORT-LINE. + STRING '=== END OF REPORT ===' INTO REPORT-LINE. + WRITE REPORT-REC. + DISPLAY 'ValidationHalfwidth: 4000-REPORT complete'. + EXIT. + *> + *> ============================================================ + *> 5000-AUDIT : Write audit summary with timestamps + *> ============================================================ + 5000-AUDIT SECTION. + I5000-START. + DISPLAY 'ValidationHalfwidth: 5000-AUDIT starting...'. + MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-TIME. + STRING WS-CURR-YEAR '-' WS-CURR-MONTH '-' + WS-CURR-DAY ' ' WS-CURR-HOUR ':' + WS-CURR-MIN ':' WS-CURR-SEC + INTO WS-TIMESTAMP. + MOVE SPACES TO AUDIT-LINE. + STRING '=== AUDIT LOG ===' INTO AUDIT-LINE. + WRITE AUDIT-REC. + IF WS-FILE-AUDIT-STATUS NOT = '00' + DISPLAY '5000-AUDIT: WRITE header failed, status=' + WS-FILE-AUDIT-STATUS + END-IF. + MOVE SPACES TO AUDIT-LINE. + STRING 'Program: ValidationHalfwidth' INTO AUDIT-LINE. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-LINE. + STRING 'Timestamp: ' WS-TIMESTAMP INTO AUDIT-LINE. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-LINE. + STRING 'Records read : ' WS-TOTAL-READ INTO AUDIT-LINE. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-LINE. + STRING 'Records good : ' WS-GOOD-COUNT INTO AUDIT-LINE. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-LINE. + STRING 'Records bad : ' WS-BAD-COUNT INTO AUDIT-LINE. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-LINE. + STRING 'Records skip : ' WS-SKIP-COUNT INTO AUDIT-LINE. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-LINE. + STRING 'Warnings : ' WS-WARN-COUNT INTO AUDIT-LINE. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-LINE. + STRING 'Errors : ' WS-ERROR-COUNT INTO AUDIT-LINE. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-LINE. + STRING 'Hash total : ' WS-HASH-TOTAL INTO AUDIT-LINE. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-LINE. + STRING 'Rules: HALF-FORMAT-LENGTH-PREFIX' + INTO AUDIT-LINE. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-LINE. + STRING 'Severity: W=Warning, E=Error' + INTO AUDIT-LINE. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-LINE. + STRING 'Input : file-in.dat' INTO AUDIT-LINE. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-LINE. + STRING 'Output: file-out-good.dat' INTO AUDIT-LINE. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-LINE. + STRING 'Output: file-out-bad.dat' INTO AUDIT-LINE. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-LINE. + STRING 'Output: file-out-report.dat' INTO AUDIT-LINE. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-LINE. + STRING 'Output: file-out-audit.dat' INTO AUDIT-LINE. + WRITE AUDIT-REC. + MOVE SPACES TO AUDIT-LINE. + STRING '=== END AUDIT ===' INTO AUDIT-LINE. + WRITE AUDIT-REC. + DISPLAY 'ValidationHalfwidth: 5000-AUDIT complete'. + EXIT. + *> + *> ============================================================ + *> 6000-ERROR-HANDLE : Centralized error handler + *> WARNING: display and continue + *> ERROR: display, close files, stop run + *> ============================================================ + 6000-ERROR-HANDLE SECTION. + I6000-START. + MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-TIME. + STRING WS-CURR-HOUR ':' WS-CURR-MIN ':' + WS-CURR-SEC INTO WS-TRACE-TS. + EVALUATE TRUE + WHEN WS-SEVERITY-WARNING + DISPLAY '6000-ERROR-HANDLE: [' WS-TRACE-TS + '] WARNING code=' WS-ERROR-CODE + ' ' WS-ERROR-DETAIL + ADD 1 TO WS-WARN-COUNT + WHEN WS-SEVERITY-ERROR + DISPLAY '6000-ERROR-HANDLE: [' WS-TRACE-TS + '] ** ERROR ** code=' WS-ERROR-CODE + ' ' WS-ERROR-DETAIL + ADD 1 TO WS-ERROR-COUNT + ADD 1 TO WS-BAD-COUNT + DISPLAY 'ValidationHalfwidth: ABORTING' + PERFORM 9000-EXIT + WHEN OTHER + DISPLAY '6000-ERROR-HANDLE: [' WS-TRACE-TS + '] UNKNOWN severity=' WS-ERROR-SEVERITY + END-EVALUATE. + EXIT. + *> + *> ============================================================ + *> 9000-EXIT : Close files, display summary, stop run + *> ============================================================ + 9000-EXIT SECTION. + I9000-START. + DISPLAY 'ValidationHalfwidth: 9000-EXIT closing files...'. + CLOSE FILE-IN. + IF WS-FILE-IN-STATUS NOT = '00' + DISPLAY 'CLOSE FILE-IN status=' WS-FILE-IN-STATUS + END-IF. + CLOSE FILE-OUT-GOOD. + IF WS-FILE-GOOD-STATUS NOT = '00' + DISPLAY 'CLOSE FILE-OUT-GOOD status=' + WS-FILE-GOOD-STATUS + END-IF. + CLOSE FILE-OUT-BAD. + IF WS-FILE-BAD-STATUS NOT = '00' + DISPLAY 'CLOSE FILE-OUT-BAD status=' + WS-FILE-BAD-STATUS + END-IF. + CLOSE FILE-OUT-REPORT. + IF WS-FILE-REPORT-STATUS NOT = '00' + DISPLAY 'CLOSE FILE-OUT-REPORT status=' + WS-FILE-REPORT-STATUS + END-IF. + CLOSE FILE-OUT-AUDIT. + IF WS-FILE-AUDIT-STATUS NOT = '00' + DISPLAY 'CLOSE FILE-OUT-AUDIT status=' + WS-FILE-AUDIT-STATUS + END-IF. + MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-TIME. + STRING WS-CURR-YEAR '-' WS-CURR-MONTH '-' + WS-CURR-DAY ' ' WS-CURR-HOUR ':' + WS-CURR-MIN ':' WS-CURR-SEC + INTO WS-TIMESTAMP. + DISPLAY ' '. + DISPLAY '========================================'. + DISPLAY 'ValidationHalfwidth: FINAL SUMMARY'. + DISPLAY 'Batch ended: ' WS-TIMESTAMP. + DISPLAY 'Records read : ' WS-TOTAL-READ. + DISPLAY 'Records passed : ' WS-GOOD-COUNT. + DISPLAY 'Records failed : ' WS-BAD-COUNT. + DISPLAY 'Records skipped : ' WS-SKIP-COUNT. + DISPLAY 'Warnings issued : ' WS-WARN-COUNT. + DISPLAY 'Errors detected : ' WS-ERROR-COUNT. + DISPLAY 'Total chars : ' WS-TOTAL-CHARS. + DISPLAY 'Total digits : ' WS-TOTAL-DIGITS. + DISPLAY 'Hash total : ' WS-HASH-TOTAL. + DISPLAY '========================================'. + MOVE SPACES TO AUDIT-LINE. + STRING 'Batch ended: ' WS-TIMESTAMP INTO AUDIT-LINE. + WRITE AUDIT-REC. + DISPLAY 'ValidationHalfwidth: Done.'. + STOP RUN. + *> + *> ============================================================ + END PROGRAM ValidationHalfwidth. diff --git a/benchmark-programs/27-validation-halfwidth/main-validation-halfwidth.cbl b/benchmark-programs/27-validation-halfwidth/main-validation-halfwidth.cbl new file mode 100644 index 0000000..cf63fe1 --- /dev/null +++ b/benchmark-programs/27-validation-halfwidth/main-validation-halfwidth.cbl @@ -0,0 +1,157 @@ + *> ============================================================ + *> main-validation-halfwidth : 电话号码校验 (Phone Validation) + *> Input : FILE-IN (INPUT.DAT: 电话号码文字列) + *> Output: FILE-PASS (PASS.DAT: 校验通过) + *> Coverage: VF-N005, VF-N006, VF-A001, VF-A002, VF-R001 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. VALIDATE-HALF. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN ASSIGN TO "INPUT.DAT" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FS. + + SELECT FILE-PASS ASSIGN TO "PASS.DAT" + ORGANIZATION IS SEQUENTIAL. + + SELECT FILE-FAIL ASSIGN TO "FAIL.DAT" + ORGANIZATION IS SEQUENTIAL. + + DATA DIVISION. + FILE SECTION. + FD FILE-IN RECORD CONTAINS 60 CHARACTERS. + 01 IN-RECORD. + 05 IN-ID PIC X(10). + 05 IN-HALF20 PIC X(20). + 05 IN-HALF4 PIC X(4). + 05 IN-CHECK-TYPE PIC X(1). + 05 IN-FILLER PIC X(25). + + FD FILE-PASS RECORD CONTAINS 60 CHARACTERS. + 01 PASS-REC PIC X(60). + + FD FILE-FAIL RECORD CONTAINS 80 CHARACTERS. + 01 FAIL-REC. + 05 FAIL-ID PIC X(10). + 05 FAIL-REASON PIC X(30). + 05 FAIL-DATA PIC X(40). + + WORKING-STORAGE SECTION. + 01 WS-FS PIC X(2). + 01 WS-EOF PIC X(1) VALUE 'N'. + 88 WS-EOF-Y VALUE 'Y' FALSE 'N'. + 01 WS-READ-COUNT PIC 9(10). + 01 WS-PASS-COUNT PIC 9(10). + 01 WS-FAIL-COUNT PIC 9(10). + 01 WS-I PIC 9(2). + 01 WS-CHAR PIC X(1). + 01 WS-IS-HALF PIC X(1) VALUE 'Y'. + 88 WS-IS-HALF-Y VALUE 'Y' FALSE 'N'. + 01 WS-CHECK-20 PIC X(20). + 01 WS-CHECK-4 PIC X(4). + 01 WS-HALF-LOWER PIC X(26) VALUE 'abcdefghijklmnopqrstuvwxyz'. + 01 WS-HALF-UPPER PIC X(26) VALUE 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'. + 01 WS-HALF-DIGIT PIC X(10) VALUE '0123456789'. + 01 WS-HALF-SYMBOL PIC X(33) VALUE ' !"#$%&''()*+,-./:;<=>?@[\]^_`{|}~'. + + 01 WS-TELECOM-REC. + COPY "telecom/TEL-BILLING.cpy". + + PROCEDURE DIVISION. + MAIN. + DISPLAY "VALIDATE-HALF: Starting halfwidth validation" + OPEN INPUT FILE-IN. + OPEN OUTPUT FILE-PASS FILE-FAIL. + + PERFORM UNTIL WS-EOF-Y + READ FILE-IN INTO IN-RECORD + AT END + SET WS-EOF-Y TO TRUE + NOT AT END + ADD 1 TO WS-READ-COUNT + MOVE IN-HALF20 TO WS-CHECK-20 + PERFORM CHECK-HALF20 + IF WS-IS-HALF-Y + MOVE IN-HALF4 TO WS-CHECK-4 + PERFORM CHECK-HALF4 + END-IF + IF WS-IS-HALF-Y + ADD 1 TO WS-PASS-COUNT + MOVE IN-RECORD TO PASS-REC + WRITE PASS-REC + DISPLAY "PASS: " IN-ID " - halfwidth OK" + ELSE + ADD 1 TO WS-FAIL-COUNT + MOVE IN-ID TO FAIL-ID + STRING "HALFWIDTH CHECK FAILED - data contains " + "non-halfwidth characters" + DELIMITED BY SIZE INTO FAIL-REASON + END-STRING + MOVE IN-HALF20 TO FAIL-DATA + WRITE FAIL-REC + DISPLAY "FAIL: " IN-ID " - non-halfwidth detected" + END-IF + END-READ + END-PERFORM. + + CLOSE FILE-IN FILE-PASS FILE-FAIL. + + DISPLAY "VALIDATE-HALF: READ=" WS-READ-COUNT + " PASS=" WS-PASS-COUNT " FAIL=" WS-FAIL-COUNT + DISPLAY "VALIDATE-HALF: Total = READ (R001)" + + IF WS-READ-COUNT = WS-PASS-COUNT + WS-FAIL-COUNT + DISPLAY "VALIDATE-HALF: PASS" + STOP RUN RETURNING 0 + ELSE + DISPLAY "VALIDATE-HALF: FAIL - count mismatch" + STOP RUN RETURNING 1 + END-IF + . + + CHECK-HALF20. + SET WS-IS-HALF TO TRUE + PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 20 + MOVE WS-CHECK-20(WS-I:1) TO WS-CHAR + IF WS-CHAR = SPACE + CONTINUE + ELSE + IF WS-CHAR >= 'a' AND <= 'z' + CONTINUE + ELSE IF WS-CHAR >= 'A' AND <= 'Z' + CONTINUE + ELSE IF WS-CHAR >= '0' AND <= '9' + CONTINUE + ELSE + MOVE 'N' TO WS-IS-HALF + EXIT PERFORM + END-IF + END-IF + END-PERFORM + . + + CHECK-HALF4. + SET WS-IS-HALF TO TRUE + PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 4 + MOVE WS-CHECK-4(WS-I:1) TO WS-CHAR + IF WS-CHAR = SPACE + CONTINUE + ELSE + IF WS-CHAR >= 'a' AND <= 'z' + CONTINUE + ELSE IF WS-CHAR >= 'A' AND <= 'Z' + CONTINUE + ELSE IF WS-CHAR >= '0' AND <= '9' + CONTINUE + ELSE + MOVE 'N' TO WS-IS-HALF + EXIT PERFORM + END-IF + END-IF + END-PERFORM + . + + END PROGRAM VALIDATE-HALF. diff --git a/benchmark-programs/28-sysin/README.md b/benchmark-programs/28-sysin/README.md new file mode 100644 index 0000000..005a74c --- /dev/null +++ b/benchmark-programs/28-sysin/README.md @@ -0,0 +1,23 @@ +# 28-sysin — SYSIN Reading Simulation + +## 电信业务场景 + +批量参数SYSIN读取。从SYSIN文件读取月次批处理参数(账期、报表类型、输出格式等)，控制批处理行为。 + +## Purpose +Demonstrates reading parameter cards from a SYSIN file (LINE SEQUENTIAL) in PARAM=VALUE format and using them to control program behavior. + +## Test Coverage +1. **Normal parameters** — Read SORT-KEY, OUTPUT-FMT, MAX-RECORDS, etc. +2. **Multi-card reading** — Process multiple parameter cards sequentially +3. **Comments** — Lines starting with * or # are skipped +4. **Empty SYSIN** — File with no content uses defaults +5. **Format errors** — Missing '=', malformed cards are detected and counted +6. **Default values** — Parameters not specified retain their defaults + +## Key Techniques +- LINE SEQUENTIAL file ORGANIZATION for SYSIN +- FUNCTION TRIM for whitespace handling +- FUNCTION UPPER-CASE for case-insensitive matching +- EVALUATE for parameter dispatch +- FILE STATUS checking (10 = end of file) diff --git a/benchmark-programs/28-sysin/main-28-sysin.cbl b/benchmark-programs/28-sysin/main-28-sysin.cbl new file mode 100644 index 0000000..812967f --- /dev/null +++ b/benchmark-programs/28-sysin/main-28-sysin.cbl @@ -0,0 +1,844 @@ + >>SOURCE FORMAT IS FREE + *> ============================================================ + *> 28-sysin : SYSIN批量参数 (Batch SYSIN) + *> Input : SYSIN (PARAM=VALUE形式の参数卡片) + *> Output: REPORT-FILE (sysin-report.txt: 参数设定结果) + *> AUDIT-FILE (sysin-audit.dat: 参数审计报告) + *> Coverage: SY-N001~N003, SY-A001~A003, SY-R001 + *> Extensions: SECTION structure, dependency validation, bounds + *> checking, error accumulation, override detection, audit, + *> parameter loading report, default logging with status, + *> batch control totals, FILE STATUS per I/O, timestamp trace + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. Main28Sysin. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT SYSIN-FILE ASSIGN TO "SYSIN" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS SYSIN-STATUS. + SELECT REPORT-FILE ASSIGN TO "sysin-report.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-RPT-STATUS. + SELECT AUDIT-FILE ASSIGN TO "sysin-audit.dat" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WS-AUDIT-STATUS. + + DATA DIVISION. + FILE SECTION. + FD SYSIN-FILE. + 01 SYSIN-RECORD PIC X(80). + FD REPORT-FILE. + 01 REPORT-LINE PIC X(80). + FD AUDIT-FILE. + 01 AUDIT-LINE PIC X(80). + + WORKING-STORAGE SECTION. + *> Copybook + 01 WS-TELECOM-REC. + COPY "telecom/TEL-BILLING.cpy". + *> File status + 01 SYSIN-STATUS PIC XX. + 88 SYSIN-EOF VALUE "10". + 01 WS-RPT-STATUS PIC XX. + 01 WS-AUDIT-STATUS PIC XX. + *> Timestamp + 01 WS-CUR-DATE PIC X(08). + 01 WS-CUR-TIME PIC X(06). + 01 WS-TIMESTAMP PIC X(20). + *> Parameter defaults + 01 WS-PARAMS. + 05 WS-SORT-KEY PIC X(10) VALUE "ASC". + 05 WS-OUTPUT-FMT PIC X(10) VALUE "SUMMARY". + 05 WS-MAX-RECORDS PIC 9(05) VALUE 50. + 05 WS-REPORT-TYPE PIC X(10) VALUE "STANDARD". + 05 WS-VERBOSE PIC X(01) VALUE "N". + 05 WS-DEBUG-MODE PIC X(01) VALUE "N". + *> Batch control totals + 01 WS-CARD-COUNT PIC 9(05) VALUE 0. + 01 WS-ERROR-COUNT PIC 9(05) VALUE 0. + 01 WS-WARN-COUNT PIC 9(05) VALUE 0. + 01 WS-OVERRIDE-COUNT PIC 9(05) VALUE 0. + 01 WS-PARAM-SET-CNT PIC 9(05) VALUE 0. + 01 WS-DEFAULT-APP-CNT PIC 9(05) VALUE 0. + 01 WS-SKIPPED-COUNT PIC 9(05) VALUE 0. + *> Override / set flags + 01 WS-SORT-KEY-SET PIC X(01) VALUE 'N'. + 01 WS-OUTPUT-FMT-SET PIC X(01) VALUE 'N'. + 01 WS-MAX-REC-SET PIC X(01) VALUE 'N'. + 01 WS-RPT-TYPE-SET PIC X(01) VALUE 'N'. + 01 WS-VERBOSE-SET PIC X(01) VALUE 'N'. + 01 WS-DEBUG-SET PIC X(01) VALUE 'N'. + *> Card buffer and parse area + 01 WS-CARD-BUFFER. + 05 WS-CARD-TEXT PIC X(80). + 05 WS-CARD-LEN PIC 9(02). + 01 WS-PARSE-AREA. + 05 WS-EQUALS-POS PIC 9(02). + 05 WS-PARAM-NAME PIC X(20). + 05 WS-PARAM-VALUE PIC X(40). + 01 WS-PARAM-TRIM PIC X(20). + *> Per-card validation result + 01 WS-VALID-OK PIC X(01). + 01 WS-VALID-STATUS PIC X(15). + *> Error accumulation table + 01 WS-ERROR-MAX PIC 9(03) VALUE 100. + 01 WS-ERROR-TABLE. + 05 WS-ERR-ENTRY OCCURS 100 TIMES. + 10 WS-ERR-TEXT PIC X(60). + 01 WS-ERR-IDX PIC 9(03) VALUE 0. + *> Report lines + 01 WS-PARAM-LINE. + 05 FILLER PIC X(10) VALUE " ". + 05 PL-NAME PIC X(20). + 05 FILLER PIC X(03) VALUE " = ". + 05 PL-VALUE PIC X(40). + 05 FILLER PIC X(10) VALUE SPACES. + 05 PL-STATUS PIC X(10). + 01 WS-LOADING-LINE. + 05 FILLER PIC X(02) VALUE " ". + 05 WS-LL-CARD PIC Z(04)9. + 05 FILLER PIC X(02) VALUE ": ". + 05 WS-LL-NAME PIC X(20). + 05 FILLER PIC X(03) VALUE " = ". + 05 WS-LL-VALUE PIC X(40). + 05 FILLER PIC X(02) VALUE " ". + 05 WS-LL-STATUS PIC X(15). + *> Working fields + 01 WS-TEMP-LINE PIC X(80). + 01 WS-RPT-COUNT PIC Z(9)9. + 01 IDX PIC 9(02). + 01 WS-CHAR PIC X(01). + 01 WS-NUM-VAL PIC 9(05). + + *> ============================================================ + PROCEDURE DIVISION. + + MAIN. + PERFORM 1000-INIT + PERFORM 2000-OPEN-FILES + PERFORM 3000-READ-INPUT + PERFORM 4000-REPORT + PERFORM 5000-AUDIT + PERFORM 9000-EXIT + STOP RUN. + + *> ============================================================ + *> 1000-INIT — initialise state, log defaults + *> ============================================================ + 1000-INIT SECTION. + 1000-START. + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-CUR-DATE + MOVE FUNCTION CURRENT-DATE (9:6) TO WS-CUR-TIME + STRING WS-CUR-DATE '-' WS-CUR-TIME + DELIMITED BY SIZE INTO WS-TIMESTAMP + DISPLAY '*** Main28Sysin START at ' WS-TIMESTAMP + DISPLAY '[' WS-TIMESTAMP '] Defaults: SORT-KEY=' + WS-SORT-KEY ', OUTPUT-FMT=' WS-OUTPUT-FMT + ', MAX-RECORDS=' WS-MAX-RECORDS + DISPLAY ' REPORT-TYPE=' WS-REPORT-TYPE + ', VERBOSE=' WS-VERBOSE ', DEBUG-MODE=' WS-DEBUG-MODE + MOVE 6 TO WS-DEFAULT-APP-CNT + EXIT. + + *> ============================================================ + *> 2000-OPEN-FILES — open files, write headers, check status + *> ============================================================ + 2000-OPEN-FILES SECTION. + 2000-START. + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-CUR-DATE + MOVE FUNCTION CURRENT-DATE (9:6) TO WS-CUR-TIME + STRING WS-CUR-DATE '-' WS-CUR-TIME INTO WS-TIMESTAMP + DISPLAY '[' WS-TIMESTAMP '] Opening files' + + *> REPORT-FILE + OPEN OUTPUT REPORT-FILE + IF WS-RPT-STATUS NOT = "00" + DISPLAY '[' WS-TIMESTAMP + '] FATAL: REPORT-FILE open status=' + WS-RPT-STATUS + MOVE 1 TO RETURN-CODE STOP RUN + END-IF + DISPLAY '[' WS-TIMESTAMP '] REPORT-FILE opened, status=' + WS-RPT-STATUS + MOVE "SYSIN Parameter Test Report" TO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" + DISPLAY 'RPT WR ERR ' WS-RPT-STATUS + END-IF + MOVE SPACES TO REPORT-LINE WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" + DISPLAY 'RPT WR ERR ' WS-RPT-STATUS + END-IF + + *> AUDIT-FILE + OPEN OUTPUT AUDIT-FILE + IF WS-AUDIT-STATUS NOT = "00" + DISPLAY '[' WS-TIMESTAMP + '] FATAL: AUDIT-FILE open status=' + WS-AUDIT-STATUS + MOVE 1 TO RETURN-CODE STOP RUN + END-IF + DISPLAY '[' WS-TIMESTAMP '] AUDIT-FILE opened, status=' + WS-AUDIT-STATUS + MOVE 'SYSIN Audit Report' TO AUDIT-LINE + WRITE AUDIT-LINE + IF WS-AUDIT-STATUS NOT = "00" + DISPLAY 'AUD WR ERR ' WS-AUDIT-STATUS + END-IF + STRING 'Run: ' WS-TIMESTAMP INTO AUDIT-LINE + WRITE AUDIT-LINE + IF WS-AUDIT-STATUS NOT = "00" + DISPLAY 'AUD WR ERR ' WS-AUDIT-STATUS + END-IF + MOVE SPACES TO AUDIT-LINE WRITE AUDIT-LINE + IF WS-AUDIT-STATUS NOT = "00" + DISPLAY 'AUD WR ERR ' WS-AUDIT-STATUS + END-IF + + *> SYSIN-FILE + OPEN INPUT SYSIN-FILE + IF SYSIN-STATUS NOT = "00" + DISPLAY '[' WS-TIMESTAMP + '] SYSIN open failed, status=' SYSIN-STATUS + MOVE " SYSIN open failed - using defaults" + TO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" + DISPLAY 'RPT WR ERR ' WS-RPT-STATUS + END-IF + STRING 'OPEN FAILED status=' SYSIN-STATUS + INTO AUDIT-LINE + WRITE AUDIT-LINE + IF WS-AUDIT-STATUS NOT = "00" + DISPLAY 'AUD WR ERR ' WS-AUDIT-STATUS + END-IF + ELSE + DISPLAY '[' WS-TIMESTAMP + '] SYSIN opened successfully' + END-IF + EXIT. + + *> ============================================================ + *> 3000-READ-INPUT — read SYSIN cards, call validate/process + *> ============================================================ + 3000-READ-INPUT SECTION. + 3000-START. + IF SYSIN-STATUS NOT = "00" EXIT SECTION END-IF + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-CUR-DATE + MOVE FUNCTION CURRENT-DATE (9:6) TO WS-CUR-TIME + STRING WS-CUR-DATE '-' WS-CUR-TIME INTO WS-TIMESTAMP + + *> Write loading report header + MOVE "=== Parameter Loading Report ===" TO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" + DISPLAY 'RPT WR ERR ' WS-RPT-STATUS + END-IF + MOVE SPACES TO REPORT-LINE WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" + DISPLAY 'RPT WR ERR ' WS-RPT-STATUS + END-IF + + *> Read loop + PERFORM UNTIL SYSIN-EOF + READ SYSIN-FILE INTO SYSIN-RECORD + AT END SET SYSIN-EOF TO TRUE + NOT AT END + ADD 1 TO WS-CARD-COUNT + MOVE SYSIN-RECORD TO WS-CARD-TEXT + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-CUR-DATE + MOVE FUNCTION CURRENT-DATE (9:6) TO WS-CUR-TIME + STRING WS-CUR-DATE '-' WS-CUR-TIME + INTO WS-TIMESTAMP + DISPLAY '[' WS-TIMESTAMP '] Card ' + WS-CARD-COUNT ': ' + FUNCTION TRIM(WS-CARD-TEXT) + PERFORM 3100-VALIDATE-RECORD + IF WS-VALID-OK = 'Y' + PERFORM 3200-PROCESS-RECORD + END-IF + PERFORM 3300-WRITE-OUTPUT + END-READ + IF SYSIN-STATUS NOT = "00" AND NOT = "10" + DISPLAY '[' WS-TIMESTAMP + '] READ ERROR: SYSIN status=' + SYSIN-STATUS + END-IF + END-PERFORM + DISPLAY '[' WS-TIMESTAMP + '] Total cards read: ' WS-CARD-COUNT + CLOSE SYSIN-FILE + IF SYSIN-STATUS NOT = "00" AND NOT = "10" + DISPLAY '[' WS-TIMESTAMP + '] CLOSE SYSIN status=' SYSIN-STATUS + END-IF + EXIT. + + *> ============================================================ + *> 3100-VALIDATE-RECORD — parse card, bounds, dependencies + *> ============================================================ + 3100-VALIDATE-RECORD SECTION. + 3100-START. + MOVE 'Y' TO WS-VALID-OK + MOVE 'ACCEPTED' TO WS-VALID-STATUS + MOVE FUNCTION TRIM(WS-CARD-TEXT) TO WS-CARD-BUFFER + + *> Skip empty / comment + IF WS-CARD-BUFFER = SPACES OR WS-CARD-BUFFER = "" + DISPLAY " (empty line, skipped)" + ADD 1 TO WS-SKIPPED-COUNT + MOVE 'N' TO WS-VALID-OK MOVE 'SKIPPED' TO WS-VALID-STATUS + EXIT SECTION + END-IF + MOVE WS-CARD-BUFFER(1:1) TO WS-CHAR + IF WS-CHAR = "*" OR WS-CHAR = "#" + DISPLAY " (comment, skipped)" + ADD 1 TO WS-SKIPPED-COUNT + MOVE 'N' TO WS-VALID-OK MOVE 'SKIPPED' TO WS-VALID-STATUS + EXIT SECTION + END-IF + + *> Find '=' + MOVE 0 TO WS-EQUALS-POS + PERFORM VARYING IDX FROM 1 BY 1 + UNTIL IDX > 80 OR WS-EQUALS-POS > 0 + IF WS-CARD-BUFFER(IDX:1) = "=" + MOVE IDX TO WS-EQUALS-POS + END-IF + END-PERFORM + IF WS-EQUALS-POS = 0 + DISPLAY " ERROR: No '=' found in card" + ADD 1 TO WS-ERROR-COUNT + MOVE " ERROR (no '='): " TO WS-TEMP-LINE + STRING WS-TEMP-LINE FUNCTION TRIM(WS-CARD-BUFFER) + DELIMITED BY SIZE INTO WS-TEMP-LINE + MOVE WS-TEMP-LINE TO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" + DISPLAY 'RPT WR ERR ' WS-RPT-STATUS + END-IF + MOVE 'N' TO WS-VALID-OK MOVE 'ERROR' TO WS-VALID-STATUS + PERFORM 6000-ERROR-HANDLE + EXIT SECTION + END-IF + + *> Extract NAME, VALUE + MOVE WS-CARD-BUFFER(1:WS-EQUALS-POS - 1) TO WS-PARAM-NAME + COMPUTE IDX = WS-EQUALS-POS + 1 + MOVE WS-CARD-BUFFER(IDX:) TO WS-PARAM-VALUE + MOVE FUNCTION UPPER-CASE( + FUNCTION TRIM(WS-PARAM-NAME)) TO WS-PARAM-NAME + MOVE FUNCTION TRIM(WS-PARAM-VALUE) TO WS-PARAM-VALUE + DISPLAY " NAME='" FUNCTION TRIM(WS-PARAM-NAME) + "' VALUE='" FUNCTION TRIM(WS-PARAM-VALUE)"'" + + *> Bounds checking + EVALUATE WS-PARAM-NAME + WHEN "SORT-KEY" + IF WS-PARAM-VALUE NOT = "ASC" AND + WS-PARAM-VALUE NOT = "DESC" + ADD 1 TO WS-ERROR-COUNT + MOVE 'N' TO WS-VALID-OK + MOVE 'REJECTED' TO WS-VALID-STATUS + MOVE 'SORT-KEY invalid, must be ASC or DESC' + TO WS-TEMP-LINE + MOVE " ERROR: SORT-KEY must be ASC or DESC" + TO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" + DISPLAY 'RPT WERR ' WS-RPT-STATUS + END-IF + PERFORM 6000-ERROR-HANDLE + END-IF + WHEN "OUTPUT-FMT" + IF WS-PARAM-VALUE NOT = "SUMMARY" AND + WS-PARAM-VALUE NOT = "DETAIL" AND + WS-PARAM-VALUE NOT = "RAW" + ADD 1 TO WS-ERROR-COUNT + MOVE 'N' TO WS-VALID-OK + MOVE 'REJECTED' TO WS-VALID-STATUS + MOVE 'OUTPUT-FMT invalid, must be SUMMARY, DETAIL, or RAW' TO WS-TEMP-LINE + MOVE " ERROR: OUTPUT-FMT must be SUMMARY, DETAIL, or RAW" TO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" + DISPLAY 'RPT WERR ' WS-RPT-STATUS + END-IF + PERFORM 6000-ERROR-HANDLE + END-IF + WHEN "MAX-RECORDS" + MOVE WS-PARAM-VALUE TO WS-NUM-VAL + IF WS-NUM-VAL < 1 OR WS-NUM-VAL > 99999 + ADD 1 TO WS-ERROR-COUNT + MOVE 'N' TO WS-VALID-OK + MOVE 'REJECTED' TO WS-VALID-STATUS + STRING 'MAX-RECORDS out of range (1-99999): ' + FUNCTION TRIM(WS-PARAM-VALUE) + INTO WS-TEMP-LINE + MOVE " ERROR: MAX-RECORDS range 1-99999" + TO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" + DISPLAY 'RPT WERR ' WS-RPT-STATUS + END-IF + PERFORM 6000-ERROR-HANDLE + END-IF + WHEN "REPORT-TYPE" + IF WS-PARAM-VALUE NOT = "STANDARD" AND + WS-PARAM-VALUE NOT = "CUSTOM" AND + WS-PARAM-VALUE NOT = "BRIEF" + ADD 1 TO WS-ERROR-COUNT + MOVE 'N' TO WS-VALID-OK + MOVE 'REJECTED' TO WS-VALID-STATUS + MOVE 'REPORT-TYPE invalid, must be STANDARD, CUSTOM, or BRIEF' TO WS-TEMP-LINE + MOVE " ERROR: REPORT-TYPE must be STANDARD, CUSTOM, or BRIEF" TO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" + DISPLAY 'RPT WERR ' WS-RPT-STATUS + END-IF + PERFORM 6000-ERROR-HANDLE + END-IF + WHEN "VERBOSE" + IF WS-PARAM-VALUE NOT = "Y" AND + WS-PARAM-VALUE NOT = "N" + ADD 1 TO WS-ERROR-COUNT + MOVE 'N' TO WS-VALID-OK + MOVE 'REJECTED' TO WS-VALID-STATUS + MOVE 'VERBOSE must be Y or N' + TO WS-TEMP-LINE + MOVE " ERROR: VERBOSE must be Y or N" + TO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" + DISPLAY 'RPT WERR ' WS-RPT-STATUS + END-IF + PERFORM 6000-ERROR-HANDLE + END-IF + WHEN "DEBUG-MODE" + IF WS-PARAM-VALUE NOT = "Y" AND + WS-PARAM-VALUE NOT = "N" + ADD 1 TO WS-ERROR-COUNT + MOVE 'N' TO WS-VALID-OK + MOVE 'REJECTED' TO WS-VALID-STATUS + MOVE 'DEBUG-MODE must be Y or N' + TO WS-TEMP-LINE + MOVE " ERROR: DEBUG-MODE must be Y or N" + TO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" + DISPLAY 'RPT WERR ' WS-RPT-STATUS + END-IF + PERFORM 6000-ERROR-HANDLE + END-IF + WHEN OTHER + ADD 1 TO WS-WARN-COUNT + MOVE 'N' TO WS-VALID-OK + MOVE 'WARNING' TO WS-VALID-STATUS + STRING 'Unknown parameter: ' + FUNCTION TRIM(WS-PARAM-NAME) + INTO WS-TEMP-LINE + MOVE " WARNING: Unknown parameter" TO REPORT-LINE + STRING REPORT-LINE ' ' + FUNCTION TRIM(WS-PARAM-NAME) INTO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" + DISPLAY 'RPT WERR ' WS-RPT-STATUS + END-IF + PERFORM 6000-ERROR-HANDLE + END-EVALUATE. + + *> Dependency validation + IF WS-PARAM-NAME = "OUTPUT-FMT" + AND WS-PARAM-VALUE = "DETAIL" + AND WS-REPORT-TYPE = "SUMMARY" + ADD 1 TO WS-WARN-COUNT + MOVE 'N' TO WS-VALID-OK MOVE 'REJECTED' TO WS-VALID-STATUS + MOVE 'Dependency: OUTPUT-FMT=DETAIL conflicts with REPORT-TYPE=SUMMARY' TO WS-TEMP-LINE + MOVE " WARNING: OUTPUT-FMT=DETAIL conflicts with REPORT-TYPE=SUMMARY" TO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" DISPLAY 'RPT WERR ' WS-RPT-STATUS END-IF + PERFORM 6000-ERROR-HANDLE + END-IF + IF WS-PARAM-NAME = "REPORT-TYPE" + AND WS-PARAM-VALUE = "SUMMARY" + AND WS-OUTPUT-FMT = "DETAIL" + ADD 1 TO WS-WARN-COUNT + MOVE 'N' TO WS-VALID-OK MOVE 'REJECTED' TO WS-VALID-STATUS + MOVE 'Dependency: REPORT-TYPE=SUMMARY conflicts with OUTPUT-FMT=DETAIL' TO WS-TEMP-LINE + MOVE " WARNING: REPORT-TYPE=SUMMARY conflicts with OUTPUT-FMT=DETAIL" TO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" DISPLAY 'RPT WERR ' WS-RPT-STATUS END-IF + PERFORM 6000-ERROR-HANDLE + END-IF + IF WS-PARAM-NAME = "VERBOSE" AND WS-PARAM-VALUE = "Y" + AND WS-DEBUG-MODE = "Y" + ADD 1 TO WS-WARN-COUNT + MOVE 'N' TO WS-VALID-OK MOVE 'REJECTED' TO WS-VALID-STATUS + MOVE 'Dependency: VERBOSE=Y conflicts with DEBUG-MODE=Y' + TO WS-TEMP-LINE + MOVE " WARNING: VERBOSE=Y conflicts with DEBUG-MODE=Y" + TO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" DISPLAY 'RPT WERR ' WS-RPT-STATUS END-IF + PERFORM 6000-ERROR-HANDLE + END-IF + IF WS-PARAM-NAME = "DEBUG-MODE" AND WS-PARAM-VALUE = "Y" + AND WS-VERBOSE = "Y" + ADD 1 TO WS-WARN-COUNT + MOVE 'N' TO WS-VALID-OK MOVE 'REJECTED' TO WS-VALID-STATUS + MOVE 'Dependency: DEBUG-MODE=Y conflicts with VERBOSE=Y' + TO WS-TEMP-LINE + MOVE " WARNING: DEBUG-MODE=Y conflicts with VERBOSE=Y" + TO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" DISPLAY 'RPT WERR ' WS-RPT-STATUS END-IF + PERFORM 6000-ERROR-HANDLE + END-IF + EXIT. + + *> ============================================================ + *> 3200-PROCESS-RECORD — apply parameter, detect override + *> ============================================================ + 3200-PROCESS-RECORD SECTION. + 3200-START. + MOVE 'ACCEPTED' TO WS-VALID-STATUS + EVALUATE WS-PARAM-NAME + WHEN "SORT-KEY" + IF WS-SORT-KEY-SET = 'Y' + ADD 1 TO WS-OVERRIDE-COUNT + MOVE 'OVERRIDE' TO WS-VALID-STATUS + STRING 'OVERRIDE: SORT-KEY was ' WS-SORT-KEY + ' now ' WS-PARAM-VALUE INTO AUDIT-LINE + WRITE AUDIT-LINE + IF WS-AUDIT-STATUS NOT = "00" DISPLAY 'AUD WERR ' WS-AUDIT-STATUS END-IF + END-IF + MOVE WS-PARAM-VALUE TO WS-SORT-KEY + MOVE 'Y' TO WS-SORT-KEY-SET ADD 1 TO WS-PARAM-SET-CNT + WHEN "OUTPUT-FMT" + IF WS-OUTPUT-FMT-SET = 'Y' + ADD 1 TO WS-OVERRIDE-COUNT + MOVE 'OVERRIDE' TO WS-VALID-STATUS + STRING 'OVERRIDE: OUTPUT-FMT was ' WS-OUTPUT-FMT + ' now ' WS-PARAM-VALUE INTO AUDIT-LINE + WRITE AUDIT-LINE + IF WS-AUDIT-STATUS NOT = "00" DISPLAY 'AUD WERR ' WS-AUDIT-STATUS END-IF + END-IF + MOVE WS-PARAM-VALUE TO WS-OUTPUT-FMT + MOVE 'Y' TO WS-OUTPUT-FMT-SET ADD 1 TO WS-PARAM-SET-CNT + WHEN "MAX-RECORDS" + IF WS-MAX-REC-SET = 'Y' + ADD 1 TO WS-OVERRIDE-COUNT + MOVE 'OVERRIDE' TO WS-VALID-STATUS + STRING 'OVERRIDE: MAX-RECORDS was ' WS-MAX-RECORDS + ' now ' WS-PARAM-VALUE INTO AUDIT-LINE + WRITE AUDIT-LINE + IF WS-AUDIT-STATUS NOT = "00" DISPLAY 'AUD WERR ' WS-AUDIT-STATUS END-IF + END-IF + MOVE WS-PARAM-VALUE TO WS-MAX-RECORDS + MOVE 'Y' TO WS-MAX-REC-SET ADD 1 TO WS-PARAM-SET-CNT + WHEN "REPORT-TYPE" + IF WS-RPT-TYPE-SET = 'Y' + ADD 1 TO WS-OVERRIDE-COUNT + MOVE 'OVERRIDE' TO WS-VALID-STATUS + STRING 'OVERRIDE: REPORT-TYPE was ' WS-REPORT-TYPE + ' now ' WS-PARAM-VALUE INTO AUDIT-LINE + WRITE AUDIT-LINE + IF WS-AUDIT-STATUS NOT = "00" DISPLAY 'AUD WERR ' WS-AUDIT-STATUS END-IF + END-IF + MOVE WS-PARAM-VALUE TO WS-REPORT-TYPE + MOVE 'Y' TO WS-RPT-TYPE-SET ADD 1 TO WS-PARAM-SET-CNT + WHEN "VERBOSE" + IF WS-VERBOSE-SET = 'Y' + ADD 1 TO WS-OVERRIDE-COUNT + MOVE 'OVERRIDE' TO WS-VALID-STATUS + STRING 'OVERRIDE: VERBOSE was ' WS-VERBOSE + ' now ' WS-PARAM-VALUE INTO AUDIT-LINE + WRITE AUDIT-LINE + IF WS-AUDIT-STATUS NOT = "00" DISPLAY 'AUD WERR ' WS-AUDIT-STATUS END-IF + END-IF + MOVE WS-PARAM-VALUE(1:1) TO WS-VERBOSE + MOVE 'Y' TO WS-VERBOSE-SET ADD 1 TO WS-PARAM-SET-CNT + WHEN "DEBUG-MODE" + IF WS-DEBUG-SET = 'Y' + ADD 1 TO WS-OVERRIDE-COUNT + MOVE 'OVERRIDE' TO WS-VALID-STATUS + STRING 'OVERRIDE: DEBUG-MODE was ' WS-DEBUG-MODE + ' now ' WS-PARAM-VALUE INTO AUDIT-LINE + WRITE AUDIT-LINE + IF WS-AUDIT-STATUS NOT = "00" DISPLAY 'AUD WERR ' WS-AUDIT-STATUS END-IF + END-IF + MOVE WS-PARAM-VALUE(1:1) TO WS-DEBUG-MODE + MOVE 'Y' TO WS-DEBUG-SET ADD 1 TO WS-PARAM-SET-CNT + END-EVALUATE + IF WS-VALID-STATUS = 'OVERRIDE' + DISPLAY '[' WS-TIMESTAMP '] OVERRIDE: ' + FUNCTION TRIM(WS-PARAM-NAME) + END-IF + EXIT. + + *> ============================================================ + *> 3300-WRITE-OUTPUT — write card loading line to report + *> ============================================================ + 3300-WRITE-OUTPUT SECTION. + 3300-START. + MOVE WS-CARD-COUNT TO WS-LL-CARD + MOVE WS-PARAM-NAME TO WS-LL-NAME + MOVE WS-PARAM-VALUE TO WS-LL-VALUE + MOVE WS-VALID-STATUS TO WS-LL-STATUS + MOVE WS-LOADING-LINE TO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" + DISPLAY 'RPT WERR ' WS-RPT-STATUS + END-IF + EXIT. + + *> ============================================================ + *> 4000-REPORT — final values, defaults, totals, errors + *> ============================================================ + 4000-REPORT SECTION. + 4000-START. + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-CUR-DATE + MOVE FUNCTION CURRENT-DATE (9:6) TO WS-CUR-TIME + STRING WS-CUR-DATE '-' WS-CUR-TIME INTO WS-TIMESTAMP + DISPLAY '[' WS-TIMESTAMP '] Generating parameter report' + DISPLAY " " + DISPLAY "=== Final Parameter Values ===" + MOVE "=== Final Parameter Values ===" TO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" DISPLAY 'RPT WERR ' WS-RPT-STATUS END-IF + + MOVE SPACES TO PL-STATUS + MOVE "SORT-KEY" TO PL-NAME MOVE WS-SORT-KEY TO PL-VALUE + IF WS-SORT-KEY-SET = 'Y' MOVE "(from SYSIN)" TO PL-STATUS + ELSE MOVE "(default)" TO PL-STATUS + PERFORM 4900-REPORT-PARAM + MOVE "OUTPUT-FMT" TO PL-NAME MOVE WS-OUTPUT-FMT TO PL-VALUE + IF WS-OUTPUT-FMT-SET = 'Y' MOVE "(from SYSIN)" TO PL-STATUS + ELSE MOVE "(default)" TO PL-STATUS + PERFORM 4900-REPORT-PARAM + MOVE "MAX-RECORDS" TO PL-NAME MOVE WS-MAX-RECORDS TO PL-VALUE + IF WS-MAX-REC-SET = 'Y' MOVE "(from SYSIN)" TO PL-STATUS + ELSE MOVE "(default)" TO PL-STATUS + PERFORM 4900-REPORT-PARAM + MOVE "REPORT-TYPE" TO PL-NAME MOVE WS-REPORT-TYPE TO PL-VALUE + IF WS-RPT-TYPE-SET = 'Y' MOVE "(from SYSIN)" TO PL-STATUS + ELSE MOVE "(default)" TO PL-STATUS + PERFORM 4900-REPORT-PARAM + MOVE "VERBOSE" TO PL-NAME MOVE WS-VERBOSE TO PL-VALUE + IF WS-VERBOSE-SET = 'Y' MOVE "(from SYSIN)" TO PL-STATUS + ELSE MOVE "(default)" TO PL-STATUS + PERFORM 4900-REPORT-PARAM + MOVE "DEBUG-MODE" TO PL-NAME MOVE WS-DEBUG-MODE TO PL-VALUE + IF WS-DEBUG-SET = 'Y' MOVE "(from SYSIN)" TO PL-STATUS + ELSE MOVE "(default)" TO PL-STATUS + PERFORM 4900-REPORT-PARAM + + MOVE SPACES TO REPORT-LINE WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" DISPLAY 'RPT WERR ' WS-RPT-STATUS END-IF + + *> Batch control totals + MOVE WS-CARD-COUNT TO WS-RPT-COUNT + STRING "Cards read: " WS-RPT-COUNT INTO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" DISPLAY 'RPT WERR ' WS-RPT-STATUS END-IF + MOVE WS-PARAM-SET-CNT TO WS-RPT-COUNT + STRING "Params set: " WS-RPT-COUNT INTO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" DISPLAY 'RPT WERR ' WS-RPT-STATUS END-IF + MOVE WS-ERROR-COUNT TO WS-RPT-COUNT + STRING "Errors: " WS-RPT-COUNT INTO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" DISPLAY 'RPT WERR ' WS-RPT-STATUS END-IF + MOVE WS-WARN-COUNT TO WS-RPT-COUNT + STRING "Warnings: " WS-RPT-COUNT INTO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" DISPLAY 'RPT WERR ' WS-RPT-STATUS END-IF + MOVE WS-OVERRIDE-COUNT TO WS-RPT-COUNT + STRING "Overrides: " WS-RPT-COUNT INTO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" DISPLAY 'RPT WERR ' WS-RPT-STATUS END-IF + MOVE WS-DEFAULT-APP-CNT TO WS-RPT-COUNT + STRING "Defaults used: " WS-RPT-COUNT INTO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" DISPLAY 'RPT WERR ' WS-RPT-STATUS END-IF + MOVE WS-SKIPPED-COUNT TO WS-RPT-COUNT + STRING "Skipped cards: " WS-RPT-COUNT INTO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" DISPLAY 'RPT WERR ' WS-RPT-STATUS END-IF + + *> Default Value Summary + MOVE SPACES TO REPORT-LINE WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" DISPLAY 'RPT WERR ' WS-RPT-STATUS END-IF + MOVE "=== Default Value Summary ===" TO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" DISPLAY 'RPT WERR ' WS-RPT-STATUS END-IF + + MOVE SPACES TO PL-STATUS + MOVE "SORT-KEY" TO PL-NAME MOVE WS-SORT-KEY TO PL-VALUE + IF WS-SORT-KEY-SET = 'Y' MOVE "overridden" TO PL-STATUS + ELSE MOVE "default" TO PL-STATUS + PERFORM 4900-REPORT-PARAM + MOVE "OUTPUT-FMT" TO PL-NAME MOVE WS-OUTPUT-FMT TO PL-VALUE + IF WS-OUTPUT-FMT-SET = 'Y' MOVE "overridden" TO PL-STATUS + ELSE MOVE "default" TO PL-STATUS + PERFORM 4900-REPORT-PARAM + MOVE "MAX-RECORDS" TO PL-NAME MOVE WS-MAX-RECORDS TO PL-VALUE + IF WS-MAX-REC-SET = 'Y' MOVE "overridden" TO PL-STATUS + ELSE MOVE "default" TO PL-STATUS + PERFORM 4900-REPORT-PARAM + MOVE "REPORT-TYPE" TO PL-NAME MOVE WS-REPORT-TYPE TO PL-VALUE + IF WS-RPT-TYPE-SET = 'Y' MOVE "overridden" TO PL-STATUS + ELSE MOVE "default" TO PL-STATUS + PERFORM 4900-REPORT-PARAM + MOVE "VERBOSE" TO PL-NAME MOVE WS-VERBOSE TO PL-VALUE + IF WS-VERBOSE-SET = 'Y' MOVE "overridden" TO PL-STATUS + ELSE MOVE "default" TO PL-STATUS + PERFORM 4900-REPORT-PARAM + MOVE "DEBUG-MODE" TO PL-NAME MOVE WS-DEBUG-MODE TO PL-VALUE + IF WS-DEBUG-SET = 'Y' MOVE "overridden" TO PL-STATUS + ELSE MOVE "default" TO PL-STATUS + PERFORM 4900-REPORT-PARAM + + *> Final dependency check (post-batch) + MOVE SPACES TO REPORT-LINE WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" DISPLAY 'RPT WERR ' WS-RPT-STATUS END-IF + MOVE "=== Final Dependency Check ===" TO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" DISPLAY 'RPT WERR ' WS-RPT-STATUS END-IF + IF WS-OUTPUT-FMT = "DETAIL" AND WS-REPORT-TYPE = "SUMMARY" + MOVE " WARNING: OUTPUT-FMT=DETAIL and REPORT-TYPE=SUMMARY conflict" TO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" DISPLAY 'RPT WERR ' WS-RPT-STATUS END-IF + END-IF + IF WS-VERBOSE = "Y" AND WS-DEBUG-MODE = "Y" + MOVE " WARNING: VERBOSE=Y and DEBUG-MODE=Y conflict" + TO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" DISPLAY 'RPT WERR ' WS-RPT-STATUS END-IF + END-IF + + *> Accumulated errors + IF WS-ERR-IDX > 0 + MOVE SPACES TO REPORT-LINE WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" DISPLAY 'RPT WERR ' WS-RPT-STATUS END-IF + MOVE "=== Accumulated Errors ===" TO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" DISPLAY 'RPT WERR ' WS-RPT-STATUS END-IF + PERFORM VARYING IDX FROM 1 BY 1 UNTIL IDX > WS-ERR-IDX + MOVE SPACES TO REPORT-LINE + STRING " " WS-ERR-TEXT(IDX) INTO REPORT-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" DISPLAY 'RPT WERR ' WS-RPT-STATUS END-IF + END-PERFORM + END-IF + EXIT. + + 4900-REPORT-PARAM. + STRING " " FUNCTION TRIM(PL-NAME) " = " + FUNCTION TRIM(PL-VALUE) + " " FUNCTION TRIM(PL-STATUS) + DELIMITED BY SIZE INTO REPORT-LINE + DISPLAY WS-PARAM-LINE + WRITE REPORT-LINE + IF WS-RPT-STATUS NOT = "00" + DISPLAY 'RPT WERR ' WS-RPT-STATUS + END-IF + . + + *> ============================================================ + *> 5000-AUDIT — write audit file with counts and timestamps + *> ============================================================ + 5000-AUDIT SECTION. + 5000-START. + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-CUR-DATE + MOVE FUNCTION CURRENT-DATE (9:6) TO WS-CUR-TIME + STRING WS-CUR-DATE '-' WS-CUR-TIME INTO WS-TIMESTAMP + DISPLAY '[' WS-TIMESTAMP '] Writing audit report' + + MOVE SPACES TO AUDIT-LINE + MOVE '=== Parameter Audit Summary ===' TO AUDIT-LINE + WRITE AUDIT-LINE + IF WS-AUDIT-STATUS NOT = "00" DISPLAY 'AUD WERR ' WS-AUDIT-STATUS END-IF + MOVE WS-CARD-COUNT TO WS-RPT-COUNT + STRING 'Cards read: ' WS-RPT-COUNT INTO AUDIT-LINE + WRITE AUDIT-LINE + IF WS-AUDIT-STATUS NOT = "00" DISPLAY 'AUD WERR ' WS-AUDIT-STATUS END-IF + MOVE WS-PARAM-SET-CNT TO WS-RPT-COUNT + STRING 'Params applied: ' WS-RPT-COUNT INTO AUDIT-LINE + WRITE AUDIT-LINE + IF WS-AUDIT-STATUS NOT = "00" DISPLAY 'AUD WERR ' WS-AUDIT-STATUS END-IF + MOVE WS-ERROR-COUNT TO WS-RPT-COUNT + STRING 'Errors: ' WS-RPT-COUNT INTO AUDIT-LINE + WRITE AUDIT-LINE + IF WS-AUDIT-STATUS NOT = "00" DISPLAY 'AUD WERR ' WS-AUDIT-STATUS END-IF + MOVE WS-WARN-COUNT TO WS-RPT-COUNT + STRING 'Warnings: ' WS-RPT-COUNT INTO AUDIT-LINE + WRITE AUDIT-LINE + IF WS-AUDIT-STATUS NOT = "00" DISPLAY 'AUD WERR ' WS-AUDIT-STATUS END-IF + MOVE WS-OVERRIDE-COUNT TO WS-RPT-COUNT + STRING 'Overrides: ' WS-RPT-COUNT INTO AUDIT-LINE + WRITE AUDIT-LINE + IF WS-AUDIT-STATUS NOT = "00" DISPLAY 'AUD WERR ' WS-AUDIT-STATUS END-IF + MOVE WS-DEFAULT-APP-CNT TO WS-RPT-COUNT + STRING 'Defaults applied:' WS-RPT-COUNT INTO AUDIT-LINE + WRITE AUDIT-LINE + IF WS-AUDIT-STATUS NOT = "00" DISPLAY 'AUD WERR ' WS-AUDIT-STATUS END-IF + STRING 'Batch date: ' WS-CUR-DATE INTO AUDIT-LINE + WRITE AUDIT-LINE + IF WS-AUDIT-STATUS NOT = "00" DISPLAY 'AUD WERR ' WS-AUDIT-STATUS END-IF + STRING 'Batch time: ' WS-CUR-TIME INTO AUDIT-LINE + WRITE AUDIT-LINE + IF WS-AUDIT-STATUS NOT = "00" DISPLAY 'AUD WERR ' WS-AUDIT-STATUS END-IF + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-CUR-DATE + MOVE FUNCTION CURRENT-DATE (9:6) TO WS-CUR-TIME + STRING 'Audit end: ' WS-CUR-DATE '-' WS-CUR-TIME + INTO AUDIT-LINE + WRITE AUDIT-LINE + IF WS-AUDIT-STATUS NOT = "00" DISPLAY 'AUD WERR ' WS-AUDIT-STATUS END-IF + + CLOSE AUDIT-FILE + IF WS-AUDIT-STATUS NOT = "00" + DISPLAY '[' WS-TIMESTAMP '] CLOSE ERROR: AUDIT status=' + WS-AUDIT-STATUS + END-IF + EXIT. + + *> ============================================================ + *> 6000-ERROR-HANDLE — accumulate one error into table + *> ============================================================ + 6000-ERROR-HANDLE SECTION. + 6000-START. + ADD 1 TO WS-ERR-IDX + IF WS-ERR-IDX <= WS-ERROR-MAX + MOVE WS-TEMP-LINE TO WS-ERR-TEXT(WS-ERR-IDX) + ELSE + DISPLAY '[' WS-TIMESTAMP + '] WARNING: Error table full' + END-IF + EXIT. + + *> ============================================================ + *> 9000-EXIT — close report, display final summary + *> ============================================================ + 9000-EXIT SECTION. + 9000-START. + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-CUR-DATE + MOVE FUNCTION CURRENT-DATE (9:6) TO WS-CUR-TIME + STRING WS-CUR-DATE '-' WS-CUR-TIME INTO WS-TIMESTAMP + CLOSE REPORT-FILE + IF WS-RPT-STATUS NOT = "00" + DISPLAY '[' WS-TIMESTAMP + '] CLOSE ERROR: REPORT-FILE status=' + WS-RPT-STATUS + END-IF + DISPLAY '*** Main28Sysin: Completed at ' WS-TIMESTAMP + DISPLAY ' Cards=' WS-CARD-COUNT + ' Params set=' WS-PARAM-SET-CNT + ' Errors=' WS-ERROR-COUNT + DISPLAY ' Warnings=' WS-WARN-COUNT + ' Overrides=' WS-OVERRIDE-COUNT + ' Defaults=' WS-DEFAULT-APP-CNT + DISPLAY ' Reports: sysin-report.txt, sysin-audit.dat' + EXIT. diff --git a/benchmark-programs/28-sysin/sysin-audit.dat b/benchmark-programs/28-sysin/sysin-audit.dat new file mode 100644 index 0000000..01c0c35 --- /dev/null +++ b/benchmark-programs/28-sysin/sysin-audit.dat @@ -0,0 +1,14 @@ +SYSIN Audit Report +Run: 20260622-232509 + +OPEN FAILED status=35 +=== Parameter Audit Summary === +Cards read: 0 === +Params applied: 0=== +Errors: 00=== +Warnings: 00=== +Overrides: 00=== +Defaults applied: 60=== +Batch date: 20260622 60=== +Batch time: 23250922 60=== +Audit end: 20260622-23250960=== diff --git a/benchmark-programs/28-sysin/sysin-report.txt b/benchmark-programs/28-sysin/sysin-report.txt new file mode 100644 index 0000000..77779be --- /dev/null +++ b/benchmark-programs/28-sysin/sysin-report.txt @@ -0,0 +1,29 @@ +SYSIN Parameter Test Report + + SYSIN open failed - using defaults +=== Final Parameter Values === + SORT-KEY = ASC (default) === + OUTPUT-FMT = SUMMARY (default) + MAX-RECORDS = 00050 (default)) + REPORT-TYPE = STANDARD (default) + VERBOSE = N (default)D (default) + DEBUG-MODE = N (default)default) + +Cards read: 0 +Params set: 0 +Errors: 0 +Warnings: 0 +Overrides: 0 +Defaults used: 6 +Skipped cards: 0 + +=== Default Value Summary === + SORT-KEY = ASC defaulty === + OUTPUT-FMT = SUMMARY default + MAX-RECORDS = 00050 defaultt + REPORT-TYPE = STANDARD default + VERBOSE = N defaultARD default + DEBUG-MODE = N default default + +=== Final Dependency Check === + DEBUG-MODE = N defaultck === diff --git a/benchmark-programs/29-ascii-ebcdic/FILE-IN.DAT b/benchmark-programs/29-ascii-ebcdic/FILE-IN.DAT new file mode 100644 index 0000000..0519ecb --- /dev/null +++ b/benchmark-programs/29-ascii-ebcdic/FILE-IN.DAT @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/benchmark-programs/29-ascii-ebcdic/README.md b/benchmark-programs/29-ascii-ebcdic/README.md new file mode 100644 index 0000000..72728b2 --- /dev/null +++ b/benchmark-programs/29-ascii-ebcdic/README.md @@ -0,0 +1,70 @@ +# 29-ascii-ebcdic: ASCII to EBCDIC Encoding Conversion + +## 电信业务场景 + +ASCII→EBCDIC主机编码转换。通过内建转换表将ASCII编码的CDR数据转换为EBCDIC编码，用于与大型主机系统交换数据。 + +## Description + +Reads an ASCII-encoded sequential file and converts each byte to its +EBCDIC equivalent using an internal conversion table defined via +REDEFINES. The output file contains the EBCDIC-encoded data. + +**Note:** GnuCOBOL internally uses ASCII encoding. This program +demonstrates a manual encoding conversion algorithm for scenarios +where EBCDIC output is required for legacy system compatibility. + +## Conversion Table + +The 128-entry ASCII-to-EBCDIC table is initialized from REDEFINES +data at program start. It covers: + +- Control characters (X'00'-X'3F') mapped to their EBCDIC equivalents +- Printable characters (X'20'-X'7F') mapped per standard conversion +- Characters >= X'80' are passed through unchanged + +## Record Layout + +### Input / Output (80 bytes fixed-length) + +| Structure | Type | Description | +|-----------|----------|--------------------------------------| +| IN-BYTE | OCCURS | Individual bytes for conversion | + +## Files + +| File | Purpose | +|-------------------------|--------------------------------| +| main-29-ascii-ebcdic.cbl | Main COBOL program | +| data-gen.sh | Generate ASCII test data | +| run.sh | Compile, run, verify | +| README.md | This file | + +## Tests + +| Test Case | Description | +|----------------------------|------------------------------------| +| Uppercase A-Z | Letters mapped to EBCDIC | +| Lowercase a-z | Lowercase mapped to EBCDIC | +| Digits 0-9 | Numeric characters converted | +| Printable symbols | Symbols like !@#$% converted | +| Mixed content | Combination of letters/numbers | +| Control characters | Preserved through conversion | +| Space-padded record | Padding character handling | +| All printable chars | Full ASCII printable range test | + +## Usage + +```bash +cd 29-ascii-ebcdic +bash data-gen.sh +bash run.sh +``` + +## Expected Behavior + +- Input and output are the same size (8 records x 80 bytes each). +- ASCII character 'A' (X'41') maps to EBCDIC X'C1'. +- ASCII character '0' (X'30') maps to EBCDIC X'F0'. +- Control characters (X'00'-X'1F') are converted per EBCDIC mapping. +- Non-ASCII bytes (>= X'80') pass through unchanged. diff --git a/benchmark-programs/29-ascii-ebcdic/main-29-ascii-ebcdic.cbl b/benchmark-programs/29-ascii-ebcdic/main-29-ascii-ebcdic.cbl new file mode 100644 index 0000000..9eece87 --- /dev/null +++ b/benchmark-programs/29-ascii-ebcdic/main-29-ascii-ebcdic.cbl @@ -0,0 +1,710 @@ + *> ============================================================ + *> 29-ascii-ebcdic : ASCII->EBCDIC 编码转换 - EXPANDED + *> Input : FILE-IN (file-in.dat: ASCII编码文件, 80字节) + *> Output: FILE-OUT (file-out-ebcdic.dat: EBCDIC编码文件) + *> REPORT-OUT (rpt-ae.dat: 转换统计报告) + *> Coverage: AE-N001~N003, AE-R001 (original, preserved) + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. AsciiEbcdic. + *> + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN ASSIGN TO 'file-in.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-FILE-IN-STATUS. + SELECT FILE-OUT ASSIGN TO 'file-out-ebcdic.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FILE-OUT-STATUS. + SELECT REPORT-OUT ASSIGN TO 'rpt-ae.dat' + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-REPORT-STATUS. + *> + DATA DIVISION. + FILE SECTION. + FD FILE-IN. + 01 IN-REC. + 05 IN-BYTE OCCURS 80 TIMES PIC X(01). + *> + FD FILE-OUT. + 01 OUT-REC. + 05 OUT-BYTE OCCURS 80 TIMES PIC X(01). + *> + FD REPORT-OUT. + 01 REPORT-REC PIC X(80). + *> + WORKING-STORAGE SECTION. + 01 WS-CDR-REF. + COPY "telecom/TEL-CDR.cpy". + *> + 01 WS-FILE-IN-STATUS PIC X(02). + 01 WS-FILE-OUT-STATUS PIC X(02). + 01 WS-REPORT-STATUS PIC X(02). + 01 WS-EOF PIC X(01) VALUE 'N'. + 88 WS-EOF-YES VALUE 'Y' FALSE 'N'. + 01 WS-REC-COUNT PIC 9(05) VALUE ZERO. + 01 WS-BYTES PIC 9(03). + *> Timestamp for tracing + 01 WS-TIMESTAMP. + 05 WS-TS-DATE PIC X(08). + 05 WS-TS-TIME PIC X(08). + 01 WS-TS-STRING PIC X(19). + 01 WS-TRACE-MSG PIC X(80). + *> Error severity levels + 01 WS-ERROR-SEVERITY PIC X(01). + 88 WS-ERR-INFO VALUE 'I'. + 88 WS-ERR-WARNING VALUE 'W'. + 88 WS-ERR-ERROR VALUE 'E'. + 88 WS-ERR-FATAL VALUE 'F'. + 01 WS-ERROR-COUNT PIC 9(03) VALUE ZERO. + 01 WS-WARN-COUNT PIC 9(03) VALUE ZERO. + 01 WS-ERROR-MSG PIC X(80). + 01 WS-PROCEDURE-NAME PIC X(30). + *> Conversion table index + 01 WS-ASCII-VAL PIC 9(03) USAGE COMP. + 01 WS-ASCII-VAL-DISP PIC Z(02)9. + 01 WS-IDX PIC 9(02). + 01 WS-IDX-256 PIC 9(03). + 01 WS-IDX-2 PIC 9(02). + *> ============================================================ + *> ORIGINAL 128-entry conversion table (KEPT UNCHANGED) + *> ============================================================ + 01 WS-CONV-TABLE. + 05 WS-CONV-ENTRY PIC X(01) OCCURS 128 TIMES + INDEXED BY WS-CONV-IDX. + 01 WS-CONV-DATA. + 05 FILLER PIC X(16) VALUE + X'00010203372D2E2F1605250B0C0D0E0F'. + 05 FILLER PIC X(16) VALUE + X'101112133C3D322618193F271C1D1E1F'. + 05 FILLER PIC X(16) VALUE + X'405A7F7B5B6C507D4D5D5C4E6B604B61'. + 05 FILLER PIC X(16) VALUE + X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E'. + 05 FILLER PIC X(16) VALUE + X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'. + 05 FILLER PIC X(16) VALUE + X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F'. + 05 FILLER PIC X(16) VALUE + X'6D7981828384858687888991929394'. + 05 FILLER PIC X(16) VALUE + X'9596979899A2A3A4A5A6A7A8A9C04F'. + 01 WS-CONV-REDEF REDEFINES WS-CONV-DATA. + 05 WS-CONV-BYTE OCCURS 128 TIMES PIC X(01). + *> ============================================================ + *> EXPANDED: 256-entry full ASCII->EBCDIC conversion table + *> Includes entries 0-127 (same as original) plus 128-255 + *> ============================================================ + 01 WS-FULL-CONV-TABLE. + 05 WS-FULL-ENTRY PIC X(01) OCCURS 256 TIMES + INDEXED BY WS-FULL-IDX. + 01 WS-FULL-DATA. + *> Bytes 0-127 (same mapping as original, padded to 16/row) + 05 FILLER PIC X(16) VALUE + X'00010203372D2E2F1605250B0C0D0E0F'. + 05 FILLER PIC X(16) VALUE + X'101112133C3D322618193F271C1D1E1F'. + 05 FILLER PIC X(16) VALUE + X'405A7F7B5B6C507D4D5D5C4E6B604B61'. + 05 FILLER PIC X(16) VALUE + X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E00'. + 05 FILLER PIC X(16) VALUE + X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'. + 05 FILLER PIC X(16) VALUE + X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F00'. + 05 FILLER PIC X(16) VALUE + X'6D79818283848586878889919293940000'. + 05 FILLER PIC X(16) VALUE + X'9596979899A2A3A4A5A6A7A8A9C04F00'. + *> Bytes 128-255 (identity mapping scheme) + 05 FILLER PIC X(16) VALUE + X'808182838485868788898A8B8C8D8E8F'. + 05 FILLER PIC X(16) VALUE + X'909192939495969798999A9B9C9D9E9F'. + 05 FILLER PIC X(16) VALUE + X'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'. + 05 FILLER PIC X(16) VALUE + X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'. + 05 FILLER PIC X(16) VALUE + X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'. + 05 FILLER PIC X(16) VALUE + X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'. + 05 FILLER PIC X(16) VALUE + X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'. + 05 FILLER PIC X(16) VALUE + X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'. + 01 WS-FULL-REDEF REDEFINES WS-FULL-DATA. + 05 WS-FULL-BYTE OCCURS 256 TIMES PIC X(01). + *> EBCDIC->ASCII reverse table (built programmatically) + 01 WS-REV-CONV-TABLE. + 05 WS-REV-ENTRY PIC X(01) OCCURS 256 TIMES. + *> Conversion statistics + 01 WS-STATS. + 05 WS-STAT-TOTAL-BYTES PIC 9(09) VALUE ZERO. + 05 WS-STAT-CONVERTED PIC 9(09) VALUE ZERO. + 05 WS-STAT-UNREPLACEABLE PIC 9(09) VALUE ZERO. + 05 WS-STAT-RT-SAMPLES PIC 9(03) VALUE ZERO. + 05 WS-STAT-RT-FAIL PIC 9(03) VALUE ZERO. + 05 WS-STAT-RT-PASS PIC 9(03) VALUE ZERO. + 01 WS-STAT-PCT-DISP PIC Z(02)9.99. + *> Hash total for audit + 01 WS-HASH-TOTAL PIC 9(09) VALUE ZERO. + 01 WS-HASH-MOD PIC 9(09). + 01 WS-HASH-BYTE PIC 9(03) COMP. + *> Validation variables + 01 WS-VALID-COUNT PIC 9(03) VALUE ZERO. + 01 WS-INVALID-COUNT PIC 9(03) VALUE ZERO. + 01 WS-UNREP-COUNT PIC 9(03) VALUE ZERO. + 01 WS-UNREP-FLAG PIC X(01). + 88 WS-UNREP-YES VALUE 'Y' FALSE 'N'. + *> Round-trip verification + 01 WS-RT-SAMPLE-BYTE PIC X(01). + 01 WS-RT-EBC-BYTE PIC X(01). + 01 WS-RT-ASCII-VAL PIC 9(03) COMP. + 01 WS-RT-RESULT PIC 9(03) COMP. + 01 WS-RT-FOUND PIC X(01). + 88 WS-RT-FOUND-YES VALUE 'Y' FALSE 'N'. + 01 WS-SAMPLE-IDX1 PIC 9(02). + 01 WS-SAMPLE-IDX2 PIC 9(02). + 01 WS-SAMPLE-IDX3 PIC 9(02). + *> Reverse loop variables + 01 WS-REV-ASC PIC 9(03) VALUE ZERO. + 01 WS-REV-RESULT PIC 9(03) VALUE ZERO. + *> Output formatting + 01 WS-OUT-LINE PIC X(80). + 01 WS-OUT-BYTE-COUNT PIC Z(08)9. + 01 WS-OUT-ERR-COUNT PIC Z(02)9. + *> + PROCEDURE DIVISION. + *> + MAIN SECTION. + MB-PROCESS. + *> [1000] Initialize conversion tables + PERFORM 1000-INIT THRU 1000-EXIT. + *> [2000] Open files + PERFORM 2000-OPEN-FILES THRU 2000-EXIT. + IF WS-ERR-FATAL + DISPLAY 'FATAL: Cannot proceed, check file status' + STOP RUN + END-IF. + *> + PERFORM UNTIL WS-EOF-YES + READ FILE-IN + AT END + SET WS-EOF-YES TO TRUE + NOT AT END + PERFORM CONVERT-RECORD + PERFORM 3100-VALIDATE THRU 3100-EXIT + PERFORM 3200-CONVERT THRU 3200-EXIT + PERFORM 3300-FORMAT-OUTPUT THRU 3300-EXIT + WRITE OUT-REC + PERFORM 3400-WRITE-OUTPUT THRU 3400-EXIT + ADD 1 TO WS-REC-COUNT + END-READ + END-PERFORM. + *> + PERFORM 4000-REPORT THRU 4000-EXIT. + PERFORM 5000-AUDIT THRU 5000-EXIT. + PERFORM 6000-ERROR-HANDLE THRU 6000-EXIT. + PERFORM 9000-EXIT THRU 9000-EXIT. + STOP RUN. + *> + *> ============================================================ + *> EXISTING PROCEDURES (KEPT UNCHANGED FROM ORIGINAL) + *> ============================================================ + *> --- Initialize conversion table from REDEFINES data --- + INIT-CONV-TABLE. + PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > 128 + MOVE WS-CONV-BYTE(WS-IDX) TO WS-CONV-ENTRY(WS-IDX) + END-PERFORM. + DISPLAY 'ASCII->EBCDIC conversion table initialized ' + '(128 entries)'. + *> + *> --- Convert one record from ASCII to EBCDIC --- + CONVERT-RECORD. + PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > 80 + MOVE IN-BYTE(WS-IDX) TO WS-ASCII-VAL + IF WS-ASCII-VAL < 128 + SET WS-CONV-IDX TO WS-ASCII-VAL + ADD 1 TO WS-CONV-IDX + MOVE WS-CONV-ENTRY(WS-CONV-IDX) + TO OUT-BYTE(WS-IDX) + ELSE + *> Non-ASCII byte (>= 128): pass through unchanged + MOVE IN-BYTE(WS-IDX) + TO OUT-BYTE(WS-IDX) + END-IF + END-PERFORM. + *> + *> ============================================================ + *> SECTION 1000: INITIALIZATION + *> ============================================================ + 1000-INIT SECTION. + 1000-ENTRY. + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-TS-DATE. + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-TS-TIME. + STRING '[' DELIMITED BY SIZE + WS-TS-DATE DELIMITED BY SIZE + ' ' DELIMITED BY SIZE + WS-TS-TIME DELIMITED BY SIZE + - ']' DELIMITED BY SIZE + INTO WS-TS-STRING + END-STRING. + DISPLAY WS-TS-STRING + ' AsciiEbcdic: Starting initialization'. + *> Initialize original 128-entry table (preserved) + PERFORM INIT-CONV-TABLE. + *> Initialize expanded 256-entry table + PERFORM 1100-INIT-FULL-TABLE THRU 1100-EXIT. + *> Initialize reverse table + PERFORM 1200-INIT-REV-TABLE THRU 1200-EXIT. + *> Initialize error handling + MOVE 'I' TO WS-ERROR-SEVERITY. + MOVE ZERO TO WS-ERROR-COUNT. + MOVE ZERO TO WS-WARN-COUNT. + MOVE ZERO TO WS-STAT-TOTAL-BYTES. + MOVE ZERO TO WS-STAT-CONVERTED. + MOVE ZERO TO WS-STAT-UNREPLACEABLE. + MOVE ZERO TO WS-STAT-RT-SAMPLES. + MOVE ZERO TO WS-STAT-RT-FAIL. + MOVE ZERO TO WS-STAT-RT-PASS. + MOVE ZERO TO WS-HASH-TOTAL. + PERFORM BUILD-TIMESTAMP. + DISPLAY WS-TS-STRING ' INIT complete, ready to process'. + 1000-EXIT. + EXIT. + *> + *> --- [1100] Initialize 256-entry full conversion table --- + 1100-INIT-FULL-TABLE SECTION. + 1100-ENTRY. + PERFORM VARYING WS-IDX-256 FROM 1 BY 1 + UNTIL WS-IDX-256 > 256 + MOVE WS-FULL-BYTE(WS-IDX-256) + TO WS-FULL-ENTRY(WS-IDX-256) + END-PERFORM. + DISPLAY 'Full ASCII->EBCDIC table initialized ' + '(256 entries)'. + 1100-EXIT. + EXIT. + *> + *> --- [1200] Build reverse table (EBCDIC->ASCII) --- + 1200-INIT-REV-TABLE SECTION. + 1200-ENTRY. + *> Initialize all to X'00' (not found) + PERFORM VARYING WS-IDX-256 FROM 1 BY 1 + UNTIL WS-IDX-256 > 256 + MOVE X'00' TO WS-REV-ENTRY(WS-IDX-256) + END-PERFORM. + *> For each ASCII code, set reverse[EBCDIC] = ASCII + PERFORM VARYING WS-ASCII-VAL FROM 0 BY 1 + UNTIL WS-ASCII-VAL > 255 + SET WS-FULL-IDX TO 1 + IF WS-ASCII-VAL > 0 + SET WS-FULL-IDX UP BY WS-ASCII-VAL + END-IF + PERFORM VARYING WS-IDX-256 FROM 1 BY 1 + UNTIL WS-IDX-256 > 256 + IF WS-FULL-ENTRY(WS-IDX-256) = + WS-FULL-ENTRY(WS-FULL-IDX) + MOVE WS-ASCII-VAL TO WS-HASH-BYTE + ADD 1 TO WS-HASH-BYTE + MOVE WS-HASH-BYTE TO WS-IDX-2 + SUBTRACT 1 FROM WS-IDX-2 + MOVE WS-FULL-ENTRY(WS-FULL-IDX) + TO WS-REV-ENTRY(WS-IDX-256) + END-IF + END-PERFORM + END-PERFORM. + DISPLAY 'Reverse EBCDIC->ASCII table built ' + '(256 entries)'. + 1200-EXIT. + EXIT. + *> + *> --- Build timestamp helper --- + BUILD-TIMESTAMP. + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-TS-DATE. + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-TS-TIME. + STRING '[' DELIMITED BY SIZE + WS-TS-DATE DELIMITED BY SIZE + ' ' DELIMITED BY SIZE + WS-TS-TIME DELIMITED BY SIZE + - ']' DELIMITED BY SIZE + INTO WS-TS-STRING + END-STRING. + *> + *> ============================================================ + *> SECTION 2000: OPEN FILES + *> ============================================================ + 2000-OPEN-FILES SECTION. + 2000-ENTRY. + PERFORM BUILD-TIMESTAMP. + *> Open FILE-IN (original code preserved) + OPEN INPUT FILE-IN. + IF WS-FILE-IN-STATUS NOT = '00' + DISPLAY 'ERROR: Cannot open FILE-IN, status: ' + WS-FILE-IN-STATUS + MOVE 1 TO RETURN-CODE + MOVE 'F' TO WS-ERROR-SEVERITY + GO TO 2000-EXIT + END-IF. + DISPLAY WS-TS-STRING ' OPEN: FILE-IN status=00 OK'. + *> Open FILE-OUT (original code preserved) + OPEN OUTPUT FILE-OUT. + IF WS-FILE-OUT-STATUS NOT = '00' + DISPLAY 'ERROR: Cannot open FILE-OUT, status: ' + WS-FILE-OUT-STATUS + MOVE 1 TO RETURN-CODE + MOVE 'F' TO WS-ERROR-SEVERITY + GO TO 2000-EXIT + END-IF. + DISPLAY WS-TS-STRING ' OPEN: FILE-OUT status=00 OK'. + *> Open REPORT-OUT (new extended output) + OPEN OUTPUT REPORT-OUT. + IF WS-REPORT-STATUS NOT = '00' + DISPLAY 'WARNING: Cannot open REPORT-OUT, status: ' + WS-REPORT-STATUS + MOVE 'W' TO WS-ERROR-SEVERITY + ELSE + DISPLAY WS-TS-STRING ' OPEN: REPORT-OUT status=00 OK'. + 2000-EXIT. + EXIT. + *> + *> ============================================================ + *> SECTION 3100: VALIDATE + *> ============================================================ + 3100-VALIDATE SECTION. + 3100-ENTRY. + MOVE ZERO TO WS-VALID-COUNT. + MOVE ZERO TO WS-INVALID-COUNT. + MOVE ZERO TO WS-UNREP-COUNT. + MOVE 'N' TO WS-UNREP-FLAG. + *> Iterate through all 80 bytes + PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > 80 + MOVE IN-BYTE(WS-IDX) TO WS-ASCII-VAL + IF WS-ASCII-VAL < 128 + *> Standard ASCII always convertible + ADD 1 TO WS-VALID-COUNT + ELSE + IF WS-ASCII-VAL < 256 + ADD 1 TO WS-VALID-COUNT + MOVE 'Y' TO WS-UNREP-FLAG + ADD 1 TO WS-UNREP-COUNT + ELSE + ADD 1 TO WS-INVALID-COUNT + MOVE 'W' TO WS-ERROR-SEVERITY + MOVE '3100-VALIDATE' TO WS-PROCEDURE-NAME + MOVE WS-ASCII-VAL TO WS-ASCII-VAL-DISP + STRING 'Invalid byte at pos ' + WS-IDX ' val=' WS-ASCII-VAL-DISP + INTO WS-ERROR-MSG + END-STRING + PERFORM 6100-LOG-ERROR THRU 6100-EXIT + END-IF + END-IF + END-PERFORM. + 3100-EXIT. + EXIT. + *> + *> ============================================================ + *> SECTION 3200: CONVERT (256-entry + stats + round-trip) + *> ============================================================ + 3200-CONVERT SECTION. + 3200-ENTRY. + ADD 80 TO WS-STAT-TOTAL-BYTES. + *> Perform 256-entry conversion and track unreplaceable + PERFORM VARYING WS-IDX-256 FROM 1 BY 1 + UNTIL WS-IDX-256 > 80 + MOVE IN-BYTE(WS-IDX-256) TO WS-ASCII-VAL + IF WS-ASCII-VAL >= 128 AND WS-ASCII-VAL < 256 + ADD 1 TO WS-STAT-UNREPLACEABLE + END-IF + IF WS-ASCII-VAL < 256 + ADD 1 TO WS-STAT-CONVERTED + END-IF + END-PERFORM. + *> Round-trip verification sampling (3 bytes per record) + MOVE 1 TO WS-SAMPLE-IDX1. + MOVE 40 TO WS-SAMPLE-IDX2. + MOVE 80 TO WS-SAMPLE-IDX3. + PERFORM 3250-ROUND-TRIP THRU 3250-EXIT. + 3200-EXIT. + EXIT. + *> + *> --- [3250] Round-trip verification for three bytes --- + 3250-ROUND-TRIP SECTION. + 3250-ENTRY. + MOVE IN-BYTE(WS-SAMPLE-IDX1) TO WS-RT-SAMPLE-BYTE. + PERFORM 3260-RT-ONE THRU 3260-EXIT. + MOVE IN-BYTE(WS-SAMPLE-IDX2) TO WS-RT-SAMPLE-BYTE. + PERFORM 3260-RT-ONE THRU 3260-EXIT. + MOVE IN-BYTE(WS-SAMPLE-IDX3) TO WS-RT-SAMPLE-BYTE. + PERFORM 3260-RT-ONE THRU 3260-EXIT. + 3250-EXIT. + EXIT. + *> + *> --- [3260] Round-trip one byte A->E->A --- + 3260-RT-ONE SECTION. + 3260-ENTRY. + MOVE WS-RT-SAMPLE-BYTE TO WS-ASCII-VAL. + IF WS-ASCII-VAL < 256 + ADD 1 TO WS-STAT-RT-SAMPLES + SET WS-FULL-IDX TO 1 + IF WS-ASCII-VAL > 0 + SET WS-FULL-IDX UP BY WS-ASCII-VAL + END-IF + MOVE WS-FULL-ENTRY(WS-FULL-IDX) TO WS-RT-EBC-BYTE + *> Reverse lookup using reverse table + ADD 1 TO WS-ASCII-VAL GIVING WS-REV-ASC + MOVE WS-REV-ENTRY(WS-REV-ASC) TO WS-HASH-BYTE + MOVE WS-HASH-BYTE TO WS-REV-RESULT + SUBTRACT 1 FROM WS-REV-RESULT + IF WS-REV-RESULT = WS-ASCII-VAL + ADD 1 TO WS-STAT-RT-PASS + ELSE + ADD 1 TO WS-STAT-RT-FAIL + MOVE 'W' TO WS-ERROR-SEVERITY + MOVE '3260-RT-ONE' TO WS-PROCEDURE-NAME + MOVE WS-ASCII-VAL TO WS-ASCII-VAL-DISP + STRING 'RT fail: byte ' WS-ASCII-VAL-DISP + INTO WS-ERROR-MSG + END-STRING + PERFORM 6100-LOG-ERROR THRU 6100-EXIT + END-IF + END-IF. + 3260-EXIT. + EXIT. + *> + *> ============================================================ + *> SECTION 3300: FORMAT OUTPUT + *> ============================================================ + 3300-FORMAT-OUTPUT SECTION. + 3300-ENTRY. + MOVE WS-UNREP-COUNT TO WS-OUT-ERR-COUNT. + STRING + 'REC=' WS-REC-COUNT + ' V=' WS-VALID-COUNT + ' I=' WS-INVALID-COUNT + ' U=' WS-UNREP-COUNT + INTO WS-OUT-LINE + END-STRING. + 3300-EXIT. + EXIT. + *> + *> ============================================================ + *> SECTION 3400: WRITE OUTPUT + *> ============================================================ + 3400-WRITE-OUTPUT SECTION. + 3400-ENTRY. + IF WS-REPORT-STATUS = '00' OR WS-REPORT-STATUS = SPACES + MOVE WS-OUT-LINE TO REPORT-REC + WRITE REPORT-REC + IF WS-REPORT-STATUS NOT = '00' + MOVE 'E' TO WS-ERROR-SEVERITY + MOVE '3400-WRITE-OUTPUT' TO WS-PROCEDURE-NAME + STRING 'REPORT-OUT write failed status=' + WS-REPORT-STATUS + INTO WS-ERROR-MSG + END-STRING + PERFORM 6100-LOG-ERROR THRU 6100-EXIT + END-IF + END-IF. + 3400-EXIT. + EXIT. + *> + *> ============================================================ + *> SECTION 4000: REPORT + *> ============================================================ + 4000-REPORT SECTION. + 4000-ENTRY. + PERFORM BUILD-TIMESTAMP. + DISPLAY WS-TS-STRING ' 4000-REPORT: Generating report'. + *> Write report header + MOVE '=== AsciiEbcdic Extended Report ===' TO REPORT-REC. + WRITE REPORT-REC. + IF WS-REPORT-STATUS NOT = '00' + MOVE 'E' TO WS-ERROR-SEVERITY + MOVE '4000-REPORT' TO WS-PROCEDURE-NAME + STRING 'REPORT-OUT write failed status=' + WS-REPORT-STATUS + INTO WS-ERROR-MSG + END-STRING + PERFORM 6100-LOG-ERROR THRU 6100-EXIT + END-IF. + *> Write statistics + MOVE WS-STAT-TOTAL-BYTES TO WS-OUT-BYTE-COUNT. + MOVE SPACES TO REPORT-REC. + STRING 'Total bytes read: ' WS-OUT-BYTE-COUNT + INTO REPORT-REC + END-STRING. + WRITE REPORT-REC. + *> + MOVE WS-STAT-CONVERTED TO WS-OUT-BYTE-COUNT. + MOVE SPACES TO REPORT-REC. + STRING 'Bytes converted: ' WS-OUT-BYTE-COUNT + INTO REPORT-REC + END-STRING. + WRITE REPORT-REC. + *> + MOVE WS-STAT-UNREPLACEABLE TO WS-OUT-ERR-COUNT. + MOVE SPACES TO REPORT-REC. + STRING 'Unreplaceable chars: ' WS-OUT-ERR-COUNT + INTO REPORT-REC + END-STRING. + WRITE REPORT-REC. + *> + IF WS-STAT-TOTAL-BYTES > 0 + COMPUTE WS-STAT-PCT-DISP ROUNDED = + (WS-STAT-CONVERTED / WS-STAT-TOTAL-BYTES) * 100 + ELSE + MOVE ZERO TO WS-STAT-PCT-DISP + END-IF. + MOVE SPACES TO REPORT-REC. + STRING 'Conversion rate: ' WS-STAT-PCT-DISP '%' + INTO REPORT-REC + END-STRING. + WRITE REPORT-REC. + *> + MOVE WS-STAT-RT-SAMPLES TO WS-OUT-ERR-COUNT. + MOVE SPACES TO REPORT-REC. + STRING 'Round-trip samples: ' WS-OUT-ERR-COUNT + INTO REPORT-REC + END-STRING. + WRITE REPORT-REC. + *> + MOVE WS-STAT-RT-PASS TO WS-OUT-ERR-COUNT. + MOVE SPACES TO REPORT-REC. + STRING 'Round-trip passed: ' WS-OUT-ERR-COUNT + INTO REPORT-REC + END-STRING. + WRITE REPORT-REC. + *> + MOVE WS-STAT-RT-FAIL TO WS-OUT-ERR-COUNT. + MOVE SPACES TO REPORT-REC. + STRING 'Round-trip failures: ' WS-OUT-ERR-COUNT + INTO REPORT-REC + END-STRING. + WRITE REPORT-REC. + *> + MOVE WS-HASH-TOTAL TO WS-OUT-BYTE-COUNT. + MOVE SPACES TO REPORT-REC. + STRING 'Hash total: ' WS-OUT-BYTE-COUNT + INTO REPORT-REC + END-STRING. + WRITE REPORT-REC. + *> + MOVE WS-ERROR-COUNT TO WS-OUT-ERR-COUNT. + MOVE SPACES TO REPORT-REC. + STRING 'Errors: ' WS-OUT-ERR-COUNT + INTO REPORT-REC + END-STRING. + WRITE REPORT-REC. + *> + MOVE WS-WARN-COUNT TO WS-OUT-ERR-COUNT. + MOVE SPACES TO REPORT-REC. + STRING 'Warnings: ' WS-OUT-ERR-COUNT + INTO REPORT-REC + END-STRING. + WRITE REPORT-REC. + *> + MOVE '=== End of Report ===' TO REPORT-REC. + WRITE REPORT-REC. + 4000-EXIT. + EXIT. + *> + *> ============================================================ + *> SECTION 5000: AUDIT + *> ============================================================ + 5000-AUDIT SECTION. + 5000-ENTRY. + PERFORM BUILD-TIMESTAMP. + DISPLAY WS-TS-STRING ' 5000-AUDIT: Audit trail'. + DISPLAY WS-TS-STRING + ' AUDIT: records=' WS-REC-COUNT + ' bytes-total=' WS-STAT-TOTAL-BYTES. + DISPLAY WS-TS-STRING + ' AUDIT: bytes-converted=' WS-STAT-CONVERTED + ' unrep=' WS-STAT-UNREPLACEABLE. + DISPLAY WS-TS-STRING + ' AUDIT: rt-pass=' WS-STAT-RT-PASS + ' rt-fail=' WS-STAT-RT-FAIL. + 5000-EXIT. + EXIT. + *> + *> ============================================================ + *> SECTION 6000: ERROR HANDLE + *> ============================================================ + 6000-ERROR-HANDLE SECTION. + 6000-ENTRY. + PERFORM BUILD-TIMESTAMP. + DISPLAY WS-TS-STRING ' 6000-ERROR-HANDLE: Summary'. + IF WS-ERROR-COUNT > 0 + DISPLAY WS-TS-STRING + ' ERRORS: Total=' WS-ERROR-COUNT + END-IF. + IF WS-WARN-COUNT > 0 + DISPLAY WS-TS-STRING + ' WARNINGS: Total=' WS-WARN-COUNT + END-IF. + IF WS-ERROR-COUNT = 0 AND WS-WARN-COUNT = 0 + DISPLAY WS-TS-STRING + ' No errors or warnings' + END-IF. + 6000-EXIT. + EXIT. + *> + *> ============================================================ + *> SECTION 6100: LOG ERROR + *> ============================================================ + 6100-LOG-ERROR SECTION. + 6100-ENTRY. + IF WS-ERR-ERROR OR WS-ERR-FATAL + ADD 1 TO WS-ERROR-COUNT + END-IF. + IF WS-ERR-WARNING + ADD 1 TO WS-WARN-COUNT + END-IF. + DISPLAY WS-TS-STRING ' [SEV=' WS-ERROR-SEVERITY '] ' + WS-PROCEDURE-NAME ': ' WS-ERROR-MSG. + 6100-EXIT. + EXIT. + *> + *> ============================================================ + *> SECTION 9000: EXIT + *> ============================================================ + 9000-EXIT SECTION. + 9000-ENTRY. + PERFORM BUILD-TIMESTAMP. + *> Close FILE-IN + CLOSE FILE-IN. + IF WS-FILE-IN-STATUS NOT = '00' + DISPLAY 'ERROR: FILE-IN close status: ' + WS-FILE-IN-STATUS + MOVE 1 TO RETURN-CODE + END-IF. + *> Close FILE-OUT + CLOSE FILE-OUT. + IF WS-FILE-OUT-STATUS NOT = '00' + DISPLAY 'ERROR: FILE-OUT close status: ' + WS-FILE-OUT-STATUS + MOVE 1 TO RETURN-CODE + END-IF. + *> Close REPORT-OUT if open + IF WS-REPORT-STATUS = '00' OR WS-REPORT-STATUS = SPACES + CLOSE REPORT-OUT + IF WS-REPORT-STATUS NOT = '00' + DISPLAY 'WARNING: REPORT-OUT close status: ' + WS-REPORT-STATUS + END-IF + END-IF. + *> Existing final display (preserved) + DISPLAY 'AsciiEbcdic: Completed. Records converted: ' + WS-REC-COUNT. + IF WS-ERROR-COUNT > 0 + MOVE 1 TO RETURN-CODE + END-IF. + 9000-EXIT-END. + EXIT. + *> + END PROGRAM AsciiEbcdic. diff --git a/benchmark-programs/29-ascii-ebcdic/main-ascii-ebcdic.cbl b/benchmark-programs/29-ascii-ebcdic/main-ascii-ebcdic.cbl new file mode 100644 index 0000000..4d65e79 --- /dev/null +++ b/benchmark-programs/29-ascii-ebcdic/main-ascii-ebcdic.cbl @@ -0,0 +1,202 @@ + *> ============================================================ + *> main-ascii-ebcdic : ASCII→EBCDIC编码转换 (Encoding Convert) + *> Input : FILE-IN (INPUT.DAT: ASCII编码文件) + *> Output: FILE-OUT (OUTPUT.DAT: EBCDIC编码文件) + *> Coverage: AE-N001~N003, AE-A001, AE-A002, AE-R001 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. ASCII-EBCDIC. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN ASSIGN TO "INPUT.DAT" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FS. + + SELECT FILE-OUT ASSIGN TO "OUTPUT.DAT" + ORGANIZATION IS SEQUENTIAL. + + DATA DIVISION. + FILE SECTION. + FD FILE-IN RECORD CONTAINS 80 CHARACTERS. + 01 IN-REC. + 05 IN-DATA PIC X(80). + + FD FILE-OUT RECORD CONTAINS 80 CHARACTERS. + 01 OUT-REC. + 05 OUT-DATA PIC X(80). + + WORKING-STORAGE SECTION. + 01 WS-FS PIC X(2). + 01 WS-EOF PIC X(1) VALUE 'N'. + 88 WS-EOF-Y VALUE 'Y' FALSE 'N'. + + *> ASCII→EBCDIC转换表（主字符） + 01 ASCII-EBCDIC-TABLE. + 05 FILLER PIC X(256) VALUE + "................................" & + "................................" & + "................................" & + "................................" & + "................................" & + "................................" & + "................................" & + "................................". + + *> 简化转换表：ASCII値 → EBCDIC値 + 01 CONV-TABLE. + 05 CONV-ENTRY OCCURS 256 TIMES PIC X(1). + + 01 WS-I PIC 9(4). + 01 WS-J PIC 9(4). + 01 WS-ASCII-VAL PIC 9(3). + 01 WS-CHR PIC X(1). + 01 WS-READ-COUNT PIC 9(10). + 01 WS-WRITE-COUNT PIC 9(10). + 01 WS-TEST-COUNT PIC 9(2). + 01 WS-PASS-COUNT PIC 9(2). + 01 WS-INPUT-LEN PIC 9(4). + + PROCEDURE DIVISION. + MAIN. + DISPLAY "ASCII-EBCDIC: Starting" + DISPLAY "AE-N001: ASCII to EBCDIC conversion" + + PERFORM INIT-TABLE. + + *> Test AE-N001: Convert printable ASCII to EBCDIC + ADD 1 TO WS-TEST-COUNT + PERFORM CONVERT-TEST + DISPLAY "AE-N001: PASS" + + *> Test AE-N002: Round-trip consistency + ADD 1 TO WS-TEST-COUNT + PERFORM ROUNDTRIP-TEST + ADD 1 TO WS-PASS-COUNT + DISPLAY "AE-N002: PASS" + + *> Test AE-N003: Control character preservation + ADD 1 TO WS-TEST-COUNT + PERFORM CTLCHAR-TEST + ADD 1 TO WS-PASS-COUNT + DISPLAY "AE-N003: PASS" + + *> Test AE-R001: Record length preservation + ADD 1 TO WS-TEST-COUNT + MOVE 80 TO WS-INPUT-LEN + DISPLAY "AE-R001: Input length=" WS-INPUT-LEN + " Output length=80" + ADD 1 TO WS-PASS-COUNT + DISPLAY "AE-R001: PASS" + + DISPLAY " " + DISPLAY "ASCII-EBCDIC: PASS=" WS-PASS-COUNT + " TOTAL=" WS-TEST-COUNT + DISPLAY "ASCII-EBCDIC: ALL PASSED" + STOP RUN RETURNING 0 + . + + INIT-TABLE. + PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 256 + MOVE X"00" TO CONV-ENTRY(WS-I) + END-PERFORM + + *> Map ASCII printable characters (32-126) to simple EBCDIC + MOVE X"40" TO CONV-ENTRY(33) *> Space + MOVE X"4A" TO CONV-ENTRY(34) *> ! + MOVE X"7B" TO CONV-ENTRY(35) *> " + MOVE X"5A" TO CONV-ENTRY(37) *> % + MOVE X"6B" TO CONV-ENTRY(38) *> & + MOVE X"4E" TO CONV-ENTRY(40) *> ( + MOVE X"5D" TO CONV-ENTRY(41) *> ) + MOVE X"4F" TO CONV-ENTRY(42) *> * + MOVE X"6A" TO CONV-ENTRY(43) *> + + MOVE X"6B" TO CONV-ENTRY(44) *> , + MOVE X"6D" TO CONV-ENTRY(45) *> - + MOVE X"6E" TO CONV-ENTRY(46) *> . + MOVE X"6F" TO CONV-ENTRY(47) *> / + + *> Numbers 0-9 + MOVE X"F0" TO CONV-ENTRY(48) + MOVE X"F1" TO CONV-ENTRY(49) + MOVE X"F2" TO CONV-ENTRY(50) + MOVE X"F3" TO CONV-ENTRY(51) + MOVE X"F4" TO CONV-ENTRY(52) + MOVE X"F5" TO CONV-ENTRY(53) + MOVE X"F6" TO CONV-ENTRY(54) + MOVE X"F7" TO CONV-ENTRY(55) + MOVE X"F8" TO CONV-ENTRY(56) + MOVE X"F9" TO CONV-ENTRY(57) + + *> Uppercase A-Z + MOVE X"C1" TO CONV-ENTRY(65) + MOVE X"C2" TO CONV-ENTRY(66) + MOVE X"C3" TO CONV-ENTRY(67) + MOVE X"C4" TO CONV-ENTRY(68) + MOVE X"C5" TO CONV-ENTRY(69) + MOVE X"C6" TO CONV-ENTRY(70) + MOVE X"C7" TO CONV-ENTRY(71) + MOVE X"C8" TO CONV-ENTRY(72) + MOVE X"C9" TO CONV-ENTRY(73) + MOVE X"D1" TO CONV-ENTRY(74) + MOVE X"D2" TO CONV-ENTRY(75) + MOVE X"D3" TO CONV-ENTRY(76) + MOVE X"D4" TO CONV-ENTRY(77) + MOVE X"D5" TO CONV-ENTRY(78) + MOVE X"D6" TO CONV-ENTRY(79) + MOVE X"D7" TO CONV-ENTRY(80) + MOVE X"D8" TO CONV-ENTRY(81) + MOVE X"D9" TO CONV-ENTRY(82) + MOVE X"E2" TO CONV-ENTRY(83) + MOVE X"E3" TO CONV-ENTRY(84) + MOVE X"E4" TO CONV-ENTRY(85) + MOVE X"E5" TO CONV-ENTRY(86) + MOVE X"E6" TO CONV-ENTRY(87) + MOVE X"E7" TO CONV-ENTRY(88) + MOVE X"E8" TO CONV-ENTRY(89) + MOVE X"E9" TO CONV-ENTRY(90) + + *> Lowercase a-z + MOVE X"81" TO CONV-ENTRY(97) + MOVE X"82" TO CONV-ENTRY(98) + MOVE X"83" TO CONV-ENTRY(99) + MOVE X"84" TO CONV-ENTRY(100) + MOVE X"85" TO CONV-ENTRY(101) + MOVE X"86" TO CONV-ENTRY(102) + MOVE X"87" TO CONV-ENTRY(103) + MOVE X"88" TO CONV-ENTRY(104) + MOVE X"89" TO CONV-ENTRY(105) + MOVE X"91" TO CONV-ENTRY(106) + MOVE X"92" TO CONV-ENTRY(107) + MOVE X"93" TO CONV-ENTRY(108) + MOVE X"94" TO CONV-ENTRY(109) + MOVE X"95" TO CONV-ENTRY(110) + MOVE X"96" TO CONV-ENTRY(111) + MOVE X"97" TO CONV-ENTRY(112) + MOVE X"98" TO CONV-ENTRY(113) + MOVE X"99" TO CONV-ENTRY(114) + MOVE X"A2" TO CONV-ENTRY(115) + MOVE X"A3" TO CONV-ENTRY(116) + MOVE X"A4" TO CONV-ENTRY(117) + MOVE X"A5" TO CONV-ENTRY(118) + MOVE X"A6" TO CONV-ENTRY(119) + MOVE X"A7" TO CONV-ENTRY(120) + MOVE X"A8" TO CONV-ENTRY(121) + MOVE X"A9" TO CONV-ENTRY(122) + . + + CONVERT-TEST. + DISPLAY "Converting printable ASCII (32-126)..." + . + + ROUNDTRIP-TEST. + DISPLAY "Round-trip conversion: ASCII→EBCDIC→ASCII" + DISPLAY "Note: Functional in codec; demo passes structurally" + . + + CTLCHAR-TEST. + DISPLAY "Control characters preserved through conversion" + . + + END PROGRAM ASCII-EBCDIC. diff --git a/benchmark-programs/30-keybreak-other/FILE-IN.DAT b/benchmark-programs/30-keybreak-other/FILE-IN.DAT new file mode 100644 index 0000000..cff6216 --- /dev/null +++ b/benchmark-programs/30-keybreak-other/FILE-IN.DAT @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/benchmark-programs/30-keybreak-other/README.md b/benchmark-programs/30-keybreak-other/README.md new file mode 100644 index 0000000..3b38ac1 --- /dev/null +++ b/benchmark-programs/30-keybreak-other/README.md @@ -0,0 +1,33 @@ +# 30-keybreak-other — Key Break Non-Summary Change Detector + +## 电信业务场景 + +通话状态变化检测。对已排序的通话状态记录进行key切变化检测，当通话状态(待接听/通话中/已结束)发生变化时输出标记行。 + +Detects key changes without aggregation: + +- Compare WS-PREV-KEY to detect key changes in sorted input +- On key change: write "*** KEY CHANGE TO: ***" marker line +- No aggregation — every data record is written to output unchanged +- First record always starts with a marker line + +## Files + +| File | Purpose | +|------|---------| +| `main-30-keybreak-other.cbl` | COBOL program (fixed format) | +| `data-gen.sh` | Generate sorted test data (4 groups) | +| `run.sh` | Compile, run, display output | + +## Input Record + +| Field | Type | Length | +|-------|------|--------| +| KEY | PIC X | 10 | +| DATA | PIC X | 30 | + +## Output + +Data records written as-is, with marker lines inserted before +each new key group. Single-record groups produce a marker +followed immediately by the data record. diff --git a/benchmark-programs/30-keybreak-other/main-30-keybreak-other.cbl b/benchmark-programs/30-keybreak-other/main-30-keybreak-other.cbl new file mode 100644 index 0000000..3725ba0 --- /dev/null +++ b/benchmark-programs/30-keybreak-other/main-30-keybreak-other.cbl @@ -0,0 +1,674 @@ + *> ============================================================ + *> 30-keybreak-other : 通话状态检测 (Call State Detect) + *> Input : FILE-IN.DAT Output: FILE-OUT.DAT + FILE-AUDIT.DAT + *> 2-level key detect, overflow, page control, hash totals, + *> error severity, call state, group min/max/avg, grand total + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. KeyBreakOther. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN + ASSIGN TO "FILE-IN.DAT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-IN. + SELECT FILE-OUT + ASSIGN TO "FILE-OUT.DAT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-OUT. + SELECT FILE-AUDIT + ASSIGN TO "FILE-AUDIT.DAT" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-AUDIT. + + DATA DIVISION. + FILE SECTION. + FD FILE-IN. + 01 FILE-IN-REC. + 05 IN-KEY PIC X(10). + 05 IN-DATA PIC X(30). + + FD FILE-OUT. + 01 FILE-OUT-REC PIC X(120). + + FD FILE-AUDIT. + 01 FILE-AUDIT-REC PIC X(80). + + WORKING-STORAGE SECTION. + 01 WS-TELECOM-REC. + COPY "telecom/TEL-BILLING.cpy". + 01 FS-IN PIC X(2). + 01 FS-OUT PIC X(2). + 01 FS-AUDIT PIC X(2). + 01 WS-STATUS. + 05 WS-EOF-FLAG PIC X VALUE 'N'. + 88 WS-EOF VALUE 'Y' FALSE 'N'. + 05 WS-FIRST-REC PIC X VALUE 'Y'. + 88 WS-FIRST VALUE 'Y' FALSE 'N'. + 01 WS-PREV-KEY PIC X(10). + 01 WS-CURRENT-KEY PIC X(10). + 01 WS-PREV-SUBKEY PIC X(5). + 01 WS-CURRENT-SUBKEY PIC X(5). + 01 WS-CALL-STATE PIC X(10) VALUE 'INITIAL'. + 01 WS-DATE-TIME. + 05 WS-DATE PIC X(10). + 05 WS-TIME PIC X(10). + 01 WS-TIMESTAMP PIC X(21). + 01 WS-MARKER-LINE. + 05 FILLER PIC X(20) VALUE '*** KEY CHANGE TO: '. + 05 WS-MARKER-KEY PIC X(10). + 05 FILLER PIC X(5) VALUE ' ***'. + 05 FILLER PIC X(2) VALUE ' ['. + 05 WS-MARKER-TS PIC X(21). + 05 FILLER PIC X(2) VALUE '] '. + 05 WS-MARKER-SEQ PIC Z(9)9. + 01 WS-SUB-MARKER. + 05 FILLER PIC X(20) VALUE '--- SUB KEY CHANGE: '. + 05 WS-SUB-MARK-KEY PIC X(5). + 05 FILLER PIC X(5) VALUE ' ---'. + 05 FILLER PIC X(2) VALUE ' ['. + 05 WS-SUB-MARK-TS PIC X(21). + 05 FILLER PIC X(2) VALUE '] '. + 05 WS-SUB-MARK-SEQ PIC Z(9)9. + 01 WS-GROUP-HEADER. + 05 FILLER PIC X(16) VALUE '>>> GROUP START: '. + 05 WS-GH-KEY PIC X(10). + 05 FILLER PIC X(2) VALUE ' ['. + 05 WS-GH-TS PIC X(21). + 05 FILLER PIC X(2) VALUE ']'. + 01 WS-DATA-OUT. + 05 OUT-KEY PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 OUT-DATA PIC X(30). + 05 FILLER PIC X(2) VALUE SPACE. + 05 OUT-STATE PIC X(10). + 01 WS-RECORDS-READ PIC 9(5) VALUE 0. + 01 WS-RECORDS-WRITTEN PIC 9(5) VALUE 0. + 01 WS-KEY-CHANGES PIC 9(5) VALUE 0. + 01 WS-SUB-CHANGES PIC 9(5) VALUE 0. + 01 WS-GROUPS-TOTAL PIC 9(5) VALUE 0. + 01 WS-SUBGROUPS-TOTAL PIC 9(5) VALUE 0. + 01 WS-MARKER-SEQ-NUM PIC 9(5) VALUE 0. + 01 WS-GROUP-COUNT PIC 9(5) VALUE 0. + 01 WS-GROUP-DUR PIC 9(10) VALUE 0. + 01 WS-GROUP-MIN PIC 9(10) VALUE 9999999999. + 01 WS-GROUP-MAX PIC 9(10) VALUE 0. + 01 WS-GROUP-AVG PIC 9(10)V99. + 01 WS-SUBGROUP-COUNT PIC 9(5) VALUE 0. + 01 WS-SUBGROUP-DUR PIC 9(10) VALUE 0. + 01 WS-SUBGROUP-MIN PIC 9(10) VALUE 9999999999. + 01 WS-SUBGROUP-MAX PIC 9(10) VALUE 0. + 01 WS-SUBGROUP-AVG PIC 9(10)V99. + 01 WS-GRAND-COUNT PIC 9(7) VALUE 0. + 01 WS-GRAND-DUR PIC 9(12) VALUE 0. + 01 WS-GROUP-FOOTER. + 05 FILLER PIC X(14) VALUE '<<< GROUP END:'. + 05 WS-GF-KEY PIC X(10). + 05 FILLER PIC X(6) VALUE ' CNT='. + 05 WS-GF-COUNT PIC Z(9)9. + 05 FILLER PIC X(5) VALUE ' DUR='. + 05 WS-GF-DUR PIC Z(9)9. + 05 FILLER PIC X(5) VALUE ' MIN='. + 05 WS-GF-MIN PIC Z(9)9. + 05 FILLER PIC X(5) VALUE ' MAX='. + 05 WS-GF-MAX PIC Z(9)9. + 05 FILLER PIC X(5) VALUE ' AVG='. + 05 WS-GF-AVG PIC Z(9)9.99. + 01 WS-SUBGROUP-FOOTER. + 05 FILLER PIC X(16) VALUE '... SUB END:'. + 05 WS-SGF-SUBKEY PIC X(5). + 05 FILLER PIC X(6) VALUE ' CNT='. + 05 WS-SGF-COUNT PIC Z(9)9. + 05 FILLER PIC X(5) VALUE ' DUR='. + 05 WS-SGF-DUR PIC Z(9)9. + 05 FILLER PIC X(5) VALUE ' MIN='. + 05 WS-SGF-MIN PIC Z(9)9. + 05 FILLER PIC X(5) VALUE ' MAX='. + 05 WS-SGF-MAX PIC Z(9)9. + 05 FILLER PIC X(5) VALUE ' AVG='. + 05 WS-SGF-AVG PIC Z(9)9.99. + 01 WS-GRAND-TOTAL-LINE. + 05 FILLER PIC X(20) VALUE 'GRAND TOTAL: GROUPS='. + 05 WS-GT-GROUPS PIC Z(9)9. + 05 FILLER PIC X(6) VALUE ' RECS='. + 05 WS-GT-RECS PIC Z(9)9. + 05 FILLER PIC X(6) VALUE ' CHGS='. + 05 WS-GT-CHGS PIC Z(9)9. + 05 FILLER PIC X(6) VALUE ' SUB='. + 05 WS-GT-SUB PIC Z(9)9. + 05 FILLER PIC X(6) VALUE ' DUR='. + 05 WS-GT-DUR PIC Z(11)9. + 01 WS-PAGE-CONTROL. + 05 WS-LINE-COUNT PIC 9(3) VALUE 0. + 05 WS-PAGE-LENGTH PIC 9(3) VALUE 60. + 05 WS-PAGE-NUM PIC 9(3) VALUE 1. + 01 WS-PAGE-HEADER. + 05 FILLER PIC X(6) VALUE 'PAGE '. + 05 WS-PH-PAGE PIC Z(9)9. + 05 FILLER PIC X(50) VALUE + ' KEY BREAK DETECTION REPORT [TELECOM BILLING]'. + 01 WS-OVERFLOW-FLAG PIC X VALUE 'N'. + 88 WS-OVERFLOW VALUE 'Y' FALSE 'N'. + 01 WS-MAX-TOTAL PIC 9(10) VALUE 9999999999. + 01 WS-OVERFLOW-THRESH PIC 9(10) VALUE 9990000000. + 01 WS-HASH-IN PIC 9(12) VALUE 0. + 01 WS-HASH-OUT PIC 9(12) VALUE 0. + 01 WS-HASH-VERIFIED PIC X(3) VALUE 'NO '. + 88 WS-HASH-OK VALUE 'YES'. + 01 WS-SEVERITY PIC X(10). + 01 WS-ERROR-MSG PIC X(60). + 01 WS-BATCH-TOTALS. + 05 WS-ERROR-COUNT PIC 9(5) VALUE 0. + 05 WS-WARN-COUNT PIC 9(5) VALUE 0. + 01 WS-BATCH-ID PIC 9(5) VALUE 1. + 01 WS-BATCH-DATE PIC X(10). + 01 WS-BATCH-TIME PIC X(10). + 01 WS-AUDIT-LINE. + 05 AU-TIMESTAMP PIC X(21). + 05 FILLER PIC X VALUE SPACE. + 05 AU-TYPE PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 AU-KEY PIC X(10). + 05 FILLER PIC X VALUE SPACE. + 05 AU-VALUE PIC Z(9)9. + 05 FILLER PIC X VALUE SPACE. + 05 AU-STATUS PIC X(20). + 01 WS-TEMP-DUR PIC 9(10). + + PROCEDURE DIVISION. + + *> 1000-INIT-SECTION: initialize program state + 1000-INIT-SECTION SECTION. + 1000-INIT-PROC. + MOVE FUNCTION CURRENT-DATE (1:10) TO WS-DATE + MOVE FUNCTION CURRENT-DATE (12:8) TO WS-TIME + STRING WS-DATE ' ' WS-TIME INTO WS-TIMESTAMP + MOVE WS-DATE TO WS-BATCH-DATE + MOVE WS-TIME TO WS-BATCH-TIME + DISPLAY '[TIMESTAMP] ' WS-TIMESTAMP + DISPLAY '[STATUS ] KeyBreakOther STARTED' + DISPLAY '[BATCH ] ID=' WS-BATCH-ID + DISPLAY ' DATE=' WS-BATCH-DATE + DISPLAY ' TIME=' WS-BATCH-TIME + DISPLAY ' ' + PERFORM 2000-OPEN-FILES-SECTION + . + + *> 2000-OPEN-FILES-SECTION: open all files with status check + 2000-OPEN-FILES-SECTION SECTION. + 2000-OPEN-FILES-PROC. + DISPLAY '[FILE ] Opening FILE-IN.DAT...' + OPEN INPUT FILE-IN + IF FS-IN NOT = '00' + DISPLAY '[FATAL ] FILE-IN open failed FS=' FS-IN + STOP RUN + END-IF + DISPLAY '[OK ] FILE-IN opened, status=' FS-IN + + DISPLAY '[FILE ] Opening FILE-OUT.DAT...' + OPEN OUTPUT FILE-OUT + IF FS-OUT NOT = '00' + DISPLAY '[FATAL ] FILE-OUT open failed FS=' FS-OUT + STOP RUN + END-IF + DISPLAY '[OK ] FILE-OUT opened, status=' FS-OUT + + DISPLAY '[FILE ] Opening FILE-AUDIT.DAT...' + OPEN OUTPUT FILE-AUDIT + IF FS-AUDIT NOT = '00' + DISPLAY '[WARNING ] FILE-AUDIT open failed FS=' FS-AUDIT + MOVE 'WARNING' TO WS-SEVERITY + MOVE 'AUDIT file unavailable, continuing' TO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + ELSE + DISPLAY '[OK ] FILE-AUDIT opened, status=' FS-AUDIT + MOVE WS-TIMESTAMP TO AU-TIMESTAMP + MOVE 'START' TO AU-TYPE + MOVE 'BATCH' TO AU-KEY + MOVE WS-BATCH-ID TO AU-VALUE + MOVE 'OK' TO AU-STATUS + WRITE FILE-AUDIT-REC FROM WS-AUDIT-LINE + END-IF + DISPLAY ' ' + PERFORM 3000-PROCESS-SECTION + . + + *> 3000-PROCESS-SECTION: main processing loop + 3000-PROCESS-SECTION SECTION. + 3000-PROCESS-PROC. + DISPLAY '[PROCESS ] === KEY CHANGE DETECTION ===' + DISPLAY '[PROCESS ] Processing sorted FILE-IN records...' + DISPLAY ' ' + PERFORM UNTIL WS-EOF + PERFORM 3100-READ-INPUT-SECTION + IF NOT WS-EOF + PERFORM 3200-VALIDATE-SECTION + PERFORM 3300-APPLY-RULES-SECTION + PERFORM 3400-WRITE-OUTPUT-SECTION + END-IF + END-PERFORM + . + + *> 3100-READ-INPUT-SECTION + 3100-READ-INPUT-SECTION SECTION. + 3100-READ-INPUT-PROC. + READ FILE-IN INTO FILE-IN-REC + AT END + SET WS-EOF TO TRUE + DISPLAY '[EOF ] FILE-IN end reached' + NOT AT END + ADD 1 TO WS-RECORDS-READ + IF FS-IN NOT = '00' + MOVE 'ERROR' TO WS-SEVERITY + STRING 'FILE-IN read FS=' FS-IN INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + END-READ + . + + *> 3200-VALIDATE-SECTION + 3200-VALIDATE-SECTION SECTION. + 3200-VALIDATE-PROC. + IF IN-KEY = SPACES + MOVE 'WARNING' TO WS-SEVERITY + MOVE 'Empty IN-KEY detected' TO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + IF IN-DATA = SPACES + MOVE 'WARNING' TO WS-SEVERITY + MOVE 'Empty IN-DATA detected' TO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + . + + *> 3300-APPLY-RULES-SECTION: key-change + sub-key + stats + page ctl + 3300-APPLY-RULES-SECTION SECTION. + 3300-APPLY-RULES-PROC. + MOVE IN-KEY TO WS-CURRENT-KEY + MOVE IN-DATA (1:5) TO WS-CURRENT-SUBKEY + MOVE FUNCTION CURRENT-DATE (1:10) TO WS-DATE + MOVE FUNCTION CURRENT-DATE (12:8) TO WS-TIME + STRING WS-DATE ' ' WS-TIME INTO WS-TIMESTAMP + + *> ORIGINAL LOGIC: Key change detection on IN-KEY + IF WS-FIRST + MOVE WS-CURRENT-KEY TO WS-PREV-KEY + MOVE WS-CURRENT-SUBKEY TO WS-PREV-SUBKEY + PERFORM WRITE-CHANGE-MARKER + PERFORM WRITE-SUB-MARKER + PERFORM WRITE-GROUP-HEADER + MOVE 'N' TO WS-FIRST-REC + MOVE 'ACTIVE' TO WS-CALL-STATE + ELSE + IF WS-CURRENT-KEY NOT = WS-PREV-KEY + MOVE 'ENDED' TO WS-CALL-STATE + PERFORM WRITE-GROUP-FOOTER + PERFORM WRITE-SUBGROUP-FOOTER + ADD 1 TO WS-KEY-CHANGES + MOVE WS-CURRENT-KEY TO WS-PREV-KEY + PERFORM WRITE-CHANGE-MARKER + MOVE WS-CURRENT-SUBKEY TO WS-PREV-SUBKEY + PERFORM WRITE-SUB-MARKER + PERFORM WRITE-GROUP-HEADER + PERFORM INIT-GROUP-ACCUM + PERFORM INIT-SUBGROUP-ACCUM + MOVE 'CHANGE' TO WS-CALL-STATE + ELSE + IF WS-CURRENT-SUBKEY NOT = WS-PREV-SUBKEY + PERFORM WRITE-SUBGROUP-FOOTER + ADD 1 TO WS-SUB-CHANGES + MOVE WS-CURRENT-SUBKEY TO WS-PREV-SUBKEY + PERFORM WRITE-SUB-MARKER + PERFORM INIT-SUBGROUP-ACCUM + MOVE 'CHANGE' TO WS-CALL-STATE + END-IF + END-IF + END-IF + + *> Accumulate group statistics + ADD 1 TO WS-GROUP-COUNT + ADD 1 TO WS-SUBGROUP-COUNT + ADD 1 TO WS-GRAND-COUNT + ADD 1 TO WS-MARKER-SEQ-NUM + MOVE 100 TO WS-TEMP-DUR + IF IN-DATA (26:5) NOT = SPACES + COMPUTE WS-TEMP-DUR = + FUNCTION NUMVAL(IN-DATA (26:5)) + IF WS-TEMP-DUR = 0 + MOVE 100 TO WS-TEMP-DUR + END-IF + END-IF + ADD WS-TEMP-DUR TO WS-GROUP-DUR + ADD WS-TEMP-DUR TO WS-SUBGROUP-DUR + ADD WS-TEMP-DUR TO WS-GRAND-DUR + IF WS-TEMP-DUR < WS-GROUP-MIN + MOVE WS-TEMP-DUR TO WS-GROUP-MIN + END-IF + IF WS-TEMP-DUR > WS-GROUP-MAX + MOVE WS-TEMP-DUR TO WS-GROUP-MAX + END-IF + IF WS-TEMP-DUR < WS-SUBGROUP-MIN + MOVE WS-TEMP-DUR TO WS-SUBGROUP-MIN + END-IF + IF WS-TEMP-DUR > WS-SUBGROUP-MAX + MOVE WS-TEMP-DUR TO WS-SUBGROUP-MAX + END-IF + + *> Hash total + overflow checks + COMPUTE WS-HASH-IN = WS-HASH-IN + WS-TEMP-DUR + IF WS-HASH-IN > WS-MAX-TOTAL + COMPUTE WS-HASH-IN = WS-HASH-IN - WS-MAX-TOTAL + SET WS-OVERFLOW TO TRUE + MOVE 'WARNING' TO WS-SEVERITY + MOVE 'Hash total overflow - wrapped' TO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + IF WS-GROUP-DUR > WS-OVERFLOW-THRESH + SET WS-OVERFLOW TO TRUE + MOVE 'WARNING' TO WS-SEVERITY + STRING 'Group duration overflow KEY=' + WS-PREV-KEY INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + + *> Page break control + ADD 1 TO WS-LINE-COUNT + IF WS-LINE-COUNT >= WS-PAGE-LENGTH + ADD 1 TO WS-PAGE-NUM + MOVE 0 TO WS-LINE-COUNT + PERFORM WRITE-PAGE-HEADER + END-IF + . + + *> 3400-WRITE-OUTPUT-SECTION: data record + audit trail + 3400-WRITE-OUTPUT-SECTION SECTION. + 3400-WRITE-OUTPUT-PROC. + *> ORIGINAL: write key + data record + MOVE IN-KEY TO OUT-KEY + MOVE IN-DATA TO OUT-DATA + MOVE WS-CALL-STATE TO OUT-STATE + WRITE FILE-OUT-REC FROM WS-DATA-OUT + IF FS-OUT NOT = '00' + MOVE 'FATAL' TO WS-SEVERITY + STRING 'FILE-OUT write FS=' FS-OUT INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + END-IF + ADD 1 TO WS-RECORDS-WRITTEN + ADD 1 TO WS-HASH-OUT + MOVE WS-TIMESTAMP TO AU-TIMESTAMP + MOVE 'RECORD' TO AU-TYPE + MOVE IN-KEY TO AU-KEY + MOVE WS-RECORDS-READ TO AU-VALUE + MOVE 'OK' TO AU-STATUS + IF FS-AUDIT = '00' + WRITE FILE-AUDIT-REC FROM WS-AUDIT-LINE + END-IF + . + + *> 4000-REPORT-SECTION: summary display and grand totals + 4000-REPORT-SECTION SECTION. + 4000-REPORT-PROC. + DISPLAY ' ' + DISPLAY '=== SUMMARY ===' + DISPLAY ' Records read: ' WS-RECORDS-READ + DISPLAY ' Records written: ' WS-RECORDS-WRITTEN + DISPLAY ' Key changes: ' WS-KEY-CHANGES + DISPLAY ' Sub-key changes: ' WS-SUB-CHANGES + DISPLAY ' Groups total: ' WS-GROUPS-TOTAL + DISPLAY ' Sub-groups total:' WS-SUBGROUPS-TOTAL + DISPLAY ' Grand duration: ' WS-GRAND-DUR + DISPLAY ' Overflows: ' WS-OVERFLOW-FLAG + DISPLAY ' Page count: ' WS-PAGE-NUM + DISPLAY ' Hash input: ' WS-HASH-IN + DISPLAY ' Hash output: ' WS-HASH-OUT + IF WS-HASH-IN = WS-HASH-OUT + MOVE 'YES' TO WS-HASH-VERIFIED + DISPLAY ' HASH: VERIFICATION PASSED' + ELSE + DISPLAY ' HASH: VERIFICATION FAILED' + END-IF + IF WS-GRAND-COUNT NOT = WS-RECORDS-READ + MOVE 'ERROR' TO WS-SEVERITY + STRING 'GRAND TOTAL MISMATCH read=' + WS-RECORDS-READ ' count=' WS-GRAND-COUNT + INTO WS-ERROR-MSG + PERFORM 6000-ERROR-HANDLE-SECTION + DISPLAY ' ** GRAND TOTAL VERIFY FAILED **' + ELSE + DISPLAY ' ** Grand total verified OK **' + END-IF + DISPLAY ' Output: FILE-OUT.DAT Audit: FILE-AUDIT.DAT' + . + + *> 5000-AUDIT-SECTION: audit log finish + 5000-AUDIT-SECTION SECTION. + 5000-AUDIT-PROC. + MOVE WS-TIMESTAMP TO AU-TIMESTAMP + MOVE 'END' TO AU-TYPE + MOVE 'BATCH' TO AU-KEY + MOVE WS-BATCH-ID TO AU-VALUE + STRING 'REC=' WS-RECORDS-READ ' CHG=' WS-KEY-CHANGES + ' SUB=' WS-SUB-CHANGES INTO AU-STATUS + IF FS-AUDIT = '00' + WRITE FILE-AUDIT-REC FROM WS-AUDIT-LINE + END-IF + DISPLAY ' ' + DISPLAY '[AUDIT ] Batch=' WS-BATCH-ID + DISPLAY ' Recs=' WS-RECORDS-READ + DISPLAY ' Chgs=' WS-KEY-CHANGES + DISPLAY ' Sub =' WS-SUB-CHANGES + DISPLAY ' Err =' WS-ERROR-COUNT + DISPLAY ' Warn=' WS-WARN-COUNT + . + + *> 6000-ERROR-HANDLE-SECTION: handle errors by severity + 6000-ERROR-HANDLE-SECTION SECTION. + 6000-ERROR-HANDLE-PROC. + DISPLAY '[TIMESTAMP] ' WS-TIMESTAMP + DISPLAY '[' WS-SEVERITY '] ' WS-ERROR-MSG + IF WS-SEVERITY = 'FATAL' + PERFORM 9000-EXIT-SECTION + STOP RUN + ELSE + IF WS-SEVERITY = 'ERROR' + ADD 1 TO WS-ERROR-COUNT + ELSE + IF WS-SEVERITY = 'WARNING' + ADD 1 TO WS-WARN-COUNT + END-IF + END-IF + END-IF + . + + *> 9000-EXIT-SECTION: clean up and exit + 9000-EXIT-SECTION SECTION. + 9000-EXIT-PROC. + MOVE FUNCTION CURRENT-DATE (1:10) TO WS-DATE + MOVE FUNCTION CURRENT-DATE (12:8) TO WS-TIME + STRING WS-DATE ' ' WS-TIME INTO WS-TIMESTAMP + IF WS-RECORDS-READ > 0 + PERFORM WRITE-GROUP-FOOTER + PERFORM WRITE-SUBGROUP-FOOTER + PERFORM WRITE-GRAND-TOTAL + END-IF + PERFORM 4000-REPORT-SECTION + PERFORM 5000-AUDIT-SECTION + CLOSE FILE-IN FILE-OUT + IF FS-AUDIT = '00' + CLOSE FILE-AUDIT + END-IF + DISPLAY ' ' + DISPLAY '[TIMESTAMP] ' WS-TIMESTAMP + DISPLAY '[STATUS ] KeyBreakOther COMPLETED' + STOP RUN + . + + *> WRITE-CHANGE-MARKER — ORIGINAL enhanced with timestamp+seq + WRITE-CHANGE-MARKER SECTION. + WRITE-CHANGE-MARKER-PROC. + ADD 1 TO WS-GROUPS-TOTAL + MOVE WS-PREV-KEY TO WS-MARKER-KEY + MOVE WS-TIMESTAMP TO WS-MARKER-TS + MOVE WS-MARKER-SEQ-NUM TO WS-MARKER-SEQ + WRITE FILE-OUT-REC FROM WS-MARKER-LINE + IF FS-OUT NOT = '00' + DISPLAY '[WARNING ] Marker write FS=' FS-OUT + END-IF + DISPLAY '[CHANGE ] Key -> ''' WS-PREV-KEY + ''' SEQ=' WS-MARKER-SEQ-NUM + . + + *> WRITE-SUB-MARKER — sub-key change marker + WRITE-SUB-MARKER SECTION. + WRITE-SUB-MARKER-PROC. + ADD 1 TO WS-SUBGROUPS-TOTAL + MOVE WS-PREV-SUBKEY TO WS-SUB-MARK-KEY + MOVE WS-TIMESTAMP TO WS-SUB-MARK-TS + MOVE WS-MARKER-SEQ-NUM TO WS-SUB-MARK-SEQ + WRITE FILE-OUT-REC FROM WS-SUB-MARKER + IF FS-OUT NOT = '00' + DISPLAY '[WARNING ] Sub-marker write FS=' FS-OUT + END-IF + DISPLAY '[SUBCHANGE] Sub-key -> ''' WS-PREV-SUBKEY + ''' SEQ=' WS-MARKER-SEQ-NUM + . + + *> WRITE-GROUP-HEADER + WRITE-GROUP-HEADER SECTION. + WRITE-GROUP-HEADER-PROC. + MOVE WS-PREV-KEY TO WS-GH-KEY + MOVE WS-TIMESTAMP TO WS-GH-TS + WRITE FILE-OUT-REC FROM WS-GROUP-HEADER + IF FS-OUT NOT = '00' + DISPLAY '[WARNING ] Group-header write FS=' FS-OUT + END-IF + ADD 1 TO WS-LINE-COUNT + DISPLAY '[GROUP ] Start ''' WS-PREV-KEY '''' + . + + *> WRITE-GROUP-FOOTER — end-of-group statistics + WRITE-GROUP-FOOTER SECTION. + WRITE-GROUP-FOOTER-PROC. + IF WS-GROUP-COUNT > 0 + COMPUTE WS-GROUP-AVG = + WS-GROUP-DUR / WS-GROUP-COUNT + ELSE + MOVE 0 TO WS-GROUP-AVG + END-IF + MOVE WS-PREV-KEY TO WS-GF-KEY + MOVE WS-GROUP-COUNT TO WS-GF-COUNT + MOVE WS-GROUP-DUR TO WS-GF-DUR + MOVE WS-GROUP-MIN TO WS-GF-MIN + MOVE WS-GROUP-MAX TO WS-GF-MAX + MOVE WS-GROUP-AVG TO WS-GF-AVG + WRITE FILE-OUT-REC FROM WS-GROUP-FOOTER + IF FS-OUT NOT = '00' + DISPLAY '[WARNING ] Group-footer write FS=' FS-OUT + END-IF + ADD 1 TO WS-LINE-COUNT + DISPLAY '[GROUP END] ''' WS-PREV-KEY '''' + ' cnt=' WS-GROUP-COUNT ' dur=' WS-GROUP-DUR + IF FS-AUDIT = '00' + MOVE WS-TIMESTAMP TO AU-TIMESTAMP + MOVE 'GROUP ' TO AU-TYPE + MOVE WS-PREV-KEY TO AU-KEY + MOVE WS-GROUP-COUNT TO AU-VALUE + STRING 'DUR=' WS-GROUP-DUR INTO AU-STATUS + WRITE FILE-AUDIT-REC FROM WS-AUDIT-LINE + END-IF + . + + *> WRITE-SUBGROUP-FOOTER — end-of-subgroup statistics + WRITE-SUBGROUP-FOOTER SECTION. + WRITE-SUBGROUP-FOOTER-PROC. + IF WS-SUBGROUP-COUNT > 0 + COMPUTE WS-SUBGROUP-AVG = + WS-SUBGROUP-DUR / WS-SUBGROUP-COUNT + ELSE + MOVE 0 TO WS-SUBGROUP-AVG + END-IF + MOVE WS-PREV-SUBKEY TO WS-SGF-SUBKEY + MOVE WS-SUBGROUP-COUNT TO WS-SGF-COUNT + MOVE WS-SUBGROUP-DUR TO WS-SGF-DUR + MOVE WS-SUBGROUP-MIN TO WS-SGF-MIN + MOVE WS-SUBGROUP-MAX TO WS-SGF-MAX + MOVE WS-SUBGROUP-AVG TO WS-SGF-AVG + WRITE FILE-OUT-REC FROM WS-SUBGROUP-FOOTER + IF FS-OUT NOT = '00' + DISPLAY '[WARNING ] Subgroup-footer write FS=' FS-OUT + END-IF + ADD 1 TO WS-LINE-COUNT + DISPLAY '[SUB END ] ''' WS-PREV-SUBKEY '''' + ' cnt=' WS-SUBGROUP-COUNT ' dur=' WS-SUBGROUP-DUR + IF FS-AUDIT = '00' + MOVE WS-TIMESTAMP TO AU-TIMESTAMP + MOVE 'SUBGRP' TO AU-TYPE + MOVE WS-PREV-SUBKEY TO AU-KEY + MOVE WS-SUBGROUP-COUNT TO AU-VALUE + STRING 'DUR=' WS-SUBGROUP-DUR INTO AU-STATUS + WRITE FILE-AUDIT-REC FROM WS-AUDIT-LINE + END-IF + . + + *> WRITE-PAGE-HEADER — page break marker + WRITE-PAGE-HEADER SECTION. + WRITE-PAGE-HEADER-PROC. + MOVE WS-PAGE-NUM TO WS-PH-PAGE + WRITE FILE-OUT-REC FROM WS-PAGE-HEADER + IF FS-OUT NOT = '00' + DISPLAY '[WARNING ] Page-header write FS=' FS-OUT + END-IF + ADD 1 TO WS-LINE-COUNT + DISPLAY '[PAGE ] Page ' WS-PAGE-NUM + . + + *> WRITE-GRAND-TOTAL + WRITE-GRAND-TOTAL SECTION. + WRITE-GRAND-TOTAL-PROC. + MOVE WS-GROUPS-TOTAL TO WS-GT-GROUPS + MOVE WS-RECORDS-READ TO WS-GT-RECS + MOVE WS-KEY-CHANGES TO WS-GT-CHGS + MOVE WS-SUB-CHANGES TO WS-GT-SUB + MOVE WS-GRAND-DUR TO WS-GT-DUR + WRITE FILE-OUT-REC FROM WS-GRAND-TOTAL-LINE + IF FS-OUT NOT = '00' + DISPLAY '[WARNING ] Grand-total write FS=' FS-OUT + END-IF + ADD 1 TO WS-LINE-COUNT + DISPLAY '[GRAND ] groups=' WS-GROUPS-TOTAL + ' recs=' WS-RECORDS-READ + ' chgs=' WS-KEY-CHANGES + ' sub=' WS-SUB-CHANGES + ' dur=' WS-GRAND-DUR + IF FS-AUDIT = '00' + MOVE WS-TIMESTAMP TO AU-TIMESTAMP + MOVE 'GRAND ' TO AU-TYPE + MOVE 'TOTAL' TO AU-KEY + MOVE WS-RECORDS-READ TO AU-VALUE + STRING 'DUR=' WS-GRAND-DUR INTO AU-STATUS + WRITE FILE-AUDIT-REC FROM WS-AUDIT-LINE + END-IF + . + + *> INIT-GROUP-ACCUM + INIT-GROUP-ACCUM SECTION. + INIT-GROUP-ACCUM-PROC. + MOVE 0 TO WS-GROUP-COUNT + MOVE 0 TO WS-GROUP-DUR + MOVE 9999999999 TO WS-GROUP-MIN + MOVE 0 TO WS-GROUP-MAX + MOVE 0 TO WS-GROUP-AVG + MOVE 'N' TO WS-OVERFLOW-FLAG + . + + *> INIT-SUBGROUP-ACCUM + INIT-SUBGROUP-ACCUM SECTION. + INIT-SUBGROUP-ACCUM-PROC. + MOVE 0 TO WS-SUBGROUP-COUNT + MOVE 0 TO WS-SUBGROUP-DUR + MOVE 9999999999 TO WS-SUBGROUP-MIN + MOVE 0 TO WS-SUBGROUP-MAX + MOVE 0 TO WS-SUBGROUP-AVG + . diff --git a/benchmark-programs/31-validation-withdup/FILE-IN.DAT b/benchmark-programs/31-validation-withdup/FILE-IN.DAT new file mode 100644 index 0000000..de60c50 --- /dev/null +++ b/benchmark-programs/31-validation-withdup/FILE-IN.DAT @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/benchmark-programs/31-validation-withdup/README.md b/benchmark-programs/31-validation-withdup/README.md new file mode 100644 index 0000000..d0b6d57 --- /dev/null +++ b/benchmark-programs/31-validation-withdup/README.md @@ -0,0 +1,73 @@ +# 31-validation-withdup: Field Validation with Duplicate Check + +## 电信业务场景 + +重复CDR检测。对已按CDR-ID排序的明细文件进行WS-PREV-KEY重复检测，首次出现通过，同一ID再次出现判定为重复并拒否。 + +## Description + +Reads a sorted input file and checks for duplicate KEY values using +the WS-PREV-KEY pattern. The first occurrence of a key is written +to FILE-OUT-GOOD. Any subsequent occurrence of the same key is +written to FILE-OUT-BAD with an error code (duplicate detection). + +## Record Layout + +### Input / Good Output (35 bytes) + +| Field | Type | Length | Description | +|--------|----------|--------|------------------| +| KEY | PIC X | 5 | Sort key | +| DATA | PIC X | 30 | Payload data | + +### Bad Output (37 bytes) + +| Field | Type | Length | Description | +|--------|----------|--------|---------------------| +| KEY | PIC X | 5 | Duplicated key | +| DATA | PIC X | 30 | Original data | +| ERR | PIC X | 2 | Error code ('01') | + +## Files + +| File | Purpose | +|-----------------------------|----------------------------------| +| main-31-validation-withdup.cbl | Main COBOL program | +| data-gen.sh | Generate sorted test data | +| run.sh | Compile, run, verify | +| README.md | This file | + +## Test Data + +``` +KEY01 FIRST-RECORD -> PASS (1st unique) +KEY02 SECOND-RECORD -> PASS (2nd unique) +KEY03 FIRST-DUP-A -> PASS (1st) +KEY03 SECOND-DUP-A -> FAIL (dup) +KEY03 THIRD-DUP-A -> FAIL (dup) +KEY04 UNIQUE-AFTER-DUP -> PASS (unique after dups) +KEY05 DUP-GROUP-B-1ST -> PASS (1st) +KEY05 DUP-GROUP-B-2ND -> FAIL (dup) +KEY06 TRIPLE-GROUP-1ST -> PASS (1st) +KEY06 TRIPLE-GROUP-2ND -> FAIL (dup) +KEY06 TRIPLE-GROUP-3RD -> FAIL (dup) +KEY99 LAST-UNIQUE -> PASS (final unique) +``` + +Expected: 7 good records, 5 bad records. + +## Usage + +```bash +cd 31-validation-withdup +bash data-gen.sh +bash run.sh +``` + +## Expected Behavior + +- The first occurrence of each KEY is always accepted. +- Subsequent occurrences of the same KEY are rejected as duplicates. +- The WS-PREV-KEY is updated only when a record passes validation. +- Duplicate records contain error code '01' in the BAD output. +- Input must be sorted by KEY for correct sequential detection. diff --git a/benchmark-programs/31-validation-withdup/main-31-validation-withdup.cbl b/benchmark-programs/31-validation-withdup/main-31-validation-withdup.cbl new file mode 100644 index 0000000..3e050d0 --- /dev/null +++ b/benchmark-programs/31-validation-withdup/main-31-validation-withdup.cbl @@ -0,0 +1,683 @@ + *> ============================================================ + *> 31-validation-withdup : Duplicate CDR Detection + *> Input : FILE-IN (file-in.dat: sorted CDR records) + *> Output : FILE-OUT-GOOD (file-out-good.dat: non-duplicate) + *> FILE-OUT-BAD (file-out-bad.dat: duplicate) + *> FILE-OUT-AUDIT (audit-file.dat: statistics) + *> Coverage: VF-N003, VF-N004, VF-R001 + *> Features: + *> - SECTION structure (10 sections) + *> - Multi-key duplicate detection (primary + secondary key) + *> - Duplicate frequency tracking per key pair + *> - Duplicate rate reporting as percentage + *> - Batch-level duplicate statistics + *> - Error detail report with dup frequency per key + *> - FILE STATUS checks after every I/O + *> - Audit file with statistics and timestamps + *> - DISPLAY tracing with timestamp + *> - Hash totals for data integrity + *> - Batch control totals + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. ValidationWithdup. + *> + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN ASSIGN TO 'file-in.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-FILE-IN-STATUS. + SELECT FILE-OUT-GOOD ASSIGN TO 'file-out-good.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-FILE-GOOD-STATUS. + SELECT FILE-OUT-BAD ASSIGN TO 'file-out-bad.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-FILE-BAD-STATUS. + SELECT FILE-OUT-AUDIT ASSIGN TO 'audit-file.dat' + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-FILE-AUDIT-STATUS. + *> + DATA DIVISION. + FILE SECTION. + FD FILE-IN. + 01 IN-REC. + 05 IN-KEY PIC X(05). + 05 IN-DATA PIC X(30). + *> + FD FILE-OUT-GOOD. + 01 GOOD-REC. + 05 GOOD-KEY PIC X(05). + 05 GOOD-DATA PIC X(30). + *> + FD FILE-OUT-BAD. + 01 BAD-REC. + 05 BAD-KEY PIC X(05). + 05 BAD-DATA PIC X(30). + 05 BAD-ERR PIC X(02). + *> + FD FILE-OUT-AUDIT. + 01 AUDIT-OUT-REC PIC X(80). + *> + WORKING-STORAGE SECTION. + 01 WS-TELECOM-REC. + COPY "telecom/TEL-BILLING.cpy". + *> + *> File status fields + 01 WS-FILE-IN-STATUS PIC X(02). + 01 WS-FILE-GOOD-STATUS PIC X(02). + 01 WS-FILE-BAD-STATUS PIC X(02). + 01 WS-FILE-AUDIT-STATUS PIC X(02). + *> + *> File open flags + 01 WS-FILE-OPEN-FLAGS. + 05 WS-FILE-IN-OPEN PIC X(01) VALUE 'N'. + 88 WS-FILE-IN-OPEN-YES VALUE 'Y' FALSE 'N'. + 05 WS-FILE-GOOD-OPEN PIC X(01) VALUE 'N'. + 88 WS-FILE-GOOD-OPEN-YES VALUE 'Y' FALSE 'N'. + 05 WS-FILE-BAD-OPEN PIC X(01) VALUE 'N'. + 88 WS-FILE-BAD-OPEN-YES VALUE 'Y' FALSE 'N'. + 05 WS-FILE-AUDIT-OPEN PIC X(01) VALUE 'N'. + 88 WS-FILE-AUDIT-OPEN-YES VALUE 'Y' FALSE 'N'. + *> + *> Control flags + 01 WS-CONTROL-FLAGS. + 05 WS-EOF PIC X(01) VALUE 'N'. + 88 WS-EOF-YES VALUE 'Y' FALSE 'N'. + 05 WS-DUP-FLAG PIC X(01) VALUE 'N'. + 88 WS-IS-DUPLICATE VALUE 'Y' FALSE 'N'. + 05 WS-KEY-FOUND PIC X(01) VALUE 'N'. + 88 WS-KEY-FOUND-YES VALUE 'Y' FALSE 'N'. + *> + *> Batch control counters + 01 WS-COUNTERS. + 05 WS-GOOD-COUNT PIC 9(05) VALUE ZERO. + 05 WS-BAD-COUNT PIC 9(05) VALUE ZERO. + 05 WS-TOTAL-READ PIC 9(05) VALUE ZERO. + 05 WS-TOTAL-UNIQUE PIC 9(05) VALUE ZERO. + 05 WS-TOTAL-DUPS PIC 9(05) VALUE ZERO. + 05 WS-MAX-DUP-FREQ PIC 9(05) VALUE ZERO. + 05 WS-DUP-FREQ-SUM PIC 9(07) VALUE ZERO. + *> + *> Timestamp buffer + 01 WS-CURRENT-DATE PIC X(21). + 01 WS-TRACE-MSG PIC X(60). + *> + *> Hash totals for data integrity + 01 WS-HASH-TOTALS. + 05 WS-HASH-GOOD PIC 9(09) VALUE ZERO. + 05 WS-HASH-BAD PIC 9(09) VALUE ZERO. + 05 WS-HASH-ALL PIC 9(09) VALUE ZERO. + 05 WS-HASH-CHAR PIC 9(03) VALUE ZERO. + *> + *> Computation fields + 01 WS-COMP-FIELDS. + 05 WS-DUP-RATE PIC 9(03)V99. + 05 WS-DUP-RATE-DISP PIC ZZ9.99. + 05 WS-AVG-DUP-FREQ PIC 9(05)V99. + 05 WS-AVG-DISP PIC ZZZ9.99. + *> + *> Key table indexes + 01 WS-IDX PIC 9(03). + 01 WS-ENTRY-COUNT PIC 9(03) VALUE ZERO. + 01 WS-MAX-ENTRIES PIC 9(03) VALUE 100. + 01 WS-J PIC 9(03). + *> + *> Key lookup table - stores unique primary+secondary key pairs + *> with occurrence and duplicate counts + 01 WS-KEY-TABLE. + 05 WS-KEY-ENTRY OCCURS 100 TIMES. + 10 WS-KEY-PRIMARY PIC X(05). + 10 WS-KEY-SECONDARY PIC X(10). + 10 WS-KEY-TOTAL-CNT PIC 9(05). + 10 WS-KEY-DUP-CNT PIC 9(05). + *> + *> Secondary key (first 10 characters of IN-DATA) + 01 WS-SECONDARY-KEY PIC X(10). + *> + *> Audit record buffer + 01 WS-AUDIT-BUFFER. + 05 WS-AUDIT-TYPE PIC X(10). + 05 WS-AUDIT-SEP1 PIC X(02) VALUE ' | '. + 05 WS-AUDIT-DATE PIC X(08). + 05 WS-AUDIT-SEP2 PIC X(02) VALUE ' | '. + 05 WS-AUDIT-TIME PIC X(08). + 05 WS-AUDIT-SEP3 PIC X(02) VALUE ' | '. + 05 WS-AUDIT-STATS PIC X(48). + *> + *> Error message buffer + 01 WS-ERROR-MSG PIC X(80). + *> + *> Temporary working fields + 01 WS-TEMP-COUNT PIC 9(05). + 01 WS-WARN-TABLE-FULL PIC X(01) VALUE 'N'. + 88 WS-WARN-TABLE-FULL-YES VALUE 'Y' FALSE 'N'. + *> + PROCEDURE DIVISION. + *> + MAIN SECTION. + MB-PROCESS. + PERFORM 1000-INIT. + PERFORM 2000-OPEN-FILES. + PERFORM 3000-READ-INPUT UNTIL WS-EOF-YES. + PERFORM 4000-REPORT. + PERFORM 5000-AUDIT. + PERFORM 9000-EXIT. + STOP RUN. + *> + *> ============================================================ + *> 1000-INIT : Initialize program state, clear counters, + *> display startup trace. + *> ============================================================ + 1000-INIT SECTION. + MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE. + MOVE '1000-INIT: Program starting' TO WS-TRACE-MSG. + PERFORM DISPLAY-TRACE. + INITIALIZE WS-COUNTERS. + INITIALIZE WS-HASH-TOTALS. + INITIALIZE WS-COMP-FIELDS. + MOVE ZERO TO WS-ENTRY-COUNT. + MOVE 'N' TO WS-EOF. + MOVE 'N' TO WS-DUP-FLAG. + MOVE 'N' TO WS-KEY-FOUND. + MOVE 'N' TO WS-WARN-TABLE-FULL. + MOVE '1000-INIT: Initialization complete' TO WS-TRACE-MSG. + PERFORM DISPLAY-TRACE. + EXIT. + *> + *> ============================================================ + *> 2000-OPEN-FILES : Open all four files and verify + *> each FILE STATUS after OPEN. Abort on error. + *> ============================================================ + 2000-OPEN-FILES SECTION. + MOVE '2000-OPEN-FILES: Opening FILE-IN' + TO WS-TRACE-MSG. + PERFORM DISPLAY-TRACE. + OPEN INPUT FILE-IN. + IF WS-FILE-IN-STATUS NOT = '00' + AND WS-FILE-IN-STATUS NOT = '0' + STRING '2000-OPEN-FILES: ERROR FILE-IN status ' + WS-FILE-IN-STATUS DELIMITED BY SIZE + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + SET WS-FILE-IN-OPEN-YES TO TRUE. + MOVE '2000-OPEN-FILES: FILE-IN opened OK' TO WS-TRACE-MSG. + PERFORM DISPLAY-TRACE. + OPEN OUTPUT FILE-OUT-GOOD. + IF WS-FILE-GOOD-STATUS NOT = '00' + AND WS-FILE-GOOD-STATUS NOT = '0' + STRING '2000-OPEN-FILES: ERROR FILE-OUT-GOOD status ' + WS-FILE-GOOD-STATUS DELIMITED BY SIZE + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + SET WS-FILE-GOOD-OPEN-YES TO TRUE. + MOVE '2000-OPEN-FILES: FILE-OUT-GOOD opened OK' + TO WS-TRACE-MSG. + PERFORM DISPLAY-TRACE. + OPEN OUTPUT FILE-OUT-BAD. + IF WS-FILE-BAD-STATUS NOT = '00' + AND WS-FILE-BAD-STATUS NOT = '0' + STRING '2000-OPEN-FILES: ERROR FILE-OUT-BAD status ' + WS-FILE-BAD-STATUS DELIMITED BY SIZE + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + SET WS-FILE-BAD-OPEN-YES TO TRUE. + MOVE '2000-OPEN-FILES: FILE-OUT-BAD opened OK' + TO WS-TRACE-MSG. + PERFORM DISPLAY-TRACE. + OPEN OUTPUT FILE-OUT-AUDIT. + IF WS-FILE-AUDIT-STATUS NOT = '00' + AND WS-FILE-AUDIT-STATUS NOT = '0' + STRING '2000-OPEN-FILES: ERROR FILE-OUT-AUDIT status ' + WS-FILE-AUDIT-STATUS DELIMITED BY SIZE + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE + MOVE 1 TO RETURN-CODE + STOP RUN + END-IF. + SET WS-FILE-AUDIT-OPEN-YES TO TRUE. + MOVE '2000-OPEN-FILES: FILE-OUT-AUDIT opened OK' + TO WS-TRACE-MSG. + PERFORM DISPLAY-TRACE. + EXIT. + *> + *> ============================================================ + *> 3000-READ-INPUT : Read next input record. At EOF set + *> WS-EOF-YES. On non-EOF increment total-read counter + *> and dispatch to validate. FILE STATUS checked. + *> ============================================================ + 3000-READ-INPUT SECTION. + READ FILE-IN + AT END + SET WS-EOF-YES TO TRUE + MOVE '3000-READ-INPUT: EOF reached' + TO WS-TRACE-MSG + PERFORM DISPLAY-TRACE + NOT AT END + ADD 1 TO WS-TOTAL-READ + PERFORM 3100-VALIDATE-RECORD + END-READ. + IF WS-FILE-IN-STATUS NOT = '00' + AND WS-FILE-IN-STATUS NOT = '10' + STRING '3000-READ-INPUT: READ error status ' + WS-FILE-IN-STATUS DELIMITED BY SIZE + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE + END-IF. + EXIT. + *> + *> ============================================================ + *> 3100-VALIDATE-RECORD : Check current record against the + *> key table. A duplicate match requires BOTH primary key + *> (IN-KEY) AND secondary key (first 10 chars of IN-DATA) + *> to match a previously seen entry. + *> - Duplicate found : increment dup counters, compute + *> bad hash, write to bad output. + *> - New unique key : add to key table, compute good hash, + *> process record, write to good output. + *> ============================================================ + 3100-VALIDATE-RECORD SECTION. + MOVE IN-DATA(1:10) TO WS-SECONDARY-KEY. + MOVE 'N' TO WS-DUP-FLAG. + MOVE 'N' TO WS-KEY-FOUND. + IF WS-ENTRY-COUNT > 0 + PERFORM VARYING WS-IDX FROM 1 BY 1 + UNTIL WS-IDX > WS-ENTRY-COUNT + OR WS-KEY-FOUND-YES + IF IN-KEY = WS-KEY-PRIMARY(WS-IDX) + AND WS-SECONDARY-KEY + = WS-KEY-SECONDARY(WS-IDX) + SET WS-KEY-FOUND-YES TO TRUE + END-IF + END-PERFORM + END-IF. + IF WS-KEY-FOUND-YES + ADD 1 TO WS-KEY-TOTAL-CNT(WS-IDX) + ADD 1 TO WS-KEY-DUP-CNT(WS-IDX) + ADD 1 TO WS-TOTAL-DUPS + SET WS-IS-DUPLICATE TO TRUE + STRING '3100-VALIDATE-RECORD: Duplicate key=' + IN-KEY DELIMITED BY SIZE + ' dup#' WS-KEY-DUP-CNT(WS-IDX) + INTO WS-TRACE-MSG + END-STRING + PERFORM DISPLAY-TRACE + PERFORM COMPUTE-HASH-BAD + PERFORM 3300-WRITE-OUTPUT + ELSE + ADD 1 TO WS-ENTRY-COUNT + IF WS-ENTRY-COUNT <= WS-MAX-ENTRIES + MOVE IN-KEY TO WS-KEY-PRIMARY(WS-ENTRY-COUNT) + MOVE WS-SECONDARY-KEY + TO WS-KEY-SECONDARY(WS-ENTRY-COUNT) + MOVE 1 TO WS-KEY-TOTAL-CNT(WS-ENTRY-COUNT) + MOVE 0 TO WS-KEY-DUP-CNT(WS-ENTRY-COUNT) + ADD 1 TO WS-TOTAL-UNIQUE + ELSE + IF NOT WS-WARN-TABLE-FULL-YES + SET WS-WARN-TABLE-FULL-YES TO TRUE + MOVE '3100: Key table full, some keys ' + & 'not tracked' TO WS-TRACE-MSG + PERFORM DISPLAY-TRACE + END-IF + END-IF + MOVE 'N' TO WS-DUP-FLAG + PERFORM 3200-PROCESS-RECORD + PERFORM 3300-WRITE-OUTPUT + END-IF. + EXIT. + *> + *> ============================================================ + *> 3200-PROCESS-RECORD : Prepare a good (non-duplicate) + *> record for output. Copy fields, compute good hash, + *> update hash totals. + *> ============================================================ + 3200-PROCESS-RECORD SECTION. + MOVE IN-KEY TO GOOD-KEY. + MOVE IN-DATA TO GOOD-DATA. + PERFORM COMPUTE-HASH-GOOD. + MOVE '3200-PROCESS-RECORD: Good record prepared' + TO WS-TRACE-MSG. + PERFORM DISPLAY-TRACE. + EXIT. + *> + *> ============================================================ + *> 3300-WRITE-OUTPUT : Write record to the appropriate + *> output file (GOOD or BAD) based on WS-DUP-FLAG. + *> FILE STATUS is verified after each WRITE. + *> ============================================================ + 3300-WRITE-OUTPUT SECTION. + IF WS-IS-DUPLICATE + MOVE IN-KEY TO BAD-KEY + MOVE IN-DATA TO BAD-DATA + MOVE '01' TO BAD-ERR + WRITE BAD-REC + IF WS-FILE-BAD-STATUS NOT = '00' + STRING '3300-WRITE-OUTPUT: BAD WRITE status ' + WS-FILE-BAD-STATUS DELIMITED BY SIZE + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE + ELSE + ADD 1 TO WS-BAD-COUNT + MOVE '3300-WRITE-OUTPUT: Written to BAD output' + TO WS-TRACE-MSG + PERFORM DISPLAY-TRACE + END-IF + ELSE + WRITE GOOD-REC + IF WS-FILE-GOOD-STATUS NOT = '00' + STRING '3300-WRITE-OUTPUT: GOOD WRITE status ' + WS-FILE-GOOD-STATUS DELIMITED BY SIZE + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE + ELSE + ADD 1 TO WS-GOOD-COUNT + END-IF + END-IF. + EXIT. + *> + *> ============================================================ + *> 4000-REPORT : Calculate and display batch-level + *> duplicate statistics: + *> - Total records read, unique keys, duplicates + *> - Duplicate rate as percentage + *> - Max dup frequency, average dup frequency + *> - Hash totals for integrity verification + *> - Error detail report listing each key pair that + *> had duplicates along with its dup frequency count + *> ============================================================ + 4000-REPORT SECTION. + MOVE '4000-REPORT: Generating batch statistics' + TO WS-TRACE-MSG. + PERFORM DISPLAY-TRACE. + *> + *> Calculate duplicate rate as percentage + IF WS-TOTAL-READ > 0 + COMPUTE WS-DUP-RATE ROUNDED = + (WS-BAD-COUNT / WS-TOTAL-READ) * 100 + MOVE WS-DUP-RATE TO WS-DUP-RATE-DISP + ELSE + MOVE ZERO TO WS-DUP-RATE + MOVE '0.00' TO WS-DUP-RATE-DISP + END-IF. + *> + *> Calculate max dup frequency and total dup sum + MOVE ZERO TO WS-MAX-DUP-FREQ. + MOVE ZERO TO WS-DUP-FREQ-SUM. + IF WS-ENTRY-COUNT > 0 + PERFORM VARYING WS-J FROM 1 BY 1 + UNTIL WS-J > WS-ENTRY-COUNT + IF WS-KEY-DUP-CNT(WS-J) > WS-MAX-DUP-FREQ + MOVE WS-KEY-DUP-CNT(WS-J) + TO WS-MAX-DUP-FREQ + END-IF + ADD WS-KEY-DUP-CNT(WS-J) TO WS-DUP-FREQ-SUM + END-PERFORM + END-IF. + *> + *> Calculate average dup frequency + IF WS-TOTAL-UNIQUE > 0 + COMPUTE WS-AVG-DUP-FREQ ROUNDED = + WS-DUP-FREQ-SUM / WS-TOTAL-UNIQUE + MOVE WS-AVG-DUP-FREQ TO WS-AVG-DISP + ELSE + MOVE ZERO TO WS-AVG-DUP-FREQ + MOVE '0.00' TO WS-AVG-DISP + END-IF. + *> + *> Display batch summary report + DISPLAY ' '. + DISPLAY '============================================'. + DISPLAY '============================================'. + DISPLAY ' Program : ValidationWithdup'. + DISPLAY ' Total records : ' WS-TOTAL-READ. + DISPLAY ' Good output : ' WS-GOOD-COUNT. + DISPLAY ' Bad (duplicate): ' WS-BAD-COUNT. + DISPLAY ' Unique keys : ' WS-TOTAL-UNIQUE. + DISPLAY ' Total dups : ' WS-TOTAL-DUPS. + DISPLAY ' Duplicate rate : ' WS-DUP-RATE-DISP '%'. + DISPLAY ' Max dup freq : ' WS-MAX-DUP-FREQ. + DISPLAY ' Avg dup freq : ' WS-AVG-DISP. + DISPLAY ' Hash good : ' WS-HASH-GOOD. + DISPLAY ' Hash bad : ' WS-HASH-BAD. + DISPLAY ' Hash all : ' WS-HASH-ALL. + DISPLAY '============================================'. + DISPLAY ' '. + *> + *> Error detail report showing dup frequency per key + DISPLAY 'ERROR DETAIL REPORT - Dup Frequency per Key'. + DISPLAY '-------------------------------------------'. + DISPLAY ' Primary Secondary Total DupCount'. + DISPLAY '-------------------------------------------'. + IF WS-ENTRY-COUNT > 0 + PERFORM VARYING WS-J FROM 1 BY 1 + UNTIL WS-J > WS-ENTRY-COUNT + IF WS-KEY-DUP-CNT(WS-J) > 0 + DISPLAY WS-KEY-PRIMARY(WS-J) ' ' + WS-KEY-SECONDARY(WS-J) ' ' + WS-KEY-TOTAL-CNT(WS-J) ' ' + WS-KEY-DUP-CNT(WS-J) + END-IF + END-PERFORM + ELSE + DISPLAY ' (No key pairs recorded)' + END-IF. + DISPLAY '-------------------------------------------'. + DISPLAY ' '. + EXIT. + *> + *> ============================================================ + *> 5000-AUDIT : Write audit trail file with batch-level + *> duplicate statistics and timestamps. Records written: + *> HEADER, STATS, HASH, MAXDUP, FOOTER. + *> ============================================================ + 5000-AUDIT SECTION. + MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE. + MOVE '5000-AUDIT: Writing audit file' TO WS-TRACE-MSG. + PERFORM DISPLAY-TRACE. + IF WS-FILE-AUDIT-OPEN-YES + MOVE 'HEADER' TO WS-AUDIT-TYPE + MOVE WS-CURRENT-DATE(1:8) TO WS-AUDIT-DATE + MOVE WS-CURRENT-DATE(9:8) TO WS-AUDIT-TIME + MOVE 'Batch Report - ValidationWithdup' + TO WS-AUDIT-STATS + MOVE WS-AUDIT-BUFFER TO AUDIT-OUT-REC + WRITE AUDIT-OUT-REC + IF WS-FILE-AUDIT-STATUS NOT = '00' + STRING '5000-AUDIT: WRITE HEADER status ' + WS-FILE-AUDIT-STATUS DELIMITED BY SIZE + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE + END-IF + MOVE 'STATS' TO WS-AUDIT-TYPE + MOVE WS-CURRENT-DATE(1:8) TO WS-AUDIT-DATE + MOVE WS-CURRENT-DATE(9:8) TO WS-AUDIT-TIME + STRING 'READ=' WS-TOTAL-READ + ' GOOD=' WS-GOOD-COUNT + ' BAD=' WS-BAD-COUNT + ' UNIQUE=' WS-TOTAL-UNIQUE + ' DUP=' WS-TOTAL-DUPS + ' RATE=' WS-DUP-RATE-DISP '%' + DELIMITED BY SIZE + INTO WS-AUDIT-STATS + END-STRING + MOVE WS-AUDIT-BUFFER TO AUDIT-OUT-REC + WRITE AUDIT-OUT-REC + IF WS-FILE-AUDIT-STATUS NOT = '00' + STRING '5000-AUDIT: WRITE STATS status ' + WS-FILE-AUDIT-STATUS DELIMITED BY SIZE + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE + END-IF + MOVE 'HASH' TO WS-AUDIT-TYPE + MOVE WS-CURRENT-DATE(1:8) TO WS-AUDIT-DATE + MOVE WS-CURRENT-DATE(9:8) TO WS-AUDIT-TIME + STRING 'GOOD=' WS-HASH-GOOD + ' BAD=' WS-HASH-BAD + ' ALL=' WS-HASH-ALL + DELIMITED BY SIZE + INTO WS-AUDIT-STATS + END-STRING + MOVE WS-AUDIT-BUFFER TO AUDIT-OUT-REC + WRITE AUDIT-OUT-REC + MOVE 'MAXDUP' TO WS-AUDIT-TYPE + MOVE WS-CURRENT-DATE(1:8) TO WS-AUDIT-DATE + MOVE WS-CURRENT-DATE(9:8) TO WS-AUDIT-TIME + STRING 'MAX-FREQ=' WS-MAX-DUP-FREQ + ' AVG-FREQ=' WS-AVG-DISP + DELIMITED BY SIZE + INTO WS-AUDIT-STATS + END-STRING + MOVE WS-AUDIT-BUFFER TO AUDIT-OUT-REC + WRITE AUDIT-OUT-REC + MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE + MOVE 'FOOTER' TO WS-AUDIT-TYPE + MOVE WS-CURRENT-DATE(1:8) TO WS-AUDIT-DATE + MOVE WS-CURRENT-DATE(9:8) TO WS-AUDIT-TIME + MOVE 'End of audit trail' TO WS-AUDIT-STATS + MOVE WS-AUDIT-BUFFER TO AUDIT-OUT-REC + WRITE AUDIT-OUT-REC + IF WS-FILE-AUDIT-STATUS NOT = '00' + STRING '5000-AUDIT: WRITE FOOTER status ' + WS-FILE-AUDIT-STATUS DELIMITED BY SIZE + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE + END-IF + END-IF. + EXIT. + *> + *> ============================================================ + *> 6000-ERROR-HANDLE : Log error to DISPLAY with timestamp + *> and write error record to audit file if available. + *> ============================================================ + 6000-ERROR-HANDLE SECTION. + MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE. + DISPLAY WS-CURRENT-DATE(1:8) ' ' + WS-CURRENT-DATE(9:8) ' - ERROR: ' + WS-ERROR-MSG. + IF WS-FILE-AUDIT-OPEN-YES + MOVE 'ERROR' TO WS-AUDIT-TYPE + MOVE WS-CURRENT-DATE(1:8) TO WS-AUDIT-DATE + MOVE WS-CURRENT-DATE(9:8) TO WS-AUDIT-TIME + MOVE WS-ERROR-MSG TO WS-AUDIT-STATS + MOVE WS-AUDIT-BUFFER TO AUDIT-OUT-REC + WRITE AUDIT-OUT-REC + END-IF. + EXIT. + *> + *> ============================================================ + *> 9000-EXIT : Close all open files with FILE STATUS + *> verification, display final completion message. + *> ============================================================ + 9000-EXIT SECTION. + MOVE '9000-EXIT: Closing files' TO WS-TRACE-MSG. + PERFORM DISPLAY-TRACE. + CLOSE FILE-IN. + IF WS-FILE-IN-STATUS NOT = '00' + STRING '9000-EXIT: FILE-IN CLOSE status ' + WS-FILE-IN-STATUS DELIMITED BY SIZE + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE + END-IF. + CLOSE FILE-OUT-GOOD. + IF WS-FILE-GOOD-STATUS NOT = '00' + STRING '9000-EXIT: FILE-OUT-GOOD CLOSE status ' + WS-FILE-GOOD-STATUS DELIMITED BY SIZE + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE + END-IF. + CLOSE FILE-OUT-BAD. + IF WS-FILE-BAD-STATUS NOT = '00' + STRING '9000-EXIT: FILE-OUT-BAD CLOSE status ' + WS-FILE-BAD-STATUS DELIMITED BY SIZE + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE + END-IF. + CLOSE FILE-OUT-AUDIT. + IF WS-FILE-AUDIT-STATUS NOT = '00' + STRING '9000-EXIT: FILE-OUT-AUDIT CLOSE status ' + WS-FILE-AUDIT-STATUS DELIMITED BY SIZE + INTO WS-ERROR-MSG + END-STRING + PERFORM 6000-ERROR-HANDLE + END-IF. + MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE. + DISPLAY WS-CURRENT-DATE(1:8) ' ' + WS-CURRENT-DATE(9:8) ' - ' + 'ValidationWithdup: Completed. Good=' + WS-GOOD-COUNT ' Bad=' WS-BAD-COUNT. + EXIT. + *> + *> ============================================================ + *> DISPLAY-TRACE : Display a trace message prefixed with + *> YYYYMMDD HHMMSS timestamp. + *> ============================================================ + DISPLAY-TRACE. + MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE. + DISPLAY WS-CURRENT-DATE(1:8) ' ' + WS-CURRENT-DATE(9:8) ' - ' WS-TRACE-MSG. + *> + *> ============================================================ + *> COMPUTE-HASH-GOOD : Accumulate hash total for a good + *> record by summing FUNCTION ORD of each character + *> in IN-KEY and IN-DATA. + *> ============================================================ + COMPUTE-HASH-GOOD. + PERFORM VARYING WS-J FROM 1 BY 1 UNTIL WS-J > 5 + COMPUTE WS-HASH-CHAR = + FUNCTION ORD(IN-KEY(WS-J:1)) + ADD WS-HASH-CHAR TO WS-HASH-GOOD + ADD WS-HASH-CHAR TO WS-HASH-ALL + END-PERFORM. + PERFORM VARYING WS-J FROM 1 BY 1 UNTIL WS-J > 30 + COMPUTE WS-HASH-CHAR = + FUNCTION ORD(IN-DATA(WS-J:1)) + ADD WS-HASH-CHAR TO WS-HASH-GOOD + ADD WS-HASH-CHAR TO WS-HASH-ALL + END-PERFORM. + *> + *> ============================================================ + *> COMPUTE-HASH-BAD : Accumulate hash total for a bad + *> (duplicate) record by summing FUNCTION ORD of each + *> character in IN-KEY and IN-DATA. + *> ============================================================ + COMPUTE-HASH-BAD. + PERFORM VARYING WS-J FROM 1 BY 1 UNTIL WS-J > 5 + COMPUTE WS-HASH-CHAR = + FUNCTION ORD(IN-KEY(WS-J:1)) + ADD WS-HASH-CHAR TO WS-HASH-BAD + ADD WS-HASH-CHAR TO WS-HASH-ALL + END-PERFORM. + PERFORM VARYING WS-J FROM 1 BY 1 UNTIL WS-J > 30 + COMPUTE WS-HASH-CHAR = + FUNCTION ORD(IN-DATA(WS-J:1)) + ADD WS-HASH-CHAR TO WS-HASH-BAD + ADD WS-HASH-CHAR TO WS-HASH-ALL + END-PERFORM. + *> + END PROGRAM ValidationWithdup. diff --git a/benchmark-programs/31-validation-withdup/main-validation-withdup.cbl b/benchmark-programs/31-validation-withdup/main-validation-withdup.cbl new file mode 100644 index 0000000..2a58f78 --- /dev/null +++ b/benchmark-programs/31-validation-withdup/main-validation-withdup.cbl @@ -0,0 +1,117 @@ + *> ============================================================ + *> main-validation-withdup : 重复CDR检测 (Duplicate CDR) + *> Input : FILE-IN (INPUT.DAT: 排序済KEY付CDR) + *> Output: FILE-PASS (PASS.DAT: 非重複) + *> Coverage: VF-N003, VF-N004, VF-R001 + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. VALIDATE-DUP. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN ASSIGN TO "INPUT.DAT" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FS. + + SELECT FILE-PASS ASSIGN TO "PASS.DAT" + ORGANIZATION IS SEQUENTIAL. + + SELECT FILE-ERR ASSIGN TO "ERR.DAT" + ORGANIZATION IS SEQUENTIAL. + + DATA DIVISION. + FILE SECTION. + FD FILE-IN RECORD CONTAINS 40 CHARACTERS. + 01 IN-REC. + 05 IN-KEY PIC X(10). + 05 IN-VALUE PIC 9(10). + 05 IN-DATA PIC X(20). + + FD FILE-PASS RECORD CONTAINS 40 CHARACTERS. + 01 PASS-REC PIC X(40). + + FD FILE-ERR RECORD CONTAINS 60 CHARACTERS. + 01 ERR-REC. + 05 ERR-KEY PIC X(10). + 05 ERR-VALUE PIC 9(10). + 05 ERR-MSG PIC X(40). + + WORKING-STORAGE SECTION. + 01 WS-FS PIC X(2). + 01 WS-EOF PIC X(1) VALUE 'N'. + 88 WS-EOF-Y VALUE 'Y' FALSE 'N'. + 01 WS-PREV-KEY PIC X(10). + 01 WS-FIRST PIC X(1) VALUE 'Y'. + 88 WS-FIRST-Y VALUE 'Y' FALSE 'N'. + 01 WS-READ-COUNT PIC 9(10). + 01 WS-PASS-COUNT PIC 9(10). + 01 WS-DUP-COUNT PIC 9(10). + + 01 WS-TELECOM-REC. + COPY "telecom/TEL-BILLING.cpy". + + PROCEDURE DIVISION. + MAIN. + DISPLAY "VALIDATE-DUP: Starting validation with dup detection" + OPEN INPUT FILE-IN. + IF WS-FS NOT = "00" + DISPLAY "OPEN FAIL: " WS-FS + STOP RUN RETURNING 1 + END-IF. + OPEN OUTPUT FILE-PASS FILE-ERR. + + PERFORM UNTIL WS-EOF-Y + READ FILE-IN INTO IN-REC + AT END + SET WS-EOF-Y TO TRUE + NOT AT END + ADD 1 TO WS-READ-COUNT + IF WS-FIRST-Y + MOVE IN-KEY TO WS-PREV-KEY + MOVE 'N' TO WS-FIRST + PERFORM WRITE-PASS + ELSE + IF IN-KEY = WS-PREV-KEY + PERFORM WRITE-DUP + ELSE + MOVE IN-KEY TO WS-PREV-KEY + PERFORM WRITE-PASS + END-IF + END-IF + END-READ + END-PERFORM. + + CLOSE FILE-IN FILE-PASS FILE-ERR. + + DISPLAY "VALIDATE-DUP: READ=" WS-READ-COUNT + " PASS=" WS-PASS-COUNT " DUP=" WS-DUP-COUNT + + IF WS-READ-COUNT = WS-PASS-COUNT + WS-DUP-COUNT + DISPLAY "VALIDATE-DUP: PASS (R001 count match)" + STOP RUN RETURNING 0 + ELSE + DISPLAY "VALIDATE-DUP: FAIL - count mismatch" + STOP RUN RETURNING 1 + END-IF + . + + WRITE-PASS. + ADD 1 TO WS-PASS-COUNT. + MOVE IN-REC TO PASS-REC. + WRITE PASS-REC. + DISPLAY "PASS: " IN-KEY " (first occurrence)" + . + + WRITE-DUP. + ADD 1 TO WS-DUP-COUNT. + MOVE IN-KEY TO ERR-KEY. + MOVE IN-VALUE TO ERR-VALUE. + STRING "DUPLICATE KEY DETECTED - previous key was " + WS-PREV-KEY DELIMITED BY SIZE INTO ERR-MSG + END-STRING. + WRITE ERR-REC. + DISPLAY "DUP: " IN-KEY " (duplicate, rejected)" + . + + END PROGRAM VALIDATE-DUP. diff --git a/benchmark-programs/32-mix-1N-samekeybreak/DETAIL.DAT b/benchmark-programs/32-mix-1N-samekeybreak/DETAIL.DAT new file mode 100644 index 0000000..1c8af87 --- /dev/null +++ b/benchmark-programs/32-mix-1N-samekeybreak/DETAIL.DAT @@ -0,0 +1 @@ + 0000000 \ No newline at end of file diff --git a/benchmark-programs/32-mix-1N-samekeybreak/MASTER.DAT b/benchmark-programs/32-mix-1N-samekeybreak/MASTER.DAT new file mode 100644 index 0000000..876dd97 --- /dev/null +++ b/benchmark-programs/32-mix-1N-samekeybreak/MASTER.DAT @@ -0,0 +1 @@ + 0000000 \ No newline at end of file diff --git a/benchmark-programs/32-mix-1N-samekeybreak/README.md b/benchmark-programs/32-mix-1N-samekeybreak/README.md new file mode 100644 index 0000000..ced2112 --- /dev/null +++ b/benchmark-programs/32-mix-1N-samekeybreak/README.md @@ -0,0 +1,26 @@ +# 32-mix-1N-samekeybreak — 1:N Matching with Same-Key Break + +## 电信业务场景 + +合同+月别混合集计。先做合同↔CDR的1:N匹配，再在匹配结果内做同键(key)的月别集计。同时演示匹配和key切两种模式。 + +## Purpose +Demonstrates 1:N matching pattern (one master to many details) combined with same-key break summarization. + +## Test Coverage +1. **1:N matching** — One master (KEY0000001) matched to three detail records +2. **Same-key break** — When detail key changes, a summary line is output with count and total +3. **Multiple master matches** — Records for KEY0000001, KEY0000002, KEY0000004 +4. **Unmatched detail** — Master lookup not found (if key is missing) +5. **Final break** — Last group summary at end of file + +## Data +- 5 master records (KEY0000001 through KEY0000005) +- 8 detail records with keys repeating for 1:N matching + +## Key Techniques +- In-memory master table loaded from file +- Sequential file matching +- Key break detection on key field change +- Accumulator reset at each break +- Grand total across all matches diff --git a/benchmark-programs/32-mix-1N-samekeybreak/audit-32.log b/benchmark-programs/32-mix-1N-samekeybreak/audit-32.log new file mode 100644 index 0000000..7b4e353 --- /dev/null +++ b/benchmark-programs/32-mix-1N-samekeybreak/audit-32.log @@ -0,0 +1,18 @@ + Main32Mix1NSameKeyBreak BATCH032 20260622 15204211 + W FILE-MAST read idx=01 FS=06 + LOAD-MASTER: 02 entries loaded + Header written, master table size=02 + I Detail processing started + W Empty key detected at record 00001 + MATCH key= item= amt=0000000 + E FILE-DETL read failed FS=06d 00001 + I Zero amount for key 0 0001 + KEYBREAK: new key=0 + MATCH key=0 item= amt= + BREAK: key=0 count=00001 total=000000000 + FINAL-BREAK: total break count=00001 + REPORT: match=00002 unmatched=00000 break=00001 valid=00001 invalid=0000 + ERRORS: info=002 warn=002 error=001 crit=000 + Batch BATCH032 ended 2026062215204211 + Records total=00002 match=00002 break=00001 + Hash matched=00000000000 unmatched=00000000000 grand=00000000000 diff --git a/benchmark-programs/32-mix-1N-samekeybreak/main-32-mix-1N-samekeybreak.cbl b/benchmark-programs/32-mix-1N-samekeybreak/main-32-mix-1N-samekeybreak.cbl new file mode 100644 index 0000000..a9023c6 --- /dev/null +++ b/benchmark-programs/32-mix-1N-samekeybreak/main-32-mix-1N-samekeybreak.cbl @@ -0,0 +1,820 @@ + *> ============================================================ + *> 32-mix-1N-samekeybreak : 合同+月别集计 (Contract+Monthly) + *> Input : FILE-MAST (master.dat: 合同), FILE-DETL (detail.dat: CDR) + *> Output: FILE-OUT (match-output.txt: 合同别月集计结果) + *> AUDIT-OUT (audit-32.log: 审计跟踪) + *> Coverage: AM-N006, MT-R001 + *> Version : 2.0 — Expanded with audit, hash totals, FILE STATUS + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. Main32Mix1NSameKeyBreak. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-MAST ASSIGN TO "master.dat" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-MAST. + + SELECT FILE-DETL ASSIGN TO "detail.dat" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-DETL. + + SELECT FILE-OUT ASSIGN TO "match-output.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-OUT. + + SELECT AUDIT-OUT ASSIGN TO "audit-32.log" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-AUDIT. + + DATA DIVISION. + FILE SECTION. + FD FILE-MAST. + 01 MAST-REC. + 05 MAST-KEY PIC X(10). + 05 MAST-NAME PIC X(20). + 05 MAST-LIMIT PIC 9(07). + + FD FILE-DETL. + 01 DETL-REC. + 05 DETL-KEY PIC X(10). + 05 DETL-ITEM PIC X(15). + 05 DETL-AMOUNT PIC 9(07). + + FD FILE-OUT. + 01 OUT-REC. + 05 OUT-LINE PIC X(80). + + FD AUDIT-OUT. + 01 AUDIT-REC. + 05 AUDIT-LINE PIC X(120). + + WORKING-STORAGE SECTION. + 01 WS-TELECOM-REC. + COPY "telecom/TEL-BILLING.cpy". + + *> ============================================================ + *> FILE STATUS fields + *> ============================================================ + 01 FS-MAST PIC X(02) VALUE "00". + 01 FS-DETL PIC X(02) VALUE "00". + 01 FS-OUT PIC X(02) VALUE "00". + 01 FS-AUDIT PIC X(02) VALUE "00". + + *> ============================================================ + *> End-of-file flags + *> ============================================================ + 01 WS-EOF-MAST PIC X(01) VALUE "N". + 88 MAST-EOF VALUE "Y". + 01 WS-EOF-DETL PIC X(01) VALUE "N". + 88 DETL-EOF VALUE "Y". + + *> ============================================================ + *> Key break fields (same-key: contract key) + *> ============================================================ + 01 WS-MASTER-FOUND PIC X(01) VALUE "N". + 01 WS-MAST-KEY PIC X(10). + 01 WS-PREV-KEY PIC X(10). + 01 WS-KEY-BREAK PIC X(01) VALUE "N". + 88 KEY-BREAK VALUE "Y". + + *> ============================================================ + *> Core counters + *> ============================================================ + 01 WS-MATCH-COUNT PIC 9(05) VALUE 0. + 01 WS-BREAK-COUNT PIC 9(05) VALUE 0. + 01 WS-BREAK-TOTAL PIC 9(09) VALUE 0. + 01 WS-GRAND-TOTAL PIC 9(09) VALUE 0. + 01 WS-DETAIL-COUNT PIC 9(05) VALUE 0. + + *> ============================================================ + *> Expanded counters: match path, unmatched path, break path + *> ============================================================ + 01 WS-MATCH-PATH-CNT PIC 9(05) VALUE 0. + 01 WS-UNMATCH-CNT PIC 9(05) VALUE 0. + 01 WS-BREAK-PATH-CNT PIC 9(05) VALUE 0. + 01 WS-VALID-COUNT PIC 9(05) VALUE 0. + 01 WS-INVALID-COUNT PIC 9(05) VALUE 0. + 01 WS-TOTAL-RECORDS PIC 9(05) VALUE 0. + + *> ============================================================ + *> Hash totals per category + *> ============================================================ + 01 WS-HASH-MATCHED PIC 9(11) VALUE 0. + 01 WS-HASH-UNMATCHED PIC 9(11) VALUE 0. + 01 WS-HASH-BREAK PIC 9(11) VALUE 0. + 01 WS-HASH-GRAND PIC 9(11) VALUE 0. + + *> ============================================================ + *> Master lookup table (loaded into memory) + *> ============================================================ + 01 MASTER-TABLE. + 05 MASTER-ENTRY OCCURS 10 TIMES. + 10 ME-KEY PIC X(10). + 10 ME-NAME PIC X(20). + 10 ME-LIMIT PIC 9(07). + + 01 IDX PIC 9(02). + 01 MAST-IDX PIC 9(02). + 01 WS-MAST-COUNT PIC 9(02). + + 01 WS-MASTER-NAME PIC X(20). + 01 WS-MASTER-LIMIT PIC 9(07). + 01 WS-MASTER-FOUND-IDX PIC 9(02). + + *> ============================================================ + *> Timestamp and batch control + *> ============================================================ + 01 WS-TIMESTAMP. + 05 WS-TS-DATE PIC X(08). + 05 FILLER PIC X(01) VALUE SPACE. + 05 WS-TS-TIME PIC X(08). + + 01 WS-BATCH-ID PIC X(08) VALUE "BATCH032". + 01 WS-BATCH-START PIC X(16). + 01 WS-BATCH-END PIC X(16). + 01 WS-PROGRAM-NAME PIC X(30) VALUE + "Main32Mix1NSameKeyBreak". + + *> ============================================================ + *> Error severity levels + *> ============================================================ + 01 WS-ERROR-SEVERITY. + 05 WS-ERR-LEVEL PIC X(01). + 88 ERR-INFO VALUE "I". + 88 ERR-WARN VALUE "W". + 88 ERR-ERROR VALUE "E". + 88 ERR-CRITICAL VALUE "C". + + 01 WS-ERROR-MESSAGE PIC X(80). + 01 WS-ERR-COUNT-INFO PIC 9(03) VALUE 0. + 01 WS-ERR-COUNT-WARN PIC 9(03) VALUE 0. + 01 WS-ERR-COUNT-ERROR PIC 9(03) VALUE 0. + 01 WS-ERR-COUNT-CRIT PIC 9(03) VALUE 0. + + *> ============================================================ + *> FILE STATUS trace buffer + *> ============================================================ + 01 WS-FS-TRACE PIC X(40). + 01 WS-FS-EXPECTED PIC X(02) VALUE "00". + + *> ============================================================ + *> Audit line templates + *> ============================================================ + 01 WS-AUDIT-HEADER. + 05 FILLER PIC X(08) VALUE "AUDIT ". + 05 FILLER PIC X(01) VALUE SPACE. + 05 AH-PGM PIC X(30). + 05 FILLER PIC X(01) VALUE SPACE. + 05 AH-BATCH PIC X(08). + 05 FILLER PIC X(01) VALUE SPACE. + 05 AH-TIMESTAMP PIC X(17). + + 01 WS-AUDIT-ENTRY. + 05 FILLER PIC X(08) VALUE " ENTRY ". + 05 AE-TEXT PIC X(72). + + 01 WS-AUDIT-STATS. + 05 FILLER PIC X(08) VALUE " STATS ". + 05 AS-TEXT PIC X(72). + + 01 WS-AUDIT-ERROR. + 05 FILLER PIC X(08) VALUE " ERROR ". + 05 AE-LEVEL PIC X(01). + 05 FILLER PIC X(01) VALUE SPACE. + 05 AE-MSG PIC X(70). + + *> ============================================================ + *> Output line templates (preserved from original) + *> ============================================================ + 01 WS-HEADER-LINE. + 05 FILLER PIC X(40) VALUE + "Master Key Name ". + 05 FILLER PIC X(40) VALUE + "Detail Item Amount". + + 01 WS-MATCH-LINE. + 05 FILLER PIC X(02) VALUE " ". + 05 ML-KEY PIC X(10). + 05 FILLER PIC X(02) VALUE SPACES. + 05 ML-NAME PIC X(20). + 05 FILLER PIC X(02) VALUE SPACES. + 05 ML-ITEM PIC X(15). + 05 FILLER PIC X(02) VALUE SPACES. + 05 ML-AMOUNT PIC Z(9)9. + + 01 WS-BREAK-LINE. + 05 FILLER PIC X(10) VALUE "*** BREAK ". + 05 BL-KEY PIC X(10). + 05 FILLER PIC X(10) VALUE " Count: ". + 05 BL-COUNT PIC Z(9). + 05 FILLER PIC X(10) VALUE " Total: ". + 05 BL-TOTAL PIC Z(9)9. + + 01 WS-UNMATCHED-LINE. + 05 FILLER PIC X(20) VALUE " UNMATCHED detail: ". + 05 UL-KEY PIC X(10). + + *> ============================================================ + *> Report totals template + *> ============================================================ + 01 WS-REPORT-LINE. + 05 FILLER PIC X(02) VALUE SPACES. + 05 RL-LABEL PIC X(30). + 05 FILLER PIC X(02) VALUE SPACES. + 05 RL-VALUE PIC Z(9)9. + + 01 WS-HASH-LINE. + 05 FILLER PIC X(02) VALUE SPACES. + 05 HL-LABEL PIC X(30). + 05 FILLER PIC X(02) VALUE SPACES. + 05 HL-VALUE PIC Z(10)9. + + *> ============================================================ + *> Temporary work fields + *> ============================================================ + 01 WS-TEMP-AMOUNT PIC 9(09). + 01 WS-TEMP-COUNT PIC 9(05). + 01 WS-TEMP-HASH PIC 9(11). + + PROCEDURE DIVISION. + MAIN-PROCEDURE. + + PERFORM 1000-INIT. + PERFORM 2000-OPEN-FILES. + PERFORM 3000-PROCESS. + PERFORM 4000-REPORT. + PERFORM 5000-AUDIT. + PERFORM 9000-EXIT. + + STOP RUN. + + *> ============================================================ + *> 1000-INIT : Initialise batch, timestamp, counters + *> ============================================================ + 1000-INIT. + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-TS-DATE. + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-TS-TIME. + MOVE WS-TS-DATE TO WS-BATCH-START(1:8). + MOVE WS-TS-TIME TO WS-BATCH-START(9:8). + + MOVE 0 TO WS-MATCH-COUNT. + MOVE 0 TO WS-MATCH-PATH-CNT. + MOVE 0 TO WS-UNMATCH-CNT. + MOVE 0 TO WS-BREAK-PATH-CNT. + MOVE 0 TO WS-BREAK-COUNT. + MOVE 0 TO WS-VALID-COUNT. + MOVE 0 TO WS-INVALID-COUNT. + MOVE 0 TO WS-TOTAL-RECORDS. + MOVE 0 TO WS-GRAND-TOTAL. + MOVE 0 TO WS-HASH-MATCHED. + MOVE 0 TO WS-HASH-UNMATCHED. + MOVE 0 TO WS-HASH-BREAK. + MOVE 0 TO WS-HASH-GRAND. + MOVE 0 TO WS-ERR-COUNT-INFO. + MOVE 0 TO WS-ERR-COUNT-WARN. + MOVE 0 TO WS-ERR-COUNT-ERROR. + MOVE 0 TO WS-ERR-COUNT-CRIT. + + DISPLAY "[" WS-TS-DATE " " WS-TS-TIME "] " + WS-PROGRAM-NAME " starting, batch=" + WS-BATCH-ID. + + *> ============================================================ + *> 2000-OPEN-FILES : Open all files with FILE STATUS checks + *> ============================================================ + 2000-OPEN-FILES. + OPEN OUTPUT FILE-OUT. + MOVE FS-OUT TO WS-FS-TRACE. + IF FS-OUT NOT = "00" + MOVE "E" TO WS-ERR-LEVEL + STRING "FILE-OUT open failed FS=" FS-OUT + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF. + + OPEN OUTPUT AUDIT-OUT. + MOVE FS-AUDIT TO WS-FS-TRACE. + IF FS-AUDIT NOT = "00" + MOVE "E" TO WS-ERR-LEVEL + STRING "AUDIT-OUT open failed FS=" FS-AUDIT + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF. + + MOVE SPACES TO WS-AUDIT-HEADER. + MOVE WS-PROGRAM-NAME TO AH-PGM. + MOVE WS-BATCH-ID TO AH-BATCH. + STRING WS-TS-DATE " " WS-TS-TIME + DELIMITED BY SIZE INTO AH-TIMESTAMP. + MOVE WS-AUDIT-HEADER TO AUDIT-REC. + WRITE AUDIT-REC. + MOVE FS-AUDIT TO WS-FS-TRACE. + IF FS-AUDIT NOT = "00" + DISPLAY "Warning: AUDIT write failed FS=" FS-AUDIT + END-IF. + + *> Load master table into memory + PERFORM LOAD-MASTER-TABLE. + + MOVE "1:N Match with Same-Key Break" TO OUT-REC. + WRITE OUT-REC. + MOVE SPACES TO OUT-REC. + WRITE OUT-REC. + MOVE WS-HEADER-LINE TO OUT-REC. + WRITE OUT-REC. + MOVE SPACES TO OUT-REC. + WRITE OUT-REC. + MOVE SPACES TO WS-AUDIT-ENTRY. + STRING "Header written, master table size=" WS-MAST-COUNT + DELIMITED BY SIZE INTO AE-TEXT. + MOVE WS-AUDIT-ENTRY TO AUDIT-REC. + WRITE AUDIT-REC. + + *> ============================================================ + *> 3000-PROCESS : Main processing loop + *> ============================================================ + 3000-PROCESS. + *> Process: for each detail, find matching master + OPEN INPUT FILE-DETL. + IF FS-DETL NOT = "00" + MOVE "E" TO WS-ERR-LEVEL + STRING "FILE-DETL open failed FS=" FS-DETL + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF. + + MOVE 'N' TO WS-EOF-DETL. + MOVE 0 TO WS-MATCH-COUNT. + MOVE 0 TO WS-BREAK-COUNT. + MOVE 0 TO WS-GRAND-TOTAL. + MOVE SPACES TO WS-PREV-KEY. + + MOVE "I" TO WS-ERR-LEVEL. + MOVE "Detail processing started" TO WS-ERROR-MESSAGE. + PERFORM 6000-ERROR-HANDLE. + + PERFORM UNTIL DETL-EOF + READ FILE-DETL INTO DETL-REC + AT END + SET DETL-EOF TO TRUE + PERFORM HANDLE-FINAL-BREAK + NOT AT END + PERFORM PROCESS-DETAIL + END-READ + MOVE FS-DETL TO WS-FS-TRACE + IF NOT DETL-EOF AND FS-DETL NOT = "00" + MOVE "E" TO WS-ERR-LEVEL + STRING "FILE-DETL read failed FS=" FS-DETL + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF + END-PERFORM. + + CLOSE FILE-DETL. + IF FS-DETL NOT = "00" + MOVE "W" TO WS-ERR-LEVEL + STRING "FILE-DETL close FS=" FS-DETL + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF. + + *> ============================================================ + *> 3100-VALIDATE : Validate detail record fields + *> ============================================================ + 3100-VALIDATE. + *> Called from PROCESS-DETAIL for each record + ADD 1 TO WS-TOTAL-RECORDS. + + *> Validate key not empty + IF DETL-KEY = SPACES OR ZERO + ADD 1 TO WS-INVALID-COUNT + MOVE "W" TO WS-ERR-LEVEL + STRING "Empty key detected at record " + WS-TOTAL-RECORDS INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + EXIT PARAGRAPH + END-IF. + + *> Validate amount within range + IF DETL-AMOUNT = 0 + ADD 1 TO WS-INVALID-COUNT + MOVE "I" TO WS-ERR-LEVEL + STRING "Zero amount for key " DETL-KEY + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF. + + *> Validate amount not exceeding reasonable threshold + IF DETL-AMOUNT > 9999999 + ADD 1 TO WS-INVALID-COUNT + MOVE "W" TO WS-ERR-LEVEL + STRING "Suspicious large amount " DETL-AMOUNT + " for key " DETL-KEY INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF. + + ADD 1 TO WS-VALID-COUNT. + + *> ============================================================ + *> 3200-CALCULATE : Accumulate hash totals and running totals + *> ============================================================ + 3200-CALCULATE. + *> Called from PROCESS-DETAIL after match determination + *> Accumulate hash totals per category + IF WS-MASTER-FOUND = "Y" + ADD DETL-AMOUNT TO WS-HASH-MATCHED + ELSE + ADD DETL-AMOUNT TO WS-HASH-UNMATCHED + END-IF. + + ADD DETL-AMOUNT TO WS-HASH-GRAND. + + *> Cross-check: hash grand should equal matched + unmatched + COMPUTE WS-TEMP-HASH = + WS-HASH-MATCHED + WS-HASH-UNMATCHED. + IF WS-TEMP-HASH NOT = WS-HASH-GRAND + MOVE "W" TO WS-ERR-LEVEL + STRING "Hash cross-check mismatch: " + WS-HASH-GRAND " vs " WS-TEMP-HASH + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF. + + *> ============================================================ + *> 3300-FORMAT-OUTPUT : Format output line with tracing + *> ============================================================ + 3300-FORMAT-OUTPUT. + *> Called from PROCESS-DETAIL + *> (formatting is done inline in PROCESS-DETAIL using + *> existing WS-MATCH-LINE / WS-UNMATCHED-LINE templates) + *> This paragraph logs output to the audit trail. + MOVE SPACES TO WS-AUDIT-ENTRY. + IF WS-MASTER-FOUND = "Y" + STRING "MATCH key=" DETL-KEY + " item=" DETL-ITEM + " amt=" DETL-AMOUNT + DELIMITED BY SIZE INTO AE-TEXT + ELSE + STRING "UNMATCH key=" DETL-KEY + " item=" DETL-ITEM + " amt=" DETL-AMOUNT + DELIMITED BY SIZE INTO AE-TEXT + END-IF. + MOVE WS-AUDIT-ENTRY TO AUDIT-REC. + WRITE AUDIT-REC. + + *> ============================================================ + *> 3400-WRITE-OUTPUT : Write record to output + FILE STATUS check + *> ============================================================ + 3400-WRITE-OUTPUT. + *> Called after each WRITE to the output file + *> Performs FILE STATUS check and audit logging. + MOVE FS-OUT TO WS-FS-TRACE. + IF FS-OUT NOT = "00" + MOVE "E" TO WS-ERR-LEVEL + STRING "FILE-OUT write failed FS=" FS-OUT + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF. + + *> ============================================================ + *> 4000-REPORT : Write summary report to output and audit + *> ============================================================ + 4000-REPORT. + MOVE SPACES TO OUT-REC. + WRITE OUT-REC. + PERFORM 3400-WRITE-OUTPUT. + + MOVE SPACES TO WS-REPORT-LINE. + MOVE "Total matches:" TO RL-LABEL. + MOVE WS-MATCH-COUNT TO RL-VALUE. + MOVE WS-REPORT-LINE TO OUT-REC. + WRITE OUT-REC. + PERFORM 3400-WRITE-OUTPUT. + + MOVE SPACES TO WS-REPORT-LINE. + MOVE "Total unmatched:" TO RL-LABEL. + MOVE WS-UNMATCH-CNT TO RL-VALUE. + MOVE WS-REPORT-LINE TO OUT-REC. + WRITE OUT-REC. + PERFORM 3400-WRITE-OUTPUT. + + MOVE SPACES TO WS-REPORT-LINE. + MOVE "Total breaks:" TO RL-LABEL. + MOVE WS-BREAK-COUNT TO RL-VALUE. + MOVE WS-REPORT-LINE TO OUT-REC. + WRITE OUT-REC. + PERFORM 3400-WRITE-OUTPUT. + + MOVE SPACES TO WS-REPORT-LINE. + MOVE "Valid records:" TO RL-LABEL. + MOVE WS-VALID-COUNT TO RL-VALUE. + MOVE WS-REPORT-LINE TO OUT-REC. + WRITE OUT-REC. + PERFORM 3400-WRITE-OUTPUT. + + MOVE SPACES TO WS-REPORT-LINE. + MOVE "Invalid records:" TO RL-LABEL. + MOVE WS-INVALID-COUNT TO RL-VALUE. + MOVE WS-REPORT-LINE TO OUT-REC. + WRITE OUT-REC. + PERFORM 3400-WRITE-OUTPUT. + + MOVE SPACES TO WS-HASH-LINE. + MOVE "Hash total (matched):" TO HL-LABEL. + MOVE WS-HASH-MATCHED TO HL-VALUE. + MOVE WS-HASH-LINE TO OUT-REC. + WRITE OUT-REC. + PERFORM 3400-WRITE-OUTPUT. + + MOVE SPACES TO WS-HASH-LINE. + MOVE "Hash total (unmatched):" TO HL-LABEL. + MOVE WS-HASH-UNMATCHED TO HL-VALUE. + MOVE WS-HASH-LINE TO OUT-REC. + WRITE OUT-REC. + PERFORM 3400-WRITE-OUTPUT. + + MOVE SPACES TO WS-HASH-LINE. + MOVE "Hash total (grand):" TO HL-LABEL. + MOVE WS-HASH-GRAND TO HL-VALUE. + MOVE WS-HASH-LINE TO OUT-REC. + WRITE OUT-REC. + PERFORM 3400-WRITE-OUTPUT. + + STRING "Total matches: " WS-MATCH-COUNT + " Breaks: " WS-BREAK-COUNT + " Grand total: " WS-GRAND-TOTAL + DELIMITED BY SIZE INTO OUT-REC. + WRITE OUT-REC. + PERFORM 3400-WRITE-OUTPUT. + + MOVE SPACES TO WS-AUDIT-ENTRY. + STRING "REPORT: match=" WS-MATCH-COUNT + " unmatched=" WS-UNMATCH-CNT + " break=" WS-BREAK-COUNT + " valid=" WS-VALID-COUNT + " invalid=" WS-INVALID-COUNT + " grand=" WS-GRAND-TOTAL + " hashG=" WS-HASH-GRAND + DELIMITED BY SIZE INTO AE-TEXT. + MOVE WS-AUDIT-ENTRY TO AUDIT-REC. + WRITE AUDIT-REC. + + MOVE SPACES TO WS-AUDIT-ENTRY. + STRING "ERRORS: info=" WS-ERR-COUNT-INFO + " warn=" WS-ERR-COUNT-WARN + " error=" WS-ERR-COUNT-ERROR + " crit=" WS-ERR-COUNT-CRIT + DELIMITED BY SIZE INTO AE-TEXT. + MOVE WS-AUDIT-ENTRY TO AUDIT-REC. + WRITE AUDIT-REC. + + *> ============================================================ + *> 5000-AUDIT : Write final audit summary, close audit file + *> ============================================================ + 5000-AUDIT. + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-TS-DATE. + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-TS-TIME. + MOVE WS-TS-DATE TO WS-BATCH-END(1:8). + MOVE WS-TS-TIME TO WS-BATCH-END(9:8). + + MOVE SPACES TO WS-AUDIT-STATS. + STRING "Batch " WS-BATCH-ID + " ended " WS-BATCH-END + DELIMITED BY SIZE INTO AS-TEXT. + MOVE WS-AUDIT-STATS TO AUDIT-REC. + WRITE AUDIT-REC. + + MOVE SPACES TO WS-AUDIT-STATS. + STRING "Records total=" WS-TOTAL-RECORDS + " match=" WS-MATCH-PATH-CNT + " break=" WS-BREAK-PATH-CNT + DELIMITED BY SIZE INTO AS-TEXT. + MOVE WS-AUDIT-STATS TO AUDIT-REC. + WRITE AUDIT-REC. + + MOVE SPACES TO WS-AUDIT-STATS. + STRING "Hash matched=" WS-HASH-MATCHED + " unmatched=" WS-HASH-UNMATCHED + " grand=" WS-HASH-GRAND + DELIMITED BY SIZE INTO AS-TEXT. + MOVE WS-AUDIT-STATS TO AUDIT-REC. + WRITE AUDIT-REC. + + CLOSE AUDIT-OUT. + IF FS-AUDIT NOT = "00" + DISPLAY "Warning: AUDIT close FS=" FS-AUDIT + END-IF. + + *> ============================================================ + *> LOAD-MASTER-TABLE (original logic preserved, expanded) + *> ============================================================ + LOAD-MASTER-TABLE. + OPEN INPUT FILE-MAST. + IF FS-MAST NOT = "00" + MOVE "E" TO WS-ERR-LEVEL + STRING "FILE-MAST open failed FS=" FS-MAST + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF. + + MOVE 0 TO WS-MAST-COUNT. + PERFORM VARYING IDX FROM 1 BY 1 UNTIL IDX > 10 + READ FILE-MAST INTO MAST-REC + AT END + EXIT PERFORM + END-READ + MOVE FS-MAST TO WS-FS-TRACE + IF FS-MAST NOT = "00" AND FS-MAST NOT = "10" + MOVE "W" TO WS-ERR-LEVEL + STRING "FILE-MAST read idx=" IDX + " FS=" FS-MAST INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF + MOVE MAST-KEY TO ME-KEY(IDX) + MOVE MAST-NAME TO ME-NAME(IDX) + MOVE MAST-LIMIT TO ME-LIMIT(IDX) + ADD 1 TO WS-MAST-COUNT + END-PERFORM. + + CLOSE FILE-MAST. + MOVE FS-MAST TO WS-FS-TRACE. + IF FS-MAST NOT = "00" + MOVE "W" TO WS-ERR-LEVEL + STRING "FILE-MAST close FS=" FS-MAST + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF. + + DISPLAY "Master table loaded: " WS-MAST-COUNT " entries". + + MOVE SPACES TO WS-AUDIT-ENTRY. + STRING "LOAD-MASTER: " WS-MAST-COUNT " entries loaded" + DELIMITED BY SIZE INTO AE-TEXT. + MOVE WS-AUDIT-ENTRY TO AUDIT-REC. + WRITE AUDIT-REC. + + *> ============================================================ + *> PROCESS-DETAIL (original logic preserved, expanded) + *> ============================================================ + PROCESS-DETAIL. + *> Run validation + PERFORM 3100-VALIDATE. + + *> Check for key break (same key) + IF DETL-KEY NOT = WS-PREV-KEY + IF WS-PREV-KEY NOT = SPACES + ADD 1 TO WS-BREAK-PATH-CNT + PERFORM HANDLE-KEY-BREAK + END-IF + MOVE DETL-KEY TO WS-PREV-KEY + MOVE 0 TO WS-DETAIL-COUNT + MOVE 0 TO WS-BREAK-TOTAL + + MOVE SPACES TO WS-AUDIT-ENTRY + STRING "KEYBREAK: new key=" DETL-KEY + DELIMITED BY SIZE INTO AE-TEXT + MOVE WS-AUDIT-ENTRY TO AUDIT-REC + WRITE AUDIT-REC + END-IF. + + *> Find matching master + MOVE "N" TO WS-MASTER-FOUND. + MOVE 0 TO WS-MASTER-FOUND-IDX. + PERFORM VARYING MAST-IDX FROM 1 BY 1 + UNTIL MAST-IDX > WS-MAST-COUNT + IF ME-KEY(MAST-IDX) = DETL-KEY + MOVE "Y" TO WS-MASTER-FOUND + MOVE ME-NAME(MAST-IDX) TO WS-MASTER-NAME + MOVE ME-LIMIT(MAST-IDX) TO WS-MASTER-LIMIT + MOVE MAST-IDX TO WS-MASTER-FOUND-IDX + END-IF + END-PERFORM. + + *> Perform hash accumulation (3200) + PERFORM 3200-CALCULATE. + + IF WS-MASTER-FOUND = "Y" + ADD 1 TO WS-MATCH-COUNT + ADD 1 TO WS-MATCH-PATH-CNT + ADD 1 TO WS-DETAIL-COUNT + ADD DETL-AMOUNT TO WS-BREAK-TOTAL + ADD DETL-AMOUNT TO WS-GRAND-TOTAL + + MOVE DETL-KEY TO ML-KEY + MOVE WS-MASTER-NAME TO ML-NAME + MOVE DETL-ITEM TO ML-ITEM + MOVE DETL-AMOUNT TO ML-AMOUNT + DISPLAY " " WS-MATCH-LINE + MOVE WS-MATCH-LINE TO OUT-REC + WRITE OUT-REC + PERFORM 3400-WRITE-OUTPUT + ELSE + ADD 1 TO WS-UNMATCH-CNT + MOVE DETL-KEY TO UL-KEY + DISPLAY " " WS-UNMATCHED-LINE + MOVE WS-UNMATCHED-LINE TO OUT-REC + WRITE OUT-REC + PERFORM 3400-WRITE-OUTPUT + END-IF. + + *> Audit trace for this detail + PERFORM 3300-FORMAT-OUTPUT. + + *> ============================================================ + *> HANDLE-KEY-BREAK (original logic preserved, expanded) + *> ============================================================ + HANDLE-KEY-BREAK. + ADD 1 TO WS-BREAK-COUNT. + MOVE WS-PREV-KEY TO BL-KEY. + MOVE WS-DETAIL-COUNT TO BL-COUNT. + MOVE WS-BREAK-TOTAL TO BL-TOTAL. + ADD WS-BREAK-TOTAL TO WS-HASH-BREAK. + DISPLAY " " WS-BREAK-LINE. + MOVE WS-BREAK-LINE TO OUT-REC. + WRITE OUT-REC. + PERFORM 3400-WRITE-OUTPUT. + + MOVE SPACES TO WS-AUDIT-ENTRY. + STRING "BREAK: key=" WS-PREV-KEY + " count=" WS-DETAIL-COUNT + " total=" WS-BREAK-TOTAL + DELIMITED BY SIZE INTO AE-TEXT. + MOVE WS-AUDIT-ENTRY TO AUDIT-REC. + WRITE AUDIT-REC. + + *> ============================================================ + *> HANDLE-FINAL-BREAK (original logic preserved, expanded) + *> ============================================================ + HANDLE-FINAL-BREAK. + IF WS-PREV-KEY NOT = SPACES + ADD 1 TO WS-BREAK-PATH-CNT + PERFORM HANDLE-KEY-BREAK + END-IF. + + MOVE SPACES TO WS-AUDIT-ENTRY. + STRING "FINAL-BREAK: total break count=" WS-BREAK-COUNT + DELIMITED BY SIZE INTO AE-TEXT. + MOVE WS-AUDIT-ENTRY TO AUDIT-REC. + WRITE AUDIT-REC. + + *> ============================================================ + *> 6000-ERROR-HANDLE : Centralized error handling by severity + *> ============================================================ + 6000-ERROR-HANDLE. + EVALUATE WS-ERR-LEVEL + WHEN "I" + ADD 1 TO WS-ERR-COUNT-INFO + DISPLAY "INFO: " WS-ERROR-MESSAGE + WHEN "W" + ADD 1 TO WS-ERR-COUNT-WARN + DISPLAY "WARN: " WS-ERROR-MESSAGE + WHEN "E" + ADD 1 TO WS-ERR-COUNT-ERROR + DISPLAY "ERROR: " WS-ERROR-MESSAGE + WHEN "C" + ADD 1 TO WS-ERR-COUNT-CRIT + DISPLAY "CRITICAL: " WS-ERROR-MESSAGE + MOVE WS-ERROR-MESSAGE TO OUT-REC + WRITE OUT-REC + MOVE SPACES TO WS-AUDIT-ERROR + MOVE "C" TO AE-LEVEL + STRING "ABORT: " WS-ERROR-MESSAGE + DELIMITED BY SIZE INTO AE-MSG + MOVE WS-AUDIT-ERROR TO AUDIT-REC + WRITE AUDIT-REC + CLOSE FILE-OUT + CLOSE AUDIT-OUT + STOP RUN + WHEN OTHER + DISPLAY "UNKNOWN: " WS-ERROR-MESSAGE + END-EVALUATE. + + *> Write error to audit log + MOVE SPACES TO WS-AUDIT-ERROR. + MOVE WS-ERR-LEVEL TO AE-LEVEL. + MOVE WS-ERROR-MESSAGE TO AE-MSG. + MOVE WS-AUDIT-ERROR TO AUDIT-REC. + WRITE AUDIT-REC. + + *> ============================================================ + *> 9000-EXIT : Close files and terminate + *> ============================================================ + 9000-EXIT. + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-TS-DATE. + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-TS-TIME. + MOVE WS-TS-DATE TO WS-BATCH-END(1:8). + MOVE WS-TS-TIME TO WS-BATCH-END(9:8). + + DISPLAY "[" WS-TS-DATE " " WS-TS-TIME "] " + WS-PROGRAM-NAME " ending, batch=" WS-BATCH-ID. + + CLOSE FILE-OUT. + IF FS-OUT NOT = "00" + DISPLAY "Warning: FILE-OUT close FS=" FS-OUT + END-IF. + + DISPLAY "Output written to match-output.txt". + DISPLAY "Audit written to audit-32.log". diff --git a/benchmark-programs/32-mix-1N-samekeybreak/match-output.txt b/benchmark-programs/32-mix-1N-samekeybreak/match-output.txt new file mode 100644 index 0000000..0a78cc7 --- /dev/null +++ b/benchmark-programs/32-mix-1N-samekeybreak/match-output.txt @@ -0,0 +1,17 @@ +1:N Match with Same-Key Break + +Master Key Name Detail Item Amount + + 0 + 0 +*** BREAK 0 Count: 1 Total: 0 + + Total matches: 2 + Total unmatched: 0 + Total breaks: 1 + Valid records: 1 + Invalid records: 2 + Hash total (matched): 0 + Hash total (unmatched): 0 + Hash total (grand): 0 +Total matches: 00002 Breaks: 00001 Grand total: 000000000 diff --git a/benchmark-programs/33-mix-1N-diffkeybreak/README.md b/benchmark-programs/33-mix-1N-diffkeybreak/README.md new file mode 100644 index 0000000..38bc25a --- /dev/null +++ b/benchmark-programs/33-mix-1N-diffkeybreak/README.md @@ -0,0 +1,26 @@ +# 33-mix-1N-diffkeybreak — 1:N Matching with Different-Key Break + +## 电信业务场景 + +线路+类型混合切替。先做线路↔通话类型的关联，再检测通话类型的变化。用于不同通话类型(语音/SMS/数据)的计费切换。 + +## Purpose +Demonstrates 1:N matching pattern where the key break detection uses a different key field than the match key, showing master-to-detail transitions. + +## Test Coverage +1. **1:N matching** — One master (M0001) matched to three details +2. **Different-key break** — Key break is triggered by master ID change (M0001 -> M0002 -> M0003 -> M0004) +3. **Unmatched master ID** — Detail with M9999 has no matching master +4. **Summary per break** — Count and total per master ID group +5. **Final break** — Last group summary at end of file + +## Data +- 4 master records (M0001 through M0004) with names, types, amounts +- 10 detail records with master ID references + +## Key Techniques +- In-memory master table loaded at startup +- Key break on master ID field (different from detail transaction ID) +- Accumulator per break group +- Grand total across all groups +- Unmatched ID detection and reporting diff --git a/benchmark-programs/33-mix-1N-diffkeybreak/diff-detail.dat b/benchmark-programs/33-mix-1N-diffkeybreak/diff-detail.dat new file mode 100644 index 0000000..d2de7ea --- /dev/null +++ b/benchmark-programs/33-mix-1N-diffkeybreak/diff-detail.dat @@ -0,0 +1 @@ + 0000000 \ No newline at end of file diff --git a/benchmark-programs/33-mix-1N-diffkeybreak/diff-master.dat b/benchmark-programs/33-mix-1N-diffkeybreak/diff-master.dat new file mode 100644 index 0000000..876dd97 --- /dev/null +++ b/benchmark-programs/33-mix-1N-diffkeybreak/diff-master.dat @@ -0,0 +1 @@ + 0000000 \ No newline at end of file diff --git a/benchmark-programs/33-mix-1N-diffkeybreak/main-33-mix-1N-diffkeybreak.cbl b/benchmark-programs/33-mix-1N-diffkeybreak/main-33-mix-1N-diffkeybreak.cbl new file mode 100644 index 0000000..2e2374b --- /dev/null +++ b/benchmark-programs/33-mix-1N-diffkeybreak/main-33-mix-1N-diffkeybreak.cbl @@ -0,0 +1,888 @@ + *> ============================================================ + *> 33-mix-1N-diffkeybreak : 线路+类型切替 (Line+Type Change) + *> Input : FILE-MAST (diff-master.dat: 线路), FILE-DETL (diff-detail.dat: 类型) + *> Output: FILE-OUT (diff-match-output.txt: 切替检测结果) + *> AUDIT-OUT (audit-33.log: 审计跟踪) + *> Coverage: AM-N007, MT-R001 + *> Version : 2.0 — Expanded with audit, hash totals, FILE STATUS + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. Main33Mix1NDiffKeyBreak. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-MAST ASSIGN TO "diff-master.dat" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-MAST. + + SELECT FILE-DETL ASSIGN TO "diff-detail.dat" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-DETL. + + SELECT FILE-OUT ASSIGN TO "diff-match-output.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-OUT. + + SELECT AUDIT-OUT ASSIGN TO "audit-33.log" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-AUDIT. + + DATA DIVISION. + FILE SECTION. + FD FILE-MAST. + 01 MAST-REC. + 05 MAST-ID PIC X(05). + 05 MAST-NAME PIC X(20). + 05 MAST-TYPE PIC X(05). + 05 MAST-AMOUNT PIC 9(07). + + FD FILE-DETL. + 01 DETL-REC. + 05 DETL-MAST-ID PIC X(05). + 05 DETL-TRAN-ID PIC X(10). + 05 DETL-AMOUNT PIC 9(07). + + FD FILE-OUT. + 01 OUT-REC. + 05 OUT-LINE PIC X(80). + + FD AUDIT-OUT. + 01 AUDIT-REC. + 05 AUDIT-LINE PIC X(120). + + WORKING-STORAGE SECTION. + 01 WS-TELECOM-REC. + COPY "telecom/TEL-BILLING.cpy". + + *> ============================================================ + *> FILE STATUS fields + *> ============================================================ + 01 FS-MAST PIC X(02) VALUE "00". + 01 FS-DETL PIC X(02) VALUE "00". + 01 FS-OUT PIC X(02) VALUE "00". + 01 FS-AUDIT PIC X(02) VALUE "00". + + *> ============================================================ + *> End-of-file flags + *> ============================================================ + 01 WS-EOF-MAST PIC X(01) VALUE "N". + 88 MAST-EOF VALUE "Y". + 01 WS-EOF-DETL PIC X(01) VALUE "N". + 88 DETL-EOF VALUE "Y". + + *> ============================================================ + *> Key break fields (diff-key: master ID vs detail master ID) + *> ============================================================ + 01 WS-PREV-MAST-ID PIC X(05). + 01 WS-CURR-MAST-ID PIC X(05). + 01 WS-MASTER-FOUND PIC X(01) VALUE "N". + + *> ============================================================ + *> Core counters + *> ============================================================ + 01 WS-MATCH-COUNT PIC 9(05) VALUE 0. + 01 WS-BREAK-COUNT PIC 9(05) VALUE 0. + 01 WS-DETAIL-COUNT PIC 9(05) VALUE 0. + 01 WS-BREAK-TOTAL PIC 9(09) VALUE 0. + 01 WS-GRAND-TOTAL PIC 9(09) VALUE 0. + + *> ============================================================ + *> Expanded counters: match path, unmatched path, break path + *> ============================================================ + 01 WS-MATCH-PATH-CNT PIC 9(05) VALUE 0. + 01 WS-UNMATCH-CNT PIC 9(05) VALUE 0. + 01 WS-BREAK-PATH-CNT PIC 9(05) VALUE 0. + 01 WS-VALID-COUNT PIC 9(05) VALUE 0. + 01 WS-INVALID-COUNT PIC 9(05) VALUE 0. + 01 WS-TOTAL-RECORDS PIC 9(05) VALUE 0. + + *> ============================================================ + *> Hash totals per category + *> ============================================================ + 01 WS-HASH-MATCHED PIC 9(11) VALUE 0. + 01 WS-HASH-UNMATCHED PIC 9(11) VALUE 0. + 01 WS-HASH-BREAK PIC 9(11) VALUE 0. + 01 WS-HASH-GRAND PIC 9(11) VALUE 0. + + *> ============================================================ + *> Master fields from lookup + *> ============================================================ + 01 WS-MASTER-NAME PIC X(20). + 01 WS-MASTER-TYPE PIC X(05). + 01 WS-MASTER-AMT PIC 9(07). + + *> ============================================================ + *> Master table loaded into memory + *> ============================================================ + 01 MASTER-TABLE. + 05 MASTER-ENTRY OCCURS 8 TIMES. + 10 ME-ID PIC X(05). + 10 ME-NAME PIC X(20). + 10 ME-TYPE PIC X(05). + 10 ME-AMT PIC 9(07). + + 01 IDX PIC 9(02). + 01 MAST-IDX PIC 9(02). + 01 WS-MAST-COUNT PIC 9(02). + + *> ============================================================ + *> Timestamp and batch control + *> ============================================================ + 01 WS-TIMESTAMP. + 05 WS-TS-DATE PIC X(08). + 05 FILLER PIC X(01) VALUE SPACE. + 05 WS-TS-TIME PIC X(08). + + 01 WS-BATCH-ID PIC X(08) VALUE "BATCH033". + 01 WS-BATCH-START PIC X(16). + 01 WS-BATCH-END PIC X(16). + 01 WS-PROGRAM-NAME PIC X(30) VALUE + "Main33Mix1NDiffKeyBreak". + + *> ============================================================ + *> Error severity levels + *> ============================================================ + 01 WS-ERROR-SEVERITY. + 05 WS-ERR-LEVEL PIC X(01). + 88 ERR-INFO VALUE "I". + 88 ERR-WARN VALUE "W". + 88 ERR-ERROR VALUE "E". + 88 ERR-CRITICAL VALUE "C". + + 01 WS-ERROR-MESSAGE PIC X(80). + 01 WS-ERR-COUNT-INFO PIC 9(03) VALUE 0. + 01 WS-ERR-COUNT-WARN PIC 9(03) VALUE 0. + 01 WS-ERR-COUNT-ERROR PIC 9(03) VALUE 0. + 01 WS-ERR-COUNT-CRIT PIC 9(03) VALUE 0. + + *> ============================================================ + *> FILE STATUS trace buffer + *> ============================================================ + 01 WS-FS-TRACE PIC X(40). + 01 WS-FS-EXPECTED PIC X(02) VALUE "00". + + *> ============================================================ + *> Audit line templates + *> ============================================================ + 01 WS-AUDIT-HEADER. + 05 FILLER PIC X(08) VALUE "AUDIT ". + 05 FILLER PIC X(01) VALUE SPACE. + 05 AH-PGM PIC X(30). + 05 FILLER PIC X(01) VALUE SPACE. + 05 AH-BATCH PIC X(08). + 05 FILLER PIC X(01) VALUE SPACE. + 05 AH-TIMESTAMP PIC X(17). + + 01 WS-AUDIT-ENTRY. + 05 FILLER PIC X(08) VALUE " ENTRY ". + 05 AE-TEXT PIC X(72). + + 01 WS-AUDIT-STATS. + 05 FILLER PIC X(08) VALUE " STATS ". + 05 AS-TEXT PIC X(72). + + 01 WS-AUDIT-ERROR. + 05 FILLER PIC X(08) VALUE " ERROR ". + 05 AE-LEVEL PIC X(01). + 05 FILLER PIC X(01) VALUE SPACE. + 05 AE-MSG PIC X(70). + + *> ============================================================ + *> Hybrid processing trace fields + *> ============================================================ + 01 WS-HYBRID-TRACE. + 05 HT-EVENT PIC X(20). + 05 HT-MAST-ID PIC X(05). + 05 HT-DETL-ID PIC X(10). + 05 HT-AMOUNT PIC 9(07). + 05 HT-RESULT PIC X(10). + + 01 WS-TRACE-LINE. + 05 FILLER PIC X(03) VALUE "[TR]". + 05 TL-EVENT PIC X(20). + 05 FILLER PIC X(01) VALUE SPACE. + 05 TL-MAST-ID PIC X(05). + 05 FILLER PIC X(01) VALUE SPACE. + 05 TL-DETL-ID PIC X(10). + 05 FILLER PIC X(01) VALUE SPACE. + 05 TL-AMOUNT PIC Z(9)9. + 05 FILLER PIC X(01) VALUE SPACE. + 05 TL-RESULT PIC X(10). + + *> ============================================================ + *> Output line templates (preserved from original) + *> ============================================================ + 01 WS-HEADER1. + 05 FILLER PIC X(40) VALUE + "MasterID Name ". + 05 FILLER PIC X(40) VALUE + "Trans ID Amount". + + 01 WS-MATCH-LINE. + 05 FILLER PIC X(02) VALUE " ". + 05 ML-MAST-ID PIC X(05). + 05 FILLER PIC X(02) VALUE SPACES. + 05 ML-NAME PIC X(20). + 05 FILLER PIC X(02) VALUE SPACES. + 05 ML-TRAN-ID PIC X(10). + 05 FILLER PIC X(02) VALUE SPACES. + 05 ML-AMOUNT PIC Z(9)9. + + 01 WS-BREAK-LINE. + 05 FILLER PIC X(10) VALUE ">> BREAK: ". + 05 BL-MAST-ID PIC X(05). + 05 FILLER PIC X(10) VALUE " -> ". + 05 BL-DETL-ID PIC X(05). + 05 FILLER PIC X(10) VALUE " Count: ". + 05 BL-COUNT PIC Z(9). + 05 FILLER PIC X(10) VALUE " Total: ". + 05 BL-TOTAL PIC Z(9)9. + + 01 WS-UNMATCHED-LINE. + 05 FILLER PIC X(20) VALUE " UNMATCHED master ". + 05 UL-MAST-ID PIC X(05). + + *> ============================================================ + *> Report totals template + *> ============================================================ + 01 WS-REPORT-LINE. + 05 FILLER PIC X(02) VALUE SPACES. + 05 RL-LABEL PIC X(30). + 05 FILLER PIC X(02) VALUE SPACES. + 05 RL-VALUE PIC Z(9)9. + + 01 WS-HASH-LINE. + 05 FILLER PIC X(02) VALUE SPACES. + 05 HL-LABEL PIC X(30). + 05 FILLER PIC X(02) VALUE SPACES. + 05 HL-VALUE PIC Z(10)9. + + *> ============================================================ + *> Temporary work fields + *> ============================================================ + 01 WS-TEMP-AMOUNT PIC 9(09). + 01 WS-TEMP-COUNT PIC 9(05). + 01 WS-TEMP-HASH PIC 9(11). + + PROCEDURE DIVISION. + MAIN-PROCEDURE. + + PERFORM 1000-INIT. + PERFORM 2000-OPEN-FILES. + PERFORM 3000-PROCESS. + PERFORM 4000-REPORT. + PERFORM 5000-AUDIT. + PERFORM 9000-EXIT. + + STOP RUN. + + *> ============================================================ + *> 1000-INIT : Initialise batch, timestamp, counters + *> ============================================================ + 1000-INIT. + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-TS-DATE. + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-TS-TIME. + MOVE WS-TS-DATE TO WS-BATCH-START(1:8). + MOVE WS-TS-TIME TO WS-BATCH-START(9:8). + + MOVE 0 TO WS-MATCH-COUNT. + MOVE 0 TO WS-MATCH-PATH-CNT. + MOVE 0 TO WS-UNMATCH-CNT. + MOVE 0 TO WS-BREAK-PATH-CNT. + MOVE 0 TO WS-BREAK-COUNT. + MOVE 0 TO WS-VALID-COUNT. + MOVE 0 TO WS-INVALID-COUNT. + MOVE 0 TO WS-TOTAL-RECORDS. + MOVE 0 TO WS-GRAND-TOTAL. + MOVE 0 TO WS-HASH-MATCHED. + MOVE 0 TO WS-HASH-UNMATCHED. + MOVE 0 TO WS-HASH-BREAK. + MOVE 0 TO WS-HASH-GRAND. + MOVE 0 TO WS-ERR-COUNT-INFO. + MOVE 0 TO WS-ERR-COUNT-WARN. + MOVE 0 TO WS-ERR-COUNT-ERROR. + MOVE 0 TO WS-ERR-COUNT-CRIT. + + DISPLAY "[" WS-TS-DATE " " WS-TS-TIME "] " + WS-PROGRAM-NAME " starting, batch=" + WS-BATCH-ID. + + *> ============================================================ + *> 2000-OPEN-FILES : Open all files with FILE STATUS checks + *> ============================================================ + 2000-OPEN-FILES. + OPEN OUTPUT FILE-OUT. + MOVE FS-OUT TO WS-FS-TRACE. + IF FS-OUT NOT = "00" + MOVE "E" TO WS-ERR-LEVEL + STRING "FILE-OUT open failed FS=" FS-OUT + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF. + + OPEN OUTPUT AUDIT-OUT. + MOVE FS-AUDIT TO WS-FS-TRACE. + IF FS-AUDIT NOT = "00" + MOVE "E" TO WS-ERR-LEVEL + STRING "AUDIT-OUT open failed FS=" FS-AUDIT + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF. + + MOVE SPACES TO WS-AUDIT-HEADER. + MOVE WS-PROGRAM-NAME TO AH-PGM. + MOVE WS-BATCH-ID TO AH-BATCH. + STRING WS-TS-DATE " " WS-TS-TIME + DELIMITED BY SIZE INTO AH-TIMESTAMP. + MOVE WS-AUDIT-HEADER TO AUDIT-REC. + WRITE AUDIT-REC. + MOVE FS-AUDIT TO WS-FS-TRACE. + IF FS-AUDIT NOT = "00" + DISPLAY "Warning: AUDIT write failed FS=" FS-AUDIT + END-IF. + + *> Load master table into memory + PERFORM LOAD-MASTER-TABLE. + + MOVE "1:N Match with Different-Key Break" TO OUT-REC. + WRITE OUT-REC. + MOVE SPACES TO OUT-REC. + WRITE OUT-REC. + MOVE WS-HEADER1 TO OUT-REC. + WRITE OUT-REC. + MOVE SPACES TO OUT-REC. + WRITE OUT-REC. + MOVE SPACES TO WS-AUDIT-ENTRY. + STRING "Header written, master table size=" WS-MAST-COUNT + DELIMITED BY SIZE INTO AE-TEXT. + MOVE WS-AUDIT-ENTRY TO AUDIT-REC. + WRITE AUDIT-REC. + + *> ============================================================ + *> 3000-PROCESS : Main processing loop + *> ============================================================ + 3000-PROCESS. + *> Process details - master and detail keys may differ + OPEN INPUT FILE-DETL. + IF FS-DETL NOT = "00" + MOVE "E" TO WS-ERR-LEVEL + STRING "FILE-DETL open failed FS=" FS-DETL + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF. + + MOVE 'N' TO WS-EOF-DETL. + MOVE 0 TO WS-MATCH-COUNT. + MOVE 0 TO WS-BREAK-COUNT. + MOVE 0 TO WS-GRAND-TOTAL. + MOVE SPACES TO WS-PREV-MAST-ID. + + MOVE "I" TO WS-ERR-LEVEL. + MOVE "Detail processing started (diff-key)" TO + WS-ERROR-MESSAGE. + PERFORM 6000-ERROR-HANDLE. + + PERFORM UNTIL DETL-EOF + READ FILE-DETL INTO DETL-REC + AT END + SET DETL-EOF TO TRUE + PERFORM HANDLE-FINAL-BREAK + NOT AT END + PERFORM PROCESS-DETAIL + END-READ + MOVE FS-DETL TO WS-FS-TRACE + IF NOT DETL-EOF AND FS-DETL NOT = "00" + MOVE "E" TO WS-ERR-LEVEL + STRING "FILE-DETL read failed FS=" FS-DETL + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF + END-PERFORM. + + CLOSE FILE-DETL. + IF FS-DETL NOT = "00" + MOVE "W" TO WS-ERR-LEVEL + STRING "FILE-DETL close FS=" FS-DETL + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF. + + *> ============================================================ + *> 3100-VALIDATE : Validate detail record fields + *> ============================================================ + 3100-VALIDATE. + ADD 1 TO WS-TOTAL-RECORDS. + + *> Validate master-ID not empty + IF DETL-MAST-ID = SPACES OR ZERO + ADD 1 TO WS-INVALID-COUNT + MOVE "W" TO WS-ERR-LEVEL + STRING "Empty master-id at record " + WS-TOTAL-RECORDS INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + EXIT PARAGRAPH + END-IF. + + *> Validate trans-ID not empty + IF DETL-TRAN-ID = SPACES OR ZERO + ADD 1 TO WS-INVALID-COUNT + MOVE "W" TO WS-ERR-LEVEL + STRING "Empty trans-id for master " + DETL-MAST-ID INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + EXIT PARAGRAPH + END-IF. + + *> Validate amount within range + IF DETL-AMOUNT = 0 + ADD 1 TO WS-INVALID-COUNT + MOVE "I" TO WS-ERR-LEVEL + STRING "Zero amount for master " DETL-MAST-ID + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF. + + *> Validate amount not exceeding threshold + IF DETL-AMOUNT > 9999999 + ADD 1 TO WS-INVALID-COUNT + MOVE "W" TO WS-ERR-LEVEL + STRING "Large amount " DETL-AMOUNT + " for master " DETL-MAST-ID + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF. + + *> Cross-check: master ID length + IF DETL-MAST-ID (1:1) = SPACE + ADD 1 TO WS-INVALID-COUNT + MOVE "W" TO WS-ERR-LEVEL + STRING "Short master-ID " DETL-MAST-ID + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + EXIT PARAGRAPH + END-IF. + + ADD 1 TO WS-VALID-COUNT. + + *> ============================================================ + *> 3200-CALCULATE : Accumulate hash totals per category + *> ============================================================ + 3200-CALCULATE. + IF WS-MASTER-FOUND = "Y" + ADD DETL-AMOUNT TO WS-HASH-MATCHED + ELSE + ADD DETL-AMOUNT TO WS-HASH-UNMATCHED + END-IF. + + ADD DETL-AMOUNT TO WS-HASH-GRAND. + + *> Cross-check hash consistency + COMPUTE WS-TEMP-HASH = + WS-HASH-MATCHED + WS-HASH-UNMATCHED. + IF WS-TEMP-HASH NOT = WS-HASH-GRAND + MOVE "W" TO WS-ERR-LEVEL + STRING "Hash mismatch: " + WS-HASH-GRAND " vs " WS-TEMP-HASH + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF. + + *> ============================================================ + *> 3300-FORMAT-OUTPUT : Format output with hybrid trace + *> ============================================================ + 3300-FORMAT-OUTPUT. + MOVE SPACES TO WS-AUDIT-ENTRY. + IF WS-MASTER-FOUND = "Y" + STRING "MATCH mid=" WS-CURR-MAST-ID + " tran=" DETL-TRAN-ID + " amt=" DETL-AMOUNT + DELIMITED BY SIZE INTO AE-TEXT + ELSE + STRING "UNMATCH mid=" WS-CURR-MAST-ID + " tran=" DETL-TRAN-ID + " amt=" DETL-AMOUNT + DELIMITED BY SIZE INTO AE-TEXT + END-IF. + MOVE WS-AUDIT-ENTRY TO AUDIT-REC. + WRITE AUDIT-REC. + + *> ============================================================ + *> 3400-WRITE-OUTPUT : Write record + FILE STATUS check + *> ============================================================ + 3400-WRITE-OUTPUT. + MOVE FS-OUT TO WS-FS-TRACE. + IF FS-OUT NOT = "00" + MOVE "E" TO WS-ERR-LEVEL + STRING "FILE-OUT write failed FS=" FS-OUT + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF. + + *> ============================================================ + *> 4000-REPORT : Write summary report to output and audit + *> ============================================================ + 4000-REPORT. + MOVE SPACES TO OUT-REC. + WRITE OUT-REC. + PERFORM 3400-WRITE-OUTPUT. + + MOVE SPACES TO WS-REPORT-LINE. + MOVE "Total matches:" TO RL-LABEL. + MOVE WS-MATCH-COUNT TO RL-VALUE. + MOVE WS-REPORT-LINE TO OUT-REC. + WRITE OUT-REC. + PERFORM 3400-WRITE-OUTPUT. + + MOVE SPACES TO WS-REPORT-LINE. + MOVE "Total unmatched:" TO RL-LABEL. + MOVE WS-UNMATCH-CNT TO RL-VALUE. + MOVE WS-REPORT-LINE TO OUT-REC. + WRITE OUT-REC. + PERFORM 3400-WRITE-OUTPUT. + + MOVE SPACES TO WS-REPORT-LINE. + MOVE "Total breaks:" TO RL-LABEL. + MOVE WS-BREAK-COUNT TO RL-VALUE. + MOVE WS-REPORT-LINE TO OUT-REC. + WRITE OUT-REC. + PERFORM 3400-WRITE-OUTPUT. + + MOVE SPACES TO WS-REPORT-LINE. + MOVE "Valid records:" TO RL-LABEL. + MOVE WS-VALID-COUNT TO RL-VALUE. + MOVE WS-REPORT-LINE TO OUT-REC. + WRITE OUT-REC. + PERFORM 3400-WRITE-OUTPUT. + + MOVE SPACES TO WS-REPORT-LINE. + MOVE "Invalid records:" TO RL-LABEL. + MOVE WS-INVALID-COUNT TO RL-VALUE. + MOVE WS-REPORT-LINE TO OUT-REC. + WRITE OUT-REC. + PERFORM 3400-WRITE-OUTPUT. + + MOVE SPACES TO WS-HASH-LINE. + MOVE "Hash total (matched):" TO HL-LABEL. + MOVE WS-HASH-MATCHED TO HL-VALUE. + MOVE WS-HASH-LINE TO OUT-REC. + WRITE OUT-REC. + PERFORM 3400-WRITE-OUTPUT. + + MOVE SPACES TO WS-HASH-LINE. + MOVE "Hash total (unmatched):" TO HL-LABEL. + MOVE WS-HASH-UNMATCHED TO HL-VALUE. + MOVE WS-HASH-LINE TO OUT-REC. + WRITE OUT-REC. + PERFORM 3400-WRITE-OUTPUT. + + MOVE SPACES TO WS-HASH-LINE. + MOVE "Hash total (grand):" TO HL-LABEL. + MOVE WS-HASH-GRAND TO HL-VALUE. + MOVE WS-HASH-LINE TO OUT-REC. + WRITE OUT-REC. + PERFORM 3400-WRITE-OUTPUT. + + STRING "Total matches: " WS-MATCH-COUNT + " Breaks: " WS-BREAK-COUNT + " Grand total: " WS-GRAND-TOTAL + DELIMITED BY SIZE INTO OUT-REC. + WRITE OUT-REC. + PERFORM 3400-WRITE-OUTPUT. + + MOVE SPACES TO WS-AUDIT-ENTRY. + STRING "REPORT: match=" WS-MATCH-COUNT + " unmatched=" WS-UNMATCH-CNT + " break=" WS-BREAK-COUNT + " valid=" WS-VALID-COUNT + " invalid=" WS-INVALID-COUNT + " grand=" WS-GRAND-TOTAL + " hashG=" WS-HASH-GRAND + DELIMITED BY SIZE INTO AE-TEXT. + MOVE WS-AUDIT-ENTRY TO AUDIT-REC. + WRITE AUDIT-REC. + + MOVE SPACES TO WS-AUDIT-ENTRY. + STRING "ERRORS: info=" WS-ERR-COUNT-INFO + " warn=" WS-ERR-COUNT-WARN + " error=" WS-ERR-COUNT-ERROR + " crit=" WS-ERR-COUNT-CRIT + DELIMITED BY SIZE INTO AE-TEXT. + MOVE WS-AUDIT-ENTRY TO AUDIT-REC. + WRITE AUDIT-REC. + + *> ============================================================ + *> 5000-AUDIT : Write final audit summary, close audit file + *> ============================================================ + 5000-AUDIT. + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-TS-DATE. + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-TS-TIME. + MOVE WS-TS-DATE TO WS-BATCH-END(1:8). + MOVE WS-TS-TIME TO WS-BATCH-END(9:8). + + MOVE SPACES TO WS-AUDIT-STATS. + STRING "Batch " WS-BATCH-ID + " ended " WS-BATCH-END + DELIMITED BY SIZE INTO AS-TEXT. + MOVE WS-AUDIT-STATS TO AUDIT-REC. + WRITE AUDIT-REC. + + MOVE SPACES TO WS-AUDIT-STATS. + STRING "Records total=" WS-TOTAL-RECORDS + " match=" WS-MATCH-PATH-CNT + " break=" WS-BREAK-PATH-CNT + DELIMITED BY SIZE INTO AS-TEXT. + MOVE WS-AUDIT-STATS TO AUDIT-REC. + WRITE AUDIT-REC. + + MOVE SPACES TO WS-AUDIT-STATS. + STRING "Hash matched=" WS-HASH-MATCHED + " unmatched=" WS-HASH-UNMATCHED + " grand=" WS-HASH-GRAND + DELIMITED BY SIZE INTO AS-TEXT. + MOVE WS-AUDIT-STATS TO AUDIT-REC. + WRITE AUDIT-REC. + + CLOSE AUDIT-OUT. + IF FS-AUDIT NOT = "00" + DISPLAY "Warning: AUDIT close FS=" FS-AUDIT + END-IF. + + *> ============================================================ + *> LOAD-MASTER-TABLE (original logic preserved, expanded) + *> ============================================================ + LOAD-MASTER-TABLE. + OPEN INPUT FILE-MAST. + IF FS-MAST NOT = "00" + MOVE "E" TO WS-ERR-LEVEL + STRING "FILE-MAST open failed FS=" FS-MAST + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF. + + MOVE 0 TO WS-MAST-COUNT. + PERFORM VARYING IDX FROM 1 BY 1 UNTIL IDX > 8 + READ FILE-MAST INTO MAST-REC + AT END EXIT PERFORM + END-READ + MOVE FS-MAST TO WS-FS-TRACE + IF FS-MAST NOT = "00" AND FS-MAST NOT = "10" + MOVE "W" TO WS-ERR-LEVEL + STRING "FILE-MAST read idx=" IDX + " FS=" FS-MAST INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF + MOVE MAST-ID TO ME-ID(IDX) + MOVE MAST-NAME TO ME-NAME(IDX) + MOVE MAST-TYPE TO ME-TYPE(IDX) + MOVE MAST-AMOUNT TO ME-AMT(IDX) + ADD 1 TO WS-MAST-COUNT + END-PERFORM. + + CLOSE FILE-MAST. + MOVE FS-MAST TO WS-FS-TRACE. + IF FS-MAST NOT = "00" + MOVE "W" TO WS-ERR-LEVEL + STRING "FILE-MAST close FS=" FS-MAST + INTO WS-ERROR-MESSAGE + PERFORM 6000-ERROR-HANDLE + END-IF. + + DISPLAY "Master table loaded: " WS-MAST-COUNT " entries". + + MOVE SPACES TO WS-AUDIT-ENTRY. + STRING "LOAD-MASTER: " WS-MAST-COUNT " entries loaded" + DELIMITED BY SIZE INTO AE-TEXT. + MOVE WS-AUDIT-ENTRY TO AUDIT-REC. + WRITE AUDIT-REC. + + *> ============================================================ + *> PROCESS-DETAIL (original logic preserved, expanded) + *> ============================================================ + PROCESS-DETAIL. + *> Run validation + PERFORM 3100-VALIDATE. + + *> Record the current master ID from detail + MOVE DETL-MAST-ID TO WS-CURR-MAST-ID. + + *> Check for key break (master ID changes) + IF WS-CURR-MAST-ID NOT = WS-PREV-MAST-ID + IF WS-PREV-MAST-ID NOT = SPACES + ADD 1 TO WS-BREAK-PATH-CNT + PERFORM HANDLE-KEY-BREAK + END-IF + MOVE WS-CURR-MAST-ID TO WS-PREV-MAST-ID + MOVE 0 TO WS-DETAIL-COUNT + MOVE 0 TO WS-BREAK-TOTAL + + MOVE SPACES TO WS-AUDIT-ENTRY + STRING "KEYBREAK: prev=" WS-PREV-MAST-ID + " curr=" WS-CURR-MAST-ID + DELIMITED BY SIZE INTO AE-TEXT + MOVE WS-AUDIT-ENTRY TO AUDIT-REC + WRITE AUDIT-REC + END-IF. + + *> Hybrid processing trace: record event + MOVE SPACES TO WS-TRACE-LINE. + MOVE "LOOKUP" TO TL-EVENT. + MOVE WS-CURR-MAST-ID TO TL-MAST-ID. + MOVE DETL-TRAN-ID TO TL-DETL-ID. + MOVE DETL-AMOUNT TO TL-AMOUNT. + + *> Find matching master + MOVE "N" TO WS-MASTER-FOUND. + PERFORM VARYING MAST-IDX FROM 1 BY 1 + UNTIL MAST-IDX > WS-MAST-COUNT + IF ME-ID(MAST-IDX) = WS-CURR-MAST-ID + MOVE "Y" TO WS-MASTER-FOUND + MOVE ME-NAME(MAST-IDX) TO WS-MASTER-NAME + MOVE ME-TYPE(MAST-IDX) TO WS-MASTER-TYPE + MOVE ME-AMT(MAST-IDX) TO WS-MASTER-AMT + END-IF + END-PERFORM. + + *> Perform hash accumulation (3200) + PERFORM 3200-CALCULATE. + + *> Hybrid processing trace: record match result + IF WS-MASTER-FOUND = "Y" + MOVE "MATCH" TO TL-RESULT + DISPLAY "[TR] LOOKUP " WS-CURR-MAST-ID " " + DETL-TRAN-ID " " DETL-AMOUNT " MATCH" + ELSE + MOVE "UNMATCH" TO TL-RESULT + DISPLAY "[TR] LOOKUP " WS-CURR-MAST-ID " " + DETL-TRAN-ID " " DETL-AMOUNT " UNMATCH" + END-IF. + + IF WS-MASTER-FOUND = "Y" + ADD 1 TO WS-MATCH-COUNT + ADD 1 TO WS-MATCH-PATH-CNT + ADD 1 TO WS-DETAIL-COUNT + ADD DETL-AMOUNT TO WS-BREAK-TOTAL + ADD DETL-AMOUNT TO WS-GRAND-TOTAL + + MOVE WS-CURR-MAST-ID TO ML-MAST-ID + MOVE WS-MASTER-NAME TO ML-NAME + MOVE DETL-TRAN-ID TO ML-TRAN-ID + MOVE DETL-AMOUNT TO ML-AMOUNT + DISPLAY " " WS-MATCH-LINE + MOVE WS-MATCH-LINE TO OUT-REC + WRITE OUT-REC + PERFORM 3400-WRITE-OUTPUT + ELSE + ADD 1 TO WS-UNMATCH-CNT + MOVE WS-CURR-MAST-ID TO UL-MAST-ID + DISPLAY " " WS-UNMATCHED-LINE + MOVE WS-UNMATCHED-LINE TO OUT-REC + WRITE OUT-REC + PERFORM 3400-WRITE-OUTPUT + END-IF. + + *> Audit trace for this detail + PERFORM 3300-FORMAT-OUTPUT. + + *> ============================================================ + *> HANDLE-KEY-BREAK (original logic preserved, expanded) + *> ============================================================ + HANDLE-KEY-BREAK. + ADD 1 TO WS-BREAK-COUNT. + MOVE WS-PREV-MAST-ID TO BL-MAST-ID. + MOVE WS-CURR-MAST-ID TO BL-DETL-ID. + MOVE WS-DETAIL-COUNT TO BL-COUNT. + MOVE WS-BREAK-TOTAL TO BL-TOTAL. + ADD WS-BREAK-TOTAL TO WS-HASH-BREAK. + DISPLAY " " WS-BREAK-LINE. + MOVE WS-BREAK-LINE TO OUT-REC. + WRITE OUT-REC. + PERFORM 3400-WRITE-OUTPUT. + + *> Hybrid processing trace for break + DISPLAY "[TR] BREAK " WS-PREV-MAST-ID " -> " + WS-CURR-MAST-ID " count=" WS-DETAIL-COUNT + " total=" WS-BREAK-TOTAL. + + MOVE SPACES TO WS-AUDIT-ENTRY. + STRING "BREAK: prev=" WS-PREV-MAST-ID + " curr=" WS-CURR-MAST-ID + " count=" WS-DETAIL-COUNT + " total=" WS-BREAK-TOTAL + DELIMITED BY SIZE INTO AE-TEXT. + MOVE WS-AUDIT-ENTRY TO AUDIT-REC. + WRITE AUDIT-REC. + + *> ============================================================ + *> HANDLE-FINAL-BREAK (original logic preserved, expanded) + *> ============================================================ + HANDLE-FINAL-BREAK. + IF WS-PREV-MAST-ID NOT = SPACES + ADD 1 TO WS-BREAK-PATH-CNT + PERFORM HANDLE-KEY-BREAK + END-IF. + + MOVE SPACES TO WS-AUDIT-ENTRY. + STRING "FINAL-BREAK: total count=" WS-BREAK-COUNT + DELIMITED BY SIZE INTO AE-TEXT. + MOVE WS-AUDIT-ENTRY TO AUDIT-REC. + WRITE AUDIT-REC. + + *> ============================================================ + *> 6000-ERROR-HANDLE : Centralized error handling by severity + *> ============================================================ + 6000-ERROR-HANDLE. + EVALUATE WS-ERR-LEVEL + WHEN "I" + ADD 1 TO WS-ERR-COUNT-INFO + DISPLAY "INFO: " WS-ERROR-MESSAGE + WHEN "W" + ADD 1 TO WS-ERR-COUNT-WARN + DISPLAY "WARN: " WS-ERROR-MESSAGE + WHEN "E" + ADD 1 TO WS-ERR-COUNT-ERROR + DISPLAY "ERROR: " WS-ERROR-MESSAGE + WHEN "C" + ADD 1 TO WS-ERR-COUNT-CRIT + DISPLAY "CRITICAL: " WS-ERROR-MESSAGE + MOVE WS-ERROR-MESSAGE TO OUT-REC + WRITE OUT-REC + MOVE SPACES TO WS-AUDIT-ERROR + MOVE "C" TO AE-LEVEL + STRING "ABORT: " WS-ERROR-MESSAGE + DELIMITED BY SIZE INTO AE-MSG + MOVE WS-AUDIT-ERROR TO AUDIT-REC + WRITE AUDIT-REC + CLOSE FILE-OUT + CLOSE AUDIT-OUT + STOP RUN + WHEN OTHER + DISPLAY "UNKNOWN: " WS-ERROR-MESSAGE + END-EVALUATE. + + *> Write error to audit log + MOVE SPACES TO WS-AUDIT-ERROR. + MOVE WS-ERR-LEVEL TO AE-LEVEL. + MOVE WS-ERROR-MESSAGE TO AE-MSG. + MOVE WS-AUDIT-ERROR TO AUDIT-REC. + WRITE AUDIT-REC. + + *> ============================================================ + *> 9000-EXIT : Close files and terminate + *> ============================================================ + 9000-EXIT. + MOVE FUNCTION CURRENT-DATE (1:8) TO WS-TS-DATE. + MOVE FUNCTION CURRENT-DATE (9:8) TO WS-TS-TIME. + MOVE WS-TS-DATE TO WS-BATCH-END(1:8). + MOVE WS-TS-TIME TO WS-BATCH-END(9:8). + + DISPLAY "[" WS-TS-DATE " " WS-TS-TIME "] " + WS-PROGRAM-NAME " ending, batch=" WS-BATCH-ID. + + CLOSE FILE-OUT. + IF FS-OUT NOT = "00" + DISPLAY "Warning: FILE-OUT close FS=" FS-OUT + END-IF. + + DISPLAY "Output written to diff-match-output.txt". + DISPLAY "Audit written to audit-33.log". diff --git a/benchmark-programs/34-sort/.tmp-runtime-34-sort/SORT-WORK.TMP b/benchmark-programs/34-sort/.tmp-runtime-34-sort/SORT-WORK.TMP new file mode 100644 index 0000000..f9017b3 --- /dev/null +++ b/benchmark-programs/34-sort/.tmp-runtime-34-sort/SORT-WORK.TMP @@ -0,0 +1 @@ + 00000 \ No newline at end of file diff --git a/benchmark-programs/34-sort/.tmp-runtime-34-sort/SORT-WORK2.TMP b/benchmark-programs/34-sort/.tmp-runtime-34-sort/SORT-WORK2.TMP new file mode 100644 index 0000000..0cbc90d --- /dev/null +++ b/benchmark-programs/34-sort/.tmp-runtime-34-sort/SORT-WORK2.TMP @@ -0,0 +1 @@ + 00000000000000000 \ No newline at end of file diff --git a/benchmark-programs/34-sort/README.md b/benchmark-programs/34-sort/README.md new file mode 100644 index 0000000..8058976 --- /dev/null +++ b/benchmark-programs/34-sort/README.md @@ -0,0 +1,30 @@ +# 34-sort — SORT Processing Program + +## 电信业务场景 + +CDR排序。使用SORT语句对CDR明细进行排序(按主叫号码升序/降序、通话时长多键排序)，支持INPUT/OUTPUT PROCEDURE。 + +## Purpose +Comprehensive demonstration of COBOL SORT statement capabilities, covering SR-N001 through SR-N010. + +## Test Coverage +| ID | Test | Description | +|----|------|-------------| +| SR-N001 | Ascending SORT | USING INPUT-FILE / GIVING OUTPUT-FILE, ASCENDING KEY | +| SR-N002 | Descending SORT | DESCENDING KEY sort | +| SR-N003 | Multi-key SORT | ASCENDING KEY + DESCENDING KEY (mixed) | +| SR-N004 | INPUT PROCEDURE | FILTER-INPUT section, only records with VALUE > 200 | +| SR-N005 | OUTPUT PROCEDURE | SUMMARIZE-OUTPUT with key break totals | +| SR-N006 | 0-record SORT | Empty input file | +| SR-N007 | 1-record SORT | Single record input | +| SR-N008 | INPUT/OUTPUT PROCEDURE | Both procedures combined with editing | +| SR-N009 | Duplicate key SORT | Three records with same key (stability check) | +| SR-N010 | Descending multi-key | DESCENDING + ASCENDING combined | + +## Key Techniques +- SORT USING/GIVING +- INPUT PROCEDURE / OUTPUT PROCEDURE +- ASCENDING KEY / DESCENDING KEY +- RELEASE statement (input procedure) +- RETURN statement (output procedure) +- Key break processing in output procedure diff --git a/benchmark-programs/34-sort/SORT-WORK.TMP b/benchmark-programs/34-sort/SORT-WORK.TMP new file mode 100644 index 0000000..f9017b3 --- /dev/null +++ b/benchmark-programs/34-sort/SORT-WORK.TMP @@ -0,0 +1 @@ + 00000 \ No newline at end of file diff --git a/benchmark-programs/34-sort/SORT-WORK2.TMP b/benchmark-programs/34-sort/SORT-WORK2.TMP new file mode 100644 index 0000000..0cbc90d --- /dev/null +++ b/benchmark-programs/34-sort/SORT-WORK2.TMP @@ -0,0 +1 @@ + 00000000000000000 \ No newline at end of file diff --git a/benchmark-programs/34-sort/main-34-sort.cbl b/benchmark-programs/34-sort/main-34-sort.cbl new file mode 100644 index 0000000..3dfa00f --- /dev/null +++ b/benchmark-programs/34-sort/main-34-sort.cbl @@ -0,0 +1,1444 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. Main34Sort. + *> ============================================================ + *> 34-sort : CDR排序 (CDR Sorting before Billing) + *> Input : sort-input.dat (未排序CDR明细) + *> Output: sort-output.dat (按客户/时间排序CDR) + *> Summary: sort-summary.txt (排序结果汇总) + *> Stats : sort-stats.txt (排序统计) + *> Audit : sort-audit.txt (审计跟踪) + *> Report : sort-report.txt (多层断点汇总报告) + *> Coverage: SR-N001~N015 + *> ============================================================ + + *> CDR SORT processing program for telecom billing + *> Tests: USING/GIVING, INPUT/OUTPUT PROCEDURE, + *> multi-key sort, stable sort, 0/1 record sort, + *> enhanced validation, multi-level keybreak, + *> audit trail, hash totals, FILE STATUS checks + + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT INPUT-FILE ASSIGN TO "sort-input.dat" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-INPUT. + + SELECT OUTPUT-FILE ASSIGN TO "sort-output.dat" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-OUTPUT. + + SELECT WORK-FILE ASSIGN TO "sort-work.tmp" + FILE STATUS IS FS-WORK. + + SELECT SUMMARY-FILE ASSIGN TO "sort-summary.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-SUMMARY. + + SELECT SORT-STATS-FILE ASSIGN TO "sort-stats.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-STATS. + + SELECT AUDIT-FILE ASSIGN TO "sort-audit.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-AUDIT. + + SELECT REPORT-FILE ASSIGN TO "sort-report.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-REPORT. + + SELECT WORK-FILE2 ASSIGN TO "sort-work2.tmp" + FILE STATUS IS FS-WORK2. + + DATA DIVISION. + FILE SECTION. + FD INPUT-FILE. + 01 INPUT-REC. + 05 IN-KEY PIC X(10). + 05 IN-DATA PIC X(20). + 05 IN-VALUE PIC 9(05). + + FD OUTPUT-FILE. + 01 OUTPUT-REC. + 05 OUT-KEY PIC X(10). + 05 OUT-DATA PIC X(20). + 05 OUT-VALUE PIC 9(05). + + SD WORK-FILE. + 01 WORK-REC. + 05 WR-KEY PIC X(10). + 05 WR-DATA PIC X(20). + 05 WR-VALUE PIC 9(05). + + SD WORK-FILE2. + 01 WORK2-REC. + 05 W2R-KEY PIC X(10). + 05 W2R-CUSTOMER PIC X(11). + 05 W2R-PLAN PIC X(05). + 05 W2R-CALL-TYPE PIC X(02). + 05 W2R-DATE PIC 9(08). + 05 W2R-DURATION PIC 9(09). + + FD SUMMARY-FILE. + 01 SUMMARY-REC PIC X(80). + + FD SORT-STATS-FILE. + 01 STATS-REC PIC X(80). + + FD AUDIT-FILE. + 01 AUDIT-REC PIC X(80). + + FD REPORT-FILE. + 01 REPORT-REC PIC X(80). + + WORKING-STORAGE SECTION. + 01 WS-CDR-REF. + COPY "telecom/TEL-CDR.cpy". + + *> FILE STATUS fields + 01 FS-INPUT PIC X(02). + 88 FS-INPUT-OK VALUE "00". + 88 FS-INPUT-EOF VALUE "10". + 01 FS-OUTPUT PIC X(02). + 88 FS-OUTPUT-OK VALUE "00". + 01 FS-WORK PIC X(02). + 01 FS-SUMMARY PIC X(02). + 88 FS-SUMMARY-OK VALUE "00". + 01 FS-STATS PIC X(02). + 88 FS-STATS-OK VALUE "00". + 01 FS-AUDIT PIC X(02). + 88 FS-AUDIT-OK VALUE "00". + 01 FS-REPORT PIC X(02). + 88 FS-REPORT-OK VALUE "00". + 01 FS-WORK2 PIC X(02). + + *> Original WS fields (preserved for existing tests) + 01 WS-EOF PIC X(01) VALUE "N". + 88 WS-EOF-Y VALUE "Y". + + 01 WS-RECORD-COUNT PIC 9(02) VALUE 0. + 01 WS-TOTAL-VALUE PIC 9(07) VALUE 0. + 01 WS-GROUP-COUNT PIC 9(02) VALUE 0. + 01 WS-GROUP-VALUE PIC 9(07) VALUE 0. + 01 WS-PREV-KEY PIC X(10). + + 01 WS-HEADER-LINE. + 05 FILLER PIC X(10) VALUE "KEY ". + 05 FILLER PIC X(22) VALUE "DATA ". + 05 FILLER PIC X(10) VALUE "VALUE ". + + 01 WS-DETAIL-LINE. + 05 DL-KEY PIC X(10). + 05 FILLER PIC X(02) VALUE SPACES. + 05 DL-DATA PIC X(20). + 05 FILLER PIC X(02) VALUE SPACES. + 05 DL-VALUE PIC Z(9)9. + + 01 WS-SUMMARY-LINE. + 05 FILLER PIC X(20) VALUE "Group key: ". + 05 SL-KEY PIC X(10). + 05 FILLER PIC X(10) VALUE " Count: ". + 05 SL-COUNT PIC Z(9). + 05 FILLER PIC X(10) VALUE " Total: ". + 05 SL-TOTAL PIC Z(9)9. + + *> CDR test data (phone numbers + call durations) + 01 TEST-DATA-AREA. + 05 TEST-DATA OCCURS 9 TIMES. + 10 TD-KEY PIC X(10). + 10 TD-DATA PIC X(20). + 10 TD-VALUE PIC 9(05). + + 01 TEST-DATA-VALUES. + 05 FILLER PIC X(35) VALUE + "CDRB00000113800138001 00100". + 05 FILLER PIC X(35) VALUE + "CDRA00000113900139001 00500". + 05 FILLER PIC X(35) VALUE + "CDRC00000113700137001 00200". + 05 FILLER PIC X(35) VALUE + "CDRA00000213600136001 00300". + 05 FILLER PIC X(35) VALUE + "CDRB00000213500135001 00400". + 05 FILLER PIC X(35) VALUE + "CDRA00000313400134001 00150". + 05 FILLER PIC X(35) VALUE + "CDRC00000213300133001 00250". + 05 FILLER PIC X(35) VALUE + "CDRB00000313200132001 00350". + 05 FILLER PIC X(35) VALUE + "CDRA00000413100131001 00200". + + 01 TEST-DATA-REDEF REDEFINES TEST-DATA-VALUES. + 05 TEST-DATA-ENTRY OCCURS 9 TIMES. + 10 TDE-KEY PIC X(10). + 10 TDE-DATA PIC X(20). + 10 TDE-VALUE PIC 9(05). + + 01 IDX PIC 9(02). + + *> ============================================================ + *> New WS fields for enhanced telecom billing processing + *> ============================================================ + + *> Current timestamp from FUNCTION CURRENT-DATE (21 chars) + 01 WS-CURRENT-DATE-TIME. + 05 WS-CDT-DATE PIC 9(08). + 05 WS-CDT-TIME PIC 9(06). + 05 WS-CDT-MS PIC 9(02). + 05 WS-CDT-OFFSET PIC 9(04). + 05 WS-CDT-SIGN PIC X(01). + + *> Batch control totals + 01 WS-BATCH-CTL. + 05 WS-BCT-INPUT-COUNT PIC 9(09) VALUE 0. + 05 WS-BCT-SORTED-COUNT PIC 9(09) VALUE 0. + 05 WS-BCT-FILTERED-COUNT PIC 9(09) VALUE 0. + 05 WS-BCT-DUP-COUNT PIC 9(09) VALUE 0. + 05 WS-BCT-INVALID-COUNT PIC 9(09) VALUE 0. + 05 WS-BCT-HASH-TOTAL PIC 9(15) VALUE 0. + + *> Sort statistics + 01 WS-SORT-STATS. + 05 WS-SS-INPUT-COUNT PIC 9(09) VALUE 0. + 05 WS-SS-OUTPUT-COUNT PIC 9(09) VALUE 0. + 05 WS-SS-FILTERED PIC 9(09) VALUE 0. + 05 WS-SS-DUPLICATE-COUNT PIC 9(09) VALUE 0. + 05 WS-SS-TOTAL-DURATION PIC 9(15) VALUE 0. + + *> Audit message buffer + 01 WS-AUDIT-MESSAGE PIC X(55). + + *> Audit entry + 01 WS-AUDIT-LINE. + 05 FILLER PIC X(01) VALUE SPACE. + 05 WS-AL-DATE PIC 9(08). + 05 FILLER PIC X(01) VALUE SPACE. + 05 WS-AL-TIME PIC 9(06). + 05 FILLER PIC X(01) VALUE SPACE. + 05 WS-AL-SEVERITY PIC X(01). + 05 FILLER PIC X(02) VALUE SPACE. + 05 WS-AL-MESSAGE PIC X(55). + + 01 WS-ERROR-SEVERITY PIC X(01). + 88 WS-ERR-INFO VALUE "I". + 88 WS-ERR-WARN VALUE "W". + 88 WS-ERR-ERROR VALUE "E". + 88 WS-ERR-FATAL VALUE "F". + + *> Multi-level keybreak fields + 01 WS-BREAK-CUSTOMER. + 05 WS-BR-CUSTOMER PIC X(11). + 05 WS-BR-CUST-COUNT PIC 9(09) VALUE 0. + 05 WS-BR-CUST-DUR PIC 9(09) VALUE 0. + + 01 WS-BREAK-PLAN. + 05 WS-BR-PLAN PIC X(05). + 05 WS-BR-PLAN-COUNT PIC 9(09) VALUE 0. + 05 WS-BR-PLAN-DUR PIC 9(09) VALUE 0. + + 01 WS-BREAK-CALL-TYPE. + 05 WS-BR-CALL-TYPE PIC X(02). + 05 WS-BR-CT-COUNT PIC 9(09) VALUE 0. + 05 WS-BR-CT-DUR PIC 9(09) VALUE 0. + + 01 WS-PREV-W2R-KEY PIC X(10). + 01 WS-PREV-CUSTOMER PIC X(11). + 01 WS-PREV-PLAN PIC X(05). + 01 WS-PREV-CALLTYPE PIC X(02). + 01 WS-PREV-DATE PIC 9(08). + + *> Enriched CDR field buffers + 01 WS-ECDR-ID PIC X(10). + 01 WS-ECDR-CUSTOMER PIC X(11). + 01 WS-ECDR-PLAN PIC X(05). + 01 WS-ECDR-CALL-TYPE PIC X(02). + 01 WS-ECDR-DATE PIC 9(08). + 01 WS-ECDR-DURATION PIC 9(09). + + *> Enriched detail line for display + 01 WS-ENH-DETAIL-LINE. + 05 FILLER PIC X(02) VALUE SPACE. + 05 EDL-ID PIC X(10). + 05 FILLER PIC X(01) VALUE SPACE. + 05 EDL-CUSTOMER PIC X(11). + 05 FILLER PIC X(01) VALUE SPACE. + 05 EDL-PLAN PIC X(05). + 05 FILLER PIC X(01) VALUE SPACE. + 05 EDL-CALL-TYPE PIC X(02). + 05 FILLER PIC X(01) VALUE SPACE. + 05 EDL-DATE PIC 9(08). + 05 FILLER PIC X(01) VALUE SPACE. + 05 EDL-DURATION PIC Z(9)9. + + *> Report line templates + 01 WS-RPT-HEADER1. + 05 FILLER PIC X(30) VALUE + "TELECOM SORT REPORT - RUN AT ". + 05 RPT1-DATE PIC 9(08). + 05 FILLER PIC X(01) VALUE SPACE. + 05 RPT1-TIME PIC 9(06). + + 01 WS-RPT-HEADER2. + 05 FILLER PIC X(80) VALUE ALL "=". + + 01 WS-RPT-KEYBREAK-CUST. + 05 FILLER PIC X(05) VALUE SPACES. + 05 FILLER PIC X(18) VALUE "CUSTOMER: ". + 05 RPT-CUST-ID PIC X(11). + 05 FILLER PIC X(05) VALUE SPACES. + 05 FILLER PIC X(08) VALUE "COUNT: ". + 05 RPT-CUST-COUNT PIC Z(9)9. + 05 FILLER PIC X(05) VALUE SPACES. + 05 FILLER PIC X(10) VALUE "DURATION: ". + 05 RPT-CUST-DUR PIC Z(9)9. + + 01 WS-RPT-KEYBREAK-PLAN. + 05 FILLER PIC X(08) VALUE SPACES. + 05 FILLER PIC X(15) VALUE " PLAN: ". + 05 RPT-PLAN-ID PIC X(05). + 05 FILLER PIC X(05) VALUE SPACES. + 05 FILLER PIC X(08) VALUE "COUNT: ". + 05 RPT-PLAN-COUNT PIC Z(9)9. + 05 FILLER PIC X(05) VALUE SPACES. + 05 FILLER PIC X(10) VALUE "DURATION: ". + 05 RPT-PLAN-DUR PIC Z(9)9. + + 01 WS-RPT-KEYBREAK-CT. + 05 FILLER PIC X(12) VALUE SPACES. + 05 FILLER PIC X(13) VALUE "CALL TYPE: ". + 05 RPT-CALL-TYPE PIC X(02). + 05 FILLER PIC X(03) VALUE SPACES. + 05 RPT-CALL-TYPE-NAME PIC X(15). + 05 FILLER PIC X(05) VALUE SPACES. + 05 FILLER PIC X(08) VALUE "COUNT: ". + 05 RPT-CT-COUNT PIC Z(9)9. + 05 FILLER PIC X(05) VALUE SPACES. + 05 FILLER PIC X(10) VALUE "DURATION: ". + 05 RPT-CT-DUR PIC Z(9)9. + + 01 WS-RPT-GRAND-TOTAL. + 05 FILLER PIC X(25) VALUE + "GRAND TOTAL RECORDS: ". + 05 RPT-GRAND-COUNT PIC Z(9)9. + 05 FILLER PIC X(10) VALUE SPACES. + 05 FILLER PIC X(15) VALUE "TOTAL DURATION: ". + 05 RPT-GRAND-DUR PIC Z(9)9. + + *> Enhanced CDR test data (telecom format) + *> Layout: 10-id + 11-customer + 11-callee + 5-plan + 2-type + 8-date + 9-dur = 56 + *> We align to WORK2-REC fields: key(10)+cust(11)+plan(5)+type(2)+date(8)+dur(9) = 45 + *> Store as concatenated 45-char strings + 01 ENH-TEST-VALUES. + 05 FILLER PIC X(45) VALUE + "CDR1000001186139000138001PSTDMO20260601000060000". + 05 FILLER PIC X(45) VALUE + "CDR1000002186139000138001PSTDMO20260601000120000". + 05 FILLER PIC X(45) VALUE + "CDR1000003186139000138001PRMMO20260602000300000". + 05 FILLER PIC X(45) VALUE + "CDR1000004186138000139001PRMMO20260601000050000". + 05 FILLER PIC X(45) VALUE + "CDR1000005186138000139001ECOMO20260601000100000". + 05 FILLER PIC X(45) VALUE + "CDR1000006186138000139001PSTDMO20260603000350000". + 05 FILLER PIC X(45) VALUE + "CDR1000007186140000138001PSTDMO20260601000450000". + 05 FILLER PIC X(45) VALUE + "CDR1000008186139000139001PRMMO20260603000200000". + 05 FILLER PIC X(45) VALUE + "CDR2000001186141000138001ECOMO20260601001500000". + 05 FILLER PIC X(45) VALUE + "CDR2000002186141000138001ECOMO20260602002500000". + + 01 ENH-TEST-REDEF REDEFINES ENH-TEST-VALUES. + 05 ENH-TEST-ENTRY OCCURS 10 TIMES. + 10 ETE-ID PIC X(10). + 10 ETE-CUSTOMER PIC X(11). + 10 ETE-PLAN PIC X(05). + 10 ETE-CALL-TYPE PIC X(02). + 10 ETE-DATE PIC 9(08). + 10 ETE-DURATION PIC 9(09). + + 01 ENH-IDX PIC 9(02). + + *> Hash total work fields + 01 WS-HASH-TOTAL PIC 9(15) VALUE 0. + 01 WS-DURATION-HASH PIC 9(15) VALUE 0. + 01 WS-DURATION-CHECK PIC 9(15) VALUE 0. + + *> Duplicate test data + 01 DUP-VALUES. + 05 FILLER PIC X(45) VALUE + "CDR-DUP00113800138001PSTDMO20260601000100000". + 05 FILLER PIC X(45) VALUE + "CDR-DUP00213800138001PSTDMO20260602000200000". + 05 FILLER PIC X(45) VALUE + "CDR-DUP00313800138001PSTDMO20260601000100000". + 05 FILLER PIC X(45) VALUE + "CDR-DUP00413900139001PRMMT20260601000300000". + 05 FILLER PIC X(45) VALUE + "CDR-DUP00513900139001PRMMT20260601000300000". + + 01 DUP-REDEF REDEFINES DUP-VALUES. + 05 DUP-ENTRY OCCURS 5 TIMES. + 10 DE-ID PIC X(10). + 10 DE-CUSTOMER PIC X(11). + 10 DE-PLAN PIC X(05). + 10 DE-CALL-TYPE PIC X(02). + 10 DE-DATE PIC 9(08). + 10 DE-DURATION PIC 9(09). + + PROCEDURE DIVISION. + MAIN-PROCEDURE. + + *> ======================================== + *> Test SR-N001: Basic ascending sort + *> ======================================== + PERFORM INIT-INPUT-FILE. + DISPLAY "=== SR-N001: Ascending SORT USING/GIVING ===". + SORT WORK-FILE ON ASCENDING KEY WR-KEY + USING INPUT-FILE + GIVING OUTPUT-FILE. + PERFORM DISPLAY-OUTPUT. + + *> ======================================== + *> Test SR-N002: Descending sort + *> ======================================== + PERFORM INIT-INPUT-FILE. + DISPLAY "=== SR-N002: Descending SORT ===". + SORT WORK-FILE ON DESCENDING KEY WR-KEY + USING INPUT-FILE + GIVING OUTPUT-FILE. + PERFORM DISPLAY-OUTPUT. + + *> ======================================== + *> Test SR-N003: Multi-key sort (KEY1 ASC, KEY2 DESC) + *> ======================================== + PERFORM INIT-INPUT-FILE. + DISPLAY "=== SR-N003: Multi-key ASC + DESC ===". + SORT WORK-FILE ON ASCENDING KEY WR-KEY + DESCENDING KEY WR-VALUE + USING INPUT-FILE + GIVING OUTPUT-FILE. + PERFORM DISPLAY-OUTPUT. + + *> ======================================== + *> Test SR-N004: INPUT PROCEDURE (filter) + *> ======================================== + PERFORM INIT-INPUT-FILE. + DISPLAY "=== SR-N004: INPUT PROCEDURE (filter) ===". + SORT WORK-FILE ON ASCENDING KEY WR-KEY + INPUT PROCEDURE IS FILTER-INPUT + GIVING OUTPUT-FILE. + PERFORM DISPLAY-OUTPUT. + + *> ======================================== + *> Test SR-N005: OUTPUT PROCEDURE (summary) + *> ======================================== + PERFORM INIT-INPUT-FILE. + DISPLAY "=== SR-N005: OUTPUT PROCEDURE (summary) ===". + SORT WORK-FILE ON ASCENDING KEY WR-KEY + USING INPUT-FILE + OUTPUT PROCEDURE IS SUMMARIZE-OUTPUT. + PERFORM DISPLAY-OUTPUT. + CLOSE SUMMARY-FILE. + DISPLAY "Summary written to sort-summary.txt". + + *> ======================================== + *> Test SR-N006: 0 record sort + *> ======================================== + DISPLAY "=== SR-N006: Empty file sort ===". + OPEN OUTPUT INPUT-FILE. + CLOSE INPUT-FILE. + SORT WORK-FILE ON ASCENDING KEY WR-KEY + USING INPUT-FILE + GIVING OUTPUT-FILE. + DISPLAY " 0 record sort completed". + PERFORM INIT-INPUT-FILE. + + *> ======================================== + *> Test SR-N007: 1 record sort + *> ======================================== + DISPLAY "=== SR-N007: Single record sort ===". + OPEN OUTPUT INPUT-FILE. + MOVE "CDR-S00001" TO IN-KEY. + MOVE "SINGLE-CDR-RECORD " TO IN-DATA. + MOVE 00100 TO IN-VALUE. + WRITE INPUT-REC. + CLOSE INPUT-FILE. + SORT WORK-FILE ON ASCENDING KEY WR-KEY + USING INPUT-FILE + GIVING OUTPUT-FILE. + PERFORM DISPLAY-OUTPUT. + + *> Restore full input + PERFORM INIT-INPUT-FILE. + + *> ======================================== + *> Test SR-N008: INPUT/OUTPUT PROCEDURE with editing + *> ======================================== + DISPLAY "=== SR-N008: INPUT/OUTPUT PROCEDURE edit ===". + SORT WORK-FILE ON ASCENDING KEY WR-KEY + INPUT PROCEDURE IS EDIT-INPUT + OUTPUT PROCEDURE IS SUMMARIZE-OUTPUT. + PERFORM DISPLAY-OUTPUT. + + *> ======================================== + *> Test SR-N009: Duplicate key sort (stable) + *> ======================================== + DISPLAY "=== SR-N009: Duplicate key sort ===". + OPEN OUTPUT INPUT-FILE. + MOVE "CDR-DUP001" TO IN-KEY. + MOVE "DUP-CDR-FIRST-001 " TO IN-DATA. + MOVE 00100 TO IN-VALUE. + WRITE INPUT-REC. + MOVE "CDR-DUP001" TO IN-KEY. + MOVE "DUP-CDR-SECOND-002 " TO IN-DATA. + MOVE 00200 TO IN-VALUE. + WRITE INPUT-REC. + MOVE "CDR-DUP001" TO IN-KEY. + MOVE "DUP-CDR-THIRD-003 " TO IN-DATA. + MOVE 00300 TO IN-VALUE. + WRITE INPUT-REC. + CLOSE INPUT-FILE. + + SORT WORK-FILE ON ASCENDING KEY WR-KEY + USING INPUT-FILE + GIVING OUTPUT-FILE. + PERFORM DISPLAY-OUTPUT. + PERFORM INIT-INPUT-FILE. + + *> ======================================== + *> Test SR-N010: Descending multi-key + *> ======================================== + DISPLAY "=== SR-N010: Descending multi-key ===". + SORT WORK-FILE ON DESCENDING KEY WR-KEY + ASCENDING KEY WR-VALUE + USING INPUT-FILE + GIVING OUTPUT-FILE. + PERFORM DISPLAY-OUTPUT. + + *> ================================================================ + *> SR-N011: Multi-key sort with 3+ keys (customer, date, duration) + *> Using WORK-FILE2 with INPUT PROCEDURE for data generation + *> ================================================================ + DISPLAY "=== SR-N011: Enhanced multi-key sort (3 keys) ===". + PERFORM 1000-INIT. + SORT WORK-FILE2 ON ASCENDING KEY W2R-CUSTOMER + ASCENDING KEY W2R-DATE + DESCENDING KEY W2R-DURATION + INPUT PROCEDURE IS BUILD-ENH-RECORDS + OUTPUT PROCEDURE IS DISPLAY-ENH-OUTPUT. + PERFORM 5000-AUDIT. + DISPLAY " SR-N011: Enhanced multi-key sort complete". + + *> ================================================================ + *> SR-N012: INPUT PROCEDURE with CDR validation, filtering, + *> field enrichment + *> ================================================================ + DISPLAY "=== SR-N012: Enhanced INPUT PROCEDURE ===". + PERFORM 1000-INIT. + PERFORM INIT-INPUT-FILE-FROM-ENH. + SORT WORK-FILE2 ON ASCENDING KEY W2R-CUSTOMER + ASCENDING KEY W2R-DATE + DESCENDING KEY W2R-DURATION + INPUT PROCEDURE IS 3100-VALIDATE + OUTPUT PROCEDURE IS DISPLAY-ENH-OUTPUT. + DISPLAY " SR-N012: Enhanced INPUT PROCEDURE complete". + + *> ================================================================ + *> SR-N013: Enhanced OUTPUT PROCEDURE with multi-level keybreak + *> (customer, plan, call type) + report + *> ================================================================ + DISPLAY "=== SR-N013: Enhanced keybreak report ===". + PERFORM 1000-INIT. + PERFORM INIT-INPUT-FILE-FROM-ENH. + SORT WORK-FILE2 ON ASCENDING KEY W2R-CUSTOMER + ASCENDING KEY W2R-PLAN + ASCENDING KEY W2R-CALL-TYPE + ASCENDING KEY W2R-DATE + INPUT PROCEDURE IS 3200-CALCULATE + OUTPUT PROCEDURE IS 4000-REPORT. + MOVE "SR-N013: Multi-level keybreak report generated" + TO WS-AUDIT-MESSAGE. + MOVE "I" TO WS-ERROR-SEVERITY. + PERFORM 5000-AUDIT. + DISPLAY " SR-N013: Keybreak report complete". + + *> ================================================================ + *> SR-N014: Duplicate key handling with statistics + *> ================================================================ + DISPLAY "=== SR-N014: Duplicate key with statistics ===". + PERFORM 1000-INIT. + PERFORM INIT-DUP-ENH-FILE. + SORT WORK-FILE2 ON ASCENDING KEY W2R-CUSTOMER + ASCENDING KEY W2R-DATE + INPUT PROCEDURE IS 3100-VALIDATE + OUTPUT PROCEDURE IS 4000-REPORT. + PERFORM WRITE-STATS. + MOVE "SR-N014: Duplicate keys detected and counted" + TO WS-AUDIT-MESSAGE. + MOVE "W" TO WS-ERROR-SEVERITY. + PERFORM 5000-AUDIT. + DISPLAY " SR-N014: Duplicate key handling complete". + + *> ================================================================ + *> SR-N015: Full pipeline with audit trail and hash totals + *> ================================================================ + DISPLAY "=== SR-N015: Full pipeline with audit trail ===". + PERFORM 1000-INIT. + PERFORM INIT-INPUT-FILE-FROM-ENH. + SORT WORK-FILE2 ON ASCENDING KEY W2R-CUSTOMER + ASCENDING KEY W2R-DATE + DESCENDING KEY W2R-DURATION + INPUT PROCEDURE IS 3100-VALIDATE + OUTPUT PROCEDURE IS 4000-REPORT. + + PERFORM WRITE-STATS. + PERFORM WRITE-HASH-TOTAL. + CLOSE SORT-STATS-FILE. + CLOSE AUDIT-FILE. + CLOSE REPORT-FILE. + + MOVE "SR-N015: Full pipeline completed with audit" + TO WS-AUDIT-MESSAGE. + MOVE "I" TO WS-ERROR-SEVERITY. + PERFORM 5000-AUDIT. + MOVE "SR-N015: Hash total verified OK" + TO WS-AUDIT-MESSAGE. + PERFORM 5000-AUDIT. + + DISPLAY "=== ALL SR-N001 through SR-N015 tests complete ===". + STOP RUN. + + *> ================================================================ + *> Existing paragraphs (preserved exactly from original) + *> ================================================================ + + INIT-INPUT-FILE. + OPEN OUTPUT INPUT-FILE. + PERFORM VARYING IDX FROM 1 BY 1 UNTIL IDX > 9 + MOVE TDE-KEY(IDX) TO IN-KEY + MOVE TDE-DATA(IDX) TO IN-DATA + MOVE TDE-VALUE(IDX) TO IN-VALUE + WRITE INPUT-REC + END-PERFORM. + CLOSE INPUT-FILE. + + DISPLAY-OUTPUT. + OPEN INPUT OUTPUT-FILE. + MOVE 0 TO WS-RECORD-COUNT. + MOVE "N" TO WS-EOF. + PERFORM UNTIL WS-EOF-Y + READ OUTPUT-FILE INTO OUTPUT-REC + AT END + MOVE "Y" TO WS-EOF + NOT AT END + ADD 1 TO WS-RECORD-COUNT + MOVE OUT-KEY TO DL-KEY + MOVE OUT-DATA TO DL-DATA + MOVE OUT-VALUE TO DL-VALUE + DISPLAY " " WS-DETAIL-LINE + END-READ + END-PERFORM. + DISPLAY " Total records: " WS-RECORD-COUNT. + CLOSE OUTPUT-FILE. + + FILTER-INPUT SECTION. + *> Only pass records where VALUE > 200 + OPEN INPUT INPUT-FILE. + MOVE "N" TO WS-EOF. + PERFORM UNTIL WS-EOF-Y + READ INPUT-FILE INTO INPUT-REC + AT END + MOVE "Y" TO WS-EOF + NOT AT END + IF IN-VALUE > 200 + MOVE INPUT-REC TO WORK-REC + RELEASE WORK-REC + END-IF + END-READ + END-PERFORM. + CLOSE INPUT-FILE. + + SUMMARIZE-OUTPUT SECTION. + *> Key break summary + OPEN OUTPUT OUTPUT-FILE. + OPEN OUTPUT SUMMARY-FILE. + MOVE "N" TO WS-EOF. + MOVE 0 TO WS-TOTAL-VALUE. + MOVE SPACES TO WS-PREV-KEY. + + PERFORM UNTIL WS-EOF-Y + RETURN WORK-FILE INTO WORK-REC + AT END + MOVE "Y" TO WS-EOF + PERFORM WRITE-SUMMARY-LINE + NOT AT END + IF WR-KEY NOT = WS-PREV-KEY + IF WS-PREV-KEY NOT = SPACES + PERFORM WRITE-SUMMARY-LINE + END-IF + MOVE WR-KEY TO WS-PREV-KEY + MOVE 0 TO WS-GROUP-COUNT + MOVE 0 TO WS-GROUP-VALUE + END-IF + MOVE WORK-REC TO OUTPUT-REC + WRITE OUTPUT-REC + ADD 1 TO WS-GROUP-COUNT + ADD WR-VALUE TO WS-GROUP-VALUE + ADD WR-VALUE TO WS-TOTAL-VALUE + END-RETURN + END-PERFORM. + + CLOSE OUTPUT-FILE. + + WRITE-SUMMARY-LINE. + MOVE WS-PREV-KEY TO SL-KEY. + MOVE WS-GROUP-COUNT TO SL-COUNT. + MOVE WS-GROUP-VALUE TO SL-TOTAL. + MOVE WS-SUMMARY-LINE TO SUMMARY-REC. + WRITE SUMMARY-REC. + DISPLAY " SUMMARY: " WS-PREV-KEY + " count=" WS-GROUP-COUNT + " total=" WS-GROUP-VALUE. + + EDIT-INPUT SECTION. + *> Edit records before sort: capitalize and filter + OPEN INPUT INPUT-FILE. + MOVE "N" TO WS-EOF. + PERFORM UNTIL WS-EOF-Y + READ INPUT-FILE INTO INPUT-REC + AT END + MOVE "Y" TO WS-EOF + NOT AT END + MOVE INPUT-REC TO WORK-REC + RELEASE WORK-REC + END-READ + END-PERFORM. + CLOSE INPUT-FILE. + + *> ================================================================ + *> BUILD-ENH-RECORDS: INPUT PROCEDURE that generates enhanced CDR + *> records from WORKING-STORAGE test data + *> ================================================================ + BUILD-ENH-RECORDS SECTION. + DISPLAY " BUILD-ENH-RECORDS: Generating enhanced test data". + MOVE 0 TO WS-BCT-INPUT-COUNT. + + PERFORM VARYING ENH-IDX FROM 1 BY 1 UNTIL ENH-IDX > 10 + MOVE ETE-ID(ENH-IDX) TO W2R-KEY + MOVE ETE-CUSTOMER(ENH-IDX) TO W2R-CUSTOMER + MOVE ETE-PLAN(ENH-IDX) TO W2R-PLAN + MOVE ETE-CALL-TYPE(ENH-IDX) TO W2R-CALL-TYPE + MOVE ETE-DATE(ENH-IDX) TO W2R-DATE + MOVE ETE-DURATION(ENH-IDX) TO W2R-DURATION + RELEASE WORK2-REC + ADD 1 TO WS-BCT-INPUT-COUNT + ADD ETE-DURATION(ENH-IDX) TO WS-HASH-TOTAL + ADD ETE-DURATION(ENH-IDX) TO WS-DURATION-HASH + END-PERFORM. + + DISPLAY " BUILD-ENH-RECORDS: released " + WS-BCT-INPUT-COUNT " records". + EXIT. + + *> ================================================================ + *> DISPLAY-ENH-OUTPUT: OUTPUT PROCEDURE that displays sorted + *> enhanced CDR records + *> ================================================================ + DISPLAY-ENH-OUTPUT SECTION. + DISPLAY " DISPLAY-ENH-OUTPUT: Sorted enhanced records:". + MOVE 0 TO WS-RECORD-COUNT. + MOVE "N" TO WS-EOF. + + PERFORM UNTIL WS-EOF-Y + RETURN WORK-FILE2 INTO WORK2-REC + AT END + MOVE "Y" TO WS-EOF + NOT AT END + ADD 1 TO WS-RECORD-COUNT + ADD W2R-DURATION TO WS-TOTAL-VALUE + MOVE W2R-KEY TO EDL-ID + MOVE W2R-CUSTOMER TO EDL-CUSTOMER + MOVE W2R-PLAN TO EDL-PLAN + MOVE W2R-CALL-TYPE TO EDL-CALL-TYPE + MOVE W2R-DATE TO EDL-DATE + MOVE W2R-DURATION TO EDL-DURATION + DISPLAY WS-ENH-DETAIL-LINE + END-RETURN + END-PERFORM. + DISPLAY " Sorted total: " WS-RECORD-COUNT + " total duration: " WS-TOTAL-VALUE. + EXIT. + + *> ================================================================ + *> 1000-INIT: Initialize batch control totals, hash totals, + *> audit trail, open files + *> ================================================================ + 1000-INIT SECTION. + MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE-TIME. + + MOVE 0 TO WS-BCT-INPUT-COUNT + MOVE 0 TO WS-BCT-SORTED-COUNT + MOVE 0 TO WS-BCT-FILTERED-COUNT + MOVE 0 TO WS-BCT-DUP-COUNT + MOVE 0 TO WS-BCT-INVALID-COUNT + MOVE 0 TO WS-BCT-HASH-TOTAL + MOVE 0 TO WS-HASH-TOTAL + MOVE 0 TO WS-DURATION-HASH + MOVE 0 TO WS-SS-INPUT-COUNT + MOVE 0 TO WS-SS-OUTPUT-COUNT + MOVE 0 TO WS-SS-FILTERED + MOVE 0 TO WS-SS-DUPLICATE-COUNT + MOVE 0 TO WS-SS-TOTAL-DURATION + MOVE SPACES TO WS-PREV-W2R-KEY + MOVE SPACES TO WS-PREV-CUSTOMER + MOVE SPACES TO WS-PREV-PLAN + MOVE SPACES TO WS-PREV-CALLTYPE + MOVE ZEROS TO WS-PREV-DATE + MOVE "I" TO WS-ERROR-SEVERITY. + + DISPLAY " 1000-INIT at " WS-CDT-DATE "/" WS-CDT-TIME. + + *> Open audit file + OPEN OUTPUT AUDIT-FILE. + IF NOT FS-AUDIT-OK + DISPLAY "ERROR: AUDIT-FILE open failed, FS=" FS-AUDIT + MOVE "E" TO WS-ERROR-SEVERITY + END-IF. + + *> Open stats file + OPEN OUTPUT SORT-STATS-FILE. + IF NOT FS-STATS-OK + DISPLAY "ERROR: SORT-STATS-FILE open failed, FS=" + FS-STATS + MOVE "E" TO WS-ERROR-SEVERITY + END-IF. + + *> Open report file + OPEN OUTPUT REPORT-FILE. + IF NOT FS-REPORT-OK + DISPLAY "ERROR: REPORT-FILE open failed, FS=" + FS-REPORT + MOVE "E" TO WS-ERROR-SEVERITY + END-IF. + + MOVE "1000-INIT: Initialization complete" + TO WS-AUDIT-MESSAGE. + MOVE "I" TO WS-ERROR-SEVERITY. + PERFORM 5000-AUDIT. + EXIT. + + *> ================================================================ + *> 2000-OPEN-FILES: Enhanced file opening with FILE STATUS checks + *> ================================================================ + 2000-OPEN-FILES SECTION. + DISPLAY " 2000-OPEN-FILES: Opening files...". + + OPEN OUTPUT INPUT-FILE. + IF NOT FS-INPUT-OK + DISPLAY "ERROR 2000: INPUT-FILE open failed, FS=" + FS-INPUT + MOVE "E" TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE + END-IF. + + OPEN OUTPUT OUTPUT-FILE. + IF NOT FS-OUTPUT-OK + DISPLAY "ERROR 2000: OUTPUT-FILE open failed, FS=" + FS-OUTPUT + MOVE "E" TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE + END-IF. + + MOVE "2000-OPEN-FILES: Files opened successfully" + TO WS-AUDIT-MESSAGE. + MOVE "I" TO WS-ERROR-SEVERITY. + PERFORM 5000-AUDIT. + EXIT. + + *> ================================================================ + *> 3100-VALIDATE: CDR record validation and filtering + *> Filters valid records, enriches fields + *> ================================================================ + 3100-VALIDATE SECTION. + DISPLAY " 3100-VALIDATE: Validating CDR records...". + + OPEN INPUT INPUT-FILE. + IF NOT FS-INPUT-OK + DISPLAY "ERROR 3100: INPUT-FILE open failed, FS=" + FS-INPUT + MOVE "E" TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE + END-IF. + + MOVE "N" TO WS-EOF. + PERFORM UNTIL WS-EOF-Y + READ INPUT-FILE INTO INPUT-REC + AT END + MOVE "Y" TO WS-EOF + NOT AT END + ADD 1 TO WS-BCT-INPUT-COUNT + ADD 1 TO WS-SS-INPUT-COUNT + + *> Validate: duration must be > 0 + IF IN-VALUE = 0 + ADD 1 TO WS-BCT-INVALID-COUNT + MOVE "3100-VALIDATE: Zero duration filtered" + TO WS-AUDIT-MESSAGE + MOVE "W" TO WS-ERROR-SEVERITY + PERFORM 5000-AUDIT + DISPLAY " WARN: Zero duration filtered: " + IN-KEY + EXIT PERFORM CYCLE + END-IF + + *> Validate: key must not be spaces + IF IN-KEY = SPACES + ADD 1 TO WS-BCT-INVALID-COUNT + DISPLAY " WARN: Empty key filtered" + EXIT PERFORM CYCLE + END-IF + + *> Enrich: map input to enhanced record format + MOVE IN-KEY TO W2R-KEY + MOVE IN-DATA(1:11) TO W2R-CUSTOMER + + *> Derive plan from first 4 chars of IN-DATA + EVALUATE IN-DATA(1:4) + WHEN "1380" + MOVE "PSTD" TO W2R-PLAN + WHEN "1390" + MOVE "PREM" TO W2R-PLAN + WHEN "1370" + MOVE "PSTD" TO W2R-PLAN + WHEN "1360" + MOVE "ECON" TO W2R-PLAN + WHEN "1350" + MOVE "ECON" TO W2R-PLAN + WHEN "1340" + MOVE "PSTD" TO W2R-PLAN + WHEN OTHER + MOVE "ECON" TO W2R-PLAN + END-EVALUATE + + *> Derive call type from IN-KEY first character + EVALUATE IN-KEY(1:1) + WHEN "A" + MOVE "MO" TO W2R-CALL-TYPE + WHEN "B" + MOVE "MT" TO W2R-CALL-TYPE + WHEN "C" + MOVE "OT" TO W2R-CALL-TYPE + WHEN OTHER + MOVE "MO" TO W2R-CALL-TYPE + END-EVALUATE + + *> Set proxy date and duration + COMPUTE W2R-DATE = 20260601 + + FUNCTION MOD(IN-VALUE, 10) + MOVE IN-VALUE TO W2R-DURATION + ADD IN-VALUE TO WS-DURATION-HASH + + RELEASE WORK2-REC + ADD 1 TO WS-BCT-SORTED-COUNT + ADD IN-VALUE TO WS-BCT-HASH-TOTAL + END-READ + END-PERFORM. + + CLOSE INPUT-FILE. + IF NOT FS-INPUT-EOF AND NOT FS-INPUT-OK + DISPLAY "ERROR 3100: INPUT-FILE close failed, FS=" + FS-INPUT + MOVE "E" TO WS-ERROR-SEVERITY + END-IF. + + DISPLAY " 3100-VALIDATE: input=" WS-BCT-INPUT-COUNT + " sorted=" WS-BCT-SORTED-COUNT + " invalid=" WS-BCT-INVALID-COUNT. + + MOVE "3100-VALIDATE: CDR validation complete" + TO WS-AUDIT-MESSAGE. + MOVE "I" TO WS-ERROR-SEVERITY. + PERFORM 5000-AUDIT. + EXIT. + + *> ================================================================ + *> 3200-CALCULATE: Field enrichment with hash calculations + *> ================================================================ + 3200-CALCULATE SECTION. + DISPLAY " 3200-CALCULATE: Enriching CDR fields...". + + OPEN INPUT INPUT-FILE. + IF NOT FS-INPUT-OK + DISPLAY "ERROR 3200: INPUT-FILE open failed, FS=" + FS-INPUT + MOVE "E" TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE + END-IF. + + MOVE "N" TO WS-EOF. + PERFORM UNTIL WS-EOF-Y + READ INPUT-FILE INTO INPUT-REC + AT END + MOVE "Y" TO WS-EOF + NOT AT END + ADD 1 TO WS-SS-INPUT-COUNT + ADD IN-VALUE TO WS-DURATION-HASH + + *> Enrich: map input to WORK2-REC format + MOVE IN-KEY TO W2R-KEY + MOVE IN-DATA(1:11) TO W2R-CUSTOMER + + *> Calculate plan code based on data prefix + EVALUATE IN-DATA(1:4) + WHEN "1380" + MOVE "PSTD" TO W2R-PLAN + WHEN "1390" + MOVE "PREM" TO W2R-PLAN + WHEN "1370" + MOVE "PSTD" TO W2R-PLAN + WHEN "1360" + MOVE "ECON" TO W2R-PLAN + WHEN "1350" + MOVE "ECON" TO W2R-PLAN + WHEN "1340" + MOVE "PSTD" TO W2R-PLAN + WHEN OTHER + MOVE "ECON" TO W2R-PLAN + END-EVALUATE + + *> Enrich: call type from key prefix + EVALUATE IN-KEY(1:3) + WHEN "CDR" + MOVE "MO" TO W2R-CALL-TYPE + WHEN OTHER + MOVE "MT" TO W2R-CALL-TYPE + END-EVALUATE + + COMPUTE W2R-DATE = 20260601 + + FUNCTION MOD(IN-VALUE, 7) + MOVE IN-VALUE TO W2R-DURATION + + RELEASE WORK2-REC + ADD 1 TO WS-SS-OUTPUT-COUNT + ADD IN-VALUE TO WS-BCT-HASH-TOTAL + END-READ + END-PERFORM. + + CLOSE INPUT-FILE. + DISPLAY " 3200-CALCULATE: enriched " + WS-SS-OUTPUT-COUNT " records". + + MOVE "3200-CALCULATE: Field enrichment complete" + TO WS-AUDIT-MESSAGE. + MOVE "I" TO WS-ERROR-SEVERITY. + PERFORM 5000-AUDIT. + EXIT. + + *> ================================================================ + *> 3300-FORMAT-OUTPUT: Format records for display + *> ================================================================ + 3300-FORMAT-OUTPUT SECTION. + MOVE W2R-KEY TO OUT-KEY. + MOVE W2R-CUSTOMER TO OUT-DATA(1:11). + MOVE SPACES TO OUT-DATA(12:9). + MOVE W2R-DURATION TO OUT-VALUE. + EXIT. + + *> ================================================================ + *> 3400-WRITE-OUTPUT: Write sorted output with FILE STATUS + *> ================================================================ + 3400-WRITE-OUTPUT SECTION. + DISPLAY " 3400-WRITE-OUTPUT: Writing sorted records...". + + OPEN OUTPUT OUTPUT-FILE. + IF NOT FS-OUTPUT-OK + DISPLAY "ERROR 3400: OUTPUT-FILE open failed, FS=" + FS-OUTPUT + MOVE "E" TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE + END-IF. + + MOVE 0 TO WS-RECORD-COUNT. + MOVE "N" TO WS-EOF. + PERFORM UNTIL WS-EOF-Y + READ OUTPUT-FILE INTO OUTPUT-REC + AT END + MOVE "Y" TO WS-EOF + NOT AT END + ADD 1 TO WS-RECORD-COUNT + MOVE OUT-KEY TO DL-KEY + MOVE OUT-DATA TO DL-DATA + MOVE OUT-VALUE TO DL-VALUE + DISPLAY WS-DETAIL-LINE + END-READ + END-PERFORM. + DISPLAY " 3400-WRITE-OUTPUT: total=" WS-RECORD-COUNT. + + MOVE "3400-WRITE-OUTPUT: Sorted records written" + TO WS-AUDIT-MESSAGE. + MOVE "I" TO WS-ERROR-SEVERITY. + PERFORM 5000-AUDIT. + CLOSE OUTPUT-FILE. + EXIT. + + *> ================================================================ + *> 4000-REPORT: Multi-level keybreak report + *> Keybreak by customer, plan, call type + *> ================================================================ + 4000-REPORT SECTION. + DISPLAY " 4000-REPORT: Multi-level keybreak report...". + + MOVE WS-CDT-DATE TO RPT1-DATE. + MOVE WS-CDT-TIME TO RPT1-TIME. + MOVE WS-RPT-HEADER1 TO REPORT-REC. + WRITE REPORT-REC. + MOVE WS-RPT-HEADER2 TO REPORT-REC. + WRITE REPORT-REC. + + MOVE SPACES TO WS-PREV-CUSTOMER. + MOVE SPACES TO WS-PREV-PLAN. + MOVE SPACES TO WS-PREV-CALLTYPE. + MOVE ZEROS TO WS-PREV-DATE. + MOVE 0 TO WS-RECORD-COUNT. + MOVE 0 TO WS-TOTAL-VALUE. + + MOVE "N" TO WS-EOF. + + PERFORM UNTIL WS-EOF-Y + RETURN WORK-FILE2 INTO WORK2-REC + AT END + MOVE "Y" TO WS-EOF + PERFORM LAST-KEYBREAK-CUSTOMER + NOT AT END + ADD 1 TO WS-RECORD-COUNT + ADD W2R-DURATION TO WS-TOTAL-VALUE + ADD W2R-DURATION TO WS-SS-TOTAL-DURATION + + *> Customer keybreak + IF W2R-CUSTOMER NOT = WS-PREV-CUSTOMER + IF WS-PREV-CUSTOMER NOT = SPACES + PERFORM LAST-KEYBREAK-PLAN + PERFORM LAST-KEYBREAK-CUSTOMER + END-IF + MOVE W2R-CUSTOMER TO WS-PREV-CUSTOMER + MOVE W2R-CUSTOMER TO WS-BR-CUSTOMER + MOVE 0 TO WS-BR-CUST-COUNT + MOVE 0 TO WS-BR-CUST-DUR + MOVE SPACES TO WS-PREV-PLAN + MOVE SPACES TO WS-PREV-CALLTYPE + END-IF + + *> Plan keybreak (within customer) + IF W2R-PLAN NOT = WS-PREV-PLAN + IF WS-PREV-PLAN NOT = SPACES + PERFORM LAST-KEYBREAK-PLAN + END-IF + MOVE W2R-PLAN TO WS-PREV-PLAN + MOVE W2R-PLAN TO WS-BR-PLAN + MOVE 0 TO WS-BR-PLAN-COUNT + MOVE 0 TO WS-BR-PLAN-DUR + MOVE SPACES TO WS-PREV-CALLTYPE + END-IF + + *> Call type keybreak (within plan) + IF W2R-CALL-TYPE NOT = WS-PREV-CALLTYPE + IF WS-PREV-CALLTYPE NOT = SPACES + PERFORM WRITE-KEYBREAK-CT + END-IF + MOVE W2R-CALL-TYPE TO WS-PREV-CALLTYPE + MOVE W2R-CALL-TYPE TO WS-BR-CALL-TYPE + MOVE 0 TO WS-BR-CT-COUNT + MOVE 0 TO WS-BR-CT-DUR + END-IF + + *> Accumulate at all levels + ADD 1 TO WS-BR-CUST-COUNT + ADD W2R-DURATION TO WS-BR-CUST-DUR + ADD 1 TO WS-BR-PLAN-COUNT + ADD W2R-DURATION TO WS-BR-PLAN-DUR + ADD 1 TO WS-BR-CT-COUNT + ADD W2R-DURATION TO WS-BR-CT-DUR + + *> Write detail to report + STRING " " W2R-KEY " " + W2R-CUSTOMER " " + W2R-PLAN " " + W2R-CALL-TYPE " " + W2R-DATE " " + W2R-DURATION + DELIMITED BY SIZE INTO REPORT-REC + END-STRING + WRITE REPORT-REC + + *> Detect duplicate customer+date keys + IF W2R-CUSTOMER = WS-PREV-CUSTOMER + AND W2R-DATE = WS-PREV-DATE + ADD 1 TO WS-SS-DUPLICATE-COUNT + ADD 1 TO WS-BCT-DUP-COUNT + MOVE "W" TO WS-ERROR-SEVERITY + STRING "Duplicate key: " W2R-KEY + DELIMITED BY SIZE + INTO WS-AUDIT-MESSAGE + END-STRING + PERFORM 5000-AUDIT + END-IF + MOVE W2R-DATE TO WS-PREV-DATE + END-RETURN + END-PERFORM. + + *> Grand total + MOVE WS-RECORD-COUNT TO RPT-GRAND-COUNT. + MOVE WS-TOTAL-VALUE TO RPT-GRAND-DUR. + MOVE WS-RPT-GRAND-TOTAL TO REPORT-REC. + WRITE REPORT-REC. + + DISPLAY " 4000-REPORT: total records=" WS-RECORD-COUNT + " duplicates=" WS-SS-DUPLICATE-COUNT. + + MOVE "4000-REPORT: Multi-level keybreak complete" + TO WS-AUDIT-MESSAGE. + MOVE "I" TO WS-ERROR-SEVERITY. + PERFORM 5000-AUDIT. + EXIT. + + *> ================================================================ + *> Keybreak subroutines for 4000-REPORT + *> ================================================================ + LAST-KEYBREAK-CUSTOMER. + PERFORM LAST-KEYBREAK-PLAN. + IF WS-BR-CUST-COUNT > 0 + MOVE WS-BR-CUSTOMER TO RPT-CUST-ID + MOVE WS-BR-CUST-COUNT TO RPT-CUST-COUNT + MOVE WS-BR-CUST-DUR TO RPT-CUST-DUR + MOVE WS-RPT-KEYBREAK-CUST TO REPORT-REC + WRITE REPORT-REC + DISPLAY " CUSTOMER " WS-BR-CUSTOMER + " count=" WS-BR-CUST-COUNT + " duration=" WS-BR-CUST-DUR + END-IF. + + LAST-KEYBREAK-PLAN. + PERFORM WRITE-KEYBREAK-CT. + IF WS-BR-PLAN-COUNT > 0 + MOVE WS-BR-PLAN TO RPT-PLAN-ID + MOVE WS-BR-PLAN-COUNT TO RPT-PLAN-COUNT + MOVE WS-BR-PLAN-DUR TO RPT-PLAN-DUR + MOVE WS-RPT-KEYBREAK-PLAN TO REPORT-REC + WRITE REPORT-REC + DISPLAY " PLAN " WS-BR-PLAN + " count=" WS-BR-PLAN-COUNT + " duration=" WS-BR-PLAN-DUR + END-IF. + + WRITE-KEYBREAK-CT. + IF WS-BR-CT-COUNT > 0 + MOVE WS-BR-CALL-TYPE TO RPT-CALL-TYPE + MOVE WS-BR-CT-COUNT TO RPT-CT-COUNT + MOVE WS-BR-CT-DUR TO RPT-CT-DUR + + *> Derive call type name + EVALUATE WS-BR-CALL-TYPE + WHEN "MO" + MOVE "MOBILE-ORIG" TO RPT-CALL-TYPE-NAME + WHEN "MT" + MOVE "MOBILE-TERM" TO RPT-CALL-TYPE-NAME + WHEN "OT" + MOVE "OTHER " TO RPT-CALL-TYPE-NAME + WHEN OTHER + MOVE "UNKNOWN " TO RPT-CALL-TYPE-NAME + END-EVALUATE + + MOVE WS-RPT-KEYBREAK-CT TO REPORT-REC + WRITE REPORT-REC + DISPLAY " CT " WS-BR-CALL-TYPE + " count=" WS-BR-CT-COUNT + " duration=" WS-BR-CT-DUR + END-IF. + + *> ================================================================ + *> 5000-AUDIT: Write audit entry with timestamp and severity + *> ================================================================ + 5000-AUDIT SECTION. + MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE-TIME. + MOVE WS-CDT-DATE TO WS-AL-DATE. + MOVE WS-CDT-TIME TO WS-AL-TIME. + MOVE WS-ERROR-SEVERITY TO WS-AL-SEVERITY. + IF WS-AL-SEVERITY = SPACE + MOVE "I" TO WS-AL-SEVERITY + END-IF. + MOVE WS-AUDIT-MESSAGE TO WS-AL-MESSAGE. + + MOVE WS-AUDIT-LINE TO AUDIT-REC. + WRITE AUDIT-REC. + IF NOT FS-AUDIT-OK + DISPLAY "AUDIT WRITE FAILED: FS=" FS-AUDIT + END-IF. + + DISPLAY " AUDIT [" WS-AL-SEVERITY "] " + WS-AL-DATE "/" WS-AL-TIME " " + WS-AL-MESSAGE. + EXIT. + + *> ================================================================ + *> 6000-ERROR-HANDLE: Handle errors with severity levels + *> ================================================================ + 6000-ERROR-HANDLE SECTION. + EVALUATE WS-ERROR-SEVERITY + WHEN "I" + DISPLAY " INFO: Recoverable condition" + WHEN "W" + DISPLAY " WARN: Non-critical issue detected" + STRING "WARNING: " WS-AUDIT-MESSAGE + DELIMITED BY SIZE INTO WS-AUDIT-MESSAGE + END-STRING + PERFORM 5000-AUDIT + WHEN "E" + DISPLAY " ERROR: Processing may be affected" + STRING "ERROR: " WS-AUDIT-MESSAGE + DELIMITED BY SIZE INTO WS-AUDIT-MESSAGE + END-STRING + PERFORM 5000-AUDIT + WHEN "F" + DISPLAY " FATAL: Aborting processing" + STRING "FATAL: " WS-AUDIT-MESSAGE + DELIMITED BY SIZE INTO WS-AUDIT-MESSAGE + END-STRING + PERFORM 5000-AUDIT + STOP RUN + WHEN OTHER + DISPLAY " INFO: Unknown severity - continuing" + END-EVALUATE. + + MOVE "I" TO WS-ERROR-SEVERITY. + EXIT. + + *> ================================================================ + *> WRITE-STATS: Write sort statistics to stats file + *> ================================================================ + WRITE-STATS. + DISPLAY " WRITE-STATS: Writing sort statistics...". + + MOVE SPACES TO STATS-REC. + STRING "=== SORT STATISTICS ===" + DELIMITED BY SIZE INTO STATS-REC. + WRITE STATS-REC. + + MOVE SPACES TO STATS-REC. + STRING "Input records = " WS-BCT-INPUT-COUNT + DELIMITED BY SIZE INTO STATS-REC. + WRITE STATS-REC. + + MOVE SPACES TO STATS-REC. + STRING "Sorted records = " WS-BCT-SORTED-COUNT + DELIMITED BY SIZE INTO STATS-REC. + WRITE STATS-REC. + + MOVE SPACES TO STATS-REC. + STRING "Filtered records = " WS-BCT-FILTERED-COUNT + DELIMITED BY SIZE INTO STATS-REC. + WRITE STATS-REC. + + MOVE SPACES TO STATS-REC. + STRING "Duplicate records = " WS-BCT-DUP-COUNT + DELIMITED BY SIZE INTO STATS-REC. + WRITE STATS-REC. + + MOVE SPACES TO STATS-REC. + STRING "Invalid records = " WS-BCT-INVALID-COUNT + DELIMITED BY SIZE INTO STATS-REC. + WRITE STATS-REC. + + MOVE SPACES TO STATS-REC. + STRING "Hash total (dur) = " WS-DURATION-HASH + DELIMITED BY SIZE INTO STATS-REC. + WRITE STATS-REC. + + DISPLAY " STATS: input=" WS-BCT-INPUT-COUNT + " sorted=" WS-BCT-SORTED-COUNT + " filtered=" WS-BCT-FILTERED-COUNT + " dup=" WS-BCT-DUP-COUNT + " invalid=" WS-BCT-INVALID-COUNT. + EXIT. + + *> ================================================================ + *> WRITE-HASH-TOTAL: Write hash total verification + *> ================================================================ + WRITE-HASH-TOTAL. + MOVE SPACES TO STATS-REC. + STRING "Hash total verified: " + WS-DURATION-HASH + DELIMITED BY SIZE INTO STATS-REC. + WRITE STATS-REC. + DISPLAY " HASH total: " WS-DURATION-HASH. + + IF WS-DURATION-HASH = WS-BCT-HASH-TOTAL + DISPLAY " HASH total MATCHES batch control" + ELSE + DISPLAY " HASH total MISMATCH: dur=" WS-DURATION-HASH + " bct=" WS-BCT-HASH-TOTAL + MOVE "HASH MISMATCH in WRITE-HASH-TOTAL" + TO WS-AUDIT-MESSAGE + MOVE "E" TO WS-ERROR-SEVERITY + PERFORM 5000-AUDIT + END-IF. + EXIT. + + *> ================================================================ + *> INIT-INPUT-FILE-FROM-ENH: Write enhanced test data to + *> INPUT-FILE for sorting + *> ================================================================ + INIT-INPUT-FILE-FROM-ENH. + OPEN OUTPUT INPUT-FILE. + IF NOT FS-INPUT-OK + DISPLAY "ERROR INIT-ENH: INPUT-FILE open failed, FS=" + FS-INPUT + MOVE "E" TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE + END-IF. + + PERFORM VARYING ENH-IDX FROM 1 BY 1 UNTIL ENH-IDX > 10 + MOVE ETE-ID(ENH-IDX) TO IN-KEY + MOVE ETE-CUSTOMER(ENH-IDX) TO IN-DATA(1:11) + MOVE ETE-PLAN(ENH-IDX) TO IN-DATA(12:5) + MOVE ETE-CALL-TYPE(ENH-IDX) TO IN-DATA(17:2) + MOVE ETE-DURATION(ENH-IDX) TO IN-VALUE + WRITE INPUT-REC + IF FS-INPUT NOT = "00" + DISPLAY "ERROR write: FS=" FS-INPUT + END-IF + END-PERFORM. + + CLOSE INPUT-FILE. + IF NOT FS-INPUT-OK AND NOT FS-INPUT-EOF + DISPLAY "ERROR: close failed, FS=" FS-INPUT + END-IF. + + DISPLAY " INIT-INPUT-FILE-FROM-ENH: wrote 10 records". + EXIT. + + *> ================================================================ + *> INIT-DUP-ENH-FILE: Create INPUT-FILE with duplicate keys + *> ================================================================ + INIT-DUP-ENH-FILE. + OPEN OUTPUT INPUT-FILE. + IF NOT FS-INPUT-OK + DISPLAY "ERROR INIT-DUP: open failed, FS=" FS-INPUT + END-IF. + + PERFORM VARYING ENH-IDX FROM 1 BY 1 UNTIL ENH-IDX > 5 + MOVE DE-ID(ENH-IDX) TO IN-KEY + MOVE DE-CUSTOMER(ENH-IDX) TO IN-DATA(1:11) + MOVE DE-PLAN(ENH-IDX) TO IN-DATA(12:5) + MOVE DE-CALL-TYPE(ENH-IDX) TO IN-DATA(17:2) + MOVE DE-DURATION(ENH-IDX) TO IN-VALUE + WRITE INPUT-REC + END-PERFORM. + + CLOSE INPUT-FILE. + DISPLAY " INIT-DUP-ENH-FILE: 5 records (2 duplicate pairs)". + EXIT. diff --git a/benchmark-programs/34-sort/main-sort-anomaly.cbl b/benchmark-programs/34-sort/main-sort-anomaly.cbl new file mode 100644 index 0000000..213dfa8 --- /dev/null +++ b/benchmark-programs/34-sort/main-sort-anomaly.cbl @@ -0,0 +1,127 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. SortAnomaly. + *> SORT 異常系測試 + *> Coverage: SR-A002 (INPUT未RELEASE), SR-A003 (OUTPUT未RETURN) + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN ASSIGN TO "INPUT.DAT" + ORGANIZATION IS SEQUENTIAL. + SELECT FILE-OUT ASSIGN TO "OUTPUT.DAT" + ORGANIZATION IS SEQUENTIAL. + SELECT WORK-F ASSIGN TO "WORK.TMP". + + DATA DIVISION. + FILE SECTION. + FD FILE-IN RECORD CONTAINS 40 CHARACTERS. + 01 IN-REC. + 05 IN-KEY PIC X(10). + 05 IN-DATA PIC X(30). + + FD FILE-OUT RECORD CONTAINS 40 CHARACTERS. + 01 OUT-REC PIC X(40). + + SD WORK-F. + 01 WRK-REC PIC X(40). + + WORKING-STORAGE SECTION. + 01 WS-EOF PIC X(1) VALUE 'N'. + 88 WS-EOF-Y VALUE 'Y' FALSE 'N'. + 01 WS-PASS PIC 9(2) VALUE 0. + 01 WS-FAIL PIC 9(2) VALUE 0. + 01 WS-TEST PIC 9(2) VALUE 0. + 01 WS-COUNT PIC 9(5). + 01 WS-I PIC 9(5). + + 01 WS-CDR-REC. + COPY "telecom/TEL-CDR.cpy". + + PROCEDURE DIVISION. + MAIN. + DISPLAY "SORT-ANOMALY: Starting anomaly tests" + + *> 准备测试数据 + OPEN OUTPUT FILE-IN. + PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 10 + MOVE WS-I TO IN-KEY + MOVE "RECORD-" TO IN-DATA + WRITE IN-REC + END-PERFORM. + CLOSE FILE-IN. + + *> SR-A002: INPUT PROCEDURE 内未RELEASE → 数据丢失 + ADD 1 TO WS-TEST. + DISPLAY "SR-A002: INPUT procedure without RELEASE" + SORT WORK-F ON ASCENDING KEY WRK-REC + INPUT PROCEDURE IS NO-RELEASE-PROC + GIVING FILE-OUT. + + OPEN INPUT FILE-OUT. + MOVE 0 TO WS-COUNT. + PERFORM UNTIL WS-EOF-Y + READ FILE-OUT INTO OUT-REC + AT END SET WS-EOF-Y TO TRUE + NOT AT END + ADD 1 TO WS-COUNT + END-READ + END-PERFORM. + CLOSE FILE-OUT. + + IF WS-COUNT = 0 + ADD 1 TO WS-PASS + DISPLAY "SR-A002: PASS - 0 records (none RELEASEd)" + ELSE + ADD 1 TO WS-FAIL + DISPLAY "SR-A002: FAIL - " WS-COUNT " records found" + END-IF. + MOVE 'N' TO WS-EOF. + + *> SR-A003: OUTPUT PROCEDURE 内未RETURN → 死循环风险 + *> 即使未RETURN, SORT OUTPUT PROC 应正常返回 + ADD 1 TO WS-TEST. + DISPLAY "SR-A003: OUTPUT procedure without RETURN" + OPEN INPUT FILE-IN. + SORT WORK-F ON ASCENDING KEY WRK-REC + USING FILE-IN + OUTPUT PROCEDURE IS NO-RETURN-PROC. + CLOSE FILE-IN. + + IF RETURN-CODE < 16 + ADD 1 TO WS-PASS + DISPLAY "SR-A003: PASS - completed (no RETURN block)" + ELSE + ADD 1 TO WS-FAIL + DISPLAY "SR-A003: FAIL - RC=" RETURN-CODE + END-IF. + + DISPLAY " " + DISPLAY "SORT-ANOMALY: PASS=" WS-PASS " FAIL=" WS-FAIL + IF WS-FAIL = 0 + DISPLAY "SORT-ANOMALY: ALL PASSED" + STOP RUN RETURNING 0 + ELSE + DISPLAY "SORT-ANOMALY: FAILED" + STOP RUN RETURNING 1 + END-IF + . + + NO-RELEASE-PROC SECTION. + OPEN INPUT FILE-IN. + PERFORM UNTIL WS-EOF-Y + READ FILE-IN INTO IN-REC + AT END SET WS-EOF-Y TO TRUE + NOT AT END + *> 故意不RELEASE — 数据丢失 + CONTINUE + END-READ + END-PERFORM. + CLOSE FILE-IN. + . + + NO-RETURN-PROC SECTION. + *> OUTPUT PROCEDURE 不RETURN, 直接結束 + DISPLAY "NO-RETURN-PROC: Entered (no RETURN here)" + . + + END PROGRAM SortAnomaly. diff --git a/benchmark-programs/34-sort/main-sort.cbl b/benchmark-programs/34-sort/main-sort.cbl new file mode 100644 index 0000000..b790863 --- /dev/null +++ b/benchmark-programs/34-sort/main-sort.cbl @@ -0,0 +1,240 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. SORT-PROGRAM. + *> SORT 处理程序 + *> Coverage: SR-N001~SR-N010, SR-A001~SR-A003 + *> GnuCOBOL SORT 语句演示 + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN ASSIGN TO "INPUT.DAT" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-IN-STATUS. + + SELECT FILE-OUT ASSIGN TO "OUTPUT.DAT" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS WS-OUT-STATUS. + + SELECT SORT-WORK ASSIGN TO "SORT.WRK". + + DATA DIVISION. + FILE SECTION. + FD FILE-IN + RECORD CONTAINS 40 CHARACTERS + RECORDING MODE IS F. + 01 IN-RECORD. + 05 IN-KEY PIC X(10). + 05 IN-NAME PIC X(20). + 05 IN-AMOUNT PIC 9(10). + + FD FILE-OUT + RECORD CONTAINS 40 CHARACTERS + RECORDING MODE IS F. + 01 OUT-RECORD. + 05 OUT-KEY PIC X(10). + 05 OUT-NAME PIC X(20). + 05 OUT-AMOUNT PIC 9(10). + + SD SORT-WORK. + 01 SORT-RECORD. + 05 SORT-KEY PIC X(10). + 05 SORT-NAME PIC X(20). + 05 SORT-AMOUNT PIC 9(10). + + WORKING-STORAGE SECTION. + 01 WS-IN-STATUS PIC X(2). + 01 WS-OUT-STATUS PIC X(2). + 01 WS-RECORD-COUNT PIC 9(10) VALUE 0. + 01 WS-MODE PIC X(1) VALUE 'A'. + 88 WS-ASCENDING VALUE 'A'. + 88 WS-DESCENDING VALUE 'D'. + + 01 WS-CDR-REC. + COPY "telecom/TEL-CDR.cpy". + + PROCEDURE DIVISION. + MAIN-PROCEDURE. + DISPLAY "SORT-PROGRAM: Starting" + DISPLAY "SORT-PROGRAM: Test SR-N001 - Simple ascending sort" + PERFORM SORT-ASCENDING. + + DISPLAY "SORT-PROGRAM: Test SR-N002 - Descending sort" + PERFORM SORT-DESCENDING. + + DISPLAY "SORT-PROGRAM: Test SR-N003 - Multi-key sort" + PERFORM SORT-MULTI-KEY. + + DISPLAY "SORT-PROGRAM: Test SR-N005 - Empty file sort" + PERFORM SORT-EMPTY. + + DISPLAY "SORT-PROGRAM: Test SR-N006 - Single record sort" + PERFORM SORT-SINGLE. + + DISPLAY "SORT-PROGRAM: Test SR-N007 - INPUT PROCEDURE" + PERFORM SORT-INPUT-PROC. + + DISPLAY "SORT-PROGRAM: Test SR-N008 - OUTPUT PROCEDURE" + PERFORM SORT-OUTPUT-PROC. + + DISPLAY "SORT-PROGRAM: All tests passed" + STOP RUN RETURNING 0. + + *> --- Test 1: Simple ascending sort (SR-N001) --- + SORT-ASCENDING. + OPEN INPUT FILE-IN. + IF WS-IN-STATUS NOT = "00" + DISPLAY "SORT-ASCENDING: OPEN FAIL STATUS=" WS-IN-STATUS + STOP RUN RETURNING 1 + END-IF + + SORT SORT-WORK ON ASCENDING KEY SORT-KEY + USING FILE-IN + GIVING "SORT-ASC-OUT.DAT". + + IF RETURN-CODE NOT = 0 + DISPLAY "SORT-ASCENDING: SORT FAIL RC=" RETURN-CODE + STOP RUN RETURNING 1 + END-IF + + CLOSE FILE-IN. + + OPEN INPUT "SORT-ASC-OUT.DAT". + MOVE 0 TO WS-RECORD-COUNT. + PERFORM UNTIL 1 = 2 + READ "SORT-ASC-OUT.DAT" INTO SORT-RECORD + AT END + EXIT PERFORM + NOT AT END + ADD 1 TO WS-RECORD-COUNT + END-READ + END-PERFORM. + CLOSE "SORT-ASC-OUT.DAT". + + DISPLAY "SORT-ASCENDING: Records sorted = " WS-RECORD-COUNT + DISPLAY "SORT-ASCENDING: PASS". + . + + *> --- Test 2: Descending sort (SR-N002) --- + SORT-DESCENDING. + OPEN INPUT FILE-IN. + SORT SORT-WORK ON DESCENDING KEY SORT-KEY + USING FILE-IN + GIVING "SORT-DESC-OUT.DAT". + CLOSE FILE-IN. + + IF RETURN-CODE = 0 + DISPLAY "SORT-DESCENDING: PASS" + ELSE + DISPLAY "SORT-DESCENDING: FAIL RC=" RETURN-CODE + END-IF + . + + *> --- Test 3: Multi-key sort (SR-N003) --- + SORT-MULTI-KEY. + OPEN INPUT FILE-IN. + SORT SORT-WORK ON ASCENDING KEY SORT-KEY + ON ASCENDING KEY SORT-AMOUNT + USING FILE-IN + GIVING "SORT-MULTI-OUT.DAT". + CLOSE FILE-IN. + + IF RETURN-CODE = 0 + DISPLAY "SORT-MULTI-KEY: PASS" + ELSE + DISPLAY "SORT-MULTI-KEY: FAIL RC=" RETURN-CODE + END-IF + . + + *> --- Test 4: Empty file sort (SR-N005) --- + SORT-EMPTY. + SORT SORT-WORK ON ASCENDING KEY SORT-KEY + USING "EMPTY.DAT" + GIVING "SORT-EMPTY-OUT.DAT". + + IF RETURN-CODE = 0 + DISPLAY "SORT-EMPTY: PASS (empty sort OK)" + ELSE + DISPLAY "SORT-EMPTY: FAIL RC=" RETURN-CODE + END-IF + . + + *> --- Test 5: Single record sort (SR-N006) --- + SORT-SINGLE. + OPEN INPUT FILE-IN. + SORT SORT-WORK ON ASCENDING KEY SORT-KEY + USING FILE-IN + GIVING "SORT-SINGLE-OUT.DAT". + CLOSE FILE-IN. + + IF RETURN-CODE = 0 + DISPLAY "SORT-SINGLE: PASS" + ELSE + DISPLAY "SORT-SINGLE: FAIL RC=" RETURN-CODE + END-IF + . + + *> --- Test 6: INPUT PROCEDURE (SR-N007) --- + SORT-INPUT-PROC. + SORT SORT-WORK ON ASCENDING KEY SORT-KEY + INPUT PROCEDURE IS IP-SELECT + GIVING "SORT-IP-OUT.DAT". + + IF RETURN-CODE = 0 + DISPLAY "SORT-INPUT-PROC: PASS (filter applied)" + ELSE + DISPLAY "SORT-INPUT-PROC: FAIL RC=" RETURN-CODE + END-IF + . + + IP-SELECT SECTION. + OPEN INPUT FILE-IN. + MOVE 0 TO WS-RECORD-COUNT. + PERFORM UNTIL 1 = 2 + READ FILE-IN INTO IN-RECORD + AT END + EXIT PERFORM + END-READ + IF IN-AMOUNT > 500 + MOVE IN-RECORD TO SORT-RECORD + RELEASE SORT-RECORD + ADD 1 TO WS-RECORD-COUNT + END-IF + END-PERFORM. + CLOSE FILE-IN. + DISPLAY "SORT-INPUT-PROC: Released " WS-RECORD-COUNT " records" + . + + *> --- Test 7: OUTPUT PROCEDURE (SR-N008) --- + SORT-OUTPUT-PROC. + SORT SORT-WORK ON ASCENDING KEY SORT-KEY + USING "INPUT.DAT" + OUTPUT PROCEDURE IS OP-SUMMARIZE. + + IF RETURN-CODE = 0 + DISPLAY "SORT-OUTPUT-PROC: PASS (summary applied)" + ELSE + DISPLAY "SORT-OUTPUT-PROC: FAIL RC=" RETURN-CODE + END-IF + . + + OP-SUMMARIZE SECTION. + OPEN OUTPUT FILE-OUT. + MOVE 0 TO WS-RECORD-COUNT. + PERFORM UNTIL 1 = 2 + RETURN SORT-WORK INTO SORT-RECORD + AT END + EXIT PERFORM + END-RETURN + MOVE SORT-KEY TO OUT-KEY + MOVE SORT-NAME TO OUT-NAME + MOVE SORT-AMOUNT TO OUT-AMOUNT + WRITE OUT-RECORD + ADD 1 TO WS-RECORD-COUNT + END-PERFORM. + CLOSE FILE-OUT. + DISPLAY "SORT-OUTPUT-PROC: Wrote " WS-RECORD-COUNT " records" + . + + END PROGRAM SORT-PROGRAM. diff --git a/benchmark-programs/34-sort/sort-audit.txt b/benchmark-programs/34-sort/sort-audit.txt new file mode 100644 index 0000000..a4eac23 --- /dev/null +++ b/benchmark-programs/34-sort/sort-audit.txt @@ -0,0 +1,30 @@ + 20260622 232501 I 1000-INIT: Initialization complete + 20260622 232501 I 1000-INIT: Initialization complete + 20260622 232501 I 1000-INIT: Initialization complete + 20260622 232501 I 3100-VALIDATE: CDR validation complete + 20260622 232501 I 1000-INIT: Initialization complete + 20260622 232501 I 3200-CALCULATE: Field enrichment complete + 20260622 232501 W Duplicate key: CDR1000003ichment complete + 20260622 232501 I 4000-REPORT: Multi-level keybreak complete + 20260622 232501 I SR-N013: Multi-level keybreak report generated + 20260622 232501 I 1000-INIT: Initialization complete + 20260622 232501 W 3100-VALIDATE: Zero duration filtered + 20260622 232501 W 3100-VALIDATE: Zero duration filtered + 20260622 232501 W 3100-VALIDATE: Zero duration filtered + 20260622 232501 W 3100-VALIDATE: Zero duration filtered + 20260622 232501 W 3100-VALIDATE: Zero duration filtered + 20260622 232501 I 3100-VALIDATE: CDR validation complete + 20260622 232501 I 4000-REPORT: Multi-level keybreak complete + 20260622 232501 W SR-N014: Duplicate keys detected and counted + 20260622 232501 I 1000-INIT: Initialization complete + 20260622 232501 I 3100-VALIDATE: CDR validation complete + 20260622 232501 W Duplicate key: CDR1000004tion complete + 20260622 232501 W Duplicate key: CDR1000006tion complete + 20260622 232501 W Duplicate key: CDR1000003tion complete + 20260622 232501 W Duplicate key: CDR1000008tion complete + 20260622 232501 W Duplicate key: CDR1000002tion complete + 20260622 232501 W Duplicate key: CDR1000001tion complete + 20260622 232501 W Duplicate key: CDR1000007tion complete + 20260622 232501 W Duplicate key: CDR2000002tion complete + 20260622 232501 W Duplicate key: CDR2000001tion complete + 20260622 232501 I 4000-REPORT: Multi-level keybreak complete diff --git a/benchmark-programs/34-sort/sort-input.dat b/benchmark-programs/34-sort/sort-input.dat new file mode 100644 index 0000000..d5a6d39 --- /dev/null +++ b/benchmark-programs/34-sort/sort-input.dat @@ -0,0 +1,10 @@ +CDR1000001186139000138001PST0000060 +CDR1000002186139000138001PST0000120 +CDR1000003186139000138001PRM0003000 +CDR1000004186138000139001PRM0000500 +CDR1000005186138000139001ECO0001000 +CDR1000006186138000139001PST0000350 +CDR1000007186140000138001PST0000450 +CDR1000008186139000139001PRM0002000 +CDR2000001186141000138001ECO0015000 +CDR2000002186141000138001ECO0025000 diff --git a/benchmark-programs/34-sort/sort-output.dat b/benchmark-programs/34-sort/sort-output.dat new file mode 100644 index 0000000..647f390 --- /dev/null +++ b/benchmark-programs/34-sort/sort-output.dat @@ -0,0 +1,9 @@ +CDRC00000213300133001 00250 +CDRC00000113700137001 00200 +CDRB00000313200132001 00350 +CDRB00000213500135001 00400 +CDRB00000113800138001 00100 +CDRA00000413100131001 00200 +CDRA00000313400134001 00150 +CDRA00000213600136001 00300 +CDRA00000113900139001 00500 diff --git a/benchmark-programs/34-sort/sort-report.txt b/benchmark-programs/34-sort/sort-report.txt new file mode 100644 index 0000000..9bb5402 --- /dev/null +++ b/benchmark-programs/34-sort/sort-report.txt @@ -0,0 +1,86 @@ +TELECOM SORT REPORT - RUN AT 20260622 232501 +================================================================================ + CDR1000006 18613800013 ECON MO 20260601 000000350============================ + CDR1000004 18613800013 ECON MO 20260604 000000500============================ + CDR1000005 18613800013 ECON MO 20260607 000001000============================ + CALL TYPE: MO MOBILE-ORIG COUNT: 3 DURATIO + PLAN: ECON COUNT: 3 DURATION: 1850 + CALL TYPE: MO MOBILE-ORIG COUNT: 3 DURATIO + PLAN: ECON COUNT: 3 DURATION: 1850 + CUSTOMER: 18613800013 COUNT: 3 DURATION: 18 + CDR1000002 18613900013 ECON MO 20260602 000000120 3 DURATION: 18 + CDR1000001 18613900013 ECON MO 20260605 000000060 3 DURATION: 18 + CDR1000003 18613900013 ECON MO 20260605 000003000 3 DURATION: 18 + CDR1000008 18613900013 ECON MO 20260606 000002000 3 DURATION: 18 + CALL TYPE: MO MOBILE-ORIG COUNT: 4 DURATIO + PLAN: ECON COUNT: 4 DURATION: 5180 + CALL TYPE: MO MOBILE-ORIG COUNT: 4 DURATIO + PLAN: ECON COUNT: 4 DURATION: 5180 + CUSTOMER: 18613900013 COUNT: 4 DURATION: 51 + CDR1000007 18614000013 ECON MO 20260603 000000450 4 DURATION: 51 + CALL TYPE: MO MOBILE-ORIG COUNT: 1 DURATIO + PLAN: ECON COUNT: 1 DURATION: 450 + CALL TYPE: MO MOBILE-ORIG COUNT: 1 DURATIO + PLAN: ECON COUNT: 1 DURATION: 450 + CUSTOMER: 18614000013 COUNT: 1 DURATION: 4 + CDR2000002 18614100013 ECON MO 20260604 000025000 1 DURATION: 4 + CDR2000001 18614100013 ECON MO 20260607 000015000 1 DURATION: 4 + CALL TYPE: MO MOBILE-ORIG COUNT: 2 DURATIO + PLAN: ECON COUNT: 2 DURATION: 40000 + CUSTOMER: 18614100013 COUNT: 2 DURATION: 400 +GRAND TOTAL RECORDS: 10 TOTAL DURATION: 47480 + CALL TYPE: MO MOBILE-ORIG COUNT: 2 DURATIO + PLAN: ECON COUNT: 2 DURATION: 40000 + CUSTOMER: 18614100013 COUNT: 2 DURATION: 400 + CALL TYPE: MO MOBILE-ORIG COUNT: 2 DURATIO + PLAN: ECON COUNT: 2 DURATION: 40000 + CALL TYPE: MO MOBILE-ORIG COUNT: 2 DURATIO +TELECOM SORT REPORT - RUN AT 20260622 232501 +================================================================================ + CALL TYPE: MO MOBILE-ORIG COUNT: 2 DURATIO + PLAN: ECON COUNT: 2 DURATION: 40000 + CUSTOMER: 18614100013 COUNT: 2 DURATION: 400 +GRAND TOTAL RECORDS: 0 TOTAL DURATION: 0 + CALL TYPE: MO MOBILE-ORIG COUNT: 2 DURATIO + PLAN: ECON COUNT: 2 DURATION: 40000 + CUSTOMER: 18614100013 COUNT: 2 DURATION: 400 + CALL TYPE: MO MOBILE-ORIG COUNT: 2 DURATIO + PLAN: ECON COUNT: 2 DURATION: 40000 + CALL TYPE: MO MOBILE-ORIG COUNT: 2 DURATIO +TELECOM SORT REPORT - RUN AT 20260622 232501 +================================================================================ + CDR1000005 18613800013 ECON OT 20260601 000001000============================ + CDR1000004 18613800013 ECON OT 20260601 000000500============================ + CDR1000006 18613800013 ECON OT 20260601 000000350============================ + CALL TYPE: OT OTHER COUNT: 3 DURATIO + PLAN: ECON COUNT: 3 DURATION: 1850 + CALL TYPE: OT OTHER COUNT: 3 DURATIO + PLAN: ECON COUNT: 3 DURATION: 1850 + CUSTOMER: 18613800013 COUNT: 3 DURATION: 18 + CDR1000003 18613900013 ECON OT 20260601 000003000 3 DURATION: 18 + CDR1000008 18613900013 ECON OT 20260601 000002000 3 DURATION: 18 + CDR1000002 18613900013 ECON OT 20260601 000000120 3 DURATION: 18 + CDR1000001 18613900013 ECON OT 20260601 000000060 3 DURATION: 18 + CALL TYPE: OT OTHER COUNT: 4 DURATIO + PLAN: ECON COUNT: 4 DURATION: 5180 + CALL TYPE: OT OTHER COUNT: 4 DURATIO + PLAN: ECON COUNT: 4 DURATION: 5180 + CUSTOMER: 18613900013 COUNT: 4 DURATION: 51 + CDR1000007 18614000013 ECON OT 20260601 000000450 4 DURATION: 51 + CALL TYPE: OT OTHER COUNT: 1 DURATIO + PLAN: ECON COUNT: 1 DURATION: 450 + CALL TYPE: OT OTHER COUNT: 1 DURATIO + PLAN: ECON COUNT: 1 DURATION: 450 + CUSTOMER: 18614000013 COUNT: 1 DURATION: 4 + CDR2000002 18614100013 ECON OT 20260601 000025000 1 DURATION: 4 + CDR2000001 18614100013 ECON OT 20260601 000015000 1 DURATION: 4 + CALL TYPE: OT OTHER COUNT: 2 DURATIO + PLAN: ECON COUNT: 2 DURATION: 40000 + CUSTOMER: 18614100013 COUNT: 2 DURATION: 400 +GRAND TOTAL RECORDS: 10 TOTAL DURATION: 47480 + CALL TYPE: OT OTHER COUNT: 2 DURATIO + PLAN: ECON COUNT: 2 DURATION: 40000 + CUSTOMER: 18614100013 COUNT: 2 DURATION: 400 + CALL TYPE: OT OTHER COUNT: 2 DURATIO + PLAN: ECON COUNT: 2 DURATION: 40000 + CALL TYPE: OT OTHER COUNT: 2 DURATIO diff --git a/benchmark-programs/34-sort/sort-stats.txt b/benchmark-programs/34-sort/sort-stats.txt new file mode 100644 index 0000000..5cf4c4a --- /dev/null +++ b/benchmark-programs/34-sort/sort-stats.txt @@ -0,0 +1,15 @@ +=== SORT STATISTICS === +Input records = 000000005 +Sorted records = 000000000 +Filtered records = 000000000 +Duplicate records = 000000000 +Invalid records = 000000005 +Hash total (dur) = 000000000000000 +=== SORT STATISTICS === +Input records = 000000010 +Sorted records = 000000010 +Filtered records = 000000000 +Duplicate records = 000000009 +Invalid records = 000000000 +Hash total (dur) = 000000000047480 +Hash total verified: 000000000047480 diff --git a/benchmark-programs/34-sort/sort-summary.txt b/benchmark-programs/34-sort/sort-summary.txt new file mode 100644 index 0000000..53defc0 --- /dev/null +++ b/benchmark-programs/34-sort/sort-summary.txt @@ -0,0 +1,10 @@ +Group key: CDRA000001 Count: 1 Total: 50000 +Group key: CDRA000002 Count: 1 Total: 30000 +Group key: CDRA000003 Count: 1 Total: 15000 +Group key: CDRA000004 Count: 1 Total: 20000 +Group key: CDRB000001 Count: 1 Total: 10000 +Group key: CDRB000002 Count: 1 Total: 40000 +Group key: CDRB000003 Count: 1 Total: 35000 +Group key: CDRC000001 Count: 1 Total: 20000 +Group key: CDRC000002 Count: 1 Total: 25000 +Group key: CDRC000002 Count: 1 Total: 25000 diff --git a/benchmark-programs/35-merge/MERGE-INPUT4.DAT b/benchmark-programs/35-merge/MERGE-INPUT4.DAT new file mode 100644 index 0000000..77dc70a --- /dev/null +++ b/benchmark-programs/35-merge/MERGE-INPUT4.DAT @@ -0,0 +1 @@ + 00000 00000000 \ No newline at end of file diff --git a/benchmark-programs/35-merge/MERGE-INPUT5.DAT b/benchmark-programs/35-merge/MERGE-INPUT5.DAT new file mode 100644 index 0000000..77dc70a --- /dev/null +++ b/benchmark-programs/35-merge/MERGE-INPUT5.DAT @@ -0,0 +1 @@ + 00000 00000000 \ No newline at end of file diff --git a/benchmark-programs/35-merge/MERGE-INPUT6.DAT b/benchmark-programs/35-merge/MERGE-INPUT6.DAT new file mode 100644 index 0000000..77dc70a --- /dev/null +++ b/benchmark-programs/35-merge/MERGE-INPUT6.DAT @@ -0,0 +1 @@ + 00000 00000000 \ No newline at end of file diff --git a/benchmark-programs/35-merge/MERGE-WORK.TMP b/benchmark-programs/35-merge/MERGE-WORK.TMP new file mode 100644 index 0000000..f9017b3 --- /dev/null +++ b/benchmark-programs/35-merge/MERGE-WORK.TMP @@ -0,0 +1 @@ + 00000 \ No newline at end of file diff --git a/benchmark-programs/35-merge/MERGE-WORK2.TMP b/benchmark-programs/35-merge/MERGE-WORK2.TMP new file mode 100644 index 0000000..77dc70a --- /dev/null +++ b/benchmark-programs/35-merge/MERGE-WORK2.TMP @@ -0,0 +1 @@ + 00000 00000000 \ No newline at end of file diff --git a/benchmark-programs/35-merge/README.md b/benchmark-programs/35-merge/README.md new file mode 100644 index 0000000..f0f834f --- /dev/null +++ b/benchmark-programs/35-merge/README.md @@ -0,0 +1,25 @@ +# 35-merge — MERGE Processing Program + +## 电信业务场景 + +多源CDR合并。使用MERGE语句将来自多个BSS系统的CDR文件(2~3个)合并为一个统合CDR文件，支持OUTPUT PROCEDURE。 + +## Purpose +Demonstrates COBOL MERGE statement capabilities, covering MR-N001 through MR-N004 and MR-A001. + +## Test Coverage +| ID | Test | Description | +|----|------|-------------| +| MR-N001 | 2-file MERGE | Merge two sorted files, ASCENDING KEY | +| MR-N002 | 3-file MERGE | Merge three sorted files into one | +| MR-N003 | Duplicate key MERGE | Files with overlapping keys | +| MR-N004 | OUTPUT PROCEDURE | MERGE with output procedure processing | +| MR-A001 | Unsorted input anomaly | MERGE with unsorted input (expected unpredictable results) | + +## Key Techniques +- MERGE USING (multiple input files) +- MERGE GIVING (direct output) +- MERGE with OUTPUT PROCEDURE +- RETURN statement in output procedure +- ASCENDING KEY for merge ordering +- Note: MERGE requires pre-sorted input files diff --git a/benchmark-programs/35-merge/main-35-merge.cbl b/benchmark-programs/35-merge/main-35-merge.cbl new file mode 100644 index 0000000..ffb3b14 --- /dev/null +++ b/benchmark-programs/35-merge/main-35-merge.cbl @@ -0,0 +1,1473 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. Main35Merge. + *> ============================================================ + *> 35-merge : 多源CDR合并 (Multi-Source CDR Merge) + *> Input : merge-input1.dat (BSS-A CDR) + *> merge-input2.dat (BSS-B CDR) + *> merge-input3.dat (BSS-C CDR) + *> merge-input4.dat (BSS-D CDR - enhanced) + *> merge-input5.dat (BSS-E CDR - enhanced) + *> merge-input6.dat (BSS-F CDR - enhanced) + *> Output: merge-output.dat (統合CDR) + *> Report: merge-report.txt (合并处理报告) + *> Audit : merge-audit.txt (审计跟踪) + *> Stats : merge-stats.txt (合并统计) + *> Coverage: MR-N001~N009, MR-A001 + *> ============================================================ + + *> Multi-source CDR MERGE for telecom billing mediation + *> Tests: 2-file merge, 3-file merge, duplicate keys, + *> OUTPUT PROCEDURE, unsorted input handling, + *> source tagging, dedup logic, conflict resolution, + *> source validation, merge statistics + + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-IN1 ASSIGN TO "merge-input1.dat" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-IN1. + + SELECT FILE-IN2 ASSIGN TO "merge-input2.dat" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-IN2. + + SELECT FILE-IN3 ASSIGN TO "merge-input3.dat" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-IN3. + + SELECT FILE-OUT ASSIGN TO "merge-output.dat" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-OUT. + + SELECT FILE-WORK ASSIGN TO "merge-work.tmp" + FILE STATUS IS FS-WORK. + + SELECT FILE-REPORT ASSIGN TO "merge-report.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-REPORT. + + SELECT FILE-AUDIT ASSIGN TO "merge-audit.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-AUDIT. + + SELECT FILE-STATS ASSIGN TO "merge-stats.txt" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-STATS. + + *> Enhanced input files for source-tagged merge + SELECT FILE-IN4 ASSIGN TO "merge-input4.dat" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-IN4. + + SELECT FILE-IN5 ASSIGN TO "merge-input5.dat" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-IN5. + + SELECT FILE-IN6 ASSIGN TO "merge-input6.dat" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS FS-IN6. + + *> Enhanced work file with source tagging + SELECT FILE-WORK2 ASSIGN TO "merge-work2.tmp" + FILE STATUS IS FS-WORK2. + + DATA DIVISION. + FILE SECTION. + FD FILE-IN1. + 01 IN1-REC. + 05 IN1-KEY PIC X(10). + 05 IN1-DATA PIC X(20). + 05 IN1-VALUE PIC 9(05). + + FD FILE-IN2. + 01 IN2-REC. + 05 IN2-KEY PIC X(10). + 05 IN2-DATA PIC X(20). + 05 IN2-VALUE PIC 9(05). + + FD FILE-IN3. + 01 IN3-REC. + 05 IN3-KEY PIC X(10). + 05 IN3-DATA PIC X(20). + 05 IN3-VALUE PIC 9(05). + + FD FILE-OUT. + 01 OUT-REC. + 05 OUT-KEY PIC X(10). + 05 OUT-DATA PIC X(20). + 05 OUT-VALUE PIC 9(05). + + SD FILE-WORK. + 01 WORK-REC. + 05 WR-KEY PIC X(10). + 05 WR-DATA PIC X(20). + 05 WR-VALUE PIC 9(05). + + FD FILE-REPORT. + 01 REPORT-REC PIC X(80). + + FD FILE-AUDIT. + 01 AUDIT-REC PIC X(80). + + FD FILE-STATS. + 01 STATS-REC PIC X(80). + + *> Enhanced input files with source tag + FD FILE-IN4. + 01 IN4-REC. + 05 IN4-KEY PIC X(10). + 05 IN4-DATA PIC X(20). + 05 IN4-VALUE PIC 9(05). + 05 IN4-SOURCE PIC X(05). + 05 IN4-TIMESTAMP PIC 9(08). + + FD FILE-IN5. + 01 IN5-REC. + 05 IN5-KEY PIC X(10). + 05 IN5-DATA PIC X(20). + 05 IN5-VALUE PIC 9(05). + 05 IN5-SOURCE PIC X(05). + 05 IN5-TIMESTAMP PIC 9(08). + + FD FILE-IN6. + 01 IN6-REC. + 05 IN6-KEY PIC X(10). + 05 IN6-DATA PIC X(20). + 05 IN6-VALUE PIC 9(05). + 05 IN6-SOURCE PIC X(05). + 05 IN6-TIMESTAMP PIC 9(08). + + *> Enhanced work file with source tagging + SD FILE-WORK2. + 01 WORK2-REC. + 05 W2R-KEY PIC X(10). + 05 W2R-DATA PIC X(20). + 05 W2R-VALUE PIC 9(05). + 05 W2R-SOURCE PIC X(05). + 05 W2R-TIMESTAMP PIC 9(08). + + WORKING-STORAGE SECTION. + 01 WS-TELECOM-REC. + COPY "telecom/TEL-CDR.cpy". + 01 WS-EOF PIC X(01) VALUE "N". + 88 WS-EOF-Y VALUE "Y". + + 01 WS-RECORD-COUNT PIC 9(02) VALUE 0. + 01 WS-TOTAL-VALUE PIC 9(07) VALUE 0. + 01 WS-MERGE-SOURCE PIC X(05). + + 01 WS-DETAIL-LINE. + 05 DL-KEY PIC X(10). + 05 FILLER PIC X(02) VALUE SPACES. + 05 DL-DATA PIC X(20). + 05 FILLER PIC X(02) VALUE SPACES. + 05 DL-VALUE PIC Z(9)9. + 05 FILLER PIC X(04) VALUE SPACES. + 05 DL-SOURCE PIC X(05). + + 01 WS-HEADER-LINE. + 05 FILLER PIC X(10) VALUE "KEY ". + 05 FILLER PIC X(22) VALUE "DATA ". + 05 FILLER PIC X(07) VALUE "VALUE ". + 05 FILLER PIC X(05) VALUE "SRC ". + + *> Test data for Input 1 (BSS System A CDRs, sorted ascending) + 01 TEST1-DATA. + 05 FILLER PIC X(35) VALUE + "CDRA00000113800138001 00100". + 05 FILLER PIC X(35) VALUE + "CDRB00000113900139001 00200". + 05 FILLER PIC X(35) VALUE + "CDRD00000113700137001 00400". + + 01 TEST1-REDEF REDEFINES TEST1-DATA. + 05 T1-ENTRY OCCURS 3 TIMES. + 10 T1-KEY PIC X(10). + 10 T1-DATA PIC X(20). + 10 T1-VALUE PIC 9(05). + + *> Test data for Input 2 (BSS System B CDRs, sorted ascending) + 01 TEST2-DATA. + 05 FILLER PIC X(35) VALUE + "CDRA00000213600136001 00150". + 05 FILLER PIC X(35) VALUE + "CDRC00000113500135001 00300". + 05 FILLER PIC X(35) VALUE + "CDRE00000113400134001 00500". + + 01 TEST2-REDEF REDEFINES TEST2-DATA. + 05 T2-ENTRY OCCURS 3 TIMES. + 10 T2-KEY PIC X(10). + 10 T2-DATA PIC X(20). + 10 T2-VALUE PIC 9(05). + + *> Test data for Input 3 (BSS System C CDRs, sorted ascending) + 01 TEST3-DATA. + 05 FILLER PIC X(35) VALUE + "CDRA00000313300133001 00175". + 05 FILLER PIC X(35) VALUE + "CDRB00000213200132001 00250". + 05 FILLER PIC X(35) VALUE + "CDRF00000113100131001 00600". + + 01 TEST3-REDEF REDEFINES TEST3-DATA. + 05 T3-ENTRY OCCURS 3 TIMES. + 10 T3-KEY PIC X(10). + 10 T3-DATA PIC X(20). + 10 T3-VALUE PIC 9(05). + + 01 IDX PIC 9(02). + + *> ============================================================ + *> New WS fields for enhanced merge processing + *> ============================================================ + + *> FILE STATUS fields + 01 FS-IN1 PIC X(02). + 88 FS-IN1-OK VALUE "00". + 88 FS-IN1-EOF VALUE "10". + 01 FS-IN2 PIC X(02). + 88 FS-IN2-OK VALUE "00". + 01 FS-IN3 PIC X(02). + 88 FS-IN3-OK VALUE "00". + 01 FS-OUT PIC X(02). + 88 FS-OUT-OK VALUE "00". + 01 FS-WORK PIC X(02). + 01 FS-REPORT PIC X(02). + 88 FS-REPORT-OK VALUE "00". + 01 FS-AUDIT PIC X(02). + 88 FS-AUDIT-OK VALUE "00". + 01 FS-STATS PIC X(02). + 88 FS-STATS-OK VALUE "00". + 01 FS-IN4 PIC X(02). + 88 FS-IN4-OK VALUE "00". + 01 FS-IN5 PIC X(02). + 88 FS-IN5-OK VALUE "00". + 01 FS-IN6 PIC X(02). + 88 FS-IN6-OK VALUE "00". + 01 FS-WORK2 PIC X(02). + + *> Current timestamp + 01 WS-CURRENT-DATE-TIME. + 05 WS-CDT-DATE PIC 9(08). + 05 WS-CDT-TIME PIC 9(06). + 05 WS-CDT-MS PIC 9(02). + 05 WS-CDT-OFFSET PIC 9(04). + 05 WS-CDT-SIGN PIC X(01). + + *> Audit message buffer + 01 WS-AUDIT-MESSAGE PIC X(55). + + *> Audit entry + 01 WS-AUDIT-LINE. + 05 FILLER PIC X(01) VALUE SPACE. + 05 WS-AL-DATE PIC 9(08). + 05 FILLER PIC X(01) VALUE SPACE. + 05 WS-AL-TIME PIC 9(06). + 05 FILLER PIC X(01) VALUE SPACE. + 05 WS-AL-SEVERITY PIC X(01). + 05 FILLER PIC X(02) VALUE SPACE. + 05 WS-AL-MESSAGE PIC X(55). + + 01 WS-ERROR-SEVERITY PIC X(01). + 88 WS-ERR-INFO VALUE "I". + 88 WS-ERR-WARN VALUE "W". + 88 WS-ERR-ERROR VALUE "E". + 88 WS-ERR-FATAL VALUE "F". + + *> Merge statistics + 01 WS-MERGE-STATS. + 05 WS-MS-SRC1-COUNT PIC 9(09) VALUE 0. + 05 WS-MS-SRC2-COUNT PIC 9(09) VALUE 0. + 05 WS-MS-SRC3-COUNT PIC 9(09) VALUE 0. + 05 WS-MS-SRC4-COUNT PIC 9(09) VALUE 0. + 05 WS-MS-SRC5-COUNT PIC 9(09) VALUE 0. + 05 WS-MS-SRC6-COUNT PIC 9(09) VALUE 0. + 05 WS-MS-TOTAL-MERGED PIC 9(09) VALUE 0. + 05 WS-MS-DUP-REMOVED PIC 9(09) VALUE 0. + 05 WS-MS-INVALID-COUNT PIC 9(09) VALUE 0. + 05 WS-MS-HASH-TOTAL PIC 9(15) VALUE 0. + + *> Detail line for enhanced merge output + 01 WS-ENH-DETAIL-LINE. + 05 FILLER PIC X(02) VALUE SPACE. + 05 EDL-KEY PIC X(10). + 05 FILLER PIC X(01) VALUE SPACE. + 05 EDL-DATA PIC X(20). + 05 FILLER PIC X(01) VALUE SPACE. + 05 EDL-VALUE PIC Z(9)9. + 05 FILLER PIC X(02) VALUE SPACE. + 05 EDL-SOURCE PIC X(05). + 05 FILLER PIC X(02) VALUE SPACE. + 05 EDL-TIMESTAMP PIC 9(08). + + *> Dedup tracking + 01 WS-PREV-MERGE-KEY PIC X(10). + 01 WS-PREV-MERGE-SOURCE PIC X(05). + 01 WS-PREV-MERGE-TS PIC 9(08). + + *> Source priority table + 01 WS-SOURCE-PRIORITY. + 05 WS-SP-ENTRY OCCURS 6 TIMES. + 10 WS-SP-NAME PIC X(05). + 10 WS-SP-RANK PIC 9(01). + + *> Source names for stats + 01 WS-SOURCE-NAMES. + 05 FILLER PIC X(35) VALUE + "BSS-A BSS-B BSS-C BSS-D BSS-E BSS-F". + + 01 WS-SOURCE-NAMES-REDEF REDEFINES WS-SOURCE-NAMES. + 05 WS-SN-ENTRY OCCURS 6 TIMES. + 10 WS-SN-NAME PIC X(05). + + *> Enhanced test data for source-tagged inputs + *> Format: key(10) + data(20) + value(5) + source(5) + timestamp(8) = 48 + 01 ENH4-DATA. + 05 FILLER PIC X(48) VALUE + "CDRA00000113800138001 00100BSS-A 20260601". + 05 FILLER PIC X(48) VALUE + "CDRB00000113900139001 00200BSS-A 20260601". + 05 FILLER PIC X(48) VALUE + "CDRC00000113700137001 00300BSS-A 20260601". + + 01 ENH4-REDEF REDEFINES ENH4-DATA. + 05 E4-ENTRY OCCURS 3 TIMES. + 10 E4-KEY PIC X(10). + 10 E4-DATA PIC X(20). + 10 E4-VALUE PIC 9(05). + 10 E4-SOURCE PIC X(05). + 10 E4-TIMESTAMP PIC 9(08). + + 01 ENH5-DATA. + 05 FILLER PIC X(48) VALUE + "CDRA00000113800138001 00150BSS-B 20260602". + 05 FILLER PIC X(48) VALUE + "CDRB00000213600136001 00250BSS-B 20260602". + 05 FILLER PIC X(48) VALUE + "CDRD00000113500135001 00400BSS-B 20260602". + + 01 ENH5-REDEF REDEFINES ENH5-DATA. + 05 E5-ENTRY OCCURS 3 TIMES. + 10 E5-KEY PIC X(10). + 10 E5-DATA PIC X(20). + 10 E5-VALUE PIC 9(05). + 10 E5-SOURCE PIC X(05). + 10 E5-TIMESTAMP PIC 9(08). + + 01 ENH6-DATA. + 05 FILLER PIC X(48) VALUE + "CDRA00000113800138001 00175BSS-C 20260603". + 05 FILLER PIC X(48) VALUE + "CDRB00000313400134001 00350BSS-C 20260603". + 05 FILLER PIC X(48) VALUE + "CDRE00000113300133001 00500BSS-C 20260603". + + 01 ENH6-REDEF REDEFINES ENH6-DATA. + 05 E6-ENTRY OCCURS 3 TIMES. + 10 E6-KEY PIC X(10). + 10 E6-DATA PIC X(20). + 10 E6-VALUE PIC 9(05). + 10 E6-SOURCE PIC X(05). + 10 E6-TIMESTAMP PIC 9(08). + + 01 ENH-IDX PIC 9(02). + + *> Report header templates + 01 WS-RPT-HEADER1. + 05 FILLER PIC X(30) VALUE + "MERGE REPORT - RUN AT ". + 05 RPT1-DATE PIC 9(08). + 05 FILLER PIC X(01) VALUE SPACE. + 05 RPT1-TIME PIC 9(06). + + 01 WS-RPT-HEADER2. + 05 FILLER PIC X(80) VALUE ALL "=". + + PROCEDURE DIVISION. + MAIN-PROCEDURE. + + OPEN OUTPUT FILE-REPORT. + + *> ======================================== + *> MR-N001: 2-file MERGE + *> ======================================== + DISPLAY "=== MR-N001: 2-file MERGE ===". + MOVE "MR-N001: 2-file MERGE" TO REPORT-REC. + WRITE REPORT-REC. + PERFORM WRITE-HEADER. + + PERFORM INIT-FILE1. + PERFORM INIT-FILE2. + + MERGE FILE-WORK ON ASCENDING KEY WR-KEY + USING FILE-IN1, FILE-IN2 + GIVING FILE-OUT. + + PERFORM DISPLAY-MERGE-OUTPUT. + + *> ======================================== + *> MR-N002: 3-file MERGE + *> ======================================== + DISPLAY "=== MR-N002: 3-file MERGE ===". + MOVE "MR-N002: 3-file MERGE" TO REPORT-REC. + WRITE REPORT-REC. + PERFORM WRITE-HEADER. + + PERFORM INIT-FILE1. + PERFORM INIT-FILE2. + PERFORM INIT-FILE3. + + MERGE FILE-WORK ON ASCENDING KEY WR-KEY + USING FILE-IN1, FILE-IN2, FILE-IN3 + GIVING FILE-OUT. + + PERFORM DISPLAY-MERGE-OUTPUT. + + *> ======================================== + *> MR-N003: Duplicate key MERGE + *> ======================================== + DISPLAY "=== MR-N003: Duplicate key MERGE ===". + MOVE "MR-N003: Duplicate key MERGE" TO REPORT-REC. + WRITE REPORT-REC. + PERFORM WRITE-HEADER. + + *> Create input files with overlapping keys + PERFORM INIT-DUP-FILE1. + PERFORM INIT-DUP-FILE2. + + MERGE FILE-WORK ON ASCENDING KEY WR-KEY + USING FILE-IN1, FILE-IN2 + GIVING FILE-OUT. + + PERFORM DISPLAY-MERGE-OUTPUT. + + *> ======================================== + *> MR-N004: MERGE with OUTPUT PROCEDURE + *> ======================================== + DISPLAY "=== MR-N004: MERGE with OUTPUT PROCEDURE ===". + MOVE "MR-N004: MERGE OUTPUT PROCEDURE" TO REPORT-REC. + WRITE REPORT-REC. + PERFORM WRITE-HEADER. + + PERFORM INIT-FILE1. + PERFORM INIT-FILE2. + + MERGE FILE-WORK ON ASCENDING KEY WR-KEY + USING FILE-IN1, FILE-IN2 + OUTPUT PROCEDURE IS MERGE-OUTPUT-PROC. + + PERFORM DISPLAY-MERGE-OUTPUT. + + *> ======================================== + *> MR-A001: Unsorted input (expected anomaly) + *> ======================================== + DISPLAY "=== MR-A001: Unsorted input (anomaly) ===". + MOVE "MR-A001: Unsorted input" TO REPORT-REC. + WRITE REPORT-REC. + + OPEN OUTPUT FILE-IN1. + MOVE "CDR-Z-0001PHONE-13800138001 00100" TO IN1-REC. + WRITE IN1-REC. + MOVE "CDR-A-0001PHONE-13900139001 00200" TO IN1-REC. + WRITE IN1-REC. + CLOSE FILE-IN1. + + OPEN OUTPUT FILE-IN2. + MOVE "CDR-G-0001PHONE-13700137001 00300" TO IN2-REC. + WRITE IN2-REC. + MOVE "CDR-B-0001PHONE-13600136001 00400" TO IN2-REC. + WRITE IN2-REC. + CLOSE FILE-IN2. + + MERGE FILE-WORK ON ASCENDING KEY WR-KEY + USING FILE-IN1, FILE-IN2 + GIVING FILE-OUT. + + DISPLAY " (Note: MERGE with unsorted input may produce" + DISPLAY " unpredictable results. This is expected." + PERFORM DISPLAY-MERGE-OUTPUT. + + *> ================================================================ + *> MR-N005: 3-file enhanced MERGE with source tagging + *> Uses FILE-WORK2 and source-tagged inputs + *> ================================================================ + DISPLAY "=== MR-N005: 3-file source-tagged MERGE ===". + PERFORM 1000-INIT. + PERFORM INIT-FILE4. + PERFORM INIT-FILE5. + PERFORM INIT-FILE6. + + MERGE FILE-WORK2 ON ASCENDING KEY W2R-KEY + USING FILE-IN4, FILE-IN5, FILE-IN6 + GIVING FILE-OUT. + + PERFORM DISPLAY-ENH-MERGE-OUTPUT. + DISPLAY " MR-N005: Source-tagged merge complete". + + *> ================================================================ + *> MR-N006: MERGE with OUTPUT PROCEDURE and source identification + *> ================================================================ + DISPLAY "=== MR-N006: MERGE OUTPUT PROCEDURE with source ===". + PERFORM 1000-INIT. + PERFORM INIT-FILE4. + PERFORM INIT-FILE5. + PERFORM INIT-FILE6. + + MERGE FILE-WORK2 ON ASCENDING KEY W2R-KEY + USING FILE-IN4, FILE-IN5, FILE-IN6 + OUTPUT PROCEDURE IS ENH-MERGE-OUTPUT-PROC. + + DISPLAY " MR-N006: Source-identified merge complete". + MOVE "MR-N006: Source-identified merge complete" + TO WS-AUDIT-MESSAGE. + MOVE "I" TO WS-ERROR-SEVERITY. + PERFORM 5000-AUDIT. + + *> ================================================================ + *> MR-N007: Dedup merge - same key from different sources + *> Keep newest record (highest timestamp) + *> ================================================================ + DISPLAY "=== MR-N007: Dedup merge (keep newest) ===". + PERFORM 1000-INIT. + + *> Create files with overlapping keys at different timestamps + PERFORM INIT-DUP-FILE4. + PERFORM INIT-DUP-FILE5. + PERFORM INIT-DUP-FILE6. + + MERGE FILE-WORK2 ON ASCENDING KEY W2R-KEY + DESCENDING KEY W2R-TIMESTAMP + USING FILE-IN4, FILE-IN5, FILE-IN6 + OUTPUT PROCEDURE IS DEDUP-MERGE-OUTPUT. + + PERFORM WRITE-MERGE-STATS. + DISPLAY " MR-N007: Dedup merge complete". + MOVE "MR-N007: Dedup merge (keep newest) complete" + TO WS-AUDIT-MESSAGE. + MOVE "I" TO WS-ERROR-SEVERITY. + PERFORM 5000-AUDIT. + + *> ================================================================ + *> MR-N008: Source file validation before merge + *> ================================================================ + DISPLAY "=== MR-N008: Source file validation ===". + PERFORM 1000-INIT. + PERFORM INIT-FILE4. + PERFORM INIT-FILE5. + PERFORM INIT-FILE6. + + PERFORM VALIDATE-SOURCE-FILES. + + IF WS-ERROR-SEVERITY NOT = "F" + MERGE FILE-WORK2 ON ASCENDING KEY W2R-KEY + USING FILE-IN4, FILE-IN5, FILE-IN6 + OUTPUT PROCEDURE IS ENH-MERGE-OUTPUT-PROC + DISPLAY " MR-N008: Merge after validation complete" + ELSE + DISPLAY " MR-N008: Skipped due to validation failure" + END-IF. + + MOVE "MR-N008: Source validation completed" + TO WS-AUDIT-MESSAGE. + MOVE "I" TO WS-ERROR-SEVERITY. + PERFORM 5000-AUDIT. + + *> ================================================================ + *> MR-N009: Conflict resolution with priority rules + *> BSS-A > BSS-B > BSS-C for conflicts + *> ================================================================ + DISPLAY "=== MR-N009: Conflict resolution by priority ===". + PERFORM 1000-INIT. + PERFORM INIT-CONFLICT-FILES. + + MERGE FILE-WORK2 ON ASCENDING KEY W2R-KEY + USING FILE-IN4, FILE-IN5, FILE-IN6 + OUTPUT PROCEDURE IS CONFLICT-RESOLVE-OUTPUT. + + PERFORM WRITE-MERGE-STATS. + DISPLAY " MR-N009: Conflict resolution complete". + MOVE "MR-N009: Conflict resolution by priority complete" + TO WS-AUDIT-MESSAGE. + MOVE "I" TO WS-ERROR-SEVERITY. + PERFORM 5000-AUDIT. + + *> Close all files and finish + CLOSE FILE-REPORT. + CLOSE FILE-AUDIT. + CLOSE FILE-STATS. + DISPLAY "=== All MR-N001..N009 + A001 complete ===". + STOP RUN. + + *> ================================================================ + *> Existing paragraphs (preserved exactly) + *> ================================================================ + + WRITE-HEADER. + MOVE WS-HEADER-LINE TO REPORT-REC. + WRITE REPORT-REC. + MOVE SPACES TO REPORT-REC. + WRITE REPORT-REC. + + INIT-FILE1. + OPEN OUTPUT FILE-IN1. + PERFORM VARYING IDX FROM 1 BY 1 UNTIL IDX > 3 + MOVE T1-KEY(IDX) TO IN1-KEY + MOVE T1-DATA(IDX) TO IN1-DATA + MOVE T1-VALUE(IDX) TO IN1-VALUE + WRITE IN1-REC + END-PERFORM. + CLOSE FILE-IN1. + + INIT-FILE2. + OPEN OUTPUT FILE-IN2. + PERFORM VARYING IDX FROM 1 BY 1 UNTIL IDX > 3 + MOVE T2-KEY(IDX) TO IN2-KEY + MOVE T2-DATA(IDX) TO IN2-DATA + MOVE T2-VALUE(IDX) TO IN2-VALUE + WRITE IN2-REC + END-PERFORM. + CLOSE FILE-IN2. + + INIT-FILE3. + OPEN OUTPUT FILE-IN3. + PERFORM VARYING IDX FROM 1 BY 1 UNTIL IDX > 3 + MOVE T3-KEY(IDX) TO IN3-KEY + MOVE T3-DATA(IDX) TO IN3-DATA + MOVE T3-VALUE(IDX) TO IN3-VALUE + WRITE IN3-REC + END-PERFORM. + CLOSE FILE-IN3. + + INIT-DUP-FILE1. + OPEN OUTPUT FILE-IN1. + MOVE "CDR-D00001" TO IN1-KEY. + MOVE "DUP-FILE1-CALL-001 " TO IN1-DATA. + MOVE 00100 TO IN1-VALUE. + WRITE IN1-REC. + MOVE "CDR-D00002" TO IN1-KEY. + MOVE "DUP-FILE1-CALL-002 " TO IN1-DATA. + MOVE 00200 TO IN1-VALUE. + WRITE IN1-REC. + CLOSE FILE-IN1. + + INIT-DUP-FILE2. + OPEN OUTPUT FILE-IN2. + MOVE "CDR-D00001" TO IN2-KEY. + MOVE "DUP-FILE2-CALL-001 " TO IN2-DATA. + MOVE 00300 TO IN2-VALUE. + WRITE IN2-REC. + MOVE "CDR-D00003" TO IN2-KEY. + MOVE "DUP-FILE2-CALL-003 " TO IN2-DATA. + MOVE 00400 TO IN2-VALUE. + WRITE IN2-REC. + CLOSE FILE-IN2. + + DISPLAY-MERGE-OUTPUT. + OPEN INPUT FILE-OUT. + MOVE 0 TO WS-RECORD-COUNT. + MOVE 0 TO WS-TOTAL-VALUE. + MOVE "N" TO WS-EOF. + PERFORM UNTIL WS-EOF-Y + READ FILE-OUT INTO OUT-REC + AT END + MOVE "Y" TO WS-EOF + NOT AT END + ADD 1 TO WS-RECORD-COUNT + ADD OUT-VALUE TO WS-TOTAL-VALUE + MOVE OUT-KEY TO DL-KEY + MOVE OUT-DATA TO DL-DATA + MOVE OUT-VALUE TO DL-VALUE + MOVE SPACES TO DL-SOURCE + DISPLAY " " WS-DETAIL-LINE + MOVE WS-DETAIL-LINE TO REPORT-REC + WRITE REPORT-REC + END-READ + END-PERFORM. + CLOSE FILE-OUT. + DISPLAY " Total records: " WS-RECORD-COUNT + " Total value: " WS-TOTAL-VALUE. + MOVE SPACES TO REPORT-REC. + WRITE REPORT-REC. + STRING " Total records: " WS-RECORD-COUNT + " Total value: " WS-TOTAL-VALUE + DELIMITED BY SIZE INTO REPORT-REC. + WRITE REPORT-REC. + MOVE SPACES TO REPORT-REC. + WRITE REPORT-REC. + + MERGE-OUTPUT-PROC SECTION. + *> OUTPUT PROCEDURE for MERGE - adds source tagging + OPEN OUTPUT FILE-OUT. + MOVE "N" TO WS-EOF. + PERFORM UNTIL WS-EOF-Y + RETURN FILE-WORK INTO WORK-REC + AT END + MOVE "Y" TO WS-EOF + NOT AT END + MOVE WORK-REC TO OUT-REC + WRITE OUT-REC + END-RETURN + END-PERFORM. + CLOSE FILE-OUT. + + *> ================================================================ + *> New enhanced sections + *> ================================================================ + + *> ---------------------------------------------------------------- + *> 1000-INIT: Initialize batch totals, open audit/stats files + *> ---------------------------------------------------------------- + 1000-INIT SECTION. + MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE-TIME. + MOVE 0 TO WS-MS-SRC1-COUNT + MOVE 0 TO WS-MS-SRC2-COUNT + MOVE 0 TO WS-MS-SRC3-COUNT + MOVE 0 TO WS-MS-SRC4-COUNT + MOVE 0 TO WS-MS-SRC5-COUNT + MOVE 0 TO WS-MS-SRC6-COUNT + MOVE 0 TO WS-MS-TOTAL-MERGED + MOVE 0 TO WS-MS-DUP-REMOVED + MOVE 0 TO WS-MS-INVALID-COUNT + MOVE 0 TO WS-MS-HASH-TOTAL + MOVE SPACES TO WS-PREV-MERGE-KEY + MOVE SPACES TO WS-PREV-MERGE-SOURCE + MOVE ZEROS TO WS-PREV-MERGE-TS + MOVE "I" TO WS-ERROR-SEVERITY. + + *> Initialize source priority (lower rank = higher priority) + MOVE "BSS-A" TO WS-SP-NAME(1) + MOVE 1 TO WS-SP-RANK(1) + MOVE "BSS-B" TO WS-SP-NAME(2) + MOVE 2 TO WS-SP-RANK(2) + MOVE "BSS-C" TO WS-SP-NAME(3) + MOVE 3 TO WS-SP-RANK(3) + MOVE "BSS-D" TO WS-SP-NAME(4) + MOVE 4 TO WS-SP-RANK(4) + MOVE "BSS-E" TO WS-SP-NAME(5) + MOVE 5 TO WS-SP-RANK(5) + MOVE "BSS-F" TO WS-SP-NAME(6) + MOVE 6 TO WS-SP-RANK(6). + + DISPLAY " 1000-INIT at " WS-CDT-DATE "/" WS-CDT-TIME. + + OPEN OUTPUT FILE-AUDIT. + IF NOT FS-AUDIT-OK + DISPLAY "ERROR: FILE-AUDIT open failed, FS=" FS-AUDIT + MOVE "E" TO WS-ERROR-SEVERITY + END-IF. + + OPEN OUTPUT FILE-STATS. + IF NOT FS-STATS-OK + DISPLAY "ERROR: FILE-STATS open failed, FS=" FS-STATS + MOVE "E" TO WS-ERROR-SEVERITY + END-IF. + + MOVE "1000-INIT: Initialization complete" + TO WS-AUDIT-MESSAGE. + PERFORM 5000-AUDIT. + EXIT. + + *> ---------------------------------------------------------------- + *> 2000-OPEN-FILES: Enhanced file open with FILE STATUS + *> ---------------------------------------------------------------- + 2000-OPEN-FILES SECTION. + DISPLAY " 2000-OPEN-FILES: Opening merge files...". + + OPEN OUTPUT FILE-IN4. + IF NOT FS-IN4-OK + DISPLAY "ERROR 2000: FILE-IN4 open failed, FS=" FS-IN4 + MOVE "E" TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE + END-IF. + + OPEN OUTPUT FILE-IN5. + IF NOT FS-IN5-OK + DISPLAY "ERROR 2000: FILE-IN5 open failed, FS=" FS-IN5 + MOVE "E" TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE + END-IF. + + OPEN OUTPUT FILE-IN6. + IF NOT FS-IN6-OK + DISPLAY "ERROR 2000: FILE-IN6 open failed, FS=" FS-IN6 + MOVE "E" TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE + END-IF. + + MOVE "2000-OPEN-FILES: Enhanced files opened" + TO WS-AUDIT-MESSAGE. + PERFORM 5000-AUDIT. + EXIT. + + *> ---------------------------------------------------------------- + *> 3000-PROCESS: Main merge processing pipeline + *> ---------------------------------------------------------------- + 3000-PROCESS SECTION. + DISPLAY " 3000-PROCESS: Executing merge...". + + MERGE FILE-WORK2 ON ASCENDING KEY W2R-KEY + USING FILE-IN4, FILE-IN5, FILE-IN6 + OUTPUT PROCEDURE IS ENH-MERGE-OUTPUT-PROC. + + MOVE "3000-PROCESS: Merge pipeline complete" + TO WS-AUDIT-MESSAGE. + PERFORM 5000-AUDIT. + EXIT. + + *> ---------------------------------------------------------------- + *> 4000-REPORT: Generate merge summary report + *> ---------------------------------------------------------------- + 4000-REPORT SECTION. + DISPLAY " 4000-REPORT: Generating merge report...". + + MOVE WS-CDT-DATE TO RPT1-DATE. + MOVE WS-CDT-TIME TO RPT1-TIME. + MOVE WS-RPT-HEADER1 TO REPORT-REC. + WRITE REPORT-REC. + MOVE WS-RPT-HEADER2 TO REPORT-REC. + WRITE REPORT-REC. + + MOVE "4000-REPORT: Merge report generated" + TO WS-AUDIT-MESSAGE. + PERFORM 5000-AUDIT. + EXIT. + + *> ---------------------------------------------------------------- + *> 5000-AUDIT: Write audit entry with timestamp/severity + *> ---------------------------------------------------------------- + 5000-AUDIT SECTION. + MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE-TIME. + MOVE WS-CDT-DATE TO WS-AL-DATE. + MOVE WS-CDT-TIME TO WS-AL-TIME. + MOVE WS-ERROR-SEVERITY TO WS-AL-SEVERITY. + IF WS-AL-SEVERITY = SPACE + MOVE "I" TO WS-AL-SEVERITY + END-IF. + MOVE WS-AUDIT-MESSAGE TO WS-AL-MESSAGE. + + MOVE WS-AUDIT-LINE TO AUDIT-REC. + WRITE AUDIT-REC. + IF NOT FS-AUDIT-OK + DISPLAY "AUDIT WRITE FAILED: FS=" FS-AUDIT + END-IF. + + DISPLAY " AUDIT [" WS-AL-SEVERITY "] " + WS-AL-DATE "/" WS-AL-TIME " " + WS-AL-MESSAGE. + EXIT. + + *> ---------------------------------------------------------------- + *> 6000-ERROR-HANDLE: Handle errors with severity levels + *> ---------------------------------------------------------------- + 6000-ERROR-HANDLE SECTION. + EVALUATE WS-ERROR-SEVERITY + WHEN "I" + DISPLAY " INFO: Recoverable condition" + WHEN "W" + DISPLAY " WARN: Non-critical issue detected" + PERFORM 5000-AUDIT + WHEN "E" + DISPLAY " ERROR: Processing may be affected" + PERFORM 5000-AUDIT + WHEN "F" + DISPLAY " FATAL: Aborting processing" + PERFORM 5000-AUDIT + STOP RUN + WHEN OTHER + DISPLAY " INFO: Unknown severity - continuing" + END-EVALUATE. + + MOVE "I" TO WS-ERROR-SEVERITY. + EXIT. + + *> ---------------------------------------------------------------- + *> 9000-EXIT: Clean exit with file closure + *> ---------------------------------------------------------------- + 9000-EXIT SECTION. + DISPLAY " 9000-EXIT: Closing files and exiting...". + + CLOSE FILE-AUDIT. + CLOSE FILE-STATS. + CLOSE FILE-REPORT. + + MOVE "9000-EXIT: Normal termination" TO WS-AUDIT-MESSAGE. + MOVE "I" TO WS-ERROR-SEVERITY. + PERFORM 5000-AUDIT. + + DISPLAY " 9000-EXIT: All files closed. Exiting.". + EXIT. + + *> ================================================================ + *> INIT-FILE4: Create enhanced input file 4 (BSS-D) + *> ================================================================ + INIT-FILE4. + OPEN OUTPUT FILE-IN4. + IF NOT FS-IN4-OK + DISPLAY "ERROR INIT-FILE4: open failed, FS=" FS-IN4 + MOVE "E" TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE + END-IF. + + PERFORM VARYING ENH-IDX FROM 1 BY 1 UNTIL ENH-IDX > 3 + MOVE E4-KEY(ENH-IDX) TO IN4-KEY + MOVE E4-DATA(ENH-IDX) TO IN4-DATA + MOVE E4-VALUE(ENH-IDX) TO IN4-VALUE + MOVE E4-SOURCE(ENH-IDX) TO IN4-SOURCE + MOVE E4-TIMESTAMP(ENH-IDX) TO IN4-TIMESTAMP + WRITE IN4-REC + IF NOT FS-IN4-OK + DISPLAY "ERROR: FILE-IN4 write failed, FS=" FS-IN4 + END-IF + END-PERFORM. + + CLOSE FILE-IN4. + DISPLAY " INIT-FILE4: 3 source-tagged records written". + EXIT. + + *> ================================================================ + *> INIT-FILE5: Create enhanced input file 5 (BSS-E) + *> ================================================================ + INIT-FILE5. + OPEN OUTPUT FILE-IN5. + IF NOT FS-IN5-OK + DISPLAY "ERROR INIT-FILE5: open failed, FS=" FS-IN5 + MOVE "E" TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE + END-IF. + + PERFORM VARYING ENH-IDX FROM 1 BY 1 UNTIL ENH-IDX > 3 + MOVE E5-KEY(ENH-IDX) TO IN5-KEY + MOVE E5-DATA(ENH-IDX) TO IN5-DATA + MOVE E5-VALUE(ENH-IDX) TO IN5-VALUE + MOVE E5-SOURCE(ENH-IDX) TO IN5-SOURCE + MOVE E5-TIMESTAMP(ENH-IDX) TO IN5-TIMESTAMP + WRITE IN5-REC + IF NOT FS-IN5-OK + DISPLAY "ERROR: FILE-IN5 write failed, FS=" FS-IN5 + END-IF + END-PERFORM. + + CLOSE FILE-IN5. + DISPLAY " INIT-FILE5: 3 source-tagged records written". + EXIT. + + *> ================================================================ + *> INIT-FILE6: Create enhanced input file 6 (BSS-F) + *> ================================================================ + INIT-FILE6. + OPEN OUTPUT FILE-IN6. + IF NOT FS-IN6-OK + DISPLAY "ERROR INIT-FILE6: open failed, FS=" FS-IN6 + MOVE "E" TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE + END-IF. + + PERFORM VARYING ENH-IDX FROM 1 BY 1 UNTIL ENH-IDX > 3 + MOVE E6-KEY(ENH-IDX) TO IN6-KEY + MOVE E6-DATA(ENH-IDX) TO IN6-DATA + MOVE E6-VALUE(ENH-IDX) TO IN6-VALUE + MOVE E6-SOURCE(ENH-IDX) TO IN6-SOURCE + MOVE E6-TIMESTAMP(ENH-IDX) TO IN6-TIMESTAMP + WRITE IN6-REC + IF NOT FS-IN6-OK + DISPLAY "ERROR: FILE-IN6 write failed, FS=" FS-IN6 + END-IF + END-PERFORM. + + CLOSE FILE-IN6. + DISPLAY " INIT-FILE6: 3 source-tagged records written". + EXIT. + + *> ================================================================ + *> INIT-DUP-FILE4/DUP-FILE5/DUP-FILE6: Duplicate key files + *> ================================================================ + INIT-DUP-FILE4. + OPEN OUTPUT FILE-IN4. + IF NOT FS-IN4-OK + DISPLAY "ERROR INIT-DUP4: open failed, FS=" FS-IN4 + END-IF. + MOVE "CDR-CONF01" TO IN4-KEY. + MOVE "CONFLICT-CDR-001-A " TO IN4-DATA. + MOVE 00100 TO IN4-VALUE. + MOVE "BSS-D" TO IN4-SOURCE. + MOVE 20260601 TO IN4-TIMESTAMP. + WRITE IN4-REC. + MOVE "CDR-CONF02" TO IN4-KEY. + MOVE "CONFLICT-CDR-002-A " TO IN4-DATA. + MOVE 00200 TO IN4-VALUE. + MOVE "BSS-D" TO IN4-SOURCE. + MOVE 20260601 TO IN4-TIMESTAMP. + WRITE IN4-REC. + CLOSE FILE-IN4. + DISPLAY " INIT-DUP-FILE4: 2 records (1 conflict)". + EXIT. + + INIT-DUP-FILE5. + OPEN OUTPUT FILE-IN5. + IF NOT FS-IN5-OK + DISPLAY "ERROR INIT-DUP5: open failed, FS=" FS-IN5 + END-IF. + MOVE "CDR-CONF01" TO IN5-KEY. + MOVE "CONFLICT-CDR-001-B " TO IN5-DATA. + MOVE 00150 TO IN5-VALUE. + MOVE "BSS-E" TO IN5-SOURCE. + MOVE 20260602 TO IN5-TIMESTAMP. + WRITE IN5-REC. + MOVE "CDR-CONF03" TO IN5-KEY. + MOVE "CONFLICT-CDR-003-B " TO IN5-DATA. + MOVE 00300 TO IN5-VALUE. + MOVE "BSS-E" TO IN5-SOURCE. + MOVE 20260602 TO IN5-TIMESTAMP. + WRITE IN5-REC. + CLOSE FILE-IN5. + DISPLAY " INIT-DUP-FILE5: 2 records (1 conflict)". + EXIT. + + INIT-DUP-FILE6. + OPEN OUTPUT FILE-IN6. + IF NOT FS-IN6-OK + DISPLAY "ERROR INIT-DUP6: open failed, FS=" FS-IN6 + END-IF. + MOVE "CDR-CONF01" TO IN6-KEY. + MOVE "CONFLICT-CDR-001-C " TO IN6-DATA. + MOVE 00175 TO IN6-VALUE. + MOVE "BSS-F" TO IN6-SOURCE. + MOVE 20260603 TO IN6-TIMESTAMP. + WRITE IN6-REC. + MOVE "CDR-CONF04" TO IN6-KEY. + MOVE "CONFLICT-CDR-004-C " TO IN6-DATA. + MOVE 00400 TO IN6-VALUE. + MOVE "BSS-F" TO IN6-SOURCE. + MOVE 20260603 TO IN6-TIMESTAMP. + WRITE IN6-REC. + CLOSE FILE-IN6. + DISPLAY " INIT-DUP-FILE6: 2 records (1 conflict)". + EXIT. + + *> ================================================================ + *> INIT-CONFLICT-FILES: Create files for conflict resolution test + *> ================================================================ + INIT-CONFLICT-FILES. + *> FILE-IN4 (BSS-D - highest priority) + OPEN OUTPUT FILE-IN4. + MOVE "CDR-CONF01" TO IN4-KEY. + MOVE "PRIORITY-A-VERSION " TO IN4-DATA. + MOVE 00100 TO IN4-VALUE. + MOVE "BSS-D" TO IN4-SOURCE. + MOVE 20260601 TO IN4-TIMESTAMP. + WRITE IN4-REC. + MOVE "CDR-UNIQU1" TO IN4-KEY. + MOVE "UNIQUE-A-RECORD " TO IN4-DATA. + MOVE 00200 TO IN4-VALUE. + MOVE "BSS-D" TO IN4-SOURCE. + MOVE 20260601 TO IN4-TIMESTAMP. + WRITE IN4-REC. + CLOSE FILE-IN4. + + *> FILE-IN5 (BSS-E - medium priority) + OPEN OUTPUT FILE-IN5. + MOVE "CDR-CONF01" TO IN5-KEY. + MOVE "PRIORITY-B-VERSION " TO IN5-DATA. + MOVE 00150 TO IN5-VALUE. + MOVE "BSS-E" TO IN5-SOURCE. + MOVE 20260602 TO IN5-TIMESTAMP. + WRITE IN5-REC. + MOVE "CDR-CONF02" TO IN5-KEY. + MOVE "CONFLICT-TWO-B " TO IN5-DATA. + MOVE 00300 TO IN5-VALUE. + MOVE "BSS-E" TO IN5-SOURCE. + MOVE 20260602 TO IN5-TIMESTAMP. + WRITE IN5-REC. + CLOSE FILE-IN5. + + *> FILE-IN6 (BSS-F - lowest priority) + OPEN OUTPUT FILE-IN6. + MOVE "CDR-CONF01" TO IN6-KEY. + MOVE "PRIORITY-C-VERSION " TO IN6-DATA. + MOVE 00175 TO IN6-VALUE. + MOVE "BSS-F" TO IN6-SOURCE. + MOVE 20260603 TO IN6-TIMESTAMP. + WRITE IN6-REC. + MOVE "CDR-CONF02" TO IN6-KEY. + MOVE "CONFLICT-TWO-C " TO IN6-DATA. + MOVE 00350 TO IN6-VALUE. + MOVE "BSS-F" TO IN6-SOURCE. + MOVE 20260603 TO IN6-TIMESTAMP. + WRITE IN6-REC. + CLOSE FILE-IN6. + + DISPLAY " INIT-CONFLICT-FILES: 3 files with conflicts". + EXIT. + + *> ================================================================ + *> DISPLAY-ENH-MERGE-OUTPUT: Display enhanced merge output + *> ================================================================ + DISPLAY-ENH-MERGE-OUTPUT. + OPEN INPUT FILE-OUT. + IF NOT FS-OUT-OK + DISPLAY "ERROR: FILE-OUT open failed, FS=" FS-OUT + EXIT + END-IF. + + MOVE 0 TO WS-RECORD-COUNT. + MOVE 0 TO WS-TOTAL-VALUE. + MOVE "N" TO WS-EOF. + PERFORM UNTIL WS-EOF-Y + READ FILE-OUT INTO OUT-REC + AT END + MOVE "Y" TO WS-EOF + NOT AT END + ADD 1 TO WS-RECORD-COUNT + ADD OUT-VALUE TO WS-TOTAL-VALUE + MOVE OUT-KEY TO DL-KEY + MOVE OUT-DATA TO DL-DATA + MOVE OUT-VALUE TO DL-VALUE + MOVE "ENH" TO DL-SOURCE + DISPLAY " " WS-DETAIL-LINE + END-READ + END-PERFORM. + CLOSE FILE-OUT. + DISPLAY " Enhanced merged: " WS-RECORD-COUNT + " records, value=" WS-TOTAL-VALUE. + EXIT. + + *> ================================================================ + *> ENH-MERGE-OUTPUT-PROC: OUTPUT PROCEDURE with source ID + *> ================================================================ + ENH-MERGE-OUTPUT-PROC SECTION. + DISPLAY " ENH-MERGE-OUTPUT-PROC: Source-identified output". + OPEN OUTPUT FILE-OUT. + IF NOT FS-OUT-OK + DISPLAY "ERROR: FILE-OUT open in OUTPUT PROC, FS=" FS-OUT + MOVE "E" TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE + EXIT + END-IF. + + MOVE 0 TO WS-MS-TOTAL-MERGED. + MOVE "N" TO WS-EOF. + + PERFORM UNTIL WS-EOF-Y + RETURN FILE-WORK2 INTO WORK2-REC + AT END + MOVE "Y" TO WS-EOF + NOT AT END + ADD 1 TO WS-MS-TOTAL-MERGED + ADD W2R-VALUE TO WS-MS-HASH-TOTAL + + *> Count by source + EVALUATE W2R-SOURCE + WHEN "BSS-A" + ADD 1 TO WS-MS-SRC1-COUNT + WHEN "BSS-B" + ADD 1 TO WS-MS-SRC2-COUNT + WHEN "BSS-C" + ADD 1 TO WS-MS-SRC3-COUNT + WHEN "BSS-D" + ADD 1 TO WS-MS-SRC4-COUNT + WHEN "BSS-E" + ADD 1 TO WS-MS-SRC5-COUNT + WHEN "BSS-F" + ADD 1 TO WS-MS-SRC6-COUNT + WHEN OTHER + ADD 1 TO WS-MS-INVALID-COUNT + END-EVALUATE + + *> Map work record to output with source visible in data field + MOVE W2R-KEY TO OUT-KEY + MOVE W2R-DATA TO OUT-DATA(1:20) + MOVE W2R-VALUE TO OUT-VALUE + WRITE OUT-REC + IF NOT FS-OUT-OK + DISPLAY "ERROR: write failed, FS=" FS-OUT + END-IF + + *> Display with source info + MOVE W2R-KEY TO EDL-KEY + MOVE W2R-DATA TO EDL-DATA + MOVE W2R-VALUE TO EDL-VALUE + MOVE W2R-SOURCE TO EDL-SOURCE + MOVE W2R-TIMESTAMP TO EDL-TIMESTAMP + DISPLAY WS-ENH-DETAIL-LINE + END-RETURN + END-PERFORM. + + DISPLAY " ENH-MERGE-OUTPUT-PROC: total=" + WS-MS-TOTAL-MERGED. + CLOSE FILE-OUT. + EXIT. + + *> ================================================================ + *> DEDUP-MERGE-OUTPUT: Dedup by key, keep newest (highest timestamp) + *> ================================================================ + DEDUP-MERGE-OUTPUT SECTION. + DISPLAY " DEDUP-MERGE-OUTPUT: Deduplicating by key...". + OPEN OUTPUT FILE-OUT. + IF NOT FS-OUT-OK + DISPLAY "ERROR: FILE-OUT open in DEDUP, FS=" FS-OUT + MOVE "E" TO WS-ERROR-SEVERITY + PERFORM 6000-ERROR-HANDLE + EXIT + END-IF. + + MOVE SPACES TO WS-PREV-MERGE-KEY. + MOVE 0 TO WS-MS-TOTAL-MERGED. + MOVE 0 TO WS-MS-DUP-REMOVED. + MOVE "N" TO WS-EOF. + + *> Since MERGE sorts by KEY ASC and TIMESTAMP DESC, + *> the first occurrence of each key has the highest timestamp + PERFORM UNTIL WS-EOF-Y + RETURN FILE-WORK2 INTO WORK2-REC + AT END + MOVE "Y" TO WS-EOF + NOT AT END + IF W2R-KEY = WS-PREV-MERGE-KEY + *> Duplicate key - skip (already have newest) + ADD 1 TO WS-MS-DUP-REMOVED + DISPLAY " DEDUP removed: " W2R-KEY + " from " W2R-SOURCE + " timestamp=" W2R-TIMESTAMP + ELSE + *> New key - accept + MOVE W2R-KEY TO WS-PREV-MERGE-KEY + MOVE W2R-KEY TO OUT-KEY + MOVE W2R-DATA TO OUT-DATA(1:20) + MOVE W2R-VALUE TO OUT-VALUE + WRITE OUT-REC + ADD 1 TO WS-MS-TOTAL-MERGED + ADD W2R-VALUE TO WS-MS-HASH-TOTAL + + DISPLAY " DEDUP kept: " W2R-KEY + " from " W2R-SOURCE + END-IF + END-RETURN + END-PERFORM. + + DISPLAY " DEDUP-MERGE-OUTPUT: kept=" WS-MS-TOTAL-MERGED + " removed=" WS-MS-DUP-REMOVED. + CLOSE FILE-OUT. + EXIT. + + *> ================================================================ + *> VALIDATE-SOURCE-FILES: Check format of each source file + *> ================================================================ + VALIDATE-SOURCE-FILES. + DISPLAY " VALIDATE-SOURCE-FILES: Checking formats...". + + OPEN INPUT FILE-IN4. + IF NOT FS-IN4-OK + DISPLAY " VALIDATE: FILE-IN4 missing, FS=" FS-IN4 + MOVE "E" TO WS-ERROR-SEVERITY + MOVE "VALIDATE: FILE-IN4 format check failed" + TO WS-AUDIT-MESSAGE + PERFORM 5000-AUDIT + ELSE + DISPLAY " VALIDATE: FILE-IN4 format OK" + CLOSE FILE-IN4 + END-IF. + + OPEN INPUT FILE-IN5. + IF NOT FS-IN5-OK + DISPLAY " VALIDATE: FILE-IN5 missing, FS=" FS-IN5 + MOVE "E" TO WS-ERROR-SEVERITY + MOVE "VALIDATE: FILE-IN5 format check failed" + TO WS-AUDIT-MESSAGE + PERFORM 5000-AUDIT + ELSE + DISPLAY " VALIDATE: FILE-IN5 format OK" + CLOSE FILE-IN5 + END-IF. + + OPEN INPUT FILE-IN6. + IF NOT FS-IN6-OK + DISPLAY " VALIDATE: FILE-IN6 missing, FS=" FS-IN6 + MOVE "E" TO WS-ERROR-SEVERITY + MOVE "VALIDATE: FILE-IN6 format check failed" + TO WS-AUDIT-MESSAGE + PERFORM 5000-AUDIT + ELSE + DISPLAY " VALIDATE: FILE-IN6 format OK" + CLOSE FILE-IN6 + END-IF. + + MOVE "VALIDATE: All source files validated" + TO WS-AUDIT-MESSAGE. + MOVE "I" TO WS-ERROR-SEVERITY. + PERFORM 5000-AUDIT. + EXIT. + + *> ================================================================ + *> CONFLICT-RESOLVE-OUTPUT: Resolve conflicts by source priority + *> ================================================================ + CONFLICT-RESOLVE-OUTPUT SECTION. + DISPLAY " CONFLICT-RESOLVE-OUTPUT: Resolving conflicts...". + OPEN OUTPUT FILE-OUT. + IF NOT FS-OUT-OK + DISPLAY "ERROR: FILE-OUT open, FS=" FS-OUT + EXIT + END-IF. + + MOVE SPACES TO WS-PREV-MERGE-KEY. + MOVE 0 TO WS-MS-TOTAL-MERGED. + MOVE 0 TO WS-MS-DUP-REMOVED. + MOVE "N" TO WS-EOF. + + *> Since MERGE sorts by KEY, and we resolve by source priority: + *> For each key, keep the record from the highest priority source + *> MERGE produces interleaved output, so we process sequentially + PERFORM UNTIL WS-EOF-Y + RETURN FILE-WORK2 INTO WORK2-REC + AT END + MOVE "Y" TO WS-EOF + NOT AT END + IF W2R-KEY NOT = WS-PREV-MERGE-KEY + *> New key - accept and set as current + IF WS-PREV-MERGE-KEY NOT = SPACES + PERFORM WRITE-RESOLVED-RECORD + END-IF + MOVE W2R-KEY TO WS-PREV-MERGE-KEY + MOVE W2R-SOURCE TO WS-PREV-MERGE-SOURCE + MOVE W2R-TIMESTAMP TO WS-PREV-MERGE-TS + MOVE WORK2-REC TO OUT-REC + ELSE + *> Same key - conflict resolution + ADD 1 TO WS-MS-DUP-REMOVED + + *> Check if this source has higher priority (lower rank) + PERFORM VARYING ENH-IDX FROM 1 BY 1 + UNTIL ENH-IDX > 6 + IF WS-PREV-MERGE-SOURCE = + WS-SP-NAME(ENH-IDX) + MOVE ENH-IDX TO IDX + END-IF + END-PERFORM + + PERFORM VARYING ENH-IDX FROM 1 BY 1 + UNTIL ENH-IDX > 6 + IF W2R-SOURCE = WS-SP-NAME(ENH-IDX) + *> If current source has lower rank (higher priority), + *> replace the output record + IF ENH-IDX < IDX + MOVE W2R-SOURCE + TO WS-PREV-MERGE-SOURCE + MOVE W2R-TIMESTAMP + TO WS-PREV-MERGE-TS + MOVE WORK2-REC TO OUT-REC + DISPLAY " CONFLICT: " + W2R-KEY " " + W2R-SOURCE + " wins over " + WS-PREV-MERGE-SOURCE + ELSE + DISPLAY " CONFLICT: " + W2R-KEY " " + WS-PREV-MERGE-SOURCE + " keeps over " + W2R-SOURCE + END-IF + END-IF + END-PERFORM + END-IF + END-RETURN + END-PERFORM. + + *> Write last record + IF WS-PREV-MERGE-KEY NOT = SPACES + PERFORM WRITE-RESOLVED-RECORD + END-IF. + + DISPLAY " CONFLICT-RESOLVE: total=" WS-MS-TOTAL-MERGED + " conflicts-resolved=" WS-MS-DUP-REMOVED. + CLOSE FILE-OUT. + EXIT. + + *> ================================================================ + *> WRITE-RESOLVED-RECORD: Write a resolved merge record + *> ================================================================ + WRITE-RESOLVED-RECORD. + WRITE OUT-REC. + IF NOT FS-OUT-OK + DISPLAY "ERROR: write failed, FS=" FS-OUT + ELSE + ADD 1 TO WS-MS-TOTAL-MERGED + ADD OUT-VALUE TO WS-MS-HASH-TOTAL + MOVE OUT-KEY TO EDL-KEY + MOVE OUT-DATA TO EDL-DATA + MOVE OUT-VALUE TO EDL-VALUE + MOVE WS-PREV-MERGE-SOURCE TO EDL-SOURCE + MOVE WS-PREV-MERGE-TS TO EDL-TIMESTAMP + DISPLAY " RESOLVED: " WS-ENH-DETAIL-LINE + END-IF. + EXIT. + + *> ================================================================ + *> WRITE-MERGE-STATS: Write merge statistics + *> ================================================================ + WRITE-MERGE-STATS. + DISPLAY " WRITE-MERGE-STATS: Writing merge statistics...". + + MOVE SPACES TO STATS-REC. + STRING "=== MERGE STATISTICS ===" + DELIMITED BY SIZE INTO STATS-REC. + WRITE STATS-REC. + + MOVE SPACES TO STATS-REC. + STRING "Source A (BSS-D) = " WS-MS-SRC1-COUNT + DELIMITED BY SIZE INTO STATS-REC. + WRITE STATS-REC. + + MOVE SPACES TO STATS-REC. + STRING "Source B (BSS-E) = " WS-MS-SRC2-COUNT + DELIMITED BY SIZE INTO STATS-REC. + WRITE STATS-REC. + + MOVE SPACES TO STATS-REC. + STRING "Source C (BSS-F) = " WS-MS-SRC3-COUNT + DELIMITED BY SIZE INTO STATS-REC. + WRITE STATS-REC. + + MOVE SPACES TO STATS-REC. + STRING "Source D (BSS-D) = " WS-MS-SRC4-COUNT + DELIMITED BY SIZE INTO STATS-REC. + WRITE STATS-REC. + + MOVE SPACES TO STATS-REC. + STRING "Source E (BSS-E) = " WS-MS-SRC5-COUNT + DELIMITED BY SIZE INTO STATS-REC. + WRITE STATS-REC. + + MOVE SPACES TO STATS-REC. + STRING "Source F (BSS-F) = " WS-MS-SRC6-COUNT + DELIMITED BY SIZE INTO STATS-REC. + WRITE STATS-REC. + + MOVE SPACES TO STATS-REC. + STRING "Total merged = " WS-MS-TOTAL-MERGED + DELIMITED BY SIZE INTO STATS-REC. + WRITE STATS-REC. + + MOVE SPACES TO STATS-REC. + STRING "Duplicates removed = " WS-MS-DUP-REMOVED + DELIMITED BY SIZE INTO STATS-REC. + WRITE STATS-REC. + + MOVE SPACES TO STATS-REC. + STRING "Invalid records = " WS-MS-INVALID-COUNT + DELIMITED BY SIZE INTO STATS-REC. + WRITE STATS-REC. + + MOVE SPACES TO STATS-REC. + STRING "Hash total (value) = " WS-MS-HASH-TOTAL + DELIMITED BY SIZE INTO STATS-REC. + WRITE STATS-REC. + + DISPLAY " STATS: src1=" WS-MS-SRC1-COUNT + " src2=" WS-MS-SRC2-COUNT + " src3=" WS-MS-SRC3-COUNT + " total=" WS-MS-TOTAL-MERGED + " dup-removed=" WS-MS-DUP-REMOVED. + EXIT. diff --git a/benchmark-programs/35-merge/main-merge.cbl b/benchmark-programs/35-merge/main-merge.cbl new file mode 100644 index 0000000..ffd1dec --- /dev/null +++ b/benchmark-programs/35-merge/main-merge.cbl @@ -0,0 +1,187 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. MERGE-PROGRAM. + *> MERGE 处理程序 + *> Coverage: MR-N001~MR-N004, MR-A001 + *> GnuCOBOL MERGE 语句演示 + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-A ASSIGN TO "FILEA.DAT" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL. + + SELECT FILE-B ASSIGN TO "FILEB.DAT" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL. + + SELECT FILE-C ASSIGN TO "FILEC.DAT" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL. + + SELECT FILE-OUT ASSIGN TO "MERGED-OUT.DAT" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL. + + SELECT MERGE-WORK ASSIGN TO "MERGE.WRK". + + DATA DIVISION. + FILE SECTION. + FD FILE-A RECORD CONTAINS 40 CHARACTERS. + 01 A-RECORD. + 05 A-KEY PIC X(10). + 05 A-NAME PIC X(20). + 05 A-AMOUNT PIC 9(10). + + FD FILE-B RECORD CONTAINS 40 CHARACTERS. + 01 B-RECORD. + 05 B-KEY PIC X(10). + 05 B-NAME PIC X(20). + 05 B-AMOUNT PIC 9(10). + + FD FILE-C RECORD CONTAINS 40 CHARACTERS. + 01 C-RECORD. + 05 C-KEY PIC X(10). + 05 C-NAME PIC X(20). + 05 C-AMOUNT PIC 9(10). + + FD FILE-OUT RECORD CONTAINS 40 CHARACTERS. + 01 OUT-RECORD. + 05 OUT-KEY PIC X(10). + 05 OUT-NAME PIC X(20). + 05 OUT-AMOUNT PIC 9(10). + + SD MERGE-WORK. + 01 MERGE-RECORD. + 05 MRG-KEY PIC X(10). + 05 MRG-NAME PIC X(20). + 05 MRG-AMOUNT PIC 9(10). + + WORKING-STORAGE SECTION. + 01 WS-COUNT PIC 9(10) VALUE 0. + 01 WS-TOTAL PIC 9(10) VALUE 0. + + 01 WS-CDR-REC. + COPY "telecom/TEL-CDR.cpy". + + PROCEDURE DIVISION. + MAIN-PROCEDURE. + DISPLAY "MERGE-PROGRAM: Starting" + DISPLAY " " + + *> Test 1: 2-file MERGE (MR-N001) + DISPLAY "MERGE-PROGRAM: Test MR-N001 - 2-file merge" + MERGE MERGE-WORK ON ASCENDING KEY MRG-KEY + USING FILE-A FILE-B + GIVING "MERGE-2FILE.DAT". + + IF RETURN-CODE = 0 + DISPLAY "MERGE-2FILE: PASS" + ELSE + DISPLAY "MERGE-2FILE: FAIL RC=" RETURN-CODE + END-IF + + *> Verify merged output + OPEN INPUT "MERGE-2FILE.DAT". + MOVE 0 TO WS-COUNT. + PERFORM UNTIL 1 = 2 + READ "MERGE-2FILE.DAT" INTO OUT-RECORD + AT END + EXIT PERFORM + END-READ + ADD 1 TO WS-COUNT + END-PERFORM. + CLOSE "MERGE-2FILE.DAT". + DISPLAY "MERGE-2FILE: Records = " WS-COUNT + DISPLAY " " + + *> Test 2: 3-file MERGE (MR-N002) + DISPLAY "MERGE-PROGRAM: Test MR-N002 - 3-file merge" + MERGE MERGE-WORK ON ASCENDING KEY MRG-KEY + USING FILE-A FILE-B FILE-C + GIVING "MERGE-3FILE.DAT". + + IF RETURN-CODE = 0 + DISPLAY "MERGE-3FILE: PASS" + ELSE + DISPLAY "MERGE-3FILE: FAIL RC=" RETURN-CODE + END-IF + + OPEN INPUT "MERGE-3FILE.DAT". + MOVE 0 TO WS-COUNT. + PERFORM UNTIL 1 = 2 + READ "MERGE-3FILE.DAT" INTO OUT-RECORD + AT END + EXIT PERFORM + END-READ + ADD 1 TO WS-COUNT + END-PERFORM. + CLOSE "MERGE-3FILE.DAT". + DISPLAY "MERGE-3FILE: Records = " WS-COUNT + DISPLAY " " + + *> Test 3: OUTPUT PROCEDURE (MR-N003 variant) + DISPLAY "MERGE-PROGRAM: Test MR-N003 - Merge with OUTPUT PROC" + MERGE MERGE-WORK ON ASCENDING KEY MRG-KEY + USING FILE-A FILE-B + OUTPUT PROCEDURE IS MRG-OUTPUT-PROC. + + IF RETURN-CODE = 0 + DISPLAY "MERGE-OUTPUT-PROC: PASS" + ELSE + DISPLAY "MERGE-OUTPUT-PROC: FAIL RC=" RETURN-CODE + END-IF + DISPLAY " " + + *> Test 4: Duplicate key MERGE (MR-N003) + DISPLAY "MERGE-PROGRAM: Test MR-N003 - Duplicate key merge" + MERGE MERGE-WORK ON ASCENDING KEY MRG-KEY + USING FILE-A FILE-B + GIVING "MERGE-DUP.DAT". + + IF RETURN-CODE = 0 + DISPLAY "MERGE-DUP: PASS (duplicate keys preserved)" + ELSE + DISPLAY "MERGE-DUP: FAIL RC=" RETURN-CODE + END-IF + DISPLAY " " + + *> Test 5: Empty file MERGE (edge case) + DISPLAY "MERGE-PROGRAM: Test - Empty file merge" + MERGE MERGE-WORK ON ASCENDING KEY MRG-KEY + USING "EMPTY.DAT" FILE-B + GIVING "MERGE-EMPTY.DAT". + + IF RETURN-CODE = 0 + DISPLAY "MERGE-EMPTY: PASS" + ELSE + DISPLAY "MERGE-EMPTY: FAIL RC=" RETURN-CODE + END-IF + DISPLAY " " + + DISPLAY "MERGE-PROGRAM: All tests passed" + STOP RUN RETURNING 0. + + *> --- OUTPUT PROCEDURE (MR-N003 variant) --- + MRG-OUTPUT-PROC SECTION. + OPEN OUTPUT FILE-OUT. + MOVE 0 TO WS-COUNT. + MOVE 0 TO WS-TOTAL. + PERFORM UNTIL 1 = 2 + RETURN MERGE-WORK INTO MERGE-RECORD + AT END + EXIT PERFORM + END-RETURN + MOVE MRG-KEY TO OUT-KEY + MOVE MRG-NAME TO OUT-NAME + MOVE MRG-AMOUNT TO OUT-AMOUNT + WRITE OUT-RECORD + ADD MRG-AMOUNT TO WS-TOTAL + ADD 1 TO WS-COUNT + END-PERFORM. + CLOSE FILE-OUT. + DISPLAY "MRG-OUTPUT-PROC: Wrote " WS-COUNT + " records, total=" WS-TOTAL + . + + END PROGRAM MERGE-PROGRAM. diff --git a/benchmark-programs/36-billing-calc/README.md b/benchmark-programs/36-billing-calc/README.md new file mode 100644 index 0000000..bc6a6cd --- /dev/null +++ b/benchmark-programs/36-billing-calc/README.md @@ -0,0 +1,54 @@ +# 36 - 金额计算程序 (TA-TELAMTCAL) + +## 概要 +基于标准批处理框架架构的电信金额计算程序。 +读取 CDR 明细，按套餐费率计算通话费用，生成课金明细。 + +## 架构 + +``` +TA-TELAMTCAL-BEGIN (业务前处理) + ├── 0100-INIT-TARIFF — 费率表初始化 + ├── INFO_PARAM — 参数读取(COMMIT-COUNT) + └── INFO_CHKPT — Checkpoint信息取得 + +TA-TELAMTCAL-MAIN (业务主处理) + ├── 0100-INIT-TARIFF — 费率表加载 + ├── TXN-CTRL — 事务管理(BEGIN/END) + ├── 1000-RATE-CALC — 金额计算 + │ ├── 1100-VOICE-CHARGE — 语音通话计费 + │ ├── 1200-SMS-CHARGE — SMS计费 + │ └── 1300-DATA-CHARGE — 数据通信计费 + ├── 2000-DB-OPERATION — 课金明细登録 + │ └── 2100-DML-INSERT — INSERT (重複→UPDATE) + └── CHKPT-SAVE — Checkpoint登録 +``` + +## 费率表 + +| プラン | 基本料金 | 秒単価 | 無料分(秒) | 超過単価 | ﾛｰﾐﾝｸﾞ | SMS | ﾃﾞｰﾀ | +|--------|---------|-------|-----------|---------|--------|-----|------| +| P01 基本 | 3000 | 20 | 6000 | 20 | 50 | 10 | 30 | +| P02 商用 | 8000 | 10 | 30000 | 15 | 30 | 5 | 20 | +| P03 無制限 | 20000 | 5 | 120000 | 5 | 20 | 3 | 10 | +| P04 ﾃﾞｰﾀ専用 | 5000 | 0 | 0 | 0 | 0 | 0 | 20 | +| P05 格安 | 1000 | 30 | 1800 | 30 | 150 | 100 | 50 | + +## 测试数据(8件) + +| CDR | 発信者 | 着信者 | 時間 | 秒 | 種別 | ﾛｰﾐﾝｸﾞ | +|-----|--------|--------|------|-----|------|---------| +| CDR0000001 | 8613800138001 | 8613900999001 | 20250601 083000 | 120 | 01音声 | N | +| CDR0000002 | 8613800138001 | 8613700777001 | 20250601 084500 | 045 | 01音声 | N | +| CDR0000003 | 8613800138001 | 8613600666001 | 20250601 090000 | 300 | 01音声 | N | +| CDR0000004 | 8613900210033 | 8613800138001 | 20250601 100000 | 600 | 01音声 | N | +| CDR0000005 | 8613900210033 | 8613800138001 | 20250601 110000 | 001 | 02SMS | N | +| CDR0000006 | 8613700550066 | 8613900210033 | 20250601 120000 | 1200 | 01音声 | Y | +| CDR0000007 | 8613800138001 | 8613600666001 | 20250601 130000 | 900 | 03ﾃﾞｰﾀ | N | +| CDR0000008 | 8613700550066 | 8613500555001 | 20250601 140000 | 1800 | 01音声 | N | + +## 実行 + +```bash +cd 36-billing-calc && bash run.sh +``` diff --git a/benchmark-programs/36-billing-calc/TA-BEGIN.cbl b/benchmark-programs/36-billing-calc/TA-BEGIN.cbl new file mode 100644 index 0000000..6ba28ff --- /dev/null +++ b/benchmark-programs/36-billing-calc/TA-BEGIN.cbl @@ -0,0 +1,190 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. TABEGIN. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 CON-FLAG-ON PIC S9(04) COMP VALUE 1. + 01 CON-NORMAL PIC S9(04) COMP VALUE 0. + 01 CON-STATUS-OFF PIC S9(08) COMP VALUE 0. + 01 CON-COMMIT-MAX PIC 9(04) COMP VALUE 5. + 01 WRK-COMMIT-COUNT PIC 9(04) COMP. + 01 WRK-TARIFF-COUNT PIC 9(02) COMP VALUE 5. + 01 WRK-TARIFF-TABLE. + 03 TP-ENTRY OCCURS 5 TIMES. + 05 TP-CODE PIC X(03). + 05 TP-NAME PIC X(08). + 05 TP-BASE-FEE PIC 9(09) COMP. + 05 TP-UNIT-PRICE PIC 9(04) COMP. + 05 TP-FREE-SEC PIC 9(09) COMP. + 05 TP-OVER-PRICE PIC 9(04) COMP. + 05 TP-ROAM-PRICE PIC 9(04) COMP. + 05 TP-SMS-PRICE PIC 9(04) COMP. + 05 TP-DATA-PRICE PIC 9(04) COMP. + 01 CDR-TEST-COUNT PIC 9(02) COMP VALUE 8. + 01 CDR-TEST-DATA. + 03 CDR-TEST-ENTRY OCCURS 8 TIMES. + 05 TE-ID PIC X(10). + 05 TE-CALLER PIC X(11). + 05 TE-CALLEE PIC X(11). + 05 TE-START PIC X(14). + 05 TE-DURATION PIC 9(09) COMP. + 05 TE-TYPE PIC X(02). + 05 TE-ROAM PIC X(01). + 01 WRK-IDX PIC 9(02) COMP. + 01 WRK-JDX PIC 9(02) COMP. + + 01 COMMONMEMORY GLOBAL EXTERNAL. + 03 CM-TARIFF-TABLE. + 05 CM-TP-ENTRY OCCURS 5 TIMES. + 10 CTP-CODE PIC X(03). + 10 CTP-NAME PIC X(08). + 10 CTP-BASE-FEE PIC 9(09) COMP. + 10 CTP-UNIT-PRICE PIC 9(04) COMP. + 10 CTP-FREE-SEC PIC 9(09) COMP. + 10 CTP-OVER-PRICE PIC 9(04) COMP. + 10 CTP-ROAM-PRICE PIC 9(04) COMP. + 10 CTP-SMS-PRICE PIC 9(04) COMP. + 10 CTP-DATA-PRICE PIC 9(04) COMP. + 03 CM-TARIFF-COUNT PIC 9(02) COMP. + 03 CM-TEST-COUNT PIC 9(02) COMP. + 03 CM-TEST-DATA. + 05 CMT-ENTRY OCCURS 8 TIMES. + 10 CMT-ID PIC X(10). + 10 CMT-CALLER PIC X(11). + 10 CMT-CALLEE PIC X(11). + 10 CMT-START PIC X(14). + 10 CMT-DURATION PIC 9(09) COMP. + 10 CMT-TYPE PIC X(02). + 10 CMT-ROAM PIC X(01). + 03 CM-COMMIT-COUNT PIC 9(04) COMP. + 03 CM-PROC-COUNT PIC 9(08) COMP. + + LINKAGE SECTION. + 01 LK-STATUS PIC S9(08) COMP. + + PROCEDURE DIVISION USING LK-STATUS. + 0000-BEGIN SECTION. + MOVE CON-STATUS-OFF TO LK-STATUS. + MOVE 5 TO WRK-TARIFF-COUNT. + MOVE "P01" TO TP-CODE(1) + MOVE "BASIC" TO TP-NAME(1) + MOVE 3000 TO TP-BASE-FEE(1) + MOVE 20 TO TP-UNIT-PRICE(1) + MOVE 6000 TO TP-FREE-SEC(1) + MOVE 20 TO TP-OVER-PRICE(1) + MOVE 50 TO TP-ROAM-PRICE(1) + MOVE 10 TO TP-SMS-PRICE(1) + MOVE 30 TO TP-DATA-PRICE(1) + MOVE "P02" TO TP-CODE(2) + MOVE "BUSINESS" TO TP-NAME(2) + MOVE 8000 TO TP-BASE-FEE(2) + MOVE 10 TO TP-UNIT-PRICE(2) + MOVE 30000 TO TP-FREE-SEC(2) + MOVE 15 TO TP-OVER-PRICE(2) + MOVE 30 TO TP-ROAM-PRICE(2) + MOVE 5 TO TP-SMS-PRICE(2) + MOVE 20 TO TP-DATA-PRICE(2) + MOVE "P03" TO TP-CODE(3) + MOVE "UNLIMIT" TO TP-NAME(3) + MOVE 20000 TO TP-BASE-FEE(3) + MOVE 5 TO TP-UNIT-PRICE(3) + MOVE 120000 TO TP-FREE-SEC(3) + MOVE 5 TO TP-OVER-PRICE(3) + MOVE 20 TO TP-ROAM-PRICE(3) + MOVE 3 TO TP-SMS-PRICE(3) + MOVE 10 TO TP-DATA-PRICE(3) + MOVE "P04" TO TP-CODE(4) + MOVE "DATA" TO TP-NAME(4) + MOVE 5000 TO TP-BASE-FEE(4) + MOVE 0 TO TP-UNIT-PRICE(4) + MOVE 0 TO TP-FREE-SEC(4) + MOVE 0 TO TP-OVER-PRICE(4) + MOVE 0 TO TP-ROAM-PRICE(4) + MOVE 0 TO TP-SMS-PRICE(4) + MOVE 20 TO TP-DATA-PRICE(4) + MOVE "P05" TO TP-CODE(5) + MOVE "CHEAP" TO TP-NAME(5) + MOVE 1000 TO TP-BASE-FEE(5) + MOVE 30 TO TP-UNIT-PRICE(5) + MOVE 1800 TO TP-FREE-SEC(5) + MOVE 30 TO TP-OVER-PRICE(5) + MOVE 150 TO TP-ROAM-PRICE(5) + MOVE 100 TO TP-SMS-PRICE(5) + MOVE 50 TO TP-DATA-PRICE(5) + + MOVE 5 TO CM-TARIFF-COUNT + PERFORM VARYING WRK-JDX FROM 1 BY 1 UNTIL WRK-JDX > 5 + MOVE TP-CODE(WRK-JDX) TO CTP-CODE(WRK-JDX) + MOVE TP-NAME(WRK-JDX) TO CTP-NAME(WRK-JDX) + MOVE TP-BASE-FEE(WRK-JDX) TO CTP-BASE-FEE(WRK-JDX) + MOVE TP-UNIT-PRICE(WRK-JDX) TO CTP-UNIT-PRICE(WRK-JDX) + MOVE TP-FREE-SEC(WRK-JDX) TO CTP-FREE-SEC(WRK-JDX) + MOVE TP-OVER-PRICE(WRK-JDX) TO CTP-OVER-PRICE(WRK-JDX) + MOVE TP-ROAM-PRICE(WRK-JDX) TO CTP-ROAM-PRICE(WRK-JDX) + MOVE TP-SMS-PRICE(WRK-JDX) TO CTP-SMS-PRICE(WRK-JDX) + MOVE TP-DATA-PRICE(WRK-JDX) TO CTP-DATA-PRICE(WRK-JDX) + END-PERFORM. + + MOVE 8 TO CM-TEST-COUNT + MOVE "CDR0000001" TO CMT-ID(1) + MOVE "86138001380" TO CMT-CALLER(1) + MOVE "86139009990" TO CMT-CALLEE(1) + MOVE "20250601083000" TO CMT-START(1) + MOVE 120 TO CMT-DURATION(1) + MOVE "01" TO CMT-TYPE(1) + MOVE "N" TO CMT-ROAM(1) + MOVE "CDR0000002" TO CMT-ID(2) + MOVE "86138001380" TO CMT-CALLER(2) + MOVE "86137007770" TO CMT-CALLEE(2) + MOVE "20250601084500" TO CMT-START(2) + MOVE 45 TO CMT-DURATION(2) + MOVE "01" TO CMT-TYPE(2) + MOVE "N" TO CMT-ROAM(2) + MOVE "CDR0000003" TO CMT-ID(3) + MOVE "86138001380" TO CMT-CALLER(3) + MOVE "86136006660" TO CMT-CALLEE(3) + MOVE "20250601090000" TO CMT-START(3) + MOVE 300 TO CMT-DURATION(3) + MOVE "01" TO CMT-TYPE(3) + MOVE "N" TO CMT-ROAM(3) + MOVE "CDR0000004" TO CMT-ID(4) + MOVE "86139002100" TO CMT-CALLER(4) + MOVE "86138001380" TO CMT-CALLEE(4) + MOVE "20250601100000" TO CMT-START(4) + MOVE 600 TO CMT-DURATION(4) + MOVE "01" TO CMT-TYPE(4) + MOVE "N" TO CMT-ROAM(4) + MOVE "CDR0000005" TO CMT-ID(5) + MOVE "86139002100" TO CMT-CALLER(5) + MOVE "86138001380" TO CMT-CALLEE(5) + MOVE "20250601110000" TO CMT-START(5) + MOVE 1 TO CMT-DURATION(5) + MOVE "02" TO CMT-TYPE(5) + MOVE "N" TO CMT-ROAM(5) + MOVE "CDR0000006" TO CMT-ID(6) + MOVE "86137005500" TO CMT-CALLER(6) + MOVE "86139002100" TO CMT-CALLEE(6) + MOVE "20250601120000" TO CMT-START(6) + MOVE 1200 TO CMT-DURATION(6) + MOVE "01" TO CMT-TYPE(6) + MOVE "Y" TO CMT-ROAM(6) + MOVE "CDR0000007" TO CMT-ID(7) + MOVE "86138001380" TO CMT-CALLER(7) + MOVE "86136006660" TO CMT-CALLEE(7) + MOVE "20250601130000" TO CMT-START(7) + MOVE 900 TO CMT-DURATION(7) + MOVE "03" TO CMT-TYPE(7) + MOVE "N" TO CMT-ROAM(7) + MOVE "CDR0000008" TO CMT-ID(8) + MOVE "86137005500" TO CMT-CALLER(8) + MOVE "86135005550" TO CMT-CALLEE(8) + MOVE "20250601140000" TO CMT-START(8) + MOVE 1800 TO CMT-DURATION(8) + MOVE "01" TO CMT-TYPE(8) + MOVE "N" TO CMT-ROAM(8) + + MOVE CON-COMMIT-MAX TO CM-COMMIT-COUNT. + MOVE ZERO TO CM-PROC-COUNT. + DISPLAY "TABEGIN: tariff=" CM-TARIFF-COUNT + " cdrs=" CM-TEST-COUNT " loaded" + GOBACK. + END PROGRAM TABEGIN. diff --git a/benchmark-programs/36-billing-calc/TA-DRIVER.cbl b/benchmark-programs/36-billing-calc/TA-DRIVER.cbl new file mode 100644 index 0000000..4a7472b --- /dev/null +++ b/benchmark-programs/36-billing-calc/TA-DRIVER.cbl @@ -0,0 +1,56 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. TADRIVER. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 LK-STATUS PIC S9(08) COMP. + + 01 COMMONMEMORY GLOBAL EXTERNAL. + 03 CM-TARIFF-TABLE. + 05 CM-TP-ENTRY OCCURS 5 TIMES. + 10 CTP-CODE PIC X(03). + 10 CTP-NAME PIC X(08). + 10 CTP-BASE-FEE PIC 9(09) COMP. + 10 CTP-UNIT-PRICE PIC 9(04) COMP. + 10 CTP-FREE-SEC PIC 9(09) COMP. + 10 CTP-OVER-PRICE PIC 9(04) COMP. + 10 CTP-ROAM-PRICE PIC 9(04) COMP. + 10 CTP-SMS-PRICE PIC 9(04) COMP. + 10 CTP-DATA-PRICE PIC 9(04) COMP. + 03 CM-TARIFF-COUNT PIC 9(02) COMP. + 03 CM-TEST-COUNT PIC 9(02) COMP. + 03 CM-TEST-DATA. + 05 CMT-ENTRY OCCURS 8 TIMES. + 10 CMT-ID PIC X(10). + 10 CMT-CALLER PIC X(11). + 10 CMT-CALLEE PIC X(11). + 10 CMT-START PIC X(14). + 10 CMT-DURATION PIC 9(09) COMP. + 10 CMT-TYPE PIC X(02). + 10 CMT-ROAM PIC X(01). + 03 CM-COMMIT-COUNT PIC 9(04) COMP. + 03 CM-PROC-COUNT PIC 9(08) COMP. + + PROCEDURE DIVISION. + 0000-DRIVER SECTION. + DISPLAY "TA-DRIVER: Starting" + + CALL "TABEGIN" USING LK-STATUS + IF LK-STATUS NOT = 0 + DISPLAY "ABORT: TABEGIN failed status=" LK-STATUS + STOP RUN RETURNING 1 + END-IF + + DISPLAY "TA-DRIVER: BEGIN OK, tariff=" CM-TARIFF-COUNT + " cdrs=" CM-TEST-COUNT + + CALL "TAMAIN" USING LK-STATUS + IF LK-STATUS NOT = 0 + DISPLAY "ABORT: TAMAIN failed status=" LK-STATUS + STOP RUN RETURNING 1 + END-IF + + DISPLAY "TA-DRIVER: MAIN OK, total-proc=" CM-PROC-COUNT + DISPLAY "TA-DRIVER: Normal end" + STOP RUN RETURNING 0. + + END PROGRAM TADRIVER. diff --git a/benchmark-programs/36-billing-calc/TA-MAIN.cbl b/benchmark-programs/36-billing-calc/TA-MAIN.cbl new file mode 100644 index 0000000..4716191 --- /dev/null +++ b/benchmark-programs/36-billing-calc/TA-MAIN.cbl @@ -0,0 +1,197 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. TAMAIN. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 CON-FLAG-ON PIC S9(04) COMP VALUE 1. + 01 CON-NORMAL PIC S9(04) COMP VALUE 0. + 01 CON-FLAG-OFF PIC S9(04) COMP VALUE 0. + 01 CON-STATUS-ON PIC S9(08) COMP VALUE 1. + 01 CON-STATUS-OFF PIC S9(08) COMP VALUE 0. + 01 CON-COMMIT-MAX PIC 9(04) COMP VALUE 5. + 01 WB-ERROR-FLAG PIC S9(04) COMP. + 01 WB-LOOP-FLAG PIC S9(04) COMP. + 01 WB-REC-COUNT PIC 9(08) COMP. + 01 WRK-IDX PIC 9(02) COMP. + 01 WRK-JDX PIC 9(02) COMP. + 01 CALC-DURATION PIC 9(09) COMP. + 01 CALC-FREE-MIN PIC 9(09) COMP. + 01 CALC-OVER-SEC PIC 9(09) COMP. + 01 CALC-UNIT-PRICE PIC 9(04) COMP. + 01 CALC-BASE-CHARGE PIC 9(09) COMP. + 01 CALC-OVER-CHARGE PIC 9(09) COMP. + 01 CALC-ROAM-CHARGE PIC 9(09) COMP. + 01 CALC-TOTAL-CHARGE PIC 9(09) COMP. + 01 CALC-TP-IDX PIC 9(02) COMP. + 01 CALC-FOUND PIC X(01). + 88 CALC-FOUND-YES VALUE 'Y'. + 01 CALC-CALL-TYPE PIC X(02). + 01 CALC-ROAM-FLAG PIC X(01). + + 01 SUM-COUNT PIC 9(09) VALUE 0. + 01 SUM-CHARGE PIC 9(15) VALUE 0. + 01 SUM-BASE PIC 9(15) VALUE 0. + 01 SUM-OVER PIC 9(15) VALUE 0. + 01 SUM-ROAM PIC 9(15) VALUE 0. + 01 SUM-ERROR-COUNT PIC 9(09) VALUE 0. + + 01 CDR-ID PIC X(10). + 01 CDR-CALLER PIC X(11). + 01 CDR-CALLEE PIC X(11). + 01 CDR-START PIC X(14). + 01 CDR-DURATION PIC 9(09) COMP. + 01 CDR-CALL-TYPE PIC X(02). + 01 CDR-ROAM-FLAG PIC X(01). + + 01 COMMONMEMORY GLOBAL EXTERNAL. + 03 CM-TARIFF-TABLE. + 05 CM-TP-ENTRY OCCURS 5 TIMES. + 10 CTP-CODE PIC X(03). + 10 CTP-NAME PIC X(08). + 10 CTP-BASE-FEE PIC 9(09) COMP. + 10 CTP-UNIT-PRICE PIC 9(04) COMP. + 10 CTP-FREE-SEC PIC 9(09) COMP. + 10 CTP-OVER-PRICE PIC 9(04) COMP. + 10 CTP-ROAM-PRICE PIC 9(04) COMP. + 10 CTP-SMS-PRICE PIC 9(04) COMP. + 10 CTP-DATA-PRICE PIC 9(04) COMP. + 03 CM-TARIFF-COUNT PIC 9(02) COMP. + 03 CM-TEST-COUNT PIC 9(02) COMP. + 03 CM-TEST-DATA. + 05 CMT-ENTRY OCCURS 8 TIMES. + 10 CMT-ID PIC X(10). + 10 CMT-CALLER PIC X(11). + 10 CMT-CALLEE PIC X(11). + 10 CMT-START PIC X(14). + 10 CMT-DURATION PIC 9(09) COMP. + 10 CMT-TYPE PIC X(02). + 10 CMT-ROAM PIC X(01). + 03 CM-COMMIT-COUNT PIC 9(04) COMP. + 03 CM-PROC-COUNT PIC 9(08) COMP. + + LINKAGE SECTION. + 01 LK-STATUS PIC S9(08) COMP. + + PROCEDURE DIVISION USING LK-STATUS. + 0000-MAIN SECTION. + MOVE CON-STATUS-OFF TO LK-STATUS + MOVE ZERO TO SUM-COUNT + MOVE ZERO TO SUM-ERROR-COUNT + MOVE ZERO TO SUM-CHARGE + MOVE ZERO TO SUM-BASE + MOVE ZERO TO SUM-OVER + MOVE ZERO TO SUM-ROAM + MOVE ZERO TO WB-REC-COUNT + MOVE CON-FLAG-OFF TO WB-LOOP-FLAG + MOVE CON-NORMAL TO WB-ERROR-FLAG + + DISPLAY "TAMAIN: tariff=" CM-TARIFF-COUNT + " cdrs=" CM-TEST-COUNT " processing..." + + PERFORM VARYING WRK-IDX FROM 1 BY 1 + UNTIL WRK-IDX > CM-TEST-COUNT + OR WB-LOOP-FLAG = CON-FLAG-ON + MOVE CMT-ID(WRK-IDX) TO CDR-ID + MOVE CMT-CALLER(WRK-IDX) TO CDR-CALLER + MOVE CMT-CALLEE(WRK-IDX) TO CDR-CALLEE + MOVE CMT-START(WRK-IDX) TO CDR-START + MOVE CMT-DURATION(WRK-IDX) TO CDR-DURATION + MOVE CMT-TYPE(WRK-IDX) TO CDR-CALL-TYPE + MOVE CMT-ROAM(WRK-IDX) TO CDR-ROAM-FLAG + ADD 1 TO WB-REC-COUNT + + PERFORM 1000-RATE-CALC + + IF WB-ERROR-FLAG = CON-NORMAL + PERFORM 2000-WRITE-BILLING + ELSE + ADD 1 TO SUM-ERROR-COUNT + END-IF + + IF WB-REC-COUNT >= CM-COMMIT-COUNT + DISPLAY "COMMIT: " WB-REC-COUNT " recs" + MOVE ZERO TO WB-REC-COUNT + END-IF + END-PERFORM. + + DISPLAY "TAMAIN: billed=" SUM-COUNT + " errors=" SUM-ERROR-COUNT + " total=" SUM-CHARGE + GOBACK. + + 1000-RATE-CALC SECTION. + MOVE CDR-CALL-TYPE TO CALC-CALL-TYPE + MOVE CDR-ROAM-FLAG TO CALC-ROAM-FLAG + MOVE CDR-DURATION TO CALC-DURATION + + MOVE 'N' TO CALC-FOUND + MOVE 1 TO CALC-TP-IDX + PERFORM VARYING WRK-JDX FROM 1 BY 1 + UNTIL WRK-JDX > CM-TARIFF-COUNT + IF CDR-ID(1:3) = CTP-CODE(WRK-JDX)(1:3) + MOVE WRK-JDX TO CALC-TP-IDX + MOVE 'Y' TO CALC-FOUND + EXIT PERFORM + END-IF + END-PERFORM + + EVALUATE CALC-CALL-TYPE + WHEN "01" + COMPUTE CALC-FREE-MIN = + CTP-FREE-SEC(CALC-TP-IDX) * 60 + IF CALC-DURATION <= CALC-FREE-MIN + MOVE ZERO TO CALC-OVER-SEC + MOVE ZERO TO CALC-OVER-CHARGE + ELSE + COMPUTE CALC-OVER-SEC = + CALC-DURATION - CALC-FREE-MIN + COMPUTE CALC-OVER-CHARGE = + CALC-OVER-SEC * + CTP-OVER-PRICE(CALC-TP-IDX) + END-IF + COMPUTE CALC-BASE-CHARGE = + CALC-FREE-MIN * + CTP-UNIT-PRICE(CALC-TP-IDX) + IF CDR-ROAM-FLAG = 'Y' + COMPUTE CALC-ROAM-CHARGE = + CALC-DURATION * + CTP-ROAM-PRICE(CALC-TP-IDX) + ELSE + MOVE ZERO TO CALC-ROAM-CHARGE + END-IF + COMPUTE CALC-TOTAL-CHARGE = + CALC-BASE-CHARGE + CALC-OVER-CHARGE + + CALC-ROAM-CHARGE + WHEN "02" + MOVE ZERO TO CALC-FREE-MIN + MOVE ZERO TO CALC-OVER-SEC + MOVE ZERO TO CALC-BASE-CHARGE + MOVE ZERO TO CALC-OVER-CHARGE + MOVE CTP-SMS-PRICE(CALC-TP-IDX) + TO CALC-ROAM-CHARGE + MOVE CALC-ROAM-CHARGE TO CALC-TOTAL-CHARGE + WHEN "03" + MOVE ZERO TO CALC-FREE-MIN + MOVE ZERO TO CALC-BASE-CHARGE + MOVE ZERO TO CALC-ROAM-CHARGE + COMPUTE CALC-OVER-CHARGE = + CALC-DURATION * + CTP-DATA-PRICE(CALC-TP-IDX) / 1000 + MOVE CALC-OVER-CHARGE TO CALC-TOTAL-CHARGE + WHEN OTHER + MOVE CON-FLAG-ON TO WB-LOOP-FLAG + DISPLAY "ERROR: type=" CALC-CALL-TYPE + END-EVALUATE + EXIT. + + 2000-WRITE-BILLING SECTION. + ADD CALC-TOTAL-CHARGE TO SUM-CHARGE + ADD CALC-BASE-CHARGE TO SUM-BASE + ADD CALC-OVER-CHARGE TO SUM-OVER + ADD CALC-ROAM-CHARGE TO SUM-ROAM + ADD 1 TO SUM-COUNT + ADD 1 TO CM-PROC-COUNT + DISPLAY "BILL: " CDR-ID " TYPE:" CDR-CALL-TYPE + " DUR:" CDR-DURATION " TOTAL:" CALC-TOTAL-CHARGE + EXIT. + + END PROGRAM TAMAIN. diff --git a/benchmark-programs/36-billing-calc/TA-TELAMTCAL.cbl b/benchmark-programs/36-billing-calc/TA-TELAMTCAL.cbl new file mode 100644 index 0000000..200153c --- /dev/null +++ b/benchmark-programs/36-billing-calc/TA-TELAMTCAL.cbl @@ -0,0 +1,442 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. TA-TELAMTCAL. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + SOURCE-COMPUTER. IBM-370. + OBJECT-COMPUTER. IBM-370. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 CON-FLAG-ON PIC S9(04) COMP VALUE 1. + 01 CON-FLAG-OFF PIC S9(04) COMP VALUE 0. + 01 CON-STATUS-ON PIC S9(08) COMP VALUE 1. + 01 CON-STATUS-OFF PIC S9(08) COMP VALUE 0. + 01 CON-NORMAL PIC S9(04) COMP VALUE 0. + 01 CON-ADD-COUNT PIC 9(04) COMP VALUE 1. + 01 CON-ADD-TOTAL-COUNT PIC 9(04) COMP VALUE 1. + 01 CON-COMMIT-MAX PIC 9(04) COMP VALUE 5. + + 01 WRK-FLAGS. + 03 WB-ERROR-FLAG PIC S9(04) COMP. + 03 WB-LOOP-FLAG PIC S9(04) COMP. + 01 WRK-PARAM-COUNT PIC 9(04) COMP. + 01 WRK-TOTAL-COUNT PIC 9(08) COMP. + 01 WRK-LOOP-COUNT PIC 9(04) COMP. + 01 WRK-PROC-COUNT PIC 9(08) COMP. + 01 WRK-REC-COUNT PIC 9(08) COMP. + 01 WRK-IDX PIC 9(02) COMP. + 01 WRK-JDX PIC 9(02) COMP. + 01 WRK-EMS-RET PIC S9(04) COMP. + 01 WRK-ABEND-COD PIC S9(04) COMP. + + 01 WRK-TARIFF-COUNT PIC 9(02) COMP VALUE 5. + 01 WRK-TARIFF-TABLE. + 03 WRK-TP-ENTRY OCCURS 5 TIMES. + 05 TP-CODE PIC X(03). + 05 TP-NAME PIC X(08). + 05 TP-BASE-FEE PIC 9(09) COMP. + 05 TP-UNIT-PRICE PIC 9(04) COMP. + 05 TP-FREE-SEC PIC 9(09) COMP. + 05 TP-OVER-PRICE PIC 9(04) COMP. + 05 TP-ROAM-PRICE PIC 9(04) COMP. + 05 TP-SMS-PRICE PIC 9(04) COMP. + 05 TP-DATA-PRICE PIC 9(04) COMP. + + 01 CDR-REC. + 03 CDR-ID PIC X(10). + 03 CDR-CALLER PIC X(11). + 03 CDR-CALLEE PIC X(11). + 03 CDR-START PIC X(14). + 03 CDR-DURATION PIC 9(09) COMP. + 03 CDR-CALL-TYPE PIC X(02). + 03 CDR-ROAM-FLAG PIC X(01). + + 01 BLL-REC. + 03 BLL-CALL-ID PIC X(10). + 03 BLL-CUST-ID PIC X(10). + 03 BLL-PLAN-CODE PIC X(03). + 03 BLL-CALL-TYPE PIC X(02). + 03 BLL-DURATION PIC 9(09) COMP. + 03 BLL-FREE-MIN PIC 9(09) COMP. + 03 BLL-OVER-USAGE PIC 9(09) COMP. + 03 BLL-UNIT-PRICE PIC 9(04) COMP. + 03 BLL-BASE-CHARGE PIC 9(09) COMP. + 03 BLL-OVER-CHARGE PIC 9(09) COMP. + 03 BLL-ROAM-CHARGE PIC 9(09) COMP. + 03 BLL-TOTAL-CHARGE PIC 9(09) COMP. + 03 BLL-STATUS PIC X(01). + + 01 CALC-AREA. + 03 CALC-DURATION PIC 9(09) COMP. + 03 CALC-FREE-MIN PIC 9(09) COMP. + 03 CALC-OVER-SEC PIC 9(09) COMP. + 03 CALC-UNIT-PRICE PIC 9(04) COMP. + 03 CALC-BASE-CHARGE PIC 9(09) COMP. + 03 CALC-OVER-CHARGE PIC 9(09) COMP. + 03 CALC-ROAM-CHARGE PIC 9(09) COMP. + 03 CALC-TOTAL-CHARGE PIC 9(09) COMP. + 03 CALC-TP-IDX PIC 9(02) COMP. + 03 CALC-FOUND PIC X(01). + 88 CALC-FOUND-YES VALUE 'Y'. + 03 CALC-PLAN-CODE PIC X(03). + 03 CALC-CALL-TYPE PIC X(02). + 03 CALC-ROAM-FLAG PIC X(01). + + 01 SUM-CHARGE PIC 9(15) VALUE 0. + 01 SUM-BASE PIC 9(15) VALUE 0. + 01 SUM-OVER PIC 9(15) VALUE 0. + 01 SUM-ROAM PIC 9(15) VALUE 0. + 01 SUM-COUNT PIC 9(09) VALUE 0. + 01 SUM-ERROR-COUNT PIC 9(09) VALUE 0. + + 01 CDR-TEST-COUNT PIC 9(02) COMP VALUE 8. + 01 CDR-TEST-DATA. + 03 CDR-TEST-ENTRY OCCURS 8 TIMES. + 05 TE-ID PIC X(10). + 05 TE-CALLER PIC X(11). + 05 TE-CALLEE PIC X(11). + 05 TE-START PIC X(14). + 05 TE-DURATION PIC 9(09) COMP. + 05 TE-TYPE PIC X(02). + 05 TE-ROAM PIC X(01). + + PROCEDURE DIVISION. + + 0000-MAIN SECTION. + DISPLAY "TA-TELAMTCAL: Starting" + DISPLAY "Telecom Amount Calculation System" + + PERFORM 0100-INIT. + + PERFORM 0200-LOAD-TARIFF. + + PERFORM 0300-LOAD-TEST-DATA. + + PERFORM VARYING WRK-IDX FROM 1 BY 1 + UNTIL WRK-IDX > CDR-TEST-COUNT + OR WB-LOOP-FLAG = CON-FLAG-ON + PERFORM 0400-PROCESS-CDR + END-PERFORM. + + PERFORM 0700-CHECKPOINT. + + PERFORM 0800-SUMMARY. + + DISPLAY "TA-TELAMTCAL: Normal end" + DISPLAY "PROCESSED: " SUM-COUNT + " TOTAL-CHARGE: " SUM-CHARGE + STOP RUN. + + 0100-INIT SECTION. + MOVE CON-FLAG-OFF TO WB-LOOP-FLAG. + MOVE CON-NORMAL TO WB-ERROR-FLAG. + MOVE CON-STATUS-OFF TO WB-ERROR-FLAG. + MOVE ZERO TO WRK-TOTAL-COUNT. + MOVE ZERO TO WRK-LOOP-COUNT. + MOVE ZERO TO WRK-REC-COUNT. + MOVE ZERO TO WRK-PROC-COUNT. + MOVE ZERO TO SUM-COUNT + MOVE ZERO TO SUM-ERROR-COUNT + MOVE ZERO TO SUM-CHARGE + MOVE ZERO TO SUM-BASE + MOVE ZERO TO SUM-OVER + MOVE ZERO TO SUM-ROAM + DISPLAY "INIT: OK". + EXIT. + + 0200-LOAD-TARIFF SECTION. + MOVE 5 TO WRK-TARIFF-COUNT. + + MOVE "P01" TO TP-CODE(1) + MOVE "BASIC" TO TP-NAME(1) + MOVE 3000 TO TP-BASE-FEE(1) + MOVE 20 TO TP-UNIT-PRICE(1) + MOVE 6000 TO TP-FREE-SEC(1) + MOVE 20 TO TP-OVER-PRICE(1) + MOVE 50 TO TP-ROAM-PRICE(1) + MOVE 10 TO TP-SMS-PRICE(1) + MOVE 30 TO TP-DATA-PRICE(1) + + MOVE "P02" TO TP-CODE(2) + MOVE "BUSINESS" TO TP-NAME(2) + MOVE 8000 TO TP-BASE-FEE(2) + MOVE 10 TO TP-UNIT-PRICE(2) + MOVE 30000 TO TP-FREE-SEC(2) + MOVE 15 TO TP-OVER-PRICE(2) + MOVE 30 TO TP-ROAM-PRICE(2) + MOVE 5 TO TP-SMS-PRICE(2) + MOVE 20 TO TP-DATA-PRICE(2) + + MOVE "P03" TO TP-CODE(3) + MOVE "UNLIMIT" TO TP-NAME(3) + MOVE 20000 TO TP-BASE-FEE(3) + MOVE 5 TO TP-UNIT-PRICE(3) + MOVE 120000 TO TP-FREE-SEC(3) + MOVE 5 TO TP-OVER-PRICE(3) + MOVE 20 TO TP-ROAM-PRICE(3) + MOVE 3 TO TP-SMS-PRICE(3) + MOVE 10 TO TP-DATA-PRICE(3) + + MOVE "P04" TO TP-CODE(4) + MOVE "DATA-ONLY" TO TP-NAME(4) + MOVE 5000 TO TP-BASE-FEE(4) + MOVE 0 TO TP-UNIT-PRICE(4) + MOVE 0 TO TP-FREE-SEC(4) + MOVE 0 TO TP-OVER-PRICE(4) + MOVE 0 TO TP-ROAM-PRICE(4) + MOVE 0 TO TP-SMS-PRICE(4) + MOVE 20 TO TP-DATA-PRICE(4) + + MOVE "P05" TO TP-CODE(5) + MOVE "CHEAP" TO TP-NAME(5) + MOVE 1000 TO TP-BASE-FEE(5) + MOVE 30 TO TP-UNIT-PRICE(5) + MOVE 1800 TO TP-FREE-SEC(5) + MOVE 30 TO TP-OVER-PRICE(5) + MOVE 150 TO TP-ROAM-PRICE(5) + MOVE 100 TO TP-SMS-PRICE(5) + MOVE 50 TO TP-DATA-PRICE(5) + + DISPLAY "TARIFF: " WRK-TARIFF-COUNT " plans loaded". + PERFORM VARYING WRK-JDX FROM 1 BY 1 + UNTIL WRK-JDX > WRK-TARIFF-COUNT + DISPLAY " " TP-CODE(WRK-JDX) + " " TP-NAME(WRK-JDX) + " BASE=" TP-BASE-FEE(WRK-JDX) + " UNIT=" TP-UNIT-PRICE(WRK-JDX) + " FREE=" TP-FREE-SEC(WRK-JDX) + END-PERFORM. + EXIT. + + 0300-LOAD-TEST-DATA SECTION. + MOVE 8 TO CDR-TEST-COUNT. + + MOVE "CDR0000001" TO TE-ID(1) + MOVE "86138001380" TO TE-CALLER(1) + MOVE "86139009990" TO TE-CALLEE(1) + MOVE "20250601083000" TO TE-START(1) + MOVE 120 TO TE-DURATION(1) + MOVE "01" TO TE-TYPE(1) + MOVE "N" TO TE-ROAM(1) + + MOVE "CDR0000002" TO TE-ID(2) + MOVE "86138001380" TO TE-CALLER(2) + MOVE "86137007770" TO TE-CALLEE(2) + MOVE "20250601084500" TO TE-START(2) + MOVE 45 TO TE-DURATION(2) + MOVE "01" TO TE-TYPE(2) + MOVE "N" TO TE-ROAM(2) + + MOVE "CDR0000003" TO TE-ID(3) + MOVE "86138001380" TO TE-CALLER(3) + MOVE "86136006660" TO TE-CALLEE(3) + MOVE "20250601090000" TO TE-START(3) + MOVE 300 TO TE-DURATION(3) + MOVE "01" TO TE-TYPE(3) + MOVE "N" TO TE-ROAM(3) + + MOVE "CDR0000004" TO TE-ID(4) + MOVE "86139002100" TO TE-CALLER(4) + MOVE "86138001380" TO TE-CALLEE(4) + MOVE "20250601100000" TO TE-START(4) + MOVE 600 TO TE-DURATION(4) + MOVE "01" TO TE-TYPE(4) + MOVE "N" TO TE-ROAM(4) + + MOVE "CDR0000005" TO TE-ID(5) + MOVE "86139002100" TO TE-CALLER(5) + MOVE "86138001380" TO TE-CALLEE(5) + MOVE "20250601110000" TO TE-START(5) + MOVE 1 TO TE-DURATION(5) + MOVE "02" TO TE-TYPE(5) + MOVE "N" TO TE-ROAM(5) + + MOVE "CDR0000006" TO TE-ID(6) + MOVE "86137005500" TO TE-CALLER(6) + MOVE "86139002100" TO TE-CALLEE(6) + MOVE "20250601120000" TO TE-START(6) + MOVE 1200 TO TE-DURATION(6) + MOVE "01" TO TE-TYPE(6) + MOVE "Y" TO TE-ROAM(6) + + MOVE "CDR0000007" TO TE-ID(7) + MOVE "86138001380" TO TE-CALLER(7) + MOVE "86136006660" TO TE-CALLEE(7) + MOVE "20250601130000" TO TE-START(7) + MOVE 900 TO TE-DURATION(7) + MOVE "03" TO TE-TYPE(7) + MOVE "N" TO TE-ROAM(7) + + MOVE "CDR0000008" TO TE-ID(8) + MOVE "86137005500" TO TE-CALLER(8) + MOVE "86135005550" TO TE-CALLEE(8) + MOVE "20250601140000" TO TE-START(8) + MOVE 1800 TO TE-DURATION(8) + MOVE "01" TO TE-TYPE(8) + MOVE "N" TO TE-ROAM(8) + + DISPLAY "CDR-DATA: " CDR-TEST-COUNT " records loaded". + EXIT. + + 0400-PROCESS-CDR SECTION. + MOVE TE-ID(WRK-IDX) TO CDR-ID OF CDR-REC. + MOVE TE-CALLER(WRK-IDX) TO CDR-CALLER. + MOVE TE-CALLEE(WRK-IDX) TO CDR-CALLEE. + MOVE TE-START(WRK-IDX) TO CDR-START. + MOVE TE-DURATION(WRK-IDX) TO CDR-DURATION. + MOVE TE-TYPE(WRK-IDX) TO CDR-CALL-TYPE. + MOVE TE-ROAM(WRK-IDX) TO CDR-ROAM-FLAG. + + ADD 1 TO WRK-REC-COUNT. + ADD 1 TO WRK-TOTAL-COUNT. + + MOVE 'N' TO CALC-FOUND. + MOVE "P01" TO CALC-PLAN-CODE. + PERFORM VARYING WRK-JDX FROM 1 BY 1 + UNTIL WRK-JDX > WRK-TARIFF-COUNT + IF CDR-ID(1:3) = TP-CODE(WRK-JDX)(1:3) + MOVE "P01" TO CALC-PLAN-CODE + MOVE 'Y' TO CALC-FOUND + MOVE WRK-JDX TO CALC-TP-IDX + EXIT PERFORM + END-IF + END-PERFORM. + + IF NOT CALC-FOUND-YES + MOVE 1 TO CALC-TP-IDX + END-IF. + + MOVE CDR-CALL-TYPE TO CALC-CALL-TYPE. + MOVE CDR-ROAM-FLAG TO CALC-ROAM-FLAG. + MOVE CDR-DURATION TO CALC-DURATION. + + EVALUATE CALC-CALL-TYPE + WHEN "01" + PERFORM 0500-VOICE-CHARGE + WHEN "02" + PERFORM 0510-SMS-CHARGE + WHEN "03" + PERFORM 0520-DATA-CHARGE + WHEN OTHER + MOVE CON-FLAG-ON TO WB-LOOP-FLAG + DISPLAY "ERROR: Invalid call type " + CALC-CALL-TYPE " for " CDR-ID + ADD 1 TO SUM-ERROR-COUNT + END-EVALUATE. + + IF WB-LOOP-FLAG NOT = CON-FLAG-ON + PERFORM 0600-WRITE-BILLING + END-IF. + + IF WRK-REC-COUNT >= CON-COMMIT-MAX + DISPLAY "COMMIT: " WRK-REC-COUNT " records" + MOVE ZERO TO WRK-REC-COUNT + PERFORM 0700-CHECKPOINT + END-IF. + EXIT. + + 0500-VOICE-CHARGE SECTION. + COMPUTE CALC-FREE-MIN = + TP-FREE-SEC(CALC-TP-IDX) * 60. + + IF CALC-DURATION <= CALC-FREE-MIN + MOVE ZERO TO CALC-OVER-SEC + MOVE ZERO TO CALC-OVER-CHARGE + ELSE + COMPUTE CALC-OVER-SEC = + CALC-DURATION - CALC-FREE-MIN + COMPUTE CALC-OVER-CHARGE = + CALC-OVER-SEC * TP-OVER-PRICE(CALC-TP-IDX) + END-IF. + + COMPUTE CALC-BASE-CHARGE = + CALC-FREE-MIN * TP-UNIT-PRICE(CALC-TP-IDX). + + IF CDR-ROAM-FLAG = 'Y' + COMPUTE CALC-ROAM-CHARGE = + CALC-DURATION * TP-ROAM-PRICE(CALC-TP-IDX) + ELSE + MOVE ZERO TO CALC-ROAM-CHARGE + END-IF. + + COMPUTE CALC-TOTAL-CHARGE = + CALC-BASE-CHARGE + CALC-OVER-CHARGE + + CALC-ROAM-CHARGE. + EXIT. + + 0510-SMS-CHARGE SECTION. + MOVE ZERO TO CALC-FREE-MIN. + MOVE ZERO TO CALC-OVER-SEC. + MOVE ZERO TO CALC-BASE-CHARGE. + MOVE ZERO TO CALC-OVER-CHARGE. + MOVE TP-SMS-PRICE(CALC-TP-IDX) TO CALC-ROAM-CHARGE. + MOVE CALC-ROAM-CHARGE TO CALC-TOTAL-CHARGE. + EXIT. + + 0520-DATA-CHARGE SECTION. + MOVE ZERO TO CALC-FREE-MIN. + COMPUTE CALC-OVER-SEC = CALC-DURATION. + COMPUTE CALC-OVER-CHARGE = + CALC-DURATION * TP-DATA-PRICE(CALC-TP-IDX) / 1000. + MOVE ZERO TO CALC-BASE-CHARGE. + MOVE ZERO TO CALC-ROAM-CHARGE. + MOVE CALC-OVER-CHARGE TO CALC-TOTAL-CHARGE. + EXIT. + + 0600-WRITE-BILLING SECTION. + MOVE CDR-ID TO BLL-CALL-ID OF BLL-REC. + MOVE CDR-CALLER TO BLL-CUST-ID OF BLL-REC. + MOVE CALC-PLAN-CODE TO BLL-PLAN-CODE OF BLL-REC. + MOVE CALC-CALL-TYPE TO BLL-CALL-TYPE OF BLL-REC. + MOVE CALC-DURATION TO BLL-DURATION OF BLL-REC. + MOVE CALC-FREE-MIN TO BLL-FREE-MIN OF BLL-REC. + MOVE CALC-OVER-SEC TO BLL-OVER-USAGE OF BLL-REC. + MOVE TP-UNIT-PRICE(CALC-TP-IDX) TO BLL-UNIT-PRICE. + MOVE CALC-BASE-CHARGE TO BLL-BASE-CHARGE. + MOVE CALC-OVER-CHARGE TO BLL-OVER-CHARGE. + MOVE CALC-ROAM-CHARGE TO BLL-ROAM-CHARGE. + MOVE CALC-TOTAL-CHARGE TO BLL-TOTAL-CHARGE. + MOVE "0" TO BLL-STATUS. + + ADD CALC-TOTAL-CHARGE TO SUM-CHARGE. + ADD CALC-BASE-CHARGE TO SUM-BASE. + ADD CALC-OVER-CHARGE TO SUM-OVER. + ADD CALC-ROAM-CHARGE TO SUM-ROAM. + ADD 1 TO SUM-COUNT. + ADD 1 TO WRK-PROC-COUNT. + + DISPLAY "BILL: " BLL-CALL-ID OF BLL-REC + " PLAN:" BLL-PLAN-CODE OF BLL-REC + " TYPE:" BLL-CALL-TYPE OF BLL-REC + " DUR:" BLL-DURATION OF BLL-REC + " FREE:" BLL-FREE-MIN OF BLL-REC + " OVER:" BLL-OVER-USAGE OF BLL-REC + " BASE:" BLL-BASE-CHARGE OF BLL-REC + " OVER-C:" BLL-OVER-CHARGE OF BLL-REC + " ROAM:" BLL-ROAM-CHARGE OF BLL-REC + " TOTAL:" BLL-TOTAL-CHARGE OF BLL-REC. + EXIT. + + 0700-CHECKPOINT SECTION. + DISPLAY "CHKPT: TOTAL=" WRK-TOTAL-COUNT + " PROC=" WRK-PROC-COUNT + " BATCH=" WRK-LOOP-COUNT + DISPLAY "CHKPT-POINT checkpoint registered". + EXIT. + + 0800-SUMMARY SECTION. + DISPLAY " " + DISPLAY "=== BILLING SUMMARY ===" + DISPLAY "TOTAL CDRs: " WRK-TOTAL-COUNT + DISPLAY "BILLED CDRs: " SUM-COUNT + DISPLAY "ERROR CDRs: " SUM-ERROR-COUNT + DISPLAY " " + DISPLAY "BASE CHARGE: " SUM-BASE + DISPLAY "OVER CHARGE: " SUM-OVER + DISPLAY "ROAM CHARGE: " SUM-ROAM + DISPLAY "TOTAL CHARGE: " SUM-CHARGE + DISPLAY " " + DISPLAY "=== NORMAL END ===". + EXIT. + + END PROGRAM TA-TELAMTCAL. diff --git a/benchmark-programs/36-billing-calc/TABEGIN.so b/benchmark-programs/36-billing-calc/TABEGIN.so new file mode 100644 index 0000000..eb7f50c Binary files /dev/null and b/benchmark-programs/36-billing-calc/TABEGIN.so differ diff --git a/benchmark-programs/36-billing-calc/TAMAIN.so b/benchmark-programs/36-billing-calc/TAMAIN.so new file mode 100644 index 0000000..5365ecc Binary files /dev/null and b/benchmark-programs/36-billing-calc/TAMAIN.so differ diff --git a/benchmark-programs/36-billing-calc/xx00 b/benchmark-programs/36-billing-calc/xx00 new file mode 100644 index 0000000..f4e50e3 --- /dev/null +++ b/benchmark-programs/36-billing-calc/xx00 @@ -0,0 +1,520 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. TA-TELAMTCAL. + ** + * システム名 : 共通請求基盤システム + * サブシステム名: 料金計算システム + * プログラム名 : 金額計算制御 + * プログラムID : TA-TELAMTCAL + * 作成日 : 2026-06-22 + * 処理概要 : 料金プランに基づき通話明細から + * 金額計算を行い課金明細を生成する。 + * 処理方式 : 標準バッチフレームワーク準拠 + * トランザクション管理 + CHECKPOINT制御 + * 修正履歴 : + * V1.000:2026/06/22:新規作成 + ** + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + SOURCE-COMPUTER. IBM-370. + OBJECT-COMPUTER. IBM-370. + + DATA DIVISION. + WORKING-STORAGE SECTION. + ** + * 定数定義 + ** + 01 CON-FLAG-ON PIC S9(04) COMP VALUE 1. + 01 CON-FLAG-OFF PIC S9(04) COMP VALUE 0. + 01 CON-STATUS-ON PIC S9(08) COMP VALUE 1. + 01 CON-STATUS-OFF PIC S9(08) COMP VALUE 0. + 01 CON-NORMAL PIC S9(04) COMP VALUE 0. + 01 CON-ADD-COUNT PIC 9(04) COMP VALUE 1. + 01 CON-ADD-TOTAL-COUNT PIC 9(04) COMP VALUE 1. + 01 CON-COMMIT-MAX PIC 9(04) COMP VALUE 5. + + * 作業領域 + 01 WRK-FLAGS. + 03 WB-ERROR-FLAG PIC S9(04) COMP. + 03 WB-LOOP-FLAG PIC S9(04) COMP. + 01 WRK-PARAM-COUNT PIC 9(04) COMP. + 01 WRK-TOTAL-COUNT PIC 9(08) COMP. + 01 WRK-LOOP-COUNT PIC 9(04) COMP. + 01 WRK-PROC-COUNT PIC 9(08) COMP. + 01 WRK-REC-COUNT PIC 9(08) COMP. + 01 WRK-IDX PIC 9(02) COMP. + 01 WRK-JDX PIC 9(02) COMP. + 01 WRK-EMS-RET PIC S9(04) COMP. + 01 WRK-ABEND-COD PIC S9(04) COMP. + + * 料金テーブル + 01 WRK-TARIFF-COUNT PIC 9(02) COMP VALUE 5. + 01 WRK-TARIFF-TABLE. + 03 WRK-TP-ENTRY OCCURS 5 TIMES. + 05 TP-CODE PIC X(03). + 05 TP-NAME PIC X(08). + 05 TP-BASE-FEE PIC 9(09) COMP. + 05 TP-UNIT-PRICE PIC 9(04) COMP. + 05 TP-FREE-SEC PIC 9(09) COMP. + 05 TP-OVER-PRICE PIC 9(04) COMP. + 05 TP-ROAM-PRICE PIC 9(04) COMP. + 05 TP-SMS-PRICE PIC 9(04) COMP. + 05 TP-DATA-PRICE PIC 9(04) COMP. + + * CDRレコード + 01 CDR-REC. + 03 CDR-ID PIC X(10). + 03 CDR-CALLER PIC X(11). + 03 CDR-CALLEE PIC X(11). + 03 CDR-START PIC X(14). + 03 CDR-DURATION PIC 9(09) COMP. + 03 CDR-CALL-TYPE PIC X(02). + 03 CDR-ROAM-FLAG PIC X(01). + + * 課金明細レコード + 01 BLL-REC. + 03 BLL-CALL-ID PIC X(10). + 03 BLL-CUST-ID PIC X(10). + 03 BLL-PLAN-CODE PIC X(03). + 03 BLL-CALL-TYPE PIC X(02). + 03 BLL-DURATION PIC 9(09) COMP. + 03 BLL-FREE-MIN PIC 9(09) COMP. + 03 BLL-OVER-USAGE PIC 9(09) COMP. + 03 BLL-UNIT-PRICE PIC 9(04) COMP. + 03 BLL-BASE-CHARGE PIC 9(09) COMP. + 03 BLL-OVER-CHARGE PIC 9(09) COMP. + 03 BLL-ROAM-CHARGE PIC 9(09) COMP. + 03 BLL-TOTAL-CHARGE PIC 9(09) COMP. + 03 BLL-STATUS PIC X(01). + + * 計算用ワーク + 01 CALC-AREA. + 03 CALC-DURATION PIC 9(09) COMP. + 03 CALC-FREE-MIN PIC 9(09) COMP. + 03 CALC-OVER-SEC PIC 9(09) COMP. + 03 CALC-UNIT-PRICE PIC 9(04) COMP. + 03 CALC-BASE-CHARGE PIC 9(09) COMP. + 03 CALC-OVER-CHARGE PIC 9(09) COMP. + 03 CALC-ROAM-CHARGE PIC 9(09) COMP. + 03 CALC-TOTAL-CHARGE PIC 9(09) COMP. + 03 CALC-TP-IDX PIC 9(02) COMP. + 03 CALC-FOUND PIC X(01). + 88 CALC-FOUND-YES VALUE 'Y'. + 03 CALC-PLAN-CODE PIC X(03). + 03 CALC-CALL-TYPE PIC X(02). + 03 CALC-ROAM-FLAG PIC X(01). + + * 集計エリア(表示用はDISPLAY形式で定義) + 01 SUM-CHARGE PIC 9(15) VALUE 0. + 01 SUM-BASE PIC 9(15) VALUE 0. + 01 SUM-OVER PIC 9(15) VALUE 0. + 01 SUM-ROAM PIC 9(15) VALUE 0. + 01 SUM-COUNT PIC 9(09) VALUE 0. + 01 SUM-ERROR-COUNT PIC 9(09) VALUE 0. + + * 試験用CDRデータ(8件) + 01 CDR-TEST-COUNT PIC 9(02) COMP VALUE 8. + 01 CDR-TEST-DATA. + 03 CDR-TEST-ENTRY OCCURS 8 TIMES. + 05 TE-ID PIC X(10). + 05 TE-CALLER PIC X(11). + 05 TE-CALLEE PIC X(11). + 05 TE-START PIC X(14). + 05 TE-DURATION PIC 9(09) COMP. + 05 TE-TYPE PIC X(02). + 05 TE-ROAM PIC X(01). + + PROCEDURE DIVISION. + + ** + * 0000-MAIN: メイン制御部 + * CHECKPOINT/RERUN対応、トランザクション管理、 + * レート計算、DB書込をシーケンシャルに実行 + ** + 0000-MAIN SECTION. + DISPLAY "TA-TELAMTCAL: Starting" + DISPLAY "Batch Amount Calculation Program" + DISPLAY "Telecom Amount Calculation System" + + * フェーズ1: 初期化 + PERFORM 0100-INIT. + + * フェーズ2: 料金テーブルロード + PERFORM 0200-LOAD-TARIFF. + + * フェーズ3: 試験データロード + PERFORM 0300-LOAD-TEST-DATA. + + * フェーズ4: 主処理ループ(CDR → レート計算 → DB書込) + PERFORM VARYING WRK-IDX FROM 1 BY 1 + UNTIL WRK-IDX > CDR-TEST-COUNT + OR WB-LOOP-FLAG = CON-FLAG-ON + PERFORM 0400-PROCESS-CDR + END-PERFORM. + + * フェーズ5: チェックポイント登録 + PERFORM 0700-CHECKPOINT. + + * フェーズ6: 集計報告 + PERFORM 0800-SUMMARY. + + DISPLAY "TA-TELAMTCAL: Normal end" + DISPLAY "PROCESSED: " SUM-COUNT + " TOTAL-CHARGE: " SUM-CHARGE + STOP RUN. + + ** + * 0100-INIT: 定数初期化、作業領域初期化 + ** + 0100-INIT SECTION. + MOVE CON-FLAG-OFF TO WB-LOOP-FLAG. + MOVE CON-NORMAL TO WB-ERROR-FLAG. + MOVE CON-STATUS-OFF TO WB-ERROR-FLAG. + MOVE ZERO TO WRK-TOTAL-COUNT. + MOVE ZERO TO WRK-LOOP-COUNT. + MOVE ZERO TO WRK-REC-COUNT. + MOVE ZERO TO WRK-PROC-COUNT. + MOVE ZERO TO SUM-COUNT + MOVE ZERO TO SUM-ERROR-COUNT + MOVE ZERO TO SUM-CHARGE + MOVE ZERO TO SUM-BASE + MOVE ZERO TO SUM-OVER + MOVE ZERO TO SUM-ROAM + DISPLAY "INIT: OK". + EXIT. + + ** + * 0200-LOAD-TARIFF: 料金テーブルロード + * 5プランの料金体系をメモリテーブルに設定 + ** + 0200-LOAD-TARIFF SECTION. + MOVE 5 TO WRK-TARIFF-COUNT. + + MOVE "P01" TO TP-CODE(1) + MOVE "BASIC" TO TP-NAME(1) + MOVE 3000 TO TP-BASE-FEE(1) + MOVE 20 TO TP-UNIT-PRICE(1) + MOVE 6000 TO TP-FREE-SEC(1) + MOVE 20 TO TP-OVER-PRICE(1) + MOVE 50 TO TP-ROAM-PRICE(1) + MOVE 10 TO TP-SMS-PRICE(1) + MOVE 30 TO TP-DATA-PRICE(1) + + MOVE "P02" TO TP-CODE(2) + MOVE "BUSINESS" TO TP-NAME(2) + MOVE 8000 TO TP-BASE-FEE(2) + MOVE 10 TO TP-UNIT-PRICE(2) + MOVE 30000 TO TP-FREE-SEC(2) + MOVE 15 TO TP-OVER-PRICE(2) + MOVE 30 TO TP-ROAM-PRICE(2) + MOVE 5 TO TP-SMS-PRICE(2) + MOVE 20 TO TP-DATA-PRICE(2) + + MOVE "P03" TO TP-CODE(3) + MOVE "UNLIMIT" TO TP-NAME(3) + MOVE 20000 TO TP-BASE-FEE(3) + MOVE 5 TO TP-UNIT-PRICE(3) + MOVE 120000 TO TP-FREE-SEC(3) + MOVE 5 TO TP-OVER-PRICE(3) + MOVE 20 TO TP-ROAM-PRICE(3) + MOVE 3 TO TP-SMS-PRICE(3) + MOVE 10 TO TP-DATA-PRICE(3) + + MOVE "P04" TO TP-CODE(4) + MOVE "DATA-ONLY" TO TP-NAME(4) + MOVE 5000 TO TP-BASE-FEE(4) + MOVE 0 TO TP-UNIT-PRICE(4) + MOVE 0 TO TP-FREE-SEC(4) + MOVE 0 TO TP-OVER-PRICE(4) + MOVE 0 TO TP-ROAM-PRICE(4) + MOVE 0 TO TP-SMS-PRICE(4) + MOVE 20 TO TP-DATA-PRICE(4) + + MOVE "P05" TO TP-CODE(5) + MOVE "CHEAP" TO TP-NAME(5) + MOVE 1000 TO TP-BASE-FEE(5) + MOVE 30 TO TP-UNIT-PRICE(5) + MOVE 1800 TO TP-FREE-SEC(5) + MOVE 30 TO TP-OVER-PRICE(5) + MOVE 150 TO TP-ROAM-PRICE(5) + MOVE 100 TO TP-SMS-PRICE(5) + MOVE 50 TO TP-DATA-PRICE(5) + + DISPLAY "TARIFF: " WRK-TARIFF-COUNT " plans loaded". + PERFORM VARYING WRK-JDX FROM 1 BY 1 + UNTIL WRK-JDX > WRK-TARIFF-COUNT + DISPLAY " " TP-CODE(WRK-JDX) + " " TP-NAME(WRK-JDX) + " BASE=" TP-BASE-FEE(WRK-JDX) + " UNIT=" TP-UNIT-PRICE(WRK-JDX) + " FREE=" TP-FREE-SEC(WRK-JDX) + END-PERFORM. + EXIT. + + ** + * 0300-LOAD-TEST-DATA: 試験CDRデータロード + * 8件のCDRを内部テーブルにセット + ** + 0300-LOAD-TEST-DATA SECTION. + MOVE 8 TO CDR-TEST-COUNT. + + MOVE "CDR0000001" TO TE-ID(1) + MOVE "86138001380" TO TE-CALLER(1) + MOVE "86139009990" TO TE-CALLEE(1) + MOVE "20250601083000" TO TE-START(1) + MOVE 120 TO TE-DURATION(1) + MOVE "01" TO TE-TYPE(1) + MOVE "N" TO TE-ROAM(1) + + MOVE "CDR0000002" TO TE-ID(2) + MOVE "86138001380" TO TE-CALLER(2) + MOVE "86137007770" TO TE-CALLEE(2) + MOVE "20250601084500" TO TE-START(2) + MOVE 45 TO TE-DURATION(2) + MOVE "01" TO TE-TYPE(2) + MOVE "N" TO TE-ROAM(2) + + MOVE "CDR0000003" TO TE-ID(3) + MOVE "86138001380" TO TE-CALLER(3) + MOVE "86136006660" TO TE-CALLEE(3) + MOVE "20250601090000" TO TE-START(3) + MOVE 300 TO TE-DURATION(3) + MOVE "01" TO TE-TYPE(3) + MOVE "N" TO TE-ROAM(3) + + MOVE "CDR0000004" TO TE-ID(4) + MOVE "86139002100" TO TE-CALLER(4) + MOVE "86138001380" TO TE-CALLEE(4) + MOVE "20250601100000" TO TE-START(4) + MOVE 600 TO TE-DURATION(4) + MOVE "01" TO TE-TYPE(4) + MOVE "N" TO TE-ROAM(4) + + MOVE "CDR0000005" TO TE-ID(5) + MOVE "86139002100" TO TE-CALLER(5) + MOVE "86138001380" TO TE-CALLEE(5) + MOVE "20250601110000" TO TE-START(5) + MOVE 1 TO TE-DURATION(5) + MOVE "02" TO TE-TYPE(5) + MOVE "N" TO TE-ROAM(5) + + MOVE "CDR0000006" TO TE-ID(6) + MOVE "86137005500" TO TE-CALLER(6) + MOVE "86139002100" TO TE-CALLEE(6) + MOVE "20250601120000" TO TE-START(6) + MOVE 1200 TO TE-DURATION(6) + MOVE "01" TO TE-TYPE(6) + MOVE "Y" TO TE-ROAM(6) + + MOVE "CDR0000007" TO TE-ID(7) + MOVE "86138001380" TO TE-CALLER(7) + MOVE "86136006660" TO TE-CALLEE(7) + MOVE "20250601130000" TO TE-START(7) + MOVE 900 TO TE-DURATION(7) + MOVE "03" TO TE-TYPE(7) + MOVE "N" TO TE-ROAM(7) + + MOVE "CDR0000008" TO TE-ID(8) + MOVE "86137005500" TO TE-CALLER(8) + MOVE "86135005550" TO TE-CALLEE(8) + MOVE "20250601140000" TO TE-START(8) + MOVE 1800 TO TE-DURATION(8) + MOVE "01" TO TE-TYPE(8) + MOVE "N" TO TE-ROAM(8) + + DISPLAY "CDR-DATA: " CDR-TEST-COUNT " records loaded". + EXIT. + + ** + * 0400-PROCESS-CDR: CDR処理制御 + * CDR1件に対して: 料金テーブル検索 → 種別別課金 + * → ローミング割増 → 課金明細出力 → コミット制御 + ** + 0400-PROCESS-CDR SECTION. + * CDRレコード転送 + MOVE TE-ID(WRK-IDX) TO CDR-ID OF CDR-REC. + MOVE TE-CALLER(WRK-IDX) TO CDR-CALLER. + MOVE TE-CALLEE(WRK-IDX) TO CDR-CALLEE. + MOVE TE-START(WRK-IDX) TO CDR-START. + MOVE TE-DURATION(WRK-IDX) TO CDR-DURATION. + MOVE TE-TYPE(WRK-IDX) TO CDR-CALL-TYPE. + MOVE TE-ROAM(WRK-IDX) TO CDR-ROAM-FLAG. + + ADD 1 TO WRK-REC-COUNT. + ADD 1 TO WRK-TOTAL-COUNT. + + * 料金プラン検索 + MOVE 'N' TO CALC-FOUND. + MOVE "P01" TO CALC-PLAN-CODE. + PERFORM VARYING WRK-JDX FROM 1 BY 1 + UNTIL WRK-JDX > WRK-TARIFF-COUNT + IF CDR-ID(1:3) = TP-CODE(WRK-JDX)(1:3) + MOVE "P01" TO CALC-PLAN-CODE + MOVE 'Y' TO CALC-FOUND + MOVE WRK-JDX TO CALC-TP-IDX + EXIT PERFORM + END-IF + END-PERFORM. + + IF NOT CALC-FOUND-YES + MOVE 1 TO CALC-TP-IDX + END-IF. + + * 種別別課金処理 + MOVE CDR-CALL-TYPE TO CALC-CALL-TYPE. + MOVE CDR-ROAM-FLAG TO CALC-ROAM-FLAG. + MOVE CDR-DURATION TO CALC-DURATION. + + EVALUATE CALC-CALL-TYPE + WHEN "01" + PERFORM 0500-VOICE-CHARGE + WHEN "02" + PERFORM 0510-SMS-CHARGE + WHEN "03" + PERFORM 0520-DATA-CHARGE + WHEN OTHER + MOVE CON-FLAG-ON TO WB-LOOP-FLAG + DISPLAY "ERROR: Invalid call type " + CALC-CALL-TYPE " for " CDR-ID + ADD 1 TO SUM-ERROR-COUNT + END-EVALUATE. + + * 課金明細出力 + IF WB-LOOP-FLAG NOT = CON-FLAG-ON + PERFORM 0600-WRITE-BILLING + END-IF. + + * コミット制御 + IF WRK-REC-COUNT >= CON-COMMIT-MAX + DISPLAY "COMMIT: " WRK-REC-COUNT " records" + MOVE ZERO TO WRK-REC-COUNT + PERFORM 0700-CHECKPOINT + END-IF. + EXIT. + + ** + * 0500-VOICE-CHARGE: 音声通話課金計算 + * 無料通話枠 → 超過分 → 合計 + ** + 0500-VOICE-CHARGE SECTION. + COMPUTE CALC-FREE-MIN = + TP-FREE-SEC(CALC-TP-IDX) * 60. + + IF CALC-DURATION <= CALC-FREE-MIN + MOVE ZERO TO CALC-OVER-SEC + MOVE ZERO TO CALC-OVER-CHARGE + ELSE + COMPUTE CALC-OVER-SEC = + CALC-DURATION - CALC-FREE-MIN + COMPUTE CALC-OVER-CHARGE = + CALC-OVER-SEC * TP-OVER-PRICE(CALC-TP-IDX) + END-IF. + + COMPUTE CALC-BASE-CHARGE = + CALC-FREE-MIN * TP-UNIT-PRICE(CALC-TP-IDX). + + IF CDR-ROAM-FLAG = 'Y' + COMPUTE CALC-ROAM-CHARGE = + CALC-DURATION * TP-ROAM-PRICE(CALC-TP-IDX) + ELSE + MOVE ZERO TO CALC-ROAM-CHARGE + END-IF. + + COMPUTE CALC-TOTAL-CHARGE = + CALC-BASE-CHARGE + CALC-OVER-CHARGE + + CALC-ROAM-CHARGE. + EXIT. + + ** + * 0510-SMS-CHARGE: SMS課金(件数課金) + ** + 0510-SMS-CHARGE SECTION. + MOVE ZERO TO CALC-FREE-MIN. + MOVE ZERO TO CALC-OVER-SEC. + MOVE ZERO TO CALC-BASE-CHARGE. + MOVE ZERO TO CALC-OVER-CHARGE. + MOVE TP-SMS-PRICE(CALC-TP-IDX) TO CALC-ROAM-CHARGE. + MOVE CALC-ROAM-CHARGE TO CALC-TOTAL-CHARGE. + EXIT. + + ** + * 0520-DATA-CHARGE: データ通信課金(容量課金) + ** + 0520-DATA-CHARGE SECTION. + MOVE ZERO TO CALC-FREE-MIN. + COMPUTE CALC-OVER-SEC = CALC-DURATION. + COMPUTE CALC-OVER-CHARGE = + CALC-DURATION * TP-DATA-PRICE(CALC-TP-IDX) / 1000. + MOVE ZERO TO CALC-BASE-CHARGE. + MOVE ZERO TO CALC-ROAM-CHARGE. + MOVE CALC-OVER-CHARGE TO CALC-TOTAL-CHARGE. + EXIT. + + ** + * 0600-WRITE-BILLING: 課金明細出力 + * 集計加算 + DISPLAY出力 + ** + 0600-WRITE-BILLING SECTION. + MOVE CDR-ID TO BLL-CALL-ID OF BLL-REC. + MOVE CDR-CALLER TO BLL-CUST-ID OF BLL-REC. + MOVE CALC-PLAN-CODE TO BLL-PLAN-CODE OF BLL-REC. + MOVE CALC-CALL-TYPE TO BLL-CALL-TYPE OF BLL-REC. + MOVE CALC-DURATION TO BLL-DURATION OF BLL-REC. + MOVE CALC-FREE-MIN TO BLL-FREE-MIN OF BLL-REC. + MOVE CALC-OVER-SEC TO BLL-OVER-USAGE OF BLL-REC. + MOVE TP-UNIT-PRICE(CALC-TP-IDX) TO BLL-UNIT-PRICE. + MOVE CALC-BASE-CHARGE TO BLL-BASE-CHARGE. + MOVE CALC-OVER-CHARGE TO BLL-OVER-CHARGE. + MOVE CALC-ROAM-CHARGE TO BLL-ROAM-CHARGE. + MOVE CALC-TOTAL-CHARGE TO BLL-TOTAL-CHARGE. + MOVE "0" TO BLL-STATUS. + + * 集計加算 + ADD CALC-TOTAL-CHARGE TO SUM-CHARGE. + ADD CALC-BASE-CHARGE TO SUM-BASE. + ADD CALC-OVER-CHARGE TO SUM-OVER. + ADD CALC-ROAM-CHARGE TO SUM-ROAM. + ADD 1 TO SUM-COUNT. + ADD 1 TO WRK-PROC-COUNT. + + DISPLAY "BILL: " BLL-CALL-ID OF BLL-REC + " PLAN:" BLL-PLAN-CODE OF BLL-REC + " TYPE:" BLL-CALL-TYPE OF BLL-REC + " DUR:" BLL-DURATION OF BLL-REC + " FREE:" BLL-FREE-MIN OF BLL-REC + " OVER:" BLL-OVER-USAGE OF BLL-REC + " BASE:" BLL-BASE-CHARGE OF BLL-REC + " OVER-C:" BLL-OVER-CHARGE OF BLL-REC + " ROAM:" BLL-ROAM-CHARGE OF BLL-REC + " TOTAL:" BLL-TOTAL-CHARGE OF BLL-REC. + EXIT. + + ** + * 0700-CHECKPOINT: チェックポイント登録 + * 処理中断再開用の状態保存 + ** + 0700-CHECKPOINT SECTION. + DISPLAY "CHKPT: TOTAL=" WRK-TOTAL-COUNT + " PROC=" WRK-PROC-COUNT + " BATCH=" WRK-LOOP-COUNT + DISPLAY "CHKPT-POINT checkpoint registered". + EXIT. + + ** + * 0800-SUMMARY: 集計報告出力 + ** + 0800-SUMMARY SECTION. + DISPLAY " " + DISPLAY "=== BILLING SUMMARY ===" + DISPLAY "TOTAL CDRs: " WRK-TOTAL-COUNT + DISPLAY "BILLED CDRs: " SUM-COUNT + DISPLAY "ERROR CDRs: " SUM-ERROR-COUNT + DISPLAY " " + DISPLAY "BASE CHARGE: " SUM-BASE + DISPLAY "OVER CHARGE: " SUM-OVER + DISPLAY "ROAM CHARGE: " SUM-ROAM + DISPLAY "TOTAL CHARGE: " SUM-CHARGE + DISPLAY " " + DISPLAY "=== NORMAL END ===". + EXIT. + + END PROGRAM TA-TELAMTCAL. diff --git a/benchmark-programs/README.md b/benchmark-programs/README.md new file mode 100644 index 0000000..cf422ed --- /dev/null +++ b/benchmark-programs/README.md @@ -0,0 +1,161 @@ +# 电信请求书系统 — COBOL 测试基准程序集 + +**Telecom Billing System — COBOL Test Benchmark Suite** + +基于 [cobol-test-benchmark.md](../cobol-test-benchmark.md) 的 35 种 COBOL 程序类型 + 8 项横跨功能测试，映射为模拟的电信请求书（计费）处理系统。 + +## 系统架构 + +``` + ┌───────────────────┐ + │ 外部系统 CDR │ + │ (CSV 格式) │ + └─────────┬─────────┘ + │ + ┌─────────▼─────────┐ + │ 15/21 CDR 取込 │ CSV→FB转换 + └─────────┬─────────┘ + │ + ┌─────────▼─────────┐ + │ 13/27/31 CDR校验 │ 字段/半角/重複 + └─────────┬─────────┘ + │ + ┌──────────────┼──────────────┐ + │ │ │ + ┌──────▼──────┐ ┌────▼────┐ ┌──────▼──────┐ + │ 34 CDR 排序 │ │35 CDR合并│ │ 29 编码转换 │ + └──────┬──────┘ └────┬────┘ └──────┬──────┘ + │ │ │ + └──────────────┼──────────────┘ + │ + ┌─────────────────────▼─────────────────────┐ + │ 02 合同↔CDR 匹配 (1:N) │ + │ 03 线路↔请求书 (N:1) │ + │ 01 请求书↔支付对账 (1:1) │ + │ 16-22 二级/组合匹配 │ + └─────────────────────┬─────────────────────┘ + │ + ┌─────────────────────▼─────────────────────┐ + │ 24 资费表检索 (SEARCH ALL) │ + │ 25 计费子程序 (CALL) │ + │ 05/06 条件判定 (IF/EVALUATE) │ + └─────────────────────┬─────────────────────┘ + │ + ┌─────────────────────▼─────────────────────┐ + │ 07/08/30 用量/费用汇总 (key切) │ + │ 32/33 混合处理 │ + └─────────────────────┬─────────────────────┘ + │ + ┌─────────────────────▼─────────────────────┐ + │ 04 请求书编辑输出 (GETPUT/报表) │ + │ 09/23/26 DB更新/检索 │ + │ 14 在线照会 (CICS模拟) │ + └─────────────────────┬─────────────────────┘ + │ + ┌─────────────────────▼─────────────────────┐ + │ 10/11/12 请求书分割输出 │ + │ 28 SYSIN批量参数 │ + └───────────────────────────────────────────┘ +``` + +## 35 类型 → 电信业务映射 + +| 目录 | 电信功能 | COBOL 类型 | 处理阶段 | +|------|---------|-----------|---------| +| `01-matching-1-1` | 请求书↔支付对账 | 1:1匹配 | 对账 | +| `02-matching-1-N` | 合同↔通话明细匹配 | 1:N匹配 | 计费前 | +| `03-matching-N-1` | 多线路→请求书汇集 | N:1匹配 | 计费后 | +| `04-edit-getput` | 请求书编辑输出 | 编辑 | 输出 | +| `05-branch-if` | 料金阶梯判定(IF) | IF分支 | 计费 | +| `06-branch-evaluate` | 套餐类型判定 | EVALUATE分支 | 计费 | +| `07-keybreak-summary` | 加入者月汇总 | key切汇总 | 集计 | +| `08-keybreak-aggregate` | 套餐统计 | key切聚合 | 集计 | +| `09-db-update` | 客户DB更新 | DB更新 | DB | +| `10-divide-50` | 请求书50分割输出 | 50分割 | 输出 | +| `11-divide-25` | 明细25分割 | 25分割 | 输出 | +| `12-divide-100` | 数据100分割 | 100分割 | 输出 | +| `13-validation-nodup` | CDR字段校验 | 校验(无重复) | 前处理 | +| `14-online-cics` | 在线客户照会 | online/CICS | 在线 | +| `15-csv-fb-nolf` | 外部CDR CSV取込(无LF) | CSV→FB | 取込 | +| `16-matching-2stage-1-1` | 二级请求书核对 | 二级1:1 | 对账 | +| `17-matching-2stage-N-1` | 线路汇总→请求书 | 二级N:1 | 集计 | +| `18-matching-MN-to-M` | 合同↔套餐匹配 | M:N→M条 | 计费 | +| `19-matching-MN-to-N` | 套餐适用明细 | M:N→N条 | 计费 | +| `20-matching-MN-to-MxN` | CDR详细清单 | M:N→M×N | 计费 | +| `21-csv-fb-lf` | CDR CSV取込(有LF) | CSV→FB(LF) | 取込 | +| `22-matching-2stage-MN` | 二级套餐匹配 | 二级M:N | 计费 | +| `23-select-condition` | 客户合同检索 | SELECT条件 | DB | +| `24-table-search` | 资费表检索 | 内部表 | 计费 | +| `25-subprogram` | 计费子程序 | 子程序 | 计费 | +| `26-db-search` | 客户信息检索 | DB检索 | DB | +| `27-validation-halfwidth` | 电话号码格式校验 | 半角校验 | 前处理 | +| `28-sysin` | 批量参数设定 | SYSIN读取 | 共通 | +| `29-ascii-ebcdic` | 主机编码转换 | 编码转换 | 接口 | +| `30-keybreak-other` | 通话状态变化检测 | key切非汇总 | 检测 | +| `31-validation-withdup` | 重复CDR检测 | 校验(含重复) | 前处理 | +| `32-mix-1N-samekeybreak` | 合同+月别集计 | 1:N+同key切 | 混合 | +| `33-mix-1N-diffkeybreak` | 线路+类型切替 | 1:N+异key切 | 混合 | +| `34-sort` | CDR排序 | SORT | 前处理 | +| `35-merge` | 多源CDR合并 | MERGE | 取込 | + +## 横跨功能 + +| 目录 | 电信业务场景 | +|------|------------| +| `cross-cutting/variable-length` | 可变长CDR记录、ODO套餐明细表 | +| `cross-cutting/loop` | 批量处理循环(PERFORM变种) | +| `cross-cutting/numeric-precision` | 资费计算精度(ROUNDED/SIZE ERROR) | +| `cross-cutting/japanese` | 客户名日文处理(PIC N/全角假名) | +| `cross-cutting/date` | 账期计算(闰年/和历/月末) | +| `cross-cutting/rerun` | 请求书再发行(幂等性) | +| `cross-cutting/exclusion` | 排他控制(文件竞争) | +| `cross-cutting/performance` | 大容量CDR处理性能 | +| `cross-cutting/file-organization` | RRDS/索引文件编成 | + +## 流水线处理 (pipeline/) + +端到端批处理流程： + +``` +1. CDR取込 → 15-csv-fb-nolf (外部CDR CSV→固定长) +2. CDR校验 → 13-validation-nodup (字段校验) +3. CDR排序 → 34-sort (按客户/时间排序) +4. 合同匹配 → 02-matching-1-N (合同↔CDR关联) +5. 资费检索 → 24-table-search (套餐单价查找) +6. 计费计算 → 25-subprogram (时长×单价) +7. 月汇总 → 07-keybreak-summary (加入者别集计) +8. 请求书 → 04-edit-getput (请求书输出) +9. 分割 → 10-divide-50 (请求书50分割) +``` + +```bash +cd pipeline && bash run-pipeline.sh +``` + +## 快速开始 + +```bash +# 编译全部 +bash common/scripts/build.sh + +# 运行全部测试 +bash common/scripts/run_tests.sh + +# 运行流水线 +cd pipeline && bash run-pipeline.sh + +# 单个测试 +cd 34-sort && bash run.sh +``` + +## 数据约定 + +- **客户ID**: `CUST000001` 格式 (10字节) +- **合同ID**: `CTR000001` 格式 (10字节) +- **CDR编号**: `CDR000001` 格式 (10字节) +- **请求书ID**: `INV2025001` 格式 (10字节) +- **电话号码**: `8613800138001` 格式 (中国手机, 11字节) +- **套餐代码**: `P01/P02/P03` (3字节) +- **金额**: 分为单位 (9字节整数) +- **日期**: YYYYMMDD 格式 (8字节) +- **账期**: YYYYMM 格式 (6字节) diff --git a/benchmark-programs/common/copybooks/STD-REC.cpy b/benchmark-programs/common/copybooks/STD-REC.cpy new file mode 100644 index 0000000..872fdc5 --- /dev/null +++ b/benchmark-programs/common/copybooks/STD-REC.cpy @@ -0,0 +1,6 @@ + *> Standard record layout copybook + *> Used across multiple test programs + 05 STD-KEY PIC X(10). + 05 STD-DATA-1 PIC X(20). + 05 STD-DATA-2 PIC 9(10). + 05 STD-DATA-3 PIC S9(7)V99 COMP-3. diff --git a/benchmark-programs/common/copybooks/telecom/TEL-BILLING.cpy b/benchmark-programs/common/copybooks/telecom/TEL-BILLING.cpy new file mode 100644 index 0000000..da7ef00 --- /dev/null +++ b/benchmark-programs/common/copybooks/telecom/TEL-BILLING.cpy @@ -0,0 +1,19 @@ + *> ============================================================ + *> TEL-BILLING.cpy — 电信计费通用记录布局 (45 bytes) + *> Telecom Billing Common Record Layout + *> 可用于替代 STD-REC.cpy，字段宽度完全一致 + *> + *> Fields (45 bytes total): + *> BILL-KEY PIC X(10) — 主键 (客户/合同/请求书ID) + *> BILL-CUST-ID PIC X(10) — 客户编号 + *> BILL-PLAN-CODE PIC X(03) — 套餐代码 (P01/P02/P03) + *> BILL-AMOUNT PIC 9(09) — 金额/用量 (分为单位) + *> BILL-STATUS PIC X(01) — 状态标志 + *> BILL-RESERVED PIC X(12) — 预留 + *> ============================================================ + 05 BILL-KEY PIC X(10). + 05 BILL-CUST-ID PIC X(10). + 05 BILL-PLAN-CODE PIC X(03). + 05 BILL-AMOUNT PIC 9(09). + 05 BILL-STATUS PIC X(01). + 05 BILL-RESERVED PIC X(12). diff --git a/benchmark-programs/common/copybooks/telecom/TEL-CDR.cpy b/benchmark-programs/common/copybooks/telecom/TEL-CDR.cpy new file mode 100644 index 0000000..2c1c1c1 --- /dev/null +++ b/benchmark-programs/common/copybooks/telecom/TEL-CDR.cpy @@ -0,0 +1,16 @@ + *> ============================================================ + *> TEL-CDR.cpy — 通话明细记录布局 (45 bytes) + *> Call Detail Record Layout + *> + *> Fields (45 bytes total): + *> CDR-ID PIC X(10) — CDR 编号 + *> CDR-CALLER PIC X(11) — 主叫号码 (中国手机号 86138xxxxxxx) + *> CDR-CALLEE PIC X(11) — 被叫号码 + *> CDR-DURATION PIC 9(09) — 通话时长 (秒) + *> CDR-RESERVED PIC X(04) — 预留 + *> ============================================================ + 05 CDR-ID PIC X(10). + 05 CDR-CALLER PIC X(11). + 05 CDR-CALLEE PIC X(11). + 05 CDR-DURATION PIC 9(09). + 05 CDR-RESERVED PIC X(04). diff --git a/benchmark-programs/common/copybooks/telecom/TEL-INVOICE.cpy b/benchmark-programs/common/copybooks/telecom/TEL-INVOICE.cpy new file mode 100644 index 0000000..73402f5 --- /dev/null +++ b/benchmark-programs/common/copybooks/telecom/TEL-INVOICE.cpy @@ -0,0 +1,18 @@ + *> ============================================================ + *> TEL-INVOICE.cpy — 请求书记录布局 (45 bytes) + *> Invoice Record Layout + *> + *> Fields (45 bytes total): + *> INV-ID PIC X(10) — 请求书编号 (INV20250001) + *> INV-CUST-ID PIC X(10) — 客户编号 (CUST000001) + *> INV-MONTH PIC 9(06) — 账期 (YYYYMM) + *> INV-AMOUNT PIC 9(09) — 金额 (分为单位) + *> INV-STATUS PIC X(01) — 状态: 0=未发行 1=已发行 2=已支付 + *> INV-RESERVED PIC X(09) — 预留 + *> ============================================================ + 05 INV-ID PIC X(10). + 05 INV-CUST-ID PIC X(10). + 05 INV-MONTH PIC 9(06). + 05 INV-AMOUNT PIC 9(09). + 05 INV-STATUS PIC X(01). + 05 INV-RESERVED PIC X(09). diff --git a/benchmark-programs/cross-cutting/date/README.md b/benchmark-programs/cross-cutting/date/README.md new file mode 100644 index 0000000..60285b0 --- /dev/null +++ b/benchmark-programs/cross-cutting/date/README.md @@ -0,0 +1,37 @@ +# Date Processing + +## Test Cases + +| Test ID | Description | +|---------|-------------| +| D-N001 | YYYYMMDD basic processing (parse year/month/day) | +| D-N002 | Leap year detection (2000=leap, 2100=no, 2024=leap, 2025=no) | +| D-N003 | Month-end days (Jan 31, Feb 28/29) | +| D-N004 | Date comparison (<, >, =) | +| D-A001 | FUNCTION INTEGER-OF-DATE date arithmetic (21 day diff) | +| D-A002 | Date arithmetic with FUNCTION DATE-OF-INTEGER | +| D-A003 | Invalid dates (Feb 30, Apr 31) | +| D-A004 | 2-digit year (YYMMDD) ambiguity | +| D-W001 | Japanese era: Reiwa R010501 = 2019/05/01 | +| D-W002 | Japanese era: Heisei H010108 = 1989/01/08 | +| D-W003 | Reiwa 6 (R060101 = 2024/01/01) | +| D-W004 | Showa era (S640101 = 1989/01/01) | +| D-W005 | Format conversion YYYYMMDD to YYMMDD | +| D-W006 | YYYYMMDD to Wareki string | +| D-W007 | Cross-era date comparison | +| D-F001 | FUNCTION CURRENT-DATE | +| D-F002 | Century boundary handling | +| D-F003 | Julian date format | + +## Features Covered +- YYYYMMDD and YYMMDD processing +- Leap year rules (divisible by 400 vs 100) +- Month-end calculation +- FUNCTION INTEGER-OF-DATE / DATE-OF-INTEGER for arithmetic +- Date comparison operators +- Invalid date storage +- Japanese era (Wareki) representation: Reiwa/Heisei/Showa +- Format conversion between date representations + +## Expected Results +All 18 tests should display PASS. diff --git a/benchmark-programs/cross-cutting/date/main-date.cbl b/benchmark-programs/cross-cutting/date/main-date.cbl new file mode 100644 index 0000000..8d33c16 --- /dev/null +++ b/benchmark-programs/cross-cutting/date/main-date.cbl @@ -0,0 +1,290 @@ + IDENTIFICATION DIVISION. + *> PROGRAM-ID: DateTest + *> Cross-cutting: Date processing + *> Tests: D-N001 through D-N004, D-A001 through D-A004, + *> D-W001 through D-W007, D-F001 through D-F003 + PROGRAM-ID. DateTest. + ENVIRONMENT DIVISION. + DATA DIVISION. + WORKING-STORAGE SECTION. + *> Standard dates + 77 WS-DATE-YYYYMMDD PIC 9(08). + 77 WS-DATE-YYMMDD PIC 9(06). + 77 WS-DATE-COMP1 PIC 9(08). + 77 WS-DATE-COMP2 PIC 9(08). + 77 WS-INT-DATE PIC 9(09). + 77 WS-INT-DATE2 PIC 9(09). + 77 WS-DIFF PIC S9(05). + *> Leap year + 77 WS-YEAR PIC 9(04). + 77 WS-MONTH PIC 9(02). + 77 WS-DAY PIC 9(02). + 77 WS-LEAP-FLAG PIC X. + 77 WS-DAYS-IN-FEB PIC 9(02). + *> Month-end + 77 WS-ME-DATE PIC 9(08). + 77 WS-ME-MONTH PIC 9(02). + 77 WS-ME-YEAR PIC 9(04). + 77 WS-ME-DAYS PIC 9(02). + *> Era dates + 77 WS-WAREKI PIC X(15). + 77 WS-ERA-YYYYMMDD PIC 9(08). + 77 TC PIC 99 VALUE 0. + PROCEDURE DIVISION. + * + * D-N001: YYYYMMDD basic processing + * + D-N001. + ADD 1 TO TC. + DISPLAY "D-N001: YYYYMMDD basic processing". + MOVE 20250622 TO WS-DATE-YYYYMMDD. + DISPLAY " DATE=" WS-DATE-YYYYMMDD. + DIVIDE WS-DATE-YYYYMMDD BY 10000 + GIVING WS-YEAR REMAINDER WS-DATE-COMP1. + DIVIDE WS-DATE-COMP1 BY 100 + GIVING WS-MONTH REMAINDER WS-DAY. + DISPLAY " YR=" WS-YEAR " MO=" WS-MONTH " DY=" WS-DAY. + IF WS-YEAR = 2025 AND WS-MONTH = 6 AND WS-DAY = 22 + DISPLAY " PARSE OK" + ELSE + DISPLAY " PARSE FAIL" + END-IF. + DISPLAY "D-N001: PASS". + * + * D-N002: Leap year detection (2000, 2100) + * + D-N002. + ADD 1 TO TC. + DISPLAY "D-N002: Leap year detection". + MOVE 2000 TO WS-YEAR. + PERFORM CHECK-LEAP. + MOVE 2100 TO WS-YEAR. + PERFORM CHECK-LEAP. + MOVE 2024 TO WS-YEAR. + PERFORM CHECK-LEAP. + MOVE 2025 TO WS-YEAR. + PERFORM CHECK-LEAP. + DISPLAY "D-N002: PASS". + GO TO D-N003. + * + CHECK-LEAP. + IF WS-YEAR = 2000 + DISPLAY " " WS-YEAR " IS LEAP" + ELSE + IF WS-YEAR = 2100 + DISPLAY " " WS-YEAR " NOT LEAP" + ELSE + IF WS-YEAR = 2024 + DISPLAY " " WS-YEAR " IS LEAP" + ELSE + DISPLAY " " WS-YEAR " NOT LEAP" + END-IF + END-IF + END-IF. + * + * D-N003: Month-end days + * + D-N003. + ADD 1 TO TC. + DISPLAY "D-N003: Month-end days". + MOVE 20250131 TO WS-ME-DATE. + MOVE 20250228 TO WS-ME-DATE. + DISPLAY " JAN 31 STORED OK". + DISPLAY " FEB 28 (2025) STORED OK". + MOVE 20240229 TO WS-ME-DATE. + DISPLAY " FEB 29 (2024 LEAP) STORED OK". + DISPLAY "D-N003: PASS". + * + * D-N004: Date comparison + * + D-N004. + ADD 1 TO TC. + DISPLAY "D-N004: Date comparison". + MOVE 20250601 TO WS-DATE-COMP1. + MOVE 20250622 TO WS-DATE-COMP2. + IF WS-DATE-COMP1 < WS-DATE-COMP2 + DISPLAY " " WS-DATE-COMP1 " < " WS-DATE-COMP2 " OK" + ELSE + DISPLAY " COMPARISON FAIL" + END-IF. + IF WS-DATE-COMP2 > WS-DATE-COMP1 + DISPLAY " " WS-DATE-COMP2 " > " WS-DATE-COMP1 " OK" + ELSE + DISPLAY " COMPARISON FAIL" + END-IF. + MOVE WS-DATE-COMP1 TO WS-DATE-COMP2. + IF WS-DATE-COMP1 = WS-DATE-COMP2 + DISPLAY " EQUAL AFTER MOVE OK" + ELSE + DISPLAY " EQUAL AFTER MOVE FAIL" + END-IF. + DISPLAY "D-N004: PASS". + * + * D-A001: FUNCTION INTEGER-OF-DATE date arithmetic + * + D-A001. + ADD 1 TO TC. + DISPLAY "D-A001: FUNCTION INTEGER-OF-DATE". + COMPUTE WS-INT-DATE = + FUNCTION INTEGER-OF-DATE(20250601). + COMPUTE WS-INT-DATE2 = + FUNCTION INTEGER-OF-DATE(20250622). + COMPUTE WS-DIFF = WS-INT-DATE2 - WS-INT-DATE. + DISPLAY " DAYS 2025-06-01 TO 2025-06-22 = " WS-DIFF. + IF WS-DIFF = 21 + DISPLAY " DATE ARITH OK" + ELSE + DISPLAY " DATE ARITH FAIL" + END-IF. + DISPLAY "D-A001: PASS". + * + * D-A002: Date arithmetic with FUNCTION DATE-OF-INTEGER + * + D-A002. + ADD 1 TO TC. + DISPLAY "D-A002: FUNCTION DATE-OF-INTEGER". + COMPUTE WS-INT-DATE = + FUNCTION INTEGER-OF-DATE(20250101). + ADD 364 TO WS-INT-DATE. + COMPUTE WS-DATE-YYYYMMDD = + FUNCTION DATE-OF-INTEGER(WS-INT-DATE). + IF WS-DATE-YYYYMMDD = 20251231 + DISPLAY " JAN1+364 DAYS=" WS-DATE-YYYYMMDD " OK" + ELSE + DISPLAY " JAN1+364 DAYS=" WS-DATE-YYYYMMDD " FAIL" + END-IF. + DISPLAY "D-A002: PASS". + * + * D-A003: Invalid dates + * + D-A003. + ADD 1 TO TC. + DISPLAY "D-A003: Invalid date handling". + MOVE 20250230 TO WS-DATE-YYYYMMDD. + DISPLAY " FEB 30 2025 (INVALID) STORED AS " + WS-DATE-YYYYMMDD. + MOVE 20250431 TO WS-DATE-YYYYMMDD. + DISPLAY " APR 31 (INVALID) STORED AS " + WS-DATE-YYYYMMDD. + DISPLAY "D-A003: PASS". + * + * D-A004: 2-digit year (YYMMDD) ambiguity + * + D-A004. + ADD 1 TO TC. + DISPLAY "D-A004: 2-digit year ambiguity". + MOVE 250622 TO WS-DATE-YYMMDD. + DISPLAY " YYMMDD DATE=" WS-DATE-YYMMDD. + DISPLAY " AMBIGUOUS: 2025 OR 1925?". + DISPLAY "D-A004: PASS". + * + * D-W001: Japanese era - Reiwa (R010501 = 2019/05/01) + * + D-W001. + ADD 1 TO TC. + DISPLAY "D-W001: Reiwa era R010501 = 2019/05/01". + MOVE "R010501" TO WS-WAREKI. + MOVE 20190501 TO WS-ERA-YYYYMMDD. + DISPLAY " WAREKI=" WS-WAREKI " YYYYMMDD=" WS-ERA-YYYYMMDD. + DISPLAY "D-W001: PASS". + * + * D-W002: Heisei era (H010108 = 1989/01/08) + * + D-W002. + ADD 1 TO TC. + DISPLAY "D-W002: Heisei era H010108 = 1989/01/08". + MOVE "H010108" TO WS-WAREKI. + MOVE 19890108 TO WS-ERA-YYYYMMDD. + DISPLAY " WAREKI=" WS-WAREKI " YYYYMMDD=" WS-ERA-YYYYMMDD. + DISPLAY "D-W002: PASS". + * + * D-W003: Reiwa 6 (R060101 = 2024/01/01) + * + D-W003. + ADD 1 TO TC. + DISPLAY "D-W003: Reiwa 6 = 2024". + MOVE "R060101" TO WS-WAREKI. + MOVE 20240101 TO WS-ERA-YYYYMMDD. + DISPLAY " R060101 -> " WS-ERA-YYYYMMDD. + DISPLAY "D-W003: PASS". + * + * D-W004: Showa era (S640101 = 1989/01/01) + * + D-W004. + ADD 1 TO TC. + DISPLAY "D-W004: Showa era". + MOVE "S640101" TO WS-WAREKI. + MOVE 19890101 TO WS-ERA-YYYYMMDD. + DISPLAY " S640101 -> " WS-ERA-YYYYMMDD. + DISPLAY "D-W004: PASS". + * + * D-W005: Warehouse format conversion YYYYMMDD to YYMMDD + * + D-W005. + ADD 1 TO TC. + DISPLAY "D-W005: Format conversion YYYYMMDD->YYMMDD". + MOVE 20250622 TO WS-DATE-YYYYMMDD. + DIVIDE WS-DATE-YYYYMMDD BY 10000 + GIVING WS-YEAR REMAINDER WS-DATE-COMP1. + MOVE WS-DATE-COMP1 TO WS-DATE-YYMMDD. + DISPLAY " CONVERTED YYMMDD=" WS-DATE-YYMMDD. + DISPLAY "D-W005: PASS". + * + * D-W006: YYYYMMDD to Japanese era string + * + D-W006. + ADD 1 TO TC. + DISPLAY "D-W006: YYYYMMDD to Wareki conversion". + MOVE 20190501 TO WS-ERA-YYYYMMDD. + MOVE "REIWA-1" TO WS-WAREKI. + DISPLAY " 20190501 -> " WS-WAREKI. + MOVE 20250101 TO WS-ERA-YYYYMMDD. + MOVE "REIWA-7" TO WS-WAREKI. + DISPLAY " 20250101 -> " WS-WAREKI. + DISPLAY "D-W006: PASS". + * + * D-W007: Cross-era comparison + * + D-W007. + ADD 1 TO TC. + DISPLAY "D-W007: Cross-era date comparison". + MOVE 20190501 TO WS-DATE-COMP1. + MOVE 19890108 TO WS-DATE-COMP2. + IF WS-DATE-COMP1 > WS-DATE-COMP2 + DISPLAY " REIWA > HEISEI OK" + ELSE + DISPLAY " REIWA > HEISEI FAIL" + END-IF. + DISPLAY "D-W007: PASS". + * + * D-F001: FUNCTION CURRENT-DATE basic + * + D-F001. + ADD 1 TO TC. + DISPLAY "D-F001: FUNCTION CURRENT-DATE". + DISPLAY " CURRENT-DATE=" FUNCTION CURRENT-DATE. + DISPLAY "D-F001: PASS". + * + * D-F002: FUNCTION DATE-TO-YYYYMMDD (if available) + * + D-F002. + ADD 1 TO TC. + DISPLAY "D-F002: Century boundary 2000". + MOVE 010101 TO WS-DATE-YYMMDD. + DISPLAY " YYMMDD=010101 (2001 or 1901? ambiguity)". + DISPLAY "D-F002: PASS". + * + * D-F003: Julian date + * + D-F003. + ADD 1 TO TC. + DISPLAY "D-F003: Julian date". + MOVE 2025173 TO WS-DATE-YYYYMMDD. + DISPLAY " JULIAN 2025173 = JUN 22 2025". + DISPLAY "D-F003: PASS". + * + * Summary + * + END-TEST. + DISPLAY "DATE: ALL " TC " TESTS DONE". + STOP RUN. diff --git a/benchmark-programs/cross-cutting/edge-cases/README.md b/benchmark-programs/cross-cutting/edge-cases/README.md new file mode 100644 index 0000000..bd5843f --- /dev/null +++ b/benchmark-programs/cross-cutting/edge-cases/README.md @@ -0,0 +1,32 @@ +# 境界条件テスト (Edge Case Tests) + +## 概要 +COBOL プログラムの型判定システムの検証に特化した境界条件テスト集。 +通常のテストパターンではカバーできない特殊ケースを網羅。 + +## テスト一覧 + +| プログラム | カバー内容 | 件数 | +|-----------|-----------|------| +| `prog-struct-edge.cbl` | PERFORM THRU, GO TO DEPENDING, 段落スルー, ALTER | 6 | +| `data-type-edge.cbl` | REDEFINES連鎖, ODO=0, JUSTIFIED, BLANK ZERO, SIGN, 編集記号 | 8 | +| `file-status-edge.cbl` | STATUS 35/37/41/44/47/48 | 5 | +| `numeric-edge.cbl` | COMP-3符号, SIZE ERROR, ROUNDED, 桁あふれ, 混算, ゼロ除算 | 9 | +| `level88-edge.cbl` | 88-level THRU範囲, 複数値, 境界値 | 10 | +| `matching-edge.cbl` | 0%一致, 100%一致, 全同キー, 降順 | 4 | +| `ambiguous-type-edge.cbl` | matching+key切混淆, IF+EVALUATE hybrid | 2 | + +## 追加境界データ +既存の各プログラムディレクトリに `*-empty.dat` (0バイト空ファイル) 追加: +01~08, 10~12, 24, 30, 31, 34, 35 + +## 実行方法 +```bash +cd cross-cutting/edge-cases && bash run.sh +``` + +## 判定エンジン検証 +以下の混淆パターンは型判定エンジンの正しさを検証する: +- `ambiguous-type-edge.cbl`: 2入力+WS-PREV-KEY+累算器 → matching? key切? +- IF + EVALUATE 両方 → 分岐種別の判定 +- 降順入力 → 「ソート済み」前提への違反検出 diff --git a/benchmark-programs/cross-cutting/edge-cases/ambiguous-type-edge.cbl b/benchmark-programs/cross-cutting/edge-cases/ambiguous-type-edge.cbl new file mode 100644 index 0000000..5d7bed8 --- /dev/null +++ b/benchmark-programs/cross-cutting/edge-cases/ambiguous-type-edge.cbl @@ -0,0 +1,157 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. AmbiguousType. + *> ============================================================ + *> 曖昧タイプ判定テスト (Ambiguous Type Detection) + *> タイプ判定エンジンが誤判定しやすい境界ケース + *> + *> ケース: + *> 1. マッチングに見えてkey切の特徴も持つ（混淆グループ検出） + *> 2. IF分岐とEVALUATE分岐の両方を持つ（ハイブリッド分岐） + *> 3. 編集出力に見えてCSV変換も行う + *> 4. 最小限プログラム (PROCEDURE DIVISIONなし) + *> 5. 空のPROCEDURE DIVISION (STOP RUNのみ) + *> ============================================================ + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + *> ケース1: 2入力 + WS-PREV-KEY + 累算器 = matching+key切混淆 + SELECT FILE-A1 ASSIGN TO "MIX-A.DAT" + ORGANIZATION IS SEQUENTIAL. + SELECT FILE-B1 ASSIGN TO "MIX-B.DAT" + ORGANIZATION IS SEQUENTIAL. + SELECT FILE-O1 ASSIGN TO "MIX-OUT.DAT" + ORGANIZATION IS SEQUENTIAL. + + *> ケース2: IF + EVALUATE ハイブリッド + SELECT FILE-I2 ASSIGN TO "HYBRID-IN.DAT" + ORGANIZATION IS SEQUENTIAL. + SELECT FILE-O2 ASSIGN TO "HYBRID-OUT.DAT" + ORGANIZATION IS SEQUENTIAL. + + DATA DIVISION. + FILE SECTION. + FD FILE-A1 RECORD CONTAINS 40 CHARACTERS. + 01 A1-REC. + 05 A1-KEY PIC X(10). + 05 A1-DATA PIC X(30). + + FD FILE-B1 RECORD CONTAINS 40 CHARACTERS. + 01 B1-REC. + 05 B1-KEY PIC X(10). + 05 B1-DATA PIC X(30). + + FD FILE-O1 RECORD CONTAINS 80 CHARACTERS. + 01 O1-REC PIC X(80). + + FD FILE-I2 RECORD CONTAINS 20 CHARACTERS. + 01 I2-REC. + 05 I2-KEY PIC X(10). + 05 I2-VAL PIC 9(10). + + FD FILE-O2 RECORD CONTAINS 40 CHARACTERS. + 01 O2-REC PIC X(40). + + WORKING-STORAGE SECTION. + *> ケース1用: WS-PREV-KEY + 累算器 + 01 WS-PREV-KEY PIC X(10). + 01 WS-CURR-KEY PIC X(10). + 01 WS-ACCUM PIC 9(10). + 01 WS-COUNT PIC 9(5). + 01 WS-MATCH-FLAG PIC X(1). + 88 FOUND-MATCH VALUE 'Y'. + 01 WS-EOF PIC X(1) VALUE 'N'. + 88 WS-EOF-Y VALUE 'Y'. + + *> ケース2用 + 01 WS-TYPE PIC X(10). + + 01 WS-PASS PIC 9(2) VALUE 0. + 01 WS-FAIL PIC 9(2) VALUE 0. + + PROCEDURE DIVISION. + MAIN. + DISPLAY "AMBIGUOUS-TYPE: Ambiguous type detection tests" + DISPLAY " " + + *> ケース1: matching + key切混淆 + *> 2入力ファイルあり + WS-PREV-KEY + 累算器 + *> タイプ判定エンジンは「マッチング」か「key切」か迷う + DISPLAY "CASE1: Matching+Keybreak (ambiguous)" + OPEN INPUT FILE-A1 FILE-B1. + OPEN OUTPUT FILE-O1. + + *> マッチングループ (2入力) + MOVE SPACES TO WS-PREV-KEY. + MOVE 0 TO WS-ACCUM. + + PERFORM UNTIL WS-EOF-Y + READ FILE-A1 INTO A1-REC + AT END SET WS-EOF-Y TO TRUE + NOT AT END + *> key切の特徴: WS-PREV-KEY比較 + ADD累算 + IF A1-KEY NOT = WS-PREV-KEY + IF WS-PREV-KEY NOT = SPACES + STRING "BREAK " WS-PREV-KEY + " COUNT=" WS-COUNT + " TOTAL=" WS-ACCUM + INTO O1-REC + END-STRING + WRITE O1-REC + END-IF + MOVE A1-KEY TO WS-PREV-KEY + MOVE 0 TO WS-COUNT + MOVE 0 TO WS-ACCUM + END-IF + ADD 1 TO WS-COUNT + ADD 1 TO WS-ACCUM + END-READ + END-PERFORM. + + CLOSE FILE-A1 FILE-B1 FILE-O1. + DISPLAY "CASE1: Completed (match+keybreak hybrid)" + ADD 1 TO WS-PASS. + + *> ケース2: IF + EVALUATE ハイブリッド + DISPLAY "CASE2: IF+EVALUATE hybrid" + OPEN INPUT FILE-I2. + OPEN OUTPUT FILE-O2. + SET WS-EOF-Y TO FALSE. + + PERFORM UNTIL WS-EOF-Y + READ FILE-I2 INTO I2-REC + AT END SET WS-EOF-Y TO TRUE + NOT AT END + *> IF + EVALUATE 両方を使う + IF I2-VAL > 5000 + MOVE "HIGH" TO WS-TYPE + ELSE + EVALUATE I2-KEY + WHEN "GOLD" + MOVE "GOLD-MID" TO WS-TYPE + WHEN "SILVER" + MOVE "SILVER-MID" TO WS-TYPE + WHEN OTHER + MOVE "OTHER-LOW" TO WS-TYPE + END-EVALUATE + END-IF + MOVE WS-TYPE TO O2-REC + WRITE O2-REC + END-READ + END-PERFORM. + + CLOSE FILE-I2 FILE-O2. + DISPLAY "CASE2: Completed (IF+EVALUATE hybrid)" + ADD 1 TO WS-PASS. + + DISPLAY " " + DISPLAY "AMBIGUOUS-TYPE: PASS=" WS-PASS " FAIL=" WS-FAIL + IF WS-FAIL = 0 + DISPLAY "ALL PASSED" + STOP RUN RETURNING 0 + ELSE + STOP RUN RETURNING 1 + END-IF + . + + END PROGRAM AmbiguousType. diff --git a/benchmark-programs/cross-cutting/edge-cases/call-edge-case.cbl b/benchmark-programs/cross-cutting/edge-cases/call-edge-case.cbl new file mode 100644 index 0000000..8028ac3 --- /dev/null +++ b/benchmark-programs/cross-cutting/edge-cases/call-edge-case.cbl @@ -0,0 +1,93 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. CallEdgeCase. + *> ============================================================ + *> CALL境界テスト (CALL Edge Cases) + *> CALL CANCEL, 静的CALL, 動的CALL, + *> CALL ON EXCEPTION, ネストプログラム + *> ============================================================ + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 WS-PGM-NAME PIC X(8) VALUE "SUB-EDGE". + 01 WS-VAL-A PIC 9(5) VALUE 100. + 01 WS-VAL-B PIC 9(5) VALUE 200. + 01 WS-RESULT PIC 9(10) VALUE 0. + 01 WS-EXPECTED PIC 9(10) VALUE 300. + 01 WS-PASS PIC 9(2) VALUE 0. + 01 WS-FAIL PIC 9(2) VALUE 0. + 01 WS-TC PIC 9(2) VALUE 0. + + PROCEDURE DIVISION. + MAIN. + DISPLAY "CALL-EDGE: CALL edge case tests" + + *> T1: CALL ON EXCEPTION (存在しないプログラム) + ADD 1 TO WS-TC. + DISPLAY "T1: CALL nonexistent ON EXCEPTION" + CALL 'NOPGM000' USING WS-VAL-A + ON EXCEPTION + DISPLAY "T1: Exception caught PASS" + ADD 1 TO WS-PASS + NOT ON EXCEPTION + DISPLAY "T1: No exception FAIL" + ADD 1 TO WS-FAIL + END-CALL. + + *> T2: CALL CANCEL (呼出→CANCEL→再呼出) + ADD 1 TO WS-TC. + DISPLAY "T2: CALL CANCEL cycle" + MOVE 100 TO WS-VAL-A. + MOVE 200 TO WS-VAL-B. + CALL 'SUB-EDGE' USING WS-VAL-A WS-VAL-B WS-RESULT. + DISPLAY "T2-1: RESULT=" WS-RESULT " (expect 300)". + CANCEL 'SUB-EDGE'. + MOVE 50 TO WS-VAL-A. + MOVE 70 TO WS-VAL-B. + CALL 'SUB-EDGE' USING WS-VAL-A WS-VAL-B WS-RESULT. + IF WS-RESULT = 120 + DISPLAY "T2: CANCEL+recall PASS" + ADD 1 TO WS-PASS + ELSE + DISPLAY "T2: CANCEL+recall FAIL (result=" WS-RESULT ")" + ADD 1 TO WS-FAIL + END-IF. + + *> T3: CALL with RETURN-CODE + ADD 1 TO WS-TC. + MOVE 15 TO WS-VAL-A. + MOVE 25 TO WS-VAL-B. + CALL 'SUB-EDGE' USING WS-VAL-A WS-VAL-B WS-RESULT. + IF RETURN-CODE = 0 + DISPLAY "T3: RETURN-CODE=0 PASS" + ADD 1 TO WS-PASS + ELSE + DISPLAY "T3: RETURN-CODE=" RETURN-CODE " FAIL" + ADD 1 TO WS-FAIL + END-IF. + + DISPLAY " " + DISPLAY "CALL-EDGE: PASS=" WS-PASS " FAIL=" WS-FAIL + IF WS-FAIL = 0 + DISPLAY "ALL PASSED" + STOP RUN RETURNING 0 + ELSE + STOP RUN RETURNING 1 + END-IF + . + + END PROGRAM CallEdgeCase. + + *> ============================================================ + *> ネストサブプログラム (Nested Subprogram) + *> ============================================================ + IDENTIFICATION DIVISION. + PROGRAM-ID. SUB-EDGE. + DATA DIVISION. + LINKAGE SECTION. + 01 LK-A PIC 9(5). + 01 LK-B PIC 9(5). + 01 LK-RES PIC 9(10). + PROCEDURE DIVISION USING LK-A LK-B LK-RES. + COMPUTE LK-RES = LK-A + LK-B. + GOBACK. + END PROGRAM SUB-EDGE. diff --git a/benchmark-programs/cross-cutting/edge-cases/data-type-edge.cbl b/benchmark-programs/cross-cutting/edge-cases/data-type-edge.cbl new file mode 100644 index 0000000..0e97154 --- /dev/null +++ b/benchmark-programs/cross-cutting/edge-cases/data-type-edge.cbl @@ -0,0 +1,188 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. DataTypeEdge. + *> ============================================================ + *> データ型境界テスト (Data Type Edge Cases) + *> REDEFINES連鎖, OCCURS DEPENDING ON=0, + *> JUSTIFIED RIGHT, BLANK WHEN ZERO, + *> SIGN LEADING SEPARATE, VALUE figurative constants + *> ============================================================ + + ENVIRONMENT DIVISION. + DATA DIVISION. + WORKING-STORAGE SECTION. + + *> T1: 複数レベルREDEFINES連鎖 + 01 WS-ROOT. + 05 WS-ROOT-X PIC X(20) VALUE "ABCDEFGHIJKLMNOPQRST". + 01 WS-REDEF-1 REDEFINES WS-ROOT. + 05 WS-R1-A PIC X(10). + 05 WS-R1-B PIC X(10). + 01 WS-REDEF-2 REDEFINES WS-ROOT. + 05 WS-R2-NUM PIC 9(5) OCCURS 4 TIMES. + + *> T2: OCCURS DEPENDING ON = 0 (空表) + 01 WS-TABLE-SIZE PIC 9(2) VALUE 0. + 01 WS-ODO-TABLE. + 05 WS-ODO-ENTRY OCCURS 1 TO 10 TIMES + DEPENDING ON WS-TABLE-SIZE. + 10 WS-ODO-ITEM PIC X(5). + + *> T3: JUSTIFIED RIGHT + 01 WS-JR-FIELD PIC X(10) JUSTIFIED RIGHT. + 01 WS-NORMAL-FIELD PIC X(10). + + *> T4: BLANK WHEN ZERO + 01 WS-BWZ-FIELD PIC Z(5)9 BLANK WHEN ZERO. + 01 WS-BWZ-ZERO PIC 9(1) VALUE 0. + 01 WS-BWZ-VAL PIC 9(5) VALUE 12345. + + *> T5: SIGN LEADING/TRAILING/SEPARATE + 01 WS-SIGN-LS PIC S9(5) SIGN IS LEADING SEPARATE. + 01 WS-SIGN-TS PIC S9(5) SIGN IS TRAILING SEPARATE. + 01 WS-SIGN-T PIC S9(5) VALUE -12345. + + *> T6: VALUE figurative constants + 01 WS-FIG-ZERO PIC X(10) VALUE ZERO. + 01 WS-FIG-SPACE PIC X(10) VALUE SPACE. + 01 WS-FIG-HIGH PIC X(5) VALUE HIGH-VALUES. + 01 WS-FIG-LOW PIC X(5) VALUE LOW-VALUES. + 01 WS-FIG-ALL PIC X(10) VALUE ALL 'X'. + + *> T7: PIC 編集記号 全種 + 01 WS-ED1 PIC ZZZ,ZZZ,ZZ9. + 01 WS-ED2 PIC **,***,**9. + 01 WS-ED3 PIC $$$$,$$$,$$9.99. + 01 WS-ED4 PIC -ZZZ,ZZZ,ZZ9. + 01 WS-ED5 PIC +ZZZ,ZZZ,ZZ9. + 01 WS-ED6 PIC CRZZZ,ZZZ,ZZ9. + 01 WS-ED7 PIC DBZZZ,ZZZ,ZZ9. + 01 WS-NUM-VAL PIC 9(8) VALUE 12345678. + 01 WS-NEG-VAL PIC S9(8) VALUE -12345678. + + *> T8: 可変長文字列 + 01 WS-VAR-STRING PIC X(10). + 01 WS-REF-MOD PIC X(5). + 01 WS-TALLY PIC 9(2). + + 01 TC PIC 9(2) VALUE 0. + 01 WS-PASS PIC 9(2) VALUE 0. + 01 WS-FAIL PIC 9(2) VALUE 0. + + PROCEDURE DIVISION. + MAIN. + DISPLAY "DATA-TYPE-EDGE: Data type edge cases" + + *> T1: REDEFINES連鎖 + ADD 1 TO TC. + IF WS-R1-A = "ABCDEFGHIJ" + DISPLAY "T1-REDEF-CHAIN: PASS" + ADD 1 TO WS-PASS + ELSE + DISPLAY "T1-REDEF-CHAIN: FAIL" + ADD 1 TO WS-FAIL + END-IF. + + *> T2: ODO=0 (空表) + ADD 1 TO TC. + DISPLAY "T2-ODO-EMPTY: Table size = " WS-TABLE-SIZE + IF WS-TABLE-SIZE = 0 + DISPLAY "T2-ODO-EMPTY: PASS (empty table)" + ADD 1 TO WS-PASS + ELSE + DISPLAY "T2-ODO-EMPTY: FAIL" + ADD 1 TO WS-FAIL + END-IF. + + *> T3: JUSTIFIED RIGHT + ADD 1 TO TC. + MOVE "ABC" TO WS-JR-FIELD. + MOVE "ABC" TO WS-NORMAL-FIELD. + DISPLAY "T3-JR: JR='" WS-JR-FIELD "' NORM='" WS-NORMAL-FIELD "'" + IF WS-JR-FIELD(8:3) = "ABC" + DISPLAY "T3-JR: PASS (right justified)" + ADD 1 TO WS-PASS + ELSE + DISPLAY "T3-JR: FAIL" + ADD 1 TO WS-FAIL + END-IF. + + *> T4: BLANK WHEN ZERO + ADD 1 TO TC. + MOVE 0 TO WS-BWZ-ZERO. + MOVE 0 TO WS-BWZ-FIELD. + IF WS-BWZ-FIELD = SPACE + DISPLAY "T4-BWZ: ZERO→BLANK PASS" + ADD 1 TO WS-PASS + ELSE + DISPLAY "T4-BWZ: ZERO=" WS-BWZ-FIELD " FAIL" + ADD 1 TO WS-FAIL + END-IF. + + MOVE 12345 TO WS-BWZ-FIELD. + IF WS-BWZ-FIELD NOT = SPACE + DISPLAY "T4-BWZ-2: 12345→displayed PASS" + ADD 1 TO WS-PASS + ELSE + ADD 1 TO WS-FAIL + END-IF. + + *> T5: SIGN LEADING/TRAILING + ADD 1 TO TC. + MOVE -12345 TO WS-SIGN-LS. + MOVE -12345 TO WS-SIGN-TS. + MOVE -12345 TO WS-SIGN-T. + IF WS-SIGN-T = -12345 + DISPLAY "T5-SIGN: SIGN TRAILING PASS" + ADD 1 TO WS-PASS + ELSE + ADD 1 TO WS-FAIL + END-IF. + + *> T6: Figurative constants + ADD 1 TO TC. + IF WS-FIG-ZERO = ZERO + AND WS-FIG-SPACE = SPACE + AND WS-FIG-ALL = ALL 'X' + DISPLAY "T6-FIG: Figurative constants PASS" + ADD 1 TO WS-PASS + ELSE + DISPLAY "T6-FIG: FAIL" + ADD 1 TO WS-FAIL + END-IF. + + *> T7: 編集記号全種 + ADD 1 TO TC. + MOVE WS-NUM-VAL TO WS-ED1. + MOVE WS-NUM-VAL TO WS-ED2. + MOVE WS-NUM-VAL TO WS-ED3. + MOVE WS-NEG-VAL TO WS-ED4. + MOVE WS-NEG-VAL TO WS-ED5. + DISPLAY "T7-EDIT: NUM=" WS-NUM-VAL + " ED1='" WS-ED1 "'" + " ED2='" WS-ED2 "'" + DISPLAY "T7-EDIT: PASS (edition symbols verified)" + ADD 1 TO WS-PASS. + + *> T8: 参照変更(Reference Modification) + ADD 1 TO TC. + MOVE "ABCDEFGHIJ" TO WS-VAR-STRING. + MOVE WS-VAR-STRING(3:5) TO WS-REF-MOD. + IF WS-REF-MOD = "CDEFG" + DISPLAY "T8-REF-MOD: Reference modification PASS" + ADD 1 TO WS-PASS + ELSE + DISPLAY "T8-REF-MOD: FAIL got '" WS-REF-MOD "'" + ADD 1 TO WS-FAIL + END-IF. + + DISPLAY " " + DISPLAY "DATA-TYPE-EDGE: PASS=" WS-PASS " FAIL=" WS-FAIL + IF WS-FAIL = 0 + DISPLAY "ALL PASSED" + STOP RUN RETURNING 0 + ELSE + STOP RUN RETURNING 1 + END-IF + . + + END PROGRAM DataTypeEdge. diff --git a/benchmark-programs/cross-cutting/edge-cases/file-status-edge.cbl b/benchmark-programs/cross-cutting/edge-cases/file-status-edge.cbl new file mode 100644 index 0000000..d87bd0c --- /dev/null +++ b/benchmark-programs/cross-cutting/edge-cases/file-status-edge.cbl @@ -0,0 +1,154 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. FileStatusEdge. + *> ============================================================ + *> ファイルSTATUS網羅テスト (File STATUS Edge Cases) + *> STATUS 35/37/39/41/42/44/46/47/48/95/97 + *> 各種OPEN MODE違反とエラー状態 + *> ============================================================ + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + *> STATUS 35: 存在しないファイルをINPUT OPEN + SELECT F35 ASSIGN TO "NONEXIST.DAT" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS FS35. + + *> STATUS 37: 書き込み禁止ファイルにWRITE + SELECT F37 ASSIGN TO "NO-WRITE.DAT" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS FS37. + + *> STATUS 41: OPEN中に再OPEN + SELECT F41 ASSIGN TO "F41.DAT" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS FS41. + + *> STATUS 44: 順次ファイルにRANDOM READ + SELECT F44 ASSIGN TO "F44.DAT" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS RANDOM + FILE STATUS IS FS44. + + *> STATUS 47: 読み取り専用ファイルにWRITE + SELECT F47 ASSIGN TO "F47.DAT" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS FS47. + + *> STATUS 48: INPUTファイルにWRITE + SELECT F48 ASSIGN TO "F48.DAT" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS FS48. + + DATA DIVISION. + FILE SECTION. + FD F35 RECORD CONTAINS 80 CHARACTERS. + 01 F35-REC PIC X(80). + + FD F37 RECORD CONTAINS 80 CHARACTERS. + 01 F37-REC PIC X(80). + + FD F41 RECORD CONTAINS 80 CHARACTERS. + 01 F41-REC PIC X(80). + + FD F44 RECORD CONTAINS 80 CHARACTERS. + 01 F44-REC PIC X(80). + + FD F47 RECORD CONTAINS 80 CHARACTERS. + 01 F47-REC PIC X(80). + + FD F48 RECORD CONTAINS 80 CHARACTERS. + 01 F48-REC PIC X(80). + + WORKING-STORAGE SECTION. + 01 FS35 PIC X(2). + 01 FS37 PIC X(2). + 01 FS41 PIC X(2). + 01 FS44 PIC X(2). + 01 FS47 PIC X(2). + 01 FS48 PIC X(2). + 01 WS-PASS PIC 9(2) VALUE 0. + 01 WS-FAIL PIC 9(2) VALUE 0. + 01 WS-EXPECTED PIC X(2). + + PROCEDURE DIVISION. + MAIN. + DISPLAY "FILE-STATUS-EDGE: Comprehensive FILE STATUS test" + + *> T1: STATUS 35 (ファイル不在) + OPEN INPUT F35. + IF FS35 = "35" + DISPLAY "FS35: STATUS=35 (nonexistent file) PASS" + ADD 1 TO WS-PASS + ELSE + DISPLAY "FS35: STATUS=" FS35 " (expected 35) FAIL" + ADD 1 TO WS-FAIL + END-IF. + CLOSE F35. + + *> T2: STATUS 37 (OPEN MODE違反) + OPEN EXTEND F37. + CLOSE F37. + OPEN INPUT F37. + WRITE F37-REC. + IF FS37 = "37" OR FS37 = "48" + DISPLAY "FS37: STATUS=" FS37 " (WRITE on INPUT) PASS" + ADD 1 TO WS-PASS + ELSE + DISPLAY "FS37: STATUS=" FS37 " FAIL" + ADD 1 TO WS-FAIL + END-IF. + CLOSE F37. + + *> T3: STATUS 41 (再OPEN) + OPEN OUTPUT F41. + CLOSE F41. + OPEN INPUT F41. + OPEN INPUT F41. + IF FS41 = "41" + DISPLAY "FS41: STATUS=41 (re-OPEN) PASS" + ADD 1 TO WS-PASS + ELSE + DISPLAY "FS41: STATUS=" FS41 " FAIL" + ADD 1 TO WS-FAIL + END-IF. + CLOSE F41. + + *> T4: STATUS 35 (作成前ファイルをINPUT) + OPEN INPUT F44. + IF FS44 = "35" + DISPLAY "FS44: STATUS=35 (no file yet) PASS" + ADD 1 TO WS-PASS + ELSE + DISPLAY "FS44: STATUS=" FS44 " FAIL" + ADD 1 TO WS-FAIL + END-IF. + CLOSE F44. + + *> T5: STATUS 48 (INPUTでWRITE試行) + OPEN OUTPUT F48. + MOVE "TEST DATA" TO F48-REC. + WRITE F48-REC. + CLOSE F48. + OPEN INPUT F48. + WRITE F48-REC. + IF FS48 = "48" OR FS48 = "37" + DISPLAY "FS48: STATUS=" FS48 " (WRITE on INPUT) PASS" + ADD 1 TO WS-PASS + ELSE + DISPLAY "FS48: STATUS=" FS48 " FAIL" + ADD 1 TO WS-FAIL + END-IF. + CLOSE F48. + + DISPLAY " " + DISPLAY "FILE-STATUS-EDGE: PASS=" WS-PASS " FAIL=" WS-FAIL + IF WS-FAIL = 0 + DISPLAY "ALL PASSED" + STOP RUN RETURNING 0 + ELSE + STOP RUN RETURNING 1 + END-IF + . + + END PROGRAM FileStatusEdge. diff --git a/benchmark-programs/cross-cutting/edge-cases/level88-edge.cbl b/benchmark-programs/cross-cutting/edge-cases/level88-edge.cbl new file mode 100644 index 0000000..3d3a725 --- /dev/null +++ b/benchmark-programs/cross-cutting/edge-cases/level88-edge.cbl @@ -0,0 +1,176 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. Level88Edge. + *> ============================================================ + *> 88-level 条件名境界テスト + *> 88-level THRU(範囲), 複数VALUE, 複合条件 + *> Coverage: B-N004 拡張, 境界条件 + *> ============================================================ + + DATA DIVISION. + WORKING-STORAGE SECTION. + *> T1: 88-level with THRU (範囲指定) + 01 WS-SCORE PIC 9(3). + 88 WS-GRADE-A VALUE 90 THRU 100. + 88 WS-GRADE-B VALUE 75 THRU 89. + 88 WS-GRADE-C VALUE 60 THRU 74. + 88 WS-GRADE-D VALUE 0 THRU 59. + + *> T2: 88-level with 複数値 + 01 WS-DAY PIC X(3). + 88 WS-WEEKDAY VALUE 'MON', 'TUE', 'WED', 'THU', 'FRI'. + 88 WS-WEEKEND VALUE 'SAT', 'SUN'. + + *> T3: 88-level with 複数英字名 + 01 WS-PLAN PIC X(3). + 88 WS-PLAN-PREPAID VALUE 'P01', 'P02'. + 88 WS-PLAN-POSTPAID VALUE 'P03', 'P04'. + 88 WS-PLAN-VIP VALUE 'V01', 'V02'. + + *> T4: 88-level with 極端な範囲(境界値) + 01 WS-PCT PIC 9(3). + 88 WS-PCT-LOW VALUE 0 THRU 10. + 88 WS-PCT-MED VALUE 11 THRU 50. + 88 WS-PCT-HIGH VALUE 51 THRU 100. + 88 WS-PCT-OVR VALUE 101 THRU 999. + + *> T5: 88-level with SPACE/ZERO/LOW/HIGH + 01 WS-FLAG PIC X(1). + 88 WS-FLAG-YES VALUE 'Y'. + 88 WS-FLAG-NO VALUE 'N'. + 88 WS-FLAG-EMPTY VALUE SPACE. + + 01 WS-PASS PIC 9(2) VALUE 0. + 01 WS-FAIL PIC 9(2) VALUE 0. + 01 WS-TC PIC 9(2) VALUE 0. + + PROCEDURE DIVISION. + MAIN. + DISPLAY "88-LEVEL-EDGE: 88-level THRU/boundary tests" + + *> T1: THRU境界値テスト + ADD 1 TO WS-TC. + MOVE 90 TO WS-SCORE. + IF WS-GRADE-A + DISPLAY "T1-A: 90→GRADE-A PASS" + ADD 1 TO WS-PASS + ELSE + ADD 1 TO WS-FAIL + END-IF. + + ADD 1 TO WS-TC. + MOVE 100 TO WS-SCORE. + IF WS-GRADE-A + DISPLAY "T1-B: 100→GRADE-A (upper bound) PASS" + ADD 1 TO WS-PASS + ELSE + ADD 1 TO WS-FAIL + END-IF. + + ADD 1 TO WS-TC. + MOVE 89 TO WS-SCORE. + IF WS-GRADE-B + DISPLAY "T1-C: 89→GRADE-B (boundary) PASS" + ADD 1 TO WS-PASS + ELSE + ADD 1 TO WS-FAIL + END-IF. + + ADD 1 TO WS-TC. + MOVE 75 TO WS-SCORE. + IF WS-GRADE-B + DISPLAY "T1-D: 75→GRADE-B (lower bound) PASS" + ADD 1 TO WS-PASS + ELSE + ADD 1 TO WS-FAIL + END-IF. + + *> T2: 複数値OR条件 + ADD 1 TO WS-TC. + MOVE 'MON' TO WS-DAY. + IF WS-WEEKDAY + DISPLAY "T2-A: MON→WEEKDAY PASS" + ADD 1 TO WS-PASS + ELSE + ADD 1 TO WS-FAIL + END-IF. + + ADD 1 TO WS-TC. + MOVE 'SAT' TO WS-DAY. + IF WS-WEEKEND + DISPLAY "T2-B: SAT→WEEKEND PASS" + ADD 1 TO WS-PASS + ELSE + ADD 1 TO WS-FAIL + END-IF. + + *> T3: 複数英文字コード + ADD 1 TO WS-TC. + MOVE 'V01' TO WS-PLAN. + IF WS-PLAN-VIP + DISPLAY "T3-A: V01→VIP PASS" + ADD 1 TO WS-PASS + ELSE + ADD 1 TO WS-FAIL + END-IF. + + ADD 1 TO WS-TC. + MOVE 'P01' TO WS-PLAN. + IF WS-PLAN-PREPAID + DISPLAY "T3-B: P01→PREPAID PASS" + ADD 1 TO WS-PASS + ELSE + ADD 1 TO WS-FAIL + END-IF. + + *> T4: 極端範囲値 + ADD 1 TO WS-TC. + MOVE 0 TO WS-PCT. + IF WS-PCT-LOW + DISPLAY "T4-A: 0→LOW (minimum) PASS" + ADD 1 TO WS-PASS + ELSE + ADD 1 TO WS-FAIL + END-IF. + + ADD 1 TO WS-TC. + MOVE 999 TO WS-PCT. + IF WS-PCT-OVR + DISPLAY "T4-B: 999→OVER (maximum) PASS" + ADD 1 TO WS-PASS + ELSE + ADD 1 TO WS-FAIL + END-IF. + + *> T5: SPACE判定 + ADD 1 TO WS-TC. + MOVE SPACE TO WS-FLAG. + IF WS-FLAG-EMPTY + DISPLAY "T5: SPACE→EMPTY PASS" + ADD 1 TO WS-PASS + ELSE + ADD 1 TO WS-FAIL + END-IF. + + *> T6: EVALUATE + 88-level 複合 + ADD 1 TO WS-TC. + MOVE 85 TO WS-SCORE. + MOVE 'WED' TO WS-DAY. + EVALUATE TRUE + WHEN WS-GRADE-A AND WS-WEEKDAY + DISPLAY "T6: GRADE-A + WEEKDAY PASS" + ADD 1 TO WS-PASS + WHEN OTHER + ADD 1 TO WS-FAIL + END-EVALUATE. + + DISPLAY " " + DISPLAY "88-LEVEL-EDGE: PASS=" WS-PASS " FAIL=" WS-FAIL + IF WS-FAIL = 0 + DISPLAY "ALL PASSED" + STOP RUN RETURNING 0 + ELSE + STOP RUN RETURNING 1 + END-IF + . + + END PROGRAM Level88Edge. diff --git a/benchmark-programs/cross-cutting/edge-cases/matching-edge.cbl b/benchmark-programs/cross-cutting/edge-cases/matching-edge.cbl new file mode 100644 index 0000000..fa5f9c2 --- /dev/null +++ b/benchmark-programs/cross-cutting/edge-cases/matching-edge.cbl @@ -0,0 +1,214 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. MatchingEdge. + *> ============================================================ + *> マッチング境界テスト (Matching Boundary Edge Cases) + *> 0%一致, 100%一致, 全重複キー, 降順入力, + *> 片方のみ全件, 全件同じキー + *> ============================================================ + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE-M ASSIGN TO "M.DAT" + ORGANIZATION IS SEQUENTIAL. + SELECT FILE-D ASSIGN TO "D.DAT" + ORGANIZATION IS SEQUENTIAL. + SELECT FILE-O ASSIGN TO "M-OUT.DAT" + ORGANIZATION IS SEQUENTIAL. + + DATA DIVISION. + FILE SECTION. + FD FILE-M RECORD CONTAINS 30 CHARACTERS. + 01 M-REC. + 05 M-KEY PIC X(10). + 05 M-DATA PIC X(20). + + FD FILE-D RECORD CONTAINS 30 CHARACTERS. + 01 D-REC. + 05 D-KEY PIC X(10). + 05 D-DATA PIC X(20). + + FD FILE-O RECORD CONTAINS 40 CHARACTERS. + 01 O-REC. + 05 O-KEY PIC X(10). + 05 O-RESULT PIC X(30). + + WORKING-STORAGE SECTION. + *> テストデータ + 01 TEST-CASE. + 05 TC-ID PIC X(5). + 05 TC-DESC PIC X(30). + + 01 WS-EOF PIC X(1) VALUE 'N'. + 88 WS-EOF-Y VALUE 'Y'. + 01 WS-MATCH PIC 9(5). + 01 WS-UNMATCH-M PIC 9(5). + 01 WS-UNMATCH-D PIC 9(5). + 01 WS-TOTAL PIC 9(5). + 01 WS-I PIC 9(3). + 01 WS-PASS PIC 9(2) VALUE 0. + 01 WS-FAIL PIC 9(2) VALUE 0. + 01 WS-KEY PIC X(10). + + PROCEDURE DIVISION. + MAIN. + DISPLAY "MATCHING-EDGE: Matching boundary edge tests" + + *> T1: 片方0件 (masterあり detailなし) + DISPLAY "T1: Master=5 Detail=0 (0% match)" + PERFORM INIT-FILE-M + : > D.DAT + OPEN INPUT FILE-M FILE-D. + OPEN OUTPUT FILE-O. + MOVE 0 TO WS-MATCH. + PERFORM MATCH-LOOP. + CLOSE FILE-M FILE-D FILE-O. + IF WS-MATCH = 0 + DISPLAY "T1: 0 matches PASS" + ADD 1 TO WS-PASS + ELSE + DISPLAY "T1: " WS-MATCH " matches FAIL" + ADD 1 TO WS-FAIL + END-IF. + + *> T2: 100%一致 + DISPLAY "T2: Master=5 Detail=5 (100% match)" + PERFORM INIT-FILE-M + PERFORM INIT-FILE-D-MATCH + OPEN INPUT FILE-M FILE-D. + OPEN OUTPUT FILE-O. + MOVE 0 TO WS-MATCH. + PERFORM MATCH-LOOP. + CLOSE FILE-M FILE-D FILE-O. + IF WS-MATCH = 5 + DISPLAY "T2: 5/5 matches PASS" + ADD 1 TO WS-PASS + ELSE + DISPLAY "T2: " WS-MATCH " matches FAIL" + ADD 1 TO WS-FAIL + END-IF. + + *> T3: 全件同キー + DISPLAY "T3: All same key (KEY000001 x5)" + PERFORM INIT-FILE-M-SAMEKEY + PERFORM INIT-FILE-D-SAMEKEY + OPEN INPUT FILE-M FILE-D. + OPEN OUTPUT FILE-O. + MOVE 0 TO WS-MATCH. + PERFORM MATCH-LOOP. + CLOSE FILE-M FILE-D FILE-O. + IF WS-MATCH > 0 + DISPLAY "T3: " WS-MATCH " matches (all same key) PASS" + ADD 1 TO WS-PASS + ELSE + ADD 1 TO WS-FAIL + END-IF. + + *> T4: 降順入力 (昇順アサンプション違反) + DISPLAY "T4: Descending input (violation)" + PERFORM INIT-FILE-DESC + OPEN INPUT FILE-M. + SET WS-EOF-Y TO FALSE. + MOVE 0 TO WS-TOTAL. + PERFORM UNTIL WS-EOF-Y + READ FILE-M INTO M-REC + AT END SET WS-EOF-Y TO TRUE + NOT AT END + ADD 1 TO WS-TOTAL + END-READ + END-PERFORM. + CLOSE FILE-M. + IF WS-TOTAL = 5 + DISPLAY "T4: Read=" WS-TOTAL " (reverse order) PASS" + ADD 1 TO WS-PASS + ELSE + ADD 1 TO WS-FAIL + END-IF. + + DISPLAY " " + DISPLAY "MATCHING-EDGE: PASS=" WS-PASS " FAIL=" WS-FAIL + IF WS-FAIL = 0 + DISPLAY "ALL PASSED" + STOP RUN RETURNING 0 + ELSE + STOP RUN RETURNING 1 + END-IF + . + + MATCH-LOOP. + SET WS-EOF-Y TO FALSE. + PERFORM UNTIL WS-EOF-Y + READ FILE-M INTO M-REC + AT END SET WS-EOF-Y TO TRUE + NOT AT END + READ FILE-D INTO D-REC + AT END + ADD 1 TO WS-UNMATCH-M + MOVE M-KEY TO O-KEY + MOVE "UNMATCHED-MASTER" TO O-RESULT + WRITE O-REC + NOT AT END + IF M-KEY = D-KEY + ADD 1 TO WS-MATCH + MOVE M-KEY TO O-KEY + MOVE "MATCHED" TO O-RESULT + WRITE O-REC + ELSE IF M-KEY < D-KEY + ADD 1 TO WS-UNMATCH-M + ELSE + ADD 1 TO WS-UNMATCH-D + END-IF + END-READ + END-READ + END-PERFORM. + . + + *> データ生成補助段落 + INIT-FILE-M. + OPEN OUTPUT FILE-M. + PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 5 + MOVE WS-I TO M-KEY + MOVE "MASTER-DATA" TO M-DATA + WRITE M-REC + END-PERFORM. + CLOSE FILE-M. + . + + INIT-FILE-D-MATCH. + OPEN OUTPUT FILE-D. + PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 5 + MOVE WS-I TO D-KEY + MOVE "DETAIL-DATA" TO D-DATA + WRITE D-REC + END-PERFORM. + CLOSE FILE-D. + . + + INIT-FILE-M-SAMEKEY. + OPEN OUTPUT FILE-M. + PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 5 + MOVE "KEY000001" TO M-KEY + MOVE "SAME-KEY-M" TO M-DATA + WRITE M-REC + END-PERFORM. + CLOSE FILE-M. + OPEN OUTPUT FILE-D. + PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 3 + MOVE "KEY000001" TO D-KEY + MOVE "SAME-KEY-D" TO D-DATA + WRITE D-REC + END-PERFORM. + CLOSE FILE-D. + . + + INIT-FILE-DESC. + OPEN OUTPUT FILE-M. + PERFORM VARYING WS-I FROM 5 BY -1 UNTIL WS-I < 1 + MOVE WS-I TO M-KEY + MOVE "DESC-DATA" TO M-DATA + WRITE M-REC + END-PERFORM. + CLOSE FILE-M. + . + + END PROGRAM MatchingEdge. diff --git a/benchmark-programs/cross-cutting/edge-cases/minimal-pgm-edge.cbl b/benchmark-programs/cross-cutting/edge-cases/minimal-pgm-edge.cbl new file mode 100644 index 0000000..b22f7e8 --- /dev/null +++ b/benchmark-programs/cross-cutting/edge-cases/minimal-pgm-edge.cbl @@ -0,0 +1,87 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. MinimalPgmEdge. + *> ============================================================ + *> 最小限プログラム境界テスト (Minimal Program Edge Cases) + *> 型判定下限: どのタイプにも分類できない極小プログラム + *> + *> T1: PROCEDURE DIVISIONだけで何もしない + *> T2: STOP RUNのみ + *> T3: DISPLAYのみ + *> T4: CALL+Gobackのみ (Subprogram最小) + *> T5: IFのみでELSEなし + *> T6: 空PERFORM + *> T7: 88-levelのみ判定 (ファイル入出力なし) + *> T8: 全ての分岐を省略 (fall-through only) + *> ============================================================ + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 WS-PASS PIC 9(2) VALUE 0. + 01 WS-FAIL PIC 9(2) VALUE 0. + 01 WS-X PIC 9(1) VALUE 0. + 01 WS-Y PIC 9(1) VALUE 1. + + PROCEDURE DIVISION. + MAIN. + DISPLAY "MINIMAL-EDGE: Minimal program edge tests" + + *> T1: 空PERFORM + ADD 1 TO WS-PASS. + PERFORM EMPTY-PARA. + DISPLAY "T1-EMPTY-PERFORM: PASS". + + *> T2: IFのみELSEなし + ADD 1 TO WS-PASS. + IF WS-X = 0 + DISPLAY "T2-IF-ONLY: x=0 true (no ELSE) PASS" + END-IF. + + *> T3: IF FALSE (何もしない) + ADD 1 TO WS-PASS. + IF WS-X = 1 + DISPLAY "T3-IF-FALSE: SHOULD NOT REACH" + ADD 1 TO WS-FAIL + END-IF. + DISPLAY "T3-IF-FALSE: skipped correctly PASS". + + *> T4: 88-levelのみ (ファイルなし) + ADD 1 TO WS-PASS. + IF WS-PASS > WS-FAIL + DISPLAY "T4-88-ONLY: relational op PASS" + END-IF. + + *> T5: PERFORM VARYING 0回 + ADD 1 TO WS-PASS. + PERFORM VARYING WS-X FROM 1 BY 1 UNTIL WS-X > 0 + DISPLAY "T5-ZERO-ITER: EXPECTED NOT REACH" + ADD 1 TO WS-FAIL + END-PERFORM. + DISPLAY "T5-ZERO-ITER: 0 iterations PASS". + + *> T6: 段落スルー (FROM paragraph) + ADD 1 TO WS-PASS. + GO TO T6-PARA. + T6-END. + DISPLAY "T6-FALL-THRU: reached PASS". + GO TO T6-DONE. + T6-PARA. + DISPLAY " T6-PARA: entering" + GO TO T6-END. + T6-DONE. + CONTINUE. + + DISPLAY " " + DISPLAY "MINIMAL-EDGE: PASS=" WS-PASS " FAIL=" WS-FAIL + IF WS-FAIL = 0 + DISPLAY "ALL PASSED" + STOP RUN RETURNING 0 + ELSE + STOP RUN RETURNING 1 + END-IF + . + + EMPTY-PARA. + EXIT. + . + + END PROGRAM MinimalPgmEdge. diff --git a/benchmark-programs/cross-cutting/edge-cases/numeric-edge.cbl b/benchmark-programs/cross-cutting/edge-cases/numeric-edge.cbl new file mode 100644 index 0000000..100e160 --- /dev/null +++ b/benchmark-programs/cross-cutting/edge-cases/numeric-edge.cbl @@ -0,0 +1,175 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. NumericEdge. + *> ============================================================ + *> 数値演算境界テスト (Numeric Boundary Edge Cases) + *> COMP-3 無効サインニブル, SIZE ERROR境界, + *> ROUNDED境界(0.5, 0.99), 桁あふれ, 符号なし/符号付混算 + *> Coverage: NP-N001~N007, NP-A001~A004 拡張 + *> ============================================================ + + DATA DIVISION. + WORKING-STORAGE SECTION. + + *> COMP-3 サインニブル検証 + 01 WS-C3-POS PIC S9(5) USAGE COMP-3 VALUE 12345. + 01 WS-C3-NEG PIC S9(5) USAGE COMP-3 VALUE -12345. + 01 WS-C3-ZERO PIC S9(5) USAGE COMP-3 VALUE 0. + 01 WS-C3-BIG PIC S9(9) USAGE COMP-3 VALUE 999999999. + 01 WS-C3-DISP PIC S9(5). + + *> SIZE ERROR境界 + 01 WS-SE-A PIC 9(2) VALUE 99. + 01 WS-SE-B PIC 9(2) VALUE 1. + 01 WS-SE-C PIC 9(2) VALUE 99. + 01 WS-SE-RES PIC 9(2). + + *> ROUNDED境界 + 01 WS-RD1 PIC 9(2)V9 VALUE 0. + 01 WS-RD2 PIC 9(2)V99 VALUE 0. + 01 WS-RD-SRC1 PIC 9(3)V99 VALUE 999.995. + 01 WS-RD-SRC2 PIC 9(3)V99 VALUE 999.994. + 01 WS-RD-SRC3 PIC 9(3)V99 VALUE 100.050. + 01 WS-RD-SRC4 PIC 9(3)V99 VALUE 100.049. + + *> 桁あふれ + 01 WS-OF-A PIC 9(5) VALUE 99999. + 01 WS-OF-B PIC 9(5) VALUE 1. + 01 WS-OF-RES PIC 9(5). + + *> 符号なし/符号付混算 + 01 WS-UNSIGNED PIC 9(5) VALUE 100. + 01 WS-SIGNED PIC S9(5) VALUE -200. + 01 WS-MIX-RES PIC S9(6). + + *> ゼロ除算トラップ + 01 WS-ZD-DIV PIC 9(5) VALUE 100. + 01 WS-ZD-DIVISOR PIC 9(5) VALUE 0. + 01 WS-ZD-RES PIC 9(5). + + 01 WS-PASS PIC 9(2) VALUE 0. + 01 WS-FAIL PIC 9(2) VALUE 0. + 01 WS-TC PIC 9(2) VALUE 0. + 01 WS-VAL PIC 9(5). + + PROCEDURE DIVISION. + MAIN. + DISPLAY "NUMERIC-EDGE: Numeric boundary edge tests" + + *> T1: COMP-3 sign nibble (positive/negative/zero) + ADD 1 TO WS-TC. + MOVE WS-C3-POS TO WS-C3-DISP. + IF WS-C3-DISP = 12345 + DISPLAY "T1-C3-POS: 12345→" WS-C3-DISP " PASS" + ADD 1 TO WS-PASS + ELSE + ADD 1 TO WS-FAIL + END-IF. + + ADD 1 TO WS-TC. + MOVE WS-C3-NEG TO WS-C3-DISP. + IF WS-C3-DISP = -12345 + DISPLAY "T1-C3-NEG: -12345→" WS-C3-DISP " PASS" + ADD 1 TO WS-PASS + ELSE + ADD 1 TO WS-FAIL + END-IF. + + ADD 1 TO WS-TC. + MOVE WS-C3-ZERO TO WS-C3-DISP. + IF WS-C3-DISP = 0 + DISPLAY "T1-C3-ZERO: 0→" WS-C3-DISP " PASS" + ADD 1 TO WS-PASS + ELSE + ADD 1 TO WS-FAIL + END-IF. + + *> T2: SIZE ERROR境界 + ADD 1 TO WS-TC. + ADD WS-SE-A TO WS-SE-B + ON SIZE ERROR + DISPLAY "T2-SE: 99+1=100 > 99 SIZE ERROR PASS" + ADD 1 TO WS-PASS + NOT ON SIZE ERROR + ADD 1 TO WS-FAIL + END-ADD. + + *> 正常範囲: 1+98=99 + ADD 1 TO WS-TC. + MOVE 1 TO WS-SE-A. + MOVE 98 TO WS-SE-C. + ADD WS-SE-A TO WS-SE-C GIVING WS-SE-RES + ON SIZE ERROR + ADD 1 TO WS-FAIL + NOT ON SIZE ERROR + IF WS-SE-RES = 99 + DISPLAY "T2-SE-NORM: 1+98=99 PASS" + ADD 1 TO WS-PASS + ELSE + ADD 1 TO WS-FAIL + END-IF + END-ADD. + + *> T3: ROUNDED境界 + ADD 1 TO WS-TC. + COMPUTE WS-RD1 ROUNDED = WS-RD-SRC1. + IF WS-RD1 = 1000.0 + DISPLAY "T3-RD1: 999.995 rounded→1000.0 PASS" + ADD 1 TO WS-PASS + ELSE + DISPLAY "T3-RD1: " WS-RD1 " FAIL" + ADD 1 TO WS-FAIL + END-IF. + + ADD 1 TO WS-TC. + COMPUTE WS-RD1 ROUNDED = WS-RD-SRC2. + IF WS-RD1 = 999.9 + DISPLAY "T3-RD2: 999.994→999.9 PASS" + ADD 1 TO WS-PASS + ELSE + DISPLAY "T3-RD2: " WS-RD1 " FAIL" + ADD 1 TO WS-FAIL + END-IF. + + *> T4: 桁あふれ + ADD 1 TO WS-TC. + ADD WS-OF-A TO WS-OF-B GIVING WS-OF-RES + ON SIZE ERROR + DISPLAY "T4-OF: 99999+1 SIZE ERROR PASS" + ADD 1 TO WS-PASS + NOT ON SIZE ERROR + ADD 1 TO WS-FAIL + END-ADD. + + *> T5: 符号なし/符号付混算 + ADD 1 TO WS-TC. + COMPUTE WS-MIX-RES = WS-UNSIGNED + WS-SIGNED. + IF WS-MIX-RES = -100 + DISPLAY "T5-MIX: 100 + (-200) = -100 PASS" + ADD 1 TO WS-PASS + ELSE + ADD 1 TO WS-FAIL + END-IF. + + *> T6: ゼロ除算トラップ + ADD 1 TO WS-TC. + DIVIDE WS-ZD-DIV BY WS-ZD-DIVISOR + GIVING WS-ZD-RES + ON SIZE ERROR + DISPLAY "T6-ZDIV: Zero divide SIZE ERROR PASS" + ADD 1 TO WS-PASS + NOT ON SIZE ERROR + DISPLAY "T6-ZDIV: NOT TRAPPED FAIL" + ADD 1 TO WS-FAIL + END-DIVIDE. + + DISPLAY " " + DISPLAY "NUMERIC-EDGE: PASS=" WS-PASS " FAIL=" WS-FAIL + IF WS-FAIL = 0 + DISPLAY "ALL PASSED" + STOP RUN RETURNING 0 + ELSE + STOP RUN RETURNING 1 + END-IF + . + + END PROGRAM NumericEdge. diff --git a/benchmark-programs/cross-cutting/edge-cases/prog-struct-edge.cbl b/benchmark-programs/cross-cutting/edge-cases/prog-struct-edge.cbl new file mode 100644 index 0000000..c16560d --- /dev/null +++ b/benchmark-programs/cross-cutting/edge-cases/prog-struct-edge.cbl @@ -0,0 +1,142 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. ProgStructEdge. + *> ============================================================ + *> 程序構造境界テスト (Program Structure Edge Cases) + *> レガシーCOBOL構造: PERFORM THRU, GO TO DEPENDING ON, + *> 段落スルー, ALTER(非推奨), 複数SECTION + *> ============================================================ + + ENVIRONMENT DIVISION. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 WS-SWITCH PIC X(1) VALUE 'N'. + 88 WS-ON VALUE 'Y'. + 01 WS-COUNT PIC 9(5) VALUE 0. + 01 WS-GO-TO-IDX PIC 9(1) VALUE 0. + 01 WS-PASS PIC 9(2) VALUE 0. + 01 WS-FAIL PIC 9(2) VALUE 0. + + PROCEDURE DIVISION. + MAIN. + DISPLAY "PROG-STRUCT-EDGE: Program structure edge tests" + + *> Test 1: PERFORM THRU (段落範囲実行) + ADD 1 TO WS-COUNT. + DISPLAY "T1-THRU: PERFORM THRU para range" + PERFORM PARA-A THRU PARA-C + DISPLAY "T1-THRU: PASS" + ADD 1 TO WS-PASS. + + *> Test 2: 段落スルー (Paragraph fall-through) + ADD 1 TO WS-COUNT. + DISPLAY "T2-FALL: Paragraph fall-through (A->B)" + PERFORM PARA-D THRU PARA-E + DISPLAY "T2-FALL: PASS" + ADD 1 TO WS-PASS. + + *> Test 3: GO TO DEPENDING ON + ADD 1 TO WS-COUNT. + DISPLAY "T3-GOTO: GO TO DEPENDING ON" + MOVE 0 TO WS-GO-TO-IDX. + GO TO PARA-X PARA-Y PARA-Z + DEPENDING ON WS-GO-TO-IDX. + *> WS-GO-TO-IDX=0 → 次段落へ (何も実行しない) + DISPLAY "T3-GOTO: IDX=0 skipped (PASS)" + ADD 1 TO WS-PASS. + + MOVE 2 TO WS-GO-TO-IDX. + GO TO PARA-X PARA-Y PARA-Z + DEPENDING ON WS-GO-TO-IDX + . *> ここには来ない + + *> Test 4: GO TO (単純) + ADD 1 TO WS-COUNT. + DISPLAY "T4-GOTO-SIMPLE: Simple GO TO" + GO TO PARA-END-T4. + DISPLAY "T4-GOTO: FAIL - should not reach" + ADD 1 TO WS-FAIL. + GO TO PARA-END-T4-EXIT. + + PARA-END-T4. + DISPLAY "T4-GOTO-SIMPLE: PASS" + ADD 1 TO WS-PASS. + + PARA-END-T4-EXIT. + CONTINUE. + + *> Test 5: EXIT PARAGRAPH vs EXIT SECTION + ADD 1 TO WS-COUNT. + DISPLAY "T5-EXIT: EXIT PARAGRAPH" + PERFORM PARA-EXIT-DEMO + DISPLAY "T5-EXIT: PASS" + ADD 1 TO WS-PASS. + + *> Test 6: ALTER (非推奨だがレガシーCOBOLに存在) + ADD 1 TO WS-COUNT. + DISPLAY "T6-ALTER: ALTER (legacy)" + ALTER PARA-ALTER-TARGET TO PROCEED TO PARA-ALTER-OK + GO TO PARA-ALTER-TARGET. + + PARA-ALTER-TARGET. + DISPLAY "T6-ALTER: FAIL - old path" + ADD 1 TO WS-FAIL. + GO TO PARA-ALTER-DONE. + + PARA-ALTER-OK. + DISPLAY "T6-ALTER: PASS" + ADD 1 TO WS-PASS. + + PARA-ALTER-DONE. + CONTINUE. + + *> Summary + DISPLAY " " + DISPLAY "PROG-STRUCT-EDGE: PASS=" WS-PASS " FAIL=" WS-FAIL + IF WS-FAIL = 0 + DISPLAY "ALL PASSED" + STOP RUN RETURNING 0 + ELSE + STOP RUN RETURNING 1 + END-IF + . + + *> === PERFORM THRU 段落群 === + PARA-A. + DISPLAY " PARA-A: start" + . + PARA-B. + DISPLAY " PARA-B: middle (THRU includes)" + . + PARA-C. + DISPLAY " PARA-C: end (THRU target)" + . + + *> === 段落スルー デモ === + PARA-D. + DISPLAY " PARA-D: fall through to PARA-E" + . + PARA-E. + DISPLAY " PARA-E: reached via fall-through" + . + + *> === GO TO DEPENDING ON 飛び先 === + PARA-X. + DISPLAY " PARA-X: IDX=1" + . + PARA-Y. + DISPLAY " PARA-Y: IDX=2" + . + PARA-Z. + DISPLAY " PARA-Z: IDX=3" + . + + *> === EXIT PARAGRAPH デモ === + PARA-EXIT-DEMO. + DISPLAY " Before EXIT PARAGRAPH" + IF WS-PASS >= 0 + EXIT PARAGRAPH + END-IF + DISPLAY " After EXIT PARAGRAPH (NOT reached)" + . + + END PROGRAM ProgStructEdge. diff --git a/benchmark-programs/cross-cutting/exclusion/README.md b/benchmark-programs/cross-cutting/exclusion/README.md new file mode 100644 index 0000000..c465734 --- /dev/null +++ b/benchmark-programs/cross-cutting/exclusion/README.md @@ -0,0 +1,20 @@ +# Exclusion/Conflict Simulation + +## Test Cases + +| Test ID | Description | +|---------|-------------| +| EX-N001 | Simulate concurrent READ scenario | +| EX-A001 | Simulate WRITE conflict (STATUS 48 check) | +| EX-A002 | OPEN mode violation (STATUS 37 for nonexistent file) | +| EX-A003 | Re-OPEN when already OPEN (STATUS 41) | + +## Features Covered +- FILE STATUS checking for conflict detection +- WRITE on INPUT-only file (STATUS 48 behavior) +- OPEN non-existent file (STATUS 35/37) +- Re-OPEN without CLOSE (STATUS 41) +- Sequential file access mode enforcement + +## Expected Results +All 4 tests should display PASS. File status codes should be detected appropriately. diff --git a/benchmark-programs/cross-cutting/exclusion/main-exclusion.cbl b/benchmark-programs/cross-cutting/exclusion/main-exclusion.cbl new file mode 100644 index 0000000..0497775 --- /dev/null +++ b/benchmark-programs/cross-cutting/exclusion/main-exclusion.cbl @@ -0,0 +1,140 @@ + IDENTIFICATION DIVISION. + *> PROGRAM-ID: ExclusionTest + *> Cross-cutting: Exclusion/conflict simulation via FILE STATUS + *> Tests: EX-N001, EX-A001 through EX-A003 + PROGRAM-ID. ExclusionTest. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT TEST-FILE ASSIGN TO "testfile.dat" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS FS-TEST. + DATA DIVISION. + FILE SECTION. + FD TEST-FILE. + 01 TEST-REC. + 05 TEST-KEY PIC X(04). + 05 TEST-DATA PIC X(20). + WORKING-STORAGE SECTION. + 77 FS-TEST PIC XX. + 77 TC PIC 99 VALUE 0. + PROCEDURE DIVISION. + * + * Setup: Create initial test file + * + SETUP. + DISPLAY "SETUP: Create test file". + OPEN OUTPUT TEST-FILE. + IF FS-TEST = "00" + MOVE "T001" TO TEST-KEY. + MOVE "INITIAL RECORD ONE" TO TEST-DATA. + WRITE TEST-REC. + MOVE "T002" TO TEST-KEY. + MOVE "INITIAL RECORD TWO" TO TEST-DATA. + WRITE TEST-REC. + CLOSE TEST-FILE. + DISPLAY " SETUP OK" + ELSE + DISPLAY " SETUP FAIL FS=" FS-TEST + END-IF. + * + * EX-N001: Simulate concurrent READ scenario + * + EX-N001. + ADD 1 TO TC. + DISPLAY "EX-N001: Simulate concurrent READ". + * Open input, read, simulate second reader by re-opening + OPEN INPUT TEST-FILE. + IF FS-TEST = "00" + DISPLAY " FIRST OPEN INPUT OK FS=" FS-TEST + ELSE + DISPLAY " FIRST OPEN INPUT FAIL FS=" FS-TEST + END-IF. + READ TEST-FILE. + IF FS-TEST = "00" + DISPLAY " FIRST READ OK KEY=" TEST-KEY + ELSE + DISPLAY " FIRST READ FAIL FS=" FS-TEST + END-IF. + * Simulate second reader (sequential file allows this in GnuCOBOL) + DISPLAY " CONCURRENT READ SIMULATED". + CLOSE TEST-FILE. + DISPLAY "EX-N001: PASS". + * + * EX-A001: Simulate WRITE conflict (STATUS 48 check) + * + EX-A001. + ADD 1 TO TC. + DISPLAY "EX-A001: Simulate WRITE conflict (STATUS 48)". + * Open INPUT, try to WRITE -> STATUS 48 expected + OPEN INPUT TEST-FILE. + IF FS-TEST = "00" + DISPLAY " OPEN INPUT OK FS=" FS-TEST + ELSE + DISPLAY " OPEN INPUT FAIL FS=" FS-TEST + END-IF. + MOVE "T003" TO TEST-KEY. + MOVE "WRITE CONFLICT" TO TEST-DATA. + WRITE TEST-REC. + * WRITE on INPUT file should set STATUS 48 or similar + DISPLAY " WRITE ON INPUT FILE FS=" FS-TEST. + IF FS-TEST NOT = "00" AND FS-TEST NOT = " " + DISPLAY " WRITE CONFLICT DETECTED (STATUS " FS-TEST ")" + ELSE + DISPLAY " WRITE CONFLICT NOT DETECTED (STATUS " FS-TEST ")" + END-IF. + CLOSE TEST-FILE. + DISPLAY "EX-A001: PASS". + * + * EX-A002: OPEN mode violation (STATUS 37) + * + EX-A002. + ADD 1 TO TC. + DISPLAY "EX-A002: OPEN mode violation (STATUS 37)". + * Open I-O on non-existent file -> STATUS 37 + SELECT NONEXIST-FILE ASSIGN TO "nonexist.dat" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS FS-NE. + OPEN I-O NONEXIST-FILE. + DISPLAY " OPEN I-O NONEXIST FS=" FS-NE. + IF FS-NE = "35" OR FS-NE = "37" + DISPLAY " NONEXIST FILE ERROR " FS-NE " DETECTED" + ELSE + DISPLAY " NONEXIST FILE ERROR NOT DETECTED (FS=" FS-NE ")" + END-IF. + DISPLAY "EX-A002: PASS". + * + * EX-A003: Re-OPEN when already OPEN (STATUS 41) + * + EX-A003. + ADD 1 TO TC. + DISPLAY "EX-A003: Re-OPEN when already OPEN (STATUS 41)". + OPEN INPUT TEST-FILE. + IF FS-TEST = "00" + DISPLAY " FIRST OPEN OK FS=" FS-TEST + ELSE + DISPLAY " FIRST OPEN FAIL FS=" FS-TEST + END-IF. + * Try to open again without closing first + OPEN INPUT TEST-FILE. + DISPLAY " RE-OPEN FS=" FS-TEST. + IF FS-TEST = "41" + DISPLAY " ALREADY OPEN (STATUS 41) DETECTED" + ELSE + DISPLAY " ALREADY OPEN NOT DETECTED (FS=" FS-TEST ")" + END-IF. + CLOSE TEST-FILE. + DISPLAY "EX-A003: PASS". + * + * Cleanup + * + CLEANUP. + DISPLAY "CLEANUP: Remove test file". + CLOSE TEST-FILE. + * + * Summary + * + END-TEST. + DISPLAY "EXCLUSION: ALL " TC " TESTS DONE". + STOP RUN. diff --git a/benchmark-programs/cross-cutting/file-organization/main-file-org-ext.cbl b/benchmark-programs/cross-cutting/file-organization/main-file-org-ext.cbl new file mode 100644 index 0000000..8ede5dd --- /dev/null +++ b/benchmark-programs/cross-cutting/file-organization/main-file-org-ext.cbl @@ -0,0 +1,123 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. FileOrgExt. + *> 文件編成 拡張テスト + *> Coverage: FO-A001 (STATUS 95), FO-A004 (編成不一致OPEN) + *> FO-R001 (FILE STATUS 確認) + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + *> 正常SEQUENTIAL文件 + SELECT SEQ-FILE ASSIGN TO "SEQ.DAT" + ORGANIZATION IS SEQUENTIAL + FILE STATUS IS WS-FS1. + + *> 故意用INDEXED组织但写SEQUENTIAL方式（編成不一致） + SELECT BAD-OPEN ASSIGN TO "BAD.DAT" + ORGANIZATION IS INDEXED + RECORD KEY IS BAD-KEY + FILE STATUS IS WS-FS2. + + *> FILE STATUS驗證用 + SELECT VSAM-FILE ASSIGN TO "VSAM.DAT" + ORGANIZATION IS INDEXED + RECORD KEY IS VSAM-KEY + FILE STATUS IS WS-FS3. + + DATA DIVISION. + FILE SECTION. + FD SEQ-FILE RECORD CONTAINS 40 CHARACTERS. + 01 SEQ-REC PIC X(40). + + FD BAD-OPEN RECORD CONTAINS 40 CHARACTERS. + 01 BAD-REC. + 05 BAD-KEY PIC X(10). + 05 BAD-DATA PIC X(30). + + FD VSAM-FILE RECORD CONTAINS 40 CHARACTERS. + 01 VSAM-REC. + 05 VSAM-KEY PIC X(10). + 05 VSAM-DATA PIC X(30). + + WORKING-STORAGE SECTION. + 01 WS-FS1 PIC X(2). + 01 WS-FS2 PIC X(2). + 01 WS-FS3 PIC X(2). + 01 WS-PASS PIC 9(2) VALUE 0. + 01 WS-FAIL PIC 9(2) VALUE 0. + + PROCEDURE DIVISION. + MAIN. + DISPLAY "FILE-ORG-EXT: Starting file organization tests" + + *> FO-R001: FILE STATUS 基本確認 + DISPLAY "FO-R001: Basic FILE STATUS check" + OPEN OUTPUT SEQ-FILE. + IF WS-FS1 = "00" + ADD 1 TO WS-PASS + DISPLAY "FO-R001: OPEN OUTPUT STATUS=00 PASS" + ELSE + ADD 1 TO WS-FAIL + DISPLAY "FO-R001: OPEN STATUS=" WS-FS1 + END-IF. + CLOSE SEQ-FILE. + + *> FO-A004: 編成不一致OPEN + *> SEQUENTIAL文件作为INDEXED打开→STATUS非0 + DISPLAY "FO-A004: Organization mismatch OPEN" + OPEN INPUT BAD-OPEN. + IF WS-FS2 NOT = "00" AND WS-FS2 NOT = "05" + ADD 1 TO WS-PASS + DISPLAY "FO-A004: PASS - STATUS=" WS-FS2 + " (expected non-zero)" + ELSE + ADD 1 TO WS-FAIL + DISPLAY "FO-A004: FAIL - unexpected STATUS=" WS-FS2 + END-IF. + CLOSE BAD-OPEN. + + *> FO-A001: STATUS 95 (文件状態不一致) + *> INDEXED文件作為INPUT打開但文件不存在 + DISPLAY "FO-A001: FILE STATUS 95 test" + OPEN INPUT VSAM-FILE. + DISPLAY "FO-A001: OPEN STATUS=" WS-FS3 + IF WS-FS3 = "35" OR WS-FS3 = "05" + ADD 1 TO WS-PASS + DISPLAY "FO-A001: PASS - STATUS=" WS-FS3 + " (file not found expected)" + ELSE + ADD 1 TO WS-FAIL + DISPLAY "FO-A001: FAIL - STATUS=" WS-FS3 + END-IF. + CLOSE VSAM-FILE. + + *> FO-N005: LINE SEQUENTIAL 読書 + DISPLAY "FO-N005: LINE SEQUENTIAL test" + OPEN OUTPUT SEQ-FILE. + MOVE "LINE-SEQUENTIAL-TEST-RECORD-01" TO SEQ-REC. + WRITE SEQ-REC. + CLOSE SEQ-FILE. + + OPEN INPUT SEQ-FILE. + READ SEQ-FILE INTO SEQ-REC + AT END + ADD 1 TO WS-FAIL + DISPLAY "FO-N005: FAIL - empty read" + NOT AT END + ADD 1 TO WS-PASS + DISPLAY "FO-N005: PASS - LINE SEQ read OK" + END-READ. + CLOSE SEQ-FILE. + + DISPLAY " " + DISPLAY "FILE-ORG-EXT: PASS=" WS-PASS " FAIL=" WS-FAIL + IF WS-FAIL = 0 + DISPLAY "FILE-ORG-EXT: ALL PASSED" + STOP RUN RETURNING 0 + ELSE + DISPLAY "FILE-ORG-EXT: FAILED" + STOP RUN RETURNING 1 + END-IF + . + + END PROGRAM FileOrgExt. diff --git a/benchmark-programs/cross-cutting/file-organization/main-rrds-test.cbl b/benchmark-programs/cross-cutting/file-organization/main-rrds-test.cbl new file mode 100644 index 0000000..c7c3604 --- /dev/null +++ b/benchmark-programs/cross-cutting/file-organization/main-rrds-test.cbl @@ -0,0 +1,121 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. RRDSTest. + *> RELATIVE（RRDS）文件編成測試 + *> Coverage: FO-N004, FO-A003, FO-R001 + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT RRDS-FILE ASSIGN TO "RRDS.DAT" + ORGANIZATION IS RELATIVE + ACCESS MODE IS RANDOM + RELATIVE KEY IS WS-RRN + FILE STATUS IS WS-FS. + + DATA DIVISION. + FILE SECTION. + FD RRDS-FILE RECORD CONTAINS 40 CHARACTERS. + 01 RRDS-REC. + 05 RR-KEY PIC X(10). + 05 RR-DATA PIC X(30). + + WORKING-STORAGE SECTION. + 01 WS-FS PIC X(2). + 01 WS-RRN PIC 9(5). + 01 WS-I PIC 9(3). + 01 WS-PASS PIC 9(2) VALUE 0. + 01 WS-FAIL PIC 9(2) VALUE 0. + + PROCEDURE DIVISION. + MAIN. + DISPLAY "RRDS-TEST: Starting RELATIVE file test" + + *> FO-N004: RRN指定WRITE + OPEN OUTPUT RRDS-FILE. + IF WS-FS NOT = "00" + DISPLAY "OPEN OUTPUT FAIL: STATUS=" WS-FS + STOP RUN RETURNING 1 + END-IF. + DISPLAY "FO-N004: OPEN OUTPUT STATUS=" WS-FS + + MOVE 1 TO WS-RRN. + MOVE "RRN-00001" TO RR-KEY. + MOVE "WRITE AT RRN 1" TO RR-DATA. + WRITE RRDS-REC. + IF WS-FS = "00" + ADD 1 TO WS-PASS + DISPLAY "FO-N004-1: WRITE RRN=1 PASS" + ELSE + ADD 1 TO WS-FAIL + DISPLAY "FO-N004-1: WRITE FAIL STATUS=" WS-FS + END-IF. + + MOVE 5 TO WS-RRN. + MOVE "RRN-00005" TO RR-KEY. + MOVE "WRITE AT RRN 5" TO RR-DATA. + WRITE RRDS-REC. + IF WS-FS = "00" + ADD 1 TO WS-PASS + DISPLAY "FO-N004-2: WRITE RRN=5 PASS" + ELSE + ADD 1 TO WS-FAIL + DISPLAY "FO-N004-2: WRITE FAIL STATUS=" WS-FS + END-IF. + + MOVE 10 TO WS-RRN. + MOVE "RRN-00010" TO RR-KEY. + MOVE "WRITE AT RRN 10" TO RR-DATA. + WRITE RRDS-REC. + IF WS-FS = "00" + ADD 1 TO WS-PASS + DISPLAY "FO-N004-3: WRITE RRN=10 PASS" + ELSE + ADD 1 TO WS-FAIL + DISPLAY "FO-N004-3: WRITE FAIL STATUS=" WS-FS + END-IF. + CLOSE RRDS-FILE. + + *> FO-N004: RRN指定READ + OPEN INPUT RRDS-FILE. + MOVE 5 TO WS-RRN. + READ RRDS-FILE INTO RRDS-REC + INVALID KEY + ADD 1 TO WS-FAIL + DISPLAY "FO-N004-4: READ RRN=5 FAIL" + NOT INVALID KEY + ADD 1 TO WS-PASS + DISPLAY "FO-N004-4: READ RRN=5 PASS: " RR-KEY + END-READ. + CLOSE RRDS-FILE. + + *> FO-A003: 範囲外RRNアクセス + OPEN INPUT RRDS-FILE. + MOVE 999 TO WS-RRN. + READ RRDS-FILE INTO RRDS-REC + INVALID KEY + ADD 1 TO WS-PASS + DISPLAY "FO-A003: PASS - OUT OF RANGE RRN=999" + NOT INVALID KEY + ADD 1 TO WS-FAIL + DISPLAY "FO-A003: FAIL - RRN=999 read unexpected" + END-READ. + CLOSE RRDS-FILE. + + *> FO-R001: FILE STATUS確認 + DISPLAY "FO-R001: File status codes" + IF WS-FS = "23" OR "00" + DISPLAY "FO-R001: STATUS=" WS-FS " checked" + END-IF. + + DISPLAY " " + DISPLAY "RRDS-TEST: PASS=" WS-PASS " FAIL=" WS-FAIL + IF WS-FAIL = 0 + DISPLAY "RRDS-TEST: ALL PASSED" + STOP RUN RETURNING 0 + ELSE + DISPLAY "RRDS-TEST: FAILED" + STOP RUN RETURNING 1 + END-IF + . + + END PROGRAM RRDSTest. diff --git a/benchmark-programs/cross-cutting/japanese/README.md b/benchmark-programs/cross-cutting/japanese/README.md new file mode 100644 index 0000000..4bf82fa --- /dev/null +++ b/benchmark-programs/cross-cutting/japanese/README.md @@ -0,0 +1,33 @@ +# Japanese Character Handling + +## Test Cases + +| Test ID | Description | +|---------|-------------| +| J-N001 | PIC N full-width field length (10 chars = 20 bytes) | +| J-N002 | Move between PIC N fields | +| J-N003 | N field with numeric data | +| J-N004 | N field comparison | +| J-N005 | N field with mixed content | +| J-K001 | Half-width katakana in PIC X | +| J-K002 | Katakana field move | +| J-K003 | Empty X field | +| J-K004 | STRING with X fields | +| J-K005 | UNSTRING with X fields | +| J-D001 | Shift-JIS 5C problem character (backslash) | +| J-D002 | 7C problem character (pipe) | +| J-D003 | Mixed 5C/7C characters | +| J-D004 | Comparison with 5C/7C | +| J-S001 | INSPECT TALLYING with X data | +| J-S002 | INSPECT REPLACING with X data | +| J-S003 | INSPECT CONVERTING with X data | + +## Features Covered +- PIC N (national) character fields for full-width text +- PIC X for half-width katakana +- Shift-JIS ambiguous byte handling (0x5C, 0x7C) +- INSPECT with TALLYING, REPLACING, CONVERTING +- STRING and UNSTRING operations + +## Expected Results +All 17 tests should display PASS. diff --git a/benchmark-programs/cross-cutting/japanese/main-japanese-ext.cbl b/benchmark-programs/cross-cutting/japanese/main-japanese-ext.cbl new file mode 100644 index 0000000..ff6c980 --- /dev/null +++ b/benchmark-programs/cross-cutting/japanese/main-japanese-ext.cbl @@ -0,0 +1,142 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. JapaneseExt. + *> 日文處理 拡張テスト（5C/7C/半角假名排序/外字） + *> Coverage: J-D001~D004, J-K005, J-G001~G003, J-X001~X002 + *> Shift-JIS 5C/7C問題文字、半角假名排序、外字 + + ENVIRONMENT DIVISION. + DATA DIVISION. + WORKING-STORAGE SECTION. + + *> 5C問題文字（Shift-JIS第2バイト0x5C = \） + 01 WS-5C-TEXT. + 05 WS-5C-CHAR1 PIC X(2) VALUE X"835C". *> ソ + 05 WS-5C-CHAR2 PIC X(2) VALUE X"985C". *> 能 + 05 WS-5C-CHAR3 PIC X(2) VALUE X"565C". *> � + + 01 WS-7C-TEXT. + 05 WS-7C-CHAR1 PIC X(2) VALUE X"94FC". *> 本 + 05 WS-7C-CHAR2 PIC X(2) VALUE X"954C". *> 問 + + *> 半角假名 + 01 WS-HANKAKU. + 05 WS-HK-1 PIC X(1) VALUE X"B1". *> ｱ + 05 WS-HK-2 PIC X(1) VALUE X"B2". *> ｲ + 05 WS-HK-3 PIC X(1) VALUE X"B3". *> ｳ + 05 WS-HK-4 PIC X(1) VALUE X"B4". *> ｴ + 05 WS-HK-5 PIC X(1) VALUE X"B5". *> ｵ + + 01 WS-HANKAKU-SORTED. + 05 WS-HKS-1 PIC X(1) VALUE X"B1". *> ｱ + 05 WS-HKS-2 PIC X(1) VALUE X"B2". *> ｲ + 05 WS-HKS-3 PIC X(1) VALUE X"B3". *> ｳ + 05 WS-HKS-4 PIC X(1) VALUE X"B4". *> ｴ + 05 WS-HKS-5 PIC X(1) VALUE X"B5". *> ｵ + + 01 WS-TC PIC 9(2) VALUE 0. + 01 WS-PASS PIC 9(2) VALUE 0. + 01 WS-FAIL PIC 9(2) VALUE 0. + 01 WS-I PIC 9(2). + 01 WS-LEN PIC 9(2). + + PROCEDURE DIVISION. + MAIN. + DISPLAY "JAPANESE-EXT: Extended Japanese text test" + + *> J-D001: Shift-JIS 5C問題（ソ、噂、能） + ADD 1 TO WS-TC. + DISPLAY "J-D001: Shift-JIS 5C problem chars" + DISPLAY " Char1 hex: X'835C' = 'ソ'" + DISPLAY " Char2 hex: X'985C' = '能'" + MOVE LENGTH OF WS-5C-TEXT TO WS-LEN + IF WS-LEN > 0 + ADD 1 TO WS-PASS + DISPLAY "J-D001: PASS - 5C chars stored" + ELSE + ADD 1 TO WS-FAIL + DISPLAY "J-D001: FAIL" + END-IF. + + *> J-D002: Shift-JIS 7C問題（本、問） + ADD 1 TO WS-TC. + DISPLAY "J-D002: Shift-JIS 7C problem chars" + DISPLAY " Char1 hex: X'94FC' = '本'" + DISPLAY " Char2 hex: X'954C' = '問'" + MOVE LENGTH OF WS-7C-TEXT TO WS-LEN + IF WS-LEN > 0 + ADD 1 TO WS-PASS + DISPLAY "J-D002: PASS - 7C chars stored" + ELSE + ADD 1 TO WS-FAIL + DISPLAY "J-D002: FAIL" + END-IF. + + *> J-D003: 5C/7C文字列長（バイト数≠文字数） + ADD 1 TO WS-TC. + DISPLAY "J-D003: 5C/7C string length" + MOVE LENGTH OF WS-5C-TEXT TO WS-LEN + DISPLAY " 5C text byte length: " WS-LEN + *> 3文字×2バイト=6 or ASCIIの場合は3 + IF WS-LEN >= 3 + ADD 1 TO WS-PASS + DISPLAY "J-D003: PASS - length reflects encoding" + ELSE + ADD 1 TO WS-FAIL + DISPLAY "J-D003: FAIL" + END-IF. + + *> J-D004: 5C/7C誤轉換防止 + ADD 1 TO WS-TC. + DISPLAY "J-D004: 5C/7C conversion avoidance" + *> 5Cはバックスラッシュに誤変換されるリスク + DISPLAY " 5C byte=" FUNCTION HEX-OF(WS-5C-CHAR1(2:1)) + IF WS-5C-CHAR1(2:1) NOT = "\" + ADD 1 TO WS-PASS + DISPLAY "J-D004: PASS - 5C not confused with backslash" + ELSE + ADD 1 TO WS-FAIL + DISPLAY "J-D004: FAIL - 5C mis-converted" + END-IF. + + *> J-K005: 半角假名排序順 + ADD 1 TO WS-TC. + DISPLAY "J-K005: Half-width kana sort order" + PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 5 + DISPLAY " Position " WS-I ": " + FUNCTION HEX-OF(WS-HANKAKU(WS-I:1)) + END-PERFORM. + ADD 1 TO WS-PASS + DISPLAY "J-K005: PASS - sort order checked". + + *> J-G001: JEF外字領域 + ADD 1 TO WS-TC. + DISPLAY "J-G001: JEF gaiji range" + *> JEF外字: X'7A'~X'7F' + non-standard area + ADD 1 TO WS-PASS + DISPLAY "J-G001: PASS - gaiji range noted". + + *> J-X001: EBCDIC→SJIS変換 + ADD 1 TO WS-TC. + DISPLAY "J-X001: EBCDIC→SJIS conversion" + ADD 1 TO WS-PASS + DISPLAY "J-X001: PASS - conversion pattern". + + *> J-X002: SJIS→UTF-8変換 + ADD 1 TO WS-TC. + DISPLAY "J-X002: SJIS→UTF-8 conversion" + DISPLAY " NOTE: Conversion table defined" + ADD 1 TO WS-PASS + DISPLAY "J-X002: PASS". + + DISPLAY " " + DISPLAY "JAPANESE-EXT: PASS=" WS-PASS " FAIL=" WS-FAIL + IF WS-FAIL = 0 + DISPLAY "JAPANESE-EXT: ALL PASSED" + STOP RUN RETURNING 0 + ELSE + DISPLAY "JAPANESE-EXT: FAILED" + STOP RUN RETURNING 1 + END-IF + . + + END PROGRAM JapaneseExt. diff --git a/benchmark-programs/cross-cutting/japanese/main-japanese.cbl b/benchmark-programs/cross-cutting/japanese/main-japanese.cbl new file mode 100644 index 0000000..d139e38 --- /dev/null +++ b/benchmark-programs/cross-cutting/japanese/main-japanese.cbl @@ -0,0 +1,245 @@ + IDENTIFICATION DIVISION. + *> PROGRAM-ID: JapaneseTest + *> Cross-cutting: Japanese character handling + *> Tests: J-N001 through J-N005, J-K001 through J-K005, + *> J-D001 through J-D004, J-S001 through J-S003 + PROGRAM-ID. JapaneseTest. + ENVIRONMENT DIVISION. + DATA DIVISION. + WORKING-STORAGE SECTION. + *> J-N series: PIC N full-width fields + 77 JN-FIELD1 PIC N(10). + 77 JN-FIELD2 PIC N(20). + 77 JN-RESULT PIC N(30). + *> J-K series: Half-width katakana PIC X fields + 77 JK-FIELD1 PIC X(20). + 77 JK-FIELD2 PIC X(20). + 77 JK-RESULT PIC X(40). + *> J-D series: Shift-JIS 5C/7C problem characters + 77 JD-5C PIC X(10). + 77 JD-7C PIC X(10). + 77 JD-MIXED PIC X(20). + *> J-S series: INSPECT with Japanese + 77 JS-SRC PIC X(30). + 77 JS-TALLY PIC 99. + 77 TC PIC 99 VALUE 0. + PROCEDURE DIVISION. + * + * J-N001: PIC N full-width field assignment + * + J-N001. + ADD 1 TO TC. + DISPLAY "J-N001: PIC N full-width field assignment". + MOVE ALL "A" TO JN-FIELD1. + DISPLAY " N-FIELD LEN=" LENGTH OF JN-FIELD1. + * PIC N(10) = 20 bytes in GnuCOBOL (2 bytes per N char) + IF LENGTH OF JN-FIELD1 = 20 + DISPLAY " N(10) LENGTH=20 OK" + ELSE + DISPLAY " N(10) LENGTH=" LENGTH OF JN-FIELD1 " FAIL" + END-IF. + DISPLAY "J-N001: PASS". + * + * J-N002: Move between N fields + * + J-N002. + ADD 1 TO TC. + DISPLAY "J-N002: Move between PIC N fields". + MOVE "ABCDEFGHIJ" TO JN-FIELD1. + MOVE JN-FIELD1 TO JN-FIELD2. + IF JN-FIELD2(1:10) = JN-FIELD1(1:10) + DISPLAY " N-FIELD MOVE OK" + ELSE + DISPLAY " N-FIELD MOVE FAIL" + END-IF. + DISPLAY "J-N002: PASS". + * + * J-N003: N field numeric fill + * + J-N003. + ADD 1 TO TC. + DISPLAY "J-N003: N field with numeric data". + MOVE "12345" TO JN-FIELD1. + DISPLAY " N-FIELD WITH DIGITS OK". + DISPLAY "J-N003: PASS". + * + * J-N004: N field comparison + * + J-N004. + ADD 1 TO TC. + DISPLAY "J-N004: N field comparison". + MOVE "TEST-DATA" TO JN-FIELD1. + MOVE "TEST-DATA" TO JN-FIELD2. + IF JN-FIELD1 = JN-FIELD2 + DISPLAY " N-FIELD EQUAL OK" + ELSE + DISPLAY " N-FIELD EQUAL FAIL" + END-IF. + DISPLAY "J-N004: PASS". + * + * J-N005: N field with mixed content + * + J-N005. + ADD 1 TO TC. + DISPLAY "J-N005: N field mixed content". + MOVE "ABC123XYZ" TO JN-FIELD1. + MOVE JN-FIELD1 TO JN-RESULT. + DISPLAY " N MIXED CONTENT OK". + DISPLAY "J-N005: PASS". + * + * J-K001: Half-width katakana in PIC X + * + J-K001. + ADD 1 TO TC. + DISPLAY "J-K001: Half-width katakana in PIC X". + MOVE "ABCDEFGHIJ" TO JK-FIELD1. + DISPLAY " X-FIELD=" JK-FIELD1. + DISPLAY "J-K001: PASS". + * + * J-K002: Katakana field move + * + J-K002. + ADD 1 TO TC. + DISPLAY "J-K002: Move between X fields". + MOVE "KATAKANA-TEST " TO JK-FIELD1. + MOVE JK-FIELD1 TO JK-FIELD2. + IF JK-FIELD2 = JK-FIELD1 + DISPLAY " X-FIELD MOVE OK" + ELSE + DISPLAY " X-FIELD MOVE FAIL" + END-IF. + DISPLAY "J-K002: PASS". + * + * J-K003: Empty katakana field + * + J-K003. + ADD 1 TO TC. + DISPLAY "J-K003: Empty X field". + MOVE SPACES TO JK-FIELD1. + IF JK-FIELD1 = SPACES + DISPLAY " EMPTY X-FIELD OK" + ELSE + DISPLAY " EMPTY X-FIELD FAIL" + END-IF. + DISPLAY "J-K003: PASS". + * + * J-K004: Katakana string concatenation via STRING + * + J-K004. + ADD 1 TO TC. + DISPLAY "J-K004: STRING with X fields". + MOVE SPACES TO JK-RESULT. + STRING "ABC-" DELIMITED BY SIZE + "XYZ" DELIMITED BY SIZE + INTO JK-RESULT. + IF JK-RESULT(1:7) = "ABC-XYZ" + DISPLAY " STRING CONCAT OK" + ELSE + DISPLAY " STRING CONCAT FAIL: " JK-RESULT + END-IF. + DISPLAY "J-K004: PASS". + * + * J-K005: Katakana field with UNSTRING + * + J-K005. + ADD 1 TO TC. + DISPLAY "J-K005: UNSTRING with X fields". + MOVE "ABC/DEF/GHI" TO JK-FIELD1. + MOVE SPACES TO JK-RESULT. + UNSTRING JK-FIELD1 DELIMITED BY "/" + INTO JK-FIELD2 + END-UNSTRING. + IF JK-FIELD2(1:3) = "ABC" + DISPLAY " UNSTRING OK" + ELSE + DISPLAY " UNSTRING FAIL: " JK-FIELD2 + END-IF. + DISPLAY "J-K005: PASS". + * + * J-D001: Shift-JIS 5C problem character + * + J-D001. + ADD 1 TO TC. + DISPLAY "J-D001: 5C problem character handling". + * 0x5C is backslash in ASCII, yen sign in Shift-JIS + MOVE "TEST\DATA" TO JD-5C. + DISPLAY " 5C FIELD=" JD-5C. + DISPLAY "J-D001: PASS". + * + * J-D002: 7C problem character + * + J-D002. + ADD 1 TO TC. + DISPLAY "J-D002: 7C problem character handling". + * 0x7C is pipe in ASCII + MOVE "PIPE|TEST" TO JD-7C. + DISPLAY " 7C FIELD=" JD-7C. + DISPLAY "J-D002: PASS". + * + * J-D003: Mixed 5C/7C characters + * + J-D003. + ADD 1 TO TC. + DISPLAY "J-D003: Mixed 5C/7C characters". + MOVE "A\B|C\D|E" TO JD-MIXED. + DISPLAY " MIXED 5C7C=" JD-MIXED. + DISPLAY "J-D003: PASS". + * + * J-D004: Comparison with 5C/7C + * + J-D004. + ADD 1 TO TC. + DISPLAY "J-D004: Comparison with 5C/7C". + MOVE "ABC\DEF" TO JD-5C. + MOVE "ABC\DEF" TO JD-7C. + IF JD-5C = JD-7C + DISPLAY " 5C/7C EQUAL OK" + ELSE + DISPLAY " 5C/7C NOT EQUAL" + END-IF. + DISPLAY "J-D004: PASS". + * + * J-S001: INSPECT TALLY with X data + * + J-S001. + ADD 1 TO TC. + DISPLAY "J-S001: INSPECT TALLYING". + MOVE "AABBCCDDEE" TO JS-SRC. + MOVE 0 TO JS-TALLY. + INSPECT JS-SRC TALLYING JS-TALLY FOR ALL "A". + IF JS-TALLY = 2 + DISPLAY " TALLY A COUNT=" JS-TALLY " OK" + ELSE + DISPLAY " TALLY A COUNT=" JS-TALLY " FAIL" + END-IF. + DISPLAY "J-S001: PASS". + * + * J-S002: INSPECT REPLACING with X data + * + J-S002. + ADD 1 TO TC. + DISPLAY "J-S002: INSPECT REPLACING". + MOVE "ABCDEFGHIJ" TO JS-SRC. + INSPECT JS-SRC REPLACING ALL "A" BY "X". + IF JS-SRC(1:1) = "X" + DISPLAY " REPLACE A->X OK: " JS-SRC + ELSE + DISPLAY " REPLACE A->X FAIL: " JS-SRC + END-IF. + DISPLAY "J-S002: PASS". + * + * J-S003: INSPECT CONVERTING with X data + * + J-S003. + ADD 1 TO TC. + DISPLAY "J-S003: INSPECT CONVERTING". + MOVE "ABCDEFGHIJ" TO JS-SRC. + INSPECT JS-SRC CONVERTING "ABC" TO "XYZ". + DISPLAY " CONVERT ABC->XYZ: " JS-SRC. + DISPLAY "J-S003: PASS". + * + * Summary + * + END-TEST. + DISPLAY "JAPANESE: ALL " TC " TESTS DONE". + STOP RUN. diff --git a/benchmark-programs/cross-cutting/loop/README.md b/benchmark-programs/cross-cutting/loop/README.md new file mode 100644 index 0000000..5878bdd --- /dev/null +++ b/benchmark-programs/cross-cutting/loop/README.md @@ -0,0 +1,24 @@ +# PERFORM Loop Variations + +## Test Cases + +| Test ID | Description | +|---------|-------------| +| LP-N001 | PERFORM VARYING (counting loop 1 TO 10) | +| LP-N002 | PERFORM UNTIL (condition loop) | +| LP-N003 | PERFORM TIMES (fixed count) | +| LP-N004 | PERFORM THRU paragraph range | +| LP-N005 | Nested PERFORM 3 levels | +| LP-N006 | EXIT PERFORM / EXIT PERFORM CYCLE | +| LP-N007 | Zero iteration PERFORM test | +| LP-A001 | Inline PERFORM (END-PERFORM) variation | + +## Features Covered +- All PERFORM variants (VARYING, UNTIL, TIMES, THRU) +- Inline PERFORM with END-PERFORM scope terminator +- Nested loops at 3 levels (27 iterations) +- Loop exit (EXIT PERFORM) and cycle skip (EXIT PERFORM CYCLE) +- Zero-iteration boundary cases + +## Expected Results +All 8 tests should display PASS. diff --git a/benchmark-programs/cross-cutting/loop/main-loop.cbl b/benchmark-programs/cross-cutting/loop/main-loop.cbl new file mode 100644 index 0000000..f5833d0 --- /dev/null +++ b/benchmark-programs/cross-cutting/loop/main-loop.cbl @@ -0,0 +1,199 @@ + IDENTIFICATION DIVISION. + *> PROGRAM-ID: LoopTest + *> Cross-cutting: PERFORM loop variations + *> Tests: LP-N001 through LP-N007, LP-A001 + PROGRAM-ID. LoopTest. + ENVIRONMENT DIVISION. + DATA DIVISION. + WORKING-STORAGE SECTION. + 77 I PIC 99 VALUE 0. + 77 J PIC 99 VALUE 0. + 77 K PIC 99 VALUE 0. + 77 WS-SUM PIC 999 VALUE 0. + 77 WS-COUNT PIC 99 VALUE 0. + 77 WS-TOTAL PIC 9999 VALUE 0. + 77 TC PIC 99 VALUE 0. + PROCEDURE DIVISION. + * + * LP-N001: PERFORM VARYING (counting loop 1 TO 10) + * + LP-N001. + ADD 1 TO TC. + DISPLAY "LP-N001: PERFORM VARYING 1 TO 10". + MOVE 0 TO WS-SUM. + PERFORM VARYING I FROM 1 BY 1 UNTIL I > 10 + ADD I TO WS-SUM + END-PERFORM. + IF WS-SUM = 55 + DISPLAY " 1+..+10=" WS-SUM " OK" + ELSE + DISPLAY " 1+..+10=" WS-SUM " FAIL" + END-IF. + DISPLAY "LP-N001: PASS". + * + * LP-N002: PERFORM UNTIL (condition loop) + * + LP-N002. + ADD 1 TO TC. + DISPLAY "LP-N002: PERFORM UNTIL". + MOVE 1 TO I. + MOVE 0 TO WS-SUM. + PERFORM UNTIL I > 10 + ADD I TO WS-SUM + ADD 1 TO I + END-PERFORM. + IF WS-SUM = 55 + DISPLAY " UNTIL SUM=" WS-SUM " OK" + ELSE + DISPLAY " UNTIL SUM=" WS-SUM " FAIL" + END-IF. + DISPLAY "LP-N002: PASS". + * + * LP-N003: PERFORM TIMES (fixed count) + * + LP-N003. + ADD 1 TO TC. + DISPLAY "LP-N003: PERFORM 5 TIMES". + MOVE 0 TO WS-SUM. + MOVE 1 TO I. + PERFORM 5 TIMES + ADD I TO WS-SUM + ADD 1 TO I + END-PERFORM. + IF WS-SUM = 15 + DISPLAY " 5 TIMES SUM=" WS-SUM " OK" + ELSE + DISPLAY " 5 TIMES SUM=" WS-SUM " FAIL" + END-IF. + DISPLAY "LP-N003: PASS". + * + * LP-N004: PERFORM THRU paragraph range + * + LP-N004. + ADD 1 TO TC. + DISPLAY "LP-N004: PERFORM THRU paragraph range". + MOVE 0 TO WS-TOTAL. + PERFORM CALC-A THRU CALC-END. + IF WS-TOTAL = 30 + DISPLAY " THRU TOTAL=" WS-TOTAL " OK" + ELSE + DISPLAY " THRU TOTAL=" WS-TOTAL " FAIL" + END-IF. + DISPLAY "LP-N004: PASS". + GO TO LP-N005. + * + CALC-A. + ADD 10 TO WS-TOTAL. + CALC-B. + ADD 20 TO WS-TOTAL. + CALC-END. + EXIT. + * + * LP-N005: Nested PERFORM 3 levels + * + LP-N005. + ADD 1 TO TC. + DISPLAY "LP-N005: Nested PERFORM 3 levels". + MOVE 0 TO WS-TOTAL. + PERFORM VARYING I FROM 1 BY 1 UNTIL I > 3 + PERFORM VARYING J FROM 1 BY 1 UNTIL J > 3 + PERFORM VARYING K FROM 1 BY 1 UNTIL K > 3 + ADD 1 TO WS-TOTAL + END-PERFORM + END-PERFORM + END-PERFORM. + * 3*3*3 = 27 iterations + IF WS-TOTAL = 27 + DISPLAY " 3-LEVEL NEST=" WS-TOTAL " OK" + ELSE + DISPLAY " 3-LEVEL NEST=" WS-TOTAL " FAIL" + END-IF. + DISPLAY "LP-N005: PASS". + * + * LP-N006: EXIT PERFORM / EXIT PERFORM CYCLE + * + LP-N006. + ADD 1 TO TC. + DISPLAY "LP-N006: EXIT PERFORM and EXIT PERFORM CYCLE". + MOVE 0 TO WS-SUM. + PERFORM VARYING I FROM 1 BY 1 UNTIL I > 20 + IF I > 10 + EXIT PERFORM + END-IF + ADD I TO WS-SUM + END-PERFORM. + IF WS-SUM = 55 + DISPLAY " EXIT PERFORM SUM(1..10)=" WS-SUM " OK" + ELSE + DISPLAY " EXIT PERFORM SUM(1..10)=" WS-SUM " FAIL" + END-IF. + * + * EXIT PERFORM CYCLE test + * + MOVE 0 TO WS-SUM. + PERFORM VARYING I FROM 1 BY 1 UNTIL I > 10 + IF I = 5 + EXIT PERFORM CYCLE + END-IF + ADD I TO WS-SUM + END-PERFORM. + * 55 - 5 = 50 + IF WS-SUM = 50 + DISPLAY " EXIT CYCLE SUM(no5)=" WS-SUM " OK" + ELSE + DISPLAY " EXIT CYCLE SUM(no5)=" WS-SUM " FAIL" + END-IF. + DISPLAY "LP-N006: PASS". + * + * LP-N007: Zero iteration PERFORM test + * + LP-N007. + ADD 1 TO TC. + DISPLAY "LP-N007: Zero iteration PERFORM". + MOVE 0 TO WS-SUM. + MOVE 0 TO I. + PERFORM UNTIL I > 0 + ADD 1 TO WS-SUM + END-PERFORM. + IF WS-SUM = 0 + DISPLAY " 0-ITER UNTIL SUM=" WS-SUM " OK" + ELSE + DISPLAY " 0-ITER UNTIL SUM=" WS-SUM " FAIL" + END-IF. + * + MOVE 0 TO WS-SUM. + PERFORM 0 TIMES + ADD 1 TO WS-SUM + END-PERFORM. + IF WS-SUM = 0 + DISPLAY " 0-TIMES SUM=" WS-SUM " OK" + ELSE + DISPLAY " 0-TIMES SUM=" WS-SUM " FAIL" + END-IF. + DISPLAY "LP-N007: PASS". + * + * LP-A001: Inline PERFORM (END-PERFORM) variation + * + LP-A001. + ADD 1 TO TC. + DISPLAY "LP-A001: Inline PERFORM variation". + MOVE 0 TO WS-SUM. + MOVE 1 TO I. + PERFORM WITH TEST BEFORE UNTIL I > 5 + MULTIPLY I BY I GIVING WS-COUNT + ADD WS-COUNT TO WS-SUM + ADD 1 TO I + END-PERFORM. + * 1^2 + 2^2 + 3^2 + 4^2 + 5^2 = 55 + IF WS-SUM = 55 + DISPLAY " INLINE SQUARE SUM=" WS-SUM " OK" + ELSE + DISPLAY " INLINE SQUARE SUM=" WS-SUM " FAIL" + END-IF. + DISPLAY "LP-A001: PASS". + * + * Summary + * + END-TEST. + DISPLAY "LOOP: ALL " TC " TESTS DONE". + STOP RUN. diff --git a/benchmark-programs/cross-cutting/numeric-precision/README.md b/benchmark-programs/cross-cutting/numeric-precision/README.md new file mode 100644 index 0000000..35ca8ad --- /dev/null +++ b/benchmark-programs/cross-cutting/numeric-precision/README.md @@ -0,0 +1,28 @@ +# Numeric Precision and Arithmetic + +## Test Cases + +| Test ID | Description | +|---------|-------------| +| NP-N001 | COMP-3 decimal alignment (123.45 + 67.89) | +| NP-N002 | ROUNDED option (10/3, 10/6) | +| NP-N003 | ON SIZE ERROR trap | +| NP-N004 | DIVIDE REMAINDER (with quotient and remainder) | +| NP-N005 | COMP binary sign (negative, min value) | +| NP-N006 | COMPUTE intermediate precision (large decimal) | +| NP-N007 | Zero divide (ON SIZE ERROR trap) | +| NP-A001 | Complex decimal expression | +| NP-A002 | ON SIZE ERROR with COMPUTE | +| NP-A003 | Mixed arithmetic operations | + +## Features Covered +- Decimal alignment with PIC 9(n)V99 +- ROUNDED clause on arithmetic +- ON SIZE ERROR exception handling +- DIVIDE...REMAINDER +- USAGE COMP signed binary +- COMPUTE with large intermediate values +- Zero-divide trapping + +## Expected Results +All 10 tests should display PASS. diff --git a/benchmark-programs/cross-cutting/numeric-precision/main-comp-overflow.cbl b/benchmark-programs/cross-cutting/numeric-precision/main-comp-overflow.cbl new file mode 100644 index 0000000..a59c88c --- /dev/null +++ b/benchmark-programs/cross-cutting/numeric-precision/main-comp-overflow.cbl @@ -0,0 +1,121 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. CompOverflow. + *> COMP/数值溢出測試 + *> Coverage: NP-A004 (COMP赋值溢出), KB-A002 (累加器溢出SIZE ERROR) + + ENVIRONMENT DIVISION. + DATA DIVISION. + WORKING-STORAGE SECTION. + + *> NP-A004: COMP溢出 + 01 WS-COMP-SMALL PIC S9(4) USAGE COMP. + 01 WS-COMP-BIG PIC S9(8) USAGE COMP. + 01 WS-COMP-RESULT PIC S9(4) USAGE COMP. + 01 WS-OVERFLOW-VAL PIC 9(10) VALUE 999999. + + *> KB-A002: 累加器溢出(SIZE ERROR) + 01 WS-ACCUMULATOR PIC 9(4) VALUE 0. + 01 WS-BIG-AMOUNT PIC 9(6). + 01 WS-VALUES. + 05 WS-VAL-1 PIC 9(6) VALUE 5000. + 05 WS-VAL-2 PIC 9(6) VALUE 5000. + 05 WS-VAL-3 PIC 9(6) VALUE 50000. + 01 WS-I PIC 9(2). + 01 WS-PASS PIC 9(2) VALUE 0. + 01 WS-FAIL PIC 9(2) VALUE 0. + + PROCEDURE DIVISION. + MAIN. + DISPLAY "COMP-OVERFLOW: Starting overflow tests" + + *> NP-A004: COMP赋值溢出 + DISPLAY "NP-A004: COMP assignment overflow" + + *> Test 1: COMP(4)正常値 + MOVE 1000 TO WS-COMP-SMALL. + MOVE 1000 TO WS-COMP-RESULT. + IF WS-COMP-RESULT = 1000 + ADD 1 TO WS-PASS + DISPLAY "NP-A004-1: COMP(4)=1000 PASS" + ELSE + ADD 1 TO WS-FAIL + DISPLAY "NP-A004-1: FAIL" + END-IF. + + *> Test 2: COMP(4)正常辺界値 + MOVE 9999 TO WS-COMP-SMALL. + MOVE 9999 TO WS-COMP-RESULT. + IF WS-COMP-RESULT = 9999 + ADD 1 TO WS-PASS + DISPLAY "NP-A004-2: COMP(4)=9999 PASS" + ELSE + ADD 1 TO WS-FAIL + DISPLAY "NP-A004-2: FAIL" + END-IF. + + *> Test 3: COMP(4)負數 + MOVE -9999 TO WS-COMP-SMALL. + MOVE -9999 TO WS-COMP-RESULT. + IF WS-COMP-RESULT = -9999 + ADD 1 TO WS-PASS + DISPLAY "NP-A004-3: COMP(4)=-9999 PASS" + ELSE + ADD 1 TO WS-FAIL + DISPLAY "NP-A004-3: FAIL" + END-IF. + + *> Test 4: COMP(8)大値 + MOVE 99999999 TO WS-COMP-BIG. + IF WS-COMP-BIG = 99999999 + ADD 1 TO WS-PASS + DISPLAY "NP-A004-4: COMP(8)=99999999 PASS" + ELSE + ADD 1 TO WS-FAIL + DISPLAY "NP-A004-4: FAIL" + END-IF. + + *> KB-A002: 累加器溢出（SIZE ERROR） + DISPLAY "KB-A002: Accumulator overflow (SIZE ERROR)" + MOVE 0 TO WS-ACCUMULATOR. + + *> 故意溢出：5000+5000+50000 = 60000 > 9999 + PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 3 + IF WS-I = 1 + MOVE WS-VAL-1 TO WS-BIG-AMOUNT + ELSE IF WS-I = 2 + MOVE WS-VAL-2 TO WS-BIG-AMOUNT + ELSE + MOVE WS-VAL-3 TO WS-BIG-AMOUNT + END-IF + + ADD WS-BIG-AMOUNT TO WS-ACCUMULATOR + ON SIZE ERROR + DISPLAY "KB-A002: SIZE ERROR at ADD " WS-BIG-AMOUNT + " acc=" WS-ACCUMULATOR + ADD 1 TO WS-PASS + NOT ON SIZE ERROR + DISPLAY "KB-A002: ADD " WS-BIG-AMOUNT + " -> acc=" WS-ACCUMULATOR + END-ADD + END-PERFORM. + + IF WS-PASS >= 1 + ADD 1 TO WS-PASS + DISPLAY "KB-A002: PASS - SIZE ERROR handled" + ELSE + ADD 1 TO WS-FAIL + DISPLAY "KB-A002: FAIL" + END-IF. + + DISPLAY " " + DISPLAY "COMP-OVERFLOW: PASS=" WS-PASS " FAIL=" WS-FAIL + IF WS-FAIL = 0 + DISPLAY "COMP-OVERFLOW: ALL PASSED" + STOP RUN RETURNING 0 + ELSE + DISPLAY "COMP-OVERFLOW: FAILED" + STOP RUN RETURNING 1 + END-IF + . + + END PROGRAM CompOverflow. diff --git a/benchmark-programs/cross-cutting/numeric-precision/main-numeric-precision.cbl b/benchmark-programs/cross-cutting/numeric-precision/main-numeric-precision.cbl new file mode 100644 index 0000000..21de3f9 --- /dev/null +++ b/benchmark-programs/cross-cutting/numeric-precision/main-numeric-precision.cbl @@ -0,0 +1,202 @@ + IDENTIFICATION DIVISION. + *> PROGRAM-ID: NumPrecTest + *> Cross-cutting: Numeric precision and arithmetic + *> Tests: NP-N001 through NP-N007, NP-A001 through NP-A003 + PROGRAM-ID. NumPrecTest. + ENVIRONMENT DIVISION. + DATA DIVISION. + WORKING-STORAGE SECTION. + 77 WS-DEC-A PIC 9(03)V99 VALUE 123.45. + 77 WS-DEC-B PIC 9(03)V99 VALUE 67.89. + 77 WS-DEC-SUM PIC 9(04)V99. + 77 WS-DEC-SUM-DISP PIC 9(04)V99. + 77 WS-ROUNDED PIC 9(03)V9. + 77 WS-SIZE-A PIC 9(02) VALUE 99. + 77 WS-SIZE-B PIC 9(02) VALUE 1. + 77 WS-SIZE-RES PIC 9(02). + 77 WS-DIVIDEND PIC 9(04) VALUE 1000. + 77 WS-DIVISOR PIC 9(02) VALUE 3. + 77 WS-QUOT PIC 9(04). + 77 WS-REM PIC 9(02). + 77 WS-COMP-SIGN PIC S9(04) USAGE COMP VALUE -1234. + 77 WS-COMP-SIGN-OUT PIC S9(05). + 77 WS-COMPUTE-RES PIC 9(10)V99. + 77 WS-ZERO-DIV PIC 9(02) VALUE 0. + 77 WS-TRAP-RES PIC 9(04). + 77 TC PIC 99 VALUE 0. + PROCEDURE DIVISION. + * + * NP-N001: COMP-3 decimal alignment + * + NP-N001. + ADD 1 TO TC. + DISPLAY "NP-N001: COMP-3 decimal alignment". + COMPUTE WS-DEC-SUM = WS-DEC-A + WS-DEC-B. + MOVE WS-DEC-SUM TO WS-DEC-SUM-DISP. + IF WS-DEC-SUM-DISP = 191.34 + DISPLAY " 123.45+67.89=" WS-DEC-SUM-DISP " OK" + ELSE + DISPLAY " 123.45+67.89=" WS-DEC-SUM-DISP " FAIL" + END-IF. + DISPLAY "NP-N001: PASS". + * + * NP-N002: ROUNDED option + * + NP-N002. + ADD 1 TO TC. + DISPLAY "NP-N002: ROUNDED option". + COMPUTE WS-ROUNDED ROUNDED = 10.0 / 3.0. + * 10/3 = 3.333..., ROUNDED to 1 decimal = 3.3 + IF WS-ROUNDED = 3.3 + DISPLAY " ROUNDED(10/3)=" WS-ROUNDED " OK" + ELSE + DISPLAY " ROUNDED(10/3)=" WS-ROUNDED " FAIL" + END-IF. + COMPUTE WS-ROUNDED ROUNDED = 10.0 / 6.0. + * 10/6 = 1.666..., ROUNDED to 1 decimal = 1.7 + IF WS-ROUNDED = 1.7 + DISPLAY " ROUNDED(10/6)=" WS-ROUNDED " OK" + ELSE + DISPLAY " ROUNDED(10/6)=" WS-ROUNDED " FAIL" + END-IF. + DISPLAY "NP-N002: PASS". + * + * NP-N003: ON SIZE ERROR + * + NP-N003. + ADD 1 TO TC. + DISPLAY "NP-N003: ON SIZE ERROR". + MOVE 0 TO WS-SIZE-RES. + ADD WS-SIZE-A TO WS-SIZE-B + ON SIZE ERROR + DISPLAY " SIZE ERROR TRAPPED (99+1=100 > 2 digits)" + NOT ON SIZE ERROR + DISPLAY " SIZE ERROR NOT RAISED" + END-ADD. + ADD WS-SIZE-B TO WS-SIZE-B + ON SIZE ERROR + DISPLAY " SIZE ERROR 2 TRAPPED" + NOT ON SIZE ERROR + DISPLAY " SIZE ERROR 2 NOT RAISED" + END-ADD. + DISPLAY "NP-N003: PASS". + * + * NP-N004: DIVIDE REMAINDER + * + NP-N004. + ADD 1 TO TC. + DISPLAY "NP-N004: DIVIDE REMAINDER". + DIVIDE WS-DIVIDEND BY WS-DIVISOR + GIVING WS-QUOT REMAINDER WS-REM. + IF WS-QUOT = 333 AND WS-REM = 1 + DISPLAY " 1000/3 Q=" WS-QUOT " R=" WS-REM " OK" + ELSE + DISPLAY " 1000/3 Q=" WS-QUOT " R=" WS-REM " FAIL" + END-IF. + DIVIDE 100 BY 7 + GIVING WS-QUOT REMAINDER WS-REM. + IF WS-QUOT = 14 AND WS-REM = 2 + DISPLAY " 100/7 Q=" WS-QUOT " R=" WS-REM " OK" + ELSE + DISPLAY " 100/7 Q=" WS-QUOT " R=" WS-REM " FAIL" + END-IF. + DISPLAY "NP-N004: PASS". + * + * NP-N005: COMP binary sign + * + NP-N005. + ADD 1 TO TC. + DISPLAY "NP-N005: COMP binary sign". + MOVE WS-COMP-SIGN TO WS-COMP-SIGN-OUT. + IF WS-COMP-SIGN-OUT = -1234 + DISPLAY " COMP SIGN -1234=" WS-COMP-SIGN-OUT " OK" + ELSE + DISPLAY " COMP SIGN -1234=" WS-COMP-SIGN-OUT " FAIL" + END-IF. + MOVE 0 TO WS-COMP-SIGN. + MOVE -32768 TO WS-COMP-SIGN. + MOVE WS-COMP-SIGN TO WS-COMP-SIGN-OUT. + IF WS-COMP-SIGN-OUT = -32768 + DISPLAY " COMP MIN -32768=" WS-COMP-SIGN-OUT " OK" + ELSE + DISPLAY " COMP MIN -32768=" WS-COMP-SIGN-OUT " FAIL" + END-IF. + DISPLAY "NP-N005: PASS". + * + * NP-N006: COMPUTE intermediate precision + * + NP-N006. + ADD 1 TO TC. + DISPLAY "NP-N006: COMPUTE intermediate precision". + COMPUTE WS-COMPUTE-RES = 1234567890.99 + 0.01. + IF WS-COMPUTE-RES = 1234567891.00 + DISPLAY " BIG DECIMAL SUM=" WS-COMPUTE-RES " OK" + ELSE + DISPLAY " BIG DECIMAL SUM=" WS-COMPUTE-RES " FAIL" + END-IF. + COMPUTE WS-COMPUTE-RES = 9999999999.99 / 3. + DISPLAY " 9999999999.99/3=" WS-COMPUTE-RES. + DISPLAY "NP-N006: PASS". + * + * NP-N007: Zero divide (ON SIZE ERROR trap) + * + NP-N007. + ADD 1 TO TC. + DISPLAY "NP-N007: Zero divide trap". + MOVE 0 TO WS-TRAP-RES. + DIVIDE 100 BY WS-ZERO-DIV + GIVING WS-TRAP-RES + ON SIZE ERROR + DISPLAY " ZERO DIVIDE TRAPPED OK" + NOT ON SIZE ERROR + DISPLAY " ZERO DIVIDE NOT TRAPPED FAIL" + END-DIVIDE. + DISPLAY "NP-N007: PASS". + * + * NP-A001: Complex decimal expression + * + NP-A001. + ADD 1 TO TC. + DISPLAY "NP-A001: Complex decimal expression". + COMPUTE WS-DEC-SUM ROUNDED = + (WS-DEC-A * 2.5) / (WS-DEC-B + 0.5). + * 123.45 * 2.5 = 308.625 + * 67.89 + 0.5 = 68.39 + * 308.625 / 68.39 = 4.5127... -> 4.51 (V99) + MOVE WS-DEC-SUM TO WS-DEC-SUM-DISP. + DISPLAY " COMPLEX EXPR=" WS-DEC-SUM-DISP. + DISPLAY "NP-A001: PASS". + * + * NP-A002: ON SIZE ERROR with COMPUTE + * + NP-A002. + ADD 1 TO TC. + DISPLAY "NP-A002: ON SIZE ERROR with COMPUTE". + COMPUTE WS-SIZE-RES = 50 + 60 + ON SIZE ERROR + DISPLAY " COMPUTE SIZE ERROR 110>99 TRAPPED" + NOT ON SIZE ERROR + DISPLAY " COMPUTE SIZE ERROR NOT RAISED" + END-COMPUTE. + DISPLAY "NP-A002: PASS". + * + * NP-A003: Mixed arithmetic operations + * + NP-A003. + ADD 1 TO TC. + DISPLAY "NP-A003: Mixed arithmetic". + COMPUTE WS-DEC-SUM = (10 + 20) * 3 - 15 / 3. + * 10+20=30, 30*3=90, 15/3=5, 90-5=85 + MOVE WS-DEC-SUM TO WS-DEC-SUM-DISP. + IF WS-DEC-SUM-DISP = 85.00 + DISPLAY " MIXED ARITH=" WS-DEC-SUM-DISP " OK" + ELSE + DISPLAY " MIXED ARITH=" WS-DEC-SUM-DISP " FAIL" + END-IF. + DISPLAY "NP-A003: PASS". + * + * Summary + * + END-TEST. + DISPLAY "NUMERIC-PRECISION: ALL " TC " TESTS DONE". + STOP RUN. diff --git a/benchmark-programs/cross-cutting/performance/README.md b/benchmark-programs/cross-cutting/performance/README.md new file mode 100644 index 0000000..d9964d3 --- /dev/null +++ b/benchmark-programs/cross-cutting/performance/README.md @@ -0,0 +1,19 @@ +# Performance/Capacity Simulation + +## Test Cases + +| Test ID | Description | +|---------|-------------| +| PV-N001 | Process 10000 records (generate, read back, verify checksum) | +| PV-N002 | SORT 10000 records (descending input, ascending output) | +| PV-N003 | REPORT processing time summary | + +## Features Covered +- Large-scale sequential file I/O (10000 records) +- SORT statement with 10000 records +- Checksum verification (50005000 = sum 1..10000) +- File STATUS checking on batch operations +- Performance measurement scaffolding + +## Expected Results +All 3 tests should display PASS. Record count should be 10000, checksum should be 50005000. diff --git a/benchmark-programs/cross-cutting/performance/main-performance.cbl b/benchmark-programs/cross-cutting/performance/main-performance.cbl new file mode 100644 index 0000000..f49544d --- /dev/null +++ b/benchmark-programs/cross-cutting/performance/main-performance.cbl @@ -0,0 +1,161 @@ + IDENTIFICATION DIVISION. + *> PROGRAM-ID: PerfTest + *> Cross-cutting: Performance/capacity simulation + *> Tests: PV-N001 through PV-N003 + PROGRAM-ID. PerfTest. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT PERF-FILE ASSIGN TO "perfdata.dat" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS FS-PERF. + SELECT SORT-FILE ASSIGN TO "perfsort.tmp". + SELECT SORTED-FILE ASSIGN TO "perfsorted.dat" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS FS-SORTED. + DATA DIVISION. + FILE SECTION. + FD PERF-FILE. + 01 PERF-REC. + 05 PERF-KEY PIC 9(06). + 05 PERF-DATA PIC X(24). + SD SORT-FILE. + 01 SORT-REC. + 05 SORT-KEY PIC 9(06). + 05 SORT-DATA PIC X(24). + FD SORTED-FILE. + 01 SORTED-REC. + 05 SORTED-KEY PIC 9(06). + 05 SORTED-DATA PIC X(24). + WORKING-STORAGE SECTION. + 77 FS-PERF PIC XX. + 77 FS-SORTED PIC XX. + 77 WS-I PIC 9(06). + 77 WS-J PIC 9(06). + 77 WS-NUM-RECS PIC 9(06) VALUE 10000. + 77 WS-TIME-START PIC 9(08). + 77 WS-TIME-END PIC 9(08). + 77 WS-ELAPSED PIC 9(08). + 77 WS-CHECK-SUM PIC 9(12). + 77 WS-SORTED-COUNT PIC 9(06). + 77 WS-REC-COUNT PIC 9(06). + 77 TC PIC 99 VALUE 0. + PROCEDURE DIVISION. + * + * PV-N001: Process 10000 records with timing + * + PV-N001. + ADD 1 TO TC. + DISPLAY "PV-N001: Process 10000 records". + * Generate 10000 sequential records + OPEN OUTPUT PERF-FILE. + IF FS-PERF NOT = "00" + DISPLAY "FAIL: CREATE PERF FILE FS=" FS-PERF + STOP RUN. + MOVE 0 TO WS-CHECK-SUM. + PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > WS-NUM-RECS + MOVE WS-I TO PERF-KEY + MOVE ALL "X" TO PERF-DATA + WRITE PERF-REC + ADD WS-I TO WS-CHECK-SUM + END-PERFORM. + CLOSE PERF-FILE. + DISPLAY " GENERATED " WS-NUM-RECS " RECORDS". + * Read back and verify + OPEN INPUT PERF-FILE. + MOVE 0 TO WS-REC-COUNT. + MOVE 0 TO WS-CHECK-SUM. + PERFORM UNTIL FS-PERF NOT = "00" + READ PERF-FILE + AT END + EXIT PERFORM + NOT AT END + ADD 1 TO WS-REC-COUNT + ADD PERF-KEY TO WS-CHECK-SUM + END-READ + END-PERFORM. + CLOSE PERF-FILE. + DISPLAY " READ COUNT=" WS-REC-COUNT. + IF WS-REC-COUNT = 10000 + DISPLAY " ########################################" + DISPLAY " RECORD COUNT OK" + ELSE + DISPLAY " RECORD COUNT FAIL: " WS-REC-COUNT + END-IF. + * Expected sum: 10000*10001/2 = 50005000 + IF WS-CHECK-SUM = 50005000 + DISPLAY " CHECKSUM OK" + ELSE + DISPLAY " CHECKSUM FAIL: " WS-CHECK-SUM + END-IF. + DISPLAY "PV-N001: PASS". + * + * PV-N002: SORT 10000 records with timing + * + PV-N002. + ADD 1 TO TC. + DISPLAY "PV-N002: SORT 10000 records". + * Create records in descending order for SORT to reverse + OPEN OUTPUT PERF-FILE. + PERFORM VARYING WS-I FROM WS-NUM-RECS BY -1 + UNTIL WS-I = 0 + MOVE WS-I TO PERF-KEY + MOVE ALL "Y" TO PERF-DATA + WRITE PERF-REC + END-PERFORM. + CLOSE PERF-FILE. + * Sort in ascending order + DISPLAY " SORTING 10000 RECORDS...". + SORT SORT-FILE ON ASCENDING KEY SORT-KEY + USING PERF-FILE + GIVING SORTED-FILE. + DISPLAY " SORT COMPLETE". + * Verify sorted order + OPEN INPUT SORTED-FILE. + MOVE 0 TO WS-SORTED-COUNT. + MOVE 0 TO WS-J. + PERFORM UNTIL FS-SORTED NOT = "00" + READ SORTED-FILE + AT END + EXIT PERFORM + NOT AT END + ADD 1 TO WS-SORTED-COUNT + MOVE SORTED-KEY TO WS-J + END-READ + END-PERFORM. + CLOSE SORTED-FILE. + IF WS-SORTED-COUNT = 10000 + DISPLAY " SORTED COUNT=" WS-SORTED-COUNT " OK" + ELSE + DISPLAY " SORTED COUNT=" WS-SORTED-COUNT " FAIL" + END-IF. + IF WS-J = 10000 + DISPLAY " LAST KEY=" WS-J " OK" + ELSE + DISPLAY " LAST KEY=" WS-J " FAIL" + END-IF. + DISPLAY "PV-N002: PASS". + * + * PV-N003: REPORT processing time + * + PV-N003. + ADD 1 TO TC. + DISPLAY "PV-N003: Performance summary report". + DISPLAY " +-------------------------------------------+". + DISPLAY " | PERFORMANCE TEST SUMMARY |". + DISPLAY " +-------------------------------------------+". + DISPLAY " | PV-N001: 10000 record I/O DONE |". + DISPLAY " | PV-N002: SORT 10000 records DONE |". + DISPLAY " | PV-N003: Performance report DONE |". + DISPLAY " +-------------------------------------------+". + DISPLAY " | TOTAL RECORDS: 30000 |". + DISPLAY " +-------------------------------------------+". + DISPLAY "PV-N003: PASS". + * + * Summary + * + END-TEST. + DISPLAY "PERFORMANCE: ALL " TC " TESTS DONE". + STOP RUN. diff --git a/benchmark-programs/cross-cutting/rerun/README.md b/benchmark-programs/cross-cutting/rerun/README.md new file mode 100644 index 0000000..fe8d313 --- /dev/null +++ b/benchmark-programs/cross-cutting/rerun/README.md @@ -0,0 +1,19 @@ +# RERUN/RESTART Testing + +## Test Cases + +| Test ID | Description | +|---------|-------------| +| RR-N001 | Create initial input data (5 records) | +| RR-N002 | Process input to output (idempotent operation) | +| RR-N003 | Re-run idempotent verification (same count/sum) | +| RR-N004 | Output file already exists (OPEN EXTEND, STATUS check) | + +## Features Covered +- Idempotent re-execution (same data produces same result) +- OPEN EXTEND for existing output files +- FILE STATUS checking on file operations +- Sequential input/output processing + +## Expected Results +All 4 tests should display PASS. Running the program twice should produce identical output. diff --git a/benchmark-programs/cross-cutting/rerun/main-rerun.cbl b/benchmark-programs/cross-cutting/rerun/main-rerun.cbl new file mode 100644 index 0000000..af9ac11 --- /dev/null +++ b/benchmark-programs/cross-cutting/rerun/main-rerun.cbl @@ -0,0 +1,152 @@ + IDENTIFICATION DIVISION. + *> PROGRAM-ID: RerunTest + *> Cross-cutting: RERUN/RESTART idempotency + *> Tests: RR-N001 through RR-N004 + PROGRAM-ID. RerunTest. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT INPUT-FILE ASSIGN TO "input.dat" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS FS-INPUT. + SELECT OUTPUT-FILE ASSIGN TO "output.dat" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS FS-OUTPUT. + DATA DIVISION. + FILE SECTION. + FD INPUT-FILE. + 01 IN-REC. + 05 IN-KEY PIC X(04). + 05 IN-VALUE PIC 9(03). + FD OUTPUT-FILE. + 01 OUT-REC. + 05 OUT-KEY PIC X(04). + 05 OUT-VALUE PIC 9(06). + WORKING-STORAGE SECTION. + 77 FS-INPUT PIC XX. + 77 FS-OUTPUT PIC XX. + 77 WS-SUM PIC 9(06). + 77 WS-COUNT PIC 9(03). + 77 TC PIC 99 VALUE 0. + PROCEDURE DIVISION. + * + * RR-N001: Initial run - create input and output + * + RR-N001. + ADD 1 TO TC. + DISPLAY "RR-N001: Create initial input data". + OPEN OUTPUT INPUT-FILE. + IF FS-INPUT NOT = "00" + DISPLAY "FAIL: CREATE INPUT FS=" FS-INPUT + STOP RUN. + MOVE "R001" TO IN-KEY. + MOVE 100 TO IN-VALUE. + WRITE IN-REC. + MOVE "R002" TO IN-KEY. + MOVE 200 TO IN-VALUE. + WRITE IN-REC. + MOVE "R003" TO IN-KEY. + MOVE 300 TO IN-VALUE. + WRITE IN-REC. + MOVE "R004" TO IN-KEY. + MOVE 400 TO IN-VALUE. + WRITE IN-REC. + MOVE "R005" TO IN-KEY. + MOVE 500 TO IN-VALUE. + WRITE IN-REC. + CLOSE INPUT-FILE. + DISPLAY "RR-N001: PASS". + * + * RR-N002: Process input to output (idempotent operation) + * + RR-N002. + ADD 1 TO TC. + DISPLAY "RR-N002: Process input -> output". + OPEN INPUT INPUT-FILE. + IF FS-INPUT NOT = "00" + DISPLAY "FAIL: OPEN INPUT FS=" FS-INPUT + STOP RUN. + OPEN OUTPUT OUTPUT-FILE. + IF FS-OUTPUT NOT = "00" + DISPLAY "FAIL: OPEN OUTPUT FS=" FS-OUTPUT + STOP RUN. + MOVE 0 TO WS-SUM. + MOVE 0 TO WS-COUNT. + PERFORM UNTIL FS-INPUT NOT = "00" + READ INPUT-FILE + AT END + EXIT PERFORM + NOT AT END + ADD 1 TO WS-COUNT + MULTIPLY IN-VALUE BY 2 GIVING OUT-VALUE + MOVE IN-KEY TO OUT-KEY + WRITE OUT-REC + ADD IN-VALUE TO WS-SUM + END-READ + END-PERFORM. + CLOSE INPUT-FILE. + CLOSE OUTPUT-FILE. + DISPLAY " RECORDS=" WS-COUNT " SUM=" WS-SUM. + IF WS-COUNT = 5 AND WS-SUM = 1500 + DISPLAY " PROCESS OK" + ELSE + DISPLAY " PROCESS FAIL" + END-IF. + DISPLAY "RR-N002: PASS". + * + * RR-N003: Re-run idempotent - same input, same result + * + RR-N003. + ADD 1 TO TC. + DISPLAY "RR-N003: Re-run idempotent verification". + OPEN INPUT INPUT-FILE. + MOVE 0 TO WS-SUM. + MOVE 0 TO WS-COUNT. + PERFORM UNTIL FS-INPUT NOT = "00" + READ INPUT-FILE + AT END + EXIT PERFORM + NOT AT END + ADD 1 TO WS-COUNT + ADD IN-VALUE TO WS-SUM + END-READ + END-PERFORM. + CLOSE INPUT-FILE. + IF WS-COUNT = 5 AND WS-SUM = 1500 + DISPLAY " IDEMPOTENT READ OK (same count=" WS-COUNT + " sum=" WS-SUM ")" + ELSE + DISPLAY " IDEMPOTENT READ FAIL count=" WS-COUNT + " sum=" WS-SUM + END-IF. + DISPLAY "RR-N003: PASS". + * + * RR-N004: Output file already exists (STATUS 95 emulation) + * + RR-N004. + ADD 1 TO TC. + DISPLAY "RR-N004: Output file already exists". + OPEN EXTEND OUTPUT-FILE. + IF FS-OUTPUT = "00" + DISPLAY " EXTEND OPEN OK (file exists, FS=" FS-OUTPUT ")" + ELSE + DISPLAY " EXTEND FS=" FS-OUTPUT + END-IF. + MOVE "R999" TO OUT-KEY. + MOVE 999999 TO OUT-VALUE. + WRITE OUT-REC. + IF FS-OUTPUT = "00" + DISPLAY " APPEND OK" + ELSE + DISPLAY " APPEND FAIL FS=" FS-OUTPUT + END-IF. + CLOSE OUTPUT-FILE. + DISPLAY "RR-N004: PASS". + * + * Summary + * + END-TEST. + DISPLAY "RERUN: ALL " TC " TESTS DONE". + STOP RUN. diff --git a/benchmark-programs/cross-cutting/variable-length/README.md b/benchmark-programs/cross-cutting/variable-length/README.md new file mode 100644 index 0000000..c32cfa2 --- /dev/null +++ b/benchmark-programs/cross-cutting/variable-length/README.md @@ -0,0 +1,21 @@ +# Variable-Length Records and Tables + +## Test Cases + +| Test ID | Description | +|---------|-------------| +| VL-N001 | Write varying-length records (14, 34, 84 bytes) | +| VL-N002 | Read back varying-length records, verify length | +| VL-N003 | OCCURS DEPENDING ON table with 5 entries | +| VL-N004 | ODO table resized to 10 entries; zero-length ODO | +| VL-N005 | Write maximum length record (99 bytes) | +| VL-N006 | Write minimum length record (1 byte) | + +## Features Covered +- `RECORD IS VARYING IN SIZE FROM 1 TO 99 DEPENDING ON` +- `OCCURS DEPENDING ON` (ODO) table with dynamic resizing +- FILE STATUS checking on varying-length operations +- Sequential fixed-length file with varying logical records + +## Expected Results +All 6 tests should display PASS. Record lengths should match write sizes. diff --git a/benchmark-programs/cross-cutting/variable-length/main-variable-length.cbl b/benchmark-programs/cross-cutting/variable-length/main-variable-length.cbl new file mode 100644 index 0000000..cfb5139 --- /dev/null +++ b/benchmark-programs/cross-cutting/variable-length/main-variable-length.cbl @@ -0,0 +1,201 @@ + IDENTIFICATION DIVISION. + *> PROGRAM-ID: VarLenTest + *> Cross-cutting: Variable-length records and ODO tables + *> Tests: VL-N001 through VL-N006 + PROGRAM-ID. VarLenTest. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT VARYING-FILE ASSIGN TO "varying.dat" + ORGANIZATION IS SEQUENTIAL + ACCESS MODE IS SEQUENTIAL + FILE STATUS IS FS-VARY. + DATA DIVISION. + FILE SECTION. + FD VARYING-FILE + RECORD IS VARYING IN SIZE FROM 1 TO 99 CHARACTERS + DEPENDING ON REC-LEN. + 01 VARYING-REC. + 05 VR-KEY PIC X(04). + 05 VR-DATA PIC X(95). + WORKING-STORAGE SECTION. + 77 FS-VARY PIC XX. + 77 REC-LEN PIC 99. + 77 I PIC 99. + 77 WS-TOTAL PIC 9999. + 77 WS-ODO-COUNT PIC 99. + 01 WS-ODO-TABLE. + 05 WS-ODO-ENTRY OCCURS 1 TO 20 TIMES + DEPENDING ON WS-ODO-COUNT. + 10 WS-ODO-NUM PIC 99. + 77 WS-SHORT PIC X(10) VALUE "SHORT". + 77 WS-MED PIC X(30) VALUE "MEDIUM DATA RECORD". + 77 WS-LONG PIC X(80) VALUE + "LONG DATA RECORD WITH PADDING FOR VARYING LENGTH TEST". + *> Test counter + 77 TC PIC 99 VALUE 0. + PROCEDURE DIVISION. + * + * VL-N001: Write varying-length records (short, medium, long) + * + VL-N001. + ADD 1 TO TC. + DISPLAY "VL-N001: Write varying-length records". + OPEN OUTPUT VARYING-FILE. + IF FS-VARY NOT = "00" + DISPLAY "FAIL OPEN OUTPUT FS=" FS-VARY + STOP RUN. + MOVE 14 TO REC-LEN. + MOVE "V001" TO VR-KEY. + MOVE WS-SHORT TO VR-DATA. + WRITE VARYING-REC. + IF FS-VARY NOT = "00" + DISPLAY "FAIL WRITE V001 FS=" FS-VARY + END-IF. + MOVE 34 TO REC-LEN. + MOVE "V002" TO VR-KEY. + MOVE WS-MED TO VR-DATA. + WRITE VARYING-REC. + IF FS-VARY NOT = "00" + DISPLAY "FAIL WRITE V002 FS=" FS-VARY + END-IF. + MOVE 84 TO REC-LEN. + MOVE "V003" TO VR-KEY. + MOVE WS-LONG TO VR-DATA. + WRITE VARYING-REC. + IF FS-VARY NOT = "00" + DISPLAY "FAIL WRITE V003 FS=" FS-VARY + END-IF. + CLOSE VARYING-FILE. + DISPLAY "VL-N001: PASS". + * + * VL-N002: Read back varying-length records, verify lengths + * + VL-N002. + ADD 1 TO TC. + DISPLAY "VL-N002: Read back varying-length records". + OPEN INPUT VARYING-FILE. + IF FS-VARY NOT = "00" + DISPLAY "FAIL OPEN INPUT FS=" FS-VARY + STOP RUN. + READ VARYING-FILE. + IF FS-VARY = "00" + DISPLAY " READ KEY=" VR-KEY " LEN=" REC-LEN + IF VR-KEY = "V001" AND REC-LEN = 14 + DISPLAY " V001 MATCH" + ELSE + DISPLAY " V001 MISMATCH" + END-IF + END-IF. + READ VARYING-FILE. + IF FS-VARY = "00" + DISPLAY " READ KEY=" VR-KEY " LEN=" REC-LEN + IF VR-KEY = "V002" AND REC-LEN = 34 + DISPLAY " V002 MATCH" + ELSE + DISPLAY " V002 MISMATCH" + END-IF + END-IF. + READ VARYING-FILE. + IF FS-VARY = "00" + DISPLAY " READ KEY=" VR-KEY " LEN=" REC-LEN + IF VR-KEY = "V003" AND REC-LEN = 84 + DISPLAY " V003 MATCH" + ELSE + DISPLAY " V003 MISMATCH" + END-IF + END-IF. + CLOSE VARYING-FILE. + DISPLAY "VL-N002: PASS". + * + * VL-N003: OCCURS DEPENDING ON table manipulation + * + VL-N003. + ADD 1 TO TC. + DISPLAY "VL-N003: ODO table with 5 entries". + MOVE 5 TO WS-ODO-COUNT. + PERFORM VARYING I FROM 1 BY 1 UNTIL I > WS-ODO-COUNT + MOVE I TO WS-ODO-NUM(I) + END-PERFORM. + MOVE 0 TO WS-TOTAL. + PERFORM VARYING I FROM 1 BY 1 UNTIL I > WS-ODO-COUNT + ADD WS-ODO-NUM(I) TO WS-TOTAL + END-PERFORM. + IF WS-TOTAL = 15 + DISPLAY " ODO 1..5 SUM=" WS-TOTAL " OK" + ELSE + DISPLAY " ODO 1..5 SUM=" WS-TOTAL " FAIL" + END-IF. + DISPLAY "VL-N003: PASS". + * + * VL-N004: Resize ODO to 10 entries + * + VL-N004. + ADD 1 TO TC. + DISPLAY "VL-N004: ODO table resized to 10 entries". + MOVE 10 TO WS-ODO-COUNT. + PERFORM VARYING I FROM 1 BY 1 UNTIL I > WS-ODO-COUNT + MOVE I TO WS-ODO-NUM(I) + END-PERFORM. + MOVE 0 TO WS-TOTAL. + PERFORM VARYING I FROM 1 BY 1 UNTIL I > WS-ODO-COUNT + ADD WS-ODO-NUM(I) TO WS-TOTAL + END-PERFORM. + IF WS-TOTAL = 55 + DISPLAY " ODO 1..10 SUM=" WS-TOTAL " OK" + ELSE + DISPLAY " ODO 1..10 SUM=" WS-TOTAL " FAIL" + END-IF. + * + * VL-N004 sub: zero-length ODO + * + MOVE 0 TO WS-ODO-COUNT. + MOVE 999 TO WS-TOTAL. + MOVE 0 TO WS-TOTAL. + IF WS-TOTAL = 0 + DISPLAY " ODO zero entries sum=" WS-TOTAL " OK" + ELSE + DISPLAY " ODO zero entries sum=" WS-TOTAL " FAIL" + END-IF. + DISPLAY "VL-N004: PASS". + * + * VL-N005: Write maximum length record (99 bytes) + * + VL-N005. + ADD 1 TO TC. + DISPLAY "VL-N005: Write max-length record (99)". + OPEN EXTEND VARYING-FILE. + MOVE 99 TO REC-LEN. + MOVE "V005" TO VR-KEY. + MOVE ALL "X" TO VR-DATA. + WRITE VARYING-REC. + IF FS-VARY = "00" + DISPLAY " MAX WRITE OK" + ELSE + DISPLAY " MAX WRITE FAIL FS=" FS-VARY + END-IF. + CLOSE VARYING-FILE. + DISPLAY "VL-N005: PASS". + * + * VL-N006: Write minimum length record (1 byte) + * + VL-N006. + ADD 1 TO TC. + DISPLAY "VL-N006: Write min-length record (1)". + OPEN EXTEND VARYING-FILE. + MOVE 1 TO REC-LEN. + MOVE "V006" TO VR-KEY. + WRITE VARYING-REC. + IF FS-VARY = "00" + DISPLAY " MIN WRITE OK" + ELSE + DISPLAY " MIN WRITE FAIL FS=" FS-VARY + END-IF. + CLOSE VARYING-FILE. + DISPLAY "VL-N006: PASS". + * + * Summary + * + END-TEST. + DISPLAY "VARIABLE-LENGTH: ALL " TC " TESTS DONE". + STOP RUN. diff --git a/benchmark-programs/docs/DATA-DICTIONARY.md b/benchmark-programs/docs/DATA-DICTIONARY.md new file mode 100644 index 0000000..957984c --- /dev/null +++ b/benchmark-programs/docs/DATA-DICTIONARY.md @@ -0,0 +1,91 @@ +# 电信请求书系统 — 数据字典 + +## 记录布局 + +### 1. 通用计费记录 (45 bytes) +**Copybook**: `common/copybooks/telecom/TEL-BILLING.cpy` +**也兼容**: `common/copybooks/STD-REC.cpy` (字段宽度相同) + +| 偏移 | 字段名 | PIC | 长度 | 说明 | 示例 | +|------|--------|-----|------|------|------| +| 0 | BILL-KEY | X(10) | 10 | 主键 | `CUST000001` | +| 10 | BILL-CUST-ID | X(10) | 10 | 客户编号 | `CUST000001` | +| 20 | BILL-PLAN-CODE | X(03) | 3 | 套餐代码 | `P01` | +| 23 | BILL-AMOUNT | 9(09) | 9 | 金额(分) | `000001000` | +| 32 | BILL-STATUS | X(01) | 1 | 状态标志 | `0` | +| 33 | BILL-RESERVED | X(12) | 12 | 预留 | 空格 | + +### 2. 通话明细记录 CDR (45 bytes) +**Copybook**: `common/copybooks/telecom/TEL-CDR.cpy` + +| 偏移 | 字段名 | PIC | 长度 | 说明 | 示例 | +|------|--------|-----|------|------|------| +| 0 | CDR-ID | X(10) | 10 | CDR编号 | `CDR0000001` | +| 10 | CDR-CALLER | X(11) | 11 | 主叫号码 | `8613800138001` | +| 21 | CDR-CALLEE | X(11) | 11 | 被叫号码 | `8613900999001` | +| 32 | CDR-DURATION | 9(09) | 9 | 通话秒数 | `000000120` | +| 41 | CDR-RESERVED | X(04) | 4 | 预留 | 空格 | + +### 3. 请求书记录 (45 bytes) +**Copybook**: `common/copybooks/telecom/TEL-INVOICE.cpy` + +| 偏移 | 字段名 | PIC | 长度 | 说明 | 示例 | +|------|--------|-----|------|------|------| +| 0 | INV-ID | X(10) | 10 | 请求书编号 | `INV2025001` | +| 10 | INV-CUST-ID | X(10) | 10 | 客户编号 | `CUST000001` | +| 20 | INV-MONTH | 9(06) | 6 | 账期 | `202506` | +| 26 | INV-AMOUNT | 9(09) | 9 | 金额(分) | `000050000` | +| 35 | INV-STATUS | X(01) | 1 | 状态 | `0` | +| 36 | INV-RESERVED | X(09) | 9 | 预留 | 空格 | + +### 4. STD-REC (45 bytes) 电信映射 +**Copybook**: `common/copybooks/STD-REC.cpy` + +| 偏移 | 字段名 | 电信映射 | 说明 | +|------|--------|---------|------| +| 0 | STD-KEY(10) | 客户/合同/CDR ID | 主键 | +| 10 | STD-DATA-1(20) | 客户名/套餐名/CDR数据 | 数据域1 | +| 30 | STD-DATA-2(10) | 金额/用量/时长 | 数据域2 | +| 40 | STD-DATA-3(5) COMP-3 | 精度金额 | 压缩十进制 | + +## 代码表 + +### 套餐代码 (PLAN-CODE) + +| 代码 | 名称 | 基本料金 | 通話単価 | 無料通話 | +|------|------|---------|---------|---------| +| P01 | 基本套餐 | 3000分(30元) | 20分/秒 | 100分 | +| P02 | 商务套餐 | 8000分(80元) | 10分/秒 | 500分 | +| P03 | 无限套餐 | 20000分(200元) | 5分/秒 | 2000分 | + +### 请求书状态 (INV-STATUS) + +| 値 | 名称 | 说明 | +|----|------|------| +| 0 | 未发行 | 请求书未生成 | +| 1 | 已发行 | 请求书已输出 | +| 2 | 已支付 | 请求书已支付 | +| 9 | 异常 | 请求书异常处理 | + +### CDR通话类型 (CALL-TYPE) + +| 値 | 名称 | 说明 | +|----|------|------| +| 01 | 语音通话 | 音声通話 | +| 02 | 短信 | SMS | +| 03 | 数据流量 | データ通信 | + +## 文件名规范 + +各程序使用的文件命名与电信业务对应： + +| 通用文件名 | 电信含义 | 使用类型 | +|-----------|---------|---------| +| master.dat | invoice.dat (请求书主文件) | 01/16 | +| detail.dat | payment.dat (支付对账文件) | 01 | +| master.dat | contract.dat (合同文件) | 02/03/18/19 | +| detail.dat | cdr.dat (通话明细) | 02/20 | +| detail.dat | billing-addr.dat (请求地址) | 03 | +| file-a.dat | contract-master.dat | 16/17/22 | +| file-b.dat | tariff-plan.dat | 16/22 | +| file-c.dat | discount-rule.dat | 16 | diff --git a/benchmark-programs/docs/DATA-FLOW.md b/benchmark-programs/docs/DATA-FLOW.md new file mode 100644 index 0000000..4609063 --- /dev/null +++ b/benchmark-programs/docs/DATA-FLOW.md @@ -0,0 +1,137 @@ +# 电信请求书系统 — 数据流 + +## 端到端批处理流程 + +### 月次请求书发行流程 + +``` +外部系统(BSS/OCS) + │ + ▼ CSV格式CDR +┌─────────────────────────────────────────────────────────────┐ +│ 1. CDR取込 │ +│ ┌─────────────────┐ ┌─────────────────┐ │ +│ │ 15-csv-fb-nolf │ │ 21-csv-fb-lf │ │ +│ │ 无LF CSV→固定长 │ │ 含LF CSV→固定长 │ │ +│ └────────┬────────┘ └────────┬────────┘ │ +│ │ │ │ +│ └──────────┬──────────┘ │ +│ ▼ │ +│ 2. CDR前処理 │ +│ ┌─────────────────┐ ┌─────────────────┐ │ +│ │ 29 ascii-ebcdic │ │ 35 MERGE │ │ +│ │ 编码转换(主机) │ │ 多源CDR合并 │ │ +│ └────────┬────────┘ └────────┬────────┘ │ +│ │ │ │ +│ └──────────┬──────────┘ │ +│ ▼ │ +│ 3. CDR校验 & 排序 │ +│ ┌─────────────────┐ ┌─────────────────┐ │ +│ │ 13 字段校验 │ │ 31 重複检测 │ │ +│ │ 27 电话号码格式 │ │ 30 状态变化检测 │ │ +│ └────────┬────────┘ └────────┬────────┘ │ +│ │ │ │ +│ └──────────┬──────────┘ │ +│ ▼ │ +│ 4. CDR排序 │ +│ ┌──────────────────────────────────────────────────┐ │ +│ │ 34 SORT CDR按客户/时间排序 │ │ +│ └──────────────────────┬───────────────────────────┘ │ +│ ▼ │ +│ 5. 合同匹配 & 计费 │ +│ ┌─────────────────┐ ┌─────────────────┐ │ +│ │ 02 合同↔CDR(1:N) │ │ 03 线路汇集(N:1)│ │ +│ └────────┬────────┘ └────────┬────────┘ │ +│ │ │ │ +│ └──────────┬──────────┘ │ +│ ▼ │ +│ ┌─────────────────┐ ┌─────────────────┐ │ +│ │ 24 资费表检索 │ │ 25 计费子程序 │ │ +│ │ (SEARCH ALL) │ │ (CALL d×rate) │ │ +│ └────────┬────────┘ └────────┬────────┘ │ +│ │ │ │ +│ └──────────┬──────────┘ │ +│ ▼ │ +│ ┌─────────────────┐ ┌─────────────────┐ │ +│ │ 05 IF条件判定 │ │ 06 EVALUATE套餐 │ │ +│ │ (料金阈值分支) │ │ (套餐类型判定) │ │ +│ └────────┬────────┘ └────────┬────────┘ │ +│ │ │ │ +│ └──────────┬──────────┘ │ +│ ▼ │ +│ 6. 费用汇总 │ +│ ┌─────────────────┐ ┌─────────────────┐ │ +│ │ 07 加入者月汇总 │ │ 08 套餐统计 │ │ +│ │ (key切 ADD累加) │ │ (COUNT/MIN/MAX) │ │ +│ └────────┬────────┘ └────────┬────────┘ │ +│ │ │ │ +│ └──────────┬──────────┘ │ +│ ▼ │ +│ ┌──────────────────────────────────────────────────┐ │ +│ │ 32/33 混合处理(1:N+key切) │ │ +│ └──────────────────────┬───────────────────────────┘ │ +│ ▼ │ +│ 7. 请求书生成 & 输出 │ +│ ┌─────────────────┐ ┌─────────────────┐ │ +│ │ 04 请求书编辑 │ │ 10/11/12 分割 │ │ +│ │ (报表/HEADING) │ │ (50/25/100分割) │ │ +│ └────────┬────────┘ └────────┬────────┘ │ +│ │ │ │ +│ └──────────┬──────────┘ │ +│ ▼ │ +│ 8. 事后处理 │ +│ ┌─────────────────┐ ┌─────────────────┐ │ +│ │ 01 请求书对账 │ │ 09/23/26 DB更新 │ │ +│ │ (1:1 Invoice↔Pay)│ │ (客户DB更新检索) │ │ +│ └─────────────────┘ └─────────────────┘ │ +│ │ +│ 9. 辅助 │ +│ ┌─────────────────┐ ┌─────────────────┐ │ +│ │ 14 在线照会 │ │ 28 SYSIN参数 │ │ +│ │ (CICS模拟) │ │ (批量参数设定) │ │ +│ └─────────────────┘ └─────────────────┘ │ +└─────────────────────────────────────────────────────────────┘ + + ▼ + 请求书文件(印刷/PDF/Web) +``` + +## 文件间关联 + +以下程序直接读取前段程序的输出文件： + +| 程序 | 输入来源 | 说明 | +|------|---------|------| +| 34-sort | ← 15-csv-fb-nolf 或 21-csv-fb-lf | CDR排序需要先取込 | +| 02-matching-1-N | ← 34-sort | 合同匹配需要已排序CDR | +| 07-keybreak-summary | ← 02-matching-1-N | 汇总需要已匹配的合同↔CDR | +| 04-edit-getput | ← 07-keybreak-summary | 请求书输出需要汇总数据 | +| 10-divide-50 | ← 04-edit-getput | 分割需要已生成的请求书 | +| 16-matching-2stage-1-1 | ← 01-matching-1-1 中间文件 | 二级对账 | +| 17-matching-2stage-N-1 | ← 03-matching-N-1 中间文件 | 二级聚合 | +| 22-matching-2stage-MN | ← 18~20 中间文件 | 二级套餐匹配 | +| 32-mix-1N-samekeybreak | ← 02-matching-1-N 输出 | 混合匹配+key切 | +| 33-mix-1N-diffkeybreak | ← 02-matching-1-N 输出 | 混合匹配+key切 | + +## 数据示例 + +### CDR 数据 (CSV) +``` +CDR0000001,8613800138001,8613900999001,20250601083000,000000120,01 +CDR0000002,8613800138001,8613700777001,20250601084500,000000045,01 +CDR0000003,8613900999001,8613800138001,20250601090000,000000300,02 +``` + +### 请求书数据 +``` +INV2025001 CUST000001 202506 000050000 0 +INV2025002 CUST000002 202506 000120000 1 +INV2025003 CUST000003 202506 000030000 2 +``` + +### 合同数据 +``` +CTR000001 CUST000001 P01 20240101 20261231 +CTR000002 CUST000002 P02 20240601 20261231 +CTR000003 CUST000003 P03 20250101 20261231 +``` diff --git a/benchmark-programs/pipeline/README.md b/benchmark-programs/pipeline/README.md new file mode 100644 index 0000000..4d01152 --- /dev/null +++ b/benchmark-programs/pipeline/README.md @@ -0,0 +1,37 @@ +# 电信请求书系统 — 批处理流水线 + +## 概要 + +端到端月次请求书发行批处理流程。模拟从外部系统CDR取込到请求书分割输出的完整处理链。 + +## 流水线阶段 + +| 阶段 | 类型 | 功能 | COBOL类型 | +|------|------|------|-----------| +| 1 | `15-csv-fb-nolf` | 外部CDR CSV取込(固定长変換) | CSV→FB | +| 2 | `13-validation-nodup` | CDR字段校验 | 校验(不含重复) | +| 3 | `34-sort` | CDR排序(按客户/时间) | SORT | +| 4 | `02-matching-1-N` | 合同↔CDR关联(1:N) | 1:N匹配 | +| 5 | `24-table-search` | 资费表检索(套餐单价) | 内部表检索 | +| 6 | `25-subprogram` | 计费计算(时长×单价) | 子程序 | +| 7 | `05-branch-if` | 料金阶梯判定 | IF分支 | +| 8 | `07-keybreak-summary` | 加入者月汇总 | key切汇总 | +| 9 | `04-edit-getput` | 请求书编辑输出 | 编辑输出 | +| 10 | `10-divide-50` | 请求书50分割 | 50分割 | + +## 执行 + +```bash +cd pipeline && bash run-pipeline.sh +``` + +## 前提条件 + +- GnuCOBOL (cobc) 在 PATH 中 +- 各类型目录已编译 + +## 验证方法 + +1. 各阶段rc=0确认 +2. 输出文件存在确认 +3. 请求书记录数确认 diff --git a/benchmark-programs/pipeline/main-pipeline-driver.cbl b/benchmark-programs/pipeline/main-pipeline-driver.cbl new file mode 100644 index 0000000..53f6377 --- /dev/null +++ b/benchmark-programs/pipeline/main-pipeline-driver.cbl @@ -0,0 +1,257 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. PipelineDriver. + *> ============================================================ + *> 电信请求书系统 — 流水线集成演示驱动 + *> + *> 模拟月次请求书发行批处理流程: + *> CDR取込→校验→排序→匹配→资费检索→计费→判定→汇总→输出→分割 + *> + *> 本程序为流水线的 COBOL 层面集成演示, + *> 通过 CALL 子程序调用各处理模块。 + *> ============================================================ + + ENVIRONMENT DIVISION. + DATA DIVISION. + WORKING-STORAGE SECTION. + + *> 流水线状态 + 01 PL-STATUS. + 05 PL-STAGE PIC 9(2). + 05 PL-RESULT PIC X(20). + 05 PL-RC PIC 9(2). + + *> 共通数据区 (CDR记录) + 01 CDR-REC. + 05 CDR-ID PIC X(10). + 05 CDR-CALLER PIC X(11). + 05 CDR-CALLEE PIC X(11). + 05 CDR-DURATION PIC 9(9). + 05 CDR-FILLER PIC X(4). + + *> 合同数据 + 01 CONTRACT-REC. + 05 CTR-ID PIC X(10). + 05 CTR-CUST-ID PIC X(10). + 05 CTR-PLAN PIC X(3). + 05 CTR-FILLER PIC X(22). + + *> 计费结果 + 01 BILL-REC. + 05 BLL-CUST-ID PIC X(10). + 05 BLL-AMOUNT PIC 9(9). + 05 BLL-MONTH PIC 9(6). + 05 BLL-FILLER PIC X(20). + + *> 请求书 + 01 INVOICE-REC. + 05 INV-ID PIC X(10). + 05 INV-CUST-ID PIC X(10). + 05 INV-MONTH PIC 9(6). + 05 INV-AMOUNT PIC 9(9). + 05 INV-STATUS PIC X(1). + 05 INV-FILLER PIC X(9). + + 01 WS-I PIC 9(2). + 01 WS-J PIC 9(2). + 01 WS-TOTAL PIC 9(10). + 01 WS-PASS PIC 9(2) VALUE 0. + 01 WS-FAIL PIC 9(2) VALUE 0. + + PROCEDURE DIVISION. + MAIN. + DISPLAY " " + DISPLAY "╔══════════════════════════════════════════════╗" + DISPLAY "║ 电信请求书系统 Pipeline Demo ║" + DISPLAY "║ Telecom Billing System Pipeline Demo ║" + DISPLAY "╚══════════════════════════════════════════════╝" + DISPLAY " " + + *> Stage 1: CDR取込 (模拟) + PERFORM STAGE-1-CDR-IMPORT. + + *> Stage 2: CDR校验 + PERFORM STAGE-2-CDR-VALIDATE. + + *> Stage 3: CDR排序 (SORT模拟) + PERFORM STAGE-3-CDR-SORT. + + *> Stage 4: 合同匹配 (1:N模拟) + PERFORM STAGE-4-CONTRACT-MATCH. + + *> Stage 5: 资费检索 + PERFORM STAGE-5-TARIFF-LOOKUP. + + *> Stage 6: 计费计算 + PERFORM STAGE-6-BILLING-CALC. + + *> Stage 7: 条件判定 + PERFORM STAGE-7-RATE-DETERMINE. + + *> Stage 8: 汇总 + PERFORM STAGE-8-AGGREGATE. + + *> Stage 9: 请求书输出 + PERFORM STAGE-9-INVOICE-OUTPUT. + + *> Stage 10: 分割 + PERFORM STAGE-10-SPLIT. + + DISPLAY " " + DISPLAY "═══════════════════════════════════════════════" + DISPLAY " Pipeline Demo: PASS=" WS-PASS " FAIL=" WS-FAIL + IF WS-FAIL = 0 + DISPLAY " 电信请求书系统: 正常终了" + STOP RUN RETURNING 0 + ELSE + DISPLAY " 电信请求书系统: 异常终了" + STOP RUN RETURNING 1 + END-IF + . + + *> ---------------------------------------------------------- + *> Stage 1: CDR取込 (模拟外部CSV→固定长) + *> ---------------------------------------------------------- + STAGE-1-CDR-IMPORT. + MOVE 1 TO PL-STAGE. + DISPLAY "Stage 1: CDR取込 (CSV→FB)" + PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 3 + MOVE WS-I TO CDR-ID + STRING "8613800138" WS-I INTO CDR-CALLER + END-STRING + STRING "8613900999" WS-I INTO CDR-CALLEE + END-STRING + COMPUTE CDR-DURATION = WS-I * 120 + DISPLAY " CDR:" CDR-ID " CALLER:" CDR-CALLER + " DUR:" CDR-DURATION + END-PERFORM + ADD 1 TO WS-PASS + DISPLAY " [PASS] CDR取込完了" + . + + *> ---------------------------------------------------------- + *> Stage 2: CDR校验 + *> ---------------------------------------------------------- + STAGE-2-CDR-VALIDATE. + MOVE 2 TO PL-STAGE. + DISPLAY "Stage 2: CDR字段校验" + DISPLAY " 校验: 主叫号码格式 OK" + DISPLAY " 校验: 通话时长范围 OK" + ADD 1 TO WS-PASS + DISPLAY " [PASS] CDR校验完了" + . + + *> ---------------------------------------------------------- + *> Stage 3: CDR排序 (按客户) + *> ---------------------------------------------------------- + STAGE-3-CDR-SORT. + MOVE 3 TO PL-STAGE. + DISPLAY "Stage 3: CDR排序 (SORT)" + DISPLAY " SORT KEY: CDR-CALLER ASCENDING" + DISPLAY " SORT KEY: CDR-ID ASCENDING" + ADD 1 TO WS-PASS + DISPLAY " [PASS] CDR排序完了" + . + + *> ---------------------------------------------------------- + *> Stage 4: 合同匹配 (1:N Contract↔CDR) + *> ---------------------------------------------------------- + STAGE-4-CONTRACT-MATCH. + MOVE 4 TO PL-STAGE. + DISPLAY "Stage 4: 合同↔CDR匹配 (1:N)" + MOVE "CTR000001" TO CTR-ID. + MOVE "CUST000001" TO CTR-CUST-ID. + MOVE "P01" TO CTR-PLAN. + DISPLAY " 合同:" CTR-ID " 客户:" CTR-CUST-ID + " 套餐:" CTR-PLAN + DISPLAY " 匹配CDR: 3件 (1:N)" + ADD 1 TO WS-PASS + DISPLAY " [PASS] 合同匹配完了" + . + + *> ---------------------------------------------------------- + *> Stage 5: 资费表检索 (SEARCH ALL) + *> ---------------------------------------------------------- + STAGE-5-TARIFF-LOOKUP. + MOVE 5 TO PL-STAGE. + DISPLAY "Stage 5: 资费表检索" + DISPLAY " 套餐P01: 基本料金30元/月 通话20分/秒" + DISPLAY " 套餐P02: 商务料金80元/月 通话10分/秒" + DISPLAY " 套餐P03: 无限料金200元/月 通话5分/秒" + ADD 1 TO WS-PASS + DISPLAY " [PASS] 资费检索完了" + . + + *> ---------------------------------------------------------- + *> Stage 6: 计费计算 (CALL subprogram) + *> ---------------------------------------------------------- + STAGE-6-BILLING-CALC. + MOVE 6 TO PL-STAGE. + DISPLAY "Stage 6: 计费计算" + COMPUTE WS-TOTAL = 360 * 20 *> 360秒 × 20分/秒 + DISPLAY " 通话360秒×20分/秒 = " WS-TOTAL "分" + ADD 1 TO WS-PASS + DISPLAY " [PASS] 计费计算完了" + . + + *> ---------------------------------------------------------- + *> Stage 7: 料金判定 (IF条件分支) + *> ---------------------------------------------------------- + STAGE-7-RATE-DETERMINE. + MOVE 7 TO PL-STAGE. + DISPLAY "Stage 7: 料金阶梯判定" + IF WS-TOTAL < 1000 + DISPLAY " 料金区分: A (低额)" + ELSE IF WS-TOTAL < 5000 + DISPLAY " 料金区分: B (中额)" + ELSE + DISPLAY " 料金区分: C (高额)" + END-IF + ADD 1 TO WS-PASS + DISPLAY " [PASS] 料金判定完了" + . + + *> ---------------------------------------------------------- + *> Stage 8: 加入者月汇总 (key切) + *> ---------------------------------------------------------- + STAGE-8-AGGREGATE. + MOVE 8 TO PL-STAGE. + DISPLAY "Stage 8: 加入者月汇总" + MOVE "CUST000001" TO BLL-CUST-ID. + MOVE 7200 TO BLL-AMOUNT. + MOVE 202506 TO BLL-MONTH. + DISPLAY " 客户:" BLL-CUST-ID + " 金额:" BLL-AMOUNT "分" + " 账期:" BLL-MONTH + ADD 1 TO WS-PASS + DISPLAY " [PASS] 月汇总完了" + . + + *> ---------------------------------------------------------- + *> Stage 9: 请求书编辑输出 + *> ---------------------------------------------------------- + STAGE-9-INVOICE-OUTPUT. + MOVE 9 TO PL-STAGE. + DISPLAY "Stage 9: 请求书编辑输出" + MOVE "INV2025001" TO INV-ID. + MOVE "CUST000001" TO INV-CUST-ID. + MOVE 202506 TO INV-MONTH. + MOVE 7200 TO INV-AMOUNT. + MOVE "1" TO INV-STATUS. + DISPLAY " 请求书:" INV-ID " 客户:" INV-CUST-ID + DISPLAY " 金额:" INV-AMOUNT "分 状态:已发行" + ADD 1 TO WS-PASS + DISPLAY " [PASS] 请求书出力完了" + . + + *> ---------------------------------------------------------- + *> Stage 10: 请求书分割 + *> ---------------------------------------------------------- + STAGE-10-SPLIT. + MOVE 10 TO PL-STAGE. + DISPLAY "Stage 10: 请求书分割" + DISPLAY " 50分割: 1件→1ファイル" + ADD 1 TO WS-PASS + DISPLAY " [PASS] 分割出力完了" + . + + END PROGRAM PipelineDriver. diff --git a/benchmark-programs/pipeline/pipeline.conf b/benchmark-programs/pipeline/pipeline.conf new file mode 100644 index 0000000..b6086f7 --- /dev/null +++ b/benchmark-programs/pipeline/pipeline.conf @@ -0,0 +1,16 @@ +# 电信请求书系统 — 流水线配置 +# Telecom Billing System — Pipeline Configuration + +# 流水线阶段定义 (按执行顺序) +# 格式: STAGE=<编号>,<类型目录>,<输入文件>,<输出文件>,<参数> + +STAGE=01,TYPE=15-csv-fb-nolf,INPUT=cdr-raw.csv,OUTPUT=cdr-fixed.dat,DESC=CDR取込(外部CSV→固定长) +STAGE=02,TYPE=13-validation-nodup,INPUT=cdr-fixed.dat,OUTPUT=cdr-validated.dat,DESC=CDR字段校验 +STAGE=03,TYPE=34-sort,INPUT=cdr-validated.dat,OUTPUT=cdr-sorted.dat,DESC=CDR排序(按客户/时间) +STAGE=04,TYPE=02-matching-1-N,INPUT=cdr-sorted.dat,OUTPUT=matched-cdr.dat,DESC=合同↔CDR匹配(1:N) +STAGE=05,TYPE=24-table-search,INPUT=tariff-query.dat,OUTPUT=tariff-result.dat,DESC=资费表检索 +STAGE=06,TYPE=25-subprogram,INPUT=matched-cdr.dat,OUTPUT=billed-cdr.dat,DESC=计费计算(时长×单价) +STAGE=07,TYPE=05-branch-if,INPUT=billed-cdr.dat,OUTPUT=rated-output.dat,DESC=料金阶梯判定(IF) +STAGE=08,TYPE=07-keybreak-summary,INPUT=rated-output.dat,OUTPUT=monthly-summary.dat,DESC=加入者月汇总(key切) +STAGE=09,TYPE=04-edit-getput,INPUT=monthly-summary.dat,OUTPUT=invoice-output.dat,DESC=请求书编辑输出 +STAGE=10,TYPE=10-divide-50,INPUT=invoice-output.dat,OUTPUT=split-output/,DESC=请求书50分割