/* REXX    SYSUMON    (v.2) Count usage of tools by userid.  Use
                      RXVSAM to open the VSAM KSDS, fetch the proper
                      record, update it, and rewrite.  Any routine
                      which calls SYSUMON must pass <userid> and
                      <toolname> as described in HELP.  The minimal
                      IDCAMS DEFINE command for the SYSUMON KSDS is
                      shown in HELP.  Your installation may require
                      others.
           Use '(routine name)  ?' for HELP-text.

           Written by Frank Clarke 20040426

     Impact Analysis
.    SYSEXEC   RUNDATA   Supplies global datapoints
.    SYSEXEC   TRAPOUT   Debugging aid

     Modification History
     20040914 fxc mark new records with an "R" (written by REXX)
     20090803 fxc keep user's real name
     20211029 fxc load username (via GETNAME) to record; set dataset
                  prefixes in LOCAL_PREINIT
     20211111 fxc immediate EXIT if no SYSUMON KSDS
     20230726 fxc adjust HELP;
     20240118 fxc fix help
     20240308 fxc chg dollar-sign to @ everywhere;
     20240423 fxc DUMP_QUEUE quiet;
     20240509 fxc RUNDATA supplies some parm data;
     20240701 fxc init RUNDATA variables;
     20250404 fxc clip too-long lines;
     20250409 fxc use RUNDATA.RXVSAM instead of RUNDATA.SYSUMON;
     20250418 fxc fix erroneous error message;

*/ arg argline
address TSO                            /* REXXSKEL ver.20040227      */
arg parms "((" opts

signal on syntax
signal on novalue

call TOOLKIT_INIT                      /* conventional start-up     -*/

if sw.inispf = "0" then do
   arg line
   line = line "((  RESTARTED"         /* tell the next invocation   */
   address TSO
   "ISPSTART CMD("exec_name line")"    /* Invoke ISPF if nec.        */
   exit 2                              /* bail out                   */
   end

rc = Trace("O"); rc = Trace(tv)
info   = parms                         /* to enable parsing          */

call A_INIT                            /*                           -*/
call B_VSAM_OPS                        /*                           -*/

if \sw.nested then call DUMP_QUEUE 'quiet' /*                       -*/

if sw.0restarted then do               /* at end of mainline         */
   rc = OutTrap("ll.")
   exit 4
   end
exit                                   /*@ SYSUMON                   */
/*
   Initialization
.  ----------------------------------------------------------------- */
A_INIT:                                /*@                           */
   if branch then call BRANCH
   address TSO

   if Sysdsn( vsksds ) <> "OK" then exit  /* No SYSUMON dataset      */

   parse value Date("S") Date("B") with yy4 5 mm 7 dd . 1 s_date b_date
   parse value "0 0 0 0 0 0 0 0 0 0 0" with,
         ct.  .
   parse value "" with,
         dumpmo  vskey  rxvsam_vsamerrormsg ,
         keyorig  prevuser  previtem  ,
         byuser.  userkeylist   byitem.  itemkeylist ,
         .
   call AK_KEYWDS                      /*                           -*/

return                                 /*@ A_INIT                    */
/*
   Parse out TOOL and USER
.  ----------------------------------------------------------------- */
AK_KEYWDS:                             /*@                           */
   if branch then call BRANCH
   address TSO

   caller = KEYWD("USER")
   tool   = KEYWD("TOOL")
   uname  = GETNAME()                  /* Name in ASCB              -*/
   uname  = SHIFT( uname )             /* dual case                 -*/

return                                 /*@ AK_KEYWDS                 */
/*
   LIBDEF to <RXVSAMll> to enable calls to RXVSAM.
.  ----------------------------------------------------------------- */
B_VSAM_OPS:                            /*@                           */
   if branch then call BRANCH
   address TSO

   if sw.inispf then,
      address ISPEXEC "LIBDEF ISPLLIB DATASET" ,
                      "ID( '"rxvsamll"' ) STACK"

   call BA_PROLOG                      /* Alloc and open VS file    -*/
   call BG_GET_KEY                     /* fetch record              -*/
   call BP_PUT_KEY                     /* replace record            -*/
   call BZ_EPILOG                      /* Close and free            -*/

   if sw.inispf then,
      address ISPEXEC "LIBDEF ISPLLIB"

return                                 /*@ B_VSAM_OPS                */
/*
   Allocate and open the KSDS
.  ----------------------------------------------------------------- */
BA_PROLOG:                             /*@                           */
   if branch then call BRANCH
   address TSO

   "ALLOC FI(@VS) DA("vsksds") SHR REU"
   rxv_rc = RXVSAM("OPENIO","@VS","KSDS")

return                                 /*@ BA_PROLOG                 */
/*
   Read-with-key.  If key not present, build a new record with a count
   of 0.
   Each record is keyed with 8 characters for the user and 8 characters
   for the tool.  There follow 12 counters, one for each month, the key
   origin (generally 'R'), and the user's name found in storage via
   GETNAME().
.  ----------------------------------------------------------------- */
BG_GET_KEY:                            /*@                           */
   if branch then call BRANCH
   address TSO

   /* read record */
   key = Left(caller,8)Left(tool,8)
   rxv_rc = RXVSAM("READ","@VS",key,"RECORD")

   if rxv_rc > 0 then,                 /* read error - dummy record  */
      parse value 1 Left(caller,8)Left(tool,8) ,
                    0 0 0  0 0 0  0 0 0  0 0 0 "R"  uname  with,
                  sw.0read_err  record

   parse var record user . 9 tool . 17,
             ct.01 ct.02 ct.03 ct.04 ct.05 ct.06,
             ct.07 ct.08 ct.09 ct.10 ct.11 ct.12   keyorig keyuser

return                                 /*@ BG_GET_KEY                */
/*
   Increment the counter or this month for this user and this tool.
   Write-with-key the updated record.
.  ----------------------------------------------------------------- */
BP_PUT_KEY:                            /*@                           */
   if branch then call BRANCH
   address TSO

   ct.mm = ct.mm + 1                   /* bump ctr for this month    */
   if keyuser = "" then,               /* was empty at read          */
      if caller = Userid() then,       /* not proxy                  */
         keyuser = uname               /* via GETNAME                */
   record = Left( user,8 )Left( tool,8 ),
            Right( ct.01,5,' ' ),
            Right( ct.02,5,' ' ),
            Right( ct.03,5,' ' ),
            Right( ct.04,5,' ' ),
            Right( ct.05,5,' ' ),
            Right( ct.06,5,' ' ),
            Right( ct.07,5,' ' ),
            Right( ct.08,5,' ' ),
            Right( ct.09,5,' ' ),
            Right( ct.10,5,' ' ),
            Right( ct.11,5,' ' ),
            Right( ct.12,5,' ' ),
            keyorig "  "Strip( keyuser )

   if sw.0read_err then,               /* REWRITE not allowed        */
      rxv_rc = RXVSAM("WRITE","@VS",,"RECORD")
   else,
      rxv_rc = RXVSAM("REWRITE","@VS",key,"RECORD")

return                                 /*@ BP_PUT_KEY                */
/*
   Close the VSAM file and FREE the dataset.
.  ----------------------------------------------------------------- */
BZ_EPILOG:                             /*@                           */
   if branch then call BRANCH
   address TSO

   rxv_rc = RXVSAM("CLOSE","@VS")
   "FREE  FI(@VS)"

return                                 /*@ BZ_EPILOG                 */
/*
.  ----------------------------------------------------------------- */
LOCAL_PREINIT:                         /*@ customize opts            */
   address TSO
   rc = Trace("O") ; rc = trace( tv )
   sw.0restarted = SWITCH( "RESTARTED" ) /* in LOCAL_PREINIT         */
   if sw.inispf = 0 then return        /* prevent RUNDATA failure    */

   "NEWSTACK"
   "RUNDATA READ TBLKEY ICEUSER "      /* ICEMEN                     */
   do queued()
      pull tag tagval
      tagval = Strip( tagval )
      @z     = Value( tag,tagval )     /* tag <-- tagval             */
   end                                 /* queued                     */
   "DELSTACK"
   special_ids = icemen

   parse value '' with  rxvsamll nvpref vspref
   "NEWSTACK"
   "RUNDATA READ  TBLKEY RXVSAM  "     /* RXVSAMLL  VSPREF           */
   do queued()                         /* return from RUNDATA        */
      pull tag tagval
      tagval  = Space( tagval,1 )
      @z   = Value( tag,tagval )       /* tag <-- tagval             */
   end                                 /* queued                     */
   "DELSTACK"

   if Words( rxvsamll  vspref ) < 2 then do
      helpmsg = "Some required information was not provided by",
                "RUNDATA.  Please ensure that RUNDATA key RXVSAM",
                "includes all of RXVSAMLL and VSPREF."
      call HELP                        /* ...and exit               -*/
      end

   parse value  KEYWD("VSAMIN") "'"vspref".SYSUMON.KSD'" with,
                vsksds   .

return                                 /*@ LOCAL_PREINIT             */
/*   subroutines below LOCAL_PREINIT are not selected by SHOWFLOW    */
/*
   Acquire the user name from internal control blocks.
.  ----------------------------------------------------------------- */
GETNAME: Procedure expose,             /*@                           */
         (tk_globalvars)
   address TSO

   ASCBASXB = d2x(c2d(Storage(224,4))+108)
   ASXBSENV = d2x(c2d(Storage(ASCBASXB,4))+200)
   ACEEUNAM = d2x(c2d(Storage(ASXBSENV,4))+100)
   Adr = c2x(Storage(ACEEUNAM,4))
   Name = Storage(d2x(c2d(Storage(ACEEUNAM,4))+1),c2d(Storage(Adr,1))-1)
   uname = Strip(Name,"B"," ")

return( name )                         /*@ GETNAME                   */
/*
   Dual-case each word presented as lower case with an initial capital.
.  ----------------------------------------------------------------- */
SHIFT: Procedure                       /*@                           */
   address TSO

   shifted = ""
   arg wordlist
   do Words( wordlist )
      parse var wordlist  word  wordlist
      low = Translate(word,,
                  "abcdefghijklmnopqrstuvwxyz",,
                  "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
      word  = Left(word,1)Substr(low,2)
      shifted = shifted  word
   end                                 /* wordlist                   */

return( shifted )                      /*@ SHIFT                     */
/*
.  ----------------------------------------------------------------- */
HELP:                                  /*@                           */
address TSO;"CLEAR" ; say ""
if helpmsg <> "" then say helpmsg
ex_nam = Left(exec_name,8)             /* predictable size           */

say "                                                                          "
say "  "ex_nam"      (v.2) tracks tool-usage.  Some required datapoints are    "
say "                provided via RUNDATA.                                     "
say "                                                                          "
say "  Syntax:   "ex_nam"  USER    uid                                         "
say "                      TOOL    toolname                                    "
say "                                                                          "
say "            uid       identifies a user for whom usage is to be counted.  "
say "                                                                          "
say "            toolname  identifies a piece of software for which usage is to"
say "                      be counted.                                         "
"NEWSTACK"; pull ; "CLEAR" ; "DELSTACK"
say "                                                                          "
say "       To use SYSUMON, you must define a suitable KSDS via IDCAMS:        "
say "                                                                          "
say "   DEFINE  CLUSTER (   NAME( <prefix>.SYSUMON.KSD ) INDEXED ) -           "
say "           DATA (   NAME( <prefix>.SYSUMON.DTA ) -                        "
say "         TRACK( 1 , 1 ) -                                                 "
say "         RECORDSIZE( 150 , 255 ) -                                        "
say "         FREESPACE( 12 , 12 ) -                                           "
say "         RECOVERY NOERASE UNORDERED NONSPANNED  -                         "
say "         REUSE  -                                                         "
say "         BUFFERSPACE( 12288 ) -                                           "
say "         SHAREOPTIONS( 1,3 ) -                                            "
say "         KEYS( 16 , 0 ) ) -                                               "
say "           INDEX (   NAME( <prefix>.SYSUMON.IDX ) -                       "
say "         TRACK( 1 , 1 ) -                                                 "
say "         UNORDERED REUSE  -                                               "
say "         SHAREOPTIONS( 1,3 ) )                                            "
say "                                                                          "
say "       Your installation may have additional requirements.  RXVSAM must be"
say "       installed and located where it can be implicitly called.  If       "
say "       necessary, RXVSAM may be LIBDEFed.                                 "
"NEWSTACK"; pull ; "CLEAR" ; "DELSTACK"
say "                                                                          "
say "       SYSUMON counts software usage by user.  SYSAMON reports periodic   "
say "       (monthly) usage and grooms the KSDS by scrubbing old data,         "
say "       preparing it for future use.  See the HELP text for SYSAMON for    "
say "       details.  SYSEMON allows editing the KSDS.                         "
say "                                                                          "
"NEWSTACK"; pull ; "CLEAR" ; "DELSTACK"
say "                                                                          "
say "   Debugging tools provided include:                                      "
say "                                                                          "
say "        MONITOR   displays key information throughout processing.         "
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             "
say "                  execution in 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                                 "
if sw.inispf then,
   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
   arg mode .

   "QSTACK"                            /* how many stacks?           */
   stk2dump    = rc - tk_init_stacks   /* remaining stacks           */
   if stk2dump = 0 & queued() = 0 then return
   if mode <> "QUIET" then,
   say "Total Stacks" rc ,             /* rc = #of stacks            */
    "   Begin Stacks" tk_init_stacks , /* Stacks present at start    */
    "   Excess Stacks to dump" stk2dump

   do dd = rc to tk_init_stacks by -1  /* empty each one.            */
      if mode <> "QUIET" then,
      say "Processing Stack #" dd "   Total Lines:" queued()
      do queued();parse pull line;say line;end /* pump to the screen */
      "DELSTACK"                       /* remove stack               */
   end                                 /* dd = 1 to rc               */

return                                 /*@ DUMP_QUEUE                */
/* Handle CLIST-form keywords             added 20020513
.  ----------------------------------------------------------------- */
CLKWD: Procedure expose info           /*@ hide all except info      */
   arg kw
   kw = kw"("                          /* form is 'KEY(DATA)'        */
   kw_pos = Pos(kw,info)               /* find where it is, maybe    */
   if kw_pos = 0 then return ""        /* send back a null, not found*/
   rtpt   = Pos(") ",info" ",kw_pos)   /* locate end-paren           */
   slug   = Substr(info,kw_pos,rtpt-kw_pos+1)     /* isolate         */
   info   = Delstr(info,kw_pos,rtpt-kw_pos+1)     /* excise          */
   parse var slug (kw)     slug        /* drop kw                    */
   slug   = Reverse(Substr(Reverse(Strip(slug)),2))
return slug                            /*@CLKWD                      */
/* Handle multi-word keys 20020513
.  ----------------------------------------------------------------- */
KEYWD: Procedure expose info           /*@ hide all vars, except info*/
   arg kw                              /* form is 'KEY DATA'         */
   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+Words(kw))/* 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                              /* form is 'KEY ;: DATA ;:'   */
   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  ssct   .                /* 'call ss 122 6' maybe      */
   if ssct  = "" then ssct  = 10
   if \datatype(ssbeg,"W") | \datatype(ssct,"W") then return
   ssend = ssbeg + ssct
   do ssii = ssbeg to ssend ; say Strip(sourceline(ssii),'T') ; end
return                                 /*@ SS                        */
/*
.  ----------------------------------------------------------------- */
SWITCH: Procedure expose info          /*@                           */
   arg kw                              /* form is 'KEY'              */
   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','5d'x )      /* clip trailing paren        */

   parse source  sys_id  how_invokt  exec_name  DD_nm  DS_nm,
                     as_invokt  cmd_env  addr_spc  usr_tokn

   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                    */

   sw.nested    = sysvar("SYSNEST") = "YES"
   sw.batch     = sysvar("SYSENV")  = "BACK"
   sw.inispf    = sysvar("SYSISPF") = "ACTIVE"

   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          .

   parse value KEYWD("TRACE")  "N"    with   tv  .
   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              */