I might be about to open that can of worms permanently (SMF and REXX) ... :-)
Seriously, I have a few tips and tricks on processing SMF with REXX. And I’m aiming to open source something. It’s not quite ready and it will be the START of something, not a finished journey. (The idea being others could pitch in - once the project is open sourced.) (I just need a little time and the help from some IBMer who’s already open sourced some code.) Cheers, Martin Sent from my iPad > On 20 Mar 2020, at 05:45, David Crayford <dcrayf...@gmail.com> wrote: > > I'm not knocking your code which looks very good, but yet again it's a > good example of why REXX is a poor language for processing binary data. > > I don't use REXX much these days. On z/OS I use either Lua [1] or Python > [2], mainly Lua as it runs in TSO/ISPF which Python doesn't. Both > languages have > libraries for reading/writing binary data (structs). They even handle > endian conversion. > > It's tempting to reach for REXX as the simple option but in many cases > the result is write-only code and technical debt. I believe some people > process SMF records > using REXX which sounds like a can of worms that I wouldn't want to open. > > [1] https://urldefense.proofpoint.com/v2/url?u=http-3A__www.inf.puc-2Drio.br_-7Eroberto_struct_&d=DwICaQ&c=jf_iaSHvJObTbx-siA1ZOg&r=BsPGKdq7-Vl8MW2-WOWZjlZ0NwmcFSpQCLphNznBSDQ&m=EnMRsdCNK5TSVa2NdwFVO_hqxLs-qNfXpICslQ6OLm8&s=7dmlBzEToMG1IckWXl6gsP3w1Gp-Nja6MRmmsGqR96Y&e= > [2] https://urldefense.proofpoint.com/v2/url?u=https-3A__docs.python.org_2_library_struct.html&d=DwICaQ&c=jf_iaSHvJObTbx-siA1ZOg&r=BsPGKdq7-Vl8MW2-WOWZjlZ0NwmcFSpQCLphNznBSDQ&m=EnMRsdCNK5TSVa2NdwFVO_hqxLs-qNfXpICslQ6OLm8&s=ktUzw10BPpe8ICjJZlckotvmlS1igg615sGJ7mDI6CU&e= > >> On 2020-03-20 8:08 AM, Dale R. Smith wrote: >>> On Thu, 19 Mar 2020 21:04:27 +0800, David Crayford <dcrayf...@gmail.com> wrote: >>> >>> I think that sample is a perfect example why you shouldn't use REXX for >>> processing complex records! >>> >>> All the magic number offsets and data conversions will only get worse as >>> the complexity of the program increases. >> Which is why REXX has variables! Set the "magic numbers" once, in one place and reference them by variable name. If the value changes, update the variable setting and nothing else needs to be changed. Talk about "magic"! :-)> >> >> I have written several REXX programs that use the Catalog Search Interface (CSI, aka IGGCSI00). I figured out early on that a lot of the code for setup, processing, and error decoding could be done with a set of common routines that could be used in every REXX program that I create that uses CSI. That way, I only have to code the unique parts for the particular processing I want to do and then include the common code. Yes, you have to code offsets and/or lengths for each Catalog Field you want to process, and those are documented in the manual. (DFSMS Managing Catalogs). >> >> The CSI Common Code and the REXX programs that use are not completely independent of each other, (that is some variables need to be set in the main program and used in the CSI Code some are set in the CSI Code and used in the main program. Their are also two routines that must be defined in the main program that are called from the CSI Common Code. The routines must be named PROCESS_ENTRY: and ENTRY_ERROR: (The CSI Common code will Call PROCESS_ENTRY for every Catalog Entry returned, PROCESS_ENTRY then Calls the correct routine to process that entry. I set it up that way to allow multiple Catalog Entry types to be processed in a single program. >> >> Here is a working example of a REXX program I wrote (GDGINFO) that uses CSI to extract and display information on one or GDG Catalog Entries. The REXX program expects the GDG DSN as it's only parameter. The DSN specified to GDGINFO must contain at least one period. It can be a full DSN, like XXXXX.A.B, or a prefix like XXXX. It can also contain wildcards, like XXXX.*.YYYYY or XXXX.userid.** CMDOUT is where the output is written to. It can be written to SYSOUT or a data set. GDGINFO can be run in TSO Batch (CMDOUT default to SYSOUT) or under TSO/ISPF (CMDOUT goes to a temporary file that will be viewed. Here is some sample output from GDGINFO XXXX. >> Data-Set-Name OwnerID Limit Defined Alter-Date Extended? Empty? Order Purge? Scratch? >> XXXX.A.B.C.D * 005 000 NEVER NOEXTENDED NOEMPTY LIFO NOPURGE SCRATCH >> XXXX.A * 002 000 2012-02-04 NOEXTENDED NOEMPTY LIFO NOPURGE SCRATCH >> XXXX.A.B.C * 252 037 2012-10-10 NOEXTENDED NOEMPTY LIFO NOPURGE SCRATCH >> XXXX.A.B,C.D * 005 000 2011-03-30 NOEXTENDED NOEMPTY LIFO NOPURGE NOSCRATCH >> XXXX.A.B.C * 025 001 2009-01-29 NOEXTENDED EMPTY LIFO NOPURGE SCRATCH >> XXXX.A.B.C * 020 020 2020-03-19 NOEXTENDED NOEMPTY LIFO NOPURGE SCRATCH >> >> Ownerid is set to "*" if no owner is defined. Limit is how many generations are allowed. Defined is how many generations are Cataloged. 000 means no generations are currently Cataloged. Alter-Date is the last date that a generation was added or deleted. NEVER means that no generation was ever created for this GDG. EXTENDED/NOEXTENDED indicates whether the GDG allows a maximum of 255 generations (NOEXTENDED) or a maximum of 999 generations (EXTENDED). >> >> Here is the main REXX program with a "/*%INCLUDE CSICOM */" where the CSI Common Code will go. I'll include the CSI Common Code after GDGINFO: >> >> /*--------------------------- GDGINFO REXX ---------------------------*/ >> /* Extract and Display Information for the Specified GDG Definitions. */ >> /*--------------------------------------------------------------------*/ >> GDGINFO: >> Parse Source . ctype ename eoutddn edsname . system subsys . >> pgmvers = 1 /* Program Version */ >> msghdr = ename': ' /* Message Header for Say */ >> tso = (system = 'TSO') >> ispf = (subsys = 'ISPF') >> If \tso Then >> Do >> Say ename 'must be invoked from TSO.' >> Exit 4 >> End >> Address TSO >> batch = (SYSVAR('SYSENV') = 'BACK') >> outddn = 'CMDOUT' /* Output DD Name */ >> myuid = Userid() >> Numeric Digits 10 >> >> Arg dsn . >> >> If dsn = '' Then >> Do >> Say msghdr 'No Data Set Name Specified.' >> Say msghdr 'A Data Set Name is Required.' >> Exit 4 >> End >> If Pos('.',dsn) = 0 Then >> Do >> Say msghdr 'Invalid Data Set Name Specified: ' dsn >> Say msghdr 'A Data Set Name must contain at least one period.' >> Exit 4 >> End >> If Right(dsn,1) = '.' Then dsn = dsn'**' >> >> Call DEFOUT >> If result \= 0 Then Call EXIT result >> >> Call CSI_INIT /* Initialize CSI Parameters */ >> /*--------------------------------------------------------------------*/ >> /* CSI Settings used by this Program. */ >> /*--------------------------------------------------------------------*/ >> gdgempty = '80'x /* GDGATTR - GDG EMPTY Parm */ >> gdgscr = '40'x /* GDGATTR - GDG SCRATCH Parm */ >> gdgfifo = '20'x /* GDGATTR - GDG FIFO Parm */ >> gdgpurge = '10'x /* GDGATTR - GDG PURGE Parm */ >> gdgext = '08'x /* GDGATTR - GDG EXTENDED Parm */ >> attlen = 1 /* Length of GDG Attributes Byte */ >> limlen = 2 /* Length of GDG Extended Limit */ >> altlen = 4 /* Length of GDG Alteration Date */ >> genlen = 4 /* Length of GDG Generations */ >> ownlen = 8 /* Length of Owner ID */ >> >> rec.0 = 0 /* Initialize Output Array Count */ >> gettype = 'GDG' /* Catalog Entry Type to Process */ >> n = WordPos(gettype,etypesi) /* Get Entry Number */ >> If n = 0 Then >> Do >> Say msghdr 'Invalid Entry Type Specified: ' gettype >> Call EXIT 4 >> End >> dtypes = Word(dtypesi,n) /* CSI Type(s) to Use */ >> /* CSI Field Names to Return */ >> fldnames = 'OWNERID GDGATTR GDGLIMTE GDGALTDT GENLEVEL' >> gdghdr = 'Data-Set-Name OwnerID ', >> 'Limit Defined Alter-Date Extended? Empty? Order', >> 'Purge? Scratch?' >> >> Call CSI_SET /* Initialize CSI Parameter List */ >> Call CSI_PROCESS /* Extract Catalog Information */ >> If rec.0 > 0 Then 'EXECIO' rec.0 'DISKW' outddn '(STEM REC. FINIS' >> Call EXIT 0 >> >> /*---------------------------- GDG_ENTRY -----------------------------*/ >> /* Extract Information for GDG, (Generation Data Group), Entries. */ >> /*--------------------------------------------------------------------*/ >> GDG_ENTRY: >> ptr2 = ptr1 + (fldlen*2) /* Point to Field Lengths */ >> lownerid = C2D(SubStr(csiwork,ptr2,fldlen)) /* Owner ID */ >> ptr2 = ptr2 + fldlen /* Skip Field Length */ >> lgdgattr = C2D(SubStr(csiwork,ptr2,fldlen)) /* Attribute */ >> ptr2 = ptr2 + fldlen /* Skip Field Length */ >> lgdglimte = C2D(SubStr(csiwork,ptr2,fldlen)) /* Limit */ >> ptr2 = ptr2 + fldlen /* Skip Field Length */ >> lgdgaltdt = C2D(SubStr(csiwork,ptr2,fldlen)) /* Alter Date */ >> ptr2 = ptr2 + fldlen /* Skip Field Length */ >> lgenlevel = C2D(SubStr(csiwork,ptr2,fldlen)) /* Generations */ >> ptr2 = ptr2 + fldlen /* Skip Field Length */ >> >> If lownerid < ownlen Then >> Do >> Say msghdr 'No Owner ID Returned for Entry: ' csiename >> Return >> End >> If lgdgattr < attlen Then >> Do >> Say msghdr 'No GDG Attributes Returned for Entry: ' csiename >> Return >> End >> If lgdglimte < limlen Then >> Do >> Say msghdr 'No GDG Limit Returned for Entry: ' csiename >> Return >> End >> If lgdgaltdt < altlen Then >> Do >> Say msghdr 'No GDG Alteration Date Returned for Entry: ', >> csiename >> Return >> End >> >> ownerid = SubStr(csiwork,ptr2,ownlen) >> ptr2 = ptr2 + ownlen /* Skip Owner ID */ >> gdgattr = SubStr(csiwork,ptr2,attlen) >> ptr2 = ptr2 + attlen /* Skip Attribute */ >> gdglimte = Right(C2D(SubStr(csiwork,ptr2,limlen)),3,'0') >> ptr2 = ptr2 + limlen /* Skip Limit */ >> gdgaltdt = Left(C2X(SubStr(csiwork,ptr2,altlen-1)),5) >> If gdgaltdt = '00000' Then >> altdate = 'NEVER ' >> Else >> Do >> altdate = Date('S',gdgaltdt,'J') >> altdate = Translate('1234-56-78',altdate,'12345678') >> End >> >> If rec.0 = 0 Then Call BLDREC gdghdr >> If ownerid = '' | Left(ownerid,1) == 'FF'x Then >> ownerid = Left('*',8) >> If BitAnd(gdgattr,gdgext) == gdgext Then >> extopt = 'EXTENDED ' >> Else >> extopt = 'NOEXTENDED' >> If BitAnd(gdgattr,gdgempty) == gdgempty Then >> empopt = 'EMPTY ' >> Else >> empopt = 'NOEMPTY' >> If BitAnd(gdgattr,gdgfifo) == gdgfifo Then >> ordopt = ' FIFO' >> Else >> ordopt = ' LIFO' >> If BitAnd(gdgattr,gdgpurge) == gdgpurge Then >> puropt = 'PURGE ' >> Else >> puropt = 'NOPURGE' >> If BitAnd(gdgattr,gdgscr) == gdgscr Then >> scropt = 'SCRATCH' >> Else >> scropt = 'NOSCRATCH' >> If lgenlevel = 0 Then >> gencnt = 000 >> Else >> gencnt = Right(lgenlevel / genlen,3,'0') >> Call BLDREC Left(csiename,44) ownerid Right(gdglimte,5), >> Right(gencnt,7) altdate extopt empopt ordopt, >> puropt scropt >> Return >> >> /*-------------------------- PROCESS_ENTRY ---------------------------*/ >> /* Process Data Set Entry Returned by CSI. */ >> /*--------------------------------------------------------------------*/ >> PROCESS_ENTRY: >> Arg etype . >> Select /* Entry Type */ >> When etype = 'GDG' Then Call GDG_ENTRY >> Otherwise >> Nop >> End /* Select Entry Type */ >> Return >> >> /*--------------------------- ENTRY_ERROR ----------------------------*/ >> /* Process Entry Errors. */ >> /*--------------------------------------------------------------------*/ >> ENTRY_ERROR: >> toterr = toterr + 1 >> Call CSI_ENTRY_ERROR >> Return >> >> /*%INCLUDE CSICOM */ >> >> /*------------------------------ DEFOUT ------------------------------*/ >> /* Define the Output File (outddn). If running in Batch, Allocate */ >> /* the Output to Sysout, otherwise Allocate the Output to a Temporary */ >> /* Disk File that will be Viewed later. */ >> /*--------------------------------------------------------------------*/ >> DEFOUT: Procedure Expose batch outddn >> Call 'BPXWDYN' 'INFO DD('outddn') INRTDSN(OUTDSN)' >> If outdsn \= '' Then Return 0 /* "outddn" Allocated */ >> If batch Then >> 'ALLOCATE DDNAME('outddn') REUSE SYSOUT' >> Else >> 'ALLOCATE DDNAME('outddn') REUSE DSORG(PS) UNIT(SYSDA)', >> 'RECFM(V,B) LRECL(255) SPACE(1,1) CYLINDER RELEASE' >> Return rc >> >> /*------------------------------ BLDREC ------------------------------*/ >> /* Build output array, (rec.), one record at a time. */ >> /*--------------------------------------------------------------------*/ >> BLDREC: Procedure Expose rec. >> n = rec.0 + 1 >> rec.n = Arg(1) >> rec.0 = n >> Return >> >> /*------------------------------- EXIT -------------------------------*/ >> /* End of Program processing. If running in Batch, just Exit. */ >> /* If not Batch, View the Output File and then Delete it. */ >> /*--------------------------------------------------------------------*/ >> EXIT: >> Arg src . >> If batch Then Exit src >> If ispf & src = 0 Then >> Do >> Address ISPEXEC >> 'LMINIT DATAID(VIEWID) DDNAME('outddn')' >> 'VIEW DATAID('viewid')' >> 'LMFREE DATAID('viewid')' >> Address TSO >> End >> 'FREE DDNAME('outddn')' >> Exit src >> >> Here is the CSI Common Code used by GDGINFO and other REXX programs I have written: >> >> /*----- Begin Catalog Search Interface (CSI) Common Subroutines ------*/ >> >> /*--------------------------- CSI_PROCESS ----------------------------*/ >> /* Call the Catalog Search Interface, (CSI), Module, (IGGCSI00), to */ >> /* Retrieve Entries for the specified Entry Type and Data Set Name. */ >> /* CSI is documented in the "Catalog Search Interface User's Guide" */ >> /* Chapter in the "DFSMS Managing Catalogs" Manual. */ >> /*--------------------------------------------------------------------*/ >> CSI_PROCESS: >> resume = 'Y' /* Set Resume Flag to "Y" */ >> pcsiename = '' /* Previous Entry Name */ >> Parse Value 0 With =1 totent =1 toterr =1 vvdsdsn . >> Do While resume = 'Y' >> Address LINKPGM 'IGGCSI00 CSIRSNRC CSIFIELD CSIWORK' /* CSI */ >> csirc = rc >> If csirc > 0 Then >> Do >> Call CSI_ERROR /* Check Return Code/Reason Code */ >> If result > 0 Then Exit result /* Exit if Bad RC */ >> End >> resume = SubStr(csifield,150,1) /* Resume Flag */ >> csiusdln = C2D(SubStr(csiwork,9,4)) /* Work Area Used */ >> ptr1 = hdrlen + 1 /* Starting Position (Skip Header) */ >> Do While ptr1 < csiusdln >> csietype = SubStr(csiwork,ptr1+1,1) /* Entry Type */ >> If csietype = 0 Then >> Do >> Call CSI_CATALOG_ENTRY /* Process Catalog Entry */ >> ptr1 = ptr1 + catlen /* Skip Catalog Entry */ >> Iterate /* Do While ptr1 < csiusdln */ >> End >> csieflag = SubStr(csiwork,ptr1,1) /* Entry Flag */ >> csiename = Strip(SubStr(csiwork,ptr1+2,44)) /* Entry Name */ >> vvdsdsn = (Left(csiename,10) = 'SYS1.VVDS.') >> totent = totent + 1 >> If BitAnd(csieflag,csienter) == csienter Then >> Do >> Call ENTRY_ERROR >> ptr1 = ptr1 + datlen + errlen /* Next Entry */ >> Iterate /* Do While ptr1 < csiusdln */ >> End >> ptr1 = ptr1 + datlen /* Skip Default Data Entry */ >> csitotln = C2D(SubStr(csiwork,ptr1,2)) /* Data Length */ >> n = WordPos(csietype,dtypeso) /* Valid Entry Type ? */ >> If n = 0 Then >> Do >> Say msghdr 'Unknown Data Type for Entry: ' csiename >> ptr1 = ptr1 + csitotln /* Next Entry */ >> toterr = toterr + 1 >> Iterate /* Do While ptr1 < csiusdln */ >> End >> etypeo = Word(etypeso,n) /* Convert Entry Type */ >> Call PROCESS_ENTRY etypeo >> ptr1 = ptr1 + csitotln /* Next Entry */ >> End /* Do While ptr1 < csiusdln */ >> If resume = 'Y' & pcsiename = csiename Then >> Do /* Exit if we have tried to process this entry twice */ >> Say msghdr csiename 'cannot be Processed with the', >> 'Work Area Size provided - you must increase', >> 'the Work Area Size and Retry' >> Exit 40 >> End >> pcsiename = csiename >> End /* Do While resume = 'Y' */ >> Return >> >> /*------------------------ CSI_CATALOG_ENTRY -------------------------*/ >> /* Entry Returned from CSI is a Catalog. This may indicate an error. */ >> /*--------------------------------------------------------------------*/ >> CSI_CATALOG_ENTRY: >> csicflg = SubStr(csiwork,ptr1,1) /* Catalog Flag */ >> Select /* Catalog Flag */ >> When csicflg == bzero Then Nop /* No Error */ >> When BitAnd(csicflg,csinoent) == csinoent Then >> Do /* No Entries Found */ >> Say msghdr 'No Entries Found for DSN: ' dsn ' Type: ' etype >> Exit 28 >> End >> Otherwise >> csicname = Strip(SubStr(csiwork,ptr1+2,44)) /* Catalog Name */ >> csicretn = SubStr(csiwork,ptr1+46,4) /* Catalog Error */ >> Say msghdr 'Error Processing CSI Request for Entry: ' dsn >> Say msghdr 'CSICNAME='csicname >> Say msghdr 'CSICFLG ='C2X(csicflg) /* Catalog Flag */ >> Call CSI_ERRCODE csicretn /* Decode Catalog Error */ >> Exit 32 >> End /* Select Catalog Flag */ >> Return >> >> /*----------------------------- CSI_SET ------------------------------*/ >> /* Set CSI Variables and Build the CSI Parameter List. */ >> /*--------------------------------------------------------------------*/ >> CSI_SET: >> csifiltk = Left(dsn,44) /* Data Set Name Filter Key */ >> csicatnm = Left(catname,44) /* Catalog Name to Process */ >> csidtyps = Left(dtypes,16) /* Entry Types to be Returned */ >> numflds = Words(fldnames) /* Number of Field Names */ >> csinumen = D2C(numflds,2) /* Number of Fields to Return */ >> csifldnm = '' /* List of 8 Byte Field Names */ >> Do f = 1 to numflds >> csifldnm = csifldnm||Left(Word(fldnames,f),8) >> End /* Do f = 1 to numflds */ >> /*--------------------------------------------------------------------*/ >> /* Build the Selection Criteria Fields part of the Parameter List. */ >> /*--------------------------------------------------------------------*/ >> csiopts = csicldi || csiresum || csis1cat || csioptns >> csifield = csifiltk || csicatnm || csiresnm || csidtyps ||, >> csiopts || csinumen || csifldnm >> Return >> >> /*----------------------------- CSI_INIT -----------------------------*/ >> /* Initialize CSI Variables and Variables that need to be set once. */ >> /*--------------------------------------------------------------------*/ >> CSI_INIT: >> /*--------------------------------------------------------------------*/ >> /* Initialize Device Type Codes, Entry Types, and Reason Messages. */ >> /*--------------------------------------------------------------------*/ >> dasdlist = '3010200F 3390 3010200E 3380 30102004 9345' >> tapelist = '78048081 3490 78048083 3590-1 78048080 3480X ', >> '78008080 3480 32108003 3400-6 32008003 3400-5', >> '30C08003 3400-2 33008003 3400-9 34008003 3400-3' >> etypesi = 'NONVSAM GDG CLUSTER AIX GDS PATH UCAT ALIAS', >> 'ATLLIB ATLVOL CATCBD' >> dtypesi = 'A B C G H R U X ', >> 'L W Z ' >> etypeso = etypesi 'DATA INDEX' >> dtypeso = dtypesi 'D I ' >> rsnmsg. = 'Unknown Reason Code' >> rsnmsg.1 = 'Insufficent Storage for GETMAIN, Increase Region Size.' >> rsnmsg.2 = 'Invalid Entry Type in CSIDTYPS.' >> rsnmsg.3 = 'Invalid Data/Index Option in CSICLDI, Should be "Y"', >> 'or Blank.' >> rsnmsg.4 = 'Invalid Resume Option in CSIRESUM, Should be "Y" or', >> 'Blank.' >> rsnmsg.5 = 'Invalid Search One Catalog Option in CSIS1CAT, Should', >> 'be "Y" or Blank.' >> rsnmsg.6 = 'Invalid Number of Fields in CSINUMEN, Should be', >> 'between Zero and 100, Inclusive.' >> rsnmsg.7 = 'Invalid Work Area Length, Should be between 1024 and', >> '8,388,608, Inclusive.' >> rsnmsg.8 = 'Invalid Length Option in CSIOPTNS, Should be "F" or', >> 'Blank.' >> /*------------ Reason Codes 9 and 10 Added in z/OS V2.2. ------------*/ >> rsnmsg.9 = 'Entry Type "Z" must be the only Entry Type in CSIDTYPS.' >> rsnmsg.10 = 'Entry Type "Z" request contains an invalid Field Name.' >> /*------------ Reason Codes 11 and 12 Added in z/OS V2.3. ------------*/ >> rsnmsg.11 = 'CSIRESUM is Set to "Y" and CSIRESNM is zeroes.' >> rsnmsg.12 = '"Z" Entry Field Names cannot be used with non-"Z"', >> 'Entry Type requests.' >> >> /*--------------------------------------------------------------------*/ >> /* Initialize CSI Parameters. */ >> /*--------------------------------------------------------------------*/ >> csirsnrc = Left(' ',4) /* CSI Module Return/Reason Code */ >> catname = Left(' ',44) /* Catalog Name to Search */ >> csiresnm = Left(' ',44) /* Resume Data Set Name */ >> csicldi = 'Y' /* Return Data/Index for Cluster */ >> csiresum = ' ' /* Resume Flag (More Entries) */ >> csis1cat = 'Y' /* Search Only 1 Catalog */ >> csioptns = ' ' /* Use Halfword Length Fields */ >> /*--------------------------------------------------------------------*/ >> /* Initialize Flags and Length Variables. */ >> /*--------------------------------------------------------------------*/ >> bzero = '00'x /* Binary Zero - No Errors */ >> csinticf = '80'x /* CSICFLG - Non-ICF Catalog */ >> csinoent = '40'x /* CSICFLG - No Entries Found */ >> csintcmp = '20'x /* CSICFLG - Data not Complete */ >> csicerr = '10'x /* CSICFLG - Catalog Error */ >> csicerrp = '08'x /* CSICFLG - Catalog Error */ >> csipment = '80'x /* CSIEFLAG - Primary Entry */ >> csienter = '40'x /* CSIEFLAG - Entry Error */ >> csiedata = '20'x /* CSIEFLAG - Entry has Data */ >> >> /*---- Work Area Max Size = 1MiB. Inceased to 8MiB in z/OS V2.2 -----*/ >> worklen = 1*(1024*1024) /* Length of Work Area 1MiB */ >> hdrlen = 14 /* Length of Work Area Header */ >> catlen = 50 /* Length of Catalog Entry */ >> datlen = 46 /* Length of Dataset Entry */ >> errlen = 4 /* Length of Error Entry */ >> If csioptns = ' ' Then >> fldlen = 2 /* Length of Field Length Entry */ >> Else >> fldlen = 4 /* Length of Field Length Entry */ >> /*--------------------------------------------------------------------*/ >> /* Initialize and Build Work Area output part of the Parameter List. */ >> /*--------------------------------------------------------------------*/ >> csiusrln = D2C(worklen,4) >> csiwork = csiusrln || Copies('00'x,worklen-4) >> Return >> >> /*------------------------- CSI_ENTRY_ERROR --------------------------*/ >> /* Process CSI Entry Errors. */ >> /*--------------------------------------------------------------------*/ >> CSI_ENTRY_ERROR: >> Say msghdr 'Error Processing CSI Request for Entry: ' csiename >> Say msghdr 'CSIEFLAG='C2X(csieflag) >> csiretn = SubStr(csiwork,ptr1+46,4) /* Entry Error */ >> Call CSI_ERRCODE csiretn /* Decode Entry Error */ >> Return >> >> /*---------------------------- CSI_ERROR -----------------------------*/ >> /* Check and Process the CSI Module Return Code and Reason Code. */ >> /* CSI Module Return Codes and Reason Codes are documented in Chapter */ >> /* "Catalog Search Interface User's Guide" in the "DFSMS Managing */ >> /* Catalogs" Manual. */ >> /*--------------------------------------------------------------------*/ >> CSI_ERROR: >> Call CSI_ERRCODE csirsnrc, 'QUIET' /* Decode Module Error */ >> Select /* Return Code */ >> When csirc = 4 Then /* Some Catalog Information Returned */ >> Select /* retcode */ >> When retcode = 100 Then /* Catalog/DSN Error Detected */ >> Do >> If rsncode = 4 Then Return 0 /* DSN Entry Error */ >> If rsncode = 8 Then Nop /* Cat Entry Error */ >> End >> When retcode = 122 Then /* Invalid Filter Key */ >> Do >> Say msghdr 'Invalid CSI Filter Key', >> '(Data Set Name): ' csifiltk >> Call CSI_ERRCODE csirsnrc /* Decode Module Error */ >> Return retcode >> End >> Otherwise >> Nop >> End /* Select retcode */ >> When csirc = 8 Then /* CSI Failure */ >> Do >> Say msghdr rsncode rsnmsg.rsncode /* Reason Code Msg */ >> Return csirc >> End >> Otherwise >> Nop >> End /* Select Return Code */ >> >> Say msghdr 'Error' csirc 'from Call to CSI' >> Call CSI_ERRCODE csirsnrc /* Decode Module Error */ >> >> ptr3 = hdrlen + 1 /* Skip Header */ >> csicflg = SubStr(csiwork,ptr3,1) /* Catalog Flag */ >> csicname = Strip(SubStr(csiwork,ptr3+2,44)) /* Catalog Name */ >> csicretn = SubStr(csiwork,ptr3+46,4) /* Catalog Error */ >> Say msghdr 'Catalog Entry Error Information:' >> Say msghdr 'CSICNAME='csicname >> Say msghdr 'CSICFLG ='C2X(csicflg) >> Call CSI_ERRCODE csicretn /* Decode Catalog Error */ >> >> ptr3 = ptr3 + catlen /* Skip Catalog Entry */ >> csieflag = SubStr(csiwork,ptr3,1) /* Entry Flag */ >> csiename = Strip(SubStr(csiwork,ptr3+2,44)) /* Entry Name */ >> csiretn = SubStr(csiwork,ptr3+46,4) /* Entry Error */ >> Say msghdr 'Dataset Entry Error Information:' >> Say msghdr 'CSIENAME='csiename >> Say msghdr 'CSIEFLAG='C2X(csieflag) >> Call CSI_ERRCODE csiretn /* Decode Entry Error */ >> Return csirc >> >> /*--------------------------- CSI_ERRCODE ----------------------------*/ >> /* Decode Error Data into Module ID, Return Code, and Reason Code. */ >> /* CSI Return Codes and Reason Codes are documented in Message */ >> /* IDC3009I in one of the "MVS System Messages" Manuals. */ >> /*--------------------------------------------------------------------*/ >> CSI_ERRCODE: >> Parse Arg csicodes, parm, . >> Parse Var csicodes =1 modid +2 rsncode +1 retcode +1 . >> If modid << 'AA' | modid >> '99' Then modid = C2X(modid) >> retcode = C2D(retcode) >> rsncode = C2D(rsncode) >> If parm = 'QUIET' Then Return >> Say msghdr 'ModID='modid 'Return Code='retcode, >> 'Reason Code='rsncode >> Return >> >> /*----- End Catalog Search Interface (CSI) Common Subroutines ------*/ >> >> I know this is long post, but I hope it will be helpful to the OP and to anyone else that wants to write REXX programs that extract Catalog information using CSI. If anyone has questions about the code, either post them here or email me directly. If you want to see other examples, let me know that also. >> >> FYI, we used the output from GDGINFO to help get rid of many unused GDG definitions! >> > > ---------------------------------------------------------------------- > For IBM-MAIN subscribe / signoff / archive access instructions, > send email to lists...@listserv.ua.edu with the message: INFO IBM-MAIN >Unless stated otherwise above: IBM United Kingdom Limited - Registered in England and Wales with number 741598. Registered office: PO Box 41, North Harbour, Portsmouth, Hampshire PO6 3AU ---------------------------------------------------------------------- For IBM-MAIN subscribe / signoff / archive access instructions, send email to lists...@listserv.ua.edu with the message: INFO IBM-MAIN
