zar@XHMEIA.CALTECH.EDU (Perfect Tommy) (04/29/87)
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