/* REXX RECALL acts to HRECALL specified datasets. This is useful to run at the start of each day to ensure that all required dataset will be available when needed. Written by Frank Clarke in the Dark Ages Impact Analysis . SYSPROC TRAPOUT Modification History 20010209 fxc reorganized to increase structure and maintainability; upgraded REXXSKEL to v.19991109; 20010510 fxc made dslist-processing independent of catalog-level specification; 20010516 fxc version.2 puts the rundate ahead of the catalog level in the DAT file; check for SYSREASON=9 from LISTDSI before ordering an HRECALL; 20020320 fxc version.3 removes the two-level restriction; 20021223 fxc allow specific ON-date; 20060808 fxc force MONITOR in background; more messages; */ arg argline address TSO /* REXXSKEL ver.19991109 */ arg parms "((" opts signal on syntax signal on novalue call TOOLKIT_INIT /* conventional start-up -*/ rc = trace(tv) info = parms /* to enable parsing */ call A_INIT /* -*/ call B_CK_LEVEL /* -*/ if \sw.0halt_process then, call C_MAIN_PROCESS /* -*/ if \sw.nested then call DUMP_QUEUE /* -*/ exit /*@ RECALL */ /* . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address TSO call AA_SETUP_LOG /* */ parse value "4" with, curr_vsn ln. dsn specific_date marker = ".VERSION.RECALL" call AK_KEYWDS /* -*/ parse var info level rest if rest <> "" then do /* too many parms */ helpmsg = "Extraneous parms:" rest call HELP /* -*/ end if level="" then level = Userid() msg. = "??" msg.0000 = "OK" /* exists */ msg.0005 = "NC" /* not catalogued */ msg.0009 = "MI" /* migrated */ return /*@ A_INIT */ /* . ----------------------------------------------------------------- */ AA_SETUP_LOG: /*@ */ if branch then call BRANCH address TSO parse value "0" with, log# log. parse value Date("S") Time("S") Time("N") with, yyyymmdd sssss hhmmss . parse var yyyymmdd 4 yrdigit 5 mm 7 dd /* 9 12 14 maybe */ if Pos(yrdigit,"13579") > 0 then mm = mm + 12 /* mm=24 */ logtag = Substr("ABCDEFGHIJKLMNOPQRSTUVWX",mm,1) /* logtag=X */ subid = logtag""dd""Right(sssss,5,0) /* X1423722 ? */ vb4k.0 = "NEW CATALOG UNIT(SYSDA) SPACE(1 5) TRACKS", "RECFM(V B) LRECL(4096) BLKSIZE(0)" vb4k.1 = "SHR" /* if it already exists... */ logdsn = "@@LOG."exec_name"."subid".LIST" call ZL_LOGMSG(exec_name "started by" Userid() yyyymmdd hhmmss) call ZL_LOGMSG("Arg:" argline) return /*@ AA_SETUP_LOG */ /* . ----------------------------------------------------------------- */ AK_KEYWDS: /*@ */ if branch then call BRANCH address TSO specific_date = Keywd("ON") /* ccyymmdd */ if specific_date <> "" then, /* specified */ if specific_date <> Date("S") then, /* not today */ do say "Run aborted because another ON-date was specified." exit end return /*@ AK_KEYWDS */ /* . ----------------------------------------------------------------- */ B_CK_LEVEL: /*@ */ if branch then call BRANCH address TSO if dslist = "" then do /* " ((SELECT dslist" */ /* code removed */ end else do /* there is a list */ sw.0halt_process = "1" "ALLOC FI($STK) DA("dslist") SHR REU" if rc <> 0 then do /* allocation failed? */ say "Allocation for" dslist "failed, RC="rc return end "NEWSTACK" "EXECIO * DISKR $STK (FINIS" /* load the queue */ call ZL_LOGMSG(queued() "lines read from $STK="dslist) do queued() /* each line */ parse pull dsn . ldrc = Listdsi("'"dsn"' norecall") if msg.sysreason = "MI" then, call CZ_HRECALL /* -*/ if rc = 14 then iterate /* ds not in catlg */ queue dsn /* place on bottom */ end /* queued */ call ZL_LOGMSG(queued() "lines rewritten to $STK") "EXECIO" queued() "DISKW $STK (FINIS" "DELSTACK" "FREE FI($STK)" end return /*@ B_CK_LEVEL */ parse var level pt1 "." pt2 if pt2 = "" then do call Z_FAIL_MSG /* >1 level required -*/ exit end /* . ----------------------------------------------------------------- */ C_MAIN_PROCESS: /*@ */ if branch then call BRANCH address TSO if force then, /* don't do date check */ if monitor then, say "Date check bypassed." else nop else do /* else DO do date check */ ctldate = "" /* ensure a value */ today = Date("S") /* 19930209 perhaps */ call CA_CERTIFY /* load the LN. array -*/ call CB_FIND_LEVEL /* -*/ ln.ii = today level /* refresh the current line */ "EXECIO" ln.0 "DISKW CTL (FINIS STEM LN." "FREE FI(CTL)" end /* date check */ if \sw.0halt_process then, call CD_SCAN_CAT /* -*/ return /*@ C_MAIN_PROCESS */ /* Make sure the control dataset has the proper version number. Load the LN. array. . ----------------------------------------------------------------- */ CA_CERTIFY: /*@ */ if branch then call BRANCH address TSO call CAA_CTL_ALLOC /* -*/ do ii = 1 to ln.0 if Word(ln.ii,1) = marker then leave end /* ii */ if ii > ln.0 then call CAL_LOAD_VSN /* -*/ parse var ln.ii . vsn . if vsn < curr_vsn then do call CAU_VSN_UPGRADE /* -*/ ln.ii = marker curr_vsn end return /*@ CA_CERTIFY */ /* . ----------------------------------------------------------------- */ CAA_CTL_ALLOC: /*@ */ if branch then call BRANCH address TSO "ALLOC FI(CTL) DA(DAT) SHR REU" /* alloc pre-existing */ if rc > 0 then do /* not there */ "ALLOC FI(CTL) DA(DAT) NEW CATALOG UNIT(SYSDA) TR SPACE(1) ", "RECFM(V) LRECL(60)" /* build a new one */ if rc <> 0 then do "CLEAR" say "CTL did not allocate." exit end "NEWSTACK" queue level "0" /* prime the pump */ "EXECIO 1 DISKW CTL (FINIS" "DELSTACK" end "EXECIO * DISKR CTL (FINIS STEM LN."/* load the whole file */ call ZL_LOGMSG(ln.0 "lines read from CTL=DAT") return /*@ CAA_CTL_ALLOC */ /* . ----------------------------------------------------------------- */ CAL_LOAD_VSN: /*@ */ if branch then call BRANCH address TSO ii = ln.0 + 1 ln.0 = ii ln.ii = marker curr_vsn return /*@ CAL_LOAD_VSN */ /* Here do any processing required for version upgrades. No changes for version 3. . ----------------------------------------------------------------- */ CAU_VSN_UPGRADE: Procedure expose, /*@ */ (tk_globalvars) ln. vsn if branch then call BRANCH address TSO if vsn = 1 then do /* DAT is version-marker on line 1 followed by lines with catalog level and last date worked. */ do caux = 2 to ln.0 /* each catlvl line */ parse var ln.caux catlvl date . ln.caux = date catlvl /* swap positions */ end /* caux */ end /* vsn = 1 */ return /*@ CAU_VSN_UPGRADE */ /* Find this DS level in the control dataset. . ----------------------------------------------------------------- */ CB_FIND_LEVEL: /*@ */ if branch then call BRANCH address TSO do ii = 2 to ln.0 /* check every line */ if level = Word(ln.ii,2) then do /* 2nd word = level ? */ ctldate = Word(ln.ii,1) /* grab the 1st word */ if ctldate = today then do if aloud then, /* if quiet, Hush ! */ say ex_nam "has already run today. Use 'force' to", "demand a re-run." sw.0halt_process = "1" end /* ctldate = today */ leave /* bail out */ end end /* ii */ if ii > ln.0 then ln.0 = ii /* add a line */ return /*@ CB_FIND_LEVEL */ /* List the catalog for the specified level (default=userid) and scan for migrated datasets. If any NONVSAM dataset is on a MIGRAT volume, HRECALL it. . ----------------------------------------------------------------- */ CD_SCAN_CAT: /*@ */ if branch then call BRANCH address TSO rc = Outtrap("cat.") /* open the trap */ "LISTC LVL('"level"') VOL" /* fill it */ rc = Outtrap("off") /* snap the trap */ do ii = 1 to cat.0 /* spin through the trap */ if Word(cat.ii,1) = "NONVSAM" then do dsn = Word(cat.ii,3) end if dsn = "" then iterate /* must have a DSN */ if Pos("VOLSER-",cat.ii) > 0 then do cat.ii = Translate(cat.ii," ","-") vol = Word(cat.ii,2) if echo then say Left(dsn,47) vol if vol = "MIGRAT" then do /* do this one */ call CZ_HRECALL /* -*/ end /* migrat */ dsn = "" /* no longer valid */ end end /* ii */ return /*@ CD_SCAN_CAT */ /* . ----------------------------------------------------------------- */ CZ_HRECALL: /*@ */ if branch then call BRANCH address TSO if test | monitor then say "HRECALL '"dsn"' NOWAIT" if \test then "HRECALL '"dsn"' NOWAIT" return /*@ CZ_HRECALL */ /* . ----------------------------------------------------------------- */ Z_FAIL_MSG: /*@ */ if branch then call BRANCH address TSO queue " " queue "RECALL has been modified to REQUIRE a selection-list when" queue " the catalog-level is single-node. That is, you may" queue " request " queue " "ex_nam" <"level">.TEST, but not" queue " "ex_nam" <"level"> In order to use a single-node" queue " catalog-level, you must also specify SELECT, e.g.:" queue " "ex_nam" "level" ((SELECT RECALL.DATA("level") " queue " " queue "See the help-text for "ex_nam" for more detail." queue " " queue " " address TSO orig_msg = Msg("off") "DELETE $$TEMP$$" "ALLOC FI($MSG) DA($$TEMP$$) NEW CATALOG REU UNIT(SYSDA)", "LRECL(80) BLKSIZE(9040) RECFM(F B) SPACE(1) TRACKS" "EXECIO" queued() "DISKW $MSG (FINIS" tgt = node"."Userid() "XMIT" tgt "MSGFILE($MSG) NOLOG NONOT NOPRO NOEPI" off_msg = Msg(orig_msg) return /*@ Z_FAIL_MSG */ /* . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ address TSO test = SWITCH("TEST") echo = SWITCH("ECHO") force = SWITCH("FORCE") aloud = \SWITCH("QUIET") dslist = KEYWD("SELECT") if Pos("(",dslist) > 0 then, /* there is an open-paren */ if Pos(")",dslist) = 0 then, /* there is NO close-paren */ dslist = dslist")" /* attach one */ if test & monitor then do say "TEST and MONITOR are mutually exclusive. ", "Re-run specifying only one of these options." exit end if ^test & sw.back then monitor = 1 /* force MONITOR in BG */ return /*@ LOCAL_PREINIT */ /* . ----------------------------------------------------------------- */ ZB_SAVELOG: /*@ */ if branch then call BRANCH address TSO if Symbol("LOG#") = "LIT" then return /* not yet set */ "ALLOC FI($LOG) DA("logdsn") REU" vb4k.0 "EXECIO" log# "DISKW $LOG (STEM LOG. FINIS" "FREE FI($LOG)" return /*@ ZB_SAVELOG */ /* . ----------------------------------------------------------------- */ ZL_LOGMSG: Procedure expose, /*@ */ (tk_globalvars) log. log# rc = Trace("O") address TSO parse arg msgtext parse value log#+1 msgtext with, zz log.zz 1 log# . if monitor then say, msgtext return /*@ ZL_LOGMSG */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address TSO;"CLEAR" if helpmsg <> "" then do ; say helpmsg; say ""; end ex_nam = Left(exec_name,8) /* predictable size */ say " "ex_nam" acts to recall from HSM any datasets which have been migrated " say " by DF/HSM. " say " " say " Syntax: "ex_nam" (Defaults) " say " (( FORCE " say " QUIET " say " ECHO " say " TEST " say " SELECT datasetname " say " " say " " say " is the specification for a TSO LISTCAT " say " operation. Any specification valid for LISTC is valid " say " here. The default is . " say " " say " more.... " "NEWSTACK" ; pull ; "CLEAR" ; "DELSTACK" say " FORCE - Bypass the date check. If FORCE is not specified, " say " "exec_name" will only run once per day for any given " say " . " say " " say " QUIET - If specified, "exec_name" -does not- notify you when" say " it quits because the date check failed. If FORCE is " say " specified the date check will not fail, thus QUIET is " say " redundant to FORCE. " say " " say " ECHO - Orders "exec_name" to list each dataset and volume " say " as it discovers them. " say " " say " TEST - When TEST is specified, "exec_name" does not " say " actually issue any requests to HSM but reports those " say " actions it would have taken in the absence of TEST. " say " " say " more.... " "NEWSTACK" ; pull ; "CLEAR" ; "DELSTACK" say " MONITOR - is like TEST, but the HRECALL will be done if " say " MONITOR is specified " say " " say " (Because their effects are diametrically opposed, TEST and " say " MONITOR are mutually exclusive.) " say " " say " SELECT - causes a selective HRECALL of only " say " the DSNames contained within the dataset specified. " "NEWSTACK" ; pull ; "CLEAR" ; "DELSTACK" say " Debugging tools provided include: " say " " say " MONITOR: displays key information throughout processing. " say " Displays most paragraph names upon entry. " say " " say " NOUPDT: by-pass all update logic. " say " " say " BRANCH: show all paragraph entries. " say " " say " TRACE tv: will use value following TRACE to place the execution in" say " REXX TRACE Mode. " say " " say " " say " Debugging tools can be accessed in the following manner: " say " " say " TSO "ex_nam" parameters (( debug-options " say " " say " For example: " say " " say " TSO "ex_nam" (( MONITOR TRACE ?R " address ISPEXEC "CONTROL DISPLAY REFRESH" exit /*@ HELP */ /* . ----------------------------------------------------------------- */ BRANCH: Procedure expose, /*@ */ sigl exec_name rc = trace("O") /* we do not want to see this */ arg brparm . origin = sigl /* where was I called from ? */ do currln = origin to 1 by -1 /* inch backward to label */ if Right(Word(Sourceline(currln),1),1) = ":" then do parse value sourceline(currln) with pgfname ":" . /* Label */ leave ; end /* name */ end /* currln */ select when brparm = "NAME" then return(pgfname) /* Return full name */ when brparm = "ID" then do /* wants the prefix */ parse var pgfname pgfpref "_" . /* get the prefix */ return(pgfpref) end /* brparm = "ID" */ otherwise say left(sigl,6) left(pgfname,40) exec_name "Time:" time("L") end /* select */ return /*@ BRANCH */ /* . ----------------------------------------------------------------- */ DUMP_QUEUE: /*@ Take whatever is in stack */ rc = trace("O") /* and write to the screen */ address TSO "QSTACK" /* how many stacks? */ stk2dump = rc - tk_init_stacks /* remaining stacks */ if stk2dump = 0 & queued() = 0 then return say "Total Stacks" rc , /* rc = #of stacks */ "Begin Stacks" tk_init_stacks , /* Stacks present at start */ "Stacks to DUMP" stk2dump do dd = rc to tk_init_stacks by -1 /* empty each one. */ say "Processing Stack #" dd "Total Lines:" queued() do queued();pull line;say line;end /* pump to the screen */ "DELSTACK" /* remove stack */ end /* dd = 1 to rc */ return /*@ DUMP_QUEUE */ /* . ----------------------------------------------------------------- */ KEYWD: Procedure expose info /*@ hide all vars, except info*/ arg kw kw_pos = wordpos(kw,info) /* find where it is, maybe */ if kw_pos = 0 then return "" /* send back a null, not found*/ kw_val = word(info,kw_pos+1) /* get the next word */ info = Delword(info,kw_pos,2) /* remove both */ return kw_val /*@ KEYWD */ /* . ----------------------------------------------------------------- */ KEYPHRS: Procedure expose, /*@ */ info helpmsg exec_name /* except these three */ arg kp wp = wordpos(kp,info) /* where is it? */ if wp = 0 then return "" /* not found */ front = subword(info,1,wp-1) /* everything before kp */ back = subword(info,wp+1) /* everything after kp */ parse var back dlm back /* 1st token must be 2 bytes */ if length(dlm) <> 2 then /* Must be two bytes */ helpmsg = helpmsg "Invalid length for delimiter("dlm") with KEYPHRS("kp")" if wordpos(dlm,back) = 0 then /* search for ending delimiter*/ helpmsg = helpmsg "No matching second delimiter("dlm") with KEYPHRS("kp")" if helpmsg <> "" then call HELP /* Something is wrong */ parse var back kpval (dlm) back /* get everything b/w delim */ info = front back /* restore remainder */ return Strip(kpval) /*@ KEYPHRS */ /* . ----------------------------------------------------------------- */ NOVALUE: /*@ */ say exec_name "raised NOVALUE at line" sigl say " " say "The referenced variable is" condition("D") say " " zsigl = sigl signal SHOW_SOURCE /*@ NOVALUE */ /* . ----------------------------------------------------------------- */ SHOW_SOURCE: /*@ */ call DUMP_QUEUE /* Spill contents of stacks -*/ if sourceline() <> "0" then /* to screen */ say sourceline(zsigl) rc = trace("?R") nop exit /*@ SHOW_SOURCE */ /* . ----------------------------------------------------------------- */ SS: Procedure /*@ Show Source */ arg ssbeg ssend . if ssend = "" then ssend = 10 if \datatype(ssbeg,"W") | \datatype(ssend,"W") then return ssend = ssbeg + ssend do ssii = ssbeg to ssend ; say sourceline(ssii) ; end return /*@ SS */ /* . ----------------------------------------------------------------- */ SWITCH: Procedure expose info /*@ */ arg kw sw_val = Wordpos(kw,info) > 0 /* exists = 1; not found = 0 */ if sw_val then /* exists */ info = Delword(info,Wordpos(kw,info),1) /* remove it */ return sw_val /*@ SWITCH */ /* . ----------------------------------------------------------------- */ SYNTAX: /*@ */ errormsg = exec_name "encountered REXX error" rc "in line" sigl":", errortext(rc) say errormsg zsigl = sigl signal SHOW_SOURCE /*@ SYNTAX */ /* Can call TRAPOUT. . ----------------------------------------------------------------- */ TOOLKIT_INIT: /*@ */ address TSO info = Strip(opts,"T",")") /* clip trailing paren */ parse source sys_id how_invokt exec_name DD_nm DS_nm, as_invokt cmd_env addr_spc usr_tokn ex_nam = Left(exec_name,8) /* predictable size */ parse value "" with tv helpmsg . parse value 0 "ISR00000 YES" "Error-Press PF1" with, sw. zerrhm zerralrm zerrsm if SWITCH("TRAPOUT") then do "TRAPOUT" exec_name parms "(( TRACE R" info exit end /* trapout */ if Word(parms,1) = "?" then call HELP /* I won't be back */ "QSTACK" ; tk_init_stacks = rc /* How many stacks? */ parse value SWITCH("BRANCH") SWITCH("MONITOR") SWITCH("NOUPDT") with, branch monitor noupdt . parse value mvsvar("SYSNAME") sysvar("SYSNODE") with, #tk_cpu node . sw.nested = sysvar("SYSNEST") = "YES" sw.batch = sysvar("SYSENV") = "BACK" sw.inispf = sysvar("SYSISPF") = "ACTIVE" parse value KEYWD("TRACE") "O" with tv . tk_globalvars = "tk_globalvars exec_name tv helpmsg sw. zerrhm", "zerralrm zerrsm zerrlm tk_init_stacks branch", "monitor noupdt" call LOCAL_PREINIT /* for more opts -*/ return /*@ TOOLKIT_INIT */