Figure 2: Fixing your clock with COBOL
$CONTROL USLINIT, NOWARN, BOUNDS, POST85
$VERSION "TimeWarp ClockFix Program. Release: 1998/12/10."
IDENTIFICATION DIVISION.
PROGRAM-ID. WARPFIX.
AUTHOR. Shawn M. Gordon.
INSTALLATION. S.M.GORDON & ASSOCIATES.
DATE-WRITTEN. FRI, APR 17, 1998.
*
************************************************************
* This program will check your system to see if you hardware
* and software clocks are out of sync. If they are then
* we prompt for a few pieces of information.
*
* ----------- change history ---------------
*
* 1998/12/10 SMG - Added test for SM or OP cap, and gracefully
* terminate if it's not there.
************************************************************
*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 ERR PIC S9(4) COMP VALUE 0.
01 ERR-LEN PIC S9(4) COMP VALUE 0.
01 ERR-PARM PIC S9(4) COMP VALUE 0.
01 MSG-LEVEL PIC S9(4) COMP VALUE 0.
01 CALC-TZ PIC S9(1) VALUE 0.
01 HOLD-TZ PIC 9 VALUE 0.
01 MY-TZ PIC X(08) VALUE SPACES.
01 MY-INTERVAL PIC X(08) VALUE SPACES.
01 MY-TIME PIC X(06) VALUE SPACES.
01 MY-TIMEZONE.
03 MYT-HEM PIC X VALUE SPACES.
03 MYT-ZONE PIC X(05) VALUE SPACES.
01 MY-BUFF PIC X(80) VALUE SPACES.
01 WS-DST PIC X VALUE SPACES.
01 WS-TZ PIC X VALUE SPACES.
01 WS-GN PIC X VALUE SPACES.
01 VAR-NAME PIC X(40) VALUE "TZ".
01 VAR-STRING PIC X(255) VALUE SPACES.
*
01 VAR-STATUS.
03 VS-1 PIC S9(4) COMP VALUE 0.
03 VS-2 PIC S9(4) COMP VALUE 0.
*
01 COM-IMAGE.
03 COMMAND-IMAGE PIC X(255) VALUE SPACES.
03 PIC X VALUE %15.
01 COMMAND-ERROR PIC S9(4) BINARY VALUE 0.
01 CAPS.
03 CFULL PIC S9(9) COMP VALUE 0.
03 CREDEF REDEFINES CFULL.
05 CWORD1 PIC S9(4) COMP.
05 CWORD2 PIC S9(4) COMP.
01 NUMBYTES PIC S9(4) COMP VALUE 16.
01 BYTEFUNC PIC S9(4) COMP VALUE 1.
01 BYTERR PIC S9(4) COMP VALUE 0.
01 BYTEMAP.
03 PIC X VALUE SPACE.
88 SMCAP VALUE "1".
03 PIC X(04) VALUE SPACES.
03 PIC X VALUE SPACES.
88 OPCAP VALUE "1".
03 PIC X(10) VALUE SPACES.
01 FULL-CURRENT-DATE.
03 F-DATE.
05 F-YEAR PIC 9(4).
05 F-MONTH PIC 99.
05 F-DAY PIC 99.
03 F-TIME.
05 F-HOUR PIC 99.
05 F-MINUTES PIC 99.
05 F-SECONDS PIC 99.
05 F-SEC-HUND PIC 99.
03 C-TIME-DIFF.
05 C-GMT-DIR PIC X.
05 C-HOUR PIC 99.
05 C-MINUTES PIC 99.
01 DATE-BUFF PIC X(27) VALUE SPACES.
01 C-DATE PIC X(08) VALUE SPACES.
01 C-TIME PIC X(08) VALUE SPACES.
01 CURR-DATE PIC X(10) VALUE SPACES.
01 HOLD-DATE PIC X(06) VALUE SPACES.
PROCEDURE DIVISION.
A0000-MACROS.
$DEFINE %COMIMAGE=
DISPLAY !1
INITIALIZE COMMAND-IMAGE
MOVE !1
TO COMMAND-IMAGE
CALL INTRINSIC 'HPCICOMMAND' USING COM-IMAGE,
COMMAND-ERROR,
ERR-PARM,
MSG-LEVEL#
*
A1000-INTRO.
CALL INTRINSIC "WHO" USING \\, CFULL.
CALL "BITMAPCNV" USING CWORD1, @BYTEMAP, NUMBYTES,
BYTEFUNC, BYTERR.
IF BYTERR <> 0
DISPLAY 'Failure in BITMAPCNV ' BYTERR.
IF SMCAP OR OPCAP
GO TO A1000-BEGIN.
DISPLAY 'Must have SM or OP capability.'
STOP RUN.
A1000-BEGIN.
* retrieve all the dates in all the formats.
MOVE FUNCTION CURRENT-DATE TO FULL-CURRENT-DATE.
DISPLAY 'Current offset from GMT: ' C-GMT-DIR C-HOUR ":"
C-MINUTES.
MOVE CURRENT-DATE TO CURR-DATE.
ACCEPT C-DATE FROM DATE.
CALL INTRINSIC 'DATELINE' USING DATE-BUFF.
ACCEPT C-TIME FROM TIME.
* format the century into the applicable dates.
MOVE C-DATE TO HOLD-DATE.
MOVE CURR-DATE(7:2) TO CURR-DATE(9:2).
MOVE DATE-BUFF(14:2) TO C-DATE(1:2)
CURR-DATE(7:2).
MOVE HOLD-DATE TO C-DATE(3:).
* get the TZ variable.
CALL INTRINSIC "HPCIGETVAR" USING VAR-NAME, VAR-STATUS,
2, VAR-STRING,
0.
IF VS-1 = -8106 OR VAR-STRING = SPACES
DISPLAY SPACES
DISPLAY 'No TZ variable is set, I will '
'show you the correct value,'
DISPLAY 'after you answer some questions.'
DISPLAY SPACES
GO TO A1000-TEST
ELSE
DISPLAY 'Current value of TZ var: ' VAR-STRING(1:16).
* if the date and time match then there is nothing to do.
IF (F-TIME(1:4) = C-TIME(1:4)) AND (F-DATE = C-DATE)
DISPLAY 'Your hardware clock is properly set'.
STOP RUN.
A1000-TEST.
IF F-TIME(1:4) <> C-TIME(1:4)
DISPLAY 'WARNING: '
"Hardware clock doesn't match the software clock"
DISPLAY 'Hardware clock = ' F-HOUR ":" F-MINUTES
DISPLAY 'Software clock = ' C-TIME(1:2) ":" C-TIME(3:2)
DISPLAY SPACES.
IF F-DATE <> C-DATE
DISPLAY "WARNING: Hardware date doesn't match the "
'hardware date'
DISPLAY 'Hardware date = ' F-DATE
DISPLAY 'Software date = ' C-DATE
DISPLAY SPACES.
DISPLAY 'Is it currently Daylight Savings Time? '
NO ADVANCING.
ACCEPT WS-DST FREE.
DISPLAY 'Please select one of the following as your '
'TimeZone'.
A1000-TZ.
DISPLAY SPACES.
DISPLAY '1. Eastern European Time (EET-2DST)'.
DISPLAY '2. Middle European Time (MET-1DST)'.
DISPLAY '3. Western European Time (GMT0BST)'.
DISPLAY '4. Atlantic Time (AST4ADT)'.
DISPLAY '5. Eastern Time (EST5EDT)'.
DISPLAY '6. Central Time (CST6CDT)'.
DISPLAY '7. Mountain Time (MST7MDT)'.
DISPLAY '8. Pacific Time (PST8PDT)'.
DISPLAY '9. Yukon Time (YST9YDT)'.
DISPLAY SPACES.
DISPLAY ' Enter Option: ' NO ADVANCING.
ACCEPT WS-TZ FREE.
EVALUATE WS-TZ
WHEN '1' MOVE 'EET-2DST' TO MY-TZ
WHEN '2' MOVE 'MET-1DST' TO MY-TZ
WHEN '3' MOVE 'GMT0BST' TO MY-TZ
WHEN '4' MOVE 'AST4ADT' TO MY-TZ
WHEN '5' MOVE 'EST5EDT' TO MY-TZ
WHEN '6' MOVE 'CST6CDT' TO MY-TZ
WHEN '7' MOVE 'MST7MDT' TO MY-TZ
WHEN '8' MOVE 'PST8PDT' TO MY-TZ
WHEN '9' MOVE 'YST9YDT' TO MY-TZ
WHEN ' ' GO TO C9000-EOJ
WHEN OTHER DISPLAY 'Invalid value' GO TO A1000-TZ
END-EVALUATE.
DISPLAY SPACES.
DISPLAY 'I am now ready to fix your hardware clock.'.
DISPLAY 'Choose one of the following options'.
DISPLAY '1. Gradually change the time over an hour'.
DISPLAY '2. Change the time immediatly'.
DISPLAY SPACES.
DISPLAY ' Enter Option: ' NO ADVANCING.
ACCEPT WS-GN FREE.
IF WS-GN = '2'
MOVE 'NOW' TO MY-INTERVAL
ELSE
MOVE 'GRADUAL' TO MY-INTERVAL.
PERFORM B1000-DO-IT THRU B1000-EXIT.
PERFORM B2000-SHOW-TZ THRU B2000-EXIT.
GO TO C9000-EOJ.
A1000-EXIT. EXIT.
*
B1000-DO-IT.
MOVE CURRENT-DATE TO CURR-DATE.
MOVE CURR-DATE(7:2) TO CURR-DATE(9:2).
CALL INTRINSIC 'DATELINE' USING DATE-BUFF.
MOVE DATE-BUFF(14:2) TO CURR-DATE(7:2).
MOVE TIME-OF-DAY TO C-TIME.
MOVE SPACES TO MY-TIME.
STRING C-TIME(1:2) ":" C-TIME(3:2)
DELIMITED BY SIZE INTO MY-TIME.
* Fix the timezone first - construct the offset by calculating
* the dst value first, and putting the right hemisphere in it
IF MY-TZ(4:1) IS NUMERIC
MOVE MY-TZ(4:1) TO CALC-TZ.
IF MY-TZ(5:1) IS NUMERIC
MOVE MY-TZ(5:1) TO CALC-TZ
MULTIPLY -1 BY CALC-TZ.
MOVE SPACES TO MY-TIMEZONE
IF CALC-TZ < 0
MOVE 'E' TO MYT-HEM
ELSE
MOVE 'W' TO MYT-HEM.
IF WS-DST = 'Y' OR 'y'
SUBTRACT 1 FROM CALC-TZ.
MOVE CALC-TZ TO HOLD-TZ.
IF MYT-HEM = 'E'
STRING "-" HOLD-TZ ":00" DELIMITED BY SIZE
INTO MYT-ZONE.
IF MYT-HEM = 'W'
STRING HOLD-TZ ":00" DELIMITED BY SIZE
INTO MYT-ZONE.
MOVE SPACES TO MY-BUFF.
STRING "SETCLOCK TIMEZONE=" DELIMITED BY SIZE
MY-TIMEZONE DELIMITED BY SPACES
INTO MY-BUFF.
%COMIMAGE(MY-BUFF#).
* Cancel the change to get an immediate timezone impact.
%COMIMAGE("SETCLOCK;CANCEL"#).
* Now set the correct date and time values.
STRING "SETCLOCK DATE="
CURR-DATE
";TIME="
MY-TIME
";"
MY-INTERVAL DELIMITED BY SIZE
INTO MY-BUFF.
%COMIMAGE(MY-BUFF#).
B1000-EXIT. EXIT.
*
B2000-SHOW-TZ.
DISPLAY SPACES.
DISPLAY 'You will want to set up the following command '
'as a system logon UDC;'.
DISPLAY 'SETVAR TZ,"' MY-TZ '"'.
DISPLAY SPACES.
B2000-EXIT. EXIT.
C9000-EOJ.
DISPLAY 'Normal termination at ' TIME-OF-DAY.
STOP RUN.