From:	HENRY::IN%"zar%xhmeia.caltech.edu%kl.sri.COM%relay.cs.net@RCA.COM"  1-MAY-1987 22:37
To:	info-vax@KL.SRI.COM
Subj:	NEXTJOB Program Source (Long)

Due to the high number of requests, I'll be posting this. Advance appologies.
c excl. this line & mail headers/trailers, checksum=977714396 (for VMS V4.5+)
        program         nextjob
c
c       Release next /HOLD batch job from current or specified batch
c       queue for current or specified username
c
c       (do not install with privileges)
c
        implicit        integer*4 (a-z)
        include         '($jpidef)/nolist'
        include         '($lnmdef)/nolist'
        include         '($quidef)/nolist'
        include         '($ssdef)/nolist'
        parameter       max_queues     =     32
        parameter       max_users      =    128
        character*80    line
        character*31    my_queue,queuename,queues(max_queues)
        character*31    queue_srch
        character*12    my_username,user
        integer*4       jpilis(10),quilis(10),lnmlis(4)
c
c       Cancel any outstanding queue searches
c
        istat = sys$getquiw(,%val(qui$_cancel_operation),,,,,)
c
c       Get the username and process I.D. for the current process
c
        jpilis(1)  = jpi$_username * 2**16 + 12
        jpilis(2)  = %loc(my_username)
        jpilis(3)  = %loc(my_username_l)
        jpilis(4)  = jpi$_pid * 2**16      +  4
        jpilis(5)  = %loc(my_pid)
        jpilis(6)  = 0
        jpilis(7)  = jpi$_mode * 2**16     +  4
        jpilis(8)  = %loc(mode)
        jpilis(9)  = 0
        jpilis(10) = 0
        istat = sys$getjpiw(,,,jpilis,,,)
        if ((.not.istat).or.(my_username_l.eq.0))
     1  call sys$exit(%val(istat))
        if (mode.eq.jpi$k_batch) then
c
c       We have a batch job -- find out what queue we're in
c
          quilis(1)  = qui$_search_flags * 2**16 +  4
          quilis(2)  = %loc(qui$m_search_this_job)
          quilis(3)  = 0
          quilis(4)  = qui$_queue_name * 2**16   + 31
          quilis(5)  = %loc(my_queue)
          quilis(6)  = %loc(my_queue_l)
          quilis(7)  = qui$_entry_number * 2**16 +  4
          quilis(8)  = %loc(my_enumber)
          quilis(9)  = 0
          quilis(10) = 0
          istat = sys$getquiw(,%val(qui$_display_job),,quilis,,,)
c
c       Error getting queue name. Assume SYS$BATCH and translate
c
          if ((.not.istat).or.(my_queue_l.eq.0)) goto 1
        else
c
c       We don't have a batch job so assume SYS$BATCH and translate
c
1         my_queue = 'SYS$BATCH'
        end if
c
c       Get the command line and see what was asked of us
c
        call lib$get_foreign(line,,)
        if (lench(line).ne.0) then
          call str$upcase(line,line)
c
c       Find out what all of the queue names are
c
          i = 0
          queuename  = '?'
          queue_srch = '*'
          qsrchflags = qui$m_search_batch .or. qui$m_search_symbiont
          quistat    = ss$_normal
          quilis(1)  = qui$_search_flags * 2**16 +  4
          quilis(2)  = %loc(qsrchflags)
          quilis(3)  = 0
          quilis(4)  = qui$_search_name * 2**16  + 31
          quilis(5)  = %loc(queue_srch)
          quilis(6)  = 0
          quilis(7)  = qui$_queue_name * 2**16   + 31
          quilis(8)  = %loc(queuename)
          quilis(9)  = %loc(queuename_l)
          quilis(10) = 0
          do while(quistat)
           quistat = sys$getquiw(,%val(qui$_display_queue),,quilis,,,)
           if (.not.quistat) goto 2
           if (queuename_l.gt.0) then
             if (i.gt.0) then
               if (queues(i).eq.queuename) goto 2
             end if
             i = i + 1
             queues(i) = queuename
           end if
          end do
2         total_queues = i
c
c       Get the requested queue name from the input command line
c
          do while(line(1:1).eq.' ')
           line = line(2:)
          end do
          i = index(line,' ') - 1
          if (i.le.0) i = lench(line)
          my_queue = line(:i)
          line = line(i+2:)
          j = 0
          do i=1,total_queues
           if (my_queue(:len1(my_queue)).eq.queues(i)(:len1(
     1     queues(i)))) goto 3
          end do
          type *,'%NEXTJOB-E-NOSUCHQUE, requested queue name does'//
     1    ' not exist'
          call sys$exit(%val(3))
c
c       Get the requested username from the command line (if any)
c
3         if (lench(line).ne.0) then
            do while(line(1:1).eq.' ')
             line = line(2:)
            end do
            i = index(line,' ') - 1
            if (i.le.0) i = lench(line)
            my_username = line(:i)
          end if
        end if
        if (my_queue(:len1(my_queue)).eq.'SYS$BATCH') then
c
c       Get the real queue name to search for the requested job
c
          lnmlis(1) = lnm$_string * 2**16 + 31
          lnmlis(2) = %loc(queuename)
          lnmlis(3) = %loc(queuename_l)
          lnmlis(4) = 0
          istat = sys$trnlnm(,'LNM$SYSTEM_TABLE','SYS$BATCH',,lnmlis)
          if ((istat).and.(queuename_l.gt.0)) my_queue = queuename
        end if
c
c       Search for the queue requested and leave us in search mode for
c       finding jobs within the queue
c
        queue_srch = my_queue
        qsrchflags = qui$m_search_batch .or. qui$m_search_symbiont .or.
     1  qui$m_search_all_jobs .or. qui$m_search_wildcard
        quilis(1) = qui$_search_flags * 2**16 +  4
        quilis(2) = %loc(qsrchflags)
        quilis(3) = 0
        quilis(4) = qui$_search_name * 2**16  + 31
        quilis(5) = %loc(queue_srch)
        quilis(6) = 0
        quilis(7) = 0
        istat = sys$getquiw(,%val(qui$_display_queue),,quilis,,,)
        if (.not.istat) call sys$exit(%val(istat))
c
c       Set up a search for the next job in the current queue
c
        best_entry = -1
        old_entry  = -1
        quistat    = ss$_normal
        quilis(1)  = qui$_job_status * 2**16   +  4
        quilis(2)  = %loc(job_status)
        quilis(3)  = 0
        quilis(4)  = qui$_entry_number * 2**16 +  4
        quilis(5)  = %loc(entry_num)
        quilis(6)  = 0
        quilis(7)  = qui$_username * 2**16     + 12
        quilis(8)  = %loc(user)
        quilis(9)  = %loc(user_l)
        quilis(10) = 0
        do while(quistat)
         quistat = sys$getquiw(,%val(qui$_display_job),,quilis,,,)
         if ((.not.quistat).or.(old_entry.eq.entry_num)) goto 4
         if (user_l.gt.0.and.lib$extzv(qui$v_job_holding,1,
     1   job_status)) then
           if (user(:len1(user)).eq.my_username(:len1(my_username)))
     1     then
             best_entry = entry_num
             goto 4
           end if
         end if
         old_entry = entry_num
        end do
c
c       Cancel the outstanding queue search
c
4       istat = sys$getquiw(,%val(qui$_cancel_operation),,,,,)
c
c       If we have a entry number to release, do it now
c
        if (best_entry.ne.-1) then
          write(line(1:5),'(i5)') best_entry
          do while(line(1:1).eq.' ')
           line = line(2:5)
          end do
          type *,'%NEXTJOB-I-JOBREL, job #'//line(:len1(line))//
     1    ' released from queue '//my_queue(:len1(my_queue))
          call lib$do_command('SET QUEUE/ENTRY='//line(:len1(line))//
     1    '/RELEASE '//my_queue(:len1(my_queue)))
        else
          type *,'%NEXTJOB-W-NOJOB, no jobs holding in queue '//
     1    my_queue(:len1(my_queue))
          call sys$exit(%val(3))
        end if
        end
c
c=======================================================================
c
c       Function LENCH
c
c This function takes a character string and finds out how long the
c "actual" string is (i.e. not including padded blanks on the right).
c
        integer function lench(string)
        character*(*) string
        character*1 nul
        data nul/0/
        if (string.eq.' '.or.string(1:1).eq.nul) then
          lench=0
          return
        endif
        do 100 lench=len(string),1,-1
         if (string(lench:lench).ne.' '.and.string(lench:lench).ne.nul)
     1   goto 200
100     continue
        lench=0
200     return
        end
c
c=====================================================================
c
        function len1(str)
        character*(*) str
        i=lench(str)
        if (i.eq.0) i=1
        len1=i
        return
        end
