zOs/REXX/TRAN3
/**********************************************************************
synopsis: trans file*
translate the given files
to the characterset of the current OperatingSystem
no file or ?: this help
**** Unterschiede rexx auf z/os und ooRexx ****************************
z/os linux ooRexx
^ \ not
| ! or, concat
$mc$ ~
upper statement nur in z/os
sysvar function nur in z/os
c ! | all
c x'05' ' all tabs
*** History ***********************************************************
24.01.09 W. Keller neu
**********************************************************************/
parse arg arg
fun = 'trans'
os = errOs()
if 0 then do
call sayChar '¬'
call sayChar '['
call sayChar '|'
call sayChar ']'
call sayChar '!'
call sayChar '^'
call sayChar '\'
call sayChar '~'
call sayChar '£'
call sayChar '%'
call sayChar '!'
exit
end
if arg = '' ! arg = '?' then
exit help()
do ax=1 to words(arg)
fi = word(arg, ax)
say 'translating' fi
if os = 'LINUX' then do
address 'sh' 'cp' fi fi'~'
if fun == 'trans' then
call transLinux fi'~', fi
else if fun == 'inline' then
call transInline fi'~', fi
else
call err 'bad fun' fun
end
else do
call err 'implement os' os
end
end
exit
sayChar: procedure
parse arg ch
say length(ch) ch c2x(ch)
return
transLinux: procedure expose m.
parse arg inp, out
inputobject = .stream~new(inp)
outputobject = .stream~new(out)
outputobject~open(write replace)
signal on notready
all = ''
do y=1
line = inputObject~linein /* version vom 19.5.13 */
line = line~translate(']\', '|^')
/* achtung £ vom Host wird als 3 Byte Sequence dargestellt,
keyBoard £ wird 2 Byte Sequenz, drum nehmen wir stattdessen % */
line = repAll(line, x2c('c2a2'), '[')
line = repAll(line, '%%', '~')
line = repAll(line, 'sqlRow#', 'sqlRow/*??? # in zOS*/')
/* line = repAll(line, x2c('efbfbd'), '%')
line = repAll(line, '|', ']')
*/ outputObject~lineOut(line)
end
notReady:
say 'notReady' y 'inp' inp
inputobject~close()
outputobject~close()
return
endProcedure transLinux
transInline: procedure expose m.
parse arg inp, out
inputobject = .stream~new(inp)
outputobject = .stream~new(out)
outputobject~open(write replace)
signal on notready
name = '/'
do y=1
line = inputObject~linein
if abbrev(line, '/*<<') then do
name = substr(word(line, 1), 5)
outputObject~lineOut('/*')
outputObject~lineOut('$</'name'/')
end
else if name \== '/' & abbrev(line, name) then do
outputObject~lineOut('$/'name'/' subword(line, 2))
name = '/'
end
else do
outputObject~lineOut(line)
end
end
notReady:
say 'notReady' y 'inp' inp
inputobject~close()
outputobject~close()
return
endProcedure transInline
repAll:
parse arg line, fr, by
do forever
cx = line~pos(fr)
if cx = 0 then
return line
nn = left(line, cx-1) !! by !! substr(line,cx+length(fr))
say 'o' line
say 'n' nn
line = nn
end
/* copy err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
/* configure err -----------------------------------------------------*/
errReset: procedure expose m.
parse arg oo, ha
if pos('I', translate(oo)) > 0 then
call adrIsp 'control errors return'
m.err.opt = translate(oo, 'th', 'HT')
if ha == '' then
drop m.err.handler
else
m.err.handler = ha
return
endSubroutine errReset
/*--- error routine: abend with message ------------------------------*/
err:
parse arg ggTxt, ggOpt
if ggOpt == '' & symbol('m.err.handler') == 'VAR' then
interpret value('m.err.handler')
call outDest
call errSay ggTxt, 'e'
if ggOpt == '' & symbol('m.err.opt') == 'VAR' then
ggOpt = value('m.err.opt')
if pos('T', ggOpt) > 0 then do
trace ?r
say 'trace ?r in err'
end
if pos('H', ggOpt) > 0 then do
call errSay 'divide by zero to show stackHistory', 'e'
x = 1 / 0
end
call errSay 'exit(12)', 'e'
exit errSetRc(12)
endSubroutine err
/*--- assert that the passed rexx expression evaluates to true -------*/
assert:
interpret 'assertRes =' arg(1)
if \ assertRes then
call err 'assert failed' arg(1)':' arg(2)
return
endProcedure assert
/*--- output an errorMessage msg with pref pref
split message in lines at '/n' ---------------------------*/
errSay: procedure expose m.
parse arg msg, pref
parse source . . ggS3 . /* current rexx */
if pref == 'e' then
msg = 'fatal error in' ggS3':' msg
else if pref == 'w' then
msg = 'warning in' ggS3':' msg
else if pref \== '' then
msg = pref':' msg
return outLn(msg)
endProcedure errSay
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure expose m.
parse arg msg, op
call errSay msg, 'e'
call help
call err msg, op
endProcedure errHelp
/*--- return the Operating System we are running on: TSO or LINUX ---*/
errOS: procedure expose m.
parse source os .
return os
endProcedure errOS
/*--- set rc for ispf: -------------------------------------------------
if a cmd is run by ispStart, its RC is ignored,
but ISPF passes the value of the shared varible 3IspfRc
back as return code
----------------------------------------------------------------------*/
errSetRc: procedure expose m.
parse arg zIspfRc
if errOS() \== 'LINUX' then
if sysVar('sysISPF') = 'ACTIVE' then
address ispExec vput 'zIspfRc' shared
return zIspfRc
endProcedure errSetRc
/*--- output a trace message if m.tr is set -----------------------*/
trc: procedure expose m.
parse arg msg
if m.trace == 1 then
call out 'trc:' msg
return
endProcedure trc
debug: procedure expose m.
parse arg msg
if m.debug == 1 then
call out 'debug' msg
return
endProcedure debug
/*--- return current time and cpu usage ------------------------------*/
timing: procedure expose m.
return time() time('E') sysvar('syscpu') /* sysvar('syssrv') */
/*--- display the first comment block of the source as help ----------*/
help: procedure expose m.
parse source . . s3 .
call out right(' help for rexx' s3, 79, '*')
do lx=1 by 1
if pos('/*', sourceLine(lx)) > 0 then
leave
else if lx > 10 then do
call out '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
call out li
end
call out right(' end help for rexx' s3, 79, '*')
return 4
endProcedure help
/*--- output a message to the current destination -------------------*/
out: procedure expose m.
parse arg msg
if symbol('m.err.out') \== 'VAR' then
call outDest
interpret m.err.out
return 0
endProcedure out
/*--- output all lines (separated by '\n') of all args --------------*/
outLn: procedure expose m.
do ax=1 to max(1, arg())
msg = arg(ax)
sx = 0
bx = -1
do lx=1 until bx >= length(msg)
ex = pos('\n', msg, bx+2)
if ex < 1 then
ex = length(msg)+1
call out substr(msg, bx+2, ex-bx-2)
bx = ex
end
end
return 0
endProcedure outLn
/*--- set and return some frequent destinations for out -------------*/
outDest: procedure expose m.
parse arg ty, a
if ty == '' ! symbol('m.err.out') \== 'VAR' then
m.err.out = 'say msg'
if ty == 's' then
m.err.out = 'st='quote(a)';sx=m.st.0+1;m.st.0=sx;m.st.sx=msg'
else if ty == 'i' then
m.err.out = a
else if \ abbrev('=', ty) then
call err 'bad type in outDes('ty',' a')'
return m.err.out
endProcedure outDest
/*--- quote string txt using quoteChar qu ("""" ==> ") ---------------*/
quote: procedure expose m.
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
/* copy err end *****************************************************/