NB-076
875 lines
34 KiB
COBOL
875 lines
34 KiB
COBOL
>>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
|
|
.
|