feat: add benchmark-programs — 58 telecom COBOL test programs

作为子目录纳入系统,与核心测试管道协同

Co-Authored-By: Claude <noreply@anthropic.com>
This commit is contained in:
NB-076
2026-06-25 09:53:21 +08:00
parent 50f9f0f52f
commit 94400d50d4
278 changed files with 44125 additions and 0 deletions
@@ -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
.