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.