OpenVMS Source-Code Demos

SEQUENCER

1000	%title "sequencer_xxx.bas"
	%ident			    "version_100.3"				! <<<---***
	declare string constant k_version = "100.3"			,	!		&
				k_program = "sequencer"				!
	!=========================================================================================================================
	! Title  : sequencer_xxx.bas
	! Author : Neil Rieck ( mailto:n.rieck@sympatico.ca - http://www3.sympatico.ca/n.rieck )
	! Created: 2013-01-21
	! Purpose: To provide a unique sequence number
	! Project: First used in the ESPP mail intercept.
	!		1. DELIVER intercepts mail then submits a batch job to process the mail message
	!		2. the submitted script runs this program to get the next number in a sequence of 1-20
	!		3. the sequence number is used to determine the name of a working subdirectory (eg. [._bench13])
	!		4. the contents of the directory are deleted (mess left by a previous transaction)
	!		5. the mail message is copied into the working subdirectory
	!		6. munpack is run to extract all MIME components (if any) of the email
	!		7. if a plain text was created, then process the message within
	!		8. if a plain text was not created, hen process the original mail message
	! History:
	! Ver Who When   What
	! --- --- ------ ---------------------------------------------------------------------------------------------------------
	! 100 NSR 130121 1. original program based upon relative file format (not 100% functional)
	!     NSR 130122 2. more work
	!     NSR 130218 3. one tiny little tweak
	!=========================================================================================================================
	option type=explicit							! cuz tricks are for kids...
!~~~	declare string	constant k_lock_fs$ = "csmis$dat:"+ k_program +".seq"	x
	declare string	constant k_lock_fs$ =               k_program +".seq"	! use current directory
	declare long	constant k_max_loop = 30				! note: 30 = 3 seconds
	set no prompt								!
	!
	!	external declarations
	!
	%include "starlet"	%from %library "sys$library:basic$starlet"	! system services
	%include "$ssdef"	%from %library "sys$library:basic$starlet"	! ss$
	%include "$syidef"	%from %library "sys$library:basic$starlet"	! syi$
	%include "lib$routines"	%from %library "sys$library:basic$starlet"	! lib$spawn
	%include "$libwaitdef"	%from %library "sys$library:basic$starlet"	! eg. $LIB$K_VAX_F
        %include "$libdef"	%from %library "sys$library:basic$starlet"	! eg. lib$_normal
	!
	!	local constants
	!
	declare string constant dq		= '34'C				! double quote
	declare string constant sq		= '39'C				! single quote
	!
	!	local variables
	!
	declare long	handler_error%					,	!			&
			seq_min%					,	!			&
			seq_max%					,	!			&
			seq_wrap%					,	!			&
			seq_inc%					,	!			&
			rc%						,	!			&
			i%, j%, k%					,	!			&
			lock_count%					,	!			&
			junk%						,	!			&
		string	junk$						,	!			&
			seq_min$					,	!			&
			seq_max$					,	!			&
			seq_mode$					,	!			&
			seq_number$					,	!			&
		single	fp_delay						!
	!
	!====================================================================================================
	!	main
	!====================================================================================================
	main:									!
2000	margin #0, 1999888777							! no implied EOL
	print k_program +"_"+ k_version						!
	print string$(len(k_program +"_"+ k_version), asc("="))			!
	!
	!	read DCL symbols
	!
	call lib$get_symbol("SEQ_MIN"		,seq_min$		)	!
	call lib$get_symbol("SEQ_MAX"		,seq_max$		)	!
	call lib$get_symbol("SEQ_MODE"		,seq_mode$		)	!
	print "-i-SEQ_MIN : "+ seq_min$						!
	print "-i-SEQ_MAX : "+ seq_max$						!
	print "-i-SEQ_MODE: "+ seq_mode$					!
	seq_number$				= "0"				! this will change later
	!
	!	MIN
	!
	when error in								!
	    seq_min% = integer(seq_min$)					!
	use									!
	    seq_min% = -1							!
	end when								!
	if seq_min% <=0	then							!
		seq_min% = 1							!
		print "-w-seq_min defaulting to: "+str$(seq_min%)		!
	end if									!
	!
	!	MAX (must be greater than MIN)
	!
	when error in								!
	    seq_max% = integer(seq_max$)					!
	use									!
	    seq_max% = -1							!
	end when								!
	if seq_max% <=0	then							!
	    seq_max% = 1							!
	    print "-w-seq_max defaulting to: "+str$(seq_max%)			!
	end if									!
	!
	if seq_min% >= seq_max% then						! min must be lower than max
	    print "-e-range error: seq_min is not lower than seq_max so exiting"!
	    goto fini_error							!
	end if									!
	!
	!	MODE (no mode = no dice)
	!
	select edit$(seq_mode$,32+2)						!
	    case "INCWRAP"							!
		seq_inc%	= 1						! increment
		seq_wrap%	= 1						! wrap-around
	    case "DECWRAP"							!
		seq_inc%	= 0						! decrement
		seq_wrap%	= 1						! wrap-around
	    case else								!
		print "-e-unsupported mode so exiting"				!
		print "   supported modes: INCWRAP, DECWRAP"			!
		goto fini_error							!
	end select								!

	!=======================================================================
	!	lock file i/o
	!=======================================================================
	!
	file_loop:								!
	lock_count% = lock_count% + 1						! incr
	if lock_count% >= k_max_loop then					!
	    print "-e-oops, could not acquire a lock within "+str$(k_max_loop)+" seconds. Please try again later"
	    rc% = 2								! vms-e-
	    goto fini_error							!
	end if									!
	!
	if lock_count% >= 2 then						!
	    fp_delay = 0.100							! wait 100 ms before we try again
	    rc% = lib$wait(fp_delay,,LIB$K_VAX_F)				!
	end if									!
	!
	when error in								!
	    !
	    !	use a relative file to simplfy the rewriting of data (we always used record #1)
	    !
	    map(d99)long    d99_transaction_counter%
	    !
	    open k_lock_fs$ as #99						!						&
		,access modify							! we want full access				&
		,allow none							! no one else may access this (for now)		&
		,organization relative						!						&
		,map d99							!
	    get #99, record 1							! get the record (with lock applied)
	    !
	    !	if we get here, then "WE" have the file "locked to our process"
	    !	so now it is time to update the sequence then put it back
	    !
	    !	Caveat: a more elegant method would be to use the FIFO associated with VMS's distrubted lock manager
	    !
	    junk% = d99_transaction_counter%					! make copy of counter (just in case)
	    if seq_inc% = 1 then						! if INC/rement
		junk% = junk% + 1						! increment
		if junk% > seq_max% then					! if too high
		    if seq_wrap% = 0 then					! if no wrap
			print "-e-SEQUENCE is at maximum so exiting"		!
			goto fini_error						!
		    else							! else wrap
			junk% = seq_min%					!
		    end if							!
		end if								!
	    else								! else DEC/rement
		junk% = junk% - 1						! decrement
		if junk% < seq_min% then					! if too low
		    if seq_wrap% = 0 then					! if no wrap
			print "-e-SEQUENCE is at minimum so exiting"		!
			goto fini_error						!
		    else							! else wrap
			junk% = seq_max%					!
		    end if							!
		end if								!
	    end if								!
	    !
	    !	update the variable then write it back to disk
	    !
	    d99_transaction_counter% = junk%					!
	    update #99								! write it back
	    handler_error% = 0							! cool
	use									!
	    handler_error% = err						! oops
	end when								!
	!
	select handler_error%							!
	    case 0								! no errors
	    case 154, 138, 19							! various lock-related errors
		goto file_loop							!
	    case 155								! RNF (okay on very first use)
		d99_transaction_counter% = seq_min%				!
		when error in							!
		    put #99, record 1						!
		    handler_error% = 0						! cool
		use								!
		    handler_error% = err					!
		    print "-e-oops, error "+str$(handler_error%)+" during lock file mtce 123"
		end when							!
		goto file_loop if handler_error% = 0				!
	    case 160								! File attributes not matched (okay during dvlp)
		close #99							!
		when error in							!
		    kill k_lock_fs$						! delete the file
		    handler_error% = 0						! cool
		use								!
		    handler_error% = err					! oops
		    print "-e-oops, error "+str$(handler_error%)+" during lock file mtce 456"
		end when							!
		goto file_loop if handler_error% = 0				!
	    case else								!
		print "-e-oops, application error "+ str$(handler_error%)	!
		goto fini_error							!
	end select								!
	!
	!	if we get here then everything worked as expected
	!
	print "-i-sequence: "+ str$(d99_transaction_counter%)+" will be saved in symbol SEQ_NUMBER"
	seq_number$ = str$(d99_transaction_counter%)				!
	!
	!=======================================================================
	!	<<< that's all folks >>>
	!=======================================================================
30000	fini:
	rc% = 1									! vms-i-
	goto rc_exit								!
	!
	fini_error:								!
	rc% = 2									! vms-e-
	!
	!	rc% must be set up b4 this point
	!
	rc_exit:								!
	close #99								! release the lock
	junk% = lib$set_symbol("SEQ_NUMBER", seq_number$)			!
	if (junk% and 7%) <> 1% then						!
	    print "-w-lib$set_symbol-rc:"+str$(junk%)				!
	end if									!
	print "-i-exiting "+ k_program +"_"+ k_version +" with status "+str$(rc%)
	end program rc%								! <<<------***
        !