zOs/REXX.O08/SPLT
/* rexx ****************************************************************
line- word and character count
***********************************************************************/
parse arg dsn
if dsn = '' then
dsn = "'TSS.SKA.PF22.KEM4000P.UNLOAD.S2006211'"
outPr = TSS.SKA.PF22.KEM4000P.UNLOAD.W
outat = "new catalog mgmtclas(BAT#ZJ) dataclas(EYN0XP) like("dsn")" ,
"space (500, 1000) cylinders"
call adrTso 'alloc dd(inDD) shr reuse dsn('dsn')'
call readDDBegin inDD
cc = 0
lc = 0
wc = 0
last = ''
outFi = ''
oc = 0
or = 0
ot = 0
do bc=1 by 1 while readDD(inDD, r.)
rx = 0
do while rx < r.0
rx = rx + 1
lc = lc + 1
cc = cc + length(r.rx)
wc = wc + words(r.rx)
cur = substr(r.rx, 7, 26)
jul = left(cur, 4)substr(cur, 6,2)substr(cur, 9,2)
jul = left(jul, 4)right(date('d', jul, 's'), 3, '0')
if last >= cur then
call err 'line' lc cur '<= previous' last
if left(cur, 7) <> left(last, 7) then do
rx = closeOut(rx)
if substr(cur, 6, 2) = '12' then do
outFi = (left(cur, 4) + 1)'001'
end
else do
da = left(cur, 4)right(substr(cur, 6, 2)+1, 2, '0')'01'
outFi = left(da, 4)right(date('d', da, 's'), 3, '0')
end
oc = oc + 1
outFi = left(cur,4)substr(cur,6,2)
outDsn = "'"outPr || outFi"'"
say 'open outFi' oc outFi outDsn 'lc' lc
call adrTso "alloc dd(ddOut)" outAt "dsn("outDsn")"
call writeDDBegin ddOut
end
last = cur
end
call writeDD ddOut, r.
or = or + r.0
if (bc // 1000) == 0 then
say 'lc' lc 'wc' wc 'cc' cc 'lRecL' (cc/lc) 'block' bc
end
rx = closeOut(1)
call readDDEnd inDD
call adrTso 'free dd(inDD)'
say 'lc' lc 'wc' wc 'cc' cc 'lRecL' (cc/lc) 'block' bc
say ' for' dsn
exit
closeOut:
parse arg nxt
if outFi <> '' then do
if nxt > 1 then do
call writeDD ddOut, r., nxt-1
or = or + nxt - 1
end
call writeDDEnd ddOut
call adrTso "free dd(ddOut)"
ot = ot + or
say 'close outFi' oc outFi 'written' or 'tot' ot 'lc' lc
or = 0
end
if nxt > 1 then do
do nqq=nxt by 1 to r.0
nqd = nqq - nxt + 1
r.nqd = r.nqq
end
r.0 = r.0 - nxt + 1
end
return 1
endSubroutine closeOut
err:
parse arg ggMsg
call errA ggMsg
exit 12
endSubroutine err
/* copy adrTso begin *************************************************/
/*--- format dsn from tso format to jcl format -----------------------*/
dsn2jcl: procedure
parse arg dsn .
if left(dsn,1) = "'" then
return strip(dsn, 'b', "'")
else if sysvar('SYSPREF') = '' then
return dsn
else
return sysvar('SYSPREF')'.'dsn
endProcedure dsn2Jcl
/*--- format dsn from jcl format to tso format -----------------------*/
dsnFromJcl: procedure
parse arg dsn .
return "'"dsn"'"
endProcedure dsnFromJcl
/**********************************************************************
io: read or write a dataset with the following callsequences:
read: readDDBegin, readDD*, readDDEnd
write: writeBegin, writeDD*, writeEnd
readDD returns true if data read, false at eof
***********************************************************************/
/*--- prepare reading from a DD --------------------------------------*/
readDDBegin: procedure
return /* end readDDBegin */
/*--- read from DD ggDD into ggSt, return false at eof ---------------*/
readDD:
parse arg ggDD, ggSt, ggCnt
if ggCnt = '' then
ggCnt = 100
call adrTso 'execio' ggCnt 'diskr' ggDD '(stem' ggSt')', 2
return (value(ggSt'0') > 0)
return /* end readDD */
readDDall:
parse arg ggDD, ggSt
call adrTso 'execio * diskr' ggDD '(stem' ggSt' finis)'
return
endSubroutine readDDall
readDSN:
parse arg dsn, ggSt
call adrTso 'alloc dd(readDsn) shr dsn('dsn')'
call readDDall readDsn, ggSt
call adrTso 'free dd(readDsn)'
return
endSubroutine readDsn
/*--- finish reading DD ggDD ----------------------------------------*/
readDDEnd: procedure
parse arg ggDD
call adrTso 'execio 0 diskr' ggDD '(finis)'
return /* end readDDEnd */
/*--- prepare writing to DD ggDD -------------------------------------*/
writeDDBegin: procedure
parse arg ggDD
/* ensure file is erased, if no records are written */
call adrTso 'execio' 0 'diskw' ggDD '(open)'
return /* end writeDDBegin */
/*--- write to gg ggDD from stem ggSt, ggCnt records -----------------*/
writeDD:
parse arg ggDD, ggSt, ggCnt
if ggCnt == '' then
ggCnt = value(ggst'0')
call adrTso 'execio' ggCnt 'diskw' ggDD '(stem' ggSt')'
return
endSubroutine writeDD
/*--- end writing to dd ggDD (close) --------------------------------*/
writeDDEnd: procedure
parse arg ggDD
call adrTso 'execio 0 diskw' ggDD '(finis)'
return /* end writeDDEnd */
/*--- end write a stem to a dsn -------------------------------------*/
writeDSN:
parse arg dsn, ggSt
call adrTso 'alloc dd(wriDsn) shr dsn('dsn')'
call adrTso 'execio' value(ggSt'0') ,
'diskw wriDsn (stem' ggSt 'finis)'
call adrTso 'free dd(wriDsn)'
return
/*--- send ggTsoCmd to tso, fail if rc <> 0 or not listed in ggRet ---*/
adrTso:
parse arg ggTsoCmd, ggRet
address tso ggTsoCmd
if rc == 0 then return 0
else if ggRet == '*' then return rc
else if wordPos(rc, ggRet) > 0 then return rc
else
call err 'adrTso rc' rc 'for' ggTsoCmd
return /* end adrTso */
/* copy adrTso end ****************************************************/
/* copy err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
parse arg ggMsg
call errA ggMsg
exit 12
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
x = x / 0
exit setRc(12)
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
say 'fatal error:' ggMsg
call help
call err ggMsg
endProcedure errHelp
/*--- set rc for ispf: -------------------------------------------------
if a cmd is run by ispStart, its RC is ignored,
but ISPF passes the value of the shared varible zIspfRc
back as return code
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- output a trace message if m.trace is set -----------------------*/
trc: procedure expose m.
parse arg msg
if m.trace == 1 then
say 'trc:' msg
return
endProcedure trc
/*--- quote string txt using quoteChar qu ("""" ==> ") ---------------*/
quote: procedure
parse arg txt, qu
if qu = '' then
qu = '"'
res = qu
ix = 1
do forever
qx = pos(qu, txt, ix)
if qx = 0 then
return res || substr(txt, ix) || qu
res = res || substr(txt, ix, qx-ix) || qu || qu
ix = qx + length(qu)
end
endProcedure quote
/*--- return current time and cpu usage ------------------------------*/
showtime: procedure
parse arg showmsg
return time() sysvar('syscpu') /* sysvar('syssrv') */ showmsg
/--- display the first comment block of the source as help -----------*/
help: procedure
parse source . . s3 .
say 'help for rexx' s3
do lx=1 by 1
if pos('/*', sourceLine(lx)) > 0 then
leave
else if lx > 10 then do
say 'initial commentblock not found for help'
return
end
end
do lx=lx+1 by 1
li = strip(sourceLine(lx), 't', ' ')
if pos('*/', li) > 0 then
leave
say li
end
return 4
endProcedure help
/* copy err end *****************************************************/