From:	CSBVAX::MRGATE!@KL.SRI.Com,@wiscvm.wisc.edu:SLOANE@UKANVAX.BITNET@SMTP 10-SEP-1987 14:41
To:	EVERHART
Subj:	RE: First unrelated question

Received: from wiscvm.wisc.edu by KL.SRI.COM with TCP; Thu 10 Sep 87 08:17:07-PDT
Received: from UKANVAX.BITNET by wiscvm.wisc.edu ; Thu, 10 Sep 87 10:16:43 CDT
Date:     Thu, 10-Sep-1987 10:06:50.28 CST
From:     <sloane%UKANVAX.BITNET@wiscvm.wisc.edu> (Bob Sloane)
Subject:  RE: First unrelated question
To:       <info-vax@kl.sri.com>

Tom Williams asks about controlling users who submit multiple jobs to a
batch queue. We had the same problem here, so I wrote a short program that
wakes up every 30 seconds and checks the batch queues for multiple jobs
submitted by the same user.  If more than one job is found for a user,
second and subsequent jobs' priorities are reduced so that other users'
jobs will execute first.  I realize that this scheme could be defeated
by the user changing the priority of the job back after I have changed
it, but is seems to work alright for what we do here.  It would be fairly
easy to modify the program to simply delete multiple jobs, if that is
desired.  We thought that was a little harsh. I am posting this to the
net in case others might find it useful.

                      Bob Sloane
                      University of Kansas
                      Computer Center
                      (913) 864-0444
                      SLOANE@UKANVAX on BITNET

....................... Cut between dotted lines and save ......................
$!..............................................................................
$! VAX/VMS archive file created by VMS_SHAR V-4.03 05-Aug-1987
$! which was written by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au)
$! To unpack, simply save and execute (@) this file.
$!
$! This archive was created by SLOANE
$!      on Thursday 10-SEP-1987 09:47:54.87
$!
$! It contains the following 1 file:
$! QUEMON.FOR
$!=============================================================================
$ Set Symbol/Scope=(NoLocal,NoGlobal)
$ Version=F$GetSYI("VERSION") ! See what VMS version we have here:
$ If Version.ges."V4.4" then goto Version_OK
$ Write SYS$Output "Sorry, you are running VMS ",Version, -
                ", but this procedure requires V4.4 or higher."
$ Exit 44
$Version_OK: CR[0,8]=13
$ Pass_or_Failed="failed!,passed."
$ Goto Start
$Convert_File:
$ Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd
$No_Error1: Define/User_Mode SYS$Output NL:
$ Edit/TPU/NoSection/NoDisplay/Command=SYS$Input/Output='File_is' -
        VMS_SHAR_DUMMY.DUMMY
f:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f);
o:=Get_Info(Command_Line,"Output_File");Set (Output_File,b,o);
Position (Beginning_of(b));Loop x:=Erase_Character(1); Loop ExitIf x<>"V";
Move_Vertical(1);x:=Erase_Character(1);Append_Line;Move_Horizontal
(-Current_Offset);EndLoop;Move_Vertical(1);ExitIf Mark(None)=End_of(b)
EndLoop;Exit;
$ Delete VMS_SHAR_DUMMY.DUMMY;*
$ Checksum 'File_is
$ Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR
$ Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd
$No_Error2: Return
$Start:
$ File_is="QUEMON.FOR"
$ Check_Sum_is=505964394
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
Xc
Xc       QUEMON - a program to regulate batch queue usage.
Xc
Xc       QUEMON searches through all batch queues (except those explicitly
Xc              excluded) for multiple jobs submitted by the same username.
Xc              If more than one job is found, the second and subsequent
Xc              jobs' priority in the queue is reduced to 50 from 100.
Xc              When the priority of the first job in the queue for a
Xc              user is set to 100.
Xc
X        IMPLICIT NONE                   ! define all vars explicitly
X        INTEGER*4 I                     ! misc counter
X        INTEGER*4 QSTATUS               ! status from queue query
X        INTEGER*4 JSTATUS               ! status from job query
X        INTEGER*4 STATUS                ! status from other operations
X        INTEGER*4 SYS$SNDJBCW           ! send to job controller and wait
X        INTEGER*4 SYS$GETQUIW           ! get queue info and wait
X        INTEGER*4 IOSB(2)               ! iosb for getquiw
X        INTEGER*4 QITEMS(10)            ! items list to query queue
X        INTEGER*4 JITEMS(13)            ! item list to query job
X        INTEGER*4 CITEMS(10)            ! item list to send to job controller
X        CHARACTER QN /'*'/              ! wildcard que name
X        CHARACTER*31 QNAME              ! name of queue found
X        INTEGER*2 QNAME_L               ! length of queue name
X        INTEGER*4 QFLAGS                ! flags for queue search
X        INTEGER*4 JFLAGS                ! flags for job search
X        INTEGER*4 JENTRY                ! entry number found for job
X        CHARACTER*12 JUSER              ! user name for job
X        INTEGER*2 JUSER_L               ! length of user name
X        INTEGER*4 JPRIO                 ! current job priority
X        INTEGER*4 CPRIO                 ! priority to send to job controller
X        CHARACTER*12 USER(1000)         ! list of all jobs in a queue
X        INTEGER*4 ENTRY(1000)           ! entry numbers for jobs in a queue
X        INTEGER*4 PRIO(1000)            ! priority of jobs in a queue
X        INTEGER*4 NJOBS                 ! number of jobs in a queue
X        LOGICAL FOUND                   ! flag that we found a job
X        INCLUDE '($QUIDEF)'
X        INCLUDE '($SJCDEF)'
Xc
Xc       set up item list for queue search
Xc
X        QITEMS(1) = ISHFT(QUI$_SEARCH_NAME,16) .OR. 1   ! name of que to find
X        QITEMS(2) = %LOC(QN)
X        QITEMS(3) = 0
X        QITEMS(4) = ISHFT(QUI$_SEARCH_FLAGS,16) .OR. 4  ! flags for search
X        QITEMS(5) = %LOC(QFLAGS)
X        QITEMS(6) = 0
X        QITEMS(7) = ISHFT(QUI$_QUEUE_NAME,16) .OR. 31   ! return name here
X        QITEMS(8) = %LOC(QNAME)
X        QITEMS(9) = %LOC(QNAME_L)
X        QITEMS(10)= 0
Xc
Xc       set up item list for job search
Xc
X        JITEMS(1) = ISHFT(QUI$_SEARCH_FLAGS,16) .OR. 4  ! job search flags
X        JITEMS(2) = %LOC(JFLAGS)
X        JITEMS(3) = 0
X        JITEMS(4) = ISHFT(QUI$_ENTRY_NUMBER,16) .OR. 4  ! entry number of job
X        JITEMS(5) = %LOC(JENTRY)
X        JITEMS(6) = 0
X        JITEMS(7) = ISHFT(QUI$_USERNAME,16) .OR. 12     ! username for job
X        JITEMS(8) = %LOC(JUSER)
X        JITEMS(9) = %LOC(JUSER_L)
X        JITEMS(10)= ISHFT(QUI$_PRIORITY,16) .OR. 4      ! priority for job
X        JITEMS(11)= %LOC(JPRIO)
X        JITEMS(12)= 0
X        JITEMS(13)= 0
Xc
Xc       set up the sndjbc item list
Xc
X        CITEMS(1) = ISHFT(SJC$_QUEUE,16) .OR. QNAME_L   ! give the queue name
X        CITEMS(2) = %LOC(QNAME)
X        CITEMS(3) = 0
X        CITEMS(4) = ISHFT(SJC$_ENTRY_NUMBER,16) .OR. 4  ! and the entry numb
X        CITEMS(5) = %LOC(JENTRY)
X        CITEMS(6) = 0
X        CITEMS(7) = ISHFT(SJC$_PRIORITY,16) .OR. 4      ! set the priority
X        CITEMS(8) = %LOC(CPRIO)
X        CITEMS(9) = 0
X        CITEMS(10)= 0
Xc
Xc       set up flag lwords for searchs
Xc
X        QFLAGS = QUI$M_SEARCH_BATCH .OR. QUI$M_SEARCH_WILDCARD
X        JFLAGS = QUI$M_SEARCH_ALL_JOBS
Xc
Xc       start of main loop to check the queues
Xc
X1       continue
Xc
Xc       clear any previous wildcard operations
Xc
X        QSTATUS = SYS$GETQUIW(,%VAL(QUI$_CANCEL_OPERATION),,,,,)
Xc
Xc       loop through all the queues we can find
Xc
X        DO WHILE (QSTATUS)
Xc
Xc       get the name of this queue
Xc
X          QSTATUS=SYS$GETQUIW(,%VAL(QUI$_DISPLAY_QUEUE),,QITEMS,IOSB,,)
Xc
Xc       test the status
Xc
X          IF ( QSTATUS ) QSTATUS = IOSB(1)
Xc
Xc       check for excluded queues
Xc
X          IF ( QNAME(1:QNAME_L) .EQ. 'CSNET$BATCH' ) GOTO 10
X          IF ( QNAME(1:QNAME_L) .EQ. 'BACKUP$BATCH' ) GOTO 10
Xc
Xc       loop to check the individual jobs in each queue
Xc
X          NJOBS = 0                             ! no jobs in this queue yet
X          JSTATUS = 1                           ! start out with good status
X          DO WHILE ( QSTATUS .AND. JSTATUS )    ! for all jobs in the queue
Xc
Xc       get the status of the next job in this queue
Xc
X            JSTATUS=SYS$GETQUIW(,%VAL(QUI$_DISPLAY_JOB),,JITEMS,IOSB,,)
X            IF ( JSTATUS ) JSTATUS = IOSB(1)    ! get the actual status
X            IF ( JSTATUS ) THEN                 ! if we have a valid entry
X              FOUND = .FALSE.
X              CITEMS(1) = ISHFT(SJC$_QUEUE,16) .OR. QNAME_L
Xc
Xc       see if this use has a previous job in this queue
Xc
X              IF ( NJOBS .GT. 0 ) THEN
X                DO I=1,NJOBS
Xc
Xc       if a users has more than one job in the queue, then set the
Xc       priority of the subsequent jobs down to 50
Xc
X                  IF (USER(I).EQ.JUSER .AND. ENTRY(I).NE.JENTRY) THEN
X                    CPRIO = 50
X                    IF ( JPRIO .GT. 50 ) THEN
X                      STATUS = SYS$SNDJBCW(,%VAL(SJC$_ALTER_JOB)
X     1                                              ,,CITEMS,IOSB,,)
X                      IF ( STATUS ) STATUS = IOSB(1)
X                    ENDIF
X                    FOUND = .TRUE.
X                  ENDIF
X                ENDDO
X              ENDIF
Xc
Xc       if we didn't find more than one job in the queue, add this
Xc       job to the list of jobs in the queue
Xc
X              IF ( .NOT. FOUND ) THEN
X                NJOBS = NJOBS + 1               ! count the job
X                USER(NJOBS)  = JUSER            ! save the username
X                ENTRY(NJOBS) = JENTRY           ! and the entry number
X                PRIO(NJOBS)  = JPRIO            ! and the priority
X              ENDIF
X            ENDIF
X          ENDDO
Xc
Xc       go through the list of first jobs, and raise their priority
Xc       as needed
Xc
X          DO I=1,NJOBS
X            CPRIO = 100                         ! new priority is 100
X            JENTRY= ENTRY(I)                    ! get the entry number
X            IF ( PRIO(I) .EQ. 50 ) THEN         ! if we lowered it before
X              STATUS = SYS$SNDJBCW(,%VAL(SJC$_ALTER_JOB) ! set back to 100
X     1                           ,,CITEMS,IOSB,,)
X              IF ( STATUS ) STATUS = IOSB(1)
X            ENDIF
X          ENDDO
X10        CONTINUE
X        ENDDO
Xc
Xc       now wait for a while for things to change
Xc
X        CALL SECWAIT(30.0)
X        GOTO 1
X        END
XC*---------------------------------------------------------------------*
XC|       S E C W A I T :  WAIT FOR SPECIFIED NUMBER OF SECONDS         |
XC*---------------------------------------------------------------------*
X      SUBROUTINE SECWAIT(NUMSEC)
XC
XC  PURPOSE:  TO CAUSE A PROGRAM TO WAIT A SPECIFIED NUMBER OF SECONDS.
XC
XC  DESIGN:  S.SIBLEY/J.BEM   CODE:  S.SIBLEY/J.BEM    DATE:  28 SEP 82
XC  INPUT:
XC     NUMSEC - NUMBER OF SECONDS TO WAIT (FLOATING POINT - REAL*4)
XC  OUTPUT:
XC     (NONE)
XC  ERROR CHECKING:
XC     WAITS ONLY 1 SECOND IF "NUMSEC" IS NOT BETWEEN 0.0 & 60.0.
XC----------------------------------------------- SUBPROGRAM PARAMETERS
X      REAL*4 NUMSEC          ! Number of seconds to wait (between 0 & 60)
XC----------------------------------------------- LOCAL DATA STRUCTURES
X      PARAMETER EVENTFLAG=6  ! VAX/VMS Event Flag number to use for timer
X      REAL*4 SECVAL          ! Number of seconds to wait
X      INTEGER*4 DT(2)        ! Timer values
XC----------------------------------------------- CHECK FOR VALID TIME
X      SECVAL = NUMSEC
X      IF (SECVAL.LE.0.0 .OR. SECVAL.GT.60.0) SECVAL = 1
XC----------------------------------------------- SET TIMER VALUES
X      DT(1) = -SECVAL*10**7
X      DT(2) = -1
XC----------------------------------------------- ISSUE TIMER REQUEST
X      I = SYS$SETIMR(%VAL(EVENTFLAG),DT,,)
XC----------------------------------------------- WAIT FOR EVENT FLAG READY
X      J = SYS$WAITFR(%VAL(EVENTFLAG))
XC----------------------------------------------- RETURN
X      RETURN
X      END
$ GoSub Convert_File
$ Exit
