/* REXX VCX Re-write of Jim Connelley's VC to take advantage of LISTCSUM Use '(routine name) ?' for HELP-text. Written by Frank Clarke 20020507 rexxhead@yahoo.com Impact Analysis . SYSEXEC LISTCSUM . SYSEXEC SYSUMON . SYSEXEC TRAPOUT Modification History 20020722 fxc NUMBERED on CLUSTER only; ignore NOWRITECHK, NOIMBED, NOREPLICAT, NOREUSE; 20020819 fxc rearranged parameters; drop obsolete tags 20030331 fxc no SUMMARY for a GDGBASE; a single generation of a GDG will show as NONVSAM with a 'GDG' tag in NONVSAMASSOCIATIONS; 20050207 fxc make sure output requires manual intervention; 20080410 fxc LISTCAT shows 'NONUNIQKEY' for AIX, but DEFINE wants 'NONUNIQUEKEY'; 20080722 fxc relabel BGG_DEFNVSAM to BGN_; 20160930 fxc an empty GDG BASE will have no NONVSAMASSOCIATIONS; parsing GDG will yield null 20211030 fxc LOG progress 20230401 fxc SYSUMON only if not testing 20230510 fxc save log if error or requested 20230723 fxc modernize logging; 20230810 fxc set msglim based on screen width; 20230824 fxc LISTCSUM was returning an empty queue; outdsn had LRECL=0; 20230908 fxc set log lrecl to 255; 20230917 fxc enable KEEP; 20231011 fxc correct syntax of DELETE; 20240308 fxc chg dollar-sign to @ everywhere; 20240415 fxc DUMP_QUEUE quiet; 20240529 fxc corrected DEFINE ALIAS for NONVSAM; 20250613 fxc add exec_name to logpref; 20250925 fxc SPACEOUT; new BACKEND; 20251014 fxc new @LOGMSG; 20251017 fxc upgrade for MSGPARMS; */ arg argline address TSO /* REXXSKEL ver.20020513 */ arg parms "((" opts signal on syntax signal on novalue call TOOLKIT_INIT /* conventional start-up -*/ rc = Trace( "O" ); rc = trace( tv ) info = parms /* to enable parsing */ call A_INIT /* -*/ call B_PROCESS_CAT /* -*/ if sw.0error_found + sw.0savelog > 0 then, call ZB_SAVELOG /* -*/ if \sw.0nested then call DUMP_QUEUE 'quiet' /* -*/ exit /*@ VCX */ /* . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address TSO if tv = 'N' then, /* only if not testing */ "SYSUMON USER" Userid() "TOOL" exec_name call AK_KEYWDS /* -*/ call AL_SETUP_LOG /* -*/ logpref = exec_name "("Branch( "ID" )")" call ZL_LOGMSG( exec_name "started by" Userid() yyyymmdd hhmmss ) call ZL_LOGMSG( logpref "Arg:" argline ) parse value "0 0 0 0 0 0 0 0 0 0" with , ct. . parse value "" with , taglist tagdata. , vwsuff , . parse var info dsname info return /*@ A_INIT */ /* . ----------------------------------------------------------------- */ AK_KEYWDS: /*@ */ if branch then call BRANCH address TSO sw.0Skinny = SWITCH( "SKINNY" ) outspec = KEYWD( "OUTPUT" ) parse value outspec exec_name".SYSOUT" with, outdsn . if outspec <> '' then, parms = parms 'KEEP' if Pos( "(" , outdsn ) > 0 then, sw.0outpds = 1 /* output is partitioned */ return /*@ AK_KEYWDS */ /* . ----------------------------------------------------------------- */ AL_SETUP_LOG: /*@ */ if branch then call BRANCH address TSO msglim = SYSVAR( "SYSWTERM" ) - 12 msgparms = 'msglim log# log. ' parse value "0 0 0 0 0" with, log# log. . parse value Date( "S" ) Time( "S" ) Time( "N" ) with, yyyymmdd sssss hhmmss . hhmmss = Space( Translate( hhmmss,' ',':' ) ,0 ) 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""Left( hhmmss,4 ) /* X141743 ? */ vblog.0 = "NEW CATALOG UNIT( SYSDA ) SPACE( 1 5 ) TRACKS", "RECFM( V B ) LRECL( 255 ) BLKSIZE( 0 )" vblog.1 = "MOD" /* if it already exists... */ logdsn = "@LOG."exec_name"."subid".LIST" if Sysdsn( logdsn ) = "OK" then, call ZL_LOGMSG( "-------------------" ) return /*@ AL_SETUP_LOG */ /* Obtain definition data via LISTC; parse it into its components; recreate the DEFINE which produced this picture. . ----------------------------------------------------------------- */ B_PROCESS_CAT: /*@ */ if branch then call BRANCH address TSO "NEWSTACK" call BD_PULL_DATAPOINTS /* -*/ "DELSTACK" ; "NEWSTACK" if \sw.0error_found then, call BG_WRITE_DEFINE /* -*/ "DELSTACK" return /*@ B_PROCESS_CAT */ /* . ----------------------------------------------------------------- */ BD_PULL_DATAPOINTS: /*@ */ if branch then call BRANCH address TSO "LISTCSUM" dsname "STACK" /* -*/ logpref = exec_name "("Branch( "ID" )")" do queued() /* each queued line */ parse pull keytag ":" tagdata taglist = taglist keytag /* add to list */ tagdata.keytag = Strip( tagdata )/* load tagdata to keytag */ call ZL_LOGMSG( logpref keytag" : "tagdata.keytag ) end /* queued */ logpref = exec_name "("Branch( "ID" )")" call ZL_LOGMSG( logpref "TagList : "taglist ) info = tagdata.SUMMARY parse value KEYWD( "AIX" ) 0 with ct.0aix . parse value KEYWD( "ALIAS" ) 0 with ct.0alias . parse value KEYWD( "CLUSTER" ) 0 with ct.0cluster . parse value KEYWD( "DATA" ) 0 with ct.0data . parse value KEYWD( "PATH" ) 0 with ct.0path . parse value KEYWD( "GDG" ) 0 with ct.0gdg . parse value KEYWD( "INDEX" ) 0 with ct.0index . parse value KEYWD( "NONVSAM" ) 0 with ct.0nonvsam . parse value KEYWD( "TOTAL" ) 0 with ct.0total . ct.0subtot = ct.0alias + ct.0cluster + ct.0data + ct.0gdg + , ct.0aix + ct.0path + , ct.0index + ct.0nonvsam if ct.0total > ct.0subtot then do /* stuff we can't handle */ errmsg = exec_name "is not yet capable of handling something in", "this list:" info logpref = exec_name "("Branch( "ID" )")" call ZL_LOGMSG( logpref errmsg ) if /monitor then, say errmsg sw.0error_found = 1 return /* we're done */ end if ct.0alias > 0 then call BDA_ALIAS /* -*/ if ct.0cluster > 0 then call BDC_CLU /* -*/ if ct.0gdg > 0 then call BDG_GDG /* -*/ if ct.0nonvsam > 0 then call BDN_NV /* -*/ if ct.0aix > 0 then call BDX_AIX /* -*/ return /*@ BD_PULL_DATAPOINTS */ /* An ALIAS is also referenced in NONVSAMASSOCIATIONS . ----------------------------------------------------------------- */ BDA_ALIAS: /*@ */ if branch then call BRANCH address TSO info = tagdata.dataassociations base = KEYWD( "NONVSAM" ) alias = dsname alias = tagdata.alias logpref = exec_name "("Branch( "ID" )")" call ZL_LOGMSG( logpref, "Base="base "Alias="alias ) return /*@ BDA_ALIAS */ /* CLUSTER. . ----------------------------------------------------------------- */ BDC_CLU: /*@ */ if branch then call BRANCH address TSO clusterdsn = tagdata.cluster info = tagdata.clusterassociations datadsn = KEYWD( "DATA" ) indexdsn = KEYWD( "INDEX" ) logpref = exec_name "("Branch( "ID" )")" call ZL_LOGMSG( logpref, "DataDSN="datadsn "IndexDSN="indexdsn ) info = tagdata.clustersmsdata stgcls = KEYWD( "STORAGECLASS" ) mgmtcls = KEYWD( "MANAGEMENTCLASS" ) datacls = KEYWD( "DATACLASS" ) call ZL_LOGMSG( logpref, "Stgcls="stgcls "Mgmtcls="mgmtcls "Datacls="datacls ) if ct.0data > 0 then, call BDCD_DATA /* -*/ if ct.0index > 0 then, call BDCI_INDEX /* -*/ return /*@ BDC_CLU */ /* CLUSTER DATA . ----------------------------------------------------------------- */ BDCD_DATA: /*@ */ if branch then call BRANCH address TSO info = tagdata.dataattributes keylen = KEYWD( "KEYLEN" ) avgrecl = KEYWD( "AVGLRECL" ) bufspc = KEYWD( "BUFSPACE" ) cisize = KEYWD( "CISIZE" ) rkp = KEYWD( "RKP" ) maxrecl = KEYWD( "MAXLRECL" ) excpext = KEYWD( "EXCPEXIT" ) recsper = KEYWD( "RECORDS/CI" ) maxrecs = KEYWD( "MAXRECS" ) cicapct = KEYWD( "CI/CA" ) shropts = CLKWD( "SHROPTNS" ) /* CLIST-form */ dataopts = Space( info,1 ) /* whatever is left */ logpref = exec_name "("Branch( "ID" )")" call ZL_LOGMSG( logpref, "Keylen="keylen "AvgRECL="avgrecl, "Bufspc="bufspc "CIsize="cisize "RKP="rkp, "Maxrecl="maxrecl "EXCPext="excpext, "Recsper="recsper "Maxrecs="maxrecs, "Cicapct="cicapct "Shropts="shropts, "Dataopts="dataopts, ) info = tagdata.dataallocation spctyp = KEYWD( "SPACE TYPE" ) spcpri = KEYWD( "SPACE PRI" ) spcsec = KEYWD( "SPACE SEC" ) call ZL_LOGMSG( logpref, "Spctyp="spctyp "Spcpri="spcpri "Spcsec="spcsec, ) info = tagdata.datastatistics dfspcci = KEYWD( "FREESPACE %CI" ) dfspcca = KEYWD( "FREESPACE %CA" ) call ZL_LOGMSG( logpref, "DFspcci="dfspcci "DFspcca="dfspcca, ) info = tagdata.dataassociations clusterdsn = KEYWD( "CLUSTER" ) call ZL_LOGMSG( logpref, "ClusterDSN="clusterdsn, ) return /*@ BDCD_DATA */ /* CLUSTER INDEX . ----------------------------------------------------------------- */ BDCI_INDEX: /*@ */ if branch then call BRANCH address TSO info = tagdata.indexattributes idxklen = KEYWD( "KEYLEN" ) idxavgl = KEYWD( "AVGLRECL" ) idxbuf = KEYWD( "BUFSPACE" ) idxci = KEYWD( "CISIZE" ) idxrkp = KEYWD( "RKP" ) idxmaxl = KEYWD( "MAXLRECL" ) idxecpx = KEYWD( "EXCPEXIT" ) idxcica = KEYWD( "CI/CA" ) idxshro = CLKWD( "SHROPTNS" ) /* CLIST-form */ idxopts = Space( info,1 ) /* whatever is left */ logpref = exec_name "("Branch( "ID" )")" call ZL_LOGMSG( logpref , "IDXklen="idxklen "IDXavgl="idxavgl, "IDXbuf="idxbuf "IDXci="idxci, "IDXrkp="idxrkp "IDXmaxl="idxmaxl, "IDXecpx="idxecpx "IDXcica="idxcica, "IDXshro="idxshro "IDXopts="idxopts, ) info = tagdata.indexallocation idxspc = KEYWD( "SPACE TYPE" ) idxpri = KEYWD( "SPACE PRI" ) idxsec = KEYWD( "SPACE SEC" ) call ZL_LOGMSG( logpref , "IDXspc="idxspc "IDXpri="idxpri "IDXsec="idxsec, ) info = tagdata.indexstatistics xfspcci = KEYWD( "FREESPACE %CI" ) xfspcca = KEYWD( "FREESPACE %CA" ) call ZL_LOGMSG( logpref , "Xfspcci="xfspcci "Xfspcca="xfspcca, ) info = tagdata.indexassociations clusterdsn = KEYWD( "CLUSTER" ) call ZL_LOGMSG( logpref , "ClusterDSN="clusterdsn, ) return /*@ BDCI_INDEX */ /* . Missing: OWNER, TO, FROM If the GDG BASE is empty, there will be no NONVSAMASSOCIATIONS from which to acquire the Base name. . ----------------------------------------------------------------- */ BDG_GDG: /*@ */ if branch then call BRANCH address TSO info = tagdata.gdgbaseattributes gdglim = KEYWD( "LIMIT" ) info = tagdata.nonvsamassociations parse value KEYWD( "GDG" ) dsname with dsname . gdgopts = Space( info,1 ) /* whatever is left */ logpref = exec_name "("Branch( "ID" )")" call ZL_LOGMSG( logpref, "GDGlim="gdglim "GDGopts="gdgopts, ) ct.0nonvsam = 0 /* don't process NONVSAM */ return /*@ BDG_GDG */ /* NON-VSAM still undo: if a non-vsam file has an alias, DEFINE ALIAS . ----------------------------------------------------------------- */ BDN_NV: /*@ */ if branch then call BRANCH address TSO info = tagdata.nonvsamsmsdata stgcls = KEYWD( "STORAGECLASS" ) mgmtcls = KEYWD( "MANAGEMENTCLASS" ) datacls = KEYWD( "DATACLASS" ) logpref = exec_name "("Branch( "ID" )")" call ZL_LOGMSG( logpref, "Stgcls="stgcls "Mgmtcls="mgmtcls "Datacls="datacls, ) info = tagdata.nonvsamassociations nvalias = KEYWD( "ALIAS" ) nvgdg = KEYWD( "GDG" ) call ZL_LOGMSG( logpref, "NValias="nvalias "NVGDG="nvgdg, ) return /*@ BDN_NV */ /* AIX (alternate index) . ----------------------------------------------------------------- */ BDX_AIX: /*@ */ if branch then call BRANCH address TSO info = tagdata.aixassociations baseclname = KEYWD( "CLUSTER" ) /* base clustername */ datadsn = KEYWD( "DATA" ) /* data name */ indexdsn = KEYWD( "INDEX" ) /* index name */ pathdsn = KEYWD( "PATH" ) /* path name */ logpref = exec_name "("Branch( "ID" )")" call ZL_LOGMSG( logpref, "BaseCLname="baseclname "DataDSN="datadsn, "IndexDSN="indexdsn "PathDSN="pathdsn, ) aixattrib = Space( tagdata.aixattributes,1 ) call ZL_LOGMSG( logpref, "AIXattrib="aixattrib, ) info = tagdata.dataassociations aixname = KEYWD( "AIX" ) /* base AIX name */ call ZL_LOGMSG( logpref, "AIXname="aixname, ) info = tagdata.dataattributes keylen = KEYWD( "KEYLEN" ) avgrecl = KEYWD( "AVGLRECL" ) bufspc = KEYWD( "BUFSPACE" ) cisize = KEYWD( "CISIZE" ) rkp = KEYWD( "RKP" ) maxrecl = KEYWD( "MAXLRECL" ) axrkp = KEYWD( "AXRKP" ) shropts = CLKWD( "SHROPTNS" ) nunqkey = SWITCH( "NONUNIQKEY" ) unqkey = SWITCH( "UNIQKEY" ) + SWITCH( "UNIQUEKEY" ) call ZL_LOGMSG( logpref, "Keylen="keylen "Avgrecl="avgrecl, "Bufspc="bufspc "CIsize="cisize, "RKP="rkp "Maxrecl="maxrecl "Axrkp="axrkp, "Shropts="shropts "Nunqkey="nunqkey, "Unqkey="unqkey, ) rc = Trace( "O" ) @z = KEYWD( "EXCPEXIT" ) @z = KEYWD( "CI/CA" ) @z = SWITCH( "INDEXED" ) @z = SWITCH( "NOWRITECHK" ) @z = SWITCH( "WRITECHK" ) @z = SWITCH( "NOIMBED" ) @z = SWITCH( "IMBED" ) @z = SWITCH( "REPLICAT" ) @z = SWITCH( "NOREPLICAT" ) @z = SWITCH( "ORDERED" ) @z = SWITCH( "UNORDERED" ) @z = SWITCH( "NOREUSE" ) @z = SWITCH( "REUSE" ) @z = SWITCH( "SPANNED" ) rc = trace( tv ) dataopts = Space( info,1 ) /* all remaining */ call ZL_LOGMSG( logpref, "Dataopts="dataopts, ) info = tagdata.datastatistics cipct = KEYWD( "FREESPACE %CI" ) capct = KEYWD( "FREESPACE %CA" ) call ZL_LOGMSG( logpref, "CIpct=" cipct "CApct="capct, ) info = tagdata.dataallocation spctyp = KEYWD( "SPACE TYPE" ) spcpri = KEYWD( "SPACE PRI" ) spcsec = KEYWD( "SPACE SEC" ) call ZL_LOGMSG( logpref, "Spctyp="spctyp "Spcpri="spcpri "Spcsec="spcsec, ) info = tagdata.indexallocation idxspc = KEYWD( "SPACE TYPE" ) idxpri = KEYWD( "SPACE PRI" ) idxsec = KEYWD( "SPACE SEC" ) call ZL_LOGMSG( logpref, "IDXspc="idxspc "IDXpri="idxpri "IDXsec="idxsec, ) info = tagdata.indexattributes idxklen = KEYWD( "KEYLEN" ) idxavgl = KEYWD( "AVGLRECL" ) idxbuf = KEYWD( "BUFSPACE" ) idxci = KEYWD( "CISIZE" ) idxrkp = KEYWD( "RKP" ) idxmaxl = KEYWD( "MAXLRECL" ) call ZL_LOGMSG( logpref, "IDXklen="idxklen "IDXavgl="idxavgl, "IDXbuf="idxbuf "IDXci="idxci, "IDXrkp="idxrkp "IDXmaxl="idxmaxl, ) pathopts = tagdata.pathattributes call ZL_LOGMSG( logpref, "Pathopts="pathopts, ) return /*@ BDX_AIX */ /* . ----------------------------------------------------------------- */ BG_WRITE_DEFINE: /*@ */ if branch then call BRANCH address TSO if ct.0alias > 0 then, call BGA_DEFALIAS /* -*/ if ct.0cluster > 0 then, call BGC_DEFCL /* -*/ if ct.0gdg > 0 then, call BGG_DEFGDG /* -*/ if ct.0nonvsam > 0 then, call BGN_DEFNVSAM /* -*/ if ct.0aix > 0 then, call BGX_DEFAIX /* -*/ call BGY_OUTPUT_DEFINE /* */ if sw.0BrowseTMP then do /* display text */ call BGZ_BROWSE_TMP /* -*/ "FREE FI( @TMP )" end /* BrowseTMP */ if WordPos( 'KEEP',parms ) = 0 then do msgstat = Msg( 'Off' ) "DELETE "outdsn rc = Msg( msgstat ) end return /*@ BG_WRITE_DEFINE */ /* . ----------------------------------------------------------------- */ BGA_DEFALIAS: /*@ */ if branch then call BRANCH address TSO queue " DEFINE ALIAS -" queue " ( NAME( -"alias" ) -" queue " RELATE( -"base" ) )" return /*@ BGA_DEFALIAS */ /* . ----------------------------------------------------------------- */ BGC_DEFCL: /*@ */ if branch then call BRANCH address TSO info = dataopts /* ready for parsing */ sw.0numbered = SWITCH( "NUMBERED" ) /* RRDS ? */ sw.0indexed = SWITCH( "INDEXED" ) /* KSDS ? */ sw.0nonindx = SWITCH( "NONINDEXED" ) /* ESDS ? */ sw.0linear = SWITCH( "LINEAR" ) /* Linear DS ? */ sw.0reuse = SWITCH( "REUSE" ) sw.0noreuse = SWITCH( "NOREUSE" ) if sw.0reuse = sw.0noreuse then, parse value "0 1" with sw.0reuse sw.0noreuse . sw.0unique = SWITCH( "UNIQUE" ) if sw.0reuse then sw.0unique = 0 @z = SWITCH( "NOWRITECHK" ) @z = SWITCH( "NOIMBED" ) @z = SWITCH( "NOREPLICAT" ) dataopts = Space( info,1 ) /* restore corrected */ queue " DELETE" "-"clusterdsn "CLUSTER" queue " " queue " SET MAXCC = 0" queue " " queue " DEFINE CLUSTER -" queue " ( NAME( -"clusterdsn" ) -" attribs = "" if sw.0numbered then, attribs = attribs "NUMBERED" if sw.0indexed then, attribs = attribs "INDEXED" if sw.0nonindx then, attribs = attribs "NONINDEXED" if sw.0linear then, attribs = attribs "LINEAR" if attribs <> "" then , queue " "Space( attribs,1 )" -" if ct.0data > 0 then do if sw.0Skinny = 0 then do queue " ) -" queue " DATA -" queue " ( NAME( -"datadsn ") -" end /* skinny - drop this */ queue " "spctyp"(" spcpri "," spcsec ") -" queue " RECORDSIZE( " avgrecl "," maxrecl " ) -" queue " FREESPACE( " dfspcci "," dfspcca " ) -" if sw.0reuse then dataopts = dataopts "REUSE" else dataopts = dataopts "NOREUSE" dataopts = Space( dataopts,1 ) do while dataopts <> "" pt = LastPos( " ",dataopts" ",40 ) slug = Substr( dataopts,1,pt ) dataopts = Delstr( dataopts,1,pt ) queue " "slug" -" end /* dataopts */ queue " BUFFERSPACE( " bufspc " ) -" queue " SHAREOPTIONS(" shropts ") -" if keylen > 0 then, queue " KEYS(" keylen "," rkp ") -" end /* DATA */ if ct.0index > 0 then do if sw.0Skinny = 0 then do queue " ) -" queue " INDEX -" queue " ( NAME( -"indexdsn ") -" queue " "idxspc"(" idxpri "," idxsec ") -" info = idxopts /* ready for parsing */ rc = Trace( "O" ) @z = SWITCH( "SPEED" ) @z = SWITCH( "RECOVERY" ) @z = SWITCH( "ERASE" ) @z = SWITCH( "NOERASE" ) @z = SWITCH( "UNIQUE" ) @z = SWITCH( "WRITECHK" ) @z = SWITCH( "NOWRITECHK" ) @z = SWITCH( "NOREPLICAT" ) @z = SWITCH( "REPLICAT" ) @z = SWITCH( "REPLICATE" ) rc = trace( tv ) idxopts = Space( info,1 ) /* ready to load */ idxopts = Space( idxopts,1 ) do while idxopts <> "" pt = LastPos( " ",idxopts" ",40 ) slug = Substr( idxopts,1,pt ) idxopts = Delstr( idxopts,1,pt ) queue " "slug" -" end /* idxopts */ queue " SHAREOPTIONS(" idxshro ") -" end /* skinny - drop this */ end /* INDEX */ queue " )" queue " " queue " VERIFY DATASET( -"clusterdsn ")" return /*@ BGC_DEFCL */ /* . ----------------------------------------------------------------- */ BGG_DEFGDG: /*@ */ if branch then call BRANCH address TSO queue " DEFINE GENERATIONDATAGROUP -" queue " ( NAME( -"dsname ") -" queue " LIMIT(" gdglim ") -" queue " " gdgopts ")" return /*@ BGG_DEFGDG */ /* . ----------------------------------------------------------------- */ BGN_DEFNVSAM: /*@ */ if branch then call BRANCH address TSO nvbase = tagdata.nonvsam queue " DEFINE NONVSAM -" queue " ( NAME( -"nvbase ") )" if nvalias <> "" then do queue " DEFINE ALIAS ( -" queue " NAME( -"nvalias ") -" queue " RELATE( -"nvbase " ) )" end /* nvalias */ return /*@ BGN_DEFNVSAM */ /* . ----------------------------------------------------------------- */ BGX_DEFAIX: /*@ */ if branch then call BRANCH address TSO queue " DELETE" "-"aixname " AIX" queue " " queue " SET MAXCC = 0" queue " " queue " DEFINE AIX -" queue " ( NAME( -"aixname ") -" queue " RELATE( -"baseclname " ) -" queue " "aixattrib " -" if sw.0Skinny = 0 then do queue " ) -" queue " DATA -" queue " ( NAME( -"datadsn ") -" end /* skinny not */ queue " "spctyp"(" spcpri spcsec ") -" queue " RECORDSIZE( " avgrecl maxrecl " ) -" if sw.0Skinny = 0 then do queue " FREESPACE( " cipct capct " ) -" queue " BUFFERSPACE( " bufspc " ) -" queue " SHAREOPTIONS(" shropts ") -" end /* skinny not */ queue " KEYS(" keylen "," rkp ") -" if sw.0Skinny = 0 then do if nunqkey then , queue " NONUNIQUEKEY -" else, queue " UNIQUEKEY -" /* Add dataattributes. This could be quite long */ do while dataopts <> "" pt = LastPos( " ",dataopts" ",40 ) /* ID 40 bytes */ slug = Substr( dataopts,1,pt ) /* load to slug */ dataopts = Delstr( dataopts,1,pt ) /* excise from dataopts */ queue " "slug" -" end /* dataopts */ queue " ) -" queue " INDEX -" queue " ( NAME( -"indexdsn ") -" queue " "idxspc"(" idxpri "," idxsec ") -" end /* skinny not */ queue " )" queue " " queue " DEFINE PATH -" queue " ( NAME( -"pathdsn ") -" queue " PATHENTRY( -"aixname ") -" queue " "pathopts " -" queue " )" queue " " queue " BLDINDEX -" queue " INDATASET( -"baseclname ") -" queue " OUTDATASET( -"aixname ")" queue " " queue " VERIFY DATASET( -"aixname ")" return /*@ BGX_DEFAIX */ /* Pump the queue to a dataset or the terminal . ----------------------------------------------------------------- */ BGY_OUTPUT_DEFINE: /*@ */ if branch then call BRANCH address TSO zz = Msg('OFF') "ALLOC FI( @TMP ) NEW REU UNIT( VIO ) SPACE( 1 ) TRACKS", "RECFM( V B )" "LRECL( 255 ) BLKSIZE( 0 )" if rc = 12 then alcunit = "SYSDA" else alcunit = "VIO" "FREE FI( @TMP )" zz = Msg(zz) alloc.0 = "NEW CATALOG UNIT( SYSDA ) SPACE( 1 ) TRACKS", "RECFM( V B ) LRECL( 255 ) BLKSIZE( 0 )" vio.0 = "NEW CATALOG UNIT( "alcunit" ) SPACE( 1 ) TRACKS", "RECFM( V B ) LRECL( 255 ) BLKSIZE( 0 )" alloc.1 = "SHR" /* if it already exists... */ if queued() = 0 then, queue " No data queued. " if outdsn <> "" then do /* write to DASD */ tempstat = Sysdsn( outdsn ) = "OK",/* 1=exists, 0=missing */ | Sysdsn( outdsn ) = "MEMBER NOT FOUND" "ALLOC FI( @TMP ) DA( "outdsn" ) REU" alloc.tempstat "EXECIO" queued() "DISKW @TMP (FINIS" sw.0BrowseTMP = 1 /* */ end /* outdsn */ else , /* no OUTDSN */ if sw.0inispf then do /* ISPF available */ "ALLOC FI( @TMP ) REU" vio.0 "EXECIO" queued() "DISKW @TMP (FINIS" sw.0BrowseTMP = 1 /* */ end /* inispf */ else do /* write to terminal */ "CLEAR" /* */ do queued() pull line; say line /* */ end /* queued */ end /* terminal */ return /*@ BGY_OUTPUT_DEFINE */ /* . ----------------------------------------------------------------- */ BGZ_BROWSE_TMP: /*@ */ if branch then call BRANCH address ISPEXEC "CONTROL ERRORS RETURN" if sw.0outpds then do if Left( outdsn,1 ) = "'" then, /* quoted */ outdsn = Strip( outdsn,,"'" ) /* unquoted */ else outdsn = Userid()"."outdsn /* fully qualified */ parse var outdsn dsname "(" dsmbr ")" "LMINIT DATAID( DDNID ) DATASET( '"dsname"' )" vwsuff = "MEMBER( "dsmbr" )" end /* sw.0outpds */ else, "LMINIT DATAID( DDNID ) DDNAME( @TMP )" "EDIT DATAID( "ddnid" )" vwsuff return /*@ BGZ_BROWSE_TMP */ /* . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ address TSO if SWITCH( "NONEST" ) then sw.0nested = 0 sw.0savelog = SWITCH( "LOG" ) return /*@ LOCAL_PREINIT */ /* subroutines below LOCAL_PREINIT are not selected by SHOWFLOW */ /* . ----------------------------------------------------------------- */ ZB_SAVELOG: /*@ */ if branch then call BRANCH address TSO if Symbol( "LOG#" ) = "LIT" then return /* not yet set */ dsstat = Sysdsn( logdsn ) = "OK" /* 1 if it exists */ "ALLOC FI( @LOG ) DA( " logdsn " ) REU" vblog.dsstat "EXECIO" log# "DISKW @LOG (STEM LOG. FINIS" "FREE FI( @LOG )" return /*@ ZB_SAVELOG */ /* . ----------------------------------------------------------------- */ ZL_LOGMSG: Procedure expose (tk_globalvars) (msgparms) /*@ */ rc = Trace( "O" ) address TSO parse arg msgtext /* for making the msgline always reasonably short: */ do while Length( msgtext ) > msglim pt = LastPos( " ",msgtext,msglim ) slug = Left( msgtext,pt ) if monitor then say, slug parse value log#+1 slug with, zz log.zz 1 log# . msgtext = " "Substr( msgtext,pt ) end /* while msglim */ 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 say helpmsg ex_nam = Left( exec_name,8 ) /* predictable size */ say " " say " "ex_nam" generates pro-forma IDCAMS DEFINE statements for the " say " specified entity such as would have been used to " say " create it originally. " say " " say " Syntax: "ex_nam" dsname (Required)" say " OUTPUT outdsn (Defaults)" say " SKINNY " say " KEEP " say " (( LOG " say " " say " dsname identifies the entity to be analyzed so that (a) " say " DEFINE statement(s) can be constructed. " say " " say " outdsn names the target to receive the generated IDCAMS " say " DEFINE statements. If not specified, it defaults to" say " "exec_name".SYSOUT. " "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK" say " " say " SKINNY (switch in parms) produces a shortened DEFINE which " say " names only the CLUSTER. " say " " say " KEEP (switch in parms) refers to . If OUTPUT or " say " KEEP is specified, is kept at process-end. " say " Otherwise, is is discarded. " say " " say " LOG (switch in opts) requests the log to be saved at " say " termination. Normally, the log is discarded unless " say " an error occurred. " say " " "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK" say " Debugging tools provided include: " 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" (( trace ?r branch " if sysvar( "SYSISPF" ) = "ACTIVE" 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 ) /* 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( '5d40'x,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 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 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" )", info if wordpos( dlm,back ) = 0 then /* search for ending delimiter*/ helpmsg = helpmsg, "No matching second delimiter( "dlm" ) with KEYPHRS( "kp" )", info 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 Strip( sourceline( ssii ),'T' ) 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','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.0nested = sysvar( "SYSNEST" ) = "YES" sw.0batch = sysvar( "SYSENV" ) = "BACK" sw.0inispf = sysvar( "SYSISPF" ) = "ACTIVE" parse value KEYWD( "TRACE" ) "N" with tv . 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 . 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 */