REXX procedure to display DBRM Timestamp
REXX procedure to display DBRM Timestamp:
/* REXX - Display a DBRM TimeStamp in a real date time format. */ /* - format is TSO DBRMTS DSN(MEMBER) (no quotes) */ /* - or TSO DBRMTS CONTOKEN=xxxxxxxxxxxxxxxx [MODE=SQLJ] */ /* xx...xx is the 16 hex digits of the contoken. */ /* */ /* Brian Kavanagh 92/09/10 */ /* Terry Doner 94/04/22 */ /* Axel Zuber 04/03/25 fixed the microseconds todo */ /* Peter Wirfs 06/07/08 amendment */ /* Gernot Ruban 08/11/27 amendment for V81 and V91 */ /* Axel Zuber 09/10/06 added contokens generated by SQLJ/IBM */ parse upper arg inparm if substr(inparm,1,9) = 'CONTOKEN=' /* added for batch testing */ then do parse var inparm . 'CONTOKEN='contoken 'MODE='mode contoken = strip(contoken) mode = strip(mode) if mode ^= ' ' & mode ^= 'SQLJ' then do say "unsupported mode" mode exit end /* contoken = substr(inparm,10,16) /* DISPLAY HEX */ */ tod = TimeStamp(contoken, mode) say 'Contoken' contoken '=>'tod zedlmsg = 'Contoken' contoken '=>'tod zedsmsg = '=>'tod address ISPEXEC 'SETMSG MSG(ISRZ000)' if rc = 0, then return 0 else return tod /* only valid for return to other rexx */ /* in a non iSPF environment */ return 0 end /* assume we have dataset input */ dsn=inparm if DSN = "" then do SAY "Format of exec is...TS PDSName(MemberName)" exit end IndexPos = Index(DSN,"(") If IndexPos = 0 then do say "Dataset specified must include member." exit end /* strip quotes if they exist */ if left(DSN,1) = "'" then DSN = Substr(DSN,2) IndexPos = Index(DSN,"'") If IndexPos > 0 then do DSNLength = IndexPos - 1 DSN = left(DSN,DSNLength) end status = sysdsn("'"dsn"'") if status ^= "OK" then do say "Problem with PDS Name Supplied..." status exit end IndexPos = Index(DSN,"(") IndexPos = IndexPos + 1 Member = Substr(DSN,IndexPos) IndexPos = Index(Member,")") MemLength = IndexPos - 1 Member = left(Member,MemLength) "alloc file(sysin) dataset('"dsn"') shr reuse" "execio 2 diskr sysin (stem dbrm. finis" if rc ^= 0, then do say "Problem reading member. Could it be empty? RC="RC exit end "free file(sysin)" if left(DBRM.1,4) ^= "DBRM" then do say "PDS Member is not a DBRM" exit end contoken = c2x(substr(dbrm.1,25,8)) /* quick hack. find a better criterion */ /* than the 'userid equal to blanks' */ mode = '' if substr(dbrm.1,9,8) = "" then mode = 'SQLJ' tod = TimeStamp(contoken, mode) zedsmsg = tod zedlmsg = Member !! ": '"contoken"'X ==>" tod address ISPEXEC 'SETMSG MSG(ISRZ000)' if rc ^= 0 then say smsg /* ISPF failure, try REXX say instead */ DBRMMRIC = substr(DBRM.1,80,1) db2ver='Pre V1.3' /* DBRMMRIC translation taken from ISC response 12E25,093,649 */ if DBRMMRIC = 'B' then db2ver='V1.3' if DBRMMRIC = 'C' then db2ver='V2.1' if DBRMMRIC = 'D' then db2ver='V2.2' if DBRMMRIC = 'E' then db2ver='V2.3' if DBRMMRIC = 'F' then db2ver='V3.1' if DBRMMRIC = 'G' then db2ver='V4.1' if DBRMMRIC = 'H' then db2ver='V5.1' if DBRMMRIC = 'I' then db2ver='V6.1' if DBRMMRIC = 'J' then db2ver='V7.1' if DBRMMRIC = 'K' then db2ver='V7.2' if DBRMMRIC = 'L' then db2ver='V8.1' if DBRMMRIC = 'M' then db2ver='V9.1' say 'DBRM name :' substr(DBRM.1,17, 8 ) say 'Pre-Compiled by:' substr(DBRM.1, 9, 8 ) say "Contoken :'"contoken"'X" say "Timestamp :" tod if DBRMMRIC >'D' then , say 'Version Id :' substr(DBRM.2, 3,64 ) say "DB2 Version :" db2ver return 0 /*******************************************/ TimeStamp: procedure; arg ts, mode select when ts = '0E5F2F3F00404040' ! ts = '0E5F2F3F01404040' then do tod = '0001-01-01-00.00.00.00' end when left(ts,1) = "0" then do /* amendment by Peter Wirfs, 2006-08-7 */ parse var ts 2 byte1to4half +7, 10 byte4halfto7 tod = x2c(byte1to4half!!byte4halfto7) end when mode = 'SQLJ' then do tod = #sqljtod(ts) end otherwise do numeric digits 30 w1 = left(ts,8) w2 = right(ts,8) w2 = sll(w2,3) tod = #tod(sldl(w1!!w2,3)) "(UTC/GMT)" end end /* select */ return tod sll: Procedure; arg w,x return B2X(right(X2B(w)!!copies('0',x),32)) sldl: Procedure; arg dw,x return B2X(right(X2B(dw)!!copies('0',x),64)) srd: Procedure; arg dw,x return B2X(left(copies('0',x)!!X2B(dw),64)) /*******************************************/ #tod: procedure; arg tod numeric digits 20 msecs = X2D(srd(tod,12)) secs = msecs % 1000000 msecs = msecs - 1000000 * secs days = secs % 86400 secs = secs - 86400 * days hours = secs % 3600 secs = secs - 3600 * hours minutes = secs % 60 secs = secs - 60 * minutes xhours = right('00'hours,2) xminutes = right('00'minutes,2) xsecs = right('00'secs,2) xms = right('000000'msecs,6) xtime = xhours'.'xminutes'.'xsecs'.'xms xdate = jd2cal(cal2jd(1900 01 01)+days) parse var xdate years month days xdate = right('0000'years,4) !!'-'!!, right('00'month,2) !!'-'!!, right('00'days,2) return xdate!!"-"!!xtime /*******************************************/ #sqljtod: procedure; arg token /* trace '?I' */ xmap = "4142434445464748494A4B4C4D4E4F50", !!"5152535455565758595A616263646566", !!"6768696A6B6C6D6E6F70717273747576", !!"7778797A313233343536373839304023", !!"245F2020202020202020202020202020", !!"20202020202020202020202020202020", !!"20202020202020202020202020202020", !!"20202020202020202020202020202020", !!"20202020202020202020202020202020", !!"20202020202020202020202020202020", !!"25202B20202020202020202020202020", !!"202020202020" dayofweek.0 = 'Sun' dayofweek.1 = 'Mon' dayofweek.2 = 'Tue' dayofweek.3 = 'Wed' dayofweek.4 = 'Thu' dayofweek.5 = 'Fri' dayofweek.6 = 'Sat' map = x2c(xmap) abyte0 = x2c(token) nanolo = pos(substr(abyte0, 1, 1), map)-1 nanohi = pos(substr(abyte0, 2, 1), map)-1 secs = pos(substr(abyte0, 3, 1), map)-1 minutes = pos(substr(abyte0, 4, 1), map)-1 hours = pos(substr(abyte0, 5, 1), map)-1 day = pos(substr(abyte0, 6, 1), map)-1 month = pos(substr(abyte0, 7, 1), map) year = pos(substr(abyte0, 8, 1), map) /* this may be a bug in IBM's token generation code. */ /* they use getDay(ofWeek) instead of getDayofMonth. */ if 0<=day & day<7 then day = dayofweek.day else day = '???' msecs = 62 * nanohi + nanolo year = year + 1961 /* adjust after 2024 ;-) */ xhours = right('00'hours,2) xminutes = right('00'minutes,2) xsecs = right('00'secs,2) xms = right('000'msecs,3) xtime = xhours'.'xminutes'.'xsecs'.'xms xdate = right('0000'year,4)'-'right('00'month,2)'-'day /* trace 'off' */ return xdate!!"-"!!xtime /*******************************************/ jd2cal: procedure; arg jd julian_calendar a=trunc((jd/36524.25)-51.12264) b=jd+1+a-a%4+1524 c=trunc((b/365.25)-0.3343) d=trunc(365.25*c) e=(b-d)%30.61 d=b-d-trunc(30.61*e) m=e-1 y=c-4716 if e>13.5 then m=m-12 if m<2.5 then y=y+1 return right("0000"y,4) right("00"m,2) right("00"d,2) /*******************************************/ cal2jd: procedure; arg yyyy mm dd jd=367*yyyy+275*mm%9-((mm+9)%12+yyyy)*7%4+dd+1721029, -((yyyy+(mm-9)%7)%100+1)*3%4 return jd
(Needs amendments for DB2 V10 for z/OS!)
Comments
Comments are closed.