zOs/REXX/TIMELRSN
call timeTest
exit
/*rexx*/
/******************************************************************/
/* LRSN */
/* */
/* 1 FUNCTION Translate Timestamp <-> LRSN (Todclock) */
/* */
/* 2 SUMMARY */
/* TYPE Rexx TSO/ISPF */
/* HISTORY: */
/* 09.11.2006 V1.0 base version (M.Streit,KITD2) */
/* 01.11.2007 V1.1 added uniq (W.Keller,KIUT23) */
/* */
/* Call: tso lrsn (TSO.RZ1.P0.USER.EXEC) */
/* */
/* 3 USAGE rexx lrsn start-procedure */
/* rexx rlrsn programm */
/* panel plrsn Mainpanel */
/* table tlrsn ISPF table */
/* */
/******************************************************************/
debug = 0 /* 0 oder 1 */
/* Check if LogMode 4 used */
lines=SYSVAR(SYSLTERM)
cols =SYSVAR(SYSWTERM)
if lines < 43
then do;
address ISPEXEC;
zmsg000l = "LM4 with 43x80 Chars required"
"setmsg msg(ispz000)"
exit(8);
end ;
/* Create ISPF table if necessary */
address ispexec
"control errors return" /* ISPF Error -> control back to pgm */
"tbopen tlrsn write" /* try to open table */
NAMES ="(CLRSN CTS CTSUTC CUNIQ JULIAN GMTTIME)"
if RC = 0 then do
address ispexec "tbQuery tlrsn names(tnm)"
if tnm <> names then do
say 'old table tLrsn has bad filed names' tnm
say 'drop and recreate table tLrsn' names
address ispexec 'tbEnd tLrsn'
address ispexec 'tberase tLrsn'
rc = 8
end
end
if rc = 8 then do /* if table not found...*/
address ispexec
"tbcreate tlrsn", /* table create */
"names"names "write replace"
if rc > 4 then do
say "Table create error with RC "rc
exit
end
"tbopen tlrsn write" /* table open */
end
if rc = 12 then do
"tbclose tlrsn "
"tbopen tlrsn write" /* try to open table */
if rc > 0 then do
say "Table open error with RC "rc
end
end
"tbtop tlrsn" /* jump to first row */
/* Display panel until PF3 is pressed */
selrows = "ALL" /* Angaben für Panel */
num1 = 1 /* Linien-Pointer */
c = ''
zc = 'CSR'
sdata = 'N'
ptimest = ''
plrsn = ''
do forever /* solange nicht PF3 */
call timeReadCvt
"tbtop tlrsn" /* jump to first row */
"tbdispl tlrsn panel(plrsn)" /* Panel anzeigen bis */
if rc > 4 then leave /* PF3 gedrückt? */
do while rc < 8
if c = 'D' then do
call del_row /* Zeilen löschen */
end
else if c <> ' ' then do
zmsg000s = "Command unknown"
zmsg000l = "Command unknown, only Delete(D) allowed"
"setmsg msg(ispz000)" /* Meldung ausgeben */
leave
end
if ztdSels <= 1 then
leave
"tbdispl tlrsn" /* get next selection */
end
c = ''
if plrsn <> '' then call calcFromLrsn pLrsn
if ptimest <> '' then call calcFromTst pTimeSt
if pUniq <> '' then call calcFromUniq pUniq
end
if sdata='Y' then
"tbclose tlrsn "
else
"tbend tlrsn"
exit
/* expand timestamp and validate it ***********************************/
checkTst: procedure
parse arg pTimeSt
/* ptimest = Timestamp format yyyy-mm-dd-hh.mm.ss.ffffff */
rTimeSt =overlay(ptimest, '1972-01-01-00.00.00.000000')
call timestampParse rTimest
/* check if values in range */
if (yyyy<1972) | (yyyy>2141) then do
zmsg000s = ""
zmsg000l = "year range: 1972-2041"
address ispExec " setmsg msg(ispz000)" /* Meldung ausgeben */
return ''
end
if (mo<1) | (mo>12) then do
zmsg000s = ""
zmsg000l = "month range 1-12"
address ispExec "setmsg msg(ispz000)" /* Meldung ausgeben */
return ''
end
if (dd<1) | (dd>31) then do
zmsg000s = ""
zmsg000l = "day range 1-31"
address ispexec "setmsg msg(ispz000)" /* Meldung ausgeben */
return ''
end
return rTimest
endProckedure checkTst
/* delete current row ***********************************************/
del_row:
address ispexec
rowid_nr=0
"tbget tdbnr rowid(rowid_nr)" /* Curor-Position lesen */
"tbskip tdbnr row("rowid_nr")" /* Cursor auf Row setzen */
"tbdelete tlrsn" /* Zeile löschen */
c = ''
return
/* read timeZoneOffset and leapSeconds registers
and set variables for uniq ***********************************/
read_cvt:
/* offsets documented in z/OS Data Areas Vol.1 */
cvt_off ='00000010' /* (offset = X'10') */
cvtext2_off='00000560'
cvtldto_off='00000038'
cvtlso_off ='00000050'
/* get CVT control block adress */
cvt_adr =C2X(STORAGE(cvt_off,4))
/* get address of extention2 */
cvtext2_adr =D2X(X2D(cvt_adr) + X2D(cvtext2_off))
/* get address of cvtldto timezone value */
cvtldto_adr =D2X(X2D(cvtext2_adr) + X2D(cvtldto_off))
/* get value */
cvtldto =C2X(STORAGE(cvtldto_adr,8))
/* get address of cvtlso leap seconds value */
cvtlso_adr =D2X(X2D(cvtext2_adr) + X2D(cvtlso_off))
/* get value */
cvtlso =C2X(STORAGE(cvtlso_adr,8))
cTZ = x2d(cvtLdto) * 1e-6 / 256 / 16 / 3600
cLS = trunc(x2d(cvtLso) * 1e-6 / 256 / 16)
uniqDigits = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ012345678'
/* find lrsn of day 0 */
uniqZero = left(conv2tod('2004-12-31-00.00.22.000000'), 12)
/* 0 out last 6 bits */
uniqZero = b2x(overlay('000000', x2b(uniqZero), 43))
if debug then do
say "cvt_adr = "cvt_adr
say "cvtext2_adr = "cvtext2_adr
say "cvtldto_adr = "cvtldto_adr
say "cvtldto (TOD-fmt) = "cvtldto,
'=' (x2d(cvtldto) * 16e-6 / 256 / 256) 'secs timezone'
say "cvtldto_adr = "cvtlso_adr
say "cvtlso (TOD-fmt) = "cvtlso ,
'=' (x2d(left(cvtlso, 13)) * 1e-6 ) 'leap secs'
say 'uniqZero' uniqZero ,
'base' length(uniqDigits) 'digits' uniqDigits
end
return
endSubroutin read_cvt
/* calculate all values from timestamp and add row ********************/
calcFromTst:
parse arg pTst
/* Timestamp format: yyyy-mm-dd-hh.mm.ss.ffffff */
rTimeSt = checkTst(pTst)
if rTimeSt = '' then
return
lrsn_cet= CONV2TOD(rTimeSt)
lrsn_cet=LEFT(STRIP(lrsn_cet),16,'0')
if debug then say "LRSN (CET) ="lrsn_cet
cLrsn = D2X(X2D(lrsn_cet) - m.timeZone + m.timeLeap)
if debug then say "LRSN (UTC) ="clrsn
cts = rtimest /*ptimest with overlay */
ctsutc = CONV2TS(clrsn)
gmtTime = substr(ctsutc, 12, 8)
cUniq = lrsn2uniq(cLrsn)
julian = tst2jul(cts)
ptimest = ''
"tbadd tlrsn"
return
endProcedure calcFromTst
/* from lrsn calculate all values add it to our table *****************/
calcFromLrsn:
parse arg lrsn
LRSN=LEFT(STRIP(LRSN),16,'0')
if debug then say "LRSN (UTC) ="LRSN
LRSN_TZ=D2X(X2D(LRSN) + m.timeZone)
if debug then say "LRSN timezone corrected ="LRSN_TZ
LRSN_CET=D2X(X2D(LRSN_TZ) - m.timeLeap)
if debug then say "LRSN timezone and leap seconds corrected ="LRSN_CET
if debug then say ""
if debug then say ""
if debug then say ""
/*********
LEAPSEC = 23
XSEC = X2D('0000000F4240000');
1 2 3 4 5 6 7
CORR = LEAPSEC * XSEC
**********/
if debug then say =CONV2TS(LRSN) "(UTC)"
clrsn = lrsn
cts = CONV2TS(LRSN_CET)
ctsutc = CONV2TS(LRSN)
gmtTime = substr(ctsutc, 12, 8)
cUniq = lrsn2uniq(cLrsn)
julian = tst2jul(cts)
"tbadd tlrsn"
if debug then say "RC="rc
plrsn = ''
return
endProcedure calcFromLrsn
/* from uniq calculate all values and add them to our table ***********/
calcFromUniq:
parse arg uniq
if verify(uniq, m.timeUQDigits) > 0 then do
zmsg000s = "bad uniq"
zmsg000s = ""
zmsg000l = "Uniq allows only characters A-Z and 0-8"
"setmsg msg(ispz000)" /* Meldung ausgeben */
return
end
call calcFromLrsn uniq2Lrsn(uniq)
pUniq = ''
return
calcFromUniq
/* timestamp to julian ************************************************/
tst2jul: procedure
parse arg yyyy '-' mm '-' dd '-'
/* date function cannot convert to julian, only from julian
==> guess a julian <= the correct and
try the next values
*/
j = trunc((mm-1) * 29.5) + dd
yy = right(yyyy, 2)
do j=j by 1
j = right(j, 3, 0)
d = date('s', yy || j, 'j')
if substr(d, 3) = yy || mm || dd then
return yy || j
end
return
/* convert a lrsn to the uniq variable ********************************/
lrsn2uniq: procedure expose m.
parse arg lrsn
/* unique are bits 0:41 of the TodClock value
minus 31.12.2004 represented
by base 35 by 'ABC...YZ01..8'
*/
lrsn = left(lrsn, 12)
diff = x2d(lrsn) - x2d(m.timeUQZero)
if diff < 0 then
return '<2005|'
diff = right(d2x(diff), 12, 0)
if debug then say ' lrsn ' lrsn
if debug then say '- zero ' m.timeUQZero
if debug then say '= ' diff
d42 = b2x(left(right(x2b(diff), 48, 0), 42))
if debug then say 'd42 ' d42
uni = right(i2bd(x2d(d42), m.timeUQDigits), 8, 'A')
if debug then say 'uni ' uni
return uni
endProcedure lrsn2uniq
/* convert a uniq variable to lrsn ************************************/
uniq2lrsn: procedure expose m.
parse arg uniq
uniq = left(uniq, 8, 'A')
d42 = d2x(bd2i(uniq, m.timeUQDigits))
d48 = b2x('00'x2b(d42)'000000')
lrsn = right(d2x(x2d(d48) + x2d(m.timeUQZero)), 12, 0)
return lrsn
endProcedure uniq2lrsn
/* conversion from Timestamp to TOD Clock Value ***********************/
CONV2TOD: PROCEDURE
/* timestamp yyyy-mm.... -> tod value: - leapseconds
BLSUXTID is described in z/OS V1R7.0 MVS IPCS Customization
BLSUXTID format : mo/dd/yyyy hh:mm:ss.ffffff
*/
parse arg tst
call timestampParse tst
tDate = mo'/'dd'/'yyyy' 'hh':'mm':'ss'.'ffffff
ACC=left('', 8)
ADDRESS LINKPGM "BLSUXTID TDATE ACC"
RETURN LEFT(c2x(ACC),16,'0')
endProcedure conv2tod
/* conversion from TOD Clock Value to Timestamp */
/* BLSUXTOD is described in z/OS V1R7.0 MVS IPCS Customization */
/* input -> + leapseconds -> output */
CONV2TS: PROCEDURE
ACC=ARG(1)
ACC=X2C(ACC)
TDATE = COPIES('0' , 26)
ADDRESS LINKPGM "BLSUXTOD ACC TDATE"
/* return format : mo/dd/yyyy hh:mm:ss.ffffff */
/* Timestamp format: yyyy-mm-dd-hh.mm.ss.ffffff */
parse var TDATE mo '/' dd '/' yyyy hh ':' mm ':' ss '.' ffffff
TDATE = yyyy'-'mo'-'dd'-'hh'.'mm'.'ss'.'ffffff
RETURN TDATE
bd2i: procedure expose m.
parse arg v, digits
b = length(digits)
i = 0
do x = 1 to length(v)
q = substr(v, x, 1)
r = pos(q, digits)
if r < 1 then
call err 'bad digit' q 'in' v 'valid digits' digits
i = i * b + r - 1
end
return i
i2bd: procedure expose m.
parse arg i, digits
if i = 0 then
return left(digits, 1)
b = length(digits)
v = ''
do while i > 0
v = substr(digits, 1 + (i // b), 1) || v
i = i % b
end
return v
/* copy time begin ---------------------------------------------------*/
timeTest: procedure
numeric digits 32
t1 = '2011-03-31-14.35.01.234567'
s1 = 'C5E963363741'
say 'Lrsn2Lzt('s1')' timeLrsn2Lzt(s1)
call timeReadCvt 1
say 'tst2jul('t1') ' tst2jul(t1)
say 'Lrsn2Gmt('s1')' timeLrsn2Gmt(s1)
say 'Lrsn2Lzt('s1')' timeLrsn2Lzt(s1)
say 'gmt2Lrsn('t1')' timeGmt2Lrsn(t1)
say 'lzt2Lrsn('t1')' timeLzt2Lrsn(t1)
say 'Lrsn2Gmt(gmt2Lrsn('t1')' timeLrsn2Gmt(timeGmt2Lrsn(t1))
say 'gmt2Lrsn(Lrsn2Gmt('s1')' timeGmt2Lrsn(timeLrsn2Gmt(s1))
say 'Lrsn2LZt(LZt2Lrsn('t1')' timeLrsn2LZt(timeLZt2Lrsn(t1))
say 'LZt2Stc(Lrsn2LZt('s1')(' timeLZt2Lrsn(timeLrsn2LZt(s1))
/* say 'conv2tod('t1')' conv2tod(t1) /* gmt --> stck */
say 'conv2ts('s1')' conv2ts(s1) /* stck --> gmt */
*/ return
endProcedure timeTest
/*--- read timeZoneOffset and leapSeconds registers
and set variables for uniq ----------------------------------*/
timeReadCvt: procedure expose m.
parse arg debug
numeric digits 32
/* offsets documented in z/OS Data Areas Vol.1 */
cvtOH = '00000010' /* cvt control block Address */
cvtext2O = x2d('00000560') /* offset to extension 2 */
cvtldtoO = x2d('00000038') /* offset to timezone */
cvtlsoO = x2d('00000050') /* offset to leapSeconds */
/* CVT CB address + extention2 */
cvtExt2A = C2D(STORAGE(cvtOH,4)) + cvtext2O
/* cvtLdto timeZone address +offset */
m.timeZone = c2d(STORAGE(d2x(cvtext2A+cvtldtoO, 8), 8))
m.timeStckUnit = 1e-6 / 256 / 16
/* cvtLso LeapSecs address +offset */
m.timeLeap = C2D(STORAGE(d2x(cvtext2A+cvtlsoO, 8), 8))
m.timeUQDigits = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ012345678'
/* find lrsn of day 0 */
m.timeUQZero = timeGmt2Lrsn('2004-12-31-00.00.22.000000')
/* 0 out last 6 bits */
m.timeUQZero = b2x(overlay('000000', x2b(m.timeUQZero), 43))
if debug == 1 then do
say 'stckUnit =' m.timeStckUnit
say 'timeLeap =' d2x(m.timeLeap,16) '=' m.timeLeap ,
'=' format(m.timeLeap * m.timeStckUnit, 9,3) 'secs'
say 'timeZone =' d2x(m.timeZone,16) '=' m.timeZone,
'=' format(m.timeZone * m.timeStckUnit, 6,3) 'secs'
say "cvtext2_adr =" d2x(cvtExt2A, 8)
say 'timeUQZero =' m.timeUQZero
say 'timeUQDigis =' ,
length(m.timeUQDigits) 'digits' m.timeUQDigits
end
m.timeReadCvt = 1
return
endSubroutin timeReadCvt
timestampParse:
parse arg yyyy'-'mo'-'dd'-'hh'.'mm'.'ss'.'ffffff
return
/*--- GMT timestamp yyyy-mm.... -> stck value char(8)
BLSUXTID is described in z/OS V1R7.0 MVS IPCS Customization
BLSUXTID format : mo/dd/yyyy hh:mm:ss.ffffff ---------------*/
timeGmt2Stck: procedure expose m.
parse arg tst
call timestampParse tst
tDate = mo'/'dd'/'yyyy' 'hh':'mm':'ss'.'ffffff
ACC=left('', 8, '00'x)
ADDRESS LINKPGM "BLSUXTID TDATE ACC"
RETURN acc
endProcedure timeGmt2Stck
/*--- GMT timestamp yyyy-mm.... -> stck value in hex(16) ------------*/
timeGmt2LRSN:
return c2x(left(timeGmt2Stck(arg(1)), 6))
endProcedure timeGmt2LRSN
/*--- LZT (Locale Zurich Tst -> stck value in hex(16) ---------------*/
timeLZT2LRSN: procedure expose m.
parse arg tst
if m.timeReadCvt \== 1 then
call timeReadCvt
return left(d2x(c2d(timeGmt2Stck(tst)) ,
- m.timeZone + m.timeLeap, 16), 12)
endProcedure timeLZT2LRSN
/*--- conversion from Stck Clock Value to GMT Timestamp
BLSUXTOD is described in z/OS V1R7.0 MVS IPCS Customization
input -> + leapseconds -> output ----------------------------*/
timeStck2Gmt: PROCEDURE expose m.
parse arg stck
stck = left(stck, 8, '00'x)
TDATE = COPIES('0' , 26)
ADDRESS LINKPGM "BLSUXTOD stck TDATE"
/* return format : mo/dd/yyyy hh:mm:ss.ffffff */
/* Timestamp format: yyyy-mm-dd-hh.mm.ss.ffffff */
parse var TDATE mo '/' dd '/' yyyy hh ':' mm ':' ss '.' ffffff
RETURN yyyy'-'mo'-'dd'-'hh'.'mm'.'ss'.'ffffff
endProcedure timeStck2Gmt
/*--- conversion from Lrsn Clock Value to GMT Timestamp -------------*/
timeLrsn2Gmt:
return timeStck2Gmt(x2c(arg(1)))
endProcedure timeLrsn2Gmt
/*--- conversion from Lrsn Clock Value to LZT Local Zurich Time -----*/
timeLrsn2LZT: procedure expose m.
parse arg lrsn
if m.timeReadCvt \== 1 then
call timeReadCvt
return timeStck2Gmt(d2c(x2d(left(lrsn, 16, 0)) ,
+ m.timeZone-m.timeLeap))
endProcedure timeLrsn2LZT
/* copy time end -----------------------------------------------------*/