*-----------------------------------------------------------------
program-id. XYB0T1B0.
author. lars kinger.
date-written. 11.11.2003.
date-compiled.
*-----------------------------------------------------------------
*Description:
* Reads the directory of a PDS.
* For each member in the directory the program opens the member
* and read all records in it.
*
* The program uses the new ENVIR variable i Cobol Enterprise
* to make dynamic allocation of members in input PDS.
*
* JCL used to run this program:
* //L58502S JOB ,NOTIFY=&SYSUID, TIME=3,
* // MSGCLASS=H,REGION=0M,CLASS=T,SCHENV=EGET0
* /*JOBPARM S=MVSB
* //*
* //XYB0T1B0 EXEC PGM=XYB0T1B0,
* // PARM=('/ENVAR ("DYNFILE=DSN(X.X) SHR")')
* //STEPLIB DD DSN=SUPG.PROG,DISP=SHR
* // DD DSN=SUPG.PROG2,DISP=SHR
* // DD DSN=SUPG.PROG3,DISP=SHR
* // DD DSN=SUPG.PROG4,DISP=SHR
* // DD DSN=SUPG.PROG5,DISP=SHR
* // DD DSN=SUPG.PROG6,DISP=SHR
* //SYSPRINT DD SYSOUT=*
* //SYSUDUMP DD SYSOUT=*
* //DIRDATA DD DSN=L58502.TSO.CNTL,DISP=SHR,
* // DCB=(RECFM=U,BLKSIZE=256,LRECL=256)
* //SYSOUT DD SYSOUT=*,DCB=(RECFM=FBA,LRECL=256)
* //SYSIN DD *
* L58502.TSO.CNTL
* //*
*-----------------------------------------------------------------
environment division.
*-----------------------------------------------------------------
configuration section.
*-----------------------------------------------------------------
source-computer. ibm-370.
object-computer. ibm-370.
special-names.
decimal-point is comma.
input-output section.
file-control.
select directoryData assign to dirData.
select memberData assign to DYNFILE
file status is memberDataStatus.
*-----------------------------------------------------------------
data division.
*-----------------------------------------------------------------
file section.
fd directoryData
record contains 256
recording mode is U.
01 directoryData-record pic x(256).
fd memberData
recording mode F
block contains 0 records
label record is standard.
01 memberData-record pic X(080).
**************************************************************
working-storage section.
**************************************************************
*
01 ws-DirectoryData-rec.
02 DirectoryData-rec.
03 DirectoryDataLgd pic s9(04) comp.
03 DirectoryDataOccurs occurs 6 times.
05 DirectoryDataName pic x(08).
05 filler pic x(04).
05 vv pic x(01).
05 mm pic x(01).
05 filler pic x(01).
05 SecChanged pic x(01).
05 DteCreate pic x(04).
05 DteChanged pic x(04).
05 TimeChangedH pic x(01).
05 TimeChangedM pic x(01).
05 MemberSize pic s9(04) comp.
05 MemberInit pic s9(04) comp.
05 filler pic x(02).
05 MemberUser pic x(10).
01 ws-memberData-rec.
02 memberData-rec pic x(80).
01 bitByteWorkAreas.
03 charWork.
05 char1 pic x(01).
05 char2 pic x(01).
03 binWork redefines charWork pic S9(04) binary.
03 bitNo pic S9(04) binary.
03 J pic S9(04) binary.
03 firstHalfByteValue pic 9(02).
03 secondHalfByteValue pic 9(02).
03 oneByte pic x(01).
03 SingleBits-tbl.
05 SingleBits pic 9(01) occurs 8.
01 MiscFields.
03 ix pic s9(08) comp.
03 memberDataStatus pic 9(02) display.
03 note9dm pic x(08).
03 wDispfelt01 pic 9(02).
03 wDispfelt02 pic 9(04).
03 wVVdotMM.
05 wVV pic 9(02).
05 filler pic x(01) value '.'.
05 wMM pic 9(02).
03 wChangeTime.
05 wHour pic 9(02).
05 filler pic x(01) value ':'.
05 wMin pic 9(02).
05 filler pic x(01) value ':'.
05 wSec pic 9(02).
03 wDirectoryDataName pic x(08).
03 wMemberSize pic s9(04) comp.
03 wMemberInit pic s9(04) comp.
03 wMemberUser pic x(10).
* Workareas for filehandling.
01 directoryDataEofSw pic 9(01) value 0.
88 directoryDataNotEOF value 0.
88 directoryDataEOF value 1.
01 memberDataEofSw pic 9(01) value 0.
88 memberDataNotEOF value 0.
88 memberDataEOF value 1.
* Workareas used for dynamic allocation of pds
01 dynAllocationWork.
03 extractPDS pic X(300).
03 statusMessage pic X(120).
03 sourcelibr pic X(045).
03 memberName pic X(008).
03 RC pic 9(009) binary.
03 RC-EDIT pic ------9.
03 extractPDS-PTR pointer.
******************************************************************
*** Installation specific copybook. ****
*** Can be excluded. No fields are referred to. ****
******************************************************************
BSLATCZ
**************************************************************
procedure division.
**************************************************************
main.
accept sourcelibr from sysin
perform openDirectoryData
perform readDirectoryData
perform until directoryDataEOF
* display ws-DirectoryData-rec
perform readThroughPDSMembers
perform readDirectoryData
end-perform
close directoryData
perform StopProgram
.
*-----------------------------------------------------------------
StopProgram.
stop run
.
*-----------------------------------------------------------------
readThroughPDSMembers.
perform until directoryDataEOF
display ws-DirectoryData-rec
perform varying tally from 1 by 1
until tally > 6 or
directoryDataEOF
if directoryDataName (tally) = high-values
set directoryDataEOF to true
else
perform storeDirectoryData
* perform dispDirectoryData
perform extractFromMemberData
end-if
end-perform
perform readDirectoryData
end-perform
.
*-----------------------------------------------------------------
storeDirectoryData.
* Store member informations from directory in working-storage
* Store membername
move DirectoryDataName (tally) to wDirectoryDataName
* Store version/level of member
move vv(tally) to oneByte
perform findBinValue
move firstHalfByteValue(2:1) to wVV(1:1)
move secondHalfByteValue(2:1) to wVV(2:1)
move mm(tally) to oneByte
perform findBinValue
move firstHalfByteValue(2:1) to wMM(1:1)
move secondHalfByteValue(2:1) to wMM(2:1)
* Store time of last change of member
move TimeChangedH(tally) to oneByte
perform findBinValue
move firstHalfByteValue(2:1) to wHour(1:1)
move secondHalfByteValue(2:1) to wHour(2:1)
move TimeChangedM(tally) to oneByte
perform findBinValue
move firstHalfByteValue(2:1) to wMin(1:1)
move secondHalfByteValue(2:1) to wMin(2:1)
move SecChanged(tally) to oneByte
perform findBinValue
move firstHalfByteValue(2:1) to wSec(1:1)
move secondHalfByteValue(2:1) to wSec(2:1)
* Store other information
move MemberSize (tally) to wMemberSize
move MemberInit (tally) to wMemberInit
move MemberUser (tally) to wMemberUser
.
*-----------------------------------------------------------------
extractFromMemberData.
* Reads through a membername extracted form the directory
perform openMemberData
display ' '
display 'reading ' extractPDS(1:80)
perform readMemberData
* perform until memberDataEOF
perform varying ix from 1 by 1
until ix > 3
or memberDataEOF
perform doSomethingWithMember
perform readMemberData
end-perform
close memberData
.
*-----------------------------------------------------------------
doSomethingWithMember.
* In this section you can whatever you want with the data from
* a member.
display ws-memberData-rec
.
*-----------------------------------------------------------------
findBinValue.
* Find the eight bits in one byte (1 and 0 values)
move zero to binWork
move oneByte to CHAR2
move 256 to J
perform varying bitNo from 1 by 1
until bitNo > 8
compute J = J / 2
if binWork >= J then
move 1 to singleBits(bitNo)
subtract J from binWork
else
move 0 to singleBits(bitNo)
end-if
end-perform
perform findHalfBytevalues
* display 'singlebits ' singleBits-tbl
.
*-----------------------------------------------------------------
findHalfBytevalues.
* Find the value of the first four bits of a byte
compute firstHalfByteValue =
((singleBits(1) * 8) +
(singleBits(2) * 4) +
(singleBits(3) * 2) +
(singleBits(4) * 1) )
* Find the value of the last four bits of a byte
compute secondHalfByteValue =
((singleBits(5) * 8) +
(singleBits(6) * 4) +
(singleBits(7) * 2) +
(singleBits(8) * 1) )
.
*-----------------------------------------------------------------
dispDirectoryData.
* Display informations from PDS directory for each member
display 'Name ' DirectoryDataName (tally)
display 'vv.mm ' wVVdotMM
display 'DteCreate ' dteCreate (tally)
display 'DteChanged ' dteChanged (tally)
display 'ChangeTime ' wChangeTime
display 'MemberSize ' MemberSize (tally)
display 'MemberInit ' MemberInit (tally)
display 'MemberUser ' MemberUser (tally)
display '------------'
.
*-----------------------------------------------------------------
openDirectoryData.
open input DirectoryData
.
*-----------------------------------------------------------------
readDirectoryData.
read DirectoryData into ws-DirectoryData-rec
at end
set directoryDataEOF to true
end-read
.
*-----------------------------------------------------------------
openMemberData.
perform setEnvirVariable
open input memberData
if memberDataStatus not = '00'
move spaces to statusMessage
string 'ERROR, write to DSN ' delimited by size
extractPDS delimited by space
' FAILED WITH status = ' delimited by size
memberDataStatus delimited by size
into statusMessage
end-string
perform ErrorHandling
end-if
.
*-----------------------------------------------------------------
setEnvirVariable.
move wDirectoryDataName to memberName
move spaces to extractPDS
string 'DYNFILE=' delimited by size
'DSN(' delimited by size
sourcelibr delimited by space
'(' delimited by size
memberName delimited by space
')) SHR' delimited by size
into extractPDS
end-string
* display extractPDS(1:80)
set extractPDS-PTR to address of extractPDS
call 'PUTENV' using by value extractPDS-PTR
returning RC
if RC not = zero
move RC to RC-EDIT
move spaces to statusMessage
string 'ERROR, PUTENV FAILED WITH RC = '
RC-EDIT
delimited by size
into statusMessage
end-string
perform ErrorHandling
end-if
.
*-----------------------------------------------------------------
readMemberData.
read memberData into ws-memberData-rec
at end
set memberDataEOF to true
end-read
.
*-----------------------------------------------------------------
ErrorHandling.
display statusMessage
move 16 to return-code
perform StopProgram
.
