feat: add benchmark-programs — 58 telecom COBOL test programs
作为子目录纳入系统，与核心测试管道协同 Co-Authored-By: Claude <noreply@anthropic.com>
This commit is contained in:
NB-076
@@ -0,0 +1,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
|
||||
@@ -0,0 +1 @@
|
||||
0000000000
|
||||
@@ -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.
|
||||
Reference in New Issue
Block a user