Linux Notes: indexed-file-demo2.cob
- The information presented here is intended for educational use by qualified computer technologists.
- The information presented here is provided free of charge, as-is, with no warranty of any kind.
Back to: Linux Notes: GnuCOBOL
indexed-file-demo2.cob
- The following example was translated from DEC-BASIC to GnuCOBOL by Anthropic Claude in 2026.
- I intended to do it myself then decided to try one of the new A.I. utilities.
- The code:
*>================================================================================ *> title : bdb-indexed-demo-103.cob *> authors: Neil Rieck (program code - both DEC-BASIC and GnuCOBOL) *> Anthropic Claude (program translation) *> build : cobc -x -free bdb-indexed-demo-103.cob *> history: *> language ver who when what *> --------- --- --- ---------- -------------------------------------------------- *> DEC-BASIC 100 NSR 2002-08-29 1. original code *> DEC-BASIC 101 NSR 2005-01-24 1. cleanup for public view *> GnuCOBOL 102 AC 2026-10-07 1. translation from DEC-BASIC to GnuCOBOL *> GnuCOBOL 103 NSR 2026-10-07 1. cleanup for public view *> 2. changed all YN prompts to YNQ *> ------------------------------------------------------------------------------- *> purpose: My original intention was to produce an ISAM COBOL demo on Linux for a *> friend. So on 2026-10-07 I asked Anthopic Claude the following: *> "Please convert the following DEC-BASIC demo program to GnuCOBOL employing BDB. *> If at all possible, retain the RFA logic by using what the equivalent would be *> in BDB (Berkeley DB)". *> Claude did not properly implement RFA which "I think" should have employed *> DB_HEAP_RID (BDB only) or DB-CURRENT-RECORD-ID (vanilla COBOL) so this demo *> COBOL program only demonstrates the use of multiple keys. *>================================================================================ IDENTIFICATION DIVISION. PROGRAM-ID. DBD-INDEXED-DEMO-103. ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT demo-file ASSIGN TO "BDB-Indexed-Demo.dat" ORGANIZATION IS INDEXED ACCESS MODE IS DYNAMIC RECORD KEY IS d21-primary-key *> key #0 (unique) ALTERNATE RECORD KEY IS d21-last-name WITH DUPLICATES *> key #1 ALTERNATE RECORD KEY IS d21-telephone WITH DUPLICATES *> key #2 / #3 LOCK MODE IS MANUAL SHARING WITH ALL OTHER FILE STATUS IS ws-fs. DATA DIVISION. FILE SECTION. FD demo-file. *> A COBOL composite key must be contiguous, so the primary key fields *> (last, first, city) are grouped at the front of the 150-byte record. 01 demo-rec. 05 d21-primary-key. 10 d21-last-name PIC X(20). 10 d21-first-name PIC X(20). 10 d21-city PIC X(20). 05 d21-telephone PIC X(10). 05 d21-address PIC X(20). 05 d21-postal-code PIC X(10). 05 FILLER PIC X(50). *> room to grow WORKING-STORAGE SECTION. 01 k-program PIC X(20) VALUE "BDB-Indexed-Demo-103". 01 k-idx-fs PIC X(20) VALUE "BDB-Indexed-Demo.dat". 01 ws-line PIC X(30) VALUE ALL "=". 01 ws-dash PIC X(60) VALUE ALL "-". 01 ws-fs PIC XX VALUE "00". 01 ws-handler-err PIC XX VALUE "00". 01 ws-phase PIC X(3) VALUE SPACES. 01 ws-text PIC X(40) VALUE SPACES. 01 ws-prompt PIC X(70) VALUE SPACES. 01 ws-temp PIC 9(3). 01 ws-index PIC 9(3). 01 ws-length PIC 9(3). 01 ws-junk PIC X(80) VALUE SPACES. 01 ws-char PIC X. 01 ws-answer PIC X VALUE "N". 88 answer-yes VALUE "Y". 88 answer-no VALUE "N". 88 answer-quit VALUE "Q". 01 answer-choices PIC X(3) VALUE "YNQ". 01 ws-rec-count BINARY-LONG VALUE 0. 01 ws-rec-disp PIC Z(3)9. 01 ws-sleep-secs BINARY-LONG VALUE 1. *> the "RFA": the primary-key value of a record we want to come back to 01 ws-rfa PIC X(60) VALUE SPACES. 01 ws-save-rec PIC X(150) VALUE SPACES. 01 ws-found PIC X VALUE "N". 88 rec-found VALUE "Y". 01 ws-done PIC X VALUE "N". 88 all-done VALUE "Y". 01 ws-fname PIC X(60) VALUE SPACES. 01 ws-idx PIC 9 VALUE 0. PROCEDURE DIVISION. *>============================================================================== *> main *>============================================================================== main-2000. DISPLAY k-program DISPLAY ws-line *> <<< delete the test files >>> MOVE "OK to delete 'demo data files'?" TO ws-prompt PERFORM ask-ynq IF answer-quit GO TO sortie END-IF IF answer-yes *> BDB keeps one file for the primary key plus one per alternate key CALL "CBL_DELETE_FILE" USING k-idx-fs PERFORM VARYING ws-idx FROM 1 BY 1 UNTIL ws-idx > 2 MOVE SPACES TO ws-fname STRING FUNCTION TRIM(k-idx-fs) "." ws-idx DELIMITED BY SIZE INTO ws-fname CALL "CBL_DELETE_FILE" USING ws-fname END-PERFORM end-if. main-3000. *> <<< open the file >>> MOVE "OK to create/open 'demo data file'?" TO ws-prompt PERFORM ask-ynq IF answer-quit GO TO sortie END-IF. IF answer-yes DISPLAY "-i- opening file: " FUNCTION TRIM(k-idx-fs) MOVE "1" TO ws-phase OPEN I-O demo-file IF ws-fs = "35" *> doesn't exist: create it (BASIC does this) OPEN OUTPUT demo-file CLOSE demo-file OPEN I-O demo-file END-IF MOVE ws-fs TO ws-handler-err IF ws-fs NOT = "00" PERFORM show-error GO TO sortie END-IF END-IF. *> <<< write some records >>> main-4000. MOVE 0 TO ws-rec-count MOVE "OK to write 3 demo data records?" TO ws-prompt PERFORM ask-ynq IF answer-quit GO TO sortie END-IF IF answer-yes MOVE "2" TO ws-phase DISPLAY "-i- writing file: " FUNCTION TRIM(k-idx-fs) MOVE SPACES TO demo-rec MOVE "Ken" TO d21-first-name MOVE "Olsen" TO d21-last-name MOVE "4165553333" TO d21-telephone MOVE "129 Parker Street" TO d21-address MOVE "Toronto" TO d21-city *> this gets corrected below MOVE "01754" TO d21-postal-code PERFORM write-one MOVE SPACES TO demo-rec MOVE "Dave" TO d21-first-name MOVE "Cutler" TO d21-last-name MOVE "4165552222" TO d21-telephone MOVE "220 Simcoe Street" TO d21-address MOVE "Toronto" TO d21-city MOVE "M5T1T4" TO d21-postal-code PERFORM write-one MOVE SPACES TO demo-rec MOVE "Gordon" TO d21-first-name MOVE "Bell" TO d21-last-name MOVE "4165551111" TO d21-telephone MOVE "483 Bay Street" TO d21-address MOVE "Toronto" TO d21-city MOVE "M5G2C9" TO d21-postal-code PERFORM write-one DISPLAY "-i- will rewrite previous record to force a duplicate key error (134)" PERFORM write-one *> expect status 22 PERFORM read-sequentially END-IF. *> <<< read the file sequentially by index-key #3 (telephone, descending) >>> main-5000. MOVE "OK to display data records in reverse telephone order?" TO ws-prompt PERFORM ask-ynq IF answer-quit GO TO sortie END-IF IF answer-yes MOVE "4" TO ws-phase DISPLAY "-i- reading file: " FUNCTION TRIM(k-idx-fs) " by index-key-3" MOVE HIGH-VALUES TO d21-telephone START demo-file KEY IS <= d21-telephone *> NOTE: if your build returns the record *after* the START position on the *> first READ PREVIOUS, replace the START with: START demo-file LAST PERFORM UNTIL ws-fs NOT = "00" READ demo-file PREVIOUS RECORD WITH NO LOCK *> "regardless" IF ws-fs = "00" PERFORM display-record END-IF END-PERFORM PERFORM show-error END-IF. *> <<< find/delete record "Cutler" (with lock) >>> main-6000. MOVE "OK to delete record for 'Dave Cutler'?" TO ws-prompt PERFORM ask-ynq IF answer-quit GO TO sortie END-IF IF answer-yes MOVE "5" TO ws-phase MOVE SPACES TO demo-rec MOVE "C" TO d21-last-name START demo-file KEY IS NOT LESS THAN d21-last-name *> find key#1 nxeq "C " PERFORM UNTIL ws-fs NOT = "00" READ demo-file NEXT RECORD WITH LOCK IF ws-fs = "00" IF d21-last-name = "Cutler" AND d21-first-name = "Dave" DELETE demo-file RECORD DISPLAY "-i- record deleted, looking for more people named 'Dave Cutler'" ELSE IF d21-last-name(1:1) NOT = "C" MOVE "10" TO ws-fs *> cause error 11: gone too far END-IF END-IF END-IF END-PERFORM UNLOCK demo-file PERFORM show-error PERFORM read-sequentially END-IF. *> <<< delete "Gordon Bell" using the RFA method >>> main-7000. MOVE "OK to delete 'Gordon Bell' using the RFA method?" TO ws-prompt PERFORM ask-ynq IF answer-quit GO TO sortie END-IF IF answer-yes MOVE "6" TO ws-phase MOVE "N" TO ws-done PERFORM UNTIL all-done MOVE "N" TO ws-found MOVE SPACES TO demo-rec MOVE "Bell" TO d21-last-name START demo-file KEY IS NOT LESS THAN d21-last-name PERFORM UNTIL ws-fs NOT = "00" OR rec-found READ demo-file NEXT RECORD WITH NO LOCK *> read without lock IF ws-fs = "00" IF d21-last-name(1:4) NOT = "Bell" MOVE "10" TO ws-fs *> gone too far ELSE IF d21-last-name = "Bell" AND d21-first-name = "Gordon" MOVE d21-primary-key TO ws-rfa *> rfa21 = getrfa(21) MOVE "Y" TO ws-found END-IF END-IF END-IF END-PERFORM IF rec-found MOVE ws-rfa TO d21-primary-key *> get #22, rfa rfa21 READ demo-file WITH LOCK KEY IS d21-primary-key IF ws-fs = "00" DELETE demo-file RECORD DISPLAY "-i- record deleted, looking for more people named 'Gordon Bell'" END-IF UNLOCK demo-file ELSE MOVE "Y" TO ws-done END-IF END-PERFORM PERFORM show-error PERFORM read-sequentially END-IF. *> <<< find/update record "Olsen" >>> main-8000. MOVE "OK to change Ken Olsen's City?" TO ws-prompt PERFORM ask-ynq IF answer-quit GO TO sortie END-IF IF answer-yes MOVE "7a" TO ws-phase MOVE "N" TO ws-done PERFORM UNTIL all-done *> find_update_reentry_point MOVE "N" TO ws-found MOVE SPACES TO demo-rec MOVE "Olsen" TO d21-last-name START demo-file KEY IS NOT LESS THAN d21-last-name PERFORM UNTIL ws-fs NOT = "00" OR rec-found READ demo-file NEXT RECORD WITH NO LOCK IF ws-fs = "00" IF d21-last-name(1:5) NOT = "Olsen" MOVE "10" TO ws-fs ELSE IF d21-first-name = "Ken" AND d21-last-name = "Olsen" AND d21-city = "Toronto" MOVE d21-primary-key TO ws-rfa MOVE "Y" TO ws-found END-IF END-IF END-IF END-PERFORM IF NOT rec-found MOVE "Y" TO ws-done ELSE MOVE ws-rfa TO d21-primary-key READ demo-file WITH LOCK KEY IS d21-primary-key *> get #22, rfa MOVE "Maynard" TO d21-city MOVE SPACES TO d21-postal-code MOVE demo-rec TO ws-save-rec REWRITE demo-rec *> update #22 MOVE ws-fs TO ws-handler-err EVALUATE ws-handler-err WHEN "00" DISPLAY "-i- record update, looking for more people named 'Ken Olsen'" WHEN "21" *> RMS 130: primary key is not changeable MOVE "7b" TO ws-phase PERFORM show-error DISPLAY "-i- attempting FIND-RFA" MOVE ws-rfa TO d21-primary-key READ demo-file WITH LOCK KEY IS d21-primary-key DISPLAY "-i- attempting DELETE" DELETE demo-file RECORD DISPLAY "-i- attempting PUT" MOVE ws-save-rec TO demo-rec *> buffered data WRITE demo-rec IF ws-fs NOT = "00" PERFORM show-error MOVE "Y" TO ws-done END-IF WHEN OTHER PERFORM show-error MOVE "Y" TO ws-done END-EVALUATE UNLOCK demo-file END-IF END-PERFORM PERFORM read-sequentially DISPLAY ws-dash END-IF. DISPLAY "That's all for now" CALL "C$SLEEP" USING ws-sleep-secs GO TO sortie. *>============================================================================== *> that's all folks *>============================================================================== sortie. CLOSE demo-file DISPLAY "Adios..." STOP RUN. *>============================================================================== *> Subroutines (only reached via PERFORM) *>============================================================================== ask-ynq. DISPLAY FUNCTION TRIM(WS-PROMPT TRAILING) " (y/n/q) " WITH NO ADVANCING MOVE SPACES TO WS-JUNK ACCEPT WS-JUNK MOVE FUNCTION UPPER-CASE(FUNCTION TRIM(WS-JUNK LEADING)) TO WS-ANSWER. COMPUTE WS-LENGTH = FUNCTION LENGTH(ANSWER-CHOICES) MOVE 0 to WS-INDEX PERFORM VARYING WS-TEMP FROM 1 BY 1 UNTIL ((WS-TEMP > WS-LENGTH) OR (WS-INDEX > 0)) MOVE ANSWER-CHOICES(WS-TEMP:1) TO WS-CHAR IF WS-CHAR = WS-ANSWER MOVE WS-TEMP TO WS-INDEX END-IF END-PERFORM IF WS-INDEX = 0 DISPLAY "-e-illegal choice" GO TO ASK-YNQ END-IF. write-one. COMPUTE ws-rec-disp = ws-rec-count + 1 DISPLAY "-i- writing record: " FUNCTION TRIM(ws-rec-disp) WRITE demo-rec IF ws-fs = "00" ADD 1 TO ws-rec-count ELSE MOVE ws-fs TO ws-handler-err PERFORM show-error MOVE ws-rec-count TO ws-rec-disp DISPLAY "-i- recs : " FUNCTION TRIM(ws-rec-disp) END-IF. read-sequentially. MOVE "OK to display data records sequentially?" TO ws-prompt PERFORM ask-ynq IF answer-yes MOVE "3" TO ws-phase DISPLAY "-i- reading file: " FUNCTION TRIM(k-idx-fs) " sequentially" MOVE LOW-VALUES TO d21-primary-key *> rewind to BOF START demo-file KEY IS NOT LESS THAN d21-primary-key PERFORM UNTIL ws-fs NOT = "00" READ demo-file NEXT RECORD WITH NO LOCK *> no record lock IF ws-fs = "00" PERFORM display-record END-IF END-PERFORM PERFORM show-error END-IF. display-record. DISPLAY "first name : " d21-first-name DISPLAY "last_name : " d21-last-name DISPLAY "telephone : " d21-telephone DISPLAY "address : " d21-address DISPLAY "city : " d21-city DISPLAY "postal code : " d21-postal-code DISPLAY "==============================" CALL "C$SLEEP" USING ws-sleep-secs. show-error. EVALUATE ws-fs WHEN "00" CONTINUE WHEN "10" MOVE "End of file (RMS 11)" TO ws-text WHEN "21" MOVE "Key not changeable (RMS 130)" TO ws-text WHEN "22" MOVE "Duplicate key (RMS 134)" TO ws-text WHEN "23" MOVE "Record not found (RMS 155)" TO ws-text WHEN "35" MOVE "File not found" TO ws-text WHEN "51" MOVE "Record locked" TO ws-text WHEN OTHER MOVE "Unexpected file status" TO ws-text END-EVALUATE IF ws-fs NOT = "00" DISPLAY "-e- error: " ws-fs " in phase #" FUNCTION TRIM(ws-phase) DISPLAY "-i- text : " FUNCTION TRIM(ws-text) END-IF. - test run:
$ cobc -x -free bdb-indexed-demo-103.cob $ ./bdb-indexed-demo-103 BDB-Indexed-Demo-103 ============================== OK to delete 'demo data files'? (y/n/q) y OK to create/open 'demo data file'? (y/n/q) y -i- opening file: BDB-Indexed-Demo.dat OK to write 3 demo data records? (y/n/q) y -i- writing file: BDB-Indexed-Demo.dat -i- writing record: 1 -i- writing record: 2 -i- writing record: 3 -i- will rewrite previous record to force a duplicate key error (134) -i- writing record: 4 -e- error: 22 in phase #2 -i- text : Duplicate key (RMS 134) -i- recs : 3 OK to display data records sequentially? (y/n/q) y -i- reading file: BDB-Indexed-Demo.dat sequentially first name : Gordon last_name : Bell telephone : 4165551111 address : 483 Bay Street city : Toronto postal code : M5G2C9 ============================== first name : Dave last_name : Cutler telephone : 4165552222 address : 220 Simcoe Street city : Toronto postal code : M5T1T4 ============================== first name : Ken last_name : Olsen telephone : 4165553333 address : 129 Parker Street city : Toronto postal code : 01754 ============================== -e- error: 10 in phase #3 -i- text : End of file (RMS 11) OK to display data records in reverse telephone order? (y/n/q) y -i- reading file: BDB-Indexed-Demo.dat by index-key-3 first name : Ken last_name : Olsen telephone : 4165553333 address : 129 Parker Street city : Toronto postal code : 01754 ============================== first name : Dave last_name : Cutler telephone : 4165552222 address : 220 Simcoe Street city : Toronto postal code : M5T1T4 ============================== first name : Gordon last_name : Bell telephone : 4165551111 address : 483 Bay Street city : Toronto postal code : M5G2C9 ============================== -e- error: 10 in phase #4 -i- text : End of file (RMS 11) OK to delete record for 'Dave Cutler'? (y/n/q) y -i- record deleted, looking for more people named 'Dave Cutler' OK to display data records sequentially? (y/n/q) y -i- reading file: BDB-Indexed-Demo.dat sequentially first name : Gordon last_name : Bell telephone : 4165551111 address : 483 Bay Street city : Toronto postal code : M5G2C9 ============================== first name : Ken last_name : Olsen telephone : 4165553333 address : 129 Parker Street city : Toronto postal code : 01754 ============================== -e- error: 10 in phase #3 -i- text : End of file (RMS 11) OK to delete 'Gordon Bell' using the RFA method? (y/n/q) y -i- record deleted, looking for more people named 'Gordon Bell' -e- error: 10 in phase #6 -i- text : End of file (RMS 11) OK to display data records sequentially? (y/n/q) y -i- reading file: BDB-Indexed-Demo.dat sequentially first name : Ken last_name : Olsen telephone : 4165553333 address : 129 Parker Street city : Toronto postal code : 01754 ============================== -e- error: 10 in phase #3 -i- text : End of file (RMS 11) OK to change Ken Olsen's City? (y/n/q) y -e- error: 21 in phase #7b -i- text : Key not changeable (RMS 130) -i- attempting FIND-RFA -i- attempting DELETE -i- attempting PUT OK to display data records sequentially? (y/n/q) y -i- reading file: BDB-Indexed-Demo.dat sequentially first name : Ken last_name : Olsen telephone : 4165553333 address : 129 Parker Street city : Maynard postal code : ============================== -e- error: 10 in phase #3 -i- text : End of file (RMS 11) ------------------------------------------------------------ That's all for now Adios... $
Back to HomeNeil Rieck
Waterloo, Ontario, Canada.