1000 %title "OpenVMS-BASIC-RMS-indexed-demo_xxx.bas" %sbttl "RMS (Record Management Services) Demo" %ident "version 101.2" !============================================================================================================== ! title : OpenVMS-BASIC-RMS-indexed-demo_xxx.bas ! author : Neil Rieck (http://neilrieck.net/links/cool_openvms.html) ! purpose: demos the use of RMS-based indexed file access for novice OpenVMS programmers ! scope : this educational program comes free of charge with no strings attached ! notes : 1. OpenVMS-BASIC has 'built in' support for RMS (Record Management Services) ! : 2. a. in a RDBS, the primary key must be unique, isn't indexed by default, can't be changed ! : b. what OpenVMS BASIC calls a primary key doesn't need to be unique, is indexed, can't be changed ! : c. in RDBS terms, the primary key is really the RFA (record file address) which can be thought ! of as an internal RMS sequence counter ! : 3. edit environment: VT-220, 132 column, 8 column tab stops at 1,9,17,25,.... ! : 4. all remarks begin in column 81 ! history: ! ver who when what ! --- --- ------ ---------------------------------------------------------------------------------------------- ! 100 NSR 020829 1. original program ! 101 NSR 050123 1. cleanup for public view ! NSR 050124 2. added more documentation !============================================================================================================== option type=explicit ! cuz tricks are for kids set no prompt ! no ? with INPUT ! ! <<< declare constants >>> ! declare string constant k_program = "OpenVMS-BASIC-RMS-Indexed-Demo" declare string constant k_idx_fs$ = "OpenVMS-BASIC-RMS-Indexed-Demo.dat" ! ! <<< mapped variables to 'lay out' a disk record >>> ! ! note: when the same map names is used, the second map overlays the first ! map (indexed_demo) string & d21_first_name = 20 , ! 20 & d21_last_name = 20 , ! 40 & d21_telephone = 10 , ! 50 & d21_address = 20 , ! 70 & d21_city = 20 , ! 90 & d21_postal_code = 10 , !100 & fill$ = 50 , !150 room to grow & d21_align = 0 ! to enforce map alignment map (indexed_demo) string & d21_whole_chunk = 150 , !150 & d21_align = 0 ! to enforce map alignment ! ! <<< declare variables >>> ! declare long handler_error% , & rec_count% , & string junk$ , & rfa rfa21 ! record file address (a 48-bit variable) ! !======================================================================================================================== ! <<< main >>> !======================================================================================================================== 2000 print k_program ! display program name print string$( len(k_program), ascii("=") ) ! now underline it on error goto trap ! legacy error handler support margin #0, 132 ! this will not change the screen size ! !==================================================================================================== ! ! <<< delete all OpenVMS versions of our test file >>> ! input "OK to delete 'demo data files'? (y/N) ";junk$ junk$ = left$( edit$(junk$,32+2), 1) ! upcase, no white space goto sortie if junk$ <> "Y" when error in while 1=1 ! make sure we get all versions kill k_idx_fs$ next use ! end when ! ! <<< open the file >>> ! ! "BASIC Open" notes: ! 1. open k_idx_fs$ for input as file #21 - the file must already exist ! 2. open k_idx_fs$ for output as file #21 - a new file version is always created ! 3. open k_idx_fs$ as file #21 - the file is created if it doesn't exit ! input "OK to create/open 'demo data file'? (y/N) ";junk$ junk$ = left$( edit$(junk$,32+2), 1) ! upcase, no white space goto sortie if junk$ <> "Y" 3000 when error in print "-i- opening file: "; k_idx_fs$ open k_idx_fs$ as file #21 ! create the file if it doesn't exist & ,access modify ! we want to read + write & ,allow modify ! allow others to read + write while we do it & ,map indexed_demo ! & ,organization indexed ! & ,primary (d21_last_name, d21_first_name, d21_city) ! key #0 & ,alternate d21_last_name duplicates changes ! key #1 & ,alternate d21_telephone duplicates changes ! key #2 & ,alternate d21_telephone duplicates changes descending ! key #3 ! ! note: the connected channel is opened last but must be closed first ! print "-i- opening file: "; k_idx_fs$; " (connect)" open k_idx_fs$ as file #22 ! & ,access modify ! we want to read + write & ,allow modify ! allow others to read + write while we do it & ,map indexed_demo ! & ,organization indexed ! & ,connect 21 ! handler_error% = 0 ! show that all is well use handler_error% = err print "-e- error: "+str$( handler_error% )+" in phase #1" print "-i- text : "+ert$( handler_error% ) end when goto sortie if handler_error% <> 0 ! exit on ant errors ! ! <<< write some records >>> ! 4000 rec_count% = 0 input "OK to write 3 demo data records? (y/N) ";junk$ junk$ = left$( edit$(junk$,32+2), 1) ! upcase, no white space goto sortie if junk$ <> "Y" when error in print "-i- writing file: "; k_idx_fs$ d21_whole_chunk = "" ! start with a clean buffer ! d21_first_name = "Ken" d21_last_name = "Olsen" d21_telephone = "4165553333" d21_address = "129 Parker Street" d21_city = "Toronto" ! this gets corrected below d21_postal_code = "01754" print "-i- writing record: "; str$(rec_count% + 1) ! put #21 ! write to file rec_count% = rec_count% + 1 ! ! d21_first_name = "Dave" d21_last_name = "Cutler" d21_telephone = "4165552222" d21_address = "220 Simcoe Street" d21_city = "Toronto" d21_postal_code = "M5T1T4" print "-i- writing record: "; str$(rec_count% + 1) put #21 ! write to file rec_count% = rec_count% + 1 ! d21_first_name = "Gordon" d21_last_name = "Bell" d21_telephone = "4165551111" d21_address = "483 Bay Street" d21_city = "Toronto" d21_postal_code = "M5G2C9" print "-i- writing record: "; str$(rec_count% + 1) put #21 ! write to file rec_count% = rec_count% + 1 ! print "-i- will rewrite previous record to force a duplicate key error (134)" print "-i- writing record: "; str$(rec_count% + 1) ! put #21 ! write to file rec_count% = rec_count% + 1 ! ! handler_error% = 0 use handler_error% = err print "-e- error: "+ str$( handler_error% )+" in phase #2" print "-i- text : "+ ert$( handler_error% ) print "-i- recs : "+ str$( rec_count% ) end when gosub read_sequentially ! display all records ! ! <<< read the file sequentially by index-key #1 >>> ! 5000 input "OK to display data records in reverse telephone order? (y/N) ";junk$ junk$ = left$( edit$(junk$,32+2), 1) ! upcase, no white space goto sortie if junk$ <> "Y" when error in print "-i- reading file: "; k_idx_fs$; " by index-key-3" reset #21, key#3 ! find #21, key#3 gt " ", regardless x same as previous line handler_error% = 0 while 1=1 ! loop forever (until we trap out) get #21, regardless ! read without applying a record lock print "first name : "; d21_first_name print "last_name : "; d21_last_name print "telephone : "; d21_telephone print "address : "; d21_address print "city : "; d21_city print "postal code : "; d21_postal_code print "==============================" sleep 1 next use handler_error% = err print "-e- error: "+str$( handler_error% )+" in phase #4" print "-i- text : "+ert$( handler_error% ) end when ! ! <<< find/delete record "Cutler" >>> ! 6000 input "OK to delete record for 'Dave Cutler'? (y/N) ";junk$ junk$ = left$( edit$(junk$,32+2), 1) ! upcase, no white space goto sortie if junk$ <> "Y" when error in find #21, key#1 nxeq "C " ! find (with lock) while 1=1 ! loop forever (until we trap out) get #21 ! read (with lock) if d21_last_name = "Cutler" and & d21_first_name = "Dave" then ! if Dave Cutler delete #21 ! print "-i- record deleted, looking for more people named 'Dave Cutler'" else ! cause error 11 if left$( d21_last_name,1) <> "C" ! exit if we've gone too far iterate ! end if next use handler_error% = err print "-e- error: "+str$( handler_error% )+" in phase #5" print "-i- text : "+ert$( handler_error% ) end when ! gosub read_sequentially ! display all records ! ! <<< delete record #2 >>> ! 7000 input "OK to delete 'Gordon Bell' using the RFA method? (y/N) ";junk$ junk$ = left$( edit$(junk$,32+2), 1) ! upcase, no white space goto sortie if junk$ <> "Y" when error in find #21, key#1 ge "Bell", regardless ! Find (without lock) (ge = nxeq) while 1=1 ! get #21, regardless ! read (without lock) cause error 11 if pos(d21_last_name,"Bell",1)=0 ! exit if we've gone too far if d21_last_name = "Bell" and & d21_first_name = "Gordon" then ! if Gordon Bell rfa21 = getrfa(21) ! get the record file address get #22, rfa rfa21 ! position connected channel with LOCK delete #22 ! now delete print "-i- record deleted, looking for more people named 'Gordon Bell'" else iterate ! do another GET on orginal channel end if next use handler_error% = err print "-e- error: "+str$( handler_error% )+" in phase #6" print "-i- text : "+ert$( handler_error% ) end when gosub read_sequentially ! display all records ! ! <<< find/update record "Olsen" >>> ! 8000 input "OK to change Ken Olsen's City? (y/N) ";junk$ junk$ = left$( edit$(junk$,32+2), 1) ! upcase, no white space goto sortie if junk$ <> "Y" find_update_reentry_point: when error in find #21, key#1 ge "Olsen", regardless ! set key while 1=1 get #21, regardless ! read without lock cause error 11 if pos(d21_last_name,"Olsen",1)=0 ! exit if we've gone too far if d21_first_name = "Ken" and & d21_last_name = "Olsen" and & d21_city = "Toronto" then rfa21 = getrfa(21) get #22, rfa rfa21 d21_city = "Maynard" d21_postal_code = "" update #22 print "-i- record update, looking for more people named 'Ken Olsen'" end if next use handler_error% = err print "-e- error: "+str$( handler_error% )+" in phase #7a" print "-i- text : "+ert$( handler_error% ) end when ! select handler_error% case 130 ! key not changeable (for primary keys only) when error in print "-i- attempting FIND-RFA" find #22, rfa rfa21 ! position with LOCK (but don't change data) print "-i- attempting DELETE" delete #22 ! delete print "-i- attempting PUT" put #22 ! write buffered data handler_error% = 0 use handler_error% = err print "-e- error: "+str$( handler_error% )+" in phase #7b" print "-i- text : "+ert$( handler_error% ) end when goto find_update_reentry_point if handler_error% = 0 ! look for more if successful case 11 ! end-of-file case 155 ! record-not-found case 131 ! no current key (no lock) end select ! gosub read_sequentially ! display all records ! print string$( 60, ascii("-") ) ! draw a line print "That's all for now" sleep 1 goto sortie !==================================================================================================== ! Subroutines !==================================================================================================== ! ! <<< read the file sequentially >>> ! 20000 read_sequentially: input "OK to display data records sequentially? (y/N) ";junk$ junk$ = left$( edit$(junk$,32+2), 1) ! upcase, no white space goto read_sequentially_exit if junk$ <> "Y" when error in print "-i- reading file: "; k_idx_fs$; " sequentially" handler_error% = 0 reset #21 ! rewind to BOF ! reset #21, key#0 x same as "reset #21" while 1=1 get #21, regardless ! read without applying a record lock print "first name : "; d21_first_name print "last_name : "; d21_last_name print "telephone : "; d21_telephone print "address : "; d21_address print "city : "; d21_city print "postal code : "; d21_postal_code print "==============================" sleep 1 next use handler_error% = err print "-e- error: "+str$( handler_error% )+" in phase #3" print "-i- text : "+ert$( handler_error% ) end when read_sequentially_exit: return !======================================================================================================================== ! <<< Final Error Trap >>> ! ! If we've done a good job coding, we should never execute this code >>> !======================================================================================================================== 31000 trap: print print "Error in final trap" print "Line: ";erl print "Err : ";str$(err) print "Msg : ";ert$(err) resume sortie ! !======================================================================================================================== ! ! <<< that's all folks >>> ! 32000 sortie: close 22 ! always close the connected channel first close 21 ! print "Adios..." end
Back to OpenVMS
Back to OpenVMS Demo Index
Back to Home
Neil Rieck
Kitchener - Waterloo - Cambridge, Ontario, Canada.