>>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 .