To reveal a little more, what I might open source is a particular RMF SMF
record - with its own quirks. :-) But only a few per interval. Which
narrows it right down. :-)
Cheers, Martin
Martin Packer
zChampion, Systems Investigator & Performance Troubleshooter, IBM
+44-7802-245-584
email: martin_pac...@uk.ibm.com
Twitter / Facebook IDs: MartinPacker
Blog:
https://www.ibm.com/developerworks/mydeveloperworks/blogs/MartinPacker
Podcast Series (With Marna Walle): https://developer.ibm.com/tv/mpt/ or
https://itunes.apple.com/gb/podcast/mainframe-performance-topics/id1127943573?mt=2
Youtube channel: https://www.youtube.com/channel/UCu_65HaYgksbF6Q8SQ4oOvA
From: David Crayford <dcrayf...@gmail.com>
To: IBM-MAIN@LISTSERV.UA.EDU
Date: 20/03/2020 09:21
Subject: [EXTERNAL] Re: IGGCSI00 and REXX
Sent by: IBM Mainframe Discussion List <IBM-MAIN@LISTSERV.UA.EDU>
Oh no! Run for the hills :)
Good luck with that! I wouldn't fancy processing an SMF 110 CMF record
(with a dictionary) in REXX! I've done it in Java and that was onerous.
On 2020-03-20 3:16 PM, Martin Packer wrote:
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
----------------------------------------------------------------------
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
