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:[email protected] - https://neilrieck.net )
! 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% ! <<<------***
!