Discussion :

[Jean GVE]

Bonsoir,
J'ai un pb à résoudre :
un programme (Batch) qui doit accéder à des séries de paramètres situés dans une série de fichiers (bibliothèques).
commandes JCL du type
//XXX EXEC PGM=FMCDF89 (en simplifié)
//III DD DSN=fichier d'entrée
//OOO DD DSN=fichier de sortie
//CMD DD DSN=USER.BIB.PARAM
// DD DSN=EQUIP.BIB.PARCDF
// DD DSN=SYSTEM.BIB.PARCDF

En fonction du "fichier III" le programme doit aller chercher ses paramètres dans certains membres dans l'un des 3 "fichiers CMD".
(la règle est normale si pas dans "USER..." rechercher dans "EQUIP..." et si toujours pas trouvé rechercher dans "SYSTERM...")
Les noms de membres ne sont pas connus à l'avance. (Le programme accède à une base IMS, mais c'est pas le soucis)

Assez sport ma question du soir ?

Merci d'avance de vos réponses

Jean-Michel

PS: En fait, une analogie serait le programme lis un source cobol et "expense" les COPY (membres à aller chercher dynamiquement dans les bibliothèque de sources) et met le tout dans un fichier de sortie.

[Homer-ac]

Aie ! On ne peut pas lire la directory d'un PDS directement par des ordres COBOL. Par compte on peut par COBOL appeler un programme assembleur ou mieux, passer des ordres Library Management (LMOPEN, LMFIND, LMGET ...) ou encore un REXX pour faire ça.
1) voir si dans ta société un module assembleur n'est pas prévu pour ça, le système a parfois ce genre de trucs dans le chapeau.
2) solution Library Managemt il faudra un JCL d'exécution d'ISPF qui appellera le COBOL mais aussi un exemple de source. Je n'ai plus ça en tête mais je peux sans doute retrouver qque chose dans le genre (il faut en plus définir et gérer les variables ISPF utiles)
3) appeler un REXX ou un LISTDS TSO, c'est aussi faisable en COBOL, mais ce serait nettement plus simple de tout développer en REXX à ce niveau de problème.

Il y a aussi des solutions hybrides, lire un fichier des directory généré en amont dans le COBOL et allouer dynamiquement les fichiers à lire. Des exemples de cette technique d'allocation ont déjà été donné sur ce forum. Je dirais que d'interroger l'équipe système du site est peut être une bonne idée au moins dans un premier temps.

[jpd75]

Bonjour,
Il est possible de lire une directory d'un pds en cobol
Je n'ai rien inventé mais trouvé ce petit prog sur le web
Je l'ai testé avec un PSD et un PDSE c'est OK
Voir ci-dessous
Bonne journée
jpd75
FILE-CONTROL.
SELECT DIRECTORY-FILE ASSIGN TO INPDATA.
DATA DIVISION.
FILE SECTION.
FD DIRECTORY-FILE.
*01 FD-DIRECTORY-RECORD PIC X(080).
01 FD-DIRECTORY-RECORD PIC X(256).
WORKING-STORAGE SECTION.
77 IX-1 PIC S9(4) COMP.
77 TRASH PIC S9(4) COMP.
77 HALF-WORDS PIC S9(4) COMP.
01 DIRECTORY-RECORD.
02 USED-BYTES PIC S9(3) COMP.
02 REST-OF-RECORD PIC X(254).
01 DIRECTORY-ENTRY.
02 MEMBER-NAME PIC X(8).
02 FILLER PIC X(3).
02 WS-INDC PIC X.
01 WORK-FIELD.
05 WORK-FIELD-NUMERIC PIC S9(4) COMP.
01 FILLER.
03 FILLER PIC 9.
88 DONE VALUE 1.
88 NOT-DONE VALUE 0.
PROCEDURE DIVISION.
OPEN INPUT DIRECTORY-FILE

READ DIRECTORY-FILE
SET NOT-DONE TO TRUE
PERFORM PROCESS-RECORD
UNTIL DONE
CLOSE DIRECTORY-FILE
GOBACK.
PROCESS-RECORD.
MOVE FD-DIRECTORY-RECORD TO DIRECTORY-RECORD
MOVE 1 TO IX-1.
PERFORM UNTIL
USED-BYTES - IX-1 < 11 OR
REST-OF-RECORD (IX-1:1) = HIGH-VALUES
MOVE REST-OF-RECORD (IX-1:12) TO DIRECTORY-ENTRY
PERFORM PROCESS-MEMBER-NAME
MOVE LOW-VALUES TO WORK-FIELD
MOVE WS-INDC TO WORK-FIELD (2:1)
DIVIDE WORK-FIELD-NUMERIC BY 32 GIVING TRASH
REMAINDER HALF-WORDS
COMPUTE IX-1 = IX-1 + 12 + HALF-WORDS * 2
END-PERFORM
IF REST-OF-RECORD (IX-1:1) = HIGH-VALUES
SET DONE TO TRUE
ELSE
READ DIRECTORY-FILE
END-IF
PROCESS-MEMBER-NAME.
DISPLAY 'MEMBER=' MEMBER-NAME .

JCL d'éxécution
//GO EXEC PGM=LECTDIR
//STEPLIB DD DISP=SHR,DSN=&LOADLIB
//SYSOUT DD SYSOUT=*
//PDS DD DISP=SHR,DSN=ZET.TEST.PDS,RECFM=U,
// LRECL=256

[Homer-ac]

C'est malin, c'est en fait la transposition d'une méthode de lecture utilisée en Assembleur, mais attention, si ça marche certainement à tous les coups pour un PDS, j'ai le souvenir que cette méthode a pu poser problème pour des PDSE et je ne jurerai pas que ça fonctionne dans ce cas toujours très bien. Il me semble que la création en amont d'un fichier Directory est plus sure.
Il y a une autre alternative qui me semble bien plus à simple. Partir d'un fichier 'plat' QSAM du PDS.
Un IEBPTPCH fait ça très bien. Il crée en drapeau 'MEMBER NAME ' devant chaque membre. Un exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
//STEP001 EXEC PGM=IEBPTPCH
//SYSPRINT DD  SYSOUT=*
//SYSUT1   DD  DISP=SHR,DSN=&FICIN
//SYSUT2   DD  DSN=&FICOUT,SPACE=(CYL,(20,20),RLSE),UNIT=3390,
//             DISP=(NEW,CATLG),
//             DCB=(BLKSIZE=0,LRECL=81,RECFM=FB)
//SYSIN    DD *
   PUNCH TYPORG=PO,MAXFLDS=80,CNTRL=1
   RECORD FIELD=(80)
//*

Toutefois les membres ne seront pas dans l'ordre alphabétique mais par adresse TTR (les derniers modifiés à la fin). Il faudra aussi tenir compte d'un code saut inutile en col. 1 et de lignes à blancs non significatives.
Un tel fichier séquentiel pourra cependant être lu et géré dans un COBOL trivial.
NB. Dans une logique Batch, on raisonne en chaîne de traitement et on peut le plus souvent contourner les problèmes en insérant des steps de service qui peuvent reposer sur des utilitaires standards. Quelques IEBCOPY, IEBPTPCH et autres remises en forme par SORT peuvent facilement simplifier la gestion.

[Homer-ac]

Bon, depuis quelques semaines en disponibilité disons réduite, j'ai enfin pu trouver le temps d'écrire et tester le COBOL suivant qui utilise ISPF Library Management pour lire la Directory de PDS concaténés.
La contrainte est au niveau JCL, il faut absolument faire un ISPSTART d'ISPF via IKJEFT01. Un exemple de JCL (et d'un REXX qui fait la même chose) est dans la cartouche commentaires en tête du programme. Pour un COBOL batch simple ce n'est pas génant, mais pour un COBOL DLI c'est probablement moins évident à utiliser.
Mais enfin comme il n'y a pas trop d'exemples de ce type sur le net (à part du display d'écrans), je pense que l'exemple ci-dessous peut intéresser certains zociens. Dialog Manager ouvre pas mal de possibilités mais c'est vrai que c'est nettement plus facile d'utilisation en REXX.

nb. J'ai aussi testé une autre piste que j'ai abandonné. Appeler TSO dans un COBOL pour passer un LISTDS DIRECTORY. Ca semblait trop simple, ça ne marche pas,TSO refuse ce contexte, LISTDS étant une fonction autorisée.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
       Identification Division.
       PROGRAM-ID. COBISPF.
      *===============================================================
      * CE PROGRAMME CHARGE LA DIRECTORY D'UN PDS EN UTILISANT LE
      * SERVICE LMMLIST D'ISPF. LECTURE SUR LE DDNAME SYSUT1 QUI
      * PEUT CONTENIR DES PDS CONCATENES. CHARGEMENT D'UN TABLEAU DES
      * MEMBRES LUS, CHAQUE POSTE (10C) CONTENANT LE NOM DU MEMBRE ET
      * LE RANG DU 1er PDS CONTENANT CE MEMBRE DANS LA CONCATENATION
      *===============================================================
      *===============================================================
      * JCL D'EXECUTION (IL FAUT UN ISPSTART D'ISPF VIA IKJEFT01) :
      *
      * // SET PREISP='ISP'
      * //IKJ      EXEC PGM=IKJEFT01,DYNAMNBR=100,REGION=4M
      * //SYSTSIN  DD  *
      * PROFILE NOPREFIX
      * ISPSTART PGM(COBISPF)
      * //*
      * //SYSPROC  DD DSN=&PREISP..SISPCLIB,DISP=SHR
      * //STEPLIB  DD  DISP=SHR,DSN=&SYSUID..COBOL.LOADLIB
      *                                      -> PDS pour Directory
      * //SYSUT1   DD  DISP=SHR,DSN=&SYSUID..COBOL.COPYLIB
      * //         DD  DISP=SHR,DSN=&SYSUID..COBOL.SRCLIB
      * //SYSTSPRT DD  SYSOUT=*
      * //SYSTERM  DD  SYSOUT=*
      * //ISPLOG   DD  DUMMY
      * //ISPPROF  DD  DSN=&&PROF,DISP=(NEW,PASS),
      * //     DCB=(LRECL=80,BLKSIZE=6160,RECFM=FB),
      * //     SPACE=(TRK,(2,1,2)),UNIT=VIO
      * //ISPMLIB  DD  DSN=&PREISP..SISPMENU,DISP=SHR
      * //ISPSLIB  DD  DSN=&PREISP..SISPSENU,DISP=SHR
      * //ISPPLIB  DD  DSN=&PREISP..SISPPENU,DISP=SHR
      * //ISPTLIB  DD  DSN=&PREISP..SISPTENU,DISP=SHR
      * //SYSOUT   DD  SYSOUT=*
      * //SYSABEND DD  SYSOUT=*
      * //CEEDUMP  DD  SYSOUT=*
      * //ISPLOG DD SYSOUT=*,
      * // LRECL=120,BLKSIZE=0,DSORG=PS,RECFM=FB
      * //SYSIN    DD  *
      * //*
      *===============================================================
      *===============================================================
      * /* UN REXX - LISTE DIRECTORY qui fait la même chose sous TSO */
      *
      * Address TSO
      * DSNR = "'"userid().COBOL.COPYLIB"','"userid()".COBOL.DBRMLIB'"
      * "ALLOC DA("DSNR") FILE(SYSUT1) SHR REUSE"
      * if RC > 0 then EXIT RC
      * Address ISPEXEC
      * MBRE = ''
      * "LMINIT  DATAID(DATAID0) DDNAME(SYSUT1) ENQ(SHRW)"
      * 'LMOPEN DATAID('DATAID0')'
      * Do N = 1 to 100       /* LISTE DES MEMBREES DU PDS */
      *    'LMMLIST DATAID('DATAID0') OPTION(LIST) MEMBER(MBRE) ' ,
      *            'STATS(YES)'
      *    if RC > 0 then leave
      *    SAY 'Membre' left(MBRE,8) 'Sur PDS No' ,
      *         right(strip(ZLLIB),2,'0')
      * End
      * 'LMMLIST DATAID('DATAID0') OPTION(FREE)'
      * 'LMCLOSE DATAID('DATAID0')'
      * 'LMFREE  DATAID('DATAID0')'
      * Address TSO 'FREE F(SYSUT1)'
      * Exit
      *===============================================================
      *===============================================================
       Environment Division.
       Data Division.
       Working-Storage Section.
      *========================
       01  WSS-WORK.
           05  WS-EYE                Pic X(16)  Value '* WSS COBISPF *'.
           05  LKISPF                Pic X(08)  Value 'ISPLINK'.
           05  WS-NBRE-POSTES        Pic S9(4)  Value  1000.
           05  WS-CNT                Pic S9(4)  Binary Value  0.
           05  WS-CNT-MBRE           Pic S9(4)  Binary Value  0.
           05  WS-ORDRE              Pic X(08).
           05  WS-SPACE              Pic X(08)  Value space.
           05  WS-DDNAME             Pic X(08)  Value 'SYSUT1'.
           05  WS-WORK               Pic X(08).

      *            LES GROUPES SUIVANTS DOIVENT RESTER ORDONNES
      *            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      *            RESERVATION POUR VDEFINE
           05  WS-VARLIST            Pic  X(40) Value
              '(ZERRMSG ZERRLM DATAID0 MEMBER ZLLIB)'.

      *            RESERVATION DES NOMS DE VARIABLES DEFINIES
           05  WS-VARNAME.
               10                    Pic X(08) Value 'ZERRMSG'.
               10                    Pic X(08) Value 'ZERRLM'.
               10                    Pic X(08) Value 'DATAID0'.
               10 WN-MBRE            Pic X(08) Value 'MEMBER'.
               10                    Pic X(08) Value 'ZLLIB'.

      *            RESERVATION DES LONGUEURS
           05  WS-VARLENGTH          Binary.
               10  WS-LG8            Pic s9(06) Value +8.
               10  WS-LG512          Pic s9(06) Value +512.
               10                    Pic s9(06) Value +8.
               10                    Pic s9(06) Value +8.
               10                    Pic s9(06) Value +8.

      *            RESERVATION DES FORMATS
           05  WS-VARFORM.
               10                    Pic x(08) Value 'CHAR'.
               10                    Pic x(08) Value 'CHAR'.
               10                    Pic x(08) Value 'CHAR'.
               10                    Pic x(08) Value 'CHAR'.
               10                    Pic x(08) Value 'CHAR'.

      *            RESERVATION DES VARIABLES ISPF ALIMENTEES
           05  WS-VARISPF.
               10  WS-ZERRMSG        Pic X(08).
               10  WS-ZERRLM         Pic X(512).
               10  WS-DATAID         Pic X(08).
               10  WS-MBRE           Pic X(08).
               10  WS-ZLLIB          Pic X(08).

      *            TABLEAU DES MEMBRES DIRECTORY SUR 1000 POSTES MAXI
           05  TB-MEMBER.
               10 TB-MEMBER-POSTES   Pic S9(4).
               10 TB-MEMBER-POSTE               Occurs 1000.
                  15 TB-MEMBER-MBR   Pic  X(8).
                  15 TB-MEMBER-RGD   Pic  9(2).

      *-------------------
       Procedure Division.
      *===================
       DEBUT-PGM.
           Perform INITIALISATION
           Perform TRAITEMENT UNTIL RETURN-CODE > 0
           Perform EPILOG

      *    Tableau des membres des PDS chargé, on l'affiche
      *    ------------------------------------------------
           Perform varying WS-CNT-MBRE From 1 by 1
                     Until WS-CNT-MBRE      > TB-MEMBER-POSTES
              Display 'Membre '
                       TB-MEMBER-MBR(WS-CNT-MBRE)
                      ' Sur PDS No '
                       TB-MEMBER-RGD(WS-CNT-MBRE)
           End-Perform
           Goback.

       INITIALISATION.
           Move Spaces       to WS-VARISPF    TB-MEMBER
           Move  WS-NBRE-POSTES to TB-MEMBER-POSTES
           Move 'CONTROL'    to WS-ORDRE
      *            on veut gérer les codes retours > 8
      *            -----------------------------------
           CALL LKISPF Using by Content 'CONTROL '
                                        'ERRORS  '
                                        'RETURN  '
           Perform CAS-ERREUR

           Move 'VDEFINE'    to WS-ORDRE
           CALL LKISPF Using    WS-ORDRE    WS-VARLIST   WS-VARISPF
                                WS-VARFORM  WS-VARLENGTH
                             by Content 'LIST    '
           Perform CAS-ERREUR

      *            Initialisation du dataid pour lirary Manager
      *            --------------------------------------------
           Move 'LMINIT'     to WS-ORDRE
           CALL LKISPF Using    WS-ORDRE
                             by Content 'DATAID0 '
                                        WS-SPACE
                                        WS-SPACE
                                        WS-SPACE
                                        WS-SPACE
                                        WS-SPACE
                                        WS-SPACE
                                        WS-SPACE
                                        WS-DDNAME

           Perform CAS-ERREUR

           Move 'LMOPEN'     to WS-ORDRE
           CALL LKISPF Using    WS-ORDRE   WS-DATAID
                             by Content 'INPUT   '
           Perform CAS-ERREUR

                 .
       TRAITEMENT.
      *            Boucle de recherche des membres PDS concaténés
      *            ----------------------------------------------
           Move 'LMMLIST'    to WS-ORDRE
           CALL LKISPF Using    WS-ORDRE   WS-DATAID
                              by Content 'LIST    '
                              WN-MBRE
                              by Content 'YES     '

           ADD 1 TO WS-CNT-MBRE
           If WS-CNT-MBRE > WS-NBRE-POSTES
              Display 'Plus de ' WS-NBRE-POSTES ' LUS - ON ARRETE !'
              Display '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
              Move 8 to RETURN-CODE
           End-if

           If RETURN-CODE = 0
      *       On prend le comptage reçu pour sa longueur utile
              Move function reverse(WS-ZLLIB) to WS-WORK
              Move 0 to WS-CNT
              Inspect WS-WORK  Tallying WS-CNT For Leading space
              Compute WS-CNT = length of WS-ZLLIB - WS-CNT

      *       Et on alimente nouveau poste du tableau (membre et rang)
              Move WS-MBRE            to TB-MEMBER-MBR(WS-CNT-MBRE)
              Move WS-ZLLIB(1:WS-CNT) to TB-MEMBER-RGD(WS-CNT-MBRE)
              Move WS-CNT-MBRE        to TB-MEMBER-POSTES
           End-if
           If RETURN-CODE > 8         Perform CAS-ERREUR    End-If

             .
       EPILOG.
      *            Libération du DATAID utilisé
      *            ----------------------------
           Move 'LMMLIST'    to WS-ORDRE
           CALL LKISPF Using    WS-ORDRE   WS-DATAID
                             by Content 'FREE    '
           Move 'LMCLOSE'    to WS-ORDRE
           CALL LKISPF Using    WS-ORDRE   WS-DATAID

           Move 'LMFREE'     to WS-ORDRE
           CALL LKISPF Using    WS-ORDRE   WS-DATAID
                                        WS-SPACE
                                        WS-SPACE
                                        WS-SPACE
                                        WS-SPACE
                                        WS-SPACE
                                        WS-SPACE
                                        WS-SPACE
                 .
       CAS-ERREUR.
      *            Controle et gestion des erreurs
      *            -------------------------------
           If RETURN-CODE > 4
               DISPLAY 'RETURN CODE ' WS-ORDRE ' = ' RETURN-CODE
               Move 'VCOPY'      to WS-ORDRE
               CALL LKISPF Using    WS-ORDRE   WS-VARLIST
                                               WS-VARLENGTH
                                               WS-VARISPF
                                 by Content 'MOVE    '
               DISPLAY 'ERREUR : '  WS-ZERRMSG '-' WS-ZERRLM
               Goback
           End-if.

       End Program COBISPF.