$! ------------------ CUT HERE ----------------------- $ v='f$verify(f$trnlnm("SHARE_UNPACK_VERIFY"))' $! $! This archive created by VMS_SHARE Version 8.3 $! On 1-JUN-1993 11:47:30.94 By user GOATHUNTER (@WKUVX1.BITNET) $! $! The VMS_SHARE software that created this archive $! was written by Andy Harper, Kings College London UK $! -- December 1992 $! $! Credit is due to these people for their original ideas: $! James Gray, Michael Bednarek $! $! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER $! AND EXECUTE AS A COMMAND PROCEDURE ( @name ) $! $! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING: $! 1. QCLEAN.DESC;1 $! 2. QCLEAN.DSJ;1 $! $set="set" $set symbol/scope=(nolocal,noglobal) $f=f$parse("SHARE_UNPACK_TEMP","SYS$SCRATCH:."+f$getjpi("","PID")) $e="write sys$error ""%UNPACK"", " $w="write sys$output ""%UNPACK"", " $ if .not. f$trnlnm("SHARE_UNPACK_LOG") then $ w = "!" $ if f$getsyi("CPU") .gt. 127 then $ goto start $ ve=f$getsyi("version") $ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto start $ e "-E-OLDVER, Must run at least VMS 4.4" $ v=f$verify(v) $ exit 44 $unpack: subroutine ! P1=filename, P2=checksum, P3=attributes $ if f$parse(P1) .nes. "" then $ goto dirok $ dn=f$parse(P1,,,"DIRECTORY") $ w "-I-CREDIR, Creating directory ''dn'" $ create/dir 'dn' $ if $status then $ goto dirok $ e "-E-CREDIRFAIL, Unable to create ''dn' File skipped" $ delete 'f'* $ exit $dirok: $ x=f$search(P1) $ if x .eqs. "" then $ goto file_absent $ e "-W-EXISTS, File ''P1' exists. Skipped" $ delete 'f'* $ exit $file_absent: $ w "-I-UNPACK, Unpacking file ", P1 $ n=P1 $ if P3 .nes. "" then $ n=f $ if .not. f$verify() then $ define/user sys$output nl: $ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='n' PROCEDURE GetHex(s,p)LOCAL x1,x2;x1:=INDEX(t,SUBSTR(s,p,1))-1;x2:=INDEX(t, SUBSTR(s,p+1,1))-1;RETURN 16*x1+x2;ENDPROCEDURE; PROCEDURE SkipPartsep LOOP EXITIF MARK(NONE)=END_OF(b);EXITIF INDEX(ERASE_LINE, "-+-+-+-+-+-+-+-+")=1;ENDLOOP;ENDPROCEDURE;PROCEDURE ProcessLine LOCAL c,s,l,b, n,p;c := ERASE_CHARACTER(1);s := ERASE_LINE;IF c = "X" THEN SPLIT_LINE; ENDIF; MOVE_HORIZONTAL(-1);l := LENGTH(s);p := 1;LOOP EXITIF p > l;c := SUBSTR(s,p,1); p := p+1;CASE c FROM ' ' TO '`' ['`']: COPY_TEXT(ASCII(GetHex(s,p))); p:=p+2;[ ' ']: p:=p+1;[INRANGE,OUTRANGE]: COPY_TEXT(c);ENDCASE;ENDLOOP;ENDPROCEDURE; PROCEDURE Decode POSITION(BEGINNING_OF(b));LOOP EXITIF MARK(NONE)=END_OF(b); IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+-")=1 THEN SkipPartSep;ELSE ProcessLine; MOVE_HORIZONTAL(1);ENDIF;ENDLOOP;ENDPROCEDURE;SET(FACILITY_NAME,"UNPACK");SET( SUCCESS,OFF);SET(INFORMATIONAL,OFF);t:="0123456789ABCDEF";f:=GET_INFO( COMMAND_LINE,"file_name");b:=CREATE_BUFFER(f,f);Decode;WRITE_FILE(b,GET_INFO( COMMAND_LINE,"output_file"));QUIT; $ if p3 .eqs. "" then $ goto dl $ open/write fdl &f $ write fdl "RECORD" $ write fdl P3 $ close fdl $ w "-I-CONVRFM, Converting record format to ", P3 $ convert/fdl=&f &f-1 &P1 $dl: delete 'f'* $ checksum 'P1' $ if checksum$checksum .nes. P2 then $ - e "-E-CHKSMFAIL, Checksum of ''P1' failed." $ exit $ endsubroutine $start: $! $ create 'f' XThis`20file`20features`20code`20previously`20published`20in`20the`20May/June V`201993`20issue`20of`20 XDigital`20Systems`20Journal.`20It`20was`20first`20run`20in`20an`20article`20by V`20J.`20Wren`20Hunt`20 Xtitled`20"Queue`20Cleanup`20Utility,"`20which`20ran`20on`20page`2015.`20QCLEAN V`20allows`20any`20 Xuser`20with`20OPER`20privilege`20or`20delete`20access`20to`20the`20queue`20to V`20delete`20a`20range`20of`20 Xentries`20from`20a`20batch`20or`20print`20queue`20without`20deleting`20the`20e Vntire`20queue.`20 XAlso,`20it`20can`20selectively`20delete`20entries`20for`20a`20specified`20user V`20throughout`20the`20 Xqueue.`20By`20default,`20it`20will`20ask`20for`20confirmation`20before`20it V`20deletes`20an`20entry. $ call unpack QCLEAN.DESC;1 1025639600 "" $! $ create 'f' X$!`20BUILD_QCLEAN.COM X$! X$!`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20 X$`20SET`20NOON X$! X$`20FORTRAN/EXTEND/CHECK=ALL`20QCLEAN X$! X$`20SET`20COMMAND/OBJECT`20QCLEAN_TABLE X$! X$`20LINK/MAP/FULL/NOTRACE`20QCLEAN,QCLEAN_TABLE X$! X$`20INQUIRE`20ANS`20"Would`20you`20like`20to`20update`20the`20system`20help V`20library" X$! X$`20IF`20ANS`20.EQS.`20"Y"`20THEN`20LIBRARY/HELP/LOG`20SYS$HELP:HELPLIB`20QCLE VAN.HLP`20`20`20`20 X$! X$`20WRITE`20SYS$OUTPUT`20"That's`20all`20folks!!!" X$! X$`20EXIT X X`0C X XMODULE`20qclean_table Xdefine`20verb`20qclean X`09routine`20qclean_command X X`09parameter`20p1,`20label=queue_name,`20prompt`20=`20"Queue" X`09`09VALUE`20(REQUIRED) X`09qualifier`20ALL X`09qualifier`20CONFIRM X`09`09default X`09qualifier`20LOG X`09`09default X`09qualifier`20RANGE X`09`09value`20(list) X`09qualifier`20USER X`09`09value`20(list) X X`0C X X`09PROGRAM`20QCLEAN_DRIVER XC********************************************************************* XC* XC*`20`20PROGRAM:`20This`20program`20'cleans'`20entries`20off`20of`20a`20given V`20queue. XC* XC* XC*`20`20PURPOSE:`20This`20utility`20serves`20to`20ease`20the`20task`20of`20del Veting`20multiple XC*`09`20`20`20`20`20jobs`20from`20a`20queue`20when`20it`20is`20not`20desirable V`20and/or`20possible XC*`09`20`20`20`20`20to`20delete`20the`20whole`20queue. XC* XC* XC*`20`20OPERATION:`20`20$`20QCLEAN/LOG/CONFIRM/RANGE=(begin,end)/USER=(usernam Ve)`20`20- XC*`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20queue_name XC* XC* XC*`20`20ENVIRONMENT:`09VAX`20VMS`20V5.5-1 XC*`20`20`09`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20VAX`20Fortran`205.7 V XC* XC*`20`20RESTRICTIONS:`20`20Must`20have`20standard`20VMS`20privileges`20to`20wo Vrk`20with`20queues XC*`09`09`20`20`20(i.e.,`20OPER`20or`20delete`20access`20to`20the`20queue) XC* XC*`09`09`09`20`20`20`20`20`20`20Information`20America XC*`09`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20 V`20`20J.`20Wren`20Hunt XC*`09`09`09`20`20`20`20`20`20`20`20`20June`2011,`201990 XC* XC*`20`20MODIFICATION`20HISTORY: XC* XC* XC********************************************************************** X X`09external`20QCLEAN_table`09`09`09!`20created`20by`20SET`20COMMAND/OBJECT X X X`09integer*2`09out_len`09`09`09!`20length`20of`20user`20input X X`09integer*4`09prompt_flag`09`09!`20flag`20for`20LIB$GET_FOREIGN X`09integer*4`09sts$value`09`09!`20return`20status`20value X`09integer*4`09cli$dispatch`09`09!`20invoke`20QCLEAN`20function X`09integer*4`20`20`20`20`20`20`20cli$dcl_parse`09`09!`20check`20QCLEAN`20synta Vx X`09integer*4`20`20`20`20`20`20`20lib$get_foreign`09`09!`20get`20command`20from V`20DCL`20line X X`09character*132`09command_line`09`20`20`20`20`20`20`20`20!`20input`20from`20u Vser X`09character*139`09full_command`09`09!`20input`20to`20CLI$DISPATCH X X X X`09prompt_flag`20=`200`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20 V`20`20`20`20`20`20`20!`20don't`20prompt`20by`20default X X****************************************************************************** V XC XC`09`20`20`20`20Mainline`20driver`20code`20follows... XC X****************************************************************************** V X XC`09Get`20the`20command`20line`20the`20user`20specified. X X`09sts$value`20=`20lib$get_foreign(command_line,,out_len,prompt_flag) X XC`09Since`20it`20stripped`20off`20the`20'verb',`20replace`20it`20back`20so`20t Vhat`20we`20can XC`09call`20the`20CLI$DCL_PARSE`20routine X X X`09full_command`20=`20'QCLEAN`20'`20//`20command_line X XC`09Let`20it`20determine`20which`20qualifiers`20`26`20parameters`20were`20spec Vified X X`09sts$value`20=`20cli$dcl_parse(full_command,QCLEAN_table,,,) X XC`09Now`20execute`20the`20command! X X`09sts$value`20=`20cli$dispatch() X X X`09end`09!`20QCLEAN_DRIVER X X X X`0C X`09integer*4`20function`20QCLEAN_COMMAND() XC********************************************************************* XC* XC*`20This`20routine`20does`20the`20actual`20processing`20for`20determining`20w Vhich`20jobs XC*`20to`20'clean'`20from`20the`20specified`20queue. XC* XC* XC*`09`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20J V.`20Wren`20Hunt XC*`09`09`09`20`20`20`20`20`20`20October`2018,`201989 XC* XC********************************************************************** X X`09implicit`20none X X`09include`20'($clidef)'`09`20`20`20`20`20`20!`20command`20language`20interpre Vter`20defs X`09include`20'($ssdef)'`09`20`20`20`20`20`20!`20system`20service`20status`20de Vfs X`09include`20'($quidef)'`09`20`20`20`20`20`20!`20$GETQUIW`20status`20defs X X`09external`20cli$_present`09`20`20`20`20`20`20!`20qualifier`20is`20present X`09external`20cli$_defaulted`09`20`20`20`20`20`20!`20qualifier`20present`20by V`20default X`09external`20cli$_absent`09`20`20`20`20`20`20!`20qualifier`20is`20absent X`09external`20QCLEAN_table`09`20`20`20`20`20`20!`20table`20created`20by`20SET V`20COMMAND/OBJECT X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20 V`20`20 X`09logical`09`20`20log_flag X`09logical`09`20`20all_flag X`09logical`09`20`20confirm_flag X`09logical`20`20`20range_flag X`09logical`09`20`20user_flag X`09 X X`09integer*2`09search_name_len,`20queue_name_len,`20job_name_len,`20 X`20`20`20`20`201`09`09`09username_len X X X`09integer*4`20iosb(2)`09`20`20`20`20`20`20!`20I/O`20Status`20Block`20values X`09integer*4`20cli$present`09`20`20`20`20`20`20!`20Routine`20to`20determine V`20if`20qualifier`20present X`09integer*4`20cli$get_value`09`20`20`20`20`20`20!`20routine`20to`20get`20qual Vifier`20value X`09integer*4`20sts$value`09`20`20`20`20`20`20!`20return`20status`20value X`09integer*4`20status_q`09`20`20`20`20`20`20!`20queue`20operation`20return`20s Vtatus X`09integer*4`20status_j`09`20`20`20`20`20`20!`20job`20operation`20return`20sta Vtus X`09integer*4`20last`09`09`20`20`20`20`20`20!`20find`20last`20non-blank`20char V`20in`20string X`09integer*4`20sys$getquiw`09`20`20`20`20`20`20!`20get`20queue`20information X`09integer*4`20str$upcase`09`20`20`20`20`20`20!`20convert`20lower`20->`20upper Vcase X`09integer*4`20delete_entry`09`20`20`20`20`20`20!`20internal`20function`20to V`20zap`20queue`20entries X`09integer*4`20search_flags`09`20`20`20`20`20`20!`20search`20flags`20for`20$GE VTQUI X`09integer*4`20job_size`09`20`20`20`20`20`20!`20returned`20job`20size`20(in V`20blocks) X`09integer*4`20job_status`09`20`20`20`20`20`20!`20returned`20job`20status X`09integer*4`20entry_number`09`20`20`20`20`20`20!`20returned`20job`20entry`20n Vumber X`09integer*4`20begin_range`09`20`20`20`20`20`20!`20user-specified`20begin`20ra Vnge X`09integer*4`20end_range`09`20`20`20`20`20`20!`20user-specified`20end`20range X X X`09character*1`09answer`09`20`20`20`20`20`20!`20user's`20answer`20to`20delete V`20prompt X`09character*5`09begin_s,end_s`20!`20string`20representation`20of`20begin/end X`09character*12`09username X`09character*12`09user_to_kill`20 X`09character*31`09search_name X`09character*31`09queue_name X`09character*39`09job_name X X XC+++++++++++++++++++++ XC XC`20RECORD`20Declarations XC XC+++++++++++++++++++++ X X`09structure`09/itmlst/ X`09`20`20union X`20`20`20`20`09`20`20`20`20map X`09`09integer*2`20buflen`09!`20buffer`20length X`09`09integer*2`20itmcod`09!`20item`20code X`09`09integer*4`20bufadr`09!`20buffer`20address X`09`09integer*4`20retadr`09!`20return`20address X`09`20`20`20`20end`20map X`09 X`09`20`20`20`20map X`09`09integer*4`20end_list`09!`20terminate`20end-of-list`20with`20longword`200 V X`09`20`20`20`20end`20map X`20`20`20`20`20`20`20`20`20`20end`20union X`20`20`20`20`20`20`20`20end`20structure X X X X X`09record`20/itmlst/`20queue_list(4) X`09record`20/itmlst/`20job_list(7) X X X X`09common`20/stuff/`09username,user_to_kill,all_flag,user_flag,confirm_flag, X`20`20`20`20`201`09`09`09username_len X X XC*********************************************************** XC XC`20`20M`20A`20I`20N`20L`20I`20N`20E`20`20`20`20`20C`20O`20D`20E`20`20`20`20 V`20S`20T`20A`20R`20T`20S`20`20`20`20`20H`20E`20R`20E XC XC*********************************************************** X X`09begin_range`20=`200 X`09end_range`20=`200 X X X XC`20See`20what`20qualifiers`20the`20user`20specified... X X`09sts$value`20=`20cli$present('log') X`09if`20(sts$value`20.eq.`20%loc(cli$_present) X`20`20`20`20`201`09`09`20.or.`20sts$value`20.eq.`20%loc(cli$_defaulted))`20the Vn X`09`09log_flag`20=`20.true. X`09else X`09`09log_flag`20=`20.false. X`09end`20if X X X`09sts$value`20=`20cli$present('all') X`09if`20(sts$value`20.eq.`20%loc(cli$_present))`20then X`09`09all_flag`20=`20.true. X`09else X`09`09all_flag`20=`20.false. X`09end`20if X X X`09sts$value`20=`20cli$present('confirm') X`09if`20(sts$value`20.eq.`20%loc(cli$_present) X`20`20`20`20`201`09`09`20.or.`20sts$value`20.eq.`20%loc(cli$_defaulted))`20the Vn X X`09`09confirm_flag`20=`20.true. X`09else X`09`09confirm_flag`20=`20.false. X`09end`20if X X Xc`09if`20(sts$value`20.eq.`20%loc(cli$_negated))`20confirm_flag`20=`20.false. X X X XC`20See`20if`20user`20specified`20a`20range;`20if`20so,`20then`20get`20two`20v Values`20(1)`20begin`20`26 XC`09(2)`20end`20job`20numbers X X`09sts$value`20=`20cli$present('range') X`09if`20(sts$value`20.eq.`20%loc(cli$_present))`20then X X`09`09range_flag`20=`20.true. X X`09`09sts$value`20=`20cli$get_value('range',begin_s) X`09`09if`20(.not.`20sts$value)`20call`20lib$signal(%val(sts$value)) X X`09`09sts$value`20=`20cli$get_value('range',end_s) X`09`09if`20(.not.`20sts$value)`20call`20lib$signal(%val(sts$value))`09 X XC`20Convert`20strings`20to`20numeric X X`09`09read`20(unit=begin_s(1:5),fmt='(bn,i10)')`20begin_range X`09`09read`20(unit=end_s(1:5),fmt='(bn,i10)')`20end_range X X`09else X`09`09range_flag`20=`20.false. X`09end`20if X X X X`09sts$value`20=`20cli$present('USER') X`09if`20(sts$value`20.eq.`20%loc(cli$_present))`20then X X`09`09user_flag`20=`20.true. X X`09`09sts$value`20=`20cli$get_value('USER',user_to_kill) X`09`09if`20(.not.`20sts$value)`20call`20lib$signal(%val(sts$value)) X X`09else X`09`09user_flag`20=`20.false. X X`09end`20if X X XC`20Grab`20the`20first`20parameter.`20Since`20this`20is`20a`20'required'`20par Vameter,`20if`20it's XC`20absent`20then`20we`20know`20the`20CLI`20has`20already`20given`20the`20user V`20an`20error`20message XC`20so`20just`20go`20ahead`20and`20quit`20til`20they`20get`20it`20right. X X`09sts$value`20=`20cli$get_value('queue_name',search_name) X`09if`20(sts$value`20.eq.`20%loc(cli$_absent))`20call`20exit X X`09search_name_len`20=`20last(search_name) X X Xc`20Initialize`20item`20list`20for`20the`20display`20queue`20operations X X`09queue_list(1).buflen`20=`20search_name_len X`09queue_list(1).itmcod`20=`20qui$_search_name X`09queue_list(1).bufadr`20=`20%loc(search_name) X`09queue_list(1).retadr`20=`200 X X`09queue_list(2).buflen`20=`204 X`09queue_list(2).itmcod`20=`20qui$_search_flags X`09queue_list(2).bufadr`20=`20%loc(search_flags) X`09queue_list(2).retadr`20=`200 X X`09queue_list(3).buflen`20=`2031 X`09queue_list(3).itmcod`20=`20qui$_queue_name X`09queue_list(3).bufadr`20=`20%loc(queue_name) X`09queue_list(3).retadr`20=`20%loc(queue_name_len) X X`09queue_list(4).end_list`20=`200 X X XC`20Initialize`20item`20list`20for`20the`20display`20job`20operation X X`09job_list(1).buflen`20=`204 X`09job_list(1).itmcod`20=`20qui$_search_flags X`09job_list(1).bufadr`20=`20%loc(search_flags) X`09job_list(1).retadr`20=`200 X X`09job_list(2).buflen`20=`204 X`09job_list(2).itmcod`20=`20qui$_job_size X`09job_list(2).bufadr`20=`20%loc(job_size) X`09job_list(2).retadr`20=`200 X X`09job_list(3).buflen`20=`2039 X`09job_list(3).itmcod`20=`20qui$_job_name X`09job_list(3).bufadr`20=`20%loc(job_name) X`09job_list(3).retadr`20=`20%loc(job_name_len) X X`09job_list(4).buflen`20=`2012 X`09job_list(4).itmcod`20=`20qui$_username X`09job_list(4).bufadr`20=`20%loc(username) X`09job_list(4).retadr`20=`20%loc(username_len) X X`09job_list(5).buflen`20=`204 X`09job_list(5).itmcod`20=`20qui$_job_status X`09job_list(5).bufadr`20=`20%loc(job_status) X`09job_list(5).retadr`20=`200 X X X`09job_list(6).buflen`20=`204 X`09job_list(6).itmcod`20=`20qui$_entry_number X`09job_list(6).bufadr`20=`20%loc(entry_number) X`09job_list(6).retadr`20=`200 X X`09job_list(7).end_list`20=`200 X X X XC`20The`20following`20is`20from`20the`20example`20in`20the`20System`20Services V`20References`20Manual: XC XC`20`20"Request`20search`20of`20all`20jobs`20present`20in`20output`20queue; V`20also`20force XC`20`20wildcard`20mode`20to`20maintain`20the`20internal`20search`20context`20b Vlock`20after XC`20`20the`20first`20call`20when`20a`20non-wild`20queue`20name`20is`20entered V`20--`20this`20preserves XC`20`20queue`20context`20for`20the`20subsequent`20display`20job`20operation." XC XC`20`20Note`20that`20if`20QUI$M_SEARCH_SYMBIONT`20is`20specified,`20it`20will V`20search`20only`20 XC`20`20print`20queues;`20it`20will`20not`20handle`20batch`20queues. X X`09Search_Flags`20=`20(qui$m_search_wildcard`20.or. X`20`20`20`20`201`09`09`20`20`20`20`20`20`20`20qui$m_search_all_jobs) X X XC`20Dissolve`20any`20internal`20search`20context`20block`20for`20the`20process V X X`09status_q`20=`20sys$getquiw(,%val(qui$_cancel_operation),,,,,) X`09if`20(.not.`20status_q)`20call`20lib$signal(%val(status_q)) X X XC`20Do`20a`20'priming'`20read... X X X`09status_q`20=`20sys$getquiw(,%val(qui$_display_queue),, X`20`20`20`20`201`09`09`09`09queue_list,iosb,,) X`09if`20(.not.`20status_q)`20call`20lib$signal(%val(status_q)) X`09if`20(.not.`20iosb(1))`20call`20lib$signal(%val(iosb(1))) X`09`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20 V`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20 V`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20 X X`09status_j`20=`20sys$getquiw(,%val(qui$_display_job),, X`20`20`20`20`202`09`09`09`09`09job_list,iosb,,) X`09if`20(.not.`20status_j)`20call`20lib$signal(%val(status_j)) X`09if`20(.not.`20iosb(1))`20call`20lib$signal(%val(iosb(1))) X`09if`20(status_j)`20status_j`20=`20iosb(1) X X X X`09do`20while`20(status_j) X XC`20`09`20`20`20`20Got`20a`20job`20so`20see`20if`20user`20wants`20to`20delete V`20it. X X`09`20`20`20`20if`20(range_flag`20.eq.`20.false.`20.and.`20user_flag`20.eq. V`20.false.)`20then X X`09`09type`20100,job_name(1:job_name_len),entry_number, X`20`20`20`20`201`09`09`20`20`20`20`20`20`20`20`20username(1:username_len) X X`09`09if`20(confirm_flag`20.eq.`20.true.)`20then X X`09`09`09read`20200,answer X Xc`09`09`09Convert`20user's`20input`20to`20uppercase`20for`20ease`20in`20compar Ving. X X`09`09`09sts$value`20=`20str$upcase(answer,answer) X X`09`09`09if`20(answer(1:1)`20.eq.`20'Y') X`20`20`20`20`201`09`09`09`20`20call`20delete_entry(queue_name,entry_number,log V_flag, X`20`20`20`20`202`09`09`09`09job_name(1:job_name_len),range_flag,begin_range,en Vd_range) X X`09`09else`20`20`20`20`20!`20user`20specified`20/NOCONFIRM X`09`09`09call`20delete_entry(queue_name,entry_number,log_flag, X`20`20`20`20`201`09`09`09`09`20`20job_name(1:job_name_len),range_flag,begin_ra Vnge,end_range) X X`09`09end`20if`20`20!`20checking`20confirmation`20switch X X`09`20`20`20`20else X`20`20`20`20`09`09call`20delete_entry(queue_name,entry_number,log_flag, X`20`20`20`20`201`09`09`09`09job_name(1:job_name_len),range_flag,begin_range,en Vd_range) X X X`09`20`20`20`20end`20if X X X X X`09`09status_j`20=`20sys$getquiw(,%val(qui$_display_job),, X`20`20`20`20`202`09`09`09`09`09`09job_list,iosb,,) X`09`09if`20(status_j)`20status_j`20=`20iosb(1) X X`09end`20do X X X100`09format('$',a,4x,i4,4x,a'`20`20delete?`20`5Bn`5D') X200`20`09format(a1) X X X`09qclean_command`20=`20ss$_normal`09!`20always`20return`20back`20a`20good`20s Vtatus X`09end`09!`20QCLEAN_COMMAND`09!`20`20to`20CLI$DISPATCH X X X X X`0C X`09subroutine`20delete_entry(queue_name,`20entry_number,log_flag, X`20`20`20`20`201`09`09`09`09`20`20`20`20`20`20`20`20job_name,range_flag,begin_ Vrange, X`20`20`20`20`202`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20 V`20`20`20`20`20`20`20`20`20`20`20`20`20`20end_range) XC***************************************************************************** V*** XC XC`20`20This`20routine`20does`20the`20actual`20deletion`20of`20the`20queue`20en Vtry. XC XC XC***************************************************************************** V*** X X`09implicit`20none X`09 X`09include`20'($ssdef)'`09`20`20`20`20!`20system`20service`20status`20defs X`09include`20'($sjcdef)'`09`20`20`20`20!`20$SNDJBCW`20status`20defs X X`09character*(*)`20`09queue_name,job_name X X`09logical`09`09log_flag X`09logical`09`09range_flag X`09logical`09`09all_flag X`09logical`09`09user_flag X`09logical`09`09confirm_flag X`09logical`09`09deleted_flag X X`09integer*2`09k`09`09!`20misc.`20scratch`20variable X`09integer*2`09username_len`09!`20length`20of`20returned`20username X X`09integer*4`20`20`20`20`20`20`20iosb(2)`09`09!`20I/O`20Status`20block X`09integer*4`09entry_number`09!`20returned`20job`20entry`20number X`09integer*4`09sts$value`09!`20returned`20status`20value X`09integer*4`09sys$sndjbcw`09!`20send-to-job-controller`20service X`09integer*4`09begin_range`09!`20beginning`20range`20of`20jobs`20to`20delete X`09integer*4`09end_range`09!`20ending`20range`20of`20jobs`20to`20delete X`09integer*4`09str$upcase`09!`20convert`20lowercase`20->`20uppercase X`09integer*4`09last`09`09!`20find`20last`20non-blank`20char`20in`20string X X`09character*1`09answer`09`09!`20user's`20response`20to`20delete`20prompt X`09character*12`09username X`09character*12`20`20`20`20user_to_kill X X X`09common`20/stuff/`09username,user_to_kill,all_flag,user_flag,confirm_flag, X`20`20`20`20`201`09`09`09username_len X X XC`20Got`20down`20here`20'cause`20user`20wanted`20to`20blow`20away`20a`20print/ Vbatch`20job.`20Do`20it! X X`09structure`09/itmlst/ X`09`20`20union X`20`20`20`20`09`20`20`20`20map X`09`09integer*2`20buflen,itmcod X`09`09integer*4`20bufadr,retadr X`09`20`20`20`20end`20map X`09 X`09`20`20`20`20map X`09`09integer*4`20end_list X`09`20`20`20`20end`20map X`20`20`20`20`20`20`20`20`20`20end`20union X`20`20`20`20`20`20`20`20end`20structure X X X X X`09record`20/itmlst/`20jbc_list(4) X X XC`20Assume`20we`20won't`20delete`20it.`20We`20use`20this`20flag`20so`20that V`20we`20know`20which`20ones`20to XC`20print`20out`20if`20/LOG`20was`20requested. X X X`09deleted_flag`20=`20.false. X X X`09jbc_list(1).buflen`20=`2031 X`09jbc_list(1).itmcod`20=`20sjc$_queue X`09jbc_list(1).bufadr`20=`20%loc(queue_name) X`09jbc_list(1).retadr`20=`200 X X`09jbc_list(2).buflen`20=`204 X`09jbc_list(2).itmcod`20=`20sjc$_entry_number X`09jbc_list(2).bufadr`20=`20%loc(entry_number) X`09jbc_list(2).retadr`20=`200 X X`09jbc_list(3).end_list`20=`200 X X XC`20See`20if`20we're`20processing`20a`20range`20of`20jobs`20or`20just`20a`20si Vngle`20one. X X`09if`20(range_flag`20.eq.`20.true.)`20then X X`09`20`20if`20(entry_number`20.ge.`20begin_range`20.and.`20entry_number`20.le. V`20end_range)`20then X X`09`09`20`20`20if`20(confirm_flag`20.eq.`20.true.)`20then X`09`09`20`20`20`09type`20100,job_name,entry_number,username X`09`09`20`20`20`09read`20200,answer X X`09`09`20`20`20`09sts$value`20=`20str$upcase(answer,answer) X`20`20`20`09`09`20`20`20`20`20`20`20`20if`20(.not.`20sts$value)`20call`20lib$s Vignal(%val(sts$value)) X X`09`09`20`20`20`09if`20(answer(1:1)`20.eq.`20'Y')`20then X`09`09`20`20`20`09`20`20`20sts$value`20=`20sys$sndjbcw(,%val(sjc$_delete_job), V, X`20`20`20`20`201`09`09`09`09`09`09`09jbc_list,iosb,,) X`09`09`20`20`20`09`20`20`20if`20(.not.`20sts$value)`20call`20lib$signal(%val(s Vts$value)) X`09`09`20`20`20`09`20`20`20if`20(.not.`20iosb(1))`20call`20lib$signal(%val(ios Vb(1))) X`09`09`20`20`20`09`20`20`20if`20(iosb(1))`20deleted_flag`20=`20.true. X`09`09`20`20`20`09end`20if X`09`09`20`20`20else X`09`09`20`20`20`09sts$value`20=`20sys$sndjbcw(,%val(sjc$_delete_job),, X`20`20`20`20`201`09`09`09`09`09`09`09jbc_list,iosb,,) X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20if`20( V.not.`20sts$value)`20call`20lib$signal(%val(sts$value)) X`09`20`20`20`09`20`20`20`20`20`20`20`20if`20(.not.`20iosb(1))`20call`20lib$sig Vnal(%val(iosb(1))) X`09`09`20`20`20`09if`20(iosb(1))`20deleted_flag`20=`20.true. X X`09`09`20`20`20end`20if`20`20`20!`20confirm_flag`20=`20true X X`09`20`20`20`20end`20if`09`20`20`20`20!`20job`20is`20within`20specified`20rang Ve X X`09end`20if`09`09`20`20`20`20!`20range_flag`20=`20true X X X X X`09if`20(user_flag`20.eq.`20.true.)`20then X X`09`09k`20=`20last(user_to_kill) X`09`09 X`09`09if`20(username(1:username_len)`20.eq.`20user_to_kill(1:k))`20then X X`09`09`09if`20(confirm_flag`20.eq.`20.true.)`20then X`09`09`09`09type`20100,job_name,entry_number,username X`09`09`09`09read`20200,answer X X`09`09`09`09sts$value`20=`20str$upcase(answer,answer) X`09`09`20`20`20`09`20`20`20`20`20`20`20`20if`20(.not.`20sts$value)`20call`20li Vb$signal(%val(sts$value)) X X`09`09`09`09if`20(answer(1:1)`20.eq.`20'Y')`20then X`09`09`09`09`20`20`20`20`20sts$value`20=`20sys$sndjbcw(, X`20`20`20`20`201`09`09`09`09`09`09`09%val(sjc$_delete_job),, X`20`20`20`20`202`09`09`09`09`09`09`09jbc_list,iosb,,) X`09`09`09`09`20`20`20`20`20if`20(.not.`20sts$value)`20call`20lib$signal( X`20`20`20`20`201`09`09`09`09`09`09`09`09%val(sts$value)) X`09`09`20`20`20`09`20`20`20`20`20`20`20`20`20`20`20`20`20if`20(.not.`20iosb(1) V)`20call`20lib$signal(%val(iosb(1))) X`09`09`09`09`20`20`20`20`20if`20(iosb(1))`20deleted_flag`20=`20.true. X`09`09`09`09end`20if X`09`09`09else X`09`09`09`09sts$value`20=`20sys$sndjbcw(,%val(sjc$_delete_job), X`20`20`20`20`201`09`09`09`09`09`09`09,jbc_list,iosb,,) X`09`09`09`09if`20(.not.`20sts$value)`20call`20lib$signal( X`20`20`20`20`201`09`09`09`09`09`09`09%val(sts$value)) X`09`09`20`20`20`09`20`20`20`20`20`20`20`20if`20(.not.`20iosb(1))`20call`20lib$ Vsignal(%val(iosb(1))) X`09`09`09`09if`20(iosb(1))`20deleted_flag`20=`20.true. X X`09`09`09end`20if`09`20`20`20`20!`20confirm`20flag`20=`20true X X`09`09end`20if`09`20`20`20`20!`20requested`20username`20matches`20user`20just V`20found X X`09end`20if`09`20`20`20`20!`20/USER=`20selected X X X X X`09if`20(user_flag`20.eq.`20.false.`20.and.`20range_flag`20.eq.`20.false.)`20t Vhen X X`09`09sts$value`20=`20sys$sndjbcw(,%val(sjc$_delete_job),,jbc_list,iosb,,) X`09`09if`20(.not.`20sts$value)`20call`20lib$signal(%val(sts$value)) X`20`20`20`09`20`20`20`20`20`20`20`20if`20(.not.`20iosb(1))`20call`20lib$signal V(%val(iosb(1))) X`09`09`20`20 X`09`09if`20(iosb(1))`20deleted_flag`20=`20.true. X X`09end`20if X X X XC`20If`20user`20specified`20/LOG`20then`20tell`20them`20that`20it's`20a`20gone Vr! X X`09if`20(log_flag`20.eq.`20.true.`20.and.`20deleted_flag`20.eq.`20.true.) X`20`20`20`20`201`09`09`20type`20300,job_name,entry_number X X X X100`09format('$',a,4x,i4,4x,a'`20`20delete?`20`5Bn`5D') X200`20`09format(a1) X300`09format('$','%QCLEAN-I-DELETED,`20',a,4x,'`20entry`20',i4,'`20`20deleted' V,/) X X X X`09end`09`20`20`20`20!`20subroutine`20DELETE_ENTRY X`20 X X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20 V`20`20`20`20`20`20`20`20`20`20`20 X`0C X`09integer`20function`20last(string) XC***************************************************************************** V*** XC XC`20This`20routine`20always`20finds`20the`20last`20non-blank`20character`20in V`20a`20string`20and`20 XC`20returns`20it's`20position`20in`20the`20string. XC XC XC***************************************************************************** V*** X X X`09implicit`20none X`09 X`09integer`20i X`09character*(*)`09string X X`09i`20=`20len(string) X X`09do`20while`20(string(i:i)`20.eq.`20'`20') X`09`09i`20=`20i`20-`201 X`09end`20do X X`09last`20=`20i X X`09end`09!`20function`20LAST X`20`20`20`20`20`20`20`20 $ call unpack QCLEAN.DSJ;1 1880638799 "" $ v=f$verify(v) $ exit