zOs/REXX/PDSTOSEQ
/*REXX******************************** begin member getmem *****
callable find members interface */
/* trace ?R */
arg mArg
/* call adrTsoRc 'execio 0 diskr outDD1 (finis)'
call adrTso 'free dd(outDD1)'
/
call des 'tmp.text(ser1)'
exit */
call showTime('start')
llq = 'PLI'
call serOpen 'tmp.text(ser1)'
call serPds 'wk.rexx', '*'
/* call serPds 'wk.pli', '*' */
call serClose
exit
serPds:
parse arg serPds, serMask
call gmIni , serPds, serMask
now = date('s') Time('n')
call serBegin 'pds', serPds now
do while (gmNext() <> '')
call serBegin 'mbr', gmMbr
call serDD serPds'('strip(gmMbr)')'
call serEnd 'mbr', gmMbr
end
call serEnd 'pds', serPds now
call showTime('serPds end' serPds)
return /* end serPds */
serDD:
parse arg serDsn
call adrTso 'alloc dd(serDD2) shr dsn('serDsn')'
do forever
serRc2 = adrTsoRc('execio 100 diskr serDD2 (stem st2.)')
if serRc2 <> 0 & serRc2 <> 2 then
call err 'bad rc' serRc2 'for tso execio 1 diskr serDD2'
call serStem st2.0, 'st2.'
if serRc2 <> 0 then
leave
end
call adrTsoRc 'execio 0 diskr serDD2 (finis)'
call adrTso 'free dd(serDD2)'
return /* end serDD */
out: procedure
parse arg typ, text
select;
when typ = '=' then do;
if left(text, length(serMark)) = serMark then
call out1 serMark 'data 1'
call out1 text
end
when left(typ, 1) = '(' then
call out1 serMark 'begin' substr(typ, 2) text
when left(typ, 1) = ')' then
call out1 serMark 'end' substr(typ, 2) text
when typ = '$alloc' then
call adrTso 'alloc dd(outDD) shr dsn('text')'
when typ = '$free' then do
call adrTso 'execio 0 diskw outDD (finis)'
call adrTso 'free dd(outDD)'
end
otherwise call err 'bad typ "' typ '" in out, text' text
end
return /* end out */
serBegin: procedure expose serMark
parse arg typ, name
call serOut serMark 'begin' typ name
return
serEnd: procedure expose serMark
parse arg typ, name
call serOut serMark 'end ' typ name
return
serOpen:
parse arg serOutDsn
serMark = '(((>>>'
call adrTso 'alloc dd(serOutDD) shr dsn('serOutDsn')'
return
serClose: procedure
call adrTso 'execio 0 diskw serOutDD (finis)'
call adrTso 'free dd(serOutDD)'
call showTime('serClose' serOutDsn)
return
serOut: procedure
parse arg line1
call adrTso 'execio 1 diskw serOutDD (stem line)'
return
serStem:
parse arg serCnt, serStem
call adrTso 'execio' serCnt 'diskw serOutDD (stem' serStem')'
return
des:
parse arg desInDsn
desMark = '(((>>> '
call adrTso 'alloc dd(desInDD) shr dsn('desInDsn')'
do forever
desRc = adrTsoRc('execio 100 diskr desInDD (stem des.)')
if desRc <> 0 & desRc <> 2 then
call err 'bad rc' desRc 'for tso execio 100 diskr serInDD'
desIx = 1
do while desIx < des.0
if left(des.desIx, length(desMark)) = desMark then do
desW2 = word(des.desIx, 2)
if desW2 = 'begin' then
call desBegin subWord(des,desIx, 3)
else if desW2 = 'end' then
call desEnd subWord(des,desIx, 3)
else
call err 'bad desW2' desW2 'in' des.desIx
desIx = desIx + 1
end
else do
do dexIx = 1 by 1
dex.dexIx = des.desIx
desIx = desIx + 1
if left(des.desIx, length(desMark)) = desMark then
leave
end
call desStem dexIx, 'dex.'
end
end
if desRc <> 0 then
leave
end
call adrTsoRc 'execio 0 diskr desInDD (finis)'
call adrTso 'free dd(desInDD)'
return /* end des */
desBegin: procedure
parse arg name text
say 'desBegin' name',' text
return
desEnd: procedure
parse arg name text
say 'desEnd' name',' text
return
desStem:
parse arg desCnt, desSt2
say 'desStem' desCnt desSt2':' left(value(desSt2'.1'), 50)
return
outMbr: /* example for lmm services, but too slow| */
parse arg outId, outMbr
call adrIsp 'lmmfind dataid(&'outId') member('outMbr')'
call out '(mbr', outMbr
outCnt = 0
do forever
outRc = adrIspRc('lmget dataid(&'outId')' ,
'mode(invar) dataloc(outRec)' ,
'maxLen(99999) datalen(outLen)')
if outRc = 0 then do
outCnt = outCnt + 1
call out '=', outRec
end
else if outRc = 8 then
leave
else
call err 'rc' outRc 'for isp lmget dataid(&'outId')'
end
call out ')mbr', outMbr outCnt
return /* outMbr */
gmIni:
parse arg gmSuf, gmDsn, gmPat
call adrTso "ALLOC DS("gmDsn") F(gmDD"gmSuf") REU SHR "
call adrIsp "LMINIT DATAID(gmII"gmSuf") DATASET("gmDSN") ENQ(SHRW)"
call adrIsp "LMOPEN DATAID(&gmII"gmSuf") OPTION(INPUT) "
if gmOpt = '' then
gmX = value('gmPP'gmSuf, '')
else
gmX = value('gmPP'gmSuf, 'pattern('gmPat')')
say 'gmPat' gmPat '=> gmPP'gmSuf '=' value('gmPP'gmSuf)
return; /* end gmIni */
gmFree:
parse arg gmSuf
if adrIspRc("LMMLIST DATAID(&gmII"gmSuf") option(free)") <> 0 then
if rc <> 8 then
call err "rc" rc "for isp" ,
"LMMLIST DATAID(&gmII"gmSuf") option(free)"
call adrIsp "LMCLOSE DATAID(&gmII"gmSuf")"
call adrIsp "LMFREE DATAID(&gmII"gmSuf")"
call adrTso "free f(gmDD"gmSuf")"
return /* end gmFree */
gmNext:
parse arg gmSuf
gmMbr = ''
gmRc = adrIspRc("LMMLIST DATAID(&gmII"gmSuf")" ,
"OPTION(LIST) MEMBER(gmMbr)" value('gmPP'gmSuf))
if gmRc <> 0 then
if gmRc <> 8 & gmRC <> 4 then
call err "adrIsp RC" gmRc "for" ,
"LMMLIST DATAID(&gmII"gmSuf")" ,
"OPTION(LIST) MEMBER(gmMbr)"
return gmMbr /* end gmNext */
showMbr:
parse arg shId, shMbr
call adrIsp 'lmmfind dataid(&'shId') member('shMbr') lrecl(lrecl)'
say 'lmmFind' shMbr 'lRecl' lRecl
do i=1 to 10
call adrIsp 'lmget dataid(&'shId') mode(invar) dataloc(rec)',
'datalen(recLen) maxlen('lrecl')'
say i 'len' recLen':' rec
end
return /* showMbr */
showTime:
parse arg showmsg
say time() sysvar('syscpu') sysvar('syssrv') showmsg
return 0
adrTsoRc:
parse arg tsoCmd
address tso tsoCmd
return rc /* end adrTsoRc */
adrTso:
parse arg tsoCmd
address tso tsoCmd
if rc <> 0 then
call err 'adrTso rc' rc 'for' tsoCmd
return /* end adrTso */
adrIspRc:
parse arg ispCmd
address ispexec ispCmd
return rc /* end adrIspRc */
adrIsp:
parse arg ispCmd
address ispexec ispCmd
if rc <> 0 then
call err 'adrIsp rc' rc 'for' ispCmd
return /* end adrIsp */
adrEdit:
parse arg editCmd, ret
address isrEdit editCmd
if rc <> 0 then
call err 'adr isrEdit rc' rc 'for' editCmd
return /* end adrEdit */
adrEditRc:
parse arg editCmd
address isrEdit editCmd
return rc /* end adrEditRc */
err:
parse arg txt
say 'fatal error in ??:' txt
exit 12