PROGRAM REMINDERS ** * PROGRAM REMINDERS * * * 12 Jan 1984 Correct second line of LOGIN message when first * appointment > 5 days from now. * * 15 May 1984 Also save time of next-to-last login if login * recording is used. * * 7 Aug 1984 Correct problem of USERX getting USERXX's login * messages (keyed reads in LOGIN were doing partial * key comparison). * * 22 Aug 1984 Use 99999 days in LOGIN_2 to signify infinity, not * 999 days (reminders for n years hence were incor- * rectly processed). * * 23 Aug 1984 Display far-off reminders in months, not days. * * 23 Aug 1984 Support years past 1999. * * 27 Aug 1984 Establish a condition handler to recover from * DEVOFFLINE error by BRDCST when user has his term- * inal set /NOBROADCAST. * * * Alan L. Zirkle Naval Surface Weapons Center * Code K105 * 5 December 1983 Dahlgren, Virginia 22448 * IMPLICIT INTEGER (A-Z) CALL INITIALIZE 10 CALL SYS$SETAST() ! Disable ASTs CALL INTERRUPT CALL SYS$SETAST(%VAL(1)) ! Enable ASTs CALL GO_TO_SLEEP GO TO 10 END SUBROUTINE INITIALIZE IMPLICIT INTEGER (A-Z) CHARACTER*128 FILE INTEGER*4 MB_DATA(4) EXTERNAL LOGIN LOGICAL LOGIN_RECORD COMMON /LOGIN_/ LOGIN_RECORD COMMON /TICKLE/ TICKLE_TIMES,TICKLE_TIME(10) DATA TICKLE_TIMES,TICKLE_TIME / 7 , 0,1,5,10,15,30,60,0,0,0 / DATA LOGIN_RECORD / .FALSE. / ! Keep record of everyone's last login? READ *, TICKLE_TIMES,(TICKLE_TIME(I),I=1,MIN(10,TICKLE_TIMES)) READ 1000,FILE OPEN (1,FILE=FILE,STATUS='OLD',SHARED,ACCESS='KEYED', 1 FORM='FORMATTED') CALL MAILBOX('REMINDERS_',MB_DATA,LOGIN,,PERM) READ (*,1000,END=100) FILE IF (FILE.NE.' ') THEN LOGIN_RECORD = .TRUE. CALL LAST_LOGIN_INITIALIZE(FILE) ENDIF 100 RETURN 1000 FORMAT (A) END SUBROUTINE INTERRUPT IMPLICIT INTEGER (A-Z) CHARACTER*90 EVENT COMMON /EVENT_/ LEV,EVENT INTEGER*4 WAKE_TIME(2) CHARACTER*20 WAKE_TIME_ COMMON /WAKE_UP/ WAKE_TIME,WAKE_TIME_ COMMON /TICKLE/ TICKLE_TIMES,TICKLE_TIME(10) WAKE_TIME_ = ' ' ASSIGN 10 TO LOCK ! Where to return to after record lock error 10 READ (1,1000,KEY=' ',ERR=110,IOSTAT=ERR) LEV,EVENT ! Simulate rewind ASSIGN 20 TO LOCK 20 READ (1,1000,END=100,ERR=110,IOSTAT=ERR) LEV,EVENT IF (EVENT(1:1).EQ.'\') THEN UNLOCK (1) GO TO 100 ENDIF CALL CV_TIME(DAYS,MINUTES,*30) IF (DAYS.LE.0) THEN ! This event is for today DO T=1,TICKLE_TIMES IF (MINUTES.LE.TICKLE_TIME(T)) THEN CALL NOTIFY(T,DAYS,MINUTES) IF (T.NE.1) CALL COMPUTE_WAKE_TIME(TICKLE_TIME(T-1)) GO TO 20 ENDIF ENDDO ENDIF CALL COMPUTE_WAKE_TIME(60) GO TO 20 30 DELETE (1) ! Remove ill-formatted record GO TO 20 100 RETURN 110 IF (ERR.EQ.52) THEN ! Is record locked? CALL GO_WAIT(1) GO TO LOCK,(10,20) ELSE PRINT 1001,ERR CALL EXIT ENDIF 1000 FORMAT (Q,A) 1001 FORMAT ('0Error',I3,' on the Reminder Event File.'/) END SUBROUTINE NOTIFY(T,DAYS,MINUTES) * * Defaults, changable by initialization input data: * * T=1 means event is NOW. * T=2 means event is in one minute. * T=3 means event is in five minutes. * T=4 means event is in ten minutes. * T=5 means event is in fifteen minutes. * T=6 means event is in a half hour. * T=7 means event is in one hour. * * DAYS is number of days until the event (should be 0). * * MINUTES is exact number of minutes until the event. * IMPLICIT INTEGER (A-Z) CHARACTER*90 EVENT COMMON /EVENT_/ LEV,EVENT CHARACTER*80 MSG IF (T.EQ.1.OR.MINUTES.LE.1) THEN ! Event is NOW or is already past IF (DAYS.EQ.0.AND.MINUTES.GE.-30) THEN ! If 30+ min. late, ! forget it NREC = SEND('You have an appointment RIGHT NOW') ENDIF * Remove event from event file if event time reached and user got * the message, or if message is too old. IF (T.EQ.1.AND.(NREC.GT.0.OR.MINUTES.LT.-30)) DELETE (1) ELSE ! Event is soon, send N-minute msg if necessary IF (EVENT(42:42).EQ.CHAR(T+48)) RETURN ! Already sent EVENT(42:42) = CHAR(T+48) ! Set flag that msg was sent LEV = MAX(LEV,42) ! Make sure updated flag is written REWRITE (1,1000) EVENT(1:LEV) ! Update event on event file CALL SYS$FAO('You have an appointment'// 1 ' in !SL minutes, at !AS',LEN,MSG, 2 %VAL(MINUTES),EVENT(37:41)) NREC = SEND(MSG(:LEN)) ENDIF 1000 FORMAT (A) END INTEGER FUNCTION SEND(TEXT) * * The function result is the number of terminals recieving the * message; this may be zero. * IMPLICIT INTEGER (A-Z) CHARACTER*(*) TEXT CHARACTER*80 BLANKS / ' ' / CHARACTER*5 NOW CHARACTER*2 CRLF PARAMETER ( CRLF = CHAR(13) // CHAR(10) ) CHARACTER*90 EVENT COMMON /EVENT_/ LEV,EVENT EXTERNAL CONDITION_HANDLER CALL TIME(NOW) L = 90 - 33 - LEN(TEXT) CALL LIB$ESTABLISH(CONDITION_HANDLER) COL = STR_LEN(EVENT(1:15)) IF (LEV.LE.42) THEN SEND = SEND_MESSAGE(EVENT(1:COL),CRLF//' Reminder -- '// 1 NOW//' -- '//TEXT//BLANKS(:L)//CRLF) ELSE L2 = 90 - 33 - (LEV-42) SEND = SEND_MESSAGE(EVENT(1:COL),CRLF//' Reminder -- '// 1 NOW//' -- '//TEXT//BLANKS(:L)//CRLF 2 //' '// 3 EVENT(43:LEV)//BLANKS(:L2)//CRLF) ENDIF END SUBROUTINE CV_TIME(DAYS,MINUTES,*) * * STRING -- AN ASCII TIME, FORMAT '18-NOV-83 12:00' (note 83, not 1983) * * DAYS -- DIFFERENCE BETWEEN TODAY AND TIME STRING IN EVENT RECORD * * MINUTES -- IF DAYS=0, DIFFERENCE BETWEEN CURRENT TIME AND STRING TIME * IF DAYS>0, MINUTES FROM THAT DAY'S MIDNIGHT AND STRING TIME * IF DAYS<0, MINUTES = -999 * * THE ALTERNATE RETURN IS TAKEN IF THE TIME IS BADLY FORMATTED. * IMPLICIT INTEGER (A-Z) CHARACTER*90 EVENT COMMON /EVENT_/ LEV,EVENT INTEGER*4 WORK(2),EVENT_TIME(2) COMMON /EVENT_DAY_/ EVENT_TIME,EVENT_DAY CALL SYS$GETTIM(WORK) IF (EVENT(34:34).GE.'8') THEN ! 1980's, or 1990's STATUS = SYS$BINTIM(EVENT(27:33)//'19'//EVENT(34:41), 1 EVENT_TIME) ELSE ! 2000 or beyond STATUS = SYS$BINTIM(EVENT(27:33)//'20'//EVENT(34:41), 1 EVENT_TIME) ENDIF IF (.NOT.STATUS) RETURN 1 CALL LIB$DAY(TODAY_DAY,WORK) CALL LIB$DAY(EVENT_DAY,EVENT_TIME,SECS) DAYS = EVENT_DAY - TODAY_DAY IF (DAYS.EQ.0) THEN CALL LIB$SUBX(EVENT_TIME,WORK,WORK) CALL LIB$EDIV(600000000,WORK,MINUTES,REM) ELSE IF (DAYS.GT.0) THEN MINUTES = SECS / (60*100) ELSE MINUTES = -999 ENDIF END SUBROUTINE COMPUTE_WAKE_TIME(BIAS) IMPLICIT INTEGER (A-Z) INTEGER*4 QWORK(4) INTEGER*4 WAKE_TIME(2) CHARACTER*20 WAKE_TIME_ COMMON /WAKE_UP/ WAKE_TIME,WAKE_TIME_ INTEGER*4 EVENT_TIME(2) COMMON /EVENT_DAY_/ EVENT_TIME,EVENT_DAY CALL LIB$EMUL(BIAS*60,10000000,0,QWORK) ! Convert bias to VAX units CALL LIB$SUBX(EVENT_TIME,QWORK,EVENT_TIME) ! Subtract bias from time CALL LIB$DAY(WORK,EVENT_TIME,CENTISEC) ! Round down to even minute CENTISEC = MOD(CENTISEC,100*60) CALL LIB$EMUL(CENTISEC,100000,0,QWORK) CALL LIB$SUBX(EVENT_TIME,QWORK,EVENT_TIME) IF (WAKE_TIME_.NE.' ') THEN CALL LIB$SUBX(WAKE_TIME,EVENT_TIME,QWORK) IF (QWORK(2).LT.0) RETURN ENDIF WAKE_TIME(1) = EVENT_TIME(1) WAKE_TIME(2) = EVENT_TIME(2) CALL SYS$ASCTIM(,WAKE_TIME_,WAKE_TIME,) ! ASCII wake time, for debugs END SUBROUTINE GO_TO_SLEEP IMPLICIT INTEGER (A-Z) INTEGER*4 WAKE_TIME(2) CHARACTER*20 WAKE_TIME_ COMMON /WAKE_UP/ WAKE_TIME,WAKE_TIME_ IF (WAKE_TIME_.NE.' ') THEN STATUS = SYS$SCHDWK(,,WAKE_TIME,) IF (.NOT.STATUS) CALL LIB$STOP(%VAL(STATUS)) ENDIF CALL GO_HIBERNATE END SUBROUTINE LOGIN(MB_DATA) IMPLICIT INTEGER (A-Z) INTEGER*4 MB_DATA(4) CHARACTER*80 BUFFER COMMON /BUF/ BLEN,BUFFER LOGICAL HIBERNATING COMMON /HIBER_/ HIBERNATING LOGICAL LOGIN_RECORD COMMON /LOGIN_/ LOGIN_RECORD CHARACTER*15 USERNAME CALL MAILBOX_READ(MB_DATA,BUFFER,LENGTH) IF (LENGTH.LE.5) RETURN IF (HIBERNATING) THEN CALL SYS$CANWAK(,) CALL GO_WAKE_UP ENDIF IF (BUFFER(1:5).NE.'I am ') RETURN COL = INDEX(BUFFER(1:LENGTH),' on ') IF (COL.EQ.0) RETURN USERNAME = BUFFER(6:COL-1) IF (LOGIN_RECORD) CALL LAST_LOGIN(USERNAME) CALL LOGIN_2(USERNAME,BUFFER(COL+4:LENGTH)) END SUBROUTINE LOGIN_2(USERNAME,TERMINAL) IMPLICIT INTEGER (A-Z) CHARACTER*(*) USERNAME,TERMINAL CHARACTER*15 EARLIEST CHARACTER*90 EVENT COMMON /EVENT_/ LEV,EVENT CHARACTER*80 BUFFER COMMON /BUF/ BLEN,BUFFER APPTS = 0 ASSIGN 10 TO LOCK ! Where to return to after record lock error 10 READ (1,1000,KEY=USERNAME,ERR=110,IOSTAT=ERR) LEV,EVENT UNLOCK (1) ASSIGN 30 TO LOCK NEXT = 99999*10000 20 APPTS = APPTS + 1 CALL CV_TIME(DAYS,MINUTES,*30) THIS = DAYS*10000 + MINUTES IF (THIS.LT.NEXT) THEN NEXT = THIS EARLIEST = EVENT(27:41) ENDIF 30 READ (1,1000,END=100,ERR=110,IOSTAT=ERR) LEV,EVENT UNLOCK (1) IF (EVENT(1:25).EQ.USERNAME) GO TO 20 100 IF (APPTS.EQ.0) RETURN EVENT(1:25) = TERMINAL ! Temporarily put terminal name of ! logging-in user in the username ! area of the event record, so ! if user is logged in elsewhere, ! only this terminal gets the mes- ! sage. Since this is not written ! to the event file, it is temporary. EVENT(27:41) = EARLIEST IF (APPTS.EQ.1) THEN BUFFER = 'You have one appointment,' BLEN = 25 CALL LOGIN_3(' ') ELSE CALL SYS$FAO('You have !SL appointments;', 1 BLEN,BUFFER,%VAL(APPTS)) CALL LOGIN_3(' The next one is ') ENDIF RETURN 110 IF (ERR.EQ.52) THEN ! Is record locked? CALL GO_WAIT(1) GO TO LOCK,(10,20) ELSE IF (ERR.EQ.36) GO TO 100 PRINT 1001,ERR CALL EXIT ENDIF 1000 FORMAT (Q,A) 1001 FORMAT ('0Error',I3,' on the Reminder Event File.'/) END SUBROUTINE LOGIN_3(TEXT) IMPLICIT INTEGER (A-Z) CHARACTER*(*) TEXT CHARACTER*90 EVENT COMMON /EVENT_/ LEV,EVENT CHARACTER*5 TIME EQUIVALENCE (TIME,EVENT(37:41)) CHARACTER*70 BUFFER CHARACTER*10 DAY COMMON /BUF/ BLEN,BUFFER,DAY INTEGER*4 EVENT_TIME(2) COMMON /EVENT_DAY_/ EVENT_TIME,EVENT_DAY CHARACTER*10 WEEK(0:6) DATA WEEK / 'Wednesday','Thursday','Friday','Saturday', 1 'Sunday','Monday','Tuesday' / EVENT(43:) = TEXT LEV = 42 + LEN(TEXT) CALL CV_TIME(DAYS,MINUTES,*10) 10 IF (DAYS.EQ.0) THEN EVENT(LEV+1:) = 'at ' // TIME // ' Today.' LEV = LEV + 3 + 5 + 7 ELSE IF (DAYS.EQ.1) THEN EVENT(LEV+1:) = 'at ' // time // ' Tomorrow.' LEV = LEV + 3 + 5 + 10 ELSE IF (DAYS.LE.5) THEN DAY = WEEK(MOD(EVENT_DAY,7)) D = INDEX(DAY,' ') - 1 EVENT(LEV+1:) = DAY(:D) // ' at ' // TIME LEV = LEV + D + 4 + 5 ELSE IF (DAYS.LE.120) THEN CALL SYS$FAO('in !SL days. ',D,EVENT(LEV+1:),%VAL(DAYS)) LEV = LEV + D ELSE CALL SYS$FAO('in !SL months. ',D,EVENT(LEV+1:), 1 %VAL(DAYS/30)) LEV = LEV + D ENDIF CALL SEND(BUFFER(1:BLEN)) END SUBROUTINE LAST_LOGIN_INITIALIZE(FILE) ** * SUBROUTINE LAST_LOGIN_INITIALIZE ( file ) * * Opens (creates if necessary) the indexed sequential file * which is used to record the date and time of each user's * last login. See routine LAST_LOGIN for more information. * * The character string FILE is the name of the file. * IMPLICIT INTEGER (A-Z) CHARACTER*(*) FILE LOGICAL EXISTS INQUIRE (FILE=FILE,EXIST=EXISTS) IF (EXISTS) THEN OPEN (2,FILE=FILE,STATUS='OLD',ACCESS='KEYED', 1 FORM='FORMATTED',SHARED) ELSE OPEN (2,FILE=FILE,STATUS='NEW',ORGANIZATION='INDEXED', 1 ACCESS='KEYED',RECL=54,RECORDTYPE='VARIABLE', 2 KEY=(1:15:CHARACTER),FORM='FORMATTED', 3 CARRIAGECONTROL='LIST',SHARED) ENDIF END SUBROUTINE LAST_LOGIN(USERNAME) ** * SUBROUTINE LAST_LOGIN( username ) * * Records, if the feature is enabled (see routine INITIALIZE), * the date and time of last login for the user USERNAME. * * This data is recorded on an indexed sequential file, indexed * by username. The format of each 36-character record is: * * Col 1-15 -- Username * * Col 17-33 -- Date/Time 'dd-mmm-yyyy hh:mm' of last login * * Col 38-54 -- Date/Time 'dd-mmm-yyyy hh:mm' of next-to- * last login * IMPLICIT INTEGER (A-Z) CHARACTER*(*) USERNAME CHARACTER*17 TIME CHARACTER*54 RECORD CALL SYS$ASCTIM(,TIME,,) 10 READ (2,1001,KEY=USERNAME,ERR=30,IOSTAT=ERR) RECORD REWRITE (2,1001) USERNAME,TIME,RECORD(17:33) 20 UNLOCK (2) RETURN 30 IF (ERR.EQ.52) THEN CALL GO_WAIT(1) GO TO 10 ELSE IF (ERR.NE.36) THEN GO TO 100 ENDIF WRITE (2,1001) USERNAME,TIME,' 1-JAN-1900 00:00' GO TO 20 100 PRINT 1000,ERR 1000 FORMAT ('0 Error',I3,' on LASTLOGIN.DAT file.'/) 1001 FORMAT (A,T17,A,T38,A) END INTEGER*4 FUNCTION CONDITION_HANDLER(SIGARGS,MECHARGS) IMPLICIT INTEGER*4 (A-Z) INTEGER*4 SIGARGS(*),MECHARGS(*) CHARACTER PROC*16,TERM*8,USER*12 INTEGER*2 PNLEN,TNLEN,UNLEN COMMON /GETJPI_1/ PID,STAT,UIC,PROC,TERM,USER,PNLEN,TNLEN,UNLEN EXTERNAL SS$_RESIGNAL,SS$_DEVOFFLINE,SS$_NOSUCHDEV,SS$_BADPARAM CONDITION_HANDLER = %LOC(SS$_RESIGNAL) N = LIB$MATCH_COND(SIGARGS(2),%LOC(SS$_DEVOFFLINE), 1 %LOC(SS$_NOSUCHDEV), 2 %LOC(SS$_BADPARAM)) IF (N.GT.0) THEN PRINT 1000,SIGARGS(2),USER(1:UNLEN),TERM(1:TNLEN) CALL SYS$UNWIND(MECHARGS(3),) ENDIF 1000 FORMAT (' ERROR ',Z8.8,2X,A,2X,A) END