zOs/REXX.O13/PVSRTEDA
/* rexx ***************************************************************
pvsrTeDa testData Generator für Maschinentest
TestDaten erzeugen mit verschiedenen Beilagen Kombinationen
und verschiedenen Seitenzahlen (zurzeit für C4)
1. Beilagen definieren: bis zu sechs Beilagen, jede Beilage
kann beigelegt oder ausgelassen werden
2 ** b BeilagenKombination
2. Limiten bestimmen
config C5 und C4 ==> wir brauchen was zugross für C5 ist
==> wir brauchen was zugross für C5 aber OK für C4
Limiten hängen von BeilagenKobination
3. Random Funktion bestimmen, die Seitenverteilung bestimmt
==> typisch min. und max. Seitenanzahl häufig
erzeugen, mittlere Seitenzahlen seltener
4. Skeleton Dokument einlesen
5. Output Dokumente erzeugen, Kopie ab Skeleton mit
Random erzeugter BeilagenKombination und SeitenZahl
Parameter: fun mach sz1 sz2
fun = Funktion
mach = 'EIN' für Einzelblatt oder '1UP' für 1 up
sz1 sz2: Grössen
fun = 'T1': drei Test Dokumente erzeugen
fun = 'LIM': Limiten testen sz1=Ra (default 2)
erzeugt bis zu 4*Ra Dokumente dies- und jenseits der C4 Grenze
Seiten: p5-Ra+1..p5, p5+1..p5+Ra, p4-Ra+1..p4, p4+1..p4+R1
mit p5 = maximal Seiten C5 und p4=maximale Seiten C4
d.h. je Ra Dokumente die gerade noch passen bzw. nicht
==> Zweck: im Output überprüfen, ob Dokumente im richtigen
Format landen (suche nach dokc5, dokc4 und dokcH)
fun = 'ran': Random verteilte Dokumente erzeugen für C4
maximal sz1 Dokumente und sz2 Seiten (was zuerst erreicht wird)
IO: im Foreground werden docIn und pvsOut dynamisch alloziert
im Batch müssen sie prealloziert werden
DD docIn: Skeleton Dokument (1 PVS-Dokument mit 1 Seite)
==> POSY.RZ1.T0.AKT.TESTFALL.DATA(VERAAA)
DD pvsOut: output Druckfile im PVS-Format
jede Seite enthält Infos über Beilagen, Dokument
und das (erwartete) Format (dokc5, dokc4 und dokcH)
Konfiguration Beilagen: durch call addBei in procedure config
Konfiguration der Couverts usw. durch addFor in config,
Achtung die aktuellen Zahlen stimmen für Einzelblatt in einigen
Fällen nicht (POSY rechnet dort aus unerfindlichen Gründen anders)
Definition VerteilungsFunktion durch Zuweisung an m.dis.src
der Zugewiesene Wert muss die Form
s1 w1 s2 w2 ..... * * t1 v1 t2 v2 .....
haben. s1, t1, s2, t2 usw sind Seiten Zahlen
w1, v2, w2, v2 usw. sind ProzentZahlen
s%, t% gelten von links, t%, v% von rechts
und * * markiert die Mitte
mit p5 = maximal Seiten C5, p4=maximale Seiten C4
und tx vx letztes Tupel also
SeitenZahl p5+1 - p5+s1 mit w1% Wahrsch.
SeitenZahl p5+1+s1 - p5+s1+s2 mit w2% Wahrsch.
....
SeitenZahl mittendrin mit Rest Wahrsch.
....
SeitenZahl p4+1-tx - p4 mit vx% Wahrsch.
History
2005.12.22 W.Keller KRDO 4: refactoring und Kommentare
2005.11.22 W.Keller KRDO 4: neu
**********************************************************************/
m.trace = 0
if 0 then random(1,100,1) /* seed definieren, für reproduzierbare
Folge, sonst zufälliger Seed */
if 0 then call randShow
parse upper arg fun mach sz1 sz2
if fun = '' then
parse upper value 'ran 1up 2000 ' with fun mach sz1 sz2
say 'start fun' fun 'machine' mach 'size1' sz1 'size2' sz2
m.dis.src = '1 15 5 25 * * 5 25 1 15'
say 'disrtibution' m.dis.src
call config mach
say m.bei.0 'Beilagen und' m.com.0 'Kobminationen'
if 0 then call show
if 0 then call randTest
foreground = sysvar(sysEnv) = 'FORE'
if foreGround then
call foregroundAlloc "'POSY.RZ1.T0.AKT.TESTFALL.DATA(VERAAA)'",
, "'A540769.TEST.OUT'"
call readDoc
m.docs = 0
m.pages = 0
call writeDDBegin pvsOut
if fun = 'T1' then do
call onedoc 60 3
call onedoc 48 1
call onedoc 16 2
end
else if fun = 'LIM' then do /* check limits */
call show
border = sz1
if border = '' then
border = 2
do c = 1 to m.com.0
do p=max(1, m.com.c.pagC5 + 1 - border) to m.com.c.pagC5
call oneDoc c p, m.for.1.name
end
do p=m.com.c.pagC5 + 1 to m.com.c.pagC5 + border
call oneDoc c p, m.for.2.name
end
do p=m.com.c.pagC4+1-border to m.com.c.pagC4
call oneDoc c p, m.for.2.name
end
do p=m.com.c.pagC4+1 to m.com.c.pagC4+border
call oneDoc c p, m.for.3.name
end
end
end
else if fun = 'RAN' then do
if sz1 = '' & sz2 = '' then
sz1 = 20
if sz1 = '' then
sz1 = 999999999
if sz2 = '' then
sz2 = 999999999
do i=1 to sz1 while sz2 > m.pages + m.docs
call onedoc rand()
/* say c m.com.c.name p 'Dis' d */
end
end
else
call err 'bad fun' fun
call writeDDEnd pvsOut
say m.docs 'Dokumente mit' m.pages 'Seiten (ohne Adressblätter)'
if foreGround then
call foregroundFree
exit
/* print one Document with
BeilagenCombination c, number of pages p ----------------------*/
oneDoc: procedure expose m.
parse arg c p ., dokMrk
m.docs = m.docs + 1
m.pages = m.pages + p
call trc oneDoc 'comb' c m.com.c.name 'pages' p 'mark' dokMrk
/*---- beilagen */
beiStr = m.com.c.name
m.dt.1 = overlay(' ', m.dt.1, 93, 48)
bx = 0
do b=1 to m.bei.0
if substr(beiStr, 2*b - 1, 2) ^== m.bei.b.naSh then
iterate
bx = bx + 1 /* PVSBEIL(bx) */
m.dt.1 = overlay(m.bei.b.name, m.dt.1, 83 + 8*bx, 8)
end
m.dt.1 = overlay(d2c(bx,2), m.dt.1, 89, 2) /* PVSBEIL# */
/*---- pvsHeader */
m.dh.1 = overlay('Dok' || dokMrk || right(m.docs, 6)'Ti'm.time,
, m.dh.1, 51, 20) /* pvsUser2 */
m.dh.1 = overlay(m.pvsIdent, m.dh.1, 163, 8) /* pvsIdent */
m.dh.1 = overlay('1', m.dh.1, 208, 1) /* pvsFormH */
/*---- pvsAdress */
m.dh.2 = overlay('3', m.dh.2, 7, 1) /* pvsARule */
m.dh.2 = overlay(left('Seiten Anzahl', 18)right(p, 7),
, m.dh.2, 70, 35) /* pvsAdrL2 */
m.dh.2 = overlay(left('Dokument' dokMrk 'Nr.', 18)right(m.docs, 7),
, m.dh.2, 105, 35) /* pvsAdrL3 */
m.dh.2 = overlay('Beilagen' bx ':' beiStr , m.dh.2, 140, 35)
/*---- pvsTrailer */
m.dt.1 = overlay(d2c(p, 2), m.dt.1, 7, 2) /* PVSPAGE */
/*---- Daten */
q = m.ddx
if m.ddx.0 >= 2 & m.ddx.2 > 0 then
m.dd.q = overlay('DokNr.' right(m.docs, 6),
, m.dd.q, m.ddx.2, m.ddl.2)
if m.ddx.0 >= 3 & m.ddx.3 > 0 then
m.dd.q = overlay('Bei.' beiStr,
, m.dd.q, m.ddx.3, m.ddl.3)
call writeDD pvsOut, m.dh.
do px=1 to p
if m.ddx.0 >= 1 & m.ddx.1 > 0 then
m.dd.q = overlay('Seite'right(px,6)'/'right(p,5),
, m.dd.q, m.ddx.1, m.ddl.1)
call writeDD pvsOut, m.dd.
end
call writeDD pvsOut, m.dt.
return
endProcedure oneDoc
/*--- read and analyse the skeleton document
for later use by oneDoc ----------------------------------------*/
readDoc: procedure expose m.
call readDDBegin docIn
call readDD docIn, m.d., '*'
call readDDEnd docIn
dWrds = "$x1x$ $x2x$ $x3x$"
do x=1 to m.d.0
if left(m.d.x, 5) == '@#H04' then
hx = x
else if left(m.d.x, 5) == '@#A04' then
ax = x
else if left(m.d.x, 5) == '@#T04' then
tx = x
else if pos(word(dWrds, 1), m.d.x) > 0 then
dx = x
end
if hx ^== 1 | ax ^== 2 then
call err 'bad header' hx 'or address ' ax
if tx ^== m.d.0 then
call err 'bad trailer' tx ' ^= last' m.d.0
m.dh.0 = 2
m.dh.1 = m.d.1
m.dh.2 = m.d.2
m.dt.0 = 1
m.dt.1 = m.d.tx
y = 0
m.dd.0 = tx - 3
do x=ax+1 to tx-1
y = y+1
m.dd.y = m.d.x
end
m.ddx = dx - ax
m.ddx.0 = words(dWrds)
do v=1 to words(dWrds)
m.ddx.v = pos(word(dWrds, v), m.d.dx)
m.ddl.v = 20
end
say 'docIn docLines' m.dd.0
return
endProcedure readDoc
/*--- configure machine: c5, c4, cH and Beilagen ---------------------*/
config: procedure expose m.
parse arg m.machine
say 'Maschine' m.machine
m.for.0 = 0
m.bei.0 = 0
m.com.0 = 0
t = time()
m.time = left(t,2)substr(t, 4,2)right(t, 2)
if m.machine == '1UP' then do
m.pvsIdent = 'ZV06'
call addFor 'c5', 15, 3, 55-5
end
else if m.machine == 'EIN' then do
m.pvsIdent = 'HY21'
call addFor 'c5', 15, 3, 55-5 + 2
end
else
call err 'unbekannter Maschinen typ' m.machine
call addFor 'c4', 79, 1, 86-5-1 /* AdressBlatt abgezählt */
call addFor 'cH'
call addBei 'WK-BEI01', 10, 10
call addBei 'WK-BEI02', 12, 12
call addBei 'WK-BEI03', 999, 09
call addBei 'WK-BEI04', 14, 14
call addBei 'WK-BEI05', 5, 5
call addBei 'WK-BEI06', 999, 6
call combine 1, "", 0, 0
return
endProcedure config
/*--- add a envelop format: name, maximal Sheets,
thickness of one sheet, inside thickness of envelope -------*/
addFor: procedure expose m.
x = m.for.0 + 1
m.for.0 = x
parse arg m.for.x.name, m.for.x.shMax, m.for.x.shThick,
, m.for.x.thick
return
endProcedure addFor
/*--- add a Beilage: name, thickness C5, thickness C4 ----------------*/
addBei: procedure expose m.
x = m.bei.0 + 1
m.bei.0 = x
parse arg m.bei.x.name, m.bei.x.1, m.bei.x.2
sh = strip(m.bei.x.name)
m.bei.x.naSh = left(sh,1)right(sh,1) /* short name */
return
endProcedure addFor
/*--- for each combinatition of Beilagen calculate limits recursively
x = number of beilagen
nm = name of combination so far (concat of beilagen names
t1, t2 = total thickness of Beilagen in C5, respectively C4
----------------------------------------------------------------------*/
combine: procedure expose m.
parse arg x, nm, t1, t2
if x <= m.bei.0 then do
/* recursively do rest with and without Beilage x+1 */
call combine x+1, nm || left('',length(m.bei.x.naSh)), t1, t2
call combine x+1, nm || m.bei.x.naSh,
, t1 + m.bei.x.1, t2 + m.bei.x.2
return
end
/* all Beilagen: add combination */
y = m.com.0 + 1
m.com.0 = y
m.com.y.name = nm
m.com.y.thick1 = t1
m.com.y.thick2 = t2
p5 = min(m.for.1.shMax, /* max sheets C5 */
, max(0, (m.for.1.thick - t1) % m.for.1.shThick))
p4 = min(m.for.2.shMax, /* max sheets C4 */
, max(0, (m.for.2.thick - t2) % m.for.2.shThick))
if p5 >= p4 then
call err 'pagC5 > pagC4'
m.com.y.pagC5 = p5
m.com.y.pagC4 = p4
weTo = 0
ml = ''
p4 = p4 + 1
p5 = p5 + 1
mr = p4
if wordPos('*',m.dis.src)//2 ^=1 | words(m.dis.src) // 2 ^= 0 then
call err 'bad distribution src' m.dis.src
lx = 1
rx = words(m.dis.src)
do forever
if cl ^== '*' then do
cl = word(m.dis.src, lx)
wl = word(m.dis.src, lx+1)
lx = lx + 2
end
if cl ^== '*' then do
ml = ml p5 wl
p5 = p5 + cl
weTo = weTo + wl
if p5 >= p4 then do
m.com.y.pageDist = ml mr
leave
end
end
if cr ^== '*' then do
cr = word(m.dis.src, rx-1)
wr = word(m.dis.src, rx)
rx = rx - 2
end
if cr ^== '*' then do
p4 = p4 - cr
if p5 >= p4 then do
m.com.y.pageDist = ml p5 wr mr
leave
end
mr = p4 wr mr
weTo = weTo + wr
end
else if wr == '*' then do
if cr == '*' then
cr = 100-weTo
m.com.y.pageDist = ml p5 cr mr
leave
end
end
if weTo > 100 then
call err 'wei > 100 map' map
return
endProcedure combine
primes: procedure
parse arg p, lim
if p = '' then
p = 0
else
p = p - 1
do while p <= lim
p = prime(p+1)
say p
end
return
endProcedure primes
prime: procedure
parse arg s
if s // 2 = 0 then
s = s + 1
do forever
do d=3 by 1
if d * d > s then
return s
if s // d = 0 then
leave
end
s = s + 2
end
endProcedure prime
/*--- random next combination pages pair -----------------------------*/
rand: procedure expose m.
do ix=1 to 10000
c = random(1, m.com.0)
if c = '' then
call err 'emtpy combination in rand'
p = randDist(m.com.c.pageDist)
if p ^== '' then
return c p
end
call err 'all maps empty?'
endProcedure rand
/*--- test rand ------------------------------------------------------*/
randTest: procedure expose m.
mxPg = 100
do c=1 to m.com.0
do p=1 to mxPg
c.c.p = 0
c.c = 0
p.p = 0
end
end
do ix=1 to 10000
parse value rand() with c p
c.c.p = c.c.p + 1
c.c = c.c + 1
p.p = p.p + 1
end
do c=1 to m.com.0
say right(c.c, 6) 'comb' c left(m.com.c.name, 12),
"maxPages" right(m.com.c.pagC5, 5)right(m.com.c.pagC4, 5)
m = ''
do l=1 to mxPg while c.c.l = 0
end
do r=mxPg by -1 to 1 while c.c.r = 0
end
m=l'>'
do p=l to r
m = m c.c.p
end
m = m '<'r
say ' ' m
end
return
endProcedure randTest
/*--- get the next random value of random distribution map
map must be a list of numbers f1 w1 f2 w2 f3 w3.... meaning
f1 to f2-1 with with w1 percent probability
f2 to f3-1 with with w2 percent probability
----------------------------------------------------------------------*/
randDist: procedure expose m.
parse arg map
max = 1237-1 /* big prime - 1 ==> modulo is a prime */
if symbol('m.randDist.mapIndex.map') == 'VAR' then do
m = m.randDist.mapIndex.map
end
else do
if symbol('m.randDist.0') == 'VAR' then
m = m.randDist.0 + 1
else
m = 1
m.randDist.0 = m
m.randDist.mapIndex.map = m
fact = (max+1) / 100
rNx = 0
we = 0
do wx = 1 by 2 to words(map) - 1
fr = word(map, wx)+0
we = we + word(map, wx+1)
nx = word(map, wx+2)+0
if nx = '' then
nx = fr + 1
else if fr >= nx then
call err 'map not increasing at' wx'='fr 'map' map
rLa = rNx
rNx = we * fact
if rNx ^= trunc(rNx) then
rNx = trunc(rNx)+1
do r=rLa to rNx - 1
m.randDist.m.r = fr + ((r-rLa) % ((rNx-rLa)/(nx - fr)))
end
end
if rNx - 1 > max then
call err 'overflow' r 'in map' map
do r=rNx by 1 to max
m.randDist.m.r = ''
end
end
r = random(0, max)
return m.randDist.m.r
endProcedure randDist
randDistTest: procedure expose m.
parse arg map
say 'map' map
x = randDist(map)
m = m.randDist.mapIndex.map
do r=0 to 22
/* say right(r, 2) 'map' m.randDist.m.r */
c.r=0
end
ll = ''
c.ll = 0
do q=1 to 2000
c.x = c.x + 1
x = randDist(map)
end
say "'' dst" c.ll
do r=0 to 22
say right(r, 2) 'dst' c.r
c.r=0
end
return
endProcedure randDistTest
/*--- show configuration with limits --------------------------------*/
show: procedure expose m.
say 'distribution' m.diss.rc
l = length(m.com.1.name)
if l < 6 then
l = 6
say m.for.0 'formats'
do x=1 to m.for.0
say " " left(m.for.x.name, l),
"sheet max" right(m.for.x.shMax, 6) ,
"thickness sheet" right(m.for.x.shThick, 6) ,
"envelope inside" right(m.for.x.thick, 6)
end
say m.bei.0 'Beilagen'
do x=1 to m.bei.0
say " " left(m.bei.x.naSh, l) "thickC5C4",
|| right(m.bei.x.1, 5)right(m.bei.x.2, 5)
end
say m.com.0 'combinations'
do x=1 to m.com.0
if 1 then
say " " left(m.com.x.name, l),
"Beilagen" right(m.com.x.thick1,5)right(m.com.x.thick2,5),
"maxPages" right(m.com.x.pagC5, 5)right(m.com.x.pagC4, 5)
if 0 then
say ' pageDist' m.com.x.pageDist
end
return
endProcedure show
/*--- dyn alloc input and output ------------------------------------*/
foregroundAlloc: procedure
parse arg docIn, pvsOut
say "dynAlloc docIn " docIn
call adrTso "alloc dd(docIn) shr dsn("docIn")"
say "dynAlloc pvsOut" pvsOut
call adrTso "alloc dd(pvsOut) old dsn("pvsOut")"
return
endProcedure foregroundAlloc
/*--- dyn free input and output --------------------------------------*/
foregroundFree: procedure
call adrTso "free dd(docIn pvsOut)"
return
endProcedure foregroundFree
err:
parse arg ggMsg
call errA ggMsg
exit 12
endSubroutine err
/* copy adr 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 */
/*--- 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 */
/*--- 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 adr 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 *****************************************************/