IGGCSI00 is a callable subroutine to search the catalog. It is provided by DFHSMS and documented in Managing Catalogs. It can be used to search for dataset names, tape libraries and volumes (as cataloged in the DFSMS catalog, not CA-1 or some other catalog). There are some assembler and REXX samples in SYS1.SAMPLIB demonstrating how to call the routine, but we’d like to do a catalog search from COBOL. Why? you may ask. I’ll get to that in a later post. Here, we demonstrate finding all of the generations of a specific GDG.
The interface to IGGCSI00 is a bit unwieldy, but workable with some effort. You specify filter criteria and field names in a control block and an area for the routine to return the results. This work area has a header and some variable data that must be parsed or stepped through. If the area provided by the caller is not large enough for the all of the results, you have to call it again with some continuation, or resume, criteria.
While assembler & PL/I mappings for the filter criteria control block are provided, we’ll have to build a COBOL one. I think this will do the trick:
01 CSIFIELD. 02 CSIFILTK PIC X(44). 02 CSICATNM PIC X(44). 02 CSIRESNM PIC X(44). 02 CSIDTYPS PIC X(16). 02 FILLER REDEFINES CSIDTYPS. 03 CSISTYPS OCCURS 16 TIMES PIC X(1). 02 CSIOPTS. 03 CSICLDI PIC X(1). 03 CSIRESUM PIC X(1). 03 CSIS1CAT PIC X(1). 03 CSIOPTNS PIC X(1). 02 CSINUMEN PIC 9(4) COMP. 02 CSIENTS. 03 CSIFLDNM PIC X(8) OCCURS 1 TO 100 TIMES DEPENDING ON CSINUMEN.
There’s no mapping provided for the return work area, but it is described in the manual with field names, though the provided samples don’t use the names. There is a sample assembler program that uses the documented field names in the IBM Redbook, Enhanced Catalog Sharing and Management. from 1999. I used these resources to come up with a copybook for the CSI return workarea:
01 CSIRWORK. 02 CSIUSRLN PIC 9(8) COMP-5. 02 CSIREQLN PIC 9(8) COMP-5. 02 CSIUSDLN PIC 9(8) COMP-5. 02 CSINUMFD PIC 9(4) COMP. 01 CSI-CATALOG. 02 CSICFLG PIC X(1). 02 CSICTYPE PIC X(1). 02 CSICNAME PIC X(44). 02 CSICRETN. 03 CSICRETM PIC X(2). 03 CSICRETR PIC X(1). 03 CSICRETC PIC X(1). 01 CSI-ENTRY. 02 CSIEFLAG PIC X(1). 02 CSIETYPE PIC X(1). 02 CSIENAME PIC X(44). 02 CSIERETN. 03 CSIERETM PIC X(2). 03 CSIERETR PIC X(1). 03 CSIERETC PIC X(1). * IF CSIOPTNS IS NOT F 02 CSIEDATA REDEFINES CSIERETN. 03 CSITOTLN PIC 9(4) COMP. 03 FILLER PIC X(2). 02 CSILENFD. 03 CSILENF1 PIC 9(4) COMP.
Now, in this sample, for a given dataset name filter, XXXXXXXX.TEST.GDG.*, we want to find all of the cataloged datasets of entry type “H” (generation data set). We want the dataset name (ENTNAME) and list of volsers (VOLSER) returned. Since this is just a demonstration, we’ll just display these results.
IGGCSI00 returns some fields as fixed length (such as ENTNAME) and some as repeating (such as VOLSER) or variable length (such as STORCLAS). There are all listed in the field name tables.
I’ll set aside a glob of storage in the working-storage section and use the return area copybook in the linkage section to use to walk through the results.
01 ws-iggcsi00-return-area pic x(64000).
set address of csirwork to address of ws-iggcsi00-return-area
We set up to call IGGCSI00:
move XXXXXXXX.TEST.GDG.* to csifiltk move spaces to csicatnm move spaces to csiresnm move 'H' to csidtyps move spaces to csiopts move 2 to csinumen move 'ENTNAME' to csifldnm (1) move 'VOLSER' to csifldnm (2)
Since the routine is assured to be in the linklist, we’ll call it dynamically.
77 ws-iggcsi00 pic x(08) value 'IGGCSI00'. 77 ws-iggcsi00-return-code pic 9(08) comp-5. 01 ws-iggcsi00-reason-code. 02 rc-module-id pic x(02). 02 rc-reason-code pic x(01). 02 rc-return-code pic x(01).
call ws-iggcsi00 using ws-iggcsi00-reason-code csifield ws-iggcsi00-return-area returning ws-iggcsi00-return-code
Check for the return and reason codes <here>.
We set up some fields we can use for pointer arithmetic (is this cheating?):
77 ws-ra-ptr usage pointer. 77 ws-ra-ptr-addr redefines ws-ra-ptr pic s9(8) comp-5. 77 ws-ra-ptr-end-addr pic s9(8) comp-5.
set ws-ra-ptr to address of ws-iggcsi00-return-area set address of csirwork to ws-ra-ptr compute ws-ra-ptr-end-addr = ws-ra-ptr-addr + csiusdln
Now we can walk through the return area:
add length of csirwork to ws-ra-ptr-addr perform until ws-ra-ptr-addr >= ws-ra-ptr-end-addr set address of csi-catalog to ws-ra-ptr set address of csi-entry to ws-ra-ptr if csictype = x'F0' then display 'Catalog: ' csicname add length of csi-catalog to ws-ra-ptr-addr else set ws-ra-ptr to address of csilenfd set address of csi-returned-fields to ws-ra-ptr display ' Entname:' csi-ret-entname display ' Volsers:' csi-ret-volser-list (1 : csi-ret-volser-length) compute ws-ra-ptr-addr = ws-ra-ptr-addr + length of csi-ret-entname-length + length of csi-ret-volser-length + csi-ret-entname-length + csi-ret-volser-length end-if end-perform
Here are the copybooks and program source.