OpenVMS Source-Code Demos

RMS_INDEXED_DEMO_FMS.BAS

1000	%title "BASIC_RMS_INDEXED_DEMO_FMS_xxx.BAS"
	%sbttl "RMS (Record Management Services) Demo - FMS Version"
	%ident "version 102.3"
	declare string constant k_program = "BASIC_RMS_Indexed_Demo_FMS"
	!==============================================================================================================
	! title  : BASIC-RMS-indexed-demo-fms_xxx.bas
	! author : Neil Rieck (http://www3.sympatico.ca/n.rieck/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
	! build  :	1. compile basic source
	!        :	    $bas BASIC_RMS_INDEXED_DEMO_FMS_102
	!        :	2. compile fms form
	!        :	    $fms/obj BASIC_RMS_INDEXED_DEMO_FMS.frm /out=BASIC_RMS_INDEXED_DEMO_FMS_frm.obj
	!        :	3. link pieces together
	!        :	    $link BASIC_RMS_INDEXED_DEMO_FMS_102, BASIC_RMS_INDEXED_DEMO_FMS_frm.obj
	! 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
	! 102 NSR 110401 1. tweaks for 2011
	!     NSR 110615 2. added code to replace plain i/o with FMS (forms management system) i/o
	!     NSR 110617 3. a few more tweaks
	!==============================================================================================================
	option type=explicit							! cuz tricks are for kids
	set no prompt								! no ? with INPUT
	!
	%include "CSMIS$ROOT3:[DVLP.INC]FMS_FDVDEF.INC"				! FMS functions and constants
	%include "CSMIS$ROOT3:[DVLP.INC]device_controls.inc"			! VT control codes
	!
	!	<<< declare constants >>>
	!
	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 (idx_map)	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 (idx_map)	string												&
			d21_whole_chunk	= 150		,			!150					&
			d21_align	= 0					!	to enforce map alignment
	!
	map (my_form)	string												&
			f21_first_name	= 20		,			! 20					&
			f21_last_name	= 20		,			! 40					&
			f21_telephone	= 10		,			! 50					&
			f21_address	= 20		,			! 70					&
			f21_city	= 20		,			! 90					&
			f21_postal_code	= 10		,			!100					&
			f21_align	= 0					!	to enforce map alignment
	map (my_form) string												&
			f21_whole_chunk	= 100		,			!150					&
			f21_align	= 0					!	to enforce map alignment
	!
	!	<<< declare variables >>>
	!
	declare long	handler_error%					,	&
			rec_count%					,	&
		string  junk$						,	&
			prev$						,	&
		rfa	rfa21							! record file address (a 24-bit variable)
	!
	!	<<< stuff for FMS >>>
	!
	map(wksp4)	string	WorkSpace4	= 12				! work space 4
	map(tca)	string	TCA		= 12				! terminal control area
	declare long	fms_init%					,	&
			form_up%					,	&
			term%						,	&
		string	choice$
	declare string	constant k_fname4$ = "BASIC_RMS_INDEXED_DEMO_FMS"	! title defined in the FORM
	declare long	constant k_fsize4% = 2000				!
	!
	!========================================================================================================================
	!	<<< 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								! 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          idx_map						!						&
		,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          idx_map						!						&
		,organization indexed						!						&
		,connect 21							!
	    handler_error% = 0							! cool
	use									!
	    handler_error% = err						! oops
	    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 4 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	= "Neil"					!
	    d21_last_name	= "Rieck"					!
	    d21_telephone	= "5195551212"					!
	    d21_address		= "20 Water Street N"				!
	    d21_city		= "Kitchener"					!
	    d21_postal_code	= "N2H5A5"					!
	    print "-i- writing record: "; str$(rec_count% + 1)			!
	    put #21								! write to file
	    rec_count% = rec_count% + 1						!
	    !
	    d21_first_name	= "Ken"						!
	    d21_last_name	= "Olsen"					!
	    d21_telephone	= "4165553333"					!
	    d21_address		= "129 Parker Street"				!
	    d21_city		= "Toronto"					! this gets corrected to "Maynard" 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- now will rewrite previous record to force a 'duplicate key' error"
	    print "-i- writing record: "; str$(rec_count% + 1)			!
	    put #21								! write to file (will fail)
	    rec_count% = rec_count% + 1						!
	    !
	    handler_error% = 0							! cool
	use									!
	    handler_error% = err						! oops
	    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"						!
	rec_count% = 0								! init
	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
	    while 1								! loop forever (until we trap out)
		get #21, regardless						! read without applying a record lock
		rec_count% = rec_count% + 1					!
		select rec_count%						!
		    case 1							! method #1 (plain terminal i/o)
			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							!
		    case 2							! method #2 (fms mode: use fdv$put)
			print							!
			print "switching to FMS mode"				!
			sleep 1							!
			gosub fms_setup if fms_init% = 0			!
			gosub display_fms_form4 if form_up% <> 4		!
			!
			call fdv$putl("will populate fields one-by-one", 23%)	!
			sleep 1							!
			!
			f21_whole_chunk = d21_whole_chunk			! copy data from disk buffer to form buffer
			call fdv$put(f21_first_name	,"F$FIRST_NAME"	)	! put data by field name
			call fdv$put(f21_last_name	,"F$LAST_NAME"	)	!
			call fdv$put(f21_telephone	,"F$TELEPHONE"	)	!
			call fdv$put(f21_address	,"F$ADDRESS"	)	!
			call fdv$put(f21_city		,"F$CITY"	)	!
			call fdv$put(f21_postal_code	,"F$POSTAL_CODE")	!
			!
			call fdv$getdl( choice$, term%, 23%, "Record "+str$(rec_count%)+". Hit <enter>" )
		    case else							! method #3 (fms mode: use fdv$putal)
			gosub fms_setup if fms_init% = 0			!
			gosub display_fms_form4 if form_up% <> 4		!
			!
			call fdv$putl("will populate whole form using one call", 23%)	!
			sleep 1							!
			!
			f21_whole_chunk = d21_whole_chunk			! copy disk buffer to form buffer
			call fdv$putal(f21_whole_chunk)				! populate the form
			prev$ = f21_whole_chunk					! remember old data$
			!
			call fdv$putl("help: <TAB> = next, <ctrl-H> = previous, <enter> = leave form", 22%)
			call fdv$putl("Record "+str$(rec_count%), 23%) 		!
			!
			call fdv$getal(f21_whole_chunk, term%)			! read the whole form
			!
			call fdv$putl("", 22%)					!
			if prev$ = f21_whole_chunk then				!
			    call fdv$getdl(junk$, term%, 23%,"nothing changed. Hit <enter> ...")
			else							!
			    call fdv$getdl(junk$, term%, 23%,"something changed. Hit <enter> ...")
			end if							!
			!
		end select							!
	    next								!
	use									!
	    handler_error% = err						!
	    if form_up% > 0 then						! if form #4 is up
		form_up% = 0							! then show it down
		call fdv$clear							! clear the fms workspace (and screen)
		print vt$normal;						! get rid of reverse video
!		print fdv$clear;vt$home;					x more stuff
	    end if								!
	    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								! 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 (again)
	!
	!	<<< 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								!
		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								!
		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						! cool
		use								!
		    handler_error% = err					! oops
		    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
	!====================================================================================================
19000	fms_setup:								!
	call fdv$aterm( TCA by desc, 12%, 5% )					! attach terminal
	call fdv$awksp( WorkSpace4 by desc, k_fsize4% )				! attach WorkSpace 4
	fms_init% = 1								!
	return									!
	!
19010	display_fms_form4:							!
	call fdv$load ( k_fname4$ )						!
	call fdv$dispw								!
	form_up% = 4								! show form #4 loaded and up
	return									!
	!
	!	<<< 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								!
		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: "; str$(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.