zOs/REXX/MARECMON

/* rexx ****************************************************************
maRecMon massRecovery Monitor Phase

Funktionen:
 -DEBUG : DEBUG ON
 -D : DISPLAY DB() TS() Liste für all/einzelne Jobs im Scope "MON#DISP"
 -P : Progress Analyse                                       "MON#PROG"
 -S : Statusanzeige                                          "MON#STAT"
 -SQL:SQL Generierung (Select Statements)                    "MON#SQL1"
 -U : DISPLAY UTILITY GESAMTE  Liste für alle Jobs           "MON#UTIL"
 -US: DISPLAY UTILITY UEBERSICHT  alle Jobs                  "MON#UTI2"
 -V : Joboutput Analyse
***********************************************************************/
parse arg code
interpret code

call checkArgs v.args
xf_vars = 'LIB="'v.lib'"; ARGS="'v.args'"; DBSUB="'v.dbsub'"; ',
          'JOBLIB="'v.joblib'"; MONLIB="'v.monlib'"; SHOWMBR="'v.showmbr'";',
          'ar.help='ar.help'; ar.dbug='ar.dbug';'
say '???xf_vars' xf_vars
debug=0
if ar.dbug=1 then debug = 1
if debug then say 'MARECMON start at 'time()
if debug then say '----------------------------'
if debug then say ' '

/* JOBOUT Library allocieren falls sie noch nicht existiert */
if debug then say 'v.monlib='v.monlib
/* check if JOBOUT library is already allocated and allocate if not */
jobout_dsn = "'"v.monlib".JOBOUT'"
call alloc_jobout jobout_dsn


if ar.dbug=1 then do
  say 'maRecMon code=' code;
  say ' '
  call sayVars;
  say 'maRecMon xf_vars='xf_vars;
end

if ar.help=1 then do
  call sayHelp;
end

if ar.utility=1 then do
  call "MON#UTIL" xf_vars;
end
if ar.utility_overview=1 then do
  call "MON#UTI2" xf_vars;
end

if ar.display=1 then do
  call "MON#DISP" xf_vars;
end

if ar.status=1 then do
  call "MON#STAT" xf_vars;
end

if ar.progress=1 then do
  call "MON#PROG" xf_vars;
end

if ar.sqlgen=1 then do
  call "MON#SQL1" xf_vars;
end

if debug then say 'MARECMON end at 'time()
if debug then say '----------------------------'
if debug then say ' '
exit 0


/*--------------------------------------------------------------------*/

sayVars: procedure expose v.                                  /*$proc$*/
parse arg st
    vars = 'VARS' v.vars
    do wx=1 to words(vars)
        v = word(vars, wx)
        vf = v
        if right(v, 2) \== '.*' then do
            if length(vf) < 20 then
                vf = left(vf, 20)
            say vf '=' v.v
            end
        else do
           v = left(v, length(v)-2)
           say v'.* ('v.v.0')'
           do y=1 to v.v.0
               say left('    .'y, 20) '=' v.v.y
               end
           end
        end
    return
endProcedure sayVars


/* Argumente prüfen und Steuervariablen initialisieren */
checkArgs: procedure expose ar.
  parse upper arg xx

  ar.help=0
  ar.dbug=0
  ar.display=0
  ar.check=0
  ar.joboutput=0
  ar.status=0
  ar.utility=0
  ar.utility_overview=0
  ar.sqlgen=0

  i=0
  do until xx=''
     parse upper var xx x ' ' y
     if x='-?' | x='??' | x='HELP' then ar.help=1             /* ok */
     if x='-DEBUG'                 then ar.dbug=1             /* ok */
     if x='-D'                     then ar.display=1          /* ok */
     if x='-V'                     then ar.check=1          /* fehlt noch */
     if x='-J'                     then ar.joboutput=1      /* fehlt noch */
     if x='-P'                     then ar.progress=1       /* in Arbeit  */
     if x='-S' | x=' ' | x='-SL'   then ar.status=1           /* ok */
     if x='-SQL'                   then ar.sqlgen=1         /* in Arbeit */
     if x='-U'                     then ar.utility=1          /* ok */
     if x='-US'                    then ar.utility_overview=1 /* ok ?? */
     xx=y
     i=i+1
  end
return
endProcedure checkArgs


sayHelp:
  say ' ';
  say 'ARGUMENTS for MON phase of the MAREC macro:'
  say ' '
  say ' -debug          activates display DEBUG information'
  say ' ? or -? or ??   display HELP Information '
  say ' '
  say ' -p              display Job Progress Report'
  say ' -s              display Job Status Report'
  say ' -sl             display extended Job Status Report (slow|)'
  say ' '
  say ' -sql            generate SELECT statements to verify access is ok'
  say ' '
  say ' -d [ jobmum ]   DISPLAY DB() TS() Report'
  say ' -u [ jobnum ]   DISPLAY UTILITY() Report'
  say ' -us             DISPLAY UTILITY() Overwiew Report'
  say ' '
  say ' -v [ jobnum ]   verify RECOVER Output in SYSPRINT of Jobs'
  say ' ';

return;


/**********************************************************************/
/** JOBOUT Library allozieren wenn noch keine existiert              **/
/**********************************************************************/
alloc_jobout:
 procedure expose v. debug
 if debug then say ">> proc: alloc_jobout "

 parse upper arg dsn
 if debug then say '.. dsn='dsn

 address tso;
 check_dsn = Sysdsn(dsn)
 If check_dsn ^= 'OK' Then do
   /** Alloc JOBOUT DS, MGMTCLAS(COM#E035), no Archive, no backup **/
   say '.. allocating a new 'dsn' ...';
   "ALLOCATE FILE(JOBOUT) DATASET("dsn") NEW CATALOG ",
   "SPACE(10,100) CYLINDERS",
   "MGMTCLAS(COM#E035) STORCLAS(ALL$N) RECFM(V, B) ",
   "LRECL(32756) BLKSIZE(32760) DSORG(PO) DSNTYPE(LIBRARY)"
   If RC ^= 0 Then do
      say " "
      say "New ALLOC of "dsn" failed, RC="RC
      say "please try again ..."
      "FREE FI(CMDDN)"
      return;
   end;
 end
 else do
   nop     /* nix tun, wenn die JOBOUT Library existiert */
 end

 if debug then say ">> end proc: alloc_jobout "
return;


/* copy err begin ******************************************************
    messages, errorhandling,help
***********************************************************************/
/* configure err -----------------------------------------------------*/
errReset: procedure expose m.
parse arg m.err.opt, ha
    if pos('I', translate(m.err.opt)) > 0 then
        if sysVar('sysISPF') = 'ACTIVE' then
            call adrIsp 'control errors return'
    if ha == '' then
        drop m.err.handler
    else
        m.err.handler = ha
    return
endSubroutine errReset

/*--- error routine: abend with message ------------------------------*/
err:
    parse arg ggTxt, ggOpt
    drop err handler opt
    if ggOpt == '' & symbol('m.err.handler') == 'VAR' then
        interpret value('m.err.handler')
    call outDest
    call errSay ggTxt, 'e'
    if ggOpt == '' & symbol('m.err.opt') == 'VAR' then
        ggOpt = value('m.err.opt')
    ggOpt = translate(ggOpt)
    if pos('T', ggOpt) > 0  then do
        trace ?r
        say 'trace ?r in err'
        end
    if pos('H', ggOpt) > 0  then do
        call errSay 'divide by zero to show stackHistory', 'e'
        x = 1 / 0
        end
    call errSay 'exit(12)', 'e'
    exit errSetRc(12)
endSubroutine err

/*--- assert that the passed rexx expression evaluates to true -------*/
assert:
    interpret 'assertRes =' arg(1)
    if \ assertRes then
        call err 'assert failed' arg(1)':' arg(2)
    return
endProcedure assert

/*--- output an errorMessage msg with pref pref
           split message in lines at '/n' ---------------------------*/
errSay: procedure expose m.
parse arg msg, pref
    parse source . . ggS3 .                           /* current rexx */
    if pref == 'e' then
        msg = 'fatal error in' ggS3':' msg
    else if pref == 'w' then
        msg = 'warning in' ggS3':' msg
    else if pref \== '' then
        msg = pref':' msg
    return outLn(msg)
endProcedure errSay

/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure expose m.
parse arg msg, op
    call errSay msg, 'e'
    call help
    call err msg, op
endProcedure errHelp

/*--- return the Operating System we are running on: TSO or LINUX ---*/
errOS: procedure expose m.
    parse source os .
    return os
endProcedure errOS

/*--- set rc for ispf: -------------------------------------------------
    if a cmd is run by ispStart, its RC is ignored,
         but ISPF passes the value of the shared varible 3IspfRc
         back as return code
----------------------------------------------------------------------*/
errSetRc: procedure expose m.
parse arg zIspfRc
    if errOS() \== 'LINUX' then
           if sysVar('sysISPF') = 'ACTIVE' then
            address ispExec vput 'zIspfRc' shared
    return zIspfRc
endProcedure errSetRc

/*--- output a trace message if m.tr is set -----------------------*/
trc: procedure expose m.
parse arg msg
    if m.trace == 1 then
        call out 'trc:' msg
    return
endProcedure trc

debug: procedure expose m.
parse arg msg
    if m.debug == 1 then
        call out 'debug' msg
    return
endProcedure debug

/*--- return current time and cpu usage ------------------------------*/
timing: procedure expose m.
return time() time('E') sysvar('syscpu') /* sysvar('syssrv') */

/*--- display the first comment block of the source as help -----------*/
help: procedure expose m.
    parse source . . s3 .
    call out right(' help for rexx' s3, 79, '*')
    do lx=1 by 1
        if pos('/*', sourceLine(lx)) > 0 then
            leave
        else if lx > 10 then do
            call out 'initial commentblock not found for help'
            return
            end
        end
    do lx=lx+1 by 1
        li = strip(sourceLine(lx), 't', ' ')
        if pos('*/', li) > 0 then
            leave
        call out li
        end
    call out right(' end help for rexx' s3, 79, '*')
    return 4
endProcedure help

/*--- output a message to the current destination -------------------*/
out: procedure expose m.
parse arg msg
    if symbol('m.err.out') \== 'VAR' then
        call outDest
    interpret m.err.out
    return 0
endProcedure out

/*--- output all lines (separated by '\n') of all args --------------*/
outLn: procedure expose m.
    do ax=1 to max(1, arg())
        msg = arg(ax)
        sx = 0
        bx = -1
        do lx=1 until bx >= length(msg)
                ex = pos('\n', msg, bx+2)
            if ex < 1 then
                ex = length(msg)+1
            call out substr(msg, bx+2, ex-bx-2)
            bx = ex
         end
        end
    return 0
endProcedure outLn

/*--- set and return some frequent destinations for out -------------*/
outDest: procedure expose m.
parse arg ty, a
    if ty == '' | symbol('m.err.out') \== 'VAR' then
        m.err.out = 'say msg'
    if ty == 's' then
        m.err.out = 'st='quote(a)';sx=m.st.0+1;m.st.0=sx;m.st.sx=msg'
    else if ty == 'i' then
        m.err.out = a
    else if \ abbrev('=', ty) then
        call err 'bad type in outDes('ty',' a')'
    return m.err.out
endProcedure outDest

/*--- quote string txt using quoteChar qu ("""" ==> ") ---------------*/
quote: procedure expose m.
parse arg txt, qu
    if qu = '' then
        qu = '"'
    res = qu
    ix = 1
    do forever
        qx = pos(qu, txt, ix)
        if qx = 0 then
            return res || substr(txt, ix) || qu
        res = res || substr(txt, ix, qx-ix) || qu || qu
        ix = qx + length(qu)
        end
endProcedure quote

/*--- conditional expression -----------------------------------------*/
if: procedure
parse arg cond, true, false
    if cond then
        return true
    else
        return false
/* copy err end   *****************************************************/