git.oblomov.eu Git - ohcount/blob - test/src_dir/rexx1.rex

   1 /* REXX    FLTTBL     Cloned from DUMPTBL 960619 to produce a flat
   2                       version (up to 32K characters wide) of any ISPF
   3                       table.
   4
   5            Written by Frank Clarke, Oldsmar, FL
   6
   7      Impact Analysis
   8 .    SYSPROC   LA
   9 .    SYSPROC   TRAPOUT
  10
  11      Modification History
  12      19960918 fxc added some error-checking
  13      19970115 fxc upgrade REXXSKEL from v.960606 to v.970113; add
  14                   RESTARTability;
  15      19991231 fxc upgrade REXXSKEL from v.970113 to v.19991109;
  16                   RXSKLY2K; DECOMM; LRECL reduced from 32K to "min
  17                   needed";
  18
  19 */ arg argline
  20 address TSO                            /* REXXSKEL ver.19991109      */
  21 arg parms "((" opts
  22
  23 signal on syntax
  24 signal on novalue
  25
  26 call TOOLKIT_INIT                      /* conventional start-up     -*/
  27 rc     = Trace(tv)
  28 info   = parms                         /* to enable parsing          */
  29
  30 if \sw.inispf  then do
  31    arg line
  32    line = line "((  RESTARTED"         /* tell the next invocation   */
  33    "ISPSTART CMD("exec_name line")"    /* Invoke ISPF if nec.        */
  34    exit                                /* ...and restart it          */
  35    end
  36
  37 call A_INIT                            /*                           -*/
  38
  39 "NEWSTACK"
  40                                     if \sw.0error_found then,
  41 call C_TABLE_OPS                       /*                           -*/
  42                                     if \sw.0error_found then,
  43 call D_PUMP_TBL                        /*                           -*/
  44
  45 "DELSTACK"
  46
  47 if sw.restarted then do
  48    rc = OutTrap("ll.")
  49    exit 4
  50    end
  51
  52 exit                                   /*@ FLTTBL                    */
  53 /*
  54 .  ----------------------------------------------------------------- */
  55 A_INIT:                                /*@                           */
  56    if branch then call BRANCH
  57    address TSO
  58
  59    call AA_KEYWDS                      /*                           -*/
  60    parse var info  $tn$    .           /* table-name required        */
  61    if $tn$ = "" then do
  62       helpmsg = "Tablename is required."
  63       call HELP
  64       end
  65
  66    parse value outdsn "FLATTBLS."$tn$     with,
  67                outdsn  .
  68
  69    xefef     = "efef"x
  70    if tblds = "" then do
  71       call AB_FIND_LIBRARY             /*                           -*/
  72       if tblds = "" then do
  73          helpmsg = "Table" $tn$ "was not found in ISPTLIB.  Please",
  74                    "restart specifying a library name as shown below."
  75          call HELP                     /* ...and don't come back     */
  76          end
  77       end
  78    else,
  79    if Left(tblds,1) = "'" then tblds = Strip(tblds,,"'")
  80                           else tblds = Userid()"."tblds
  81
  82 return                                 /*@ A_INIT                    */
  83 /*
  84 .  ----------------------------------------------------------------- */
  85 AA_KEYWDS:                             /*@                           */
  86    if branch then call BRANCH
  87    address TSO
  88
  89    tblds       = KEYWD("IN")
  90    outdsn      = KEYWD("OUTPUT")
  91    sortseq     = KEYWD("SORT")
  92    sw.0purge   = SWITCH("DELETEBEHIND")
  93
  94    parse value KEYWD("ADD") "0"  with  bytes_to_add  .
  95
  96 return                                 /*@ AA_KEYWDS                 */
  97 /*
  98    <tblds> was not specified.  Locate the table in ISPTLIB.
  99 .  ----------------------------------------------------------------- */
 100 AB_FIND_LIBRARY:                       /*@                           */
 101    if branch then call BRANCH
 102    address TSO
 103
 104    "NEWSTACK"
 105    "LA ISPTLIB ((STACK LINE"
 106    pull tliblist
 107    "DELSTACK"
 108
 109    do Words(tliblist)                  /* each library               */
 110       parse var tliblist  tblds  tliblist
 111       if Sysdsn("'"tblds"("$tn$")'") = "OK" then return
 112    end                                 /* tliblist                   */
 113    tblds = ""
 114
 115 return                                 /*@ AB_FIND_LIBRARY           */
 116 /*
 117 .  ----------------------------------------------------------------- */
 118 C_TABLE_OPS:                           /*@                           */
 119    if branch then call BRANCH
 120    address ISPEXEC
 121
 122    call CA_OPEN_TBL                    /*                           -*/
 123    call CS_SPIN_TBL                    /*                           -*/
 124    call CZ_DROP_TBL                    /*                           -*/
 125
 126 return                                 /*@ C_TABLE_OPS               */
 127 /*
 128 .  ----------------------------------------------------------------- */
 129 CA_OPEN_TBL:                           /*@                           */
 130    if branch then call BRANCH
 131    address ISPEXEC
 132
 133    "LIBDEF ISPTLIB DATASET ID('"tblds"')  STACK"
 134    "TBSTATS" $tn$ "STATUS1(s1) STATUS2(s2) ROWCURR(rowct)"
 135    if s1 > 1 then do
 136       say "Table" $tn$ "not available."
 137       sw.0error_found = "1"; return
 138       end; else,
 139    if s2 = 1 then,                     /* not open                   */
 140       "TBOPEN " $tn$ "NOWRITE"
 141    else "TBTOP" $tn$
 142    "LIBDEF ISPTLIB"
 143                                        if sw.0error_found then return
 144    "TBQUERY" $tn$  "KEYS(keylist)",
 145                    "NAMES(nmlist)"
 146    parse var keylist "(" keylist ")"
 147    parse var  nmlist "("  nmlist ")"
 148    namelist = keylist nmlist
 149
 150    if sortseq <> "" then "TBSORT" $tn$ "FIELDS("sortseq")"
 151
 152 return                                 /*@ CA_OPEN_TBL               */
 153 /*
 154 .  Given: <namelist> contains all the defined names for this table.
 155    The table has been TOPped.
 156 .  ----------------------------------------------------------------- */
 157 CS_SPIN_TBL: Procedure expose,         /*@ hide everything           */
 158       expose (tk_globalvars),          /* except these               */
 159       $tn$  namelist  xefef  tblds  rows  keylist  nmlist  maxlen
 160                                                         cs_tv = Trace()
 161    if branch then call BRANCH
 162    address ISPEXEC
 163
 164    maxlen = 0                          /* maximum line length        */
 165    do forever
 166       "TBSKIP" $tn$ "SAVENAME(xvars)"
 167       if rc > 0 then leave             /* we're done...              */
 168       line  = ""                       /* set empty                  */
 169                            /* add blocks of "var .. varvalue .."     */
 170       do cx = 1 to Words(namelist)
 171          thiswd = Word(namelist,cx)
 172          line = line thiswd xefef Value(thiswd) xefef
 173       end                              /* cx                         */
 174       rc = Trace("O"); rc = Trace(cs_tv)
 175       parse var xvars "(" xvars ")"
 176                            /* add a block of "XVARS .. xvarlist .."  */
 177       line = line "XVARS" xefef xvars xefef
 178                            /* add blocks of "xvar .. xvarvalue .."   */
 179       do cx = 1 to Words(xvars)
 180          thiswd = Word(xvars,cx)
 181          line = line thiswd xefef Value(thiswd) xefef
 182       end                              /* cx                         */
 183       rc = Trace("O"); rc = Trace(cs_tv)
 184       maxlen  = Max(maxlen,Length(line))
 185       queue line
 186    end                                 /* forever                    */
 187
 188    lines_in_stack = queued()
 189    line = "Contents of" $tn$ "in" tblds,
 190           "("lines_in_stack" rows)  KEYS("keylist")  NAMES("nmlist")."
 191    push line                           /* make it the first line     */
 192    maxlen  = Max(maxlen,Length(line))
 193    if monitor then say "Maximum line length is" maxlen
 194
 195 return                                 /*@ CS_SPIN_TBL               */
 196 /*
 197 .  ----------------------------------------------------------------- */
 198 CZ_DROP_TBL:                           /*@                           */
 199    if branch then call BRANCH
 200    address ISPEXEC
 201
 202    if s2 = 1 then,                     /* table was not open at start*/
 203       "TBEND" $tn$
 204
 205 return                                 /*@ CZ_DROP_TBL               */
 206 /*
 207 .  ----------------------------------------------------------------- */
 208 D_PUMP_TBL:                            /*@                           */
 209    if branch then call BRANCH
 210    address TSO
 211
 212    if monitor then say,
 213       "Writing text."
 214
 215    maxlen = maxlen + 4 + bytes_to_add  /* set LRECL                  */
 216    vbmax.0   = "NEW CATALOG UNIT(SYSDA) SPACE(1 5) TRACKS",
 217                     "RECFM(V B) LRECL("maxlen") BLKSIZE(0)"
 218    vbmax.1   = "SHR"                   /* if it already exists...    */
 219
 220    tempstat = Sysdsn(outdsn) = "OK"    /* 1=exists, 0=missing        */
 221    "ALLOC FI($TMP) DA("outdsn") REU" vbmax.tempstat
 222    rcx = rc
 223    "EXECIO" queued() "DISKW $TMP (FINIS"
 224    rcx = max(rcx,rc)
 225    "FREE  FI($TMP)"
 226
 227    if rcx = 0 & sw.0purge then do
 228       address ISPEXEC
 229       "LIBDEF  ISPTLIB  DATASET  ID('"tblds"')  STACK"
 230       "TBERASE" $tn$
 231       if rc = 0 then say $tn$ "was deleted"
 232       "LIBDEF  ISPTLIB"
 233       end
 234
 235 return                                 /*@ D_PUMP_TBL                */
 236 /*
 237 .  ----------------------------------------------------------------- */
 238 LOCAL_PREINIT:                         /*@ customize opts            */
 239    if branch then call BRANCH
 240    address TSO
 241
 242
 243 return                                 /*@ LOCAL_PREINIT             */
 244 /*
 245 .  ----------------------------------------------------------------- */
 246 HELP:                                  /*@                           */
 247 address TSO;"CLEAR"
 248 if helpmsg <> "" then do ; say helpmsg; say ""; end
 249 ex_nam = Left(exec_name,8)             /* predictable size           */
 250 say "  "ex_nam"      produces a flattened version of any ISPF table    "
 251 say "                into a VB-form dataset of minimum necessary LRECL."
 252 say "                                                                  "
 253 say "   The field contents are written in KEYPHRS format               "
 254 say "             (var .. varval ..)                                   "
 255 say "   key-fields first, followed by name-fields, followed by the     "
 256 say "   names of any extension variables key-phrased by 'XVARS',       "
 257 say "   followed by the extension variables themselves in KEYPHRS      "
 258 say "   format.                                                        "
 259 say "                                                                  "
 260 say "   The first record on the file identifies the table name, the    "
 261 say "   source library, the number of rows processed, and the key- and "
 262 say "   name-fields.                                                   "
 263 say "                                                                  "
 264 say "                                             more....             "
 265 pull
 266 "CLEAR"
 267 say "  Syntax:   "ex_nam"  <tbl>                             (Required)"
 268 say "                      <IN     libdsn>                             "
 269 say "                      <OUTPUT outdsn>                   (Defaults)"
 270 say "                      <SORT   sortspec>                           "
 271 say "                      <ADD    bytes>                    (Defaults)"
 272 say "                                                                          "
 273 say "            <tbl>     identifies the table to be dumped.                  "
 274 say "                                                                          "
 275 say "            <libdsn>  identifies the ISPF Table library which holds <tbl>."
 276 say "                      If <libdsn> is not specified, ISPTLIB will be       "
 277 say "                      searched to find the correct dataset.               "
 278 say "                                                                          "
 279 say "            <outdsn>  (default: FLATTBLS.<tbl>) names the output file.    "
 280 say "                      <outdsn> will be created if it does not exist.      "
 281 say "                                                                          "
 282 say "            <sortspec> causes the table to be sorted as indicated before  "
 283 say "                      being dumped.                                       "
 284 say "                                                                          "
 285 say "            <bytes>   (default=0) causes the LRECL of the output dataset  "
 286 say "                      to be extended to enable updating.                  "
 287 pull
 288 "CLEAR"
 289 say "   Debugging tools provided include:                              "
 290 say "                                                                  "
 291 say "        MONITOR:  displays key information throughout processing. "
 292 say "                  Displays most paragraph names upon entry.       "
 293 say "                                                                  "
 294 say "        NOUPDT:   by-pass all update logic.                       "
 295 say "                                                                  "
 296 say "        BRANCH:   show all paragraph entries.                     "
 297 say "                                                                  "
 298 say "        TRACE tv: will use value following TRACE to place the     "
 299 say "                  execution in REXX TRACE Mode.                   "
 300 say "                                                                  "
 301 say "                                                                  "
 302 say "   Debugging tools can be accessed in the following manner:       "
 303 say "                                                                  "
 304 say "        TSO "ex_nam"  parameters     ((  debug-options            "
 305 say "                                                                  "
 306 say "   For example:                                                   "
 307 say "                                                                  "
 308 say "        TSO "ex_nam" vt2231 add 17 (( MONITOR TRACE ?R            "
 309 address ISPEXEC "CONTROL DISPLAY REFRESH"
 310 exit                                   /*@ HELP                      */
 311 /*   REXXSKEL back-end removed for space   */