program WATCH
! -----------------------------------------------------------------
!+
!	Gets information on current jobs
!	and stores it in array CURRENT
!	then compares this to PREVIOUS after designated wait.
!	All those processes with identical values are flagged
!	for possible deletion.
!
!
!	D.H.Anderson	16-Jan-1986!
!-
! -----------------------------------------------------------------
	IMPLICIT INTEGER*4 (A-Z)
!
	STRUCTURE /ITMLST/
	  UNION
	    MAP
	      INTEGER*2	BUFLEN
	      INTEGER*2	CODE
	      INTEGER*4	BUFADR
	      INTEGER*4	RETLENADR
	    END MAP
	    MAP
	      INTEGER*4	END_LIST
	    END MAP
	  END UNION
	END STRUCTURE
	RECORD /ITMLST/ JPI_LIST(15)
C
C		Status block
C
	STRUCTURE /IOSB/
	  INTEGER*2	STATUS
	  INTEGER*2	COUNT
	INTEGER*4	%FILL
	END STRUCTURE
	RECORD /IOSB/	JPISTAT
C
	STRUCTURE /JPI_PICTURE/
	  CHARACTER*12	USR
	  CHARACTER*15	PCN
	  INTEGER*4	JID
	  CHARACTER*8	TRM
	  CHARACTER*80	IMA
	  INTEGER*4	PRI
	  INTEGER*4	CPU
	  INTEGER*4	BIO
	  INTEGER*4	DIO
	  INTEGER*4	MDD
	  INTEGER*4	PFL
	  INTEGER*4	STA
	  INTEGER*4	UIC
	  INTEGER*4	OWN
	  INTEGER*4	WRN
	END STRUCTURE
	RECORD /JPI_PICTURE/ CURRENT(80), PREVIOUS(80)
	INTEGER*2	CURRENT_NUMBER	/0/
	INTEGER*2	 PREVIOUS_NUMBER /0/
!
	CHARACTER*12	USERNAME	! field 1
	CHARACTER*15	PRCNAM		! field 2
	INTEGER*4	PID		! field 3
	CHARACTER*8	TERMINAL	! field 4
	CHARACTER*80	IMAGNAME	! field 5
!
	INTEGER*4	STATUS,
	2		STATUS_OK,
	2		SYS$GETJPIW,
	2		CLI$PRESENT,
	2		CLI$GET_VALUE
	PARAMETER	(STATUS_OK = 1)

	INCLUDE '($JPIDEF)'
	INCLUDE '($BRKDEF)'

	PARAMETER SS$_NOPRIV = '00000024'X
	PARAMETER SS$_SUSPENDED = '000003A4'X

	PARAMETER SCH$C_COLPG	= 1
	PARAMETER SCH$C_MWAIT	= 2
	PARAMETER SCH$C_CEF	= 3
	PARAMETER SCH$C_PFW	= 4
	PARAMETER SCH$C_LEF	= 5
	PARAMETER SCH$C_LEFO	= 6
	PARAMETER SCH$C_HIB	= 7
	PARAMETER SCH$C_HIBO	= 8
	PARAMETER SCH$C_SUSP	= 9
	PARAMETER SCH$C_SUSPO	= 10
	PARAMETER SCH$C_FPG	= 11
	PARAMETER SCH$C_COM	= 12
	PARAMETER SCH$C_COMO	= 13
	PARAMETER SCH$C_CUR	= 14
!+
!		Arrays for Display
!-
	INTEGER*4	DISP_COD(14)	! Code for this field
	INTEGER*2	DISP_BFL(14)	! Buffer length for $GETJPI
	CHARACTER*24	DISP_NAM(14)	! CLD Keyword for $GETJPI
	INTEGER*4	DISP_CLE(14)	! Length of returned string
	INTEGER*4	DISP_VAL(14)	! for values output by $GETJPI
!+
!		Load up the system codes for $GETJPI system service.
!		These are defined in the module JPIDEF.
!-
	DATA	DISP_COD /JPI$_USERNAME, JPI$_PRCNAM,   JPI$_PID,
	2		  JPI$_TERMINAL, JPI$_IMAGNAME, JPI$_PRIB,
	2		  JPI$_CPUTIM,   JPI$_BUFIO,	JPI$_DIRIO,
	2		  JPI$_MODE,     JPI$_PAGEFLTS,	JPI$_STATE,
	2		  JPI$_UIC, 	 JPI$_OWNER/
!
!		These are the buffer sizes to give $GETJPI
	DATA	DISP_BFL /12,            15,            4,
	2		  8,             80,            4,
	2		  4,             4,             4,
	2		  4,             4,             4,
	2		  4,		 4/
!

	INTEGER*4	PROCESS_ID	!  translation of PID
	INTEGER*4	OWNER_ID	!  translation of PID
	INTEGER*2	UNUM
	CHARACTER*9	WAIT
	CHARACTER*23	CUR_TIME
	INTEGER*4	DELTIME(2)
	CHARACTER*15	DELAY_TIME
	CHARACTER*80	BRKMESSAGE, BRKFINAL
	CHARACTER*(*)	BRKMES, BRKFIN
	PARAMETER	(BRKMES = 'Process Inactive 20 minutes -- Please consider logging off.  ')
	PARAMETER	(BRKFIN = 'Process Inactive 40 minutes -- You HAVE BEEN logged off.     ')
	CHARACTER*80	BLANK /' '/
C
! -----------------------------------------------------------------
C
C		The user may define a delay time as a foreign command
C
	STATUS = LIB$GET_FOREIGN (DELAY_TIME, 'Interval (min.): ',
	2		DELAY_TIME_LEN)
	IF (.NOT. STATUS .OR. DELAY_TIME_LEN .EQ. 0) THEN
	  WAIT = '0 :05:0.0'	! 5-min default
	ELSE
	  WAIT = '0 :'//DELAY_TIME(1:DELAY_TIME_LEN)
	ENDIF
!
C	Translate ascii time to binary
	STATUS= SYS$BINTIM( WAIT, DELTIME)
	   IF (.NOT. STATUS) CALL LIB$STOP( %VAL( STATUS))
C
!+
!		Load up the JPI_LIST record with the codes and
!		locations necessary to make $GETJPI fetch out
!		what we will need
!-
	DO I = 1, 14
	  JPI_LIST(I).BUFLEN    = DISP_BFL(I)
	  JPI_LIST(I).CODE      = DISP_COD(I)
	  JPI_LIST(I).RETLENADR = %LOC(DISP_CLE(I))
	  IF (I .EQ. 1) JPI_LIST(I).BUFADR = %LOC(USERNAME)
	  IF (I .EQ. 2) JPI_LIST(I).BUFADR = %LOC(PRCNAM)
	  IF (I .EQ. 3) JPI_LIST(I).BUFADR = %LOC(PID)
	  IF (I .EQ. 4) JPI_LIST(I).BUFADR = %LOC(TERMINAL)
	  IF (I .EQ. 5) JPI_LIST(I).BUFADR = %LOC(IMAGNAME)
	  IF (I .GT. 5)	JPI_LIST(I).BUFADR = %LOC(DISP_VAL(I))
	ENDDO

	JPI_LIST(14+1).END_LIST	= 0
!
	NUMLOOP = 0
!
!		Main search loop
!
100	CONTINUE
C
!	Set a wakeup schedule for hibernate
	STATUS = SYS$SCHDWK(,,DELTIME,)
	   IF (.NOT. STATUS) CALL LIB$STOP( %VAL( STATUS))

C	Inform the invoker of this program what current time is.
	STATUS= LIB$DATE_TIME( CUR_TIME )
	   IF (.NOT. STATUS) CALL LIB$STOP( %VAL( STATUS))
C
C		The next line may be eliminated if you wish.
	TYPE *, 'The time is now:', CUR_TIME
C	
	BRKMESSAGE = BRKMES//CUR_TIME
	BRKFINAL   = BRKFIN//CUR_TIME
C
	UNUM		= 0	!index for CURRENT
	PROCESS_ID	= -1	! to start continuous search
	STATUS = STATUS_OK

	DO WHILE (STATUS)
	STATUS = SYS$GETJPIW (,PROCESS_ID,,JPI_LIST,JPISTAT,,)
!
	  IF (STATUS) THEN
	    UNUM = UNUM + 1
!
	    CURRENT(UNUM).USR = USERNAME
	    CURRENT(UNUM).PCN = PRCNAM
	    CURRENT(UNUM).JID = PID
	    CURRENT(UNUM).TRM = TERMINAL
	    CURRENT(UNUM).IMA = IMAGNAME
	    CURRENT(UNUM).PRI = DISP_VAL(6)	! PRIORITY
	    CURRENT(UNUM).CPU = DISP_VAL(7)	! CPU SEC * 100
	    CURRENT(UNUM).BIO = DISP_VAL(8)	! BUFIO
	    CURRENT(UNUM).DIO = DISP_VAL(9)	! DIRIO
	    CURRENT(UNUM).MDD = DISP_VAL(10)	! MODE
	    CURRENT(UNUM).PFL = DISP_VAL(11)	! PAGE FAULTS
	    CURRENT(UNUM).STA = DISP_VAL(12)	! STATUS
	    CURRENT(UNUM).UIC = DISP_VAL(13)	! UIC
	    CURRENT(UNUM).OWN = DISP_VAL(14)	! OWNER
	    CURRENT(UNUM).WRN = 0		! WARNINGS

	    STATUS = STATUS_OK

	  ELSE IF (STATUS .EQ. SS$_NOPRIV) THEN
	    STATUS = STATUS_OK
	  ELSE IF (STATUS .EQ. SS$_SUSPENDED) THEN
	    STATUS = STATUS_OK
	  ENDIF
	END DO
	CURRENT_NUMBER = UNUM		! remember how many entries
!
!
C		The next statement may be eliminated if you wish.
	WRITE (*, '('' CURR.NUM, PREV.NUM='',2I)')
	2		CURRENT_NUMBER,PREVIOUS_NUMBER
C
	NUMLOOP = NUMLOOP + 1
C
	IF (NUMLOOP .EQ. 1) GOTO 1240
C
	DO N1 = 1, CURRENT_NUMBER
C
C	  WRITE(6,9000) CURRENT(N1).JID, CURRENT(N1).OWN,
C     *		CURRENT(N1).USR, CURRENT(N1).PCN, CURRENT(N1).IMA
C
!	  IF (ICHAR(CURRENT(N1).IMA) .NE. 0) GOTO 1230	!Skip if curr image
C
	  ISKIP = 1
C
	  IF (CURRENT(N1).PRI .GT. 4) GOTO 1230		!Skip if hi priority
	  IF (CURRENT(N1).MDD .EQ. 0) GOTO 1230	! Skip Detached proc's
	  IF (INDEX(CURRENT(N1).USR,'SYSTEM') .EQ. 1) GOTO 1230
	  IF (INDEX(CURRENT(N1).USR,'DECNET') .EQ. 1) GOTO 1230
	  IF (INDEX(CURRENT(N1).PCN,'NULL'  ) .EQ. 1) GOTO 1230
	  IF (INDEX(CURRENT(N1).PCN,'SWAPPER') .NE. 0) GOTO 1230
C	  IF (INDEX(CURRENT(N1).IMA,'BACKEND' ) .NE. 0) GOTO 1230
C	  IF (INDEX(CURRENT(N1).IMA,'QBF' ) .NE. 0) GOTO 1230
	  IF (CURRENT(N1).OWN .NE. 0) GOTO 1230
C
C
	  DO N2 = 1, CURRENT_NUMBER
	    IF (CURRENT(N1).JID .EQ. CURRENT(N2).OWN) GOTO 1230
	  ENDDO
C
C
C	CHECK TIME OF DAY, AFTER 8:00PM WE GET RID OF EVERYBODY WE CAN.
C

	  IF (CUR_TIME(13:14) .EQ. '20') GOTO 1550
C
C	  IF (INDEX(CURRENT(N1).USR,'SYSMAN') .EQ. 1) GOTO 1230
C	  IF (INDEX(CURRENT(N1).IMA,'EDT' ) .NE. 0) GOTO 1230
C	  IF (INDEX(CURRENT(N1).IMA,'EEV34' ) .NE. 0) GOTO 1230
C
C	  IF (INDEX(CURRENT(N1).USR,'POOL') .EQ. 1) GOTO 1230
C	  IF (INDEX(CURRENT(N1).USR,'HOMICK') .EQ. 1) GOTO 1230
C	  IF (INDEX(CURRENT(N1).USR,'JOHNSON') .EQ. 1) GOTO 1230
C	  IF (INDEX(CURRENT(N1).USR,'NACHTWEY') .EQ. 1) GOTO 1230
C	  IF (INDEX(CURRENT(N1).USR,'LOGAN') .EQ. 1) GOTO 1230
C	  IF (INDEX(CURRENT(N1).USR,'FERGUSON') .EQ. 1) GOTO 1230
C	  IF (INDEX(CURRENT(N1).USR,'CINTRON') .EQ. 1) GOTO 1230
C	  IF (INDEX(CURRENT(N1).USR,'PIERSON') .EQ. 1) GOTO 1230
C	  IF (INDEX(CURRENT(N1).USR,'KERWIN') .EQ. 1) GOTO 1230
C	  IF (INDEX(CURRENT(N1).USR,'BUNGO') .EQ. 1) GOTO 1230
C	  IF (INDEX(CURRENT(N1).USR,'WALIGORA') .EQ. 1) GOTO 1230
C
1550	  DO N2 = 1, PREVIOUS_NUMBER
C
	    ISKIP = 0
	    IF (CURRENT(N1).JID .EQ. PREVIOUS(N2).JID .AND.
	2	CURRENT(N1).BIO .EQ. PREVIOUS(N2).BIO .AND.
	2	CURRENT(N1).DIO .EQ. PREVIOUS(N2).DIO .AND.
	2	CURRENT(N1).CPU .EQ. PREVIOUS(N2).CPU) THEN
	      !  Leave a note
		IF (PREVIOUS(N2).WRN .EQ. 0) THEN
		    STATUS = SYS$BRKTHRU(,BRKMESSAGE, CURRENT(N1).TRM,
	2		%VAL(BRK$C_DEVICE),,,,,%VAL(5),,)	!5 SEC TIMEOUT
		    WRITE(6,9025) CURRENT(N1).JID, CURRENT(N1).OWN,
     *				  CURRENT(N1).USR, CURRENT(N1).PCN, CURRENT(N1).IMA
		    CURRENT(N1).WRN = PREVIOUS(N2).WRN + 1
		    goto 1230
		ELSE
		    STATUS = SYS$BRKTHRU(,BRKFINAL, CURRENT(N1).TRM,
	2		%VAL(BRK$C_DEVICE),,,,,%VAL(5),,)	!5 SEC TIMEOUT
		    WRITE(6,9050) CURRENT(N1).JID, CURRENT(N1).OWN,
     *				  CURRENT(N1).USR, CURRENT(N1).PCN, CURRENT(N1).IMA
		    CURRENT(N1).WRN = PREVIOUS(N2).WRN + 1
	            IF (.NOT. STATUS) CALL LIB$STOP( %VAL( STATUS))
C	      !  *** Delete the sluggard ***
		    STATUS = SYS$DELPRC (CURRENT(N1).JID,)
	      !AND EXIT THE LOOP, BECAUSE THERE CAN BE BUT ONE
	            goto 1230
              ENDIF
	    ENDIF
	  ENDDO
1230	CONTINUE
	IF (ISKIP .EQ. 1) WRITE(6,9075) CURRENT(N1).JID, CURRENT(N1).OWN,
     *			  CURRENT(N1).USR, CURRENT(N1).PCN, CURRENT(N1).IMA
	ENDDO
1240	CONTINUE
!+
!		If this is the 2nd time thru, the value
!		of PREVIOUS_NUMBER will no longer be zero
!		and we can quit this buisiness.
!-
	IF (CUR_TIME(13:14) .EQ. '21') CALL EXIT
!+
!		copy the values of CURRENT to PREVIOUS
!		and hang up for awhile before we do this again
!-
	DO N1 = 1, CURRENT_NUMBER
	  PREVIOUS(N1) = CURRENT(N1)
	ENDDO
	PREVIOUS_NUMBER = CURRENT_NUMBER
!
!			Hang up awhile before recycling

	STATUS = SYS$HIBER()

	GOTO 100

9000	FORMAT(2X,'NEXT USER',3X,I8,5X,I8,5X,A14/ 14X,A14,5X,A50)
9025	FORMAT(2X,'WILL WARN',3X,I8,5X,I8,5X,A14/ 14X,A14,5X,A50)
9050	FORMAT(2X,'WILL STOP',3X,I8,5X,I8,5X,A14/ 14X,A14,5X,A50)
9075	FORMAT(2X,'WILL SKIP',3X,I8,5X,I8,5X,A14/ 14X,A14,5X,A50)
	END