/* Test local to Zulu (= GMT) date conversion. EXPERIMENTAL */ signal on novalue name TRAP ; signal on halt name TRAP signal on failure name TRAP ; signal on syntax name TRAP if length( arg( 1 )) = 1 | length( arg( 1 )) = 2 then do say '20030301 00:30:24 =>' ZULU( '20030301' '00:30:24' ) say '20030201 00:30:24 =>' ZULU( '20030201' '00:30:24' ) say '20030101 00:30:24 =>' ZULU( '20030101' '00:30:24' ) say '20000301 00:30:24 =>' ZULU( '20000301' '00:30:24' ) say '20040301 00:30:24 =>' ZULU( '20040301' '00:30:24' ) say '19040301 00:30:24 =>' ZULU( '19040301' '00:30:24' ) say '21000301 00:30:24 =>' ZULU( '21000301' '00:30:24' ) say '22000301 00:30:24 =>' ZULU( '22000301' '00:30:24' ) say '23000301 00:30:24 =>' ZULU( '23000301' '00:30:24' ) say '24000301 00:30:24 =>' ZULU( '24000301' '00:30:24' ) say '19000301 00:30:24 =>' ZULU( '19000301' '00:30:24' ) say date( 'S' ) time() '=>' ZULU() ; exit 0 end parse source . ? . if ? <> 'COMMAND' then return ZULU( arg( 1 )) if arg( 1 ) <> '' then ? = arg( 1 ) else ? = date( 'S' ) time() say 'local' ? '=> GMT' ZULU( ? ) ; exit 0 ZULU: procedure /* local time to GMT */ if arg() = 0 then Y = date( 'S' ) time() else Y = arg( 1 ) /* local timestamp */ parse var Y Y 5 M 7 D 9 HH ':' MM ':' SS /* parse timestamp */ /* A given argument (for testing) has to be YYYYMMDD hh:mm:ss, */ /* and the same format is used for the returned GMT timestamp. */ /* Supported TZ formats (environmental variable): */ /* name || offset || dst,3,details => DST from last Sun Mar, */ /* name || offset || dst,03,details => dito, details ignored, */ /* name || offset || dst => dito (default 3,-1,...) */ /* name || offset || dst,10,details => DST from last Sun Oct, */ /* name || offset => no summer time */ /* Timezone and DST name can be any alpha-string, but normally */ /* it should be 3 characters. The offset are hours, normally */ /* -12 .. 12, optionally followed by :30 or :00. Other values */ /* for minutes and exact start / end of DST not yet supported. */ TZ = XENV( 'TZ' ) ; OFS = verify( TZ, '0123456789', 'M' ) select /* get rid of name: */ when OFS <= 3 then exit TRAP( 'missing or unexpected TZ' TZ ) when pos( substr( TZ, OFS - 1, 1 ), '+-' ) = 0 then nop otherwise OFS = OFS - 1 /* use signed offset */ end OFS = substr( TZ, OFS ) ; R = verify( OFS, ':01234567890', , 2 ) if R = 0 then TZ = '' ; else parse var OFS OFS =(R) TZ OFS = translate( OFS, '.', ':' ) /* note x:30 as x.30 */ if TZ <> '' then do /* expect simple DST */ parse var TZ . ',' TZ ',' . /* (for last Sunday) */ select when TZ = '' | TZ = 3 then TZ = 0 /* DST start March */ when TZ = 10 then TZ = 1 /* DST start October */ otherwise exit TRAP( 'unsupported DST start month' TZ ) end L = Y % 100 ; R = Y // 100 /* last Sunday March */ L = ( 33 + R + ( R % 4 ) + ( L % 4 ) - ( L * 2 )) // 7 if L < 0 then L = 24 - L ; else L = 31 - L select /* in: TZ <==> South */ when M > 03 & M < 10 then TZ = 1 - TZ when M < 03 | M > 10 then nop when M = 03 & L <= D then TZ = 1 - TZ when M = 03 & D < L then nop otherwise /* last Sun October: */ if L < 28 then L = L + 3 ; else L = L - 4 if D < L then TZ = 1 - TZ end /* out: TZ <==> DST */ OFS = OFS - TZ end R = trunc( OFS ) ; HH = HH + R /* only for .30 min: */ if R <> OFS then MM = MM + 30 * sign( R ) if MM < 0 then do ; MM = MM + 60 ; HH = HH - 1 ; end if 60 <= MM then do ; MM = MM - 60 ; HH = HH + 1 ; end if HH < 0 then do ; HH = HH + 24 ; D = D - 1 ; end if 24 <= HH then do ; HH = HH - 24 ; D = D + 1 ; end R = right( HH, 2, 0 ) || ':' || right( MM, 2, 0 ) || ':' || SS D = right( D , 2, 0 ) /* L last day of Feb */ L = 29 - ( sign( Y // 4 ) | ( Y // 100 = 0 & sign( Y // 400 ))) select when D < 29 & 0 < D then return Y || M || D R when D = 29 & M <> 02 then return Y || M || D R when D = 29 & L = D then return Y || M || D R when D = 30 & M <> 02 then return Y || M || D R when D = 31 & sign( wordpos( M, 01 03 05 07 08 10 12 )) then return Y || M || D R when D = 32 & M = 12 then return ( Y + 1 ) || '0101' R when D = 0 & M = 01 then return ( Y - 1 ) || '1231' R when D > 29 then return Y || right( M + 1, 2, 0 ) || '01' R when D = 0 & sign( wordpos( M, 02 04 06 09 11 )) then return Y || right( M - 1, 2, 0 ) || '31' R when D = 0 & M <> 03 then return Y || right( M - 1, 2, 0 ) || '30' R when D = 0 then return Y || '02' || L R when D = 29 & M = 02 & L < D then return Y || '0301' R /* otherwise force syntax error 7 'WHEN or OTHERWISE expected' */ end /* see , (c) F. Ellermann */ XENV: procedure /* DOS REXX portable environment */ parse version ENV . . if ENV = 'REXXSAA' then do parse source ENV . . /* OS/2 REXXSAA: os2environment */ if ENV = 'OS/2' then ENV = 'OS2ENVIRONMENT' else ENV = ENV || 'ENVIRONMENT' end /* DOS REXXSAA: DOSENVIRONMENT */ else ENV = 'ENVIRONMENT' /* REXX/Personal: environment */ select when arg() = 1 then return value( arg( 1 ),/* get */, ENV ) when arg() = 2 then return value( arg( 1 ), arg( 2 ), ENV ) otherwise return abs( /* force REXX error 40 */ ) end TRAP: /* select REXX exception handler */ call trace 'O' ; trace N /* don't trace interactive */ parse source TRAP /* source on separate line */ TRAP = x2c( 0D ) || right( '+++', 10 ) TRAP || x2c( 0D0A ) TRAP = TRAP || right( '+++', 10 ) /* = standard trace prefix */ TRAP = TRAP strip( condition( 'c' ) 'trap:' condition( 'd' )) select when wordpos( condition( 'c' ), 'ERROR FAILURE' ) > 0 then do if condition( 'd' ) > '' /* need an additional line */ then TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 ) TRAP = TRAP '(RC' rc || ')' /* any system error codes */ if condition( 'c' ) = 'FAILURE' then rc = -3 end when wordpos( condition( 'c' ), 'HALT SYNTAX' ) > 0 then do if condition( 'c' ) = 'HALT' then rc = 4 if condition( 'd' ) > '' & condition( 'd' ) <> rc then do if condition( 'd' ) <> errortext( rc ) then do TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 ) TRAP = TRAP errortext( rc ) end /* future condition( 'd' ) */ end /* may use errortext( rc ) */ else TRAP = TRAP errortext( rc ) rc = -rc /* rc < 0: REXX error code */ end when condition( 'c' ) = 'NOVALUE' then rc = -2 /* dubious */ when condition( 'c' ) = 'NOTREADY' then rc = -1 /* dubious */ otherwise /* force non-zero whole rc */ if datatype( value( 'RC' ), 'W' ) = 0 then rc = 1 if rc = 0 then rc = 1 if condition() = '' then TRAP = TRAP arg( 1 ) end /* direct: TRAP( message ) */ TRAP = TRAP || x2c( 0D0A ) || format( sigl, 6 ) signal on syntax name TRAP.SIGL /* throw syntax error 3... */ if 0 < sigl & sigl <= sourceline() /* if no handle for source */ then TRAP = TRAP '*-*' strip( sourceline( sigl )) else TRAP = TRAP '+++ (source line unavailable)' TRAP.SIGL: /* ...catch syntax error 3 */ if abbrev( right( TRAP, 2 + 6 ), x2c( 0D0A )) then do TRAP = TRAP '+++ (source line unreadable)' ; rc = -rc end select when 0 then do /* in pipes STDERR: output */ parse version TRAP.REXX /* REXX/Personal: \dev\con */ if abbrev( TRAP.REXX, 'REXXSAA ' ) | /**/ , 6 <= word( TRAP.REXX, 2 ) then TRAP.REXX = 'STDERR' else TRAP.REXX = '\dev\con' signal on syntax name TRAP.FAIL call lineout TRAP.REXX , TRAP /* fails if no more handle */ end when 0 then do /* OS/2 PM or ooREXX on NT */ signal on syntax name TRAP.FAIL call RxMessageBox translate( TRAP, ' ', x2c( 0D )), /**/ , 'Trap' time(),, 'ERROR' end otherwise say TRAP ; trace ?L /* interactive Label trace */ end if condition() = 'SIGNAL' then signal TRAP.EXIT TRAP.CALL: return rc /* continue after CALL ON */ TRAP.FAIL: say TRAP ; rc = 0 - rc /* force TRAP error output */ TRAP.EXIT: exit rc /* exit for any SIGNAL ON */