	PROGRAM SRCHQUE

C     This program searches a specified batch queue for a specified job name.
C     If it finds the job in the specified queue it returns with a status of
C     sucess.  If it does not find the job in the specified queue it returns
C     with a warning status. 
C
C     The program is called using a foreign command as follows:
C     SRCHQUE := ${program_location:SRCHQUE}
C     SRCHQUE {queue} {jobname}
C
C     If the queue name or the jobname contain lowercase letters, then enclose
C     the name in quotes.
C
C     EXAMPLE OF USE WITHIN A COMFILE:
C
C     $ SRCHQUE := $SCN_MANAGER:SRCQUE
C     $ SRCHQUE BATCH1 "VAXACC_timer"
C     $ IF .NOT. $STATUS THEN -
C         SUBMIT SYS$MANAGER:VAXACC.COM/QUEUE=BATCH1/NAME="VAXACC_timer"
C     $
C
C     The queue name may contain wildcards, the jobname may not.
C     If the queue name contains wildcards then all queues matching the
C     specification will be searched until a match is found or there are
C     no more queues to search.
C
C
C  COMPILING THE PROGRAM
C     The program consists of two files:
C	1. SRCHQUE.FOR		(fortran source code)
C	2. SRCHQUEMSG.MSG	(message soruce code)
C
C     $ FORTRAN/EXTEND SRCHQUE
C     $ MESSAGE SRCHQUEMSG
C     $ LINK/NOTRACEBACK SRCHQUE,SRCHQUEMSG
C
C     David Deley   May, 1986
C-----------------------------------------------------------------------

	!Declare external variables
	EXTERNAL CKQ__JOBEXISTS
	EXTERNAL CKQ__NOSUCHJOB
	EXTERNAL CKQ__NOSUCHQUE
	EXTERNAL CKQ__NOMOREQUE
	EXTERNAL CKQ__INVQUENAM

	INCLUDE  '($STSDEF)'
	INCLUDE	 '($QUIDEF)'
	INCLUDE  '($JBCMSGDEF)'


	! Define item list structure
	STRUCTURE	/ITMLST/
	  UNION
	    MAP
	      INTEGER*2 BUFLEN,ITMCOD
	      INTEGER*4 BUFADR, RETADR
	    END MAP
	    MAP
	      INTEGER*4 END_LIST
	    END MAP
	  END UNION
	END STRUCTURE

	! Define I/O status block structure
	STRUCTURE	/IOSBLK/
	  INTEGER*4	STS,ZEROED
	END STRUCTURE

	! Declare $GETQUIW item lists and I/O status block
	RECORD  /ITMLST/  QUEUE_LIST(4)
	RECORD  /ITMLST/  JOB_LIST(6)
	RECORD  /IOSBLK/  IOSB


	! Declare variables
	CHARACTER*12	USERNAME		!Username of job found in queue.  Not currently used.
	CHARACTER*39	JOB_NAME		!Job name found in queue.
	CHARACTER*31	SEARCH_QUEUE		!Queue to search for.  May contain wildcards.
	CHARACTER*31	SEARCH_JOB		!Job to search for.  Must be exact.
	CHARACTER*31	QUEUE_NAME		!Name of queue currently searching.
	CHARACTER*72	P(8)
	CHARACTER*80	LINE
	INTEGER*2	SEARCH_QUEUE_LEN,	!Length of search queue name.	(Queue to search through)
	2		SEARCH_JOB_LEN,		!Length of search job name.	(Job we are searching for)
	2		QUEUE_NAME_LEN,		!Length of queue name.		(Queue currently searching)
	2		JOB_NAME_LEN,		!Length of job name found in queue.
	2		USERNAME_LEN,		!Length of username who owns job found in queue.
	2		P_LEN(8)
	INTEGER*4	SEARCH_FLAGS,
	2		SYS$GETQUIW,		!System service GET QUEUE INFORMATION
	2		LIB$GET_FOREIGN,	!System service GET FOREIGN COMMAND LINE
	2		STATUS,			!Return status from LIB$GET_FOREIGN
	2		STATUS_Q,		!Return status from SYS$GETQUIW
	2		STATUS_J,		!Return status from SYS$GETJPIW
	2		LINE_LEN,
	2		WARNING_MSG
	LOGICAL		WILDCARD_SEARCH		!Have we searched through more than one queue?

C-----------------------------------------------------------------------
C	.ENTRY
	!GET QUEUE NAME AND JOB NAME TO SEARCH FOR

	status = lib$get_foreign (line,, line_len)
	if (.not. status) call sys$exit (%val(status))
	call parse_line( line, line_len, p, p_len)
	search_queue = p(1)
	search_queue_len = p_len(1)
	search_job = p(2)
	search_job_len = p_len(2)

	! Initialize item list for the display queue operation
	QUEUE_LIST(1).BUFLEN =  SEARCH_QUEUE_LEN
	QUEUE_LIST(1).ITMCOD =  QUI$_SEARCH_NAME
	QUEUE_LIST(1).BUFADR =  %LOC(SEARCH_QUEUE)
	QUEUE_LIST(1).RETADR =  0
	QUEUE_LIST(2).BUFLEN =  4
	QUEUE_LIST(2).ITMCOD =  QUI$_SEARCH_FLAGS
	QUEUE_LIST(2).BUFADR =  %LOC(SEARCH_FLAGS)
	QUEUE_LIST(2).RETADR =  0
	QUEUE_LIST(3).BUFLEN =  31
	QUEUE_LIST(3).ITMCOD =  QUI$_QUEUE_NAME
	QUEUE_LIST(3).BUFADR =  %LOC(QUEUE_NAME)
	QUEUE_LIST(3).RETADR =  %LOC(QUEUE_NAME_LEN)
	QUEUE_LIST(4).END_LIST = 0

	! Initialize item list for the display job operation
	JOB_LIST(1).BUFLEN =	4
	JOB_LIST(1).ITMCOD =	QUI$_SEARCH_FLAGS
	JOB_LIST(1).BUFADR =	%LOC(SEARCH_FLAGS)
	JOB_LIST(1).RETADR =	0
	JOB_LIST(2).BUFLEN =	39
	JOB_LIST(2).ITMCOD =	QUI$_JOB_NAME
	JOB_LIST(2).BUFADR =	%LOC(JOB_NAME)
	JOB_LIST(2).RETADR =	%LOC(JOB_NAME_LEN)
	JOB_LIST(3).BUFLEN =	12
	JOB_LIST(3).ITMCOD =	QUI$_USERNAME
	JOB_LIST(3).BUFADR =	%LOC(USERNAME)
	JOB_LIST(3).RETADR =	%LOC(USERNAME_LEN)
	JOB_LIST(4).END_LIST =  0

	! Request search of all jobs present in output queues; also force
	! wildcard mode to maintain the internal search context block after
	! the first call when a non-wild queue name is entered--this preserves
	! queue context for the subsequent display job operation
	SEARCH_FLAGS = (QUI$M_SEARCH_WILDCARD .OR.
	2		QUI$M_SEARCH_BATCH .OR.
	2		QUI$M_SEARCH_ALL_JOBS)

	! Dissolve any internal search context block for the process
	STATUS_Q = SYS$GETQUIW (,%VAL(QUI$_CANCEL_OPERATION),,,,,)
C-----------------------------------------------------------------------
C	.MAIN LOOP.
	QUEUE_NUM = 0
	WILDCARD_SEARCH = .FALSE.

	DO WHILE (STATUS_Q)
	    !Locate next output queue; loop until an error status is returned
	    IF (QUEUE_NUM .GT. 1) WILDCARD_SEARCH = .TRUE.
	    QUEUE_NUM = QUEUE_NUM + 1
	    STATUS_Q = SYS$GETQUIW (, %VAL(QUI$_DISPLAY_QUEUE),, QUEUE_LIST, IOSB,,)
	    IF (.NOT. STATUS_Q) CALL SYS$EXIT (%VAL(STATUS_Q))
	    STATUS_Q = IOSB.STS

	    STATUS_J = 1
	    DO WHILE (STATUS_Q .AND. STATUS_J)
	        !Get information on next job in queue; loop until status = JBC$_NOMOREJOB or an error status is returned
		STATUS_J = SYS$GETQUIW (, %VAL(QUI$_DISPLAY_JOB),, JOB_LIST, IOSB,,)
		IF (STATUS_J) STATUS_J = IOSB.STS
		IF (STATUS_J) THEN
		    !Check to see if it is the job we are looking for
		    IF (JOB_NAME(1:JOB_NAME_LEN) .EQ. SEARCH_JOB(1:SEARCH_JOB_LEN)) THEN
		        CALL LIB$SIGNAL(%VAL(%LOC(CKQ__JOBEXISTS)), %VAL(2), JOB_NAME(1:JOB_NAME_LEN), QUEUE_NAME(1:QUEUE_NAME_LEN))
		        CALL SYS$EXIT(%VAL(STS$K_INFO))		!exit program.  Job was found in queue.
		    ENDIF
		ELSE IF (STATUS_J .NE. JBC$_NOMOREJOB) THEN
		    CALL LIB$SIGNAL(%VAL(STATUS_J))
		ENDIF
	    ENDDO    !Go find next job in queue

	!If we drop out the bottom of the job loop then the specified job was not found in the given queue.
	IF (STATUS_Q) CALL LIB$SIGNAL(%VAL(%LOC(CKQ__NOSUCHJOB)),%VAL(2),SEARCH_JOB(1:SEARCH_JOB_LEN),QUEUE_NAME(1:QUEUE_NAME_LEN))
	ENDDO	!Go find next queue to search

	!If we drop out the bottom of the queue loop then the specified job was not found in any of the queues.
	WARNING_MSG = STS$K_WARNING
	WARNING_MSG = (WARNING_MSG .OR. STS$M_INHIB_MSG)
	IF (STATUS_Q .EQ. JBC$_NOMOREQUE) THEN
	    IF (WILDCARD_SEARCH) CALL SYS$EXIT(%VAL(%LOC(CKQ__NOMOREQUE)))      !exit program.  No more queues to search.
	    CALL SYS$EXIT(%VAL(WARNING_MSG))			!exit program.  Only one queue was searched so don't print message.
	ELSE IF (STATUS_Q .EQ. JBC$_NOSUCHQUE) THEN
	    CALL LIB$SIGNAL(%VAL(%LOC(CKQ__NOSUCHQUE)),%VAL(1),SEARCH_QUEUE)
	    CALL SYS$EXIT(%VAL(WARNING_MSG))			!exit program.
	ELSE IF (STATUS_Q .EQ. JBC$_INVQUENAM) THEN
	    CALL LIB$SIGNAL(%VAL(%LOC(CKQ__INVQUENAM)),%VAL(1),SEARCH_QUEUE)
	    CALL SYS$EXIT(%VAL(WARNING_MSG))			!exit program.
	ELSE
	    CALL SYS$EXIT (%VAL(STATUS_Q))			!exit program
	ENDIF
	END
C	----------------------------------------------------------------

	SUBROUTINE PARSE_LINE( LINE, LINE_LEN, P, P_LEN )
	INTEGER*2	LINE_LEN		! Length of line to parse
	INTEGER*2	P_LEN(8)		! Length of each word in P
	INTEGER*2	I,J,K
	CHARACTER	LINE*(*)		! Line to parse
	CHARACTER*72	P(8)			! One word from LINE in each P(k)

	! Clean out P array.
	DO N = 1,8
	  P(N) = ' '
	ENDDO

	! Initialize loop
	I = 1
	J = 1
	K = 1

1	CONTINUE
	! Parse line for word
	! Search for first non-blank character
	DO WHILE ( LINE(J:J) .EQ. ' ' )
	  J = J + 1
	  IF ( J .GT. LINE_LEN ) RETURN
	ENDDO

	! make P(K)(I:I) = LINE(J:J)
	IF ( LINE(J:J) .EQ. '"' ) THEN
	    J = J + 1
10	    IF ( J .GT. LINE_LEN ) RETURN
	    IF ( LINE(J:J+1) .EQ. '" ' ) GOTO 20
	    P(K)(I:I) = LINE(J:J)
	    P_LEN(K) = I
	    I = I + 1
	    J = J + 1
	    IF ( I .LT. 72 ) GOTO 10
	ELSE
11	    IF ( J .GT. LINE_LEN ) RETURN
	    IF ( LINE(J:J) .EQ. ' ' ) GOTO 20
	    P(K)(I:I) = LINE(J:J)
	    P_LEN(K) = I
	    I = I + 1
	    J = J + 1
	    IF ( I .LT. 72 ) GOTO 11
	ENDIF
20	J = J + 1	! Next character in LINE
	K = K + 1	! Next subscript of P(k)
	I = 1		! First character of P(k)
	IF ( K .GT. 8 ) RETURN
	GOTO 1		! AND GET NEXT WORD INTO P(K+1)

	END
