diff --git a/99bottles-dcl b/99bottles-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_OTlib3R0bGVzLWRjbA==
--- /dev/null
+++ b/99bottles-dcl
@@ -0,0 +1,25 @@
+99bottles.com
+Ken Farmer, Wednesday May 14 2003 @ 08:26AM EDT
+$! 99 bottles of beer
+$! Written for VMS DCL by rsteenw@xs4all.nl
+$!
+$! $fao is a system lexical function, where FAO stands for
+$! Formatted ASCII Output. There's a fair bunch of these
+$! functions accessible via DCL (the command interpreter),
+$! like querying system, device, process and user parameters,
+$! string and list manipulation, file system foo, and more.
+$!
+$ cnt = 99
+$ msg = f$fao("!UB bottle!1%C!%Es!%F of beer", cnt)
+$ loop:
+$ write sys$output f$fao("!AS on the wall!/!-!AS", msg)
+$ write sys$output "Take one down and pass it around"
+$ cnt = cnt - 1
+$ if cnt .gt. 0
+$ then
+$ msg = f$fao("!UB bottle!1%C!%Es!%F of beer", cnt)
+$ write sys$output f$fao("!AS on the wall!/", msg)
+$ goto loop
+$ else
+$ write sys$output "No more bottles of beer on the wall"
+$ endif
diff --git a/ATM-credit-card-transaction-dcl b/ATM-credit-card-transaction-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_QVRNLWNyZWRpdC1jYXJkLXRyYW5zYWN0aW9uLWRjbA==
--- /dev/null
+++ b/ATM-credit-card-transaction-dcl
@@ -0,0 +1,84 @@
+ATM_credit_card_transaction
+sanjay Dharmik, Thursday November 20 2003 @ 09:09PM EST
+1)Name of the program:ATM_credit_card_transaction Total lines of code = about 100{100=60 lines(dcl.com) + 40 lines (dcl1.com)}--dcl1.com is called by dcl.com
+2)location of the code:dka306:[sanjay]
+
+3)objectives of the program:To prepare a Report giving the transaction details of the ATM log from the file atmlog.out present in dka306:[sanjay]
+
+4)location of the Report file:The name of the Report file is atmlog1.lis and which gives the credit card details present in dka300:[conopr.out]
+
+5)objectives of the Report:The credit card amount is extracted from the file atmlog.out(present in dka306:[sanjay] and the total credit card transaction is displayed in the last row.Thus this report gives the total credit card transaction detail using the f$extract lexical.
+
+Also the unwanted field such as the time field is removed from the report file atmlog1.lis
+
+6)The program prepares location wise "ATM1,2,3...." FILES automatically giving location wise credit card transaction details
+
+7)Any new location added to the file atmlog.out with trainsaction details get automatically updated in the respective files .
+
+8)This program which prepares locationwise(atmi%.rep )where %=1,2,3... all the locations possible .
+
+9)The totaling of the credit card transaction inthe location wise report is done.
+
+$set verify
+$set symbol/scope=global
+$set terminal/width=80
+$define oupn concert$log:atmlog1.lis
+$open inp atmlog.out
+$open/write oupn concert$log:atmlog1.lis
+$str1:==*****************************************
+$str2:==STR NO. STOCK NO. IC NO. ATM.IF ATM1% CASH
+$str3:==*****************************************
+$write/symbol oupn "''str1'"
+$write/symbol oupn "''str2'"
+$write/symbol oupn "''str3'"
+$close oupn
+$lis="0,1,2,3,4,5,6,7,8,9"
+$next=0
+$lp:
+$next =next + 1
+$num=f$element(next,",",lis)
+$if(num . nes .",")
+$then
+$create dka306:[sanjay]atmi'num'.rep
+$open opn atmi'num'.rep
+$copy concert$log:atmlog1.lis atmi'num'.rep
+$close opn
+$goto lp
+$else
+$endif
+$stg5=0
+$loop:
+$read/end_of_file=readcomplete inp data
+$open/read/write inp data
+$stg1=f$extract(0,48,data)
+$stg2=f$extract(57,100,data)
+$write oupn stg1 + stg2
+$stg4=f$extract(31,5,data)
+$set def dka306:[sanjay]
+$sear/exact/out='stg4.out atmlog.out 'stg4
+$loop1:
+$open/read/end_of_file=inp data
+$stg3=f$extract(111,4,data)
+$if stg3. eqs. " "
+$then
+$goto abc
+$else
+$endif
+$stg5=stg5+stg3
+$goto loop
+$abc:
+$readcomplete
+$write oupn "THE TOTAL CASH TRANSACTION IS''stg'"
+$close inp
+$close oupn
+$close inpo
+$set def concert$log:
+$append atmlog1.lis atmlog1.lis;-1
+$rename atmlog1.lis;-1 atmlog1.lis
+$purge/noconfirm atmlog1.lis
+$set def dka 306:[sanjay]
+$@dcl1.com
+$exit
+
+
+< diskspace.com | cpsearch >
diff --git a/account-dcl b/account-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_YWNjb3VudC1kY2w=
--- /dev/null
+++ b/account-dcl
@@ -0,0 +1,333 @@
+ACCOUNT
+Sebastiano Salvati, Friday November 05 2004 @ 11:09AM EST
+$ goto start
+$!*****************************************************************************
+$! A C C O U N T *
+$! *
+$! Description: *
+$! *
+$! This procedure has been created to use the AUTHORIZE system utility *
+$! on a simple and guided manner through the use of a menu. *
+$! It can be run on a captive account in order to permit at *
+$! non-priviledged user to execute priviledged account management *
+$! operations. *
+$! The procedure has been conceived on a way to avoid control-Y escapes *
+$! in order to achieve DCL system prompt capabilities. *
+$! *
+$! Available and permitted functions are as follows: *
+$! *
+$! - Password modification of an account. *
+$! - Enabling of an account. *
+$! - Disabling of an account. *
+$! - List of one or more account. *
+$! *
+$! Any occurence of the string "!ZZZZ" denotes command lines or portion of it *
+$! inserted for debugging purposes. *
+$! *
+$! Author: *
+$! *
+$! Sebastiano Salvati Digital Equipment Corporation Rome Italy *
+$! *
+$! Needed privileges: *
+$! *
+$! SYSPRV *
+$! *
+$! Revisions: *
+$! *
+$! v 1.0 17 may 1993 *
+$! *
+$! First release. *
+$! *
+$! v 1.1 20 may 1993 *
+$! *
+$! - modified option 4, list. *
+$! - inserted messagge in reverse to say operation completed. *
+$! - inserted logic sysuaf in user mode to point to data file *
+$! sysuaf.dat *
+$! *
+$! v 1.2 21 may 1993 *
+$! *
+$! created subroutine status_&_closure *
+$! *
+$! v 1.3 26 may 1993 *
+$! *
+$! created symbol print_file to point at a specified print queue *
+$! (default = sys$print) *
+$! *
+$! v 1.4 28 maggio 1993 *
+$! *
+$! - modified variable username to be univoque on any section *
+$! of the program. *
+$! - added control for null input on read of various sections. *
+$! *
+$!*****************************************************************************
+$start:
+$!
+$ set noon
+$ set nocontrol=(y,t)
+$ set terminal/nobroadcast
+$ say := write sys$output
+$ clear_terminal := "[!p[2J[H"
+$ zot := write sys$output clear_terminal
+$ print_file := print/queue=sys$print ! modify queue name as needed
+$ uaf := $authorize
+$ done = "[14;14H[7m Operation completed." + -
+" Return status is: [0m"
+$ conditions = "[18;14H[7m %uaf-i = ok," + -
+" %uaf-w = error, %uaf-e = error [0m"
+$!
+$check_for_sysprv:
+$!
+$ procpriv = f$getjpi("","PROCPRIV")
+$ if f$locate("SYSPRV",procpriv) .eq. f$length(procpriv)
+$ then
+$ say "Sorry ! Missing process privilege to run this procedure !"
+$ goto nopriv_exit
+$ endif
+$!
+$initial_menu:
+$!
+$ call make_a_border
+$ say "[4;20HAutomatic procedure for basic management"
+$ say "[5;20Hof system accounts by unprivileged users"
+$ say "[8;20H[1;7m 1 [0m Modify a password"
+$ say "[10;20H[1;7m 2 [0m Enable an account"
+$ say "[12;20H[1;7m 3 [0m Disable an account"
+$ say "[14;20H[1;7m 4 [0m List one or all accounts"
+$ say "[16;20H[1;7m u [0m Exit"
+$!
+$ask_for_option:
+$!
+$ read/prompt="[19;24HChoice one option: " sys$command option
+$ if option .eqs. "1" then goto modify_password
+$ if option .eqs. "2" then goto enable_account
+$ if option .eqs. "3" then goto disable_account
+$ if option .eqs. "4" then goto list_account
+$ if ((option .eqs. "U") .or. (option .eqs. "u")) then goto exit
+$ say "[20;24H[?25l[1mChoice not valid," + -
+" try again...[0m"
+$ wait 00:00:00.5
+$ say "[19;47H "
+$ say "[20;24H[1m [0m[?25h"
+$ goto ask_for_option
+$!
+$modify_password:
+$!
+$ call make_a_border
+$ say "[4;27H[1mModify a password[0m"
+$ask_for_user_mod:
+$ read/prompt="[6;10HUsername [max 12 crt] ? " -
+sys$command user_mod
+$ if user_mod .eqs. "" then goto ask_for_user_mod
+$ask_for_password:
+$ set terminal/noecho
+$ read/prompt="[8;10HEnter new password: " -
+sys$command password
+$ if password .eqs. "" then goto ask_for_password
+$ask_for_verify:
+$ read/prompt="[10;10HEnter again to verify: " -
+sys$command password_verify
+$ if password_verify .eqs. "" then goto ask_for_verify
+$ set terminal/echo
+$ if password_verify .nes. password
+$ then
+$ say "[12;10H[?25l[1m" + -
+"Verify error, try again...[0m"
+$ wait 00:00:01
+$ say "[10;10H "
+$ say "[12;10H [?25h"
+$ goto ask_for_password
+$ else
+$ say "[?25l"
+$ define/user sysuaf sys$system:sysuaf.dat
+$ define/exec/nolog sys$error _nl:
+$ define/exec/nolog sys$output my_uaf.log
+$ uaf modify 'user_mod'/password='password'/pwdexpired
+$ deassign/exec sys$output
+$ deassign/exec sys$error
+$ call status_&_closure
+$ endif
+$ goto initial_menu
+$!
+$enable_account:
+$!
+$ call make_a_border
+$ say "[4;27H[1mEnable an account[0m"
+$ask_for_user:
+$ read/prompt="[6;10HUsername [max 12 crt] ? " sys$command user_ena
+$ if user_ena .eqs. "" then goto ask_for_user
+$ask_for_days:
+$ read/prompt="[8;10HHow many days ? " sys$command days
+$ if days .eqs. "" then goto ask_for_days
+$ say "[?25l"
+$ expiration_time = f$cvtime("''f$time()'+''days'-0","absolute","date")
+$ define/user sysuaf sys$system:sysuaf.dat
+$ define/exec/nolog sys$error _nl:
+$ define/exec/nolog sys$output my_uaf.log
+$ uaf modify 'user_ena'/flag=nodisuser/expiration='expiration_time'
+$ deassign/exec sys$output
+$ deassign/exec sys$error
+$ call status_&_closure
+$ goto initial_menu
+$!
+$disable_account:
+$!
+$ call make_a_border
+$ say "[4;25H[1mDisable an account[0m"
+$ask_for_user_disa:
+$ read/prompt="[6;10HEnter username [max 12 crt] ? " -
+sys$command user_disa
+$ if user_disa .eqs. "" then goto ask_for_user_disa
+$ read/prompt="[8;10HEnter again to verify: " -
+sys$command username_verify
+$ if username_verify .nes. user_disa
+$ then
+$ say "[10;10H[?25l[1m" + -
+"Verify error, try again...[0m"
+$ wait 00:00:01
+$ say "[6;10H " + -
+" "
+$ say "[8;10H " + -
+" "
+$ say "[10;10H [?25h"
+$ goto ask_for_user_disa
+$ else
+$ say "[?25l"
+$ define/user sysuaf sys$system:sysuaf.dat
+$ define/exec/nolog sys$error _nl:
+$ define/exec/nolog sys$output my_uaf.log
+$ uaf modify 'user_disa'/flag=disuser
+$ deassign/exec sys$output
+$ deassign/exec sys$error
+$ call status_&_closure
+$ endif
+$ goto initial_menu
+$!
+$list_account:
+$!
+$ call make_a_border
+$ say "[4;25H[1mList one or all account[0m"
+$ask_for_output:
+$ read/prompt="[6;10Hdisplay (1 = screen, 2 = file): " -
+sys$command out_on
+$ if ((out_on .nes. "1") .and. (out_on .nes. "2")) then goto ask_for_output
+$ if out_on .eqs. "1" then out_on = "screen"
+$ if out_on .eqs. "2" then out_on = "file"
+$ask_for_how_many:
+$ read/prompt="[8;10HHow many account ? (1 = one, 2 = all): " -
+sys$command how_many
+$ if ((how_many .nes. "1") .and. (how_many .nes. "2")) then -
+goto ask_for_how_many
+$ if how_many .eqs. "1"
+$ then
+$ ask_for_user_list:
+$ read/prompt="[10;10HUsername of the account: " -
+sys$command user_list
+$ if user_list .eqs. "" then goto ask_for_user_list
+$ define/user sysuaf sys$system:sysuaf.dat
+$ define/exec/nolog sys$error _nl:
+$ define/exec/nolog sys$output _nl:
+$ uaf list/full 'user_list'
+$ deassign/exec sys$error
+$ deassign/exec sys$output
+$ if out_on .eqs. "screen"
+$ then
+$ say "[2J"
+$ type/page sysuaf.lis;
+$ set terminal/noecho
+$ read/prompt= -
+"[24;29H[7mPress return to continue[0m" -
+sys$command dummy
+$ set terminal/echo
+$ else
+$ print_file sysuaf.lis;
+$ endif
+$ else
+$ define/user sysuaf sys$system:sysuaf.dat
+$ define/exec/nolog sys$error _nl:
+$ define/exec/nolog sys$output _nl:
+$ uaf list/brief [*,*]
+$ deassign/exec sys$error
+$ deassign/exec sys$output
+$ if out_on .eqs. "screen"
+$ then
+$ say "[2J"
+$ set terminal/width=132
+$ type/page sysuaf.lis;
+$ set terminal/noecho
+$ read/prompt= -
+"[24;55H[7mPress return to continue[0m" -
+sys$command dummy
+$ set terminal/echo/width=80
+$ else
+$ print_file sysuaf.lis;
+$ endif
+$ endif
+$ delete sysuaf.lis;
+$ goto initial_menu
+$!
+$error:
+$ zot
+$ say "Procedure internal error:"
+$ say "status = ''$status'"
+$ say "severity = ''$severity'"
+$ wait 00:00:01
+$! logout/brief ! for captive account usage
+$ set control=(y,t) !ZZZZ
+$ exit $status !ZZZZ
+$!
+$exit:
+$ zot
+$nopriv_exit:
+$! logout/brief ! for captive account usage
+$ set control=(y,t) !ZZZZ
+$ exit !ZZZZ
+$!
+$make_a_border: subroutine
+$ zot
+$ say "[2;1H(0"
+$ say " lqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqk"
+$ say " x x"
+$ say " x x"
+$ say " x x"
+$ say " x x"
+$ say " x x"
+$ say " x x"
+$ say " x x"
+$ say " x x"
+$ say " x x"
+$ say " x x"
+$ say " x x"
+$ say " x x"
+$ say " x x"
+$ say " x x"
+$ say " x x"
+$ say " x x"
+$ say " x x"
+$ say " x x"
+$ say " mqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqj"
+$ say "(B"
+$!
+$ endsubroutine
+$!
+$status_&_closure: subroutine
+$!
+$ say done
+$ open/read out_string my_uaf.log
+$read_file:
+$ read/end=end_of_file/error=error out_string record
+$ say "[16;20H''record'"
+$ goto read_file
+$end_of_file:
+$ close/nolog out_string
+$ delete my_uaf.log;*
+$ say conditions
+$ set terminal/noecho
+$ read/prompt="[20;10H[?25hPress return to continue " -
+sys$command dummy
+$ set terminal/echo
+$!
+$ endsubroutine
+
+
+< FALLBACK.COM | Display_Link >
diff --git a/batch-log-vleanup-dcl b/batch-log-vleanup-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_YmF0Y2gtbG9nLXZsZWFudXAtZGNs
--- /dev/null
+++ b/batch-log-vleanup-dcl
@@ -0,0 +1,142 @@
+BATCH_LOG_FILE_CLEANUP.COM
+Robert Boyd, Monday April 04 2005 @ 05:51PM EDT
+$ vfl = f$verify(0.or.f$trnlnm("DEBUG$DCL"))
+$ set noon
+$!
+$! Clean up log file(s) for the currently executing batch job
+$!
+$! Parameters:
+$! p1 -- number of versions to keep if PURGE is executed (DEF=7)
+$! p2 -- maximum number of versions to allow to stay around.(DEF=10)
+$! p3 -- if supplied a delta time to use to purge before(No default)
+$!
+$! Side effects:
+$! Creates 3 global symbols JOB_ENTRY, JOB_LOG_FILE_NAME and JOB_NAME
+$! which can be used by the calling procedure.
+$!
+$! Author: Robert L. Boyd
+$!
+$! TARGET_INCLUDE = TOOLS_TARGETS.COM
+$!============================================================================
+$! Change History:
+$!============================================================================
+$! 27-Mar-2001 R.L. Boyd Add in log file discovery for SCHEDULE and
+$! other mode jobs when available.
+$!
+$ set noon
+$ semi = ";"
+$ this_job = "THIS_JOB"
+$ display_job = "DISPLAY_JOB"
+$ null = ""
+$ version = "version"
+$ if f$mode().nes."BATCH"
+$ then ! not batch, so what are we?
+$ if f$type(job_log_file_name).eqs.null
+$ then ! we may be in a SCHEDULER environment
+$ if f$type(nsched_outfile).nes.null
+$ then ! this is a SCHEDULE environment
+$ job_entry == "SCHEDULE:''nsched_jobnum'"
+$ job_log_file_name == nsched_outfile
+$ job_name == nsched_jobname
+$ log_file_name = job_log_file_name
+$ else ! this is not a SCHEDULE environment
+$ if f$search("TOOLS$DIR:PROCESS_PERMANENT_FILE.EXE;").nes.null
+$ then ! we can find out what SYS$OUTPUT is pointing to
+$ ppf = "$TOOLS$DIR:PROCESS_PERMANENT_FILE.EXE;"
+$ ppf sys$output
+$ job_entry == null
+$ job_log_file_name == PPF_ORG_FILE_NAME
+$ job_name == f$parse(job_log_file_name,,,"NAME")
+$ log_file_name = f$parse(job_log_file_name,job_name,"sys$Login:.log")
+$ job_log_file_name == log_file_name
+$ else ! we do not have an easy way to figure out anything ...punt
+$ goto EXIT
+$ endif ! we can/cannot find out
+$ endif ! SCHEDULE environment or not
+$ endif ! maybe a SCHEDULE environment
+$ else ! it is a batch job
+$!
+$ log_file_null = f$getqui(display_job,"JOB_LOG_NULL",,this_job)
+$ log_file_name = f$getqui(display_job,"LOG_SPECIFICATION",,this_job)
+$ job_entry == f$getqui(display_job,"ENTRY_NUMBER",,this_job)
+$ job_name == f$getqui(display_job,"JOB_NAME",,this_job)
+$ log_file_name = f$parse(log_file_name,job_name,"sys$Login:.log")
+$ job_log_file_name == log_file_name
+$!
+$ endif ! not batch, so what are we?
+$!
+$ logfile_keep_versions = 7
+$ logfile_max_versions = 10
+$ vms_max_version = 32767
+$ local_max_version = 20000
+$ if p1.nes.null then $ logfile_keep_versions = p1
+$ if p2.nes.null then $ logfile_max_versions = p2
+$ if p3.nes.null then $ purge_qualifier = "/CREATED/BEFORE="+p3
+$!
+$! Determine what the threshold is for resequencing from the bottom
+$!
+$ logfile_version_threshold = vms_max_version - (2*logfile_max_versions)
+$ logfile_local_version_threshold = local_max_version - (2*logfile_max_versions)
+$ if logfile_local_version_threshold .lt. logfile_version_threshold then -
+$ logfile_version_threshold = logfile_local_version_threshold
+$!
+$ if f$type(log_file_name).nes.""
+$ then ! we did find a log file name
+$ log_file_name = f$parse(semi,log_file_name)-semi
+$!
+$! Are there more versions than the allowed maximum for this logfile?
+$!
+$ if f$search(log_file_name+";-''logfile_max_versions'").nes.null then -
+$ purge 'log_file_name'/keep='logfile_keep_versions''purge_qualifier'
+$!
+$! What is the highest version number for this file?
+$!
+$ highest_version= f$parse(f$search(log_file_name+semi),,,version)-semi
+$if highest_version.nes.null
+$then ! a highest version does exist
+$if 'highest_version'.gt. logfile_version_threshold
+$then ! the last version number is too close to the highest supported version
+$ vfl = f$verify(01)
+$!
+$! find the lowest bracket of version numbers we can renumber to
+$!
+$ min_num = 0
+$ nx_num = 1
+$ clear_start = nx_num
+$START_SEARCH:
+$ if f$search(log_file_name+";''nx_num'") .nes. null
+$ then ! there is already a file with that version number
+$ nx_num = nx_num+1
+$ clear_start = nx_num
+$ goto START_SEARCH
+$ else ! there is no file at this number, extend the range until all clear
+$ nx_num = nx_num+1
+$ if nx_num-clear_start .lt. logfile_max_versions then $ goto START_SEARCH
+$ endif! already a file with that version number
+$ start_num = 1+nx_num
+$ write sys$output "Renumbering versions down, starting with version ",-
+nx_num-1
+$!
+$ min_num = clear_start
+$! nx_num = 1+nx_num
+$!
+$LOOP:
+$ nx_num = nx_num -1
+$ if nx_num .ge. min_num
+$ then ! do all the versions that might be around
+$ highest_version= f$parse(f$search(log_file_name+semi),,,version)-semi
+$ if 'highest_version' .ge. START_NUM
+$ then ! The version number is higher than the target range
+$ rename 'log_file_name';0 'log_file_name';'nx_num'/log
+$ goto LOOP
+$ endif ! outside of target range
+$ endif ! make sure all available versions are renumbered
+$ if f$type(vfl).nes.null then $ x = f$verify(vfl)
+$endif ! the highest version is too close to the maximum file version#
+$endif ! there is a highest version
+$endif
+$!
+$EXIT:
+$ exit ! 'f$verify(vfl)'
+$!
+$!Last Modified: 14-DEC-2004 18:55:11.79
diff --git a/batch-monitor-dcl b/batch-monitor-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_YmF0Y2gtbW9uaXRvci1kY2w=
--- /dev/null
+++ b/batch-monitor-dcl
@@ -0,0 +1,151 @@
+Batch Monitor (Perl script)
+Andrew Robert, Thursday August 05 2004 @ 11:04AM EDT
+#!perl
+#
+# Program: batch_monitor.pl
+# Author: Andrew Robert
+#
+
+#
+# By converting the process from DCL to Perl, the code:
+#
+# - eliminates the need to create, read and write from files.
+# - makes use of sed style line editing to remove unwanted text elements
+# - reduces the number of lexical function calls by parsing the array field elements which
+# already contain the information
+# - eliminates the need to parse the display based on string length because in-line tabs are used
+# - eliminates the need to calculate the cpu time because this is already a retreived array element
+# - reduces the number of hard faults and converts the operations to buffered I/O
+#
+# Function:
+#
+# Continuously scan for running batch jobs and display relevant information
+# for job monitoring
+#
+#
+
+
+
+
+# Variable and Array Definition Key:
+#
+# $nodename = host name
+# $pacer_status = Pacer Application Status Code
+# $timestamp = current time
+# @command = Array containing currently executing batch jobs
+# $jpid = Job process ID number
+# $jnum = Batch entry job number
+# $jstate = Batch entry execution state
+# $jpri = Job priority level
+# $cpu = CPU time consumed
+# $dio = Direct I/O activity of batch job
+# $qname = Execution queue batch entry is running in
+# $jname = Scheduler/Batch Entry name
+
+
+#
+# Set window width
+#
+
+
+system("set term/width=90");
+system("set process/priority=2");
+my $nodename = FORCE;
+
+
+#
+# Endless loop to run monitor
+#
+
+
+while (1)
+{
+
+
+#
+# Display header
+#
+
+
+chomp($pacer_status=`write sys$output "''F$TRNLNM("STATUS_APPLICATION","LNM$FMC_G1_TABLE")'"`);
+chomp($timestamp = `write sys$output "''F$TIME()'"`);
+print "="x90,"n","Node: ",$nodename,"t"x2,"Time: ",$timestamp,"n","="x90,"n";
+print "PID"," "," "," Ent","t","Pr"," ","State"," ","CPU Time ","t",'I/O',"t","Queue","t"x2,"Job","n";
+
+
+#
+# Get list of currently running batch jobs
+#
+
+
+my @command = `PIPE SHOW SYS/B | SEARCH/NOWARN SYS$INPUT "BATCH"`;
+
+
+foreach (@command)
+{
+
+
+#
+# Compress white space in line using sed line editor and remove underscores
+#
+
+
+s/_/ /|s/ */ /g;
+
+
+#
+# Extract first three fields from buffer, discarding the rest
+#
+
+
+($jpid, $junk, $jnum, $jstate, $jpri, $testfield1, $testfield2, $testfield3, $testfield4)=split(" ",$_);
+
+
+#
+# Get Queue Name
+#
+
+
+chomp($qname = `write sys$output "''F$GETQUI("DISPLAY_ENTRY","QUEUE_NAME",$jnum)'"`);
+
+
+#
+# Get Job Name
+#
+
+
+chomp($jname=`write sys$output "''F$GETQUI("DISPLAY_ENTRY","JOB_NAME",$jnum)'"`);
+
+
+#
+# Parse CPU and Direct I/O fields based on process state
+#
+
+
+if ($jstate ne "LEF")
+{
+$cpu=$testfield4;
+chomp($dio=$testfield2);
+}
+else
+{
+$cpu=$testfield3;
+chomp($dio=$testfield1);
+}
+
+
+#
+# Write output to screen
+#
+
+
+
+
+print $jpid, " " , $jnum, "t" , $jpri, " ", $jstate, " ",$cpu,"t",$dio, "t",$qname,"t", $jname, "n";
+}
+
+
+print "n","="x90,"n","Waiting 15 secs...","n";
+sleep 15;
+}
+
diff --git a/batch_info-dcl b/batch_info-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_YmF0Y2hfaW5mby1kY2w=
--- /dev/null
+++ b/batch_info-dcl
@@ -0,0 +1,71 @@
+BATCH_INFO.COM
+Alan E. Feldman, Friday October 24 2003 @ 07:26PM EDT
+$!+ BATCH_INFO.COM v1.1-2
+$!
+$! AUTHOR: Alan E. Feldman
+$!
+$! PURPOSE: To get the PID of a batch job and use it in
+$! a SHOW PROCESS command and show other useful info.
+$!
+$! Parameters: P1 - Entry number. Qualifiers for the SHOW PROCESS
+$! command may be optionally appended.
+$! P2... - Qualifiers for SHOW PROC/ID=pid (optional)
+$!
+$! Example: $ BAT*CH_INFO :== @disk:[dir]BATCH_INFO.COM
+$!
+$! $ BAT 234/ACC/QUOT
+$! or
+$! $ BAT 234 /ACC /QUOT
+$!
+$!! Define status codes:
+$
+$ BATCH_INFO__STATUS = %X18008000
+$ BATCH_INFO__SUCCESS = BATCH_INFO__STATUS + %X0001
+$ BATCH_INFO__CONTROL_Y = BATCH_INFO__STATUS + %X000C
+$
+$!! Establish handlers:
+$
+$ STATUS = BATCH_INFO__SUCCESS
+$ ON CONTROL_Y THEN GOTO _CONTROL_Y
+$ ON WARNING THEN GOTO _ERROR
+$
+$ WSO := WRITE SYS$OUTPUT
+$
+$ P1ORIG = P1
+$ P1 = F$ELEMENT(0,"/",P1)
+$ P1END = P1ORIG - P1
+$
+$ SHOW ENTRY/FULL 'P1'
+$ BATCH_PID = F$GETQUI("DISPLAY_ENTRY","JOB_PID",P1)
+$ IF (BATCH_PID .EQS. "")
+$ THEN
+$ WSO " "
+$ WSO "No PID; job not running."
+$ GOTO _EXIT
+$ ENDIF
+$ WSO " "
+$ WSO "Process creation time: ",-
+F$CVTIME(F$GETJPI(BATCH_PID,"LOGINTIM"))
+$ WSO "Current image: ''F$GETJPI(BATCH_PID,"IMAGNAME")'"
+$ SHOW PROCESS -
+/ID='BATCH_PID' 'P1END' 'P2' 'P3' 'P4' 'P5' 'P6' 'P7' 'P8'
+$ WSO " "
+$ SHOW SYSTEM/BATCH/OUTPUT=SYS$SCRATCH:AEFBAT.AEFTMP
+$ SEARCH /NOHIGHLIGHT SYS$SCRATCH:AEFBAT.AEFTMP -
+'BATCH_PID',"on node","Process Name"/EXACT
+$ GOTO _EXIT
+$
+$_CONTROL_Y:
+$ STATUS = BATCH_INFO__CONTROL_Y
+$ GOTO _EXIT
+$
+$_ERROR:
+$ STATUS = $STATUS
+$ GOTO _EXIT
+$
+$_EXIT:
+$ SET NOON
+$ IF (F$SEARCH("SYS$SCRATCH:AEFBAT.AEFTMP").NES."") THEN -
+DELETE/NOLOG SYS$SCRATCH:AEFBAT.AEFTMP;*
+$ WSO " "
+$ EXIT STATUS .OR. %X10000000
diff --git a/bgprocess-dcl b/bgprocess-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_Ymdwcm9jZXNzLWRjbA==
--- /dev/null
+++ b/bgprocess-dcl
@@ -0,0 +1,70 @@
+BG_PROCESS
+labadie, Tuesday December 02 2008 @ 05:20AM EST
+This procedure needs three files
+
+1) bg.com
+
+$ if P1.eqs."MON" then goto mon
+$ ! test the pid exists
+$ set mess/nofac/nosev/noide/notext
+$ show proc/ide='p1 /out=nla0:
+$ if .not. '$status then exit
+$ set mess/fac/sev/ide/text
+$ self=f$parse(";",f$environment("procedure"))
+$ awk :== $ sys$common:[syshlp.examples.tcpip.snmp]gawk.exe
+$ create/fdl=sys$input tcpip.ref
+record
+format stream
+$ pipe write sys$output " show proc/id=''P1'/chan " | -
+ana/sys | awk/input=bg.awk sys$pipe | @'self' MON
+$ exit
+$ mon: open/read in sys$pipe:
+$ Loop: read/end=fin in line
+$ call bg 'line
+$ goto loop
+$ fin: if f$trnlnm("in").nes."" then close/nolog in
+$ if f$search("tcpip.*").nes.""
+$ then
+$ deletee/nolog/noconf tcpip.out;*,tcpip.ref;*
+$ endif
+$ exit
+$ bg: subroutine
+$ copy tcpip.ref tcpip.out;
+$ def/user sys$output tcpip.out
+$ ucx sh dev/fu 'P1
+$ awk/input=bg2.awk/var="bg=''P1'" tcpip.out
+$ endsubroutine
+$ exit
+2) bg.awk
+
+$NF ~ /BG[0-9]+:/ {print $NF}
+3) bg2.awk
+
+BEGIN { print "n" ; printf "%-7s %-8s %-14s %-14sn","device ", bg," received"," sent " ; ioc="I/O completed" ; ior="Bytes transferred"} { if (/Bytes/) { printf "%-13s %14d %14d",ior,$(NF-1),$NF } } { if (/I/O completed/) { printf "%-17s %14d %14dn",ioc, $(NF-1),$NF } }
+Then submit the procedure by passing a pid as P1, for example
+
+$ @bg 204002B4
+which may display something like
+
+device BG4928: received sent
+I/O completed 2619 199
+Bytes transferred 254287 12631
+
+device BG4935: received sent
+I/O completed 659 317
+Bytes transferred 58496 26508
+
+
+device BG4941: received sent
+I/O completed 37 18
+Bytes transferred 5751 843
+
+
+
+It can happen that the procedure displays a BG device with no statistics and a message, such as
+
+%TCPIP-W-NODEVSOCK, device_socket not found
+
+device BG3934: received sent
+
+It is possible to hide it, but I am not convinced it is a good idea.
\ No newline at end of file
diff --git a/bgstats-dcl b/bgstats-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_YmdzdGF0cy1kY2w=
--- /dev/null
+++ b/bgstats-dcl
@@ -0,0 +1,53 @@
+bg_stats
+Labadie, Monday June 04 2007 @ 08:39AM EDT
+Create a file a.awk:
+
+BEGIN
+{ while ("sh dev bg/full" | getline ) {
+if (/^Device/) {split ($2,x,":"); bg=x[1] }
+if (/UIC/) {split ($0,x,"""); prcnam[bg]=x[2] }
+if (/Owner process ID/) { pid[bg]=$4 ; bg="X" }
+}
+print("device | pid | processname | typ | locp| remp| local host | remote host | bytes rec| bytes sen| I/O rec |
+I/O sen |")
+}
+/Device_socket/ {dev=toupper($2); typ=$4 }
+/Port:/ {plocal=$(NF-1); pdist=$NF }
+/Host:/ {hlocal = 0 ; hdist = 0 ; hlocal=$2; hdist=$3 }
+/O completed/ {iot=$(NF-1); ior=$NF }
+/Bytes transferred/ {byt = 0 ; byt=$3 ; byr= 0 ; byr=$4 ;
+
+bg =dev ;
+
+
+printf("%-7s,%8s,%15s,%6s,%5d,%5d,%15s,%15s,%10d,%10d,%10d,%10dn",dev,pid[bg],prcnam[bg],typ,plocal,pdist,hlocal,hd
+ist,byt,byr,iot,ior)}
+
+
+{
+print("device | pid | processname | typ | locp| remp| local host | remote host | bytes rec| bytes sen| I/O rec |
+I/O sen |")
+print("_____________________________________________________________________________________________________________________
+__________")
+}
+
+Then create a file a.com, containing the following:
+
+$ fntmp:== "sys$scratch:temp_xxx.tmp"
+$ gawk :== $ sys$common:[syshlp.examples.tcpip.snmp]gawk
+$ create/fdl=sys$input tcpip.out
+record
+format stream
+$ def/user sys$output tcpip.out
+$ ucx sh dev/fu
+$ pipe sea tcpip.out "Device_socket","Bytes t",Service,Host,port,completed | gawk /INPUT=bbb.awk sys$pipe /output='fntmp'
+$ statbyr :== SORT/KEY=(POS:84,SIZE:10)/NODUP a.tmp SYS$OUTPUT
+$ statbyr
+$ statbys :== SORT/KEY=(POS:95,SIZE:10)/NODUP a.tmp SYS$OUTPUT
+$ statbys
+$ statior :== SORT/KEY=(POS:106,SIZE:10)/NODUP a.tmp sys$output
+$ statior
+$ statios :== SORT/KEY=(POS:117,SIZE:10)/NODUP a.tmp sys$output
+$ statios
+$ delete/nolog/noconf 'fntmp';
+$ delete/nolog/noconf tcpip.out;
diff --git a/calendar-dcl b/calendar-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_Y2FsZW5kYXItZGNs
--- /dev/null
+++ b/calendar-dcl
@@ -0,0 +1,55 @@
+Calendar
+Aaron, Thursday December 02 2004 @ 04:34PM EST
+$! Calendar
+$! by ACSakovich, 01-Dec-2004
+$! Usage:
+$! @Calendar {Mon{-Year}}
+$! Output:
+$! A calendar of the specified month, or if none specified, the
+$! current month.
+$! Restrictions:
+$! Month must be the first 3 letters of the English Month. This
+$! may be customized through the "MonthMap" variable, if desired.
+$! Year must be in the valid OpenVMS range of 1858 to 9999.
+$
+$ if p1 .eqs. ""
+$ then
+$ Spec = "Today"
+$ else
+$ Spec = "1-" + p1
+$ endif
+$ WeekMap = "Sunday Monday Tuesday WednesdayThursday Friday Saturday"
+$ MonthMap = "JanFebMarAprMayJunJulAugSepOctNovDec"
+$ on Warning then Goto SpecErr
+$ Month = f$extr((f$cvt(Spec,,"Month")-1)*3,3,MonthMap)
+$ set NoOn
+$ Year = f$cvt(Spec,,"Year")
+$ DayOfWeek = f$loc(f$cvt("1-''Month'-''Year'",,"WeekDay"),WeekMap)/9
+$ FDay = f$cvt("1-''Month'-''Year'-''DayOfWeek'-",,"Day")
+$ FMonth = f$extr((f$cvt("1-''Month'-''Year'-''DayOfWeek'-",,"Month")-1)*3,3,MonthMap)
+$ FYear = f$cvt("1-''Month'-''Year'-''DayOfWeek'-",,"Year")
+$ FDate = FDay + "-" + FMonth + "-" + FYear
+$ write sys$output f$fao("!3AS!13* !4AS",Month,Year)
+$ write sys$output "Su Mo Tu We Th Fr Sa"
+$ Week = 0
+$ DOC = 0
+$ WLoop:
+$ DOW = 0
+$ DLoop:
+$ Date'DOW' = f$cvt("''FDate'+''DOC'-",,"Day")
+$ if Week .lt. 1 .and. Date'DOW' .gt. "07" then Date'DOW' = " "
+$ if Week .gt. 3 .and. Date'DOW' .lt. "14" then Date'DOW' = " "
+$ DOC = DOC + 1
+$ DOW = DOW + 1
+$ if DOW .lt. 7 then goto DLoop
+$ write sys$output f$fao("!2AS !2AS !2AS !2AS !2AS !2AS !2AS", -
+Date0,Date1,Date2,Date3,Date4,Date5,Date6)
+$ Week = Week + 1
+$ if Week .le. 5 then goto WLoop
+$ goto CommonExit
+$ SpecErr:
+$ write sys$output "Error processing ''p1'; month requested must be of the form MON or MON-YYYY"
+$ write sys$output "e.g., Dec-2004 or just DEC. Years must be in the valid OpenVMS time range,"
+$ write sys$output "from 1858 to 9999."
+$ CommonExit:
+$ exit
diff --git a/capture-firewall-logs-dcl b/capture-firewall-logs-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_Y2FwdHVyZS1maXJld2FsbC1sb2dzLWRjbA==
--- /dev/null
+++ b/capture-firewall-logs-dcl
@@ -0,0 +1,26 @@
+Capture_Firewall_Log.com
+Aaron, Tuesday June 24 2003 @ 11:58PM EDT
+The following are two command procedures that are used to capture SNMP traps from a LinkSys firewall to a log file.
+
+First, you must create a directory to place these procedures and logs in; in this example, let's assume it's the Disk$User0:[TCP$SNMPlog] directory. Assuming that you're running TCP/IP Services, you'll also need to copy an existing TCP/IP service account (e.g., TCPIP$SMTP) to a new account named TCP$SNMPLOG, using a new UIC, device, and directory also.
+
+On your LinkSys box, enable SNMP traps to be sent to your network by clicking on Logs and Enable (NB: this broadcasts the traps to your entire LAN.)
+
+Move the two attached files into that directory and run the Logger$Startup.com file to launch a detached process that will watch for incoming SNMP traps from the firewall, logging them immediately to your logfile.
+
+Logger$Startup.com
+$ Run /Detach -
+Sys$System:Loginout.exe -
+/Input=Disk$User0:[TCP$SNMPlog]Capture_Firewall_Log.com -
+/Output=Disk$User0:[TCP$SNMPlog]Capture_Firewall.log -
+/Process_Name="SNMP Logger" -
+/Priority=3 -
+/UIC=[TCP$SNMPlog]
+Capture_Firewall_Log.com
+$ set nover
+$ @sys$manager:tcpip$define_commands
+$ loop:
+$ pipe snmp_traprcv | search sys$input "@out","@in" /match=or | -
+(read sys$input trap ; -
+write sys$output f$fao("!AS - !AS",f$time(),f$element(1,"@",trap)))
+$ goto loop
diff --git a/capture-reply-dcl b/capture-reply-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_Y2FwdHVyZS1yZXBseS1kY2w=
--- /dev/null
+++ b/capture-reply-dcl
@@ -0,0 +1,62 @@
+CAPTURE_REPLY.COM
+Robert Boyd, Monday June 25 2007 @ 05:30PM EDT
+$! capture_reply.com -- capture the output from the REPLY/TO command
+$! p1 -- operator to make request to , DEF=CENTRAL
+$! p2 -- message text, no default
+$! p3 -- Global Symbol to put reply text into, DEF=OPERATOR_REPLY
+$! p4 -- Global Symbol to put the reply time into, DEF=OPERATOR_TIME
+$! p5 -- Global Symbol to put the reply username into, DEF=OPERATOR_TERMINAL
+$! p6 -- if present, and = "S" then p2 is a symbol with the message string
+$! in it. It is copied from the symbol
+$ vfl = f$ver(0)
+$ set noon
+$ status = $status
+$ null = ""
+$ comma = ","
+$ crlf = f$fao("!/")
+$ cr = f$ext(0,1,crlf)
+$ lf = f$ext(1,1,crlf)
+$ show sym crlf
+$ operator = p1
+$ if operator.eqs.null then $ operator = "CENTRAL"
+$ if f$edit(f$ext(0,1,p6),"upcase").eqs."S" then $ p2 = 'p2'
+$ message = p2
+$ if message.eqs.null then $ goto ERR_NOMESSAGE
+$ reply_sym = p3
+$ if reply_sym.eqs.null then $ reply_sym = "OPERATOR_REPLY"
+$ time_sym = p4
+$ if time_sym.eqs.null then $ time_sym = "OPERATOR_TIME"
+$ name_sym = p5
+$ if name_sym.eqs.null then $ name_sym = "OPERATOR_TERMINAL"
+$ tmp_file = "sys$login:reply_"+(f$cvtime()-" "-":"-":"-".")+".tmp"
+$ if vfl then $ show sym tmp_file
+$ define/user sys$output 'tmp_file'
+$ request/reply/to=('operator') "''message'"
+$ status = $status
+$ if f$trnlnm("message_file","lnm$process").nes.null then $ close message_file
+$ open/read/error=ERR_FILE message_file 'tmp_file'
+$ read/end=ERR_FILE message_file header
+$ read/end=ERR_FILE message_file reply_text
+$ show sym header
+$ show sym reply_text
+$ close message_file
+$ 'reply_sym' == f$element(1,lf,f$element(1,cr,reply_text))
+$ note_field == f$element(2,lf,reply_text)
+$ 'time_sym' == f$element(0,comma,note_field)
+$ 'name_sym' == f$extract(9+f$locate("operator",note_field),999,note_field)
+$EXIT:
+$ if f$trnlnm("message_file","lnm$process").nes.null then $ close message_file
+$ delete 'tmp_file';*/nolog
+$ if vfl then $ show sym 'reply_sym'
+$ if vfl then $ show sym 'time_sym'
+$ if vfl then $ show sym 'name_sym'
+$ exit status ! 'f$ver(vfl)'
+$ERR_NOMESSAGE:
+$ STATUS == "%X100381F4"
+$ say "CAPTURE-E-ABSENT, missing message text: P2"
+$ goto EXIT
+$ERR_FILE:
+$ status == $status
+$ say "CAPTURE-E-FILE, error handling message file"
+$ goto EXIT
+$!Last Modified: 26-AUG-1987 13:38:09.69, By: RLB
diff --git a/cd-dcl b/cd-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_Y2QtZGNs
--- /dev/null
+++ b/cd-dcl
@@ -0,0 +1,147 @@
+cd.com (set default like a pc!)
+Jerrold Schiff, Tuesday June 26 2007 @ 08:02PM EDT
+$! set noverify oct 10 1995 CD.COM
+$! allow logicals ie: cd cds
+$! inputs cd p1 p2
+$! where cd is the symbol set up in your login as cd :== @cd.com
+$! example: cd .a (set def [.a])
+$! p2 is used to show the files" cd .a x (any char)
+$! if directory not entered, check if logical entered and use it
+$!
+$ if p1 .eqs. ".." ! set up one level - just like pc dos
+$ then set def [-]
+$ goto SHOW_DEFAULT
+$ endif
+$ ! check to go down one level - cd .down
+$ assume_flag = "N" ! must track if logical+directory exists
+$ set_disk = ""
+$ got_a_dot = 0
+$ save_dir = f$environment("default")
+$ if p1 .eqs. "" then goto SHOW_DEFAULT
+$ dot = f$extract(0,1,p1)
+$ if dot .eqs. "."
+$ then dotplus = f$extract(1,1,p1)
+$ if dotplus .eqs. "" ! if just dot entered, go down to what?
+$ then write sys$output " supply lower directory"
+$ goto SHOW_DEFAULT
+$ else goto GO_DOWN
+$ endif
+$ endif
+$ if f$locate(":",p1) .ne. f$length(p1) then goto GOT_COLON
+$ bracket = f$extract(0,1,p1)
+$ if bracket .eqs. "[" ! did they enter brackets?
+$ then p3 = p1
+$ else p3 = "[''p1]"
+$ endif
+$ goto TEST_DEFAULT
+$!
+$GOT_COLON: ! means you are dealing with a disk or node notation
+$ found_colon = f$locate(":",p1) + 2 ! ignore colon
+$ set_disk = f$extract(0,found_colon,p1)
+$ p3 = p1
+$ goto TEST_DEFAULT
+$!
+$GO_DOWN:
+$ total_length = f$length(save_dir)
+$ total_length = total_length - 1
+$ first_part = f$extract(0,total_length,save_dir)
+$ p3 = ''first_part + ''p1 + "]"
+$!
+$TEST_DEFAULT:
+$ on warning then goto RESTORE_DIR
+$ on error then goto RESTORE_DIR
+$ test_directory = p3
+$! write sys$output "Looking for: ''test_directory'"
+$ search_dir = f$search("''p3*.*") ! do files exist in this dir?
+$ if search_dir .eqs. "" then goto CHECK_IF_DIR ! if not, check if dir exists
+$ set default 'p3
+$ goto SHOW_DEFAULT
+$!
+$CHECK_IF_DIR:
+$! write sys$output " No files found - determine if directory exists:"
+$ ! remove up to the first bracket
+$ bracket = f$locate("[",p3) + 1
+$ sub_length = f$length(p3) - bracket - 1
+$ next_part = f$extract(bracket,sub_length,p3)
+$! extract a "." if found
+$!
+$STILL_DOT:
+$ dot = f$locate(".",next_part)
+$ total_length = f$length(next_part)
+$ if dot .eq. total_length then goto GOT_DIR
+$ got_a_dot = 1
+$ dot = f$locate(".",next_part) + 1
+$ sub_length = f$length(next_part) - dot
+$ next1_part = f$extract(dot,sub_length,next_part)
+$ next_part = next1_part
+$ goto STILL_DOT
+$!
+$GOT_DIR:
+$ if got_a_dot .eq. 0
+$ then p4 = set_disk + "000000]" + next_part + ".dir"
+$ if f$search(''p4) .eqs. ""
+$ then goto DIR_NOT_FOUND
+$ else set default 'p3
+$ goto SHOW_DEFAULT
+$ endif
+$ else
+$ dot_part = "." + next_part + "]"
+$ locate_upper_dir = f$locate(''dot_part,p3)
+$ upper_dir = f$extract(0,locate_upper_dir,p3) + "]" + -
+next_part + ".dir"
+$ if f$search(''upper_dir) .eqs. ""
+$ then goto DIR_NOT_FOUND
+$ else set default 'p3
+$ goto SHOW_DEFAULT
+$ endif
+$ endif
+$ exit
+$!
+$DIR_NOT_FOUND:
+$ if assume_flag .eqs. "Y"
+$ then
+$ write sys$output " Directory/Logical can not be resolved "
+$ show default
+$ write sys$output " Return to current directory"
+$ set def 'save_dir
+$ exit
+$ endif
+$!
+$ASSUME_LOGICAL:
+$ save_status = f$trnlnm("''p1'")
+$ if ("''save_status'" .eqs. "")
+$ then
+$ write sys$output " Logical dosen't exist - returning to current directory"
+$ p3 = f$environment("default")
+$ else
+$ set def 'p1
+$ p3 = f$environment("default") ! set p3 to be new directory
+$ assume_flag = "Y"
+$ endif
+$ goto TEST_DEFAULT
+$!
+$RESTORE_DIR:
+$ set def 'save_dir
+$!
+$SHOW_DEFAULT: ! change prompt to include day/date/directory
+$ if p2 .nes "" then dir
+$ save_dir = f$environment("default")
+$ found_colon = f$locate(":",save_dir) + 2
+$ total_length = f$length(save_dir) - 1
+$ for_prompt = f$extract(found_colon,total_length - found_colon,save_dir)
+$ dow_day = f$cvtime("today",,"weekday")
+$ dow_day = f$extract(0,3,dow_day)
+$ num_day = f$cvtime("today",,"day")
+$ if f$locate("0",num_day) .eq. 0 then num_day = f$extract(1,2,num_day)
+$ for_prompt = dow_day + " " + num_day + " " + for_prompt
+$ total_length = f$length(for_prompt)
+$ if total_length .gt. 30
+$ then
+$ for_prompt = f$extract(0,13,for_prompt) + "..." + -
+f$extract(total_length - 13,total_length,for_prompt)
+$ set prompt = "''for_prompt'> "
+$ else
+$ set prompt = "''for_prompt'> "
+$ endif
+$!
+$ exit
diff --git a/cde-dcl b/cde-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_Y2RlLWRjbA==
--- /dev/null
+++ b/cde-dcl
@@ -0,0 +1,9 @@
+CDE, beep off by default; and other features
+Henry G. Juengst, Tuesday May 25 2004 @ 08:57PM EDT
+The DCL procedure CDE$SYSTEM_COMMON:[BIN]XSESSION.COM is part of CDE. It searches for command files in the directories CDE$USER_DEFAULTS:[CONFIG.XSESSION_D] and CDE$SYSTEM_DEFAULTS:[CONFIG.XSESSION_D] in alphabetic order and executes them. System managers can store their own command files in the second directory, while users may use the first one. There is no need to add complicated checks in e.g. SYLOGIN and hacks in command files of the standard distribution are not needed either (they tend to disappear with the next update anyway ;-) . For example, a simple command file called CDE$SYSTEM_DEFAULTS:[CONFIG.XSESSION_D]XSET.COM can be used to turn off the beeper:
+
+$ MCR DECW$UTILS:XSET B 0
+Peace.
+
+The protection of the directory and command files have to be allow READ and/or EXECUTE access for "world". The owner should be SYSTEM.
+
diff --git a/check-compression-dcl b/check-compression-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_Y2hlY2stY29tcHJlc3Npb24tZGNs
--- /dev/null
+++ b/check-compression-dcl
@@ -0,0 +1,152 @@
+check_compression.com
+Peter Barkas, Tuesday April 05 2005 @ 08:18AM EDT
+$ say:==write sys$output
+$ minsiz=1000
+$ dat_file_spec="allport$application:*.dat;" ! *** Your file spec here ***
+$ !
+$ say f$getsyi("nodename"),"::",f$env("procedure")," ",f$ext(0,17,f$time())
+$ say "--------------------------------------------------------------------------------"
+$ say "Checks indexed files acf and ''dat_file_spec' >= ''minsiz' blocks"
+$ say "The following anomalies are reported:"
+$ say ""
+$ say "1. Generally it is not a good idea to use index compression"
+$ say "2. A negative key compression % indicates that compression should be turned off"
+$ say "3. Primary keys that allow duplicates are not usually a good idea"
+$ say ""
+$ dat_files="allport$global:acf.dat" ! *** Your file spec here ***
+$ gosub process_files
+$ dat_files=dat_file_spec
+$ gosub process_files
+$ exit
+$ !
+$process_files:
+$ prev_dat_file=""
+$ !
+$next_file:
+$ set noon
+$ dat_file=f$sea(dat_files)
+$ if dat_file.eqs."".or.dat_file.eqs.prev_dat_file
+$ then
+$ return
+$ endif
+$ prev_dat_file=dat_file
+$ org=f$file(dat_file,"org")
+$ if org.nes."IDX"
+$ then
+$ goto next_file
+$ endif
+$ dat_file_size=f$file(dat_file,"eof")
+$ if dat_file_size.lt.minsiz
+$ then
+$ goto next_file
+$ endif
+$ call analyse_file
+$ goto next_file
+$ !
+$analyse_file: subroutine
+$ say ""
+$ say "Analysing ",dat_file," (",dat_file_size," blocks)"
+$ on error then goto analyse_error
+$ def/user sys$error nl:
+$ def/user sys$output nl:
+$ fdl_file=f$par(dat_file,,,"name")+"_fdl.tmp"
+$ ana/rms/fdl/out='fdl_file' 'dat_file'
+$ set noon
+$ goto process_fdl
+$ !
+$analyse_error:
+$ say "Can't analyse ",dat_file
+$ goto end_analyse_file
+$ !
+$process_fdl:
+$ open fdl_ch 'fdl_file'
+$ !
+$next_key:
+$ read fdl_ch fdl_line
+$ if f$ext(0,8,fdl_line).eqs."ANALYSIS"
+$ then
+$ goto next_key_analysis
+$ endif
+$ if f$ext(0,4,fdl_line).nes."KEY "
+$ then
+$ goto next_key
+$ endif
+$ keynum=f$int(f$ext(4,1,fdl_line))
+$ read fdl_ch fdl_line ! Change
+$ read fdl_ch fdl_line ! Data_key_compression
+$ if keynum.eq.0
+$ then
+$ read fdl_ch fdl_line ! Data_record_compression
+$ endif
+$ read fdl_ch fdl_line ! Data_area
+$ read fdl_ch fdl_line ! Data_fill
+$ read fdl_ch fdl_line ! Duplicates
+$ if keynum.eq.0
+$ then
+$ duplicates=f$ext(25,2,fdl_line)
+$ if duplicates.nes."no"
+$ then
+$ say ">>> Key ",keynum," has duplicates on"
+$ endif
+$ endif
+$ read fdl_ch fdl_line ! Index_area
+$ read fdl_ch fdl_line ! Index_compression
+$ compression=f$ext(25,2,fdl_line)
+$ if compression.nes."no"
+$ then
+$ say ">>> Key ",keynum," has Index_compression on"
+$ endif
+$ goto next_key
+$ !
+$next_key_analysis:
+$ read/end=end_fdl fdl_ch fdl_line
+$ if f$ext(0,15,fdl_line).nes."ANALYSIS_OF_KEY"
+$ then
+$ goto next_key_analysis
+$ endif
+$ keynum=f$int(f$ext(16,f$len(fdl_line)-16,fdl_line))
+$ read fdl_ch fdl_line ! Data fill
+$ if f$ext(0,54,fdl_line).eqs." ! This index is uninitialized - there are no records."
+$ then
+$ say dat_file," is empty"
+$ goto end_fdl
+$ endif
+$ read fdl_ch fdl_line ! Data key compression
+$ keytype="Data key"
+$ call inspect_compression
+$ if keynum.eq.0
+$ then
+$ read fdl_ch fdl_line ! Data record compression
+$ keytype="Data record"
+$ call inspect_compression
+$ endif
+$ read fdl_ch fdl_line ! Data record count
+$ read fdl_ch fdl_line ! Data space occupied
+$ read fdl_ch fdl_line ! Depth
+$ if keynum.ne.0
+$ then
+$ read fdl_ch fdl_line ! Duplicates per SIDR
+$ endif
+$ read fdl_ch fdl_line ! Index compression
+$ keytype="Index"
+$ call inspect_compression
+$ goto next_key_analysis
+$ !
+$end_fdl:
+$ close fdl_ch
+$end_analyse_file:
+$ endsubroutine
+$ !
+$inspect_compression: subroutine
+$ comp_ratio=f$int(f$ext(25,3,fdl_line))
+$ if comp_ratio.lt.0
+$ then
+$ say ">>> key ",keynum," ",keytype," has negative compression ",comp_ratio
+$ endif
+$ endsubroutine
+$ !
+$ exit
+$ !
+$ ! PHB 09-Dec-2004
+$ ! Check indexed files for inappropriate compression settings
+$ !
diff --git a/chkbat-dcl b/chkbat-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_Y2hrYmF0LWRjbA==
--- /dev/null
+++ b/chkbat-dcl
@@ -0,0 +1,96 @@
+CHKBAT
+Ralf Gärtner, Tuesday June 29 2004 @ 05:26AM EDT
+$!+++
+$!
+$_CHKBAT: Subroutine
+$!
+$! Purpose: Get the file name and check the version number of a batch
+$! logfile. If the version no. exceeds the value given by
+$! LOG_FILE_VERSION_LIMIT, an error status will be returned.
+$!
+$! The logfile name will always be returned.
+$!
+$! Usage: if f$mode() .eqs. "BATCH" then call _CHKBAT
+$!
+$! Parameter: P1 , optional, shows the local symbols during testing
+$!
+$! Return values: chkbat_filnam , full logfile name
+$! chkbat_status = 1 , no error
+$! = 2 , version limit exceeds
+$! LOG_FILE_VERSION_LIMIT
+$!
+$! 29.5.2000 Ralf Gärtner
+$! ??.6.2004 Ralf Gärtner
+$!---
+$
+$ if f$mode() .eqs. "BATCH"
+$ then
+$ set noon
+$
+$ chkbat_status == %X00000001 ! %SYSTEM-S-NORMAL
+$ chkbat_filnam == ""
+$
+$ if P1 .nes. "" then set verify ! Debug statement
+$ this_node = f$getsyi("NODENAME")
+$ say := write sys$output
+$
+$ ! define the version limmit
+$ LOG_FILE_VERSION_LIMIT = 30000 ! max. version = 32767
+$
+$ tmp = f$getqui("CANCEL_OPERATION")
+$
+$ ! set the default values of a batch job
+$ dflt_dev = f$parse(f$trnlnm("SYS$LOGIN"),,,"DEVICE")
+$ dflt_dir = f$parse(f$trnlnm("SYS$LOGIN"),,,"DIRECTORY")
+$ dflt_nam = f$getqui("DISPLAY_ENTRY","JOB_NAME",,"THIS_JOB")
+$ dflt_typ = ".LOG"
+$
+$ if .not. f$getqui("DISPLAY_ENTRY","JOB_LOG_NULL",,"THIS_JOB")
+$ then ! /LOG qualifier
+$
+$ ! get the logfile name
+$ log_file = f$getqui("DISPLAY_ENTRY","LOG_SPECIFICATION",,"THIS_JOB")
+$ if P1 .nes. "" then show symbol log_file ! Debug statement
+$
+$ ! check the logfile specification;
+$ ! missing parts are set to the default values
+$ log_dev = f$parse(log_file,,,"DEVICE")
+$ log_dir = f$parse(log_file,,,"DIRECTORY")
+$ log_nam = f$parse(log_file,,,"NAME")
+$ log_typ = f$parse(log_file,,,"TYPE")
+$ log_ver = f$parse(log_file,,,"VERSION")
+$ if log_dev .eqs. "" then log_dev = dflt_dev
+$ if log_dir .eqs. "" then log_dir = dflt_dir
+$ if log_nam .eqs. "" then log_nam = dflt_nam
+$ if (log_typ .eqs. "") .or. (log_typ .eqs. ".") then log_typ = dflt_typ
+$ if log_ver .eqs. ";" then log_ver = ""
+$ log_file = log_dev + log_dir + log_nam + log_typ + log_ver
+$
+$ ! get the current version number
+$ log_file = log_file - f$parse(log_file,,,"VERSION","SYNTAX_ONLY") + ";0"
+$ log_file_version = f$parse(f$search(log_file),,,"VERSION") - ";"
+$ log_file_version = f$integer(log_file_version)
+$ log_file = log_file - ";0" + ";''log_file_version'"
+$
+$ ! return the logfile name without concealed device specification
+$ chkbat_filnam == log_file - "]["
+$
+$ ! check the limit
+$ if log_file_version .gt. LOG_FILE_VERSION_LIMIT
+$ then ! limit exceeded, display a message
+$ ! request /to=cluster "''f$fao("%LOG-W-VERSION, high file version of batch log !AS", log_file)'"
+$ chkbat_status == %X00000002
+$ endif
+$
+$ endif
+$
+$ endif
+$
+$ if P1 .nes. "" then show symbol /local /all ! Debug statement
+$ if P1 .nes. "" then set noverify ! Debug statement
+$
+$ Exit
+$ Endsubroutine
+
+
+< MAKEUP.COM | UNIX_to_VMS.com >
diff --git a/clas-dcl b/clas-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_Y2xhcy1kY2w=
--- /dev/null
+++ b/clas-dcl
@@ -0,0 +1,681 @@
+CLAS$PATCH_WORK_C.COM and CLAS$PATCH_WORK_FORTRAN.COM
+Henry G. Juengst, Monday December 22 2003 @ 03:32PM EST
+Below are two procedures which help to adapt unix Fortran code quickly so that you can start to use it. The long term solution of course is to fix the code.
+OpenVMS provides calling standard which allows us to develop source code in various languages (not counting Java as a useful programming language). Unix does not define such a standard (Posix and System V definitions do not address this issue the way VMS does).
+
+Most notorious are games with leading and trailing underscore characters ("_") in unix software environments. Various unix derivatives use them to separate assembler, C and other code, a most unsatisfying and stupid approach. This is not only system specific, but also compiler specific. Some compilers also add dollar characters.
+
+The other critical issue is the way how character strings are passed by unix Fortran compilers. The problem is that unix in its primitive form has no definition of a descriptor. VMS does. While there is again no standard, most unix compilers pass the address of a character string at the position of the actual procedure argument and append the missing string length to the end of the argument list. This is not only ambiguous, but also not VMS compatible and certainly hidden arguments are unsatisfying.
+
+The two procedures listed below help me to address both issues on a temporary basis.
+
+Unfortunately some unexperienced unix users also use case sensitive identifiers to distinguish between e.g. Fortran and C style arguments. For example in Fortran (and many other languages) arguments are passed by reference, while in C scalar data are typically passed by value. Things get really difficult when unix users write a C "wrapper" routine with the same name of an existing Fortran routine, but with the name in lower case and all or some argument passing mechanisms changed. Obviously this is not too helpful when dealing with case _insensitive_ identifiers from various non-C languages in a VMS environment. I do not fix these problems with an automatic procedure, because in my experience this always needs to be fixed by an understanding VMS software developer. Since this issue only appears in C code I often put the fix into a C header file.
+
+The idea behind the two procedures below is to produce a C header file to fix the C code. One common patch header file includes the project specific header files, each project specific header file includes project specific fixes (see last mentioned problem category) and also includes the C and Fortran header files produced by the two DCL procedures below.
+
+The procedures expect each one text file. The text files contain the names of the procedures which need to be fixed. List one procedure name per line. For example if your project name is DC, then a you may have these two files in your DC project directory:
+
+(DC$PATCH_WORK_C.TXT)
+
+DC_MAKE_DGEO
+TESTMAP
+DC_READ_MAP_FLOAT FUNCTION 5 2 3
+DC_READ_MAP_INT FUNCTION 5 2 3
+DC_XVST_FCT
+(DC$PATCH_WORK_FORTRAN.TXT)
+
+DC_SET_DEF
+DC_TCL_INIT
+DDLY2DC_CAL_TDLY
+Then you call CLAS$PATCH_WORK_C and CLAS$PATCH_WORK_FORTRAN from a common tool directory. BTW CLAS is the name of the big all-embracing project, while DC etc. are just componets of CLAS. In the command files below you will find logical names like CLAS$SCRATCH_PATCH_WORK and CLAS$INCLUDE. You may want to change the prefix of those names.
+
+The first argument in *$PATCH_WORK_C.TXT indicates whether a procedure is a FUNCTION or SUBROUTINE. The following numbers in *$PATCH_WORK_C.TXT indicate the total number of arguments of a routine and the position of character string arguments.
+
+The two procedures only update one header file each and only when necessary. I suggest to run the procedures in an MMS description file as action of the .FIRST target so that the header files are produced before any other source code is being compiled.
+
+Here are the two DCL procedures CLAS$PATCH_WORK_C.COM and CLAS$PATCH_WORK_FORTRAN.COM ... I hope they help other people to get started with alien unix hacks.
+
+$!CLAS$PATCH_WORK_C.COM
+$IF P1.EQS.""
+$THEN
+$ MY_LIBRARY_FILE_SPEC=F$SEARCH("*$PATCH_WORK_C.TXT")
+$ IF MY_LIBRARY_FILE_SPEC.EQS.""
+$ THEN
+$ WRITE SYS$ERROR "Missing *$PATCH_WORK_C.TXT"
+$ EXIT
+$ ENDIF
+$ MY_LIBRARY=F$PARSE(MY_LIBRARY_FILE_SPEC,,,"NAME",)-"$PATCH_WORK_C"
+$ELSE
+$ MY_LIBRARY=P1
+$ENDIF
+$
+$OPEN/READ MY_LIST_FCB 'MY_LIBRARY'$PATCH_WORK_C.TXT
+$OPEN/WRITE MY_PATCH_C_FCB CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_C_'F$GETJPI("","PID")'.C
+$OPEN/WRITE MY_PATCH_H_FCB CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_C_'F$GETJPI("","PID")'.H
+$WRITE MY_PATCH_C_FCB "#include "
+$WRITE MY_PATCH_H_FCB "#ifndef ''MY_LIBRARY'$PATCH_WORK_C_H"
+$WRITE MY_PATCH_H_FCB "#define ''MY_LIBRARY'$PATCH_WORK_C_H"
+$WRITE MY_PATCH_H_FCB "#ifdef VMS"
+$LIST_LOOP:
+$READ/END=LIST_DONE MY_LIST_FCB MY_LIST_LINE
+$MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$IF MY_LIST_SEPARATOR.EQ.F$LENGTH(MY_LIST_LINE)
+$THEN
+$ WRITE MY_PATCH_H_FCB "#define ''F$EDIT(MY_LIST_LINE,"LOWERCASE")'_ ''MY_LIST_LINE'"
+$ELSE
+$ MY_LIST_MODULE=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ WRITE MY_PATCH_H_FCB "#define ''F$EDIT(MY_LIST_MODULE,"LOWERCASE")' ''MY_LIST_MODULE'_CC"
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_KIND=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_COUNT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_SEPARATOR.EQ.F$LENGTH(MY_LIST_LINE)
+$ THEN
+$ MY_LIST_LINE=""
+$ ELSE
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ ENDIF
+$ MY_LIST_LINE_BACKUP=MY_LIST_LINE
+$
+$ IF MY_LIST_KIND.EQS."FUNCTION"
+$ THEN
+$ WRITE MY_PATCH_C_FCB "extern void *''MY_LIST_MODULE'_("
+$ ELSE
+$ WRITE MY_PATCH_C_FCB "extern void ''MY_LIST_MODULE'_("
+$ ENDIF
+$
+$ MY_LIST_LINE=MY_LIST_LINE_BACKUP
+$ MY_LIST_ARGUMENT=1
+$ MY_LIST_ARGUMENT_STRING_LAST=MY_LIST_ARGUMENT_COUNT
+$ MY_LIST_ARG_ANY_STRING_FLAG=0
+$ ARG_1_LOOP:
+$ IF MY_LIST_LINE.EQS.""
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ELSE
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_NEXT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_ARGUMENT.EQ.F$INTEGER(MY_LIST_ARGUMENT_STRING_NEXT)
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=1
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_LAST=MY_LIST_ARGUMENT
+$ ELSE
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$ MY_LIST_ARG_ANY_STRING_FLAG=1
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ IF MY_LIST_ARG_ANY_STRING_FLAG
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ MY_LIST_ARG_END=");"
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$ WRITE MY_PATCH_C_FCB " char *arg''MY_LIST_ARGUMENT'''MY_LIST_ARG_END'"
+$ ELSE
+$ WRITE MY_PATCH_C_FCB " void *arg''MY_LIST_ARGUMENT'''MY_LIST_ARG_END'"
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARGUMENT=MY_LIST_ARGUMENT+1
+$ GOTO ARG_1_LOOP
+$ ENDIF
+$
+$ MY_LIST_LINE=MY_LIST_LINE_BACKUP
+$ MY_LIST_ARGUMENT=1
+$ ARG_2_LOOP:
+$ IF MY_LIST_LINE.EQS.""
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ELSE
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_NEXT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_ARGUMENT.EQ.F$INTEGER(MY_LIST_ARGUMENT_STRING_NEXT)
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=1
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ ELSE
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_STRING_LAST
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ MY_LIST_ARG_END=");"
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$ WRITE MY_PATCH_C_FCB " int arg''MY_LIST_ARGUMENT'_len''MY_LIST_ARG_END'"
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARGUMENT=MY_LIST_ARGUMENT+1
+$ GOTO ARG_2_LOOP
+$ ENDIF
+$
+$ IF MY_LIST_KIND.EQS."FUNCTION"
+$ THEN
+$ WRITE MY_PATCH_C_FCB "void *''MY_LIST_MODULE'("
+$ ELSE
+$ WRITE MY_PATCH_C_FCB "void ''MY_LIST_MODULE'("
+$ ENDIF
+$
+$ MY_LIST_LINE=MY_LIST_LINE_BACKUP
+$ MY_LIST_ARGUMENT=1
+$ ARG_3_LOOP:
+$ IF MY_LIST_LINE.EQS.""
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ELSE
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_NEXT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_ARGUMENT.EQ.F$INTEGER(MY_LIST_ARGUMENT_STRING_NEXT)
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=1
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ ELSE
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ MY_LIST_ARG_END=")"
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$! WRITE MY_PATCH_C_FCB " struct dsc64$descriptor_s *arg''MY_LIST_ARGUMENT'_dsc''MY_LIST_ARG_END'"
+$ WRITE MY_PATCH_C_FCB " struct dsc$descriptor_s *arg''MY_LIST_ARGUMENT'_dsc''MY_LIST_ARG_END'"
+$ ELSE
+$ WRITE MY_PATCH_C_FCB " void *arg''MY_LIST_ARGUMENT'''MY_LIST_ARG_END'"
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARGUMENT=MY_LIST_ARGUMENT+1
+$ GOTO ARG_3_LOOP
+$ ENDIF
+$
+$ WRITE MY_PATCH_C_FCB " {"
+$
+$ IF MY_LIST_KIND.EQS."FUNCTION"
+$ THEN
+$ WRITE MY_PATCH_C_FCB " return ''MY_LIST_MODULE'_("
+$ ELSE
+$ WRITE MY_PATCH_C_FCB " ''MY_LIST_MODULE'_("
+$ ENDIF
+$
+$ MY_LIST_LINE=MY_LIST_LINE_BACKUP
+$ MY_LIST_ARGUMENT=1
+$ ARG_4_LOOP:
+$ IF MY_LIST_LINE.EQS.""
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ELSE
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_NEXT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_ARGUMENT.EQ.F$INTEGER(MY_LIST_ARGUMENT_STRING_NEXT)
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=1
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ ELSE
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ IF MY_LIST_ARG_ANY_STRING_FLAG
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ MY_LIST_ARG_END=");"
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$! WRITE MY_PATCH_C_FCB " (char*)arg''MY_LIST_ARGUMENT'_dsc->dsc64$pq_pointer''MY_LIST_ARG_END'"
+$ WRITE MY_PATCH_C_FCB " (char*)arg''MY_LIST_ARGUMENT'_dsc->dsc$a_pointer''MY_LIST_ARG_END'"
+$ ELSE
+$ WRITE MY_PATCH_C_FCB " arg''MY_LIST_ARGUMENT'''MY_LIST_ARG_END'"
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARGUMENT=MY_LIST_ARGUMENT+1
+$ GOTO ARG_4_LOOP
+$ ENDIF
+$
+$ MY_LIST_LINE=MY_LIST_LINE_BACKUP
+$ MY_LIST_ARGUMENT=1
+$ ARG_5_LOOP:
+$ IF MY_LIST_LINE.EQS.""
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ELSE
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_NEXT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_ARGUMENT.EQ.F$INTEGER(MY_LIST_ARGUMENT_STRING_NEXT)
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=1
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ ELSE
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_STRING_LAST
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ MY_LIST_ARG_END=");"
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$! WRITE MY_PATCH_C_FCB " (int)arg''MY_LIST_ARGUMENT'_dsc->dsc64$q_length''MY_LIST_ARG_END'"
+$ WRITE MY_PATCH_C_FCB " (int)arg''MY_LIST_ARGUMENT'_dsc->dsc$w_length''MY_LIST_ARG_END'"
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARGUMENT=MY_LIST_ARGUMENT+1
+$ GOTO ARG_5_LOOP
+$ ENDIF
+$
+$ WRITE MY_PATCH_C_FCB " }"
+$ENDIF
+$GOTO LIST_LOOP
+$LIST_DONE:
+$WRITE MY_PATCH_H_FCB "#endif"
+$WRITE MY_PATCH_H_FCB "#endif"
+$CLOSE MY_PATCH_H_FCB
+$CLOSE MY_PATCH_C_FCB
+$CLOSE MY_LIST_FCB
+$
+$CALL UPDATE CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_C_'F$GETJPI("","PID")'.C SYS$DISK:[]'MY_LIBRARY'$PATCH_WORK_C.C
+$CALL UPDATE CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_C_'F$GETJPI("","PID")'.H CLAS$INCLUDE:'MY_LIBRARY'$PATCH_WORK_C.H
+$
+$DELETE CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_C_'F$GETJPI("","PID")'.C;*
+$DELETE CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_C_'F$GETJPI("","PID")'.H;*
+$
+$EXIT
+$
+$UPDATE: SUBROUTINE
+$IF F$SEARCH(P2).NES.""
+$THEN
+$ DIFFERENCES/IGNORE=(BLANK_LINES,CASE,FORM_FEEDS,SPACING,TRAILING_SPACES)/OUTPUT=NL: 'P1' 'P2'
+$ IF $STATUS.NE.%X006C8009
+$ THEN
+$ !****************************
+$ !* Files are not identical. *
+$ !****************************
+$ IF $STATUS.EQ.%X006C8013
+$ THEN
+$ COPY/LOG 'P1' 'P2'_TMP
+$ RENAME 'P2'_TMP 'P2'
+$ PURGE 'P2'
+$ RENAME 'P2' ;1
+$ ELSE
+$ MY_STATUS=$STATUS
+$ WRITE SYS$OUTPUT "Unknown status from DIFFERENCES, procedure stopped."
+$ EXIT 'MY_STATUS'
+$ ENDIF
+$ ENDIF
+$ELSE
+$ COPY/LOG 'P1' 'P2'
+$ENDIF
+$EXIT
+$ENDSUBROUTINE
+$!CLAS$PATCH_WORK_FORTRAN.COM
+$IF P1.EQS.""
+$THEN
+$ MY_LIBRARY_FILE_SPEC=F$SEARCH("*$PATCH_WORK_FORTRAN.TXT")
+$ IF MY_LIBRARY_FILE_SPEC.EQS.""
+$ THEN
+$ WRITE SYS$ERROR "Missing *$PATCH_WORK_FORTRAN.TXT"
+$ EXIT
+$ ENDIF
+$ MY_LIBRARY=F$PARSE(MY_LIBRARY_FILE_SPEC,,,"NAME",)-"$PATCH_WORK_FORTRAN"
+$ELSE
+$ MY_LIBRARY=P1
+$ENDIF
+$
+$MY_LIBRARY=F$EDIT(MY_LIBRARY,"COLLAPSE,UPCASE")
+$
+$OPEN/READ MY_LIST_FCB 'MY_LIBRARY'$PATCH_WORK_FORTRAN.TXT
+$OPEN/WRITE MY_PATCH_C_FCB CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_FORTRAN_'F$GETJPI("","PID")'.C
+$OPEN/WRITE MY_PATCH_H_FCB CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_FORTRAN_'F$GETJPI("","PID")'.H
+$WRITE MY_PATCH_C_FCB "#include "
+$WRITE MY_PATCH_C_FCB "#include "
+$WRITE MY_PATCH_C_FCB "#include "
+$WRITE MY_PATCH_C_FCB "#include "
+$WRITE MY_PATCH_C_FCB ""
+$WRITE MY_PATCH_C_FCB "static unsigned short ",F$EDIT(MY_LIBRARY,"LOWERCASE"),"$vms_cstrlen_to_strlen(const int arg_len)"
+$WRITE MY_PATCH_C_FCB " { union"
+$WRITE MY_PATCH_C_FCB " { unsigned short s[2];"
+$WRITE MY_PATCH_C_FCB " int i;"
+$WRITE MY_PATCH_C_FCB " } conv;"
+$WRITE MY_PATCH_C_FCB " conv.i=arg_len;"
+$WRITE MY_PATCH_C_FCB " if ((unsigned int)conv.s[0]>0x7fff)"
+$WRITE MY_PATCH_C_FCB " lib$stop(SS$_BADPARAM);"
+$WRITE MY_PATCH_C_FCB " if ((unsigned int)conv.s[1])"
+$WRITE MY_PATCH_C_FCB " lib$stop(SS$_BADPARAM);"
+$WRITE MY_PATCH_C_FCB " return conv.s[0];"
+$WRITE MY_PATCH_C_FCB " }"
+$WRITE MY_PATCH_C_FCB ""
+$WRITE MY_PATCH_H_FCB "#ifndef ''MY_LIBRARY'$PATCH_WORK_FORTRAN_H"
+$WRITE MY_PATCH_H_FCB "#define ''MY_LIBRARY'$PATCH_WORK_FORTRAN_H"
+$WRITE MY_PATCH_H_FCB "#ifdef VMS"
+$LIST_LOOP:
+$READ/END=LIST_DONE MY_LIST_FCB MY_LIST_LINE
+$MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$IF MY_LIST_SEPARATOR.EQ.F$LENGTH(MY_LIST_LINE)
+$THEN
+$ WRITE MY_PATCH_H_FCB "#define ''F$EDIT(MY_LIST_LINE,"LOWERCASE")'_ ''MY_LIST_LINE'"
+$ELSE
+$ MY_LIST_MODULE=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_KIND=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_COUNT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_SEPARATOR.EQ.F$LENGTH(MY_LIST_LINE)
+$ THEN
+$ MY_LIST_LINE=""
+$ ELSE
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ ENDIF
+$ MY_LIST_LINE_BACKUP=MY_LIST_LINE
+$
+$ IF MY_LIST_KIND.EQS."FUNCTION"
+$ THEN
+$ WRITE MY_PATCH_C_FCB "extern void *''MY_LIST_MODULE'("
+$ ELSE
+$ WRITE MY_PATCH_C_FCB "extern void ''MY_LIST_MODULE'("
+$ ENDIF
+$
+$ MY_LIST_ARGUMENT=1
+$ MY_LIST_ARGUMENT_STRING_LAST=MY_LIST_ARGUMENT_COUNT
+$ ARG_1_LOOP:
+$ IF MY_LIST_LINE.EQS.""
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ELSE
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_NEXT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_ARGUMENT.EQ.F$INTEGER(MY_LIST_ARGUMENT_STRING_NEXT)
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=1
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_LAST=MY_LIST_ARGUMENT
+$ ELSE
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ MY_LIST_ARG_END=");"
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$ WRITE MY_PATCH_C_FCB " struct dsc$descriptor_s *arg''MY_LIST_ARGUMENT'_dsc''MY_LIST_ARG_END'"
+$ ELSE
+$ WRITE MY_PATCH_C_FCB " void *arg''MY_LIST_ARGUMENT'''MY_LIST_ARG_END'"
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARGUMENT=MY_LIST_ARGUMENT+1
+$ GOTO ARG_1_LOOP
+$ ENDIF
+$
+$ IF MY_LIST_KIND.EQS."FUNCTION"
+$ THEN
+$ WRITE MY_PATCH_C_FCB "void *''MY_LIST_MODULE'_("
+$ ELSE
+$ WRITE MY_PATCH_C_FCB "void ''MY_LIST_MODULE'_("
+$ ENDIF
+$
+$ MY_LIST_LINE=MY_LIST_LINE_BACKUP
+$ MY_LIST_ARGUMENT=1
+$ MY_LIST_ARG_ANY_STRING_FLAG=0
+$ ARG_2_LOOP:
+$ IF MY_LIST_LINE.EQS.""
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ELSE
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_NEXT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_ARGUMENT.EQ.F$INTEGER(MY_LIST_ARGUMENT_STRING_NEXT)
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=1
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ ELSE
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$ MY_LIST_ARG_ANY_STRING_FLAG=1
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ IF MY_LIST_ARG_ANY_STRING_FLAG
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ MY_LIST_ARG_END=")"
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$ WRITE MY_PATCH_C_FCB " char *const arg''MY_LIST_ARGUMENT'''MY_LIST_ARG_END'"
+$ ELSE
+$ WRITE MY_PATCH_C_FCB " void *arg''MY_LIST_ARGUMENT'''MY_LIST_ARG_END'"
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARGUMENT=MY_LIST_ARGUMENT+1
+$ GOTO ARG_2_LOOP
+$ ENDIF
+$
+$ MY_LIST_LINE=MY_LIST_LINE_BACKUP
+$ MY_LIST_ARGUMENT=1
+$ ARG_3_LOOP:
+$ IF MY_LIST_LINE.EQS.""
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ELSE
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_NEXT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_ARGUMENT.EQ.F$INTEGER(MY_LIST_ARGUMENT_STRING_NEXT)
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=1
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ ELSE
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_STRING_LAST
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ MY_LIST_ARG_END=")"
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$ WRITE MY_PATCH_C_FCB " const int arg''MY_LIST_ARGUMENT'_len''MY_LIST_ARG_END'"
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARGUMENT=MY_LIST_ARGUMENT+1
+$ GOTO ARG_3_LOOP
+$ ENDIF
+$
+$ WRITE MY_PATCH_C_FCB " {"
+$
+$ MY_LIST_LINE=MY_LIST_LINE_BACKUP
+$ MY_LIST_ARGUMENT=1
+$ ARG_3_LOOP:
+$ IF MY_LIST_LINE.EQS.""
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ELSE
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_NEXT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_ARGUMENT.EQ.F$INTEGER(MY_LIST_ARGUMENT_STRING_NEXT)
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=1
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ ELSE
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$ WRITE MY_PATCH_C_FCB " struct dsc$descriptor_s arg''MY_LIST_ARGUMENT'_dsc={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL};"
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARGUMENT=MY_LIST_ARGUMENT+1
+$ GOTO ARG_3_LOOP
+$ ENDIF
+$
+$ WRITE MY_PATCH_C_FCB ""
+$
+$ MY_LIST_LINE=MY_LIST_LINE_BACKUP
+$ MY_LIST_ARGUMENT=1
+$ MY_LIST_ARG_ANY_STRING_FLAG=0
+$ ARG_4_LOOP:
+$ IF MY_LIST_LINE.EQS.""
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ELSE
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_NEXT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_ARGUMENT.EQ.F$INTEGER(MY_LIST_ARGUMENT_STRING_NEXT)
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=1
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ ELSE
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$ WRITE MY_PATCH_C_FCB " arg''MY_LIST_ARGUMENT'_dsc.dsc$w_length=",F$EDIT(MY_LIBRARY,"LOWERCASE"),-
+"$vms_cstrlen_to_strlen(arg''MY_LIST_ARGUMENT'_len);"
+$ WRITE MY_PATCH_C_FCB " arg''MY_LIST_ARGUMENT'_dsc.dsc$a_pointer=arg''MY_LIST_ARGUMENT';"
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARGUMENT=MY_LIST_ARGUMENT+1
+$ GOTO ARG_4_LOOP
+$ ENDIF
+$
+$ WRITE MY_PATCH_C_FCB ""
+$
+$ IF MY_LIST_KIND.EQS."FUNCTION"
+$ THEN
+$ WRITE MY_PATCH_C_FCB " return ''MY_LIST_MODULE'("
+$ ELSE
+$ WRITE MY_PATCH_C_FCB " ''MY_LIST_MODULE'("
+$ ENDIF
+$
+$ MY_LIST_LINE=MY_LIST_LINE_BACKUP
+$ MY_LIST_ARGUMENT=1
+$ MY_LIST_ARG_ANY_STRING_FLAG=0
+$ ARG_5_LOOP:
+$ IF MY_LIST_LINE.EQS.""
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ELSE
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_NEXT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_ARGUMENT.EQ.F$INTEGER(MY_LIST_ARGUMENT_STRING_NEXT)
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=1
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ ELSE
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ MY_LIST_ARG_END=");"
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$ WRITE MY_PATCH_C_FCB " &arg;''MY_LIST_ARGUMENT'_dsc''MY_LIST_ARG_END'"
+$ ELSE
+$ WRITE MY_PATCH_C_FCB " arg''MY_LIST_ARGUMENT'''MY_LIST_ARG_END'"
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARGUMENT=MY_LIST_ARGUMENT+1
+$ GOTO ARG_5_LOOP
+$ ENDIF
+$
+$ WRITE MY_PATCH_C_FCB " }"
+$ENDIF
+$GOTO LIST_LOOP
+$LIST_DONE:
+$WRITE MY_PATCH_H_FCB "#endif"
+$WRITE MY_PATCH_H_FCB "#endif"
+$CLOSE MY_PATCH_H_FCB
+$CLOSE MY_PATCH_C_FCB
+$CLOSE MY_LIST_FCB
+$
+$CALL UPDATE CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_FORTRAN_'F$GETJPI("","PID")'.C -
+SYS$DISK:[]'MY_LIBRARY'$PATCH_WORK_FORTRAN.C
+$CALL UPDATE CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_FORTRAN_'F$GETJPI("","PID")'.H -
+CLAS$INCLUDE:'MY_LIBRARY'$PATCH_WORK_FORTRAN.H
+$
+$DELETE CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_FORTRAN_'F$GETJPI("","PID")'.C;*
+$DELETE CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_FORTRAN_'F$GETJPI("","PID")'.H;*
+$
+$EXIT
+$
+$UPDATE: SUBROUTINE
+$IF F$SEARCH(P2).NES.""
+$THEN
+$ DIFFERENCES/IGNORE=(BLANK_LINES,CASE,FORM_FEEDS,SPACING,TRAILING_SPACES)/OUTPUT=NL: 'P1' 'P2'
+$ IF $STATUS.NE.%X006C8009
+$ THEN
+$ !****************************
+$ !* Files are not identical. *
+$ !****************************
+$ IF $STATUS.EQ.%X006C8013
+$ THEN
+$ COPY/LOG 'P1' 'P2'_TMP
+$ RENAME 'P2'_TMP 'P2'
+$ PURGE 'P2'
+$ RENAME 'P2' ;1
+$ ELSE
+$ MY_STATUS=$STATUS
+$ WRITE SYS$OUTPUT "Unknown status from DIFFERENCES, procedure stopped."
+$ EXIT 'MY_STATUS'
+$ ENDIF
+$ ENDIF
+$ELSE
+$ COPY/LOG 'P1' 'P2'
+$ENDIF
+$EXIT
+$ENDSUBROUTINE
diff --git a/cleanups-logs-dcl b/cleanups-logs-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_Y2xlYW51cHMtbG9ncy1kY2w=
--- /dev/null
+++ b/cleanups-logs-dcl
@@ -0,0 +1,32 @@
+cleanup_logs.com
+Mike Ford, Monday November 03 2003 @ 02:23PM EST
+$! CLEANUP_LOGS.COM PURGE P1 LOG TO P2 VERSIONS AND RESET VERSIONS IF > 32000
+$! Written by Mike Ford Oct 08, 2001
+$ IF P1 .EQS. ""
+$ then
+$ IF F$MODE() .EQS. "INTERACTIVE"
+$ THEN
+$ GOSUB GET_LOGFILE
+$ ELSE
+$ EXIT
+$ ENDIF
+$ ENDIF
+$ IF P2 .EQS. "" THEN P2 = "40"
+$ PURGE/LOG/KEEP='P2' 'P1
+$ FILE = F$SEARCH("''P1'")
+$ VERSION = F$PARSE("''FILE'",,,"VERSION") - ";"
+$ IF VERSION .GT. 32000 THEN GOSUB RESET_VERSIONS
+$!
+$ EXIT
+$!
+$ RESET_VERSIONS:
+$ ON ERROR THEN RETURN
+$ RENAME/LOG 'P1';'VERSION 'P1';'P2
+$ VERSION = VERSION - 1
+$ P2 = P2 - 1
+$ IF F$SEARCH("''P1';''VERSION'") .NES. "" THEN GOTO RESET_VERSIONS
+$ RETURN
+$!
+$ GET_LOGFILE:
+$ INQUIRE P1 "Enter logfile"
+$ return
\ No newline at end of file
diff --git a/compare-params-dcl b/compare-params-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_Y29tcGFyZS1wYXJhbXMtZGNs
--- /dev/null
+++ b/compare-params-dcl
@@ -0,0 +1,566 @@
+COMPARE_PARAMS (and PARAM_TABLES)
+Mark Hawley, Friday May 13 2011 @ 09:16AM EDT
+COMPARE_PARAMS.COM (calls PARAM_TABLES.COM, following)
+
+$ V = F$Verify(0)
+$ On Control_Y Then Goto Abort_exit
+$ On Error Then Goto Error_exit
+$!------------------------------------------------------------------------------
+$! PROCEDURE: COMPARE_PARAMS.COM
+$!------------------------------------------------------------------------------
+$! MAKE NO ALTERATIONS TO THIS PROCEDURE WITHOUT UPDATING
+$! REVISION BLOCK AT THE END OF THIS FILE
+$!------------------------------------------------------------------------------
+$!
+$!
+$ Write Sys$Output "+---------------------------------------------------+"
+$ Write Sys$Output "| MAYO_PROCS:COMPARE_PARAMS.COM |"
+$ Write Sys$Output "+---------------------------------------------------+"
+$ Write Sys$Output "This procedure automatically gathers and tabularizes"
+$ Write Sys$Output " SYSGEN parameters from nodes supporting SYSMAN"
+$ Write Sys$Output ""
+$ Write Sys$Output "Started at ''F$Time()'"
+$ Write Sys$Output ""
+$ Save_default = F$Environment("DEFAULT")
+$!
+$!------------------------------------------------------------------------------
+$! Determine if we have the privileges necessary to do any of this
+$!------------------------------------------------------------------------------
+$!
+$ Save_privs = F$Setprv("OPER") ! set new, save old priv's
+$ If .not. F$Privilege("OPER")
+$ Then
+$ Say "''Fatal'NOPRIV, Insufficient privilege to use this procedure.''Clrg'"
+$ Goto Done
+$ EndIf
+$!
+$!
+$!------------------------------------------------------------------------------
+$! Prompt for nodes to compare.
+$!------------------------------------------------------------------------------
+$!
+$ Env_loop:
+$ Read /Prompt="Enter /CLUSTER or /NODE=(node1,...) for environment: " -
+/End_of_file=Abort_exit -
+Sys$Command Environment
+$ If F$Locate("/",Environment) .eq. F$Length(Environment) Then -
+Goto Env_loop
+$ If F$Locate("/N",F$Edit(Environment,"UPCASE")) .ne. F$Length(Environment)
+$ Then
+$ Remote = "TRUE"
+$ If F$Mode() .nes. "INTERACTIVE" Then Goto Wrong_mode
+$ Default_account = F$Edit(F$GetJPI("","USERNAME"),"TRIM")
+$ Read /Prompt="Enter Username to use on remote nodes (default is ''Default_account'):" -
+/End_of_file=Abort_exit -
+Sys$command Username
+$ If Username .eqs. "" Then Username = Default_account
+$!! Set Terminal /NoEcho
+$!! Read /Prompt="Enter Password to use on remote nodes" -
+$!!! /End_of_file=Abort_exit -
+$!!! Sys$command Password
+$!! Set Terminal /Echo
+$ Write Sys$Output "" !make a blank line so SYSMAN password prompt doesn't overwrite
+$ Else
+$ Remote = "FALSE"
+$ EndIf
+$!
+$!------------------------------------------------------------------------------
+$! Determine which parameters the user wishes to compare.
+$!------------------------------------------------------------------------------
+$!
+$ Param_loop:
+$ Type Sys$input
+
+
+You may choose any ONE of the following sets of parameters:
+
+
+/ACP /ALL /CLUSTER /DYNAMIC /GEN
+/JOB /LGI /MAJOR /PQL /RMS
+/SCS /SPECIAL /SYS /TTY
+
+
+$ Read /Prompt="Enter selection (default= /ALL): " -
+/End_of_file=Abort_exit -
+Sys$Command Param_set
+$ If Param_set .eqs. "" Then Param_set = "/ALL"
+$ If F$Locate("/",Param_set) .eq. F$Length(Param_set) Then Goto Param_loop
+$!
+$!------------------------------------------------------------------------------
+$! Locate physically where we are, so that the parameter output from all nodes
+$! comes back here, instead of spreading out all over the place due to
+$! remote node logical name translation, etc.
+$!------------------------------------------------------------------------------
+$!
+$!! FourQ = """"
+$!! Local_node = F$GetSYI("NODENAME") + FourQ + FourQ + Username + -
+$!! " ''Password'" + FourQ + FourQ+ "::"
+$ Local_node = F$GetSYI("NODENAME") + "::"
+$ Device = F$Parse("X.X",,,"DEVICE")
+$ Translate = F$TrnLNM(Device-":") !e.g. SYS$SYSROOT
+$ If Translate .nes. "" Then Device = Translate !e.g. $1$DUS0:[SYS3.]
+$ Directory = F$Parse("X.X",,,"DIRECTORY") !e.g. [SYSMGR]
+$ If F$Locate("]",Device) .ne. F$Length(Device) !e.g. $1$DUS0:[SYS3.]
+$ Then
+$ Device = Device - "]" !e.g. $1$DUS0:[SYS3.
+$ Directory = Directory - "[" !e.g. SYSMGR]
+$ EndIf
+$!! Out_file = "SYS$login:SYSMAN_PARAMS.TMP"
+$!! Out_file = "SYS$SCRATCH:SYSMAN_PARAMS.TMP"
+$ Out_file = Device + Directory + "SYSMAN_PARAMS.TMP"
+$!
+$!------------------------------------------------------------------------------
+$! Create the appropriate SYSMAN command file, and execute it to produce the
+$! parameter listing file.
+$!------------------------------------------------------------------------------
+$!
+$ Open /Write Sysman_commands SYSMAN_COMMANDS.TMP
+$ Write Sysman_commands "$ RUN SYS$SYSTEM:SYSMAN"
+$ If Remote
+$ Then
+$ If .not. F$Environment("INTERACTIVE") Then Goto Wrong_mode
+$ Write Sysman_commands " SET ENVIRONMENT ''Environment'/USER=''Username'"
+$ Write Sysman_commands " SET PROFILE /DEFAULT=SYS$SYSTEM /PRIV=ALL" !so SYSMAN doesn't error
+$ Write Sysman_commands " SET TIMEOUT 00:00:10"
+$!! Write Sysman_commands " PARAM SHOW ''Param_set' /OUT=''Local_node'''Out_file'"
+$ Write Sysman_commands " PARAM SHOW ''Param_set' /OUT=''Out_file'"
+$ Else
+$ Write Sysman_commands " SET ENVIRONMENT ''Environment'"
+$ Write Sysman_commands " SET PROFILE /DEFAULT=SYS$SYSTEM /PRIV=ALL" !so SYSMAN doesn't error
+$ Write Sysman_commands " SET TIMEOUT 00:00:10"
+$ Write Sysman_commands " PARAM SHOW ''Param_set' /OUT=''Out_file'"
+$ EndIf
+$ Write Sysman_commands "$ EXIT"
+$ Close Sysman_commands
+$!
+$ Time = F$Time()
+$ @SYSMAN_COMMANDS.TMP
+$ Set Default 'Save_default' !because SYSMAN will have put us in SYS$SYSTEM!
+$ Delete /NoLog SYSMAN_COMMANDS.TMP;*
+$!
+$!------------------------------------------------------------------------------
+$! Read the parameter listing file created, and separate it into individual files for
+$! processing by the "tabularizing" procedure. Each file will be called PARAM_nn.TMP
+$! where "nn" is simply a counter of the files. This will keep the node information
+$! in the same order in the final listing as it was specified by the user - useful
+$! if you wish to keep node information together by hardware type (i.e. 8550's, 780's)
+$! for example.
+$!------------------------------------------------------------------------------
+$!
+$ Open /Read Sysman_outfile 'Out_file'
+$!
+$ Current_node = ""
+$ Write Sys$Output "Examining SYSMAN combined parameter listing ..."
+$ Start:
+$ Read /End_of_file=Done Sysman_outfile Record
+$ If F$Locate("%SYSMAN-I-USE",Record) .ne. F$Length(Record) ! signifies start of new node info
+$ Then
+$ If Current_node .nes. "" Then Close Param_'Current_node' ! close any previous info file, if any
+$ Read /End_of_file=Missing_rec Sysman_outfile Record ! get the next record, which contains node name
+$ Start = F$Locate(" ",Record) + 1 ! start of the name
+$ Colon = F$Locate(":",Record) ! end of the name
+$ Len = Colon - Start ! length of the name
+$ Current_name = F$Edit(F$Extract(Start,Len,Record),"COLLAPSE") ! the node name, w/o spaces
+$ Current_node = Current_node + 1 ! counter, to keep names in user supplied order
+$ If Current_node .le. 9
+$ Then ! open a new file for this node's info ...
+$ Open /Write Param_'Current_node' PARAMS_0'Current_node'.TMP ! ... as PARAMS_01.TMP thru PARAMS_09.TMP ...
+$ Else
+$ Open /Write Param_'Current_node' PARAMS_'Current_node'.TMP ! ... or as PARAMS_10.TMP and up
+$ EndIf
+$ Write Param_'Current_node' Record ! save node name record for COMPARE_PARAMS.COM use
+$ Write Sys$Output "... extracting ''Current_name' records"
+$ Read /End_of_file=Missing_rec Sysman_outfile Junk ! junk header record, discard
+$ Read /End_of_file=Missing_rec Sysman_outfile Junk ! junk header record, discard
+$ Else
+$ Write Param_'Current_node' Record ! output an individual parameters value
+$ EndIf
+$ Goto Start
+$!
+$!------------------------------------------------------------------------------
+$! Normal completion.
+$!------------------------------------------------------------------------------
+$!
+$ Done:
+$ Write Sys$Output "Parameter extraction completed."
+$ Close Sysman_outfile
+$ Close Param_'Current_node'
+$ Delete /NoLog 'Out_file';*
+$ @MAYO_PROCS:PARAM_TABLES.COM "PARAMS_*.TMP" "''Time'"
+$ Delete /NoLog PARAMS_*.TMP;*
+$ Write Sys$Output ""
+$ Write Sys$Output "Completed at ''F$Time()'"
+$ Write Sys$Output "Results are in ''F$Search("COMPARE_PARAMS.LIS;*")'"
+$ Set Default 'Save_default'
+$ If V Then Set Verify
+$ Exit
+$!
+$!------------------------------------------------------------------------------
+$! Error while separating parameter listing.
+$!------------------------------------------------------------------------------
+$!
+$ Missing_rec:
+$ Write Sys$Output "Error - Unexpected end of input from SYSMAN_PARAMS.TMP."
+$ Write Sys$Output "This is probably the result of a timeout of SYSMAN"
+$ Write Sys$Output "on one of the nodes."
+$ Goto Cleanup
+$!
+$!------------------------------------------------------------------------------
+$! Unknown errors.
+$!------------------------------------------------------------------------------
+$!
+$ Error_exit:
+$ Write Sys$Output "Error - Cleanup operation in progress."
+$ Goto Cleanup
+$!
+$!------------------------------------------------------------------------------
+$! Aborted run.
+$!------------------------------------------------------------------------------
+$!
+$ Abort_Exit:
+$ Write Sys$Output "Aborted run - Cleanup operation in progress."
+$ Cleanup:
+$ If F$TrnLnm("Sysman_commands") .nes. "" Then Close Sysman_commands
+$ If F$Search("SYSMAN_COMMANDS.TMP;*") .nes. "" Then Delete /NoLog SYSMAN_COMMANDS.TMP;*
+$ If F$TrnLnm("Sysman_outfile") .nes. "" Then Close Sysman_outfile
+$ If F$Search("SYSMAN_PARAMS.TMP;*") .nes. "" Then Delete /NoLog SYSMAN_PARAMS.TMP;*
+$ If F$TrnLnm("Param_''Current_node'") .nes. "" Then Close Param_'Current_node'
+$ If F$Search("PARAMS_*.TMP;*") .nes. "" Then Delete /NoLog PARAMS_*.TMP;*
+$ Set Default 'Save_default'
+$ Exit
+$!
+$!------------------------------------------------------------------------------
+$! Special conditions.
+$!------------------------------------------------------------------------------
+$!
+$ Wrong_mode:
+$ Write Sys$Output "Error. /NODE=(node1,node2,...) is not allowed from batch"
+$ Write Sys$Output "since a password is required for remote login."
+$ Goto Cleanup
+$!
+$!------------------------------------------------------------------------------
+$!------------------------------------------------------------------------------
+$! Title And Functional Description:
+$!
+$! MAYO_PROCS:COMPARE_PARAMS.COM
+$!
+$! This procedure, in combination with MAYO_PROCS:PARAM_TABLES.COM,
+$! provides a mechanism for creating a tabularized listing of
+$! SYSGEN paramaters from several nodes. This allows for easy
+$! comparison of parameters to facilitate tuning alterations
+$! using AUTOGEN.
+$!
+$! Programmer: Mark Hawley
+$!
+$! Creation Date: 08-NOV-1990
+$! Ported to Mayo: 15-SEP-1995
+$!
+$! Invoking/Calling Sequence: @MAYO_PROCS:COMPARE_PARAMS
+$!
+$! Formal Parameters: None
+$!
+$! Implicit Inputs: "SYSTEM" as the default account to use
+$!
+$! Implicit Outputs: COMPARE_PARAMS.LIS
+$!
+$! Environment:
+$! Must be run from account with privilege to access and
+$! use SYSMAN, specifically the PARAM SHOW command.
+$! In order to use across nodes not all in the same cluster,
+$! it must be run from an account which exists on all the nodes
+$! involved, and has the same password on all nodes.
+$!
+$! Library Ref/Include Files: PARAM_TABLES.COM is called
+$! from this procedure, and is required.
+$!
+$! Completion Statuses: None
+$!
+$! Side Effects: None
+$!
+$!------------------------------------------------------------------------------
+
+
+
+
+PARAM_TABLES.COM (called by COMPARE_PARAMS.COM)
+
+
+$!------------------------------------------------------------------------------
+$! PARAM_TABLES.COM
+$!------------------------------------------------------------------------------
+$! DO NOT MAKE CHANGES TO THIS PROCEDURE WITHOUT UPDATING THE HISTORY
+$! INFORMATION AT THE BOTTOM OF THIS FILE.
+$!------------------------------------------------------------------------------
+$!
+$ On Control_Y Then Goto Abort_exit
+$ Lines_per_page = F$TrnLnm("SYS$LP_LINES")
+$ If Lines_per_page .eqs. "" Then Lines_per_page = 62
+$ Form_feed[0,8] = %X0C
+$!
+$ If P1 .eqs. ""
+$ Then
+$ Type Sys$Input
+
+
+PARAM_TABLES.COM may be used independently to produce
+parameter comparisons, if the input files match the following
+conditions :
+
+
+1) Files are named such that a wildcard file name
+specification can find all the parameter files.
+2) The files have the same parameters in the same order
+(i.e. were generated by the same SYSMAN PARAM SHOW command).
+3) Each file contains parameters from a single node.
+4) The top of each file appears as follows:
+(i.e. output generated by SYSMAN PARAM SHOW command)
+
+
+%SYSMAN-I-USEACTNOD, a USE ACTIVE has been defaulted on node NODENAME
+Node NODENAME: Parameters in use: ACTIVE
+Parameter Name Current Default Minimum Maximum Unit Dynamic
+-------------- ------- ------- ------- ------- ---- -------
+....parameters.....
+....parameters.....
+
+
+
+
+$ Read /Prompt="Enter wildcard format of parameter file names (default= PARAMS_*.TMP) " -
+/End_of_file=Abort_exit -
+Sys$command params_wild
+$ If Params_wild .eqs. "" Then params_wild = "PARAMS_*.TMP"
+$ Else
+$ Params_wild = P1 !format of param file names...
+$ EndIf !...passed from COMPARE_PARAMS.COM
+$!
+$ If P2 .eqs. ""
+$ Then
+$ Time = F$Time() !now - we're probably being run directly
+$ Else
+$ Time = P2 !time when SYSMAN was used to get params...
+$ EndIf !...passed from COMPARE_PARAMS.COM
+$!
+$!------------------------------------------------------------------------------
+$! Locate and open all parameter files
+$!------------------------------------------------------------------------------
+$!
+$ Write Sys$Output "Starting to build tabularized output ..."
+$ Current_file = 1
+$ Find_all_files:
+$ Filename_'Current_file' = F$Search("''Params_wild'")
+$ If (Current_file .eq. 1 .and. Filename_'Current_file' .eqs. "" ) -
+Then Goto Error_exit
+$ If Filename_'Current_file' .eqs. "" Then Goto Found_all
+$ Name = Filename_'Current_file'
+$ Open /Read File_'Current_file' 'Name'
+$ Current_file = Current_file + 1
+$ Goto Find_all_Files
+$!
+$ Found_all:
+$ Max_file = Current_file - 1
+$ If Max_file .eq. 0 then Goto Error_exit
+$!
+$!------------------------------------------------------------------------------
+$! Throw away first record, but take node name off of it first
+$!------------------------------------------------------------------------------
+$!
+$ Underline_record = ""
+$ Current_file = 1
+$ Nodes_loop:
+$ Read File_'Current_file' Junk
+$ Start = F$Locate(" ",Junk) + 1
+$ Colon = F$Locate(":",Junk)
+$ Len = Colon - Start
+$ Node_'Current_file' = F$FAO("!8AS",F$Extract(Start,Len,Junk))
+$ Underline_record = Underline_record + F$FAO("!7*-|")
+$ Current_file = Current_file + 1
+$ If Current_file .le. Max_file Then Goto Nodes_loop
+$!
+$!------------------------------------------------------------------------------
+$! We only want to write whole amounts of 5 parameters separated by a line
+$! (i.e. 6 line groupings), to make the output easily readable. So compute
+$! the number of 6-line grouping we can fit on a page (1 group is the header)
+$!------------------------------------------------------------------------------
+$!
+$ Groupings = Lines_per_page / 6
+$ No_form_feed = (Lines_per_page .eq. (Groupings * 6)) !true if divided evenly
+$!
+$!------------------------------------------------------------------------------
+$! Write the header record
+$!------------------------------------------------------------------------------
+$!
+$ Open /Write Result_file COMPARE_PARAMS.LIS
+$ Hdr_record = F$FAO(" !15AS","Param")
+$ Underline_record = F$FAO("|!14*-|") + Underline_record
+$ Current_file = 1
+$ Page = 1
+$ Header_loop:
+$ Hdr_record = Hdr_record + Node_'Current_file'
+$ Current_file = Current_file + 1
+$ If Current_file .le. Max_file Then Goto Header_loop
+$ Hdr_record = Hdr_record + "Units Dynamic"
+$ Underline_record = Underline_record + F$FAO("!14*-|")
+$ Write Result_file ""
+$ Write Result_file "''Param_list' Parameter Comparison on ''Time' Page ''Page'"
+$ Write Result_file "* Denotes records with values wider then 8 characters"
+$ Write Result_file ""
+$ Write Result_file Hdr_record
+$ Write Result_file Underline_record
+$ Group_count = 1
+$!
+$!------------------------------------------------------------------------------
+$! Read the value from each record, and place in formatted record
+$!------------------------------------------------------------------------------
+$!
+$ Break_5_lines = 1
+$ Loop_values:
+$ Current_file = 1
+$ Get_values:
+$ Read /End_of_File=Done File_'Current_file' Record
+$ Param_len = F$Locate(" ",Record) !wipes " internal value" records
+$ Param = F$FAO(" !15AS",F$Extract(0,Param_len,Record))
+$ If F$Edit(Param,"COLLAPSE") .eqs. "" Then Goto Done ! empty record
+$ Start = Param_len
+$ Value_len = 33 - Start + 1
+$ Value_'Current_file' = F$Edit(F$Extract(Start,Value_len,Record),"COLLAPSE")
+$ If F$Length(Value_'Current_file') .gt. 9 Then - ! add an "*" to the front of the name
+Param = F$FAO("*!15AS",F$Extract(0,Param_len,Record))
+$ Value_'Current_file' = F$FAO("!8AS",Value_'Current_file')
+$ Units = F$FAO("!20AS",F$Edit(F$Extract(67,20,Record),"TRIM"))
+$ If Current_file .eq. 1
+$ Then
+$ Out_record = Param + Value_'Current_file'
+$ Else
+$ Out_record = Out_record + Value_'Current_file'
+$ EndIf
+$ Current_file = Current_file + 1
+$ If Current_file .le. Max_file Then Goto Get_values
+$!
+$ Out_record = Out_record + Units
+$ Write Sys$Output "Processing... ''Param'"
+$ Write Result_file Out_record
+$ Break_5_lines = Break_5_lines + 1
+$ If Break_5_lines .gt. 5 ! blank line every 5
+$ Then
+$ Break_5_lines = 1
+$ Group_count = Group_count + 1
+$ Write Result_file ""
+$ EndIf
+$ If Group_count .lt. Groupings Then Goto Loop_values
+$!
+$ Page = Page + 1
+$ If .not. No_form_feed Then Write Result_file "''Form_feed'"
+$ Write Result_file ""
+$ Write Result_file "Parameter Comparison on ''Time' Page ''Page'"
+$ Write Result_file "* Denotes records with values wider then 8 characters"
+$ Write Result_file ""
+$ Write Result_file Hdr_record
+$ Write Result_file Underline_record
+$ Break_5_lines = 1
+$ Group_count = 1
+$ Goto Loop_values
+$!
+$!------------------------------------------------------------------------------
+$! Close all files and exit
+$!------------------------------------------------------------------------------
+$!
+$ Done:
+$ Current_file = 1
+$ Close_loop:
+$ Close File_'Current_file'
+$ Current_file = Current_file + 1
+$ If Current_file .le. Max_file Then Goto Close_loop
+$ Close Result_file
+$!
+$ Exit
+$!
+$!------------------------------------------------------------------------------
+$! Error Exit
+$!------------------------------------------------------------------------------
+$!
+$ Error_exit:
+$ Write Sys$Output "No files found."
+$ Goto Done
+$ Exit
+$!
+$!------------------------------------------------------------------------------
+$! ABORTED RUN
+$!------------------------------------------------------------------------------
+$!
+$ Abort_exit:
+$ Write Sys$Output "Aborting tabularized listing prepartion."
+$ Goto Done
+$ Exit
+$!------------------------------------------------------------------------------
+$! Title And Functional Description:
+$! MAYO_PROCS:PARAM_TABLES.COM
+$!
+$! This procedure is normally called by MAYO_PROCS:COMPARE_PARAMS.COM
+$! for the preparation of a tabularized listing of SYSGEN parameters
+$! from files generated by COMPARE_PARAMS.COM.
+$! COMPARE_PARAMS.COM uses SYSMAN to access multiple nodes, and
+$! creates files of the form "PARAMS_nn.TMP" for this procedure
+$! to process, where "nn" is a count from 01,02,...,09,10,... up
+$! to the number of nodes the user specified.
+$! PARAM_TABLES.COM may be used independently to produce
+$! parameter comparisons, if the input files match the following
+$! conditions :
+$!
+$! 1) Files are named such that a wildcard file name
+$! specification can find all the parameter files.
+$! 2) The files have the same parameters in the same order
+$! (i.e. were generated by the same SYSMAN PARAM SHOW command).
+$! 3) Each file contains parameters from a single node.
+$! 4) The top of each file appears as follows:
+$! (i.e. output generated by SYSMAN PARAM SHOW command)
+$!
+$!%SYSMAN-I-USEACTNOD, a USE ACTIVE has been defaulted on node NODENAME
+$!Node NODENAME: Parameters in use: ACTIVE
+$!0123456789012345678901234567890123456789012345678901234567890123456789
+$!Parameter Name Current Default Minimum Maximum Unit Dynamic
+$!-------------- ------- ------- ------- ------- ---- -------
+$! ....parameters.....
+$! ....parameters.....
+$!
+$!
+$! Programmer:
+$! Mark S. Hawley
+$!
+$! Creation Date:
+$! 08-NOV-1990
+$!
+$! Invoking/Calling Sequence:
+$! @MAYO_PROCS:PARAM_TABLES
+$!
+$! Formal Parameters:
+$! P1 - [optional] Wildcard format of file names to tabularize.
+$! This will be prompted for if missing.
+$!
+$! P2 - [optional] time listings were generated.
+$!
+$! Implicit Inputs:
+$! None
+$!
+$! Implicit Outputs:
+$! None
+$!
+$! Environment:
+$! Runs in non-privileged user mode.
+$!
+$! Library References/Include Files:
+$! None
+$!
+$! Completion Statuses:
+$! None
+$!
+$! Side Effects:
+$! None
+$!
+$!------------------------------------------------------------------------------
+$! Edit History:
+$!
+$! Edit Date By Comments
+$!
+$! 8-Nov-1990 M. Hawley Completed
+$!------------------------------------------------------------------------------
\ No newline at end of file
diff --git a/compare-params-parms-table-dcl b/compare-params-parms-table-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_Y29tcGFyZS1wYXJhbXMtcGFybXMtdGFibGUtZGNs
--- /dev/null
+++ b/compare-params-parms-table-dcl
@@ -0,0 +1,567 @@
+COMPARE_PARAMS (and PARAM_TABLES)
+Mark Hawley, Friday May 13 2011 @ 09:16AM EDT
+COMPARE_PARAMS.COM (calls PARAM_TABLES.COM, following)
+
+$ V = F$Verify(0)
+$ On Control_Y Then Goto Abort_exit
+$ On Error Then Goto Error_exit
+$!------------------------------------------------------------------------------
+$! PROCEDURE: COMPARE_PARAMS.COM
+$!------------------------------------------------------------------------------
+$! MAKE NO ALTERATIONS TO THIS PROCEDURE WITHOUT UPDATING
+$! REVISION BLOCK AT THE END OF THIS FILE
+$!------------------------------------------------------------------------------
+$!
+$!
+$ Write Sys$Output "+---------------------------------------------------+"
+$ Write Sys$Output "| MAYO_PROCS:COMPARE_PARAMS.COM |"
+$ Write Sys$Output "+---------------------------------------------------+"
+$ Write Sys$Output "This procedure automatically gathers and tabularizes"
+$ Write Sys$Output " SYSGEN parameters from nodes supporting SYSMAN"
+$ Write Sys$Output ""
+$ Write Sys$Output "Started at ''F$Time()'"
+$ Write Sys$Output ""
+$ Save_default = F$Environment("DEFAULT")
+$!
+$!------------------------------------------------------------------------------
+$! Determine if we have the privileges necessary to do any of this
+$!------------------------------------------------------------------------------
+$!
+$ Save_privs = F$Setprv("OPER") ! set new, save old priv's
+$ If .not. F$Privilege("OPER")
+$ Then
+$ Say "''Fatal'NOPRIV, Insufficient privilege to use this procedure.''Clrg'"
+$ Goto Done
+$ EndIf
+$!
+$!
+$!------------------------------------------------------------------------------
+$! Prompt for nodes to compare.
+$!------------------------------------------------------------------------------
+$!
+$ Env_loop:
+$ Read /Prompt="Enter /CLUSTER or /NODE=(node1,...) for environment: " -
+/End_of_file=Abort_exit -
+Sys$Command Environment
+$ If F$Locate("/",Environment) .eq. F$Length(Environment) Then -
+Goto Env_loop
+$ If F$Locate("/N",F$Edit(Environment,"UPCASE")) .ne. F$Length(Environment)
+$ Then
+$ Remote = "TRUE"
+$ If F$Mode() .nes. "INTERACTIVE" Then Goto Wrong_mode
+$ Default_account = F$Edit(F$GetJPI("","USERNAME"),"TRIM")
+$ Read /Prompt="Enter Username to use on remote nodes (default is ''Default_account'):" -
+/End_of_file=Abort_exit -
+Sys$command Username
+$ If Username .eqs. "" Then Username = Default_account
+$!! Set Terminal /NoEcho
+$!! Read /Prompt="Enter Password to use on remote nodes" -
+$!!! /End_of_file=Abort_exit -
+$!!! Sys$command Password
+$!! Set Terminal /Echo
+$ Write Sys$Output "" !make a blank line so SYSMAN password prompt doesn't overwrite
+$ Else
+$ Remote = "FALSE"
+$ EndIf
+$!
+$!------------------------------------------------------------------------------
+$! Determine which parameters the user wishes to compare.
+$!------------------------------------------------------------------------------
+$!
+$ Param_loop:
+$ Type Sys$input
+
+
+You may choose any ONE of the following sets of parameters:
+
+
+/ACP /ALL /CLUSTER /DYNAMIC /GEN
+/JOB /LGI /MAJOR /PQL /RMS
+/SCS /SPECIAL /SYS /TTY
+
+
+$ Read /Prompt="Enter selection (default= /ALL): " -
+/End_of_file=Abort_exit -
+Sys$Command Param_set
+$ If Param_set .eqs. "" Then Param_set = "/ALL"
+$ If F$Locate("/",Param_set) .eq. F$Length(Param_set) Then Goto Param_loop
+$!
+$!------------------------------------------------------------------------------
+$! Locate physically where we are, so that the parameter output from all nodes
+$! comes back here, instead of spreading out all over the place due to
+$! remote node logical name translation, etc.
+$!------------------------------------------------------------------------------
+$!
+$!! FourQ = """"
+$!! Local_node = F$GetSYI("NODENAME") + FourQ + FourQ + Username + -
+$!! " ''Password'" + FourQ + FourQ+ "::"
+$ Local_node = F$GetSYI("NODENAME") + "::"
+$ Device = F$Parse("X.X",,,"DEVICE")
+$ Translate = F$TrnLNM(Device-":") !e.g. SYS$SYSROOT
+$ If Translate .nes. "" Then Device = Translate !e.g. $1$DUS0:[SYS3.]
+$ Directory = F$Parse("X.X",,,"DIRECTORY") !e.g. [SYSMGR]
+$ If F$Locate("]",Device) .ne. F$Length(Device) !e.g. $1$DUS0:[SYS3.]
+$ Then
+$ Device = Device - "]" !e.g. $1$DUS0:[SYS3.
+$ Directory = Directory - "[" !e.g. SYSMGR]
+$ EndIf
+$!! Out_file = "SYS$login:SYSMAN_PARAMS.TMP"
+$!! Out_file = "SYS$SCRATCH:SYSMAN_PARAMS.TMP"
+$ Out_file = Device + Directory + "SYSMAN_PARAMS.TMP"
+$!
+$!------------------------------------------------------------------------------
+$! Create the appropriate SYSMAN command file, and execute it to produce the
+$! parameter listing file.
+$!------------------------------------------------------------------------------
+$!
+$ Open /Write Sysman_commands SYSMAN_COMMANDS.TMP
+$ Write Sysman_commands "$ RUN SYS$SYSTEM:SYSMAN"
+$ If Remote
+$ Then
+$ If .not. F$Environment("INTERACTIVE") Then Goto Wrong_mode
+$ Write Sysman_commands " SET ENVIRONMENT ''Environment'/USER=''Username'"
+$ Write Sysman_commands " SET PROFILE /DEFAULT=SYS$SYSTEM /PRIV=ALL" !so SYSMAN doesn't error
+$ Write Sysman_commands " SET TIMEOUT 00:00:10"
+$!! Write Sysman_commands " PARAM SHOW ''Param_set' /OUT=''Local_node'''Out_file'"
+$ Write Sysman_commands " PARAM SHOW ''Param_set' /OUT=''Out_file'"
+$ Else
+$ Write Sysman_commands " SET ENVIRONMENT ''Environment'"
+$ Write Sysman_commands " SET PROFILE /DEFAULT=SYS$SYSTEM /PRIV=ALL" !so SYSMAN doesn't error
+$ Write Sysman_commands " SET TIMEOUT 00:00:10"
+$ Write Sysman_commands " PARAM SHOW ''Param_set' /OUT=''Out_file'"
+$ EndIf
+$ Write Sysman_commands "$ EXIT"
+$ Close Sysman_commands
+$!
+$ Time = F$Time()
+$ @SYSMAN_COMMANDS.TMP
+$ Set Default 'Save_default' !because SYSMAN will have put us in SYS$SYSTEM!
+$ Delete /NoLog SYSMAN_COMMANDS.TMP;*
+$!
+$!------------------------------------------------------------------------------
+$! Read the parameter listing file created, and separate it into individual files for
+$! processing by the "tabularizing" procedure. Each file will be called PARAM_nn.TMP
+$! where "nn" is simply a counter of the files. This will keep the node information
+$! in the same order in the final listing as it was specified by the user - useful
+$! if you wish to keep node information together by hardware type (i.e. 8550's, 780's)
+$! for example.
+$!------------------------------------------------------------------------------
+$!
+$ Open /Read Sysman_outfile 'Out_file'
+$!
+$ Current_node = ""
+$ Write Sys$Output "Examining SYSMAN combined parameter listing ..."
+$ Start:
+$ Read /End_of_file=Done Sysman_outfile Record
+$ If F$Locate("%SYSMAN-I-USE",Record) .ne. F$Length(Record) ! signifies start of new node info
+$ Then
+$ If Current_node .nes. "" Then Close Param_'Current_node' ! close any previous info file, if any
+$ Read /End_of_file=Missing_rec Sysman_outfile Record ! get the next record, which contains node name
+$ Start = F$Locate(" ",Record) + 1 ! start of the name
+$ Colon = F$Locate(":",Record) ! end of the name
+$ Len = Colon - Start ! length of the name
+$ Current_name = F$Edit(F$Extract(Start,Len,Record),"COLLAPSE") ! the node name, w/o spaces
+$ Current_node = Current_node + 1 ! counter, to keep names in user supplied order
+$ If Current_node .le. 9
+$ Then ! open a new file for this node's info ...
+$ Open /Write Param_'Current_node' PARAMS_0'Current_node'.TMP ! ... as PARAMS_01.TMP thru PARAMS_09.TMP ...
+$ Else
+$ Open /Write Param_'Current_node' PARAMS_'Current_node'.TMP ! ... or as PARAMS_10.TMP and up
+$ EndIf
+$ Write Param_'Current_node' Record ! save node name record for COMPARE_PARAMS.COM use
+$ Write Sys$Output "... extracting ''Current_name' records"
+$ Read /End_of_file=Missing_rec Sysman_outfile Junk ! junk header record, discard
+$ Read /End_of_file=Missing_rec Sysman_outfile Junk ! junk header record, discard
+$ Else
+$ Write Param_'Current_node' Record ! output an individual parameters value
+$ EndIf
+$ Goto Start
+$!
+$!------------------------------------------------------------------------------
+$! Normal completion.
+$!------------------------------------------------------------------------------
+$!
+$ Done:
+$ Write Sys$Output "Parameter extraction completed."
+$ Close Sysman_outfile
+$ Close Param_'Current_node'
+$ Delete /NoLog 'Out_file';*
+$ @MAYO_PROCS:PARAM_TABLES.COM "PARAMS_*.TMP" "''Time'"
+$ Delete /NoLog PARAMS_*.TMP;*
+$ Write Sys$Output ""
+$ Write Sys$Output "Completed at ''F$Time()'"
+$ Write Sys$Output "Results are in ''F$Search("COMPARE_PARAMS.LIS;*")'"
+$ Set Default 'Save_default'
+$ If V Then Set Verify
+$ Exit
+$!
+$!------------------------------------------------------------------------------
+$! Error while separating parameter listing.
+$!------------------------------------------------------------------------------
+$!
+$ Missing_rec:
+$ Write Sys$Output "Error - Unexpected end of input from SYSMAN_PARAMS.TMP."
+$ Write Sys$Output "This is probably the result of a timeout of SYSMAN"
+$ Write Sys$Output "on one of the nodes."
+$ Goto Cleanup
+$!
+$!------------------------------------------------------------------------------
+$! Unknown errors.
+$!------------------------------------------------------------------------------
+$!
+$ Error_exit:
+$ Write Sys$Output "Error - Cleanup operation in progress."
+$ Goto Cleanup
+$!
+$!------------------------------------------------------------------------------
+$! Aborted run.
+$!------------------------------------------------------------------------------
+$!
+$ Abort_Exit:
+$ Write Sys$Output "Aborted run - Cleanup operation in progress."
+$ Cleanup:
+$ If F$TrnLnm("Sysman_commands") .nes. "" Then Close Sysman_commands
+$ If F$Search("SYSMAN_COMMANDS.TMP;*") .nes. "" Then Delete /NoLog SYSMAN_COMMANDS.TMP;*
+$ If F$TrnLnm("Sysman_outfile") .nes. "" Then Close Sysman_outfile
+$ If F$Search("SYSMAN_PARAMS.TMP;*") .nes. "" Then Delete /NoLog SYSMAN_PARAMS.TMP;*
+$ If F$TrnLnm("Param_''Current_node'") .nes. "" Then Close Param_'Current_node'
+$ If F$Search("PARAMS_*.TMP;*") .nes. "" Then Delete /NoLog PARAMS_*.TMP;*
+$ Set Default 'Save_default'
+$ Exit
+$!
+$!------------------------------------------------------------------------------
+$! Special conditions.
+$!------------------------------------------------------------------------------
+$!
+$ Wrong_mode:
+$ Write Sys$Output "Error. /NODE=(node1,node2,...) is not allowed from batch"
+$ Write Sys$Output "since a password is required for remote login."
+$ Goto Cleanup
+$!
+$!------------------------------------------------------------------------------
+$!------------------------------------------------------------------------------
+$! Title And Functional Description:
+$!
+$! MAYO_PROCS:COMPARE_PARAMS.COM
+$!
+$! This procedure, in combination with MAYO_PROCS:PARAM_TABLES.COM,
+$! provides a mechanism for creating a tabularized listing of
+$! SYSGEN paramaters from several nodes. This allows for easy
+$! comparison of parameters to facilitate tuning alterations
+$! using AUTOGEN.
+$!
+$! Programmer: Mark Hawley
+$!
+$! Creation Date: 08-NOV-1990
+$! Ported to Mayo: 15-SEP-1995
+$!
+$! Invoking/Calling Sequence: @MAYO_PROCS:COMPARE_PARAMS
+$!
+$! Formal Parameters: None
+$!
+$! Implicit Inputs: "SYSTEM" as the default account to use
+$!
+$! Implicit Outputs: COMPARE_PARAMS.LIS
+$!
+$! Environment:
+$! Must be run from account with privilege to access and
+$! use SYSMAN, specifically the PARAM SHOW command.
+$! In order to use across nodes not all in the same cluster,
+$! it must be run from an account which exists on all the nodes
+$! involved, and has the same password on all nodes.
+$!
+$! Library Ref/Include Files: PARAM_TABLES.COM is called
+$! from this procedure, and is required.
+$!
+$! Completion Statuses: None
+$!
+$! Side Effects: None
+$!
+$!------------------------------------------------------------------------------
+
+
+
+
+PARAM_TABLES.COM (called by COMPARE_PARAMS.COM)
+
+
+$!------------------------------------------------------------------------------
+$! PARAM_TABLES.COM
+$!------------------------------------------------------------------------------
+$! DO NOT MAKE CHANGES TO THIS PROCEDURE WITHOUT UPDATING THE HISTORY
+$! INFORMATION AT THE BOTTOM OF THIS FILE.
+$!------------------------------------------------------------------------------
+$!
+$ On Control_Y Then Goto Abort_exit
+$ Lines_per_page = F$TrnLnm("SYS$LP_LINES")
+$ If Lines_per_page .eqs. "" Then Lines_per_page = 62
+$ Form_feed[0,8] = %X0C
+$!
+$ If P1 .eqs. ""
+$ Then
+$ Type Sys$Input
+
+
+PARAM_TABLES.COM may be used independently to produce
+parameter comparisons, if the input files match the following
+conditions :
+
+
+1) Files are named such that a wildcard file name
+specification can find all the parameter files.
+2) The files have the same parameters in the same order
+(i.e. were generated by the same SYSMAN PARAM SHOW command).
+3) Each file contains parameters from a single node.
+4) The top of each file appears as follows:
+(i.e. output generated by SYSMAN PARAM SHOW command)
+
+
+%SYSMAN-I-USEACTNOD, a USE ACTIVE has been defaulted on node NODENAME
+Node NODENAME: Parameters in use: ACTIVE
+Parameter Name Current Default Minimum Maximum Unit Dynamic
+-------------- ------- ------- ------- ------- ---- -------
+....parameters.....
+....parameters.....
+
+
+
+
+$ Read /Prompt="Enter wildcard format of parameter file names (default= PARAMS_*.TMP) " -
+/End_of_file=Abort_exit -
+Sys$command params_wild
+$ If Params_wild .eqs. "" Then params_wild = "PARAMS_*.TMP"
+$ Else
+$ Params_wild = P1 !format of param file names...
+$ EndIf !...passed from COMPARE_PARAMS.COM
+$!
+$ If P2 .eqs. ""
+$ Then
+$ Time = F$Time() !now - we're probably being run directly
+$ Else
+$ Time = P2 !time when SYSMAN was used to get params...
+$ EndIf !...passed from COMPARE_PARAMS.COM
+$!
+$!------------------------------------------------------------------------------
+$! Locate and open all parameter files
+$!------------------------------------------------------------------------------
+$!
+$ Write Sys$Output "Starting to build tabularized output ..."
+$ Current_file = 1
+$ Find_all_files:
+$ Filename_'Current_file' = F$Search("''Params_wild'")
+$ If (Current_file .eq. 1 .and. Filename_'Current_file' .eqs. "" ) -
+Then Goto Error_exit
+$ If Filename_'Current_file' .eqs. "" Then Goto Found_all
+$ Name = Filename_'Current_file'
+$ Open /Read File_'Current_file' 'Name'
+$ Current_file = Current_file + 1
+$ Goto Find_all_Files
+$!
+$ Found_all:
+$ Max_file = Current_file - 1
+$ If Max_file .eq. 0 then Goto Error_exit
+$!
+$!------------------------------------------------------------------------------
+$! Throw away first record, but take node name off of it first
+$!------------------------------------------------------------------------------
+$!
+$ Underline_record = ""
+$ Current_file = 1
+$ Nodes_loop:
+$ Read File_'Current_file' Junk
+$ Start = F$Locate(" ",Junk) + 1
+$ Colon = F$Locate(":",Junk)
+$ Len = Colon - Start
+$ Node_'Current_file' = F$FAO("!8AS",F$Extract(Start,Len,Junk))
+$ Underline_record = Underline_record + F$FAO("!7*-|")
+$ Current_file = Current_file + 1
+$ If Current_file .le. Max_file Then Goto Nodes_loop
+$!
+$!------------------------------------------------------------------------------
+$! We only want to write whole amounts of 5 parameters separated by a line
+$! (i.e. 6 line groupings), to make the output easily readable. So compute
+$! the number of 6-line grouping we can fit on a page (1 group is the header)
+$!------------------------------------------------------------------------------
+$!
+$ Groupings = Lines_per_page / 6
+$ No_form_feed = (Lines_per_page .eq. (Groupings * 6)) !true if divided evenly
+$!
+$!------------------------------------------------------------------------------
+$! Write the header record
+$!------------------------------------------------------------------------------
+$!
+$ Open /Write Result_file COMPARE_PARAMS.LIS
+$ Hdr_record = F$FAO(" !15AS","Param")
+$ Underline_record = F$FAO("|!14*-|") + Underline_record
+$ Current_file = 1
+$ Page = 1
+$ Header_loop:
+$ Hdr_record = Hdr_record + Node_'Current_file'
+$ Current_file = Current_file + 1
+$ If Current_file .le. Max_file Then Goto Header_loop
+$ Hdr_record = Hdr_record + "Units Dynamic"
+$ Underline_record = Underline_record + F$FAO("!14*-|")
+$ Write Result_file ""
+$ Write Result_file "''Param_list' Parameter Comparison on ''Time' Page ''Page'"
+$ Write Result_file "* Denotes records with values wider then 8 characters"
+$ Write Result_file ""
+$ Write Result_file Hdr_record
+$ Write Result_file Underline_record
+$ Group_count = 1
+$!
+$!------------------------------------------------------------------------------
+$! Read the value from each record, and place in formatted record
+$!------------------------------------------------------------------------------
+$!
+$ Break_5_lines = 1
+$ Loop_values:
+$ Current_file = 1
+$ Get_values:
+$ Read /End_of_File=Done File_'Current_file' Record
+$ Param_len = F$Locate(" ",Record) !wipes " internal value" records
+$ Param = F$FAO(" !15AS",F$Extract(0,Param_len,Record))
+$ If F$Edit(Param,"COLLAPSE") .eqs. "" Then Goto Done ! empty record
+$ Start = Param_len
+$ Value_len = 33 - Start + 1
+$ Value_'Current_file' = F$Edit(F$Extract(Start,Value_len,Record),"COLLAPSE")
+$ If F$Length(Value_'Current_file') .gt. 9 Then - ! add an "*" to the front of the name
+Param = F$FAO("*!15AS",F$Extract(0,Param_len,Record))
+$ Value_'Current_file' = F$FAO("!8AS",Value_'Current_file')
+$ Units = F$FAO("!20AS",F$Edit(F$Extract(67,20,Record),"TRIM"))
+$ If Current_file .eq. 1
+$ Then
+$ Out_record = Param + Value_'Current_file'
+$ Else
+$ Out_record = Out_record + Value_'Current_file'
+$ EndIf
+$ Current_file = Current_file + 1
+$ If Current_file .le. Max_file Then Goto Get_values
+$!
+$ Out_record = Out_record + Units
+$ Write Sys$Output "Processing... ''Param'"
+$ Write Result_file Out_record
+$ Break_5_lines = Break_5_lines + 1
+$ If Break_5_lines .gt. 5 ! blank line every 5
+$ Then
+$ Break_5_lines = 1
+$ Group_count = Group_count + 1
+$ Write Result_file ""
+$ EndIf
+$ If Group_count .lt. Groupings Then Goto Loop_values
+$!
+$ Page = Page + 1
+$ If .not. No_form_feed Then Write Result_file "''Form_feed'"
+$ Write Result_file ""
+$ Write Result_file "Parameter Comparison on ''Time' Page ''Page'"
+$ Write Result_file "* Denotes records with values wider then 8 characters"
+$ Write Result_file ""
+$ Write Result_file Hdr_record
+$ Write Result_file Underline_record
+$ Break_5_lines = 1
+$ Group_count = 1
+$ Goto Loop_values
+$!
+$!------------------------------------------------------------------------------
+$! Close all files and exit
+$!------------------------------------------------------------------------------
+$!
+$ Done:
+$ Current_file = 1
+$ Close_loop:
+$ Close File_'Current_file'
+$ Current_file = Current_file + 1
+$ If Current_file .le. Max_file Then Goto Close_loop
+$ Close Result_file
+$!
+$ Exit
+$!
+$!------------------------------------------------------------------------------
+$! Error Exit
+$!------------------------------------------------------------------------------
+$!
+$ Error_exit:
+$ Write Sys$Output "No files found."
+$ Goto Done
+$ Exit
+$!
+$!------------------------------------------------------------------------------
+$! ABORTED RUN
+$!------------------------------------------------------------------------------
+$!
+$ Abort_exit:
+$ Write Sys$Output "Aborting tabularized listing prepartion."
+$ Goto Done
+$ Exit
+$!------------------------------------------------------------------------------
+$! Title And Functional Description:
+$! MAYO_PROCS:PARAM_TABLES.COM
+$!
+$! This procedure is normally called by MAYO_PROCS:COMPARE_PARAMS.COM
+$! for the preparation of a tabularized listing of SYSGEN parameters
+$! from files generated by COMPARE_PARAMS.COM.
+$! COMPARE_PARAMS.COM uses SYSMAN to access multiple nodes, and
+$! creates files of the form "PARAMS_nn.TMP" for this procedure
+$! to process, where "nn" is a count from 01,02,...,09,10,... up
+$! to the number of nodes the user specified.
+$! PARAM_TABLES.COM may be used independently to produce
+$! parameter comparisons, if the input files match the following
+$! conditions :
+$!
+$! 1) Files are named such that a wildcard file name
+$! specification can find all the parameter files.
+$! 2) The files have the same parameters in the same order
+$! (i.e. were generated by the same SYSMAN PARAM SHOW command).
+$! 3) Each file contains parameters from a single node.
+$! 4) The top of each file appears as follows:
+$! (i.e. output generated by SYSMAN PARAM SHOW command)
+$!
+$!%SYSMAN-I-USEACTNOD, a USE ACTIVE has been defaulted on node NODENAME
+$!Node NODENAME: Parameters in use: ACTIVE
+$!0123456789012345678901234567890123456789012345678901234567890123456789
+$!Parameter Name Current Default Minimum Maximum Unit Dynamic
+$!-------------- ------- ------- ------- ------- ---- -------
+$! ....parameters.....
+$! ....parameters.....
+$!
+$!
+$! Programmer:
+$! Mark S. Hawley
+$!
+$! Creation Date:
+$! 08-NOV-1990
+$!
+$! Invoking/Calling Sequence:
+$! @MAYO_PROCS:PARAM_TABLES
+$!
+$! Formal Parameters:
+$! P1 - [optional] Wildcard format of file names to tabularize.
+$! This will be prompted for if missing.
+$!
+$! P2 - [optional] time listings were generated.
+$!
+$! Implicit Inputs:
+$! None
+$!
+$! Implicit Outputs:
+$! None
+$!
+$! Environment:
+$! Runs in non-privileged user mode.
+$!
+$! Library References/Include Files:
+$! None
+$!
+$! Completion Statuses:
+$! None
+$!
+$! Side Effects:
+$! None
+$!
+$!------------------------------------------------------------------------------
+$! Edit History:
+$!
+$! Edit Date By Comments
+$!
+$! 8-Nov-1990 M. Hawley Completed
+$!------------------------------------------------------------------------------
+
diff --git a/copy-if-newer-dcl b/copy-if-newer-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_Y29weS1pZi1uZXdlci1kY2w=
--- /dev/null
+++ b/copy-if-newer-dcl
@@ -0,0 +1,52 @@
+
+COPY_IF_NEWER
+Joseph Huber, Tuesday September 23 2003 @ 09:14AM EDT
+$!========================================================================
+$!
+$! Name : copy_if_newer.com
+$!
+$! Purpose : copy file from dir p1 to current, if of newer date
+$!
+$! Arguments : P1 = (wild card) directory and file specification
+$! the device:[directory] part is the FROM directory, name.type
+$! lists the current directory, i.e. no missing file copy is done !
+$!
+$! Created 30-APR-1992 J.Huber
+$!
+$!========================================================================
+$ SET ON
+$ ON WARNING THEN $ GOTO EXIT
+$ stream1 = 0
+$ stream2 = 0
+$ delete = "DELETE"
+$ if p1 .eqs. "" then exit
+$ ON ERROR THEN $ GOTO EXIT
+$ ON CONTROL_Y THEN $ GOTO EXIT
+$ fdir = f$parse(p1,,,"DEVICE","SYNTAX_ONLY")+f$parse(p1,,,"DIRECTORY","SYNTAX_ONLY")
+$ wspec = f$parse(p1,"*.*;",,"NAME","SYNTAX_ONLY") + -
+f$parse(p1,"*.*;",,"TYPE","SYNTAX_ONLY")+f$parse(p1,"*.*;",,"VERSION","SYNTAX_ONLY")
+$floop:
+$ ON WARNING THEN $ GOTO fdone
+$ filex = f$search(wspec)
+$ if filex .eqs. "" then goto fdone
+$ if f$file_attributes(filex,"DIRECTORY") then goto floop
+$ bdt = f$file_attributes(filex,"CDT") !get creation date
+$ bdt = f$cvtime(bdt,"COMPARISON") !start time string with year
+$ filen = fdir + f$parse(filex,,,"NAME") + f$parse(filex,,,"TYPE")
+$ file = f$search(filen,stream2)
+$ if file .eqs. "" then goto floop
+$ ON WARNING THEN $!
+$ cdt = f$file_attributes(file,"CDT") !get createion date
+$ cdt = f$cvtime(cdt,"COMPARISON") !start time string with year
+$ if f$extract(0,4,cdt).eqs."1858" then goto floop !no date ?
+$ if cdt .gts. bdt
+$ then
+$ write sys$output " ",file," created ",cdt," after ",filex,":",bdt
+$ fver = f$parse(file,,,"VERSION")
+$ file = file - fver
+$ copy/log 'file' []
+$ endif
+$ goto floop
+$fdone:
+$EXIT:
+$ EXIT
\ No newline at end of file
diff --git a/cpsearch-dcl b/cpsearch-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_Y3BzZWFyY2gtZGNs
--- /dev/null
+++ b/cpsearch-dcl
@@ -0,0 +1,114 @@
+cpsearch
+Thomas Pauli, Tuesday December 02 2003 @ 10:10AM EST
+CPSEARCH shows a clusterwide selection of processes and their data, as far as it is provided by f$getjpi. Just call CPSEARCH with a comma separated list of arguments and get the results. As far as arguments may also be used with f$context they may be qualified. Example: $ @CPSEARCH prcnam=ora_*,nodename=dkbep*,cputim
+$ set noon
+$ on control_y then goto ende
+$ ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+$ ! +
+$ ! + CPSEARCH.COM - Search Cluster-Processes
+$ ! +
+$ ! + usage: @CPSEARCH [item[=value][,item[=value]]...
+$ ! +
+$ ! + item = any legal item for F$GETJPI or F$CONTEXT
+$ ! + value = string to be compared with result of F$GETJPI(ctx,item)
+$ ! +
+$ ! + Every specified item will be displayed. If there is a value with an
+$ ! + item, the trimmed item will be compared with the value, and only matches
+$ ! + will be displayed. If there are more than one items with values, only
+$ ! + those processes matching all values will be displayed (AND).
+$ ! +
+$ ! + 22-APR-1993 Thomas H. Pauli © PSI S+S Berlin 1993
+$ ! +
+$ ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+$ mess = f$environment("MESSAGE")
+$ cont = f$environment("CONTROL")
+$ set message/nofaci/nosever/notext/noident
+$ set control=(y)
+$ on control_y then goto ende
+$ say = "write sys$output"
+$ knwn = "|ACCOUNT|AUTHPRI|CURPRIV|GRP|HW_MODEL|HW_NAME|JOBPRCCNT" + -
+"|JOBTYPE|MASTER_PID|MEM|MODE|NODE_CSID|NODENAME|OWNER" + -
+"|PRCCNT|PRCNAM|PRI|PRIB|STATE|STS|TERMINAL|UIC|USERNAME|"
+$ check_p1:
+$ if P1 .eqs. "" then P1 = "IMAGNAME"
+$ privs:
+$ if .not.f$privilege("WORLD") .and. .not.f$privilege("GROUP")
+$ then
+$ say "%CPSEARCH-I-NOWRLDNOGRP, will show only your own processes."
+$ endif
+$ if .not.f$privilege("WORLD") .and. f$privilege("GROUP")
+$ then
+$ say "%CPSEARCH-I-NOWORLD, will show only processes in your own grou
+p."
+$ endif
+$ start:
+$ ctx = ""
+$ srch = ""
+$ pcnt = 0
+$ nset = "FALSE"
+$ ploop:
+$ strg = f$element(pcnt,",",P1)
+$ pcnt = pcnt + 1
+$ if strg .eqs. "" then goto ploop
+$ if strg .eqs. "," then goto ploop_e
+$ item = f$element(0,"=",strg)
+$ comp = f$element(1,"=",strg)
+$ if comp .eqs. "" then goto ploop_add
+$ if comp .eqs. "=" then goto ploop_add
+$ if f$locate("|''item'|",knwn) .ne. f$length(knwn)
+$ then
+$ tmp = f$context("PROCESS",ctx,"''item'","''comp'","EQL")
+$ srch = srch + "," + item
+$ if item .eqs. "NODENAME" then nset = "TRUE"
+$ goto ploop
+$ endif
+$ ploop_add:
+$ srch = srch + "," + strg
+$ goto ploop
+$ ploop_e:
+$ srch = f$extract(1,2048,srch)
+$ if .not. nset
+$ then
+$ tmp = f$context("PROCESS",ctx,"NODENAME","*","EQL")
+$ endif
+$ loop:
+$ pid = f$pid(ctx)
+$ if pid .eqs. "" then goto ende
+$ user = f$fao("!15AS",f$getjpi(pid,"USERNAME"))
+$ count = 0
+$ tstr = ""
+$ loop1:
+$ strg = f$element(count,",",srch)
+$ count = count + 1
+$ if strg .eqs. "" then goto loop1
+$ if strg .eqs. "," then goto loop1e
+$ item = f$element(0,"=",strg)
+$ comp = f$element(1,"=",strg)
+$ text = f$getjpi(pid,"''item'")
+$ if .not. $status then goto elemerr
+$ text = f$edit(text,"TRIM")
+$ if item .eqs. "IMAGNAME"
+$ then
+$ text = f$parse(text,,,"NAME")
+$ endif
+$ if comp .nes. "" .and. comp .nes. "="
+$ then
+$ if text .nes. comp
+$ then
+$ goto loop
+$ endif
+$ endif
+$ if text .eqs. "" then text = "-"
+$ tstr = tstr + ", " + text
+$ goto loop1
+$ loop1e:
+$ tstr = f$extract(2,999,tstr)
+$ say pid," ",user,": ",tstr
+$ goto loop
+$ elemerr:
+$ say "%CPSEARCH-F-INVITEM, item ''item' is not allowed. See F$GETJPI",-
+" and F$CONTEXT."
+$ ende:
+$ set message'mess'
+$ set control=('cont')
+$ exit
diff --git a/dbd-dcl b/dbd-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_ZGJkLWRjbA==
--- /dev/null
+++ b/dbd-dcl
@@ -0,0 +1,35 @@
+DBD.com
+Aaron Sakovich, Thursday June 05 2003 @ 11:37PM EDT
+$! Days Between Dates
+$! Accepts one or two parameters as VMS standard dates (dd-mmm-yyyy).
+$! If only one, the delta from the current date is calculated.
+$! The global symbol DBD$Delta is set to the calculated value.
+$!
+$ if p2 .eqs. ""
+$ then
+$ p2 = f$cvtime(,"absolute")
+$ SecondDay = "Today"
+$ else
+$ SecondDay = p2
+$ endif
+$ call calculate_day_number "''p1'" "DBD$day1"
+$ call calculate_day_number "''p2'" "DBD$day2"
+$ DBD$Delta == DBD$day1 - DBD$day2
+$ write sys$output -
+f$fao("!AS = !UL, !AS = !UL, delta = !SL", -
+p1, DBD$day1, SecondDay, DBD$day2, DBD$Delta)
+$ exit
+$
+$ calculate_day_number: subroutine
+$! Parameters:
+$! P1 = VMS-spec date (dd-mmm[-yyyy], time portion ignored)
+$! P2 = name of global variable to receive day number
+$!
+$ year = f$integer(f$cvtime(p1,,"year"))
+$ month = f$integer(f$cvtime(p1,,"month"))
+$ day = f$integer(f$cvtime(p1,,"day"))
+$ DayOfYear = f$cvtime(p1,,"DayOfYear")
+$ 'p2' == 44 + (year-1859)*365 + (year-1857)/4 - -
+(year-1801)/100 + (year-1601)/400 + -
+DayOfYear ! base date is 17-Nov-1858
+$ endsubroutine
diff --git a/decnet_reach-dcl b/decnet_reach-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_ZGVjbmV0X3JlYWNoLWRjbA==
--- /dev/null
+++ b/decnet_reach-dcl
@@ -0,0 +1,64 @@
+
+decnet_reach
+Labadie, Wednesday September 24 2003 @ 03:39AM EDT
+$ ! testing Decnet reachability of 3 nodes
+$ ! alpha1
+$ ! alpha2
+$ ! alpha3
+$ ! ending the program when logical
+$ ! trame_state = EXIT ( system table)
+$ ! 'f$ver(0)
+$ set noon
+$ nod = f$getsyi("nodename")
+$ liste="situation ok/alpha1 HS/alpha2 HS/alpha1 and alpha2 HS/alpha3HS/alpha3 a
+nd alpha1 HS/alpha3 and alpha2 HS/alpha3, alpha2, and alpha1 H.S."
+$ ! 0 / 1 /2 / 3 /4
+$ ! 5 / 6 / 7/
+$deb:
+$ open/write lo reseau_alpha1
+$ state = 0
+$ old_state = 0
+$ if f$trnlnm("TRAME_WAIT").eqs."" then def/sys/exec trame_wait "00:02:00"
+$ wr lo "start of procedure at ''f$ti()'"
+$ wr lo "test interval is ''f$trnlnm("TRAME_WAIT")' "
+$ wr lo "procedure running from ''nod', testing alpha1,alpha2 and alpha3"
+$ wr lo "current state is 0 at ''f$ti()'"
+$b1:
+$ if f$trn("trame_state","lnm$system_table","executive",,).eqs."EXIT"
+$ then
+$ goto exit
+$ endif
+$ wait 'f$trnlnm("TRAME_WAIT")
+$ old_state = state
+$ alpha1 = 0
+$ alpha2 = 0
+$ alpha3 = 0
+$ !sh ti
+$ open/err=pb_alpha1 logi alpha1::"23="
+$ close logi
+$ goto alpha2
+$ !sh ti
+$ pb_alpha1:
+$ alpha1 = 1
+$ alpha2:
+$ open/err=pb_alpha2 logi alpha2::"23="
+$ close logi
+$ goto alpha3
+$ pb_alpha2:
+$ alpha2 = 2
+$ alpha3:
+$ open/err=pb_alpha3 logi alpha3::"23="
+$ close logi
+$ goto fin_test
+$ pb_alpha3:
+$ alpha3 = 4
+$ fin_test:
+$ state = alpha1+alpha2+alpha3
+$ if state.ne.old_state then wr lo -
+"new state is ''state' at ''f$ti()' with ''f$ele(state,"/",liste)'"
+$ goto b1
+$exit:
+$ wr lo "end of procedure at ''f$ti()'"
+$ close lo
+$ deas/sys/exec trame_state
+$ exit
\ No newline at end of file
diff --git a/decwho-dcl b/decwho-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_ZGVjd2hvLWRjbA==
--- /dev/null
+++ b/decwho-dcl
@@ -0,0 +1,293 @@
+sendmail.com
+Jerry Alan Braga, Monday March 29 2004 @ 11:17AM EST
+$!
+$! Send Mail with Mime
+$!
+$! Requirements:
+$! MC MIME utility for attachment rendering
+$! TCPIP send from File utility if using SMTP
+$!
+$! Logicals if Defined
+$! define/system sendmail_mode ! "SMTP" or "MAIL"
+$! define/system sendmail_domain ! Overrides the default domain
+$! define/system sendmail_sff ! Send from file image to use for smtp
+$!
+$! Usage:
+$! @sendmail "to_address,..." "Subject" "Body" "Attachment,..." "Mode"
+$!
+$ Main:
+$!-----
+$ Gosub Initialize
+$ Gosub Header
+$ Gosub Body
+$ Gosub Attachments
+$ Gosub Send
+$ Gosub Finish
+$!
+$ Exit
+$!
+$ Initialize:
+$!-----------
+$!
+$ proc = f$edit(f$parse(f$enviornment("PROCEDURE"),,,"NAME"),"LOWERCASE,COLLAPSE")
+$ username = f$edit(f$getjpi("","USERNAME"),"LOWERCASE,COLLAPSE")
+$ pid = f$getjpi("","PID")
+$ tmp_inp = "sys$scratch:''proc'''pid'.tmp"
+$ tmp_eml = "sys$scratch:''proc'''pid'.eml"
+$ dq = """
+$!
+$! -- Get the Send From File Image --
+$!
+$ sff = f$trnlnm("''proc'_sff")
+$ if (sff .eqs. "")
+$ then sff = "$sys$system:tcpip$smtp_sff.exe"
+$ else sff = "$''sff'"
+$ endif
+$!
+$! -- Get Email Domain --
+$!
+$ inet_domain = f$edit(f$trnlnm("''proc'_domain"),"LOWERCASE,COLLAPSE")
+$ if (inet_domain .eqs. "") then inet_domain = f$edit(f$trnlnm("TCPIP$INET_DOMAIN"),"LOWERCASE,COLLAPSE")
+$!
+$! -- RFC Message ID xxxxx.xxxxx --
+$!
+$ message_id = "''f$cvtime(,,"DAYOFYEAR")'''f$cvtime(,,"SECONDOFYEAR")'"
+$ message_id = "''message_id'.''f$cvtime(,,"HOUROFYEAR")'''f$cvtime(,,"SECONDOFYEAR")'"
+$!
+$! -- RFC Date time Day, DD MON YYYY HH:MM:SS.CC --
+$!
+$ datetime = -
+f$extract(0,3,f$cvtime(,"ABSOLUTE","WEEKDAY")) + ", " + -
+f$cvtime(,"ABSOLUTE","DAY") + " " + f$cvtime(,"ABSOLUTE","MONTH") + " " + -
+f$cvtime(,"ABSOLUTE","YEAR") + " " + f$cvtime(,"ABSOLUTE","TIME")
+$!
+$! *** Start Parameters ***
+$!
+$ p_address = f$edit("''p1'","TRIM") ! Email address(s)
+$ p_subject = f$edit("''p2'","TRIM") ! Subject
+$ p_body = f$edit("''p3'","TRIM") ! Can be A Filename or message
+$ p_attach = f$edit("''p4'","TRIM") ! File(s)
+$ p_mode = f$edit("''p5'","UPCASE,COLLAPSE") ! SMTP, MAIL
+$!
+$! *** End Parameters ***
+$!
+$! -- Check Mode Logical --
+$!
+$ l_mode = f$edit(f$trnlnm("''proc'_mode"),"UPCASE,COLLAPSE")
+$ if (l_mode .nes. "" .and. p_mode .eqs. "") then p_mode = l_mode
+$!
+$! -- Address Must be passed ---
+$!
+$ if (p_address .eqs. "")
+$ then
+$ write sys$output ""
+$ write sys$output "Email Address Required"
+$ exit
+$ endif
+$!
+$! If Mode is SMTP the check for the Image Required
+$!
+$ if (p_mode .eqs. "SMTP" .and. f$search(f$extract(1,f$length(sff),sff)) .eqs. "")
+$ then
+$ write sys$output ""
+$ write sys$output "Cannot Find ''sff'"
+$ exit
+$ endif
+$!
+$! Check to See if To Address is a single address with No Domain
+$! If this is true assume the same domain as sender
+$! This emulates VMS mail based
+$! This is required as the mail/for will not work without @domain.com
+$!
+$ if (f$locate(",",p_address) .eq. f$length(p_address) .and. f$locate("@",p_address) .eq. f$length(p_address))
+$ then
+$ p_address = "''p_address'@''inet_domain'"
+$ endif
+$!
+$ return
+$!
+$ Header:
+$!-------
+$!
+$ open/write f 'tmp_eml'
+$!
+$! If No Attachments are to be Used then Must Write Text Header
+$! As MC MIME will not be used to Create it
+$!
+$ if (p_attach .eqs. "")
+$ then
+$ boundry = "OpenVMS/MIME.''message_id'"
+$ write f "Mime-version: 1.0"
+$ write f "Content-Type: multipart/mixed; boundary=''boundry'"
+$ write f "Content-Transfer-Encoding: 7bit"
+$ write f "Message-ID: <''message_id'@OpenVMS>"
+$ write f ""
+$ write f ""
+$ write f "--''boundry'"
+$ endif
+$ write f "Content-Type: text/plain; charset=ISO-8859-1"
+$ write f "Content-Transfer-Encoding: 7bit"
+$ write f "Content-Disposition: inline"
+$ write f ""
+$!
+$ close f
+$!
+$ Return
+$!
+$ Body:
+$!-----
+$!
+$! Body Of Message Can be an input file or a Text String
+$!
+$ if (f$search("''p_body'") .nes. "")
+$ then
+$ convert/append 'p_body' 'tmp_eml'
+$ else
+$ open/append f 'tmp_eml'
+$ write f "''p_body'"
+$ close f
+$ endif
+$!
+$ Return
+$!
+$ Attachments:
+$!------------
+$!
+$! Parse Multiple attachments and add according to file format
+$! using the MIME utility
+$!
+$ files = p_attach
+$ afnd = 0
+$ aloop:
+$ if (files .eqs. "") then goto aeof
+$ comma = f$locate(",",files)
+$ if (comma .ne. f$length(files))
+$ then file = f$extract(0,comma,files)
+$ else file = files
+$ endif
+$!
+$ fspec = f$search(file)
+$ if (fspec .eqs. "") then goto aloop
+$
+$ if (.not. afnd)
+$ then
+$ open/write f 'tmp_inp'
+$ write f "open/draft ''tmp_eml'"
+$ afnd = 1
+$ endif
+$!
+$! If File is FIX then must use binary type attachment
+$! Otherwise allow MIME utility to detect it
+$!
+$ rfm = f$file_attributes(fspec, "RFM")
+$ if (rfm .eqs. "FIX")
+$ then mime_type = "/BINARY"
+$ else mime_type = ""
+$ endif
+$!
+$ open/append f 'tmp_inp'
+$ write f "add''mime_type' ''file'"
+$ close f
+$!
+$ if (comma .eq. f$length(files))
+$ then files = ""
+$ else files = f$extract(comma+1,f$length(files),files)
+$ endif
+$ goto aloop
+$ aeof: if (.not. afnd) then return
+$ open/append f 'tmp_inp'
+$ write f "save"
+$ write f "exit"
+$ close f
+$!
+$! Run MIME utility with the imput file above
+$!
+$ define/user sys$input 'tmp_inp'
+$ define/user sys$output nl:
+$!
+$ mc mime
+$!
+$ delete/nolog/noconfirm 'tmp_inp';*
+$!
+$ Return
+$!
+$ Send:
+$!-----
+$!
+$ if (p_mode .eqs. "SMTP")
+$ then
+$!
+$! Parse thru all addresses and send out a email for each
+$!
+$ address = p_address - "<" - ">"
+$ fspec = f$search(tmp_eml)
+$ eloop:
+$ if (address .eqs. "") then goto eeof
+$ comma = f$locate(",",address)
+$ if (comma .ne. f$length(address))
+$ then taddress = f$extract(0,comma,address)
+$ else taddress = address
+$ endif
+$!
+$! Look for a SMTP extended formated message Name Address
+$! and Rewrite Address as "Name"
+
+$!
+$ len = f$length(taddress)
+$ pos = f$locate(" ",taddress)
+$ if (pos .ne. f$length(taddress))
+$ then
+$ pos = len
+$ al: pos = pos - 1
+$ if (f$extract(pos,1,taddress) .nes. " ") then goto al
+$ to_address = "<" + f$extract(pos+1,len,taddress) + ">"
+$ to_name = dq + f$extract(0,pos,taddress) + dq + " " + to_address
+$ else
+$ to_address = "<" + taddress + ">"
+$ to_name = to_address
+$ endif
+$!
+$! If Email is Based on Using SMTP must write full Envelope Header
+$! Have to Write the Envelope Header for Each Destination
+$!
+$ open/write f 'tmp_eml'
+$ write f "MAIL FROM:<''username'@''inet_domain'>"
+$ write f "RCPT TO:",to_address
+$ write f "DATA"
+$ write f "Reply-To: <''username'@''inet_domain'>"
+$ write f "From: <''username'@''inet_domain'>"
+$ write f "To: ",to_name
+$ write f "Subject: ",p_subject
+$ write f "Date: ",datetime
+$ close f
+$!
+$! Append the MIME rendered Version to This
+$!
+$ convert/append 'fspec' 'tmp_eml'
+$!
+$! Use the TCPIP SMTP Send From File Utility
+$!
+$ sff 'tmp_eml'
+$! sff 'tmp_eml' -loglevel 1
+$!
+$ if (comma .eq. f$length(address))
+$ then address = ""
+$ else address = f$extract(comma+1,f$length(address),address)
+$ endif
+$ goto eloop
+$ eeof:
+$ else
+$!
+$! Use Standard Mail With the Foreign Switch
+$!
+$ mail/for/subject="''p_subject'" 'tmp_eml' "''p_address'"
+$ endif
+$!
+$ delete/nolog/noconfirm 'tmp_eml';*
+$!
+$ return
+$!
+$ Finish:
+$!-------
+$!
+$ exit
diff --git a/disk-usage-dcl b/disk-usage-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_ZGlzay11c2FnZS1kY2w=
--- /dev/null
+++ b/disk-usage-dcl
@@ -0,0 +1,681 @@
+CLAS$PATCH_WORK_C.COM and CLAS$PATCH_WORK_FORTRAN.COM
+Henry G. Juengst, Monday December 22 2003 @ 03:32PM EST
+Below are two procedures which help to adapt unix Fortran code quickly so that you can start to use it. The long term solution of course is to fix the code.
+OpenVMS provides calling standard which allows us to develop source code in various languages (not counting Java as a useful programming language). Unix does not define such a standard (Posix and System V definitions do not address this issue the way VMS does).
+
+Most notorious are games with leading and trailing underscore characters ("_") in unix software environments. Various unix derivatives use them to separate assembler, C and other code, a most unsatisfying and stupid approach. This is not only system specific, but also compiler specific. Some compilers also add dollar characters.
+
+The other critical issue is the way how character strings are passed by unix Fortran compilers. The problem is that unix in its primitive form has no definition of a descriptor. VMS does. While there is again no standard, most unix compilers pass the address of a character string at the position of the actual procedure argument and append the missing string length to the end of the argument list. This is not only ambiguous, but also not VMS compatible and certainly hidden arguments are unsatisfying.
+
+The two procedures listed below help me to address both issues on a temporary basis.
+
+Unfortunately some unexperienced unix users also use case sensitive identifiers to distinguish between e.g. Fortran and C style arguments. For example in Fortran (and many other languages) arguments are passed by reference, while in C scalar data are typically passed by value. Things get really difficult when unix users write a C "wrapper" routine with the same name of an existing Fortran routine, but with the name in lower case and all or some argument passing mechanisms changed. Obviously this is not too helpful when dealing with case _insensitive_ identifiers from various non-C languages in a VMS environment. I do not fix these problems with an automatic procedure, because in my experience this always needs to be fixed by an understanding VMS software developer. Since this issue only appears in C code I often put the fix into a C header file.
+
+The idea behind the two procedures below is to produce a C header file to fix the C code. One common patch header file includes the project specific header files, each project specific header file includes project specific fixes (see last mentioned problem category) and also includes the C and Fortran header files produced by the two DCL procedures below.
+
+The procedures expect each one text file. The text files contain the names of the procedures which need to be fixed. List one procedure name per line. For example if your project name is DC, then a you may have these two files in your DC project directory:
+
+(DC$PATCH_WORK_C.TXT)
+
+DC_MAKE_DGEO
+TESTMAP
+DC_READ_MAP_FLOAT FUNCTION 5 2 3
+DC_READ_MAP_INT FUNCTION 5 2 3
+DC_XVST_FCT
+(DC$PATCH_WORK_FORTRAN.TXT)
+
+DC_SET_DEF
+DC_TCL_INIT
+DDLY2DC_CAL_TDLY
+Then you call CLAS$PATCH_WORK_C and CLAS$PATCH_WORK_FORTRAN from a common tool directory. BTW CLAS is the name of the big all-embracing project, while DC etc. are just componets of CLAS. In the command files below you will find logical names like CLAS$SCRATCH_PATCH_WORK and CLAS$INCLUDE. You may want to change the prefix of those names.
+
+The first argument in *$PATCH_WORK_C.TXT indicates whether a procedure is a FUNCTION or SUBROUTINE. The following numbers in *$PATCH_WORK_C.TXT indicate the total number of arguments of a routine and the position of character string arguments.
+
+The two procedures only update one header file each and only when necessary. I suggest to run the procedures in an MMS description file as action of the .FIRST target so that the header files are produced before any other source code is being compiled.
+
+Here are the two DCL procedures CLAS$PATCH_WORK_C.COM and CLAS$PATCH_WORK_FORTRAN.COM ... I hope they help other people to get started with alien unix hacks.
+
+$!CLAS$PATCH_WORK_C.COM
+$IF P1.EQS.""
+$THEN
+$ MY_LIBRARY_FILE_SPEC=F$SEARCH("*$PATCH_WORK_C.TXT")
+$ IF MY_LIBRARY_FILE_SPEC.EQS.""
+$ THEN
+$ WRITE SYS$ERROR "Missing *$PATCH_WORK_C.TXT"
+$ EXIT
+$ ENDIF
+$ MY_LIBRARY=F$PARSE(MY_LIBRARY_FILE_SPEC,,,"NAME",)-"$PATCH_WORK_C"
+$ELSE
+$ MY_LIBRARY=P1
+$ENDIF
+$
+$OPEN/READ MY_LIST_FCB 'MY_LIBRARY'$PATCH_WORK_C.TXT
+$OPEN/WRITE MY_PATCH_C_FCB CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_C_'F$GETJPI("","PID")'.C
+$OPEN/WRITE MY_PATCH_H_FCB CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_C_'F$GETJPI("","PID")'.H
+$WRITE MY_PATCH_C_FCB "#include "
+$WRITE MY_PATCH_H_FCB "#ifndef ''MY_LIBRARY'$PATCH_WORK_C_H"
+$WRITE MY_PATCH_H_FCB "#define ''MY_LIBRARY'$PATCH_WORK_C_H"
+$WRITE MY_PATCH_H_FCB "#ifdef VMS"
+$LIST_LOOP:
+$READ/END=LIST_DONE MY_LIST_FCB MY_LIST_LINE
+$MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$IF MY_LIST_SEPARATOR.EQ.F$LENGTH(MY_LIST_LINE)
+$THEN
+$ WRITE MY_PATCH_H_FCB "#define ''F$EDIT(MY_LIST_LINE,"LOWERCASE")'_ ''MY_LIST_LINE'"
+$ELSE
+$ MY_LIST_MODULE=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ WRITE MY_PATCH_H_FCB "#define ''F$EDIT(MY_LIST_MODULE,"LOWERCASE")' ''MY_LIST_MODULE'_CC"
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_KIND=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_COUNT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_SEPARATOR.EQ.F$LENGTH(MY_LIST_LINE)
+$ THEN
+$ MY_LIST_LINE=""
+$ ELSE
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ ENDIF
+$ MY_LIST_LINE_BACKUP=MY_LIST_LINE
+$
+$ IF MY_LIST_KIND.EQS."FUNCTION"
+$ THEN
+$ WRITE MY_PATCH_C_FCB "extern void *''MY_LIST_MODULE'_("
+$ ELSE
+$ WRITE MY_PATCH_C_FCB "extern void ''MY_LIST_MODULE'_("
+$ ENDIF
+$
+$ MY_LIST_LINE=MY_LIST_LINE_BACKUP
+$ MY_LIST_ARGUMENT=1
+$ MY_LIST_ARGUMENT_STRING_LAST=MY_LIST_ARGUMENT_COUNT
+$ MY_LIST_ARG_ANY_STRING_FLAG=0
+$ ARG_1_LOOP:
+$ IF MY_LIST_LINE.EQS.""
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ELSE
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_NEXT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_ARGUMENT.EQ.F$INTEGER(MY_LIST_ARGUMENT_STRING_NEXT)
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=1
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_LAST=MY_LIST_ARGUMENT
+$ ELSE
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$ MY_LIST_ARG_ANY_STRING_FLAG=1
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ IF MY_LIST_ARG_ANY_STRING_FLAG
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ MY_LIST_ARG_END=");"
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$ WRITE MY_PATCH_C_FCB " char *arg''MY_LIST_ARGUMENT'''MY_LIST_ARG_END'"
+$ ELSE
+$ WRITE MY_PATCH_C_FCB " void *arg''MY_LIST_ARGUMENT'''MY_LIST_ARG_END'"
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARGUMENT=MY_LIST_ARGUMENT+1
+$ GOTO ARG_1_LOOP
+$ ENDIF
+$
+$ MY_LIST_LINE=MY_LIST_LINE_BACKUP
+$ MY_LIST_ARGUMENT=1
+$ ARG_2_LOOP:
+$ IF MY_LIST_LINE.EQS.""
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ELSE
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_NEXT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_ARGUMENT.EQ.F$INTEGER(MY_LIST_ARGUMENT_STRING_NEXT)
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=1
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ ELSE
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_STRING_LAST
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ MY_LIST_ARG_END=");"
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$ WRITE MY_PATCH_C_FCB " int arg''MY_LIST_ARGUMENT'_len''MY_LIST_ARG_END'"
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARGUMENT=MY_LIST_ARGUMENT+1
+$ GOTO ARG_2_LOOP
+$ ENDIF
+$
+$ IF MY_LIST_KIND.EQS."FUNCTION"
+$ THEN
+$ WRITE MY_PATCH_C_FCB "void *''MY_LIST_MODULE'("
+$ ELSE
+$ WRITE MY_PATCH_C_FCB "void ''MY_LIST_MODULE'("
+$ ENDIF
+$
+$ MY_LIST_LINE=MY_LIST_LINE_BACKUP
+$ MY_LIST_ARGUMENT=1
+$ ARG_3_LOOP:
+$ IF MY_LIST_LINE.EQS.""
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ELSE
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_NEXT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_ARGUMENT.EQ.F$INTEGER(MY_LIST_ARGUMENT_STRING_NEXT)
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=1
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ ELSE
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ MY_LIST_ARG_END=")"
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$! WRITE MY_PATCH_C_FCB " struct dsc64$descriptor_s *arg''MY_LIST_ARGUMENT'_dsc''MY_LIST_ARG_END'"
+$ WRITE MY_PATCH_C_FCB " struct dsc$descriptor_s *arg''MY_LIST_ARGUMENT'_dsc''MY_LIST_ARG_END'"
+$ ELSE
+$ WRITE MY_PATCH_C_FCB " void *arg''MY_LIST_ARGUMENT'''MY_LIST_ARG_END'"
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARGUMENT=MY_LIST_ARGUMENT+1
+$ GOTO ARG_3_LOOP
+$ ENDIF
+$
+$ WRITE MY_PATCH_C_FCB " {"
+$
+$ IF MY_LIST_KIND.EQS."FUNCTION"
+$ THEN
+$ WRITE MY_PATCH_C_FCB " return ''MY_LIST_MODULE'_("
+$ ELSE
+$ WRITE MY_PATCH_C_FCB " ''MY_LIST_MODULE'_("
+$ ENDIF
+$
+$ MY_LIST_LINE=MY_LIST_LINE_BACKUP
+$ MY_LIST_ARGUMENT=1
+$ ARG_4_LOOP:
+$ IF MY_LIST_LINE.EQS.""
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ELSE
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_NEXT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_ARGUMENT.EQ.F$INTEGER(MY_LIST_ARGUMENT_STRING_NEXT)
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=1
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ ELSE
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ IF MY_LIST_ARG_ANY_STRING_FLAG
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ MY_LIST_ARG_END=");"
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$! WRITE MY_PATCH_C_FCB " (char*)arg''MY_LIST_ARGUMENT'_dsc->dsc64$pq_pointer''MY_LIST_ARG_END'"
+$ WRITE MY_PATCH_C_FCB " (char*)arg''MY_LIST_ARGUMENT'_dsc->dsc$a_pointer''MY_LIST_ARG_END'"
+$ ELSE
+$ WRITE MY_PATCH_C_FCB " arg''MY_LIST_ARGUMENT'''MY_LIST_ARG_END'"
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARGUMENT=MY_LIST_ARGUMENT+1
+$ GOTO ARG_4_LOOP
+$ ENDIF
+$
+$ MY_LIST_LINE=MY_LIST_LINE_BACKUP
+$ MY_LIST_ARGUMENT=1
+$ ARG_5_LOOP:
+$ IF MY_LIST_LINE.EQS.""
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ELSE
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_NEXT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_ARGUMENT.EQ.F$INTEGER(MY_LIST_ARGUMENT_STRING_NEXT)
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=1
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ ELSE
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_STRING_LAST
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ MY_LIST_ARG_END=");"
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$! WRITE MY_PATCH_C_FCB " (int)arg''MY_LIST_ARGUMENT'_dsc->dsc64$q_length''MY_LIST_ARG_END'"
+$ WRITE MY_PATCH_C_FCB " (int)arg''MY_LIST_ARGUMENT'_dsc->dsc$w_length''MY_LIST_ARG_END'"
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARGUMENT=MY_LIST_ARGUMENT+1
+$ GOTO ARG_5_LOOP
+$ ENDIF
+$
+$ WRITE MY_PATCH_C_FCB " }"
+$ENDIF
+$GOTO LIST_LOOP
+$LIST_DONE:
+$WRITE MY_PATCH_H_FCB "#endif"
+$WRITE MY_PATCH_H_FCB "#endif"
+$CLOSE MY_PATCH_H_FCB
+$CLOSE MY_PATCH_C_FCB
+$CLOSE MY_LIST_FCB
+$
+$CALL UPDATE CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_C_'F$GETJPI("","PID")'.C SYS$DISK:[]'MY_LIBRARY'$PATCH_WORK_C.C
+$CALL UPDATE CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_C_'F$GETJPI("","PID")'.H CLAS$INCLUDE:'MY_LIBRARY'$PATCH_WORK_C.H
+$
+$DELETE CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_C_'F$GETJPI("","PID")'.C;*
+$DELETE CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_C_'F$GETJPI("","PID")'.H;*
+$
+$EXIT
+$
+$UPDATE: SUBROUTINE
+$IF F$SEARCH(P2).NES.""
+$THEN
+$ DIFFERENCES/IGNORE=(BLANK_LINES,CASE,FORM_FEEDS,SPACING,TRAILING_SPACES)/OUTPUT=NL: 'P1' 'P2'
+$ IF $STATUS.NE.%X006C8009
+$ THEN
+$ !****************************
+$ !* Files are not identical. *
+$ !****************************
+$ IF $STATUS.EQ.%X006C8013
+$ THEN
+$ COPY/LOG 'P1' 'P2'_TMP
+$ RENAME 'P2'_TMP 'P2'
+$ PURGE 'P2'
+$ RENAME 'P2' ;1
+$ ELSE
+$ MY_STATUS=$STATUS
+$ WRITE SYS$OUTPUT "Unknown status from DIFFERENCES, procedure stopped."
+$ EXIT 'MY_STATUS'
+$ ENDIF
+$ ENDIF
+$ELSE
+$ COPY/LOG 'P1' 'P2'
+$ENDIF
+$EXIT
+$ENDSUBROUTINE
+$!CLAS$PATCH_WORK_FORTRAN.COM
+$IF P1.EQS.""
+$THEN
+$ MY_LIBRARY_FILE_SPEC=F$SEARCH("*$PATCH_WORK_FORTRAN.TXT")
+$ IF MY_LIBRARY_FILE_SPEC.EQS.""
+$ THEN
+$ WRITE SYS$ERROR "Missing *$PATCH_WORK_FORTRAN.TXT"
+$ EXIT
+$ ENDIF
+$ MY_LIBRARY=F$PARSE(MY_LIBRARY_FILE_SPEC,,,"NAME",)-"$PATCH_WORK_FORTRAN"
+$ELSE
+$ MY_LIBRARY=P1
+$ENDIF
+$
+$MY_LIBRARY=F$EDIT(MY_LIBRARY,"COLLAPSE,UPCASE")
+$
+$OPEN/READ MY_LIST_FCB 'MY_LIBRARY'$PATCH_WORK_FORTRAN.TXT
+$OPEN/WRITE MY_PATCH_C_FCB CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_FORTRAN_'F$GETJPI("","PID")'.C
+$OPEN/WRITE MY_PATCH_H_FCB CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_FORTRAN_'F$GETJPI("","PID")'.H
+$WRITE MY_PATCH_C_FCB "#include "
+$WRITE MY_PATCH_C_FCB "#include "
+$WRITE MY_PATCH_C_FCB "#include "
+$WRITE MY_PATCH_C_FCB "#include "
+$WRITE MY_PATCH_C_FCB ""
+$WRITE MY_PATCH_C_FCB "static unsigned short ",F$EDIT(MY_LIBRARY,"LOWERCASE"),"$vms_cstrlen_to_strlen(const int arg_len)"
+$WRITE MY_PATCH_C_FCB " { union"
+$WRITE MY_PATCH_C_FCB " { unsigned short s[2];"
+$WRITE MY_PATCH_C_FCB " int i;"
+$WRITE MY_PATCH_C_FCB " } conv;"
+$WRITE MY_PATCH_C_FCB " conv.i=arg_len;"
+$WRITE MY_PATCH_C_FCB " if ((unsigned int)conv.s[0]>0x7fff)"
+$WRITE MY_PATCH_C_FCB " lib$stop(SS$_BADPARAM);"
+$WRITE MY_PATCH_C_FCB " if ((unsigned int)conv.s[1])"
+$WRITE MY_PATCH_C_FCB " lib$stop(SS$_BADPARAM);"
+$WRITE MY_PATCH_C_FCB " return conv.s[0];"
+$WRITE MY_PATCH_C_FCB " }"
+$WRITE MY_PATCH_C_FCB ""
+$WRITE MY_PATCH_H_FCB "#ifndef ''MY_LIBRARY'$PATCH_WORK_FORTRAN_H"
+$WRITE MY_PATCH_H_FCB "#define ''MY_LIBRARY'$PATCH_WORK_FORTRAN_H"
+$WRITE MY_PATCH_H_FCB "#ifdef VMS"
+$LIST_LOOP:
+$READ/END=LIST_DONE MY_LIST_FCB MY_LIST_LINE
+$MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$IF MY_LIST_SEPARATOR.EQ.F$LENGTH(MY_LIST_LINE)
+$THEN
+$ WRITE MY_PATCH_H_FCB "#define ''F$EDIT(MY_LIST_LINE,"LOWERCASE")'_ ''MY_LIST_LINE'"
+$ELSE
+$ MY_LIST_MODULE=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_KIND=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_COUNT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_SEPARATOR.EQ.F$LENGTH(MY_LIST_LINE)
+$ THEN
+$ MY_LIST_LINE=""
+$ ELSE
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ ENDIF
+$ MY_LIST_LINE_BACKUP=MY_LIST_LINE
+$
+$ IF MY_LIST_KIND.EQS."FUNCTION"
+$ THEN
+$ WRITE MY_PATCH_C_FCB "extern void *''MY_LIST_MODULE'("
+$ ELSE
+$ WRITE MY_PATCH_C_FCB "extern void ''MY_LIST_MODULE'("
+$ ENDIF
+$
+$ MY_LIST_ARGUMENT=1
+$ MY_LIST_ARGUMENT_STRING_LAST=MY_LIST_ARGUMENT_COUNT
+$ ARG_1_LOOP:
+$ IF MY_LIST_LINE.EQS.""
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ELSE
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_NEXT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_ARGUMENT.EQ.F$INTEGER(MY_LIST_ARGUMENT_STRING_NEXT)
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=1
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_LAST=MY_LIST_ARGUMENT
+$ ELSE
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ MY_LIST_ARG_END=");"
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$ WRITE MY_PATCH_C_FCB " struct dsc$descriptor_s *arg''MY_LIST_ARGUMENT'_dsc''MY_LIST_ARG_END'"
+$ ELSE
+$ WRITE MY_PATCH_C_FCB " void *arg''MY_LIST_ARGUMENT'''MY_LIST_ARG_END'"
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARGUMENT=MY_LIST_ARGUMENT+1
+$ GOTO ARG_1_LOOP
+$ ENDIF
+$
+$ IF MY_LIST_KIND.EQS."FUNCTION"
+$ THEN
+$ WRITE MY_PATCH_C_FCB "void *''MY_LIST_MODULE'_("
+$ ELSE
+$ WRITE MY_PATCH_C_FCB "void ''MY_LIST_MODULE'_("
+$ ENDIF
+$
+$ MY_LIST_LINE=MY_LIST_LINE_BACKUP
+$ MY_LIST_ARGUMENT=1
+$ MY_LIST_ARG_ANY_STRING_FLAG=0
+$ ARG_2_LOOP:
+$ IF MY_LIST_LINE.EQS.""
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ELSE
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_NEXT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_ARGUMENT.EQ.F$INTEGER(MY_LIST_ARGUMENT_STRING_NEXT)
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=1
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ ELSE
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$ MY_LIST_ARG_ANY_STRING_FLAG=1
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ IF MY_LIST_ARG_ANY_STRING_FLAG
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ MY_LIST_ARG_END=")"
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$ WRITE MY_PATCH_C_FCB " char *const arg''MY_LIST_ARGUMENT'''MY_LIST_ARG_END'"
+$ ELSE
+$ WRITE MY_PATCH_C_FCB " void *arg''MY_LIST_ARGUMENT'''MY_LIST_ARG_END'"
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARGUMENT=MY_LIST_ARGUMENT+1
+$ GOTO ARG_2_LOOP
+$ ENDIF
+$
+$ MY_LIST_LINE=MY_LIST_LINE_BACKUP
+$ MY_LIST_ARGUMENT=1
+$ ARG_3_LOOP:
+$ IF MY_LIST_LINE.EQS.""
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ELSE
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_NEXT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_ARGUMENT.EQ.F$INTEGER(MY_LIST_ARGUMENT_STRING_NEXT)
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=1
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ ELSE
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_STRING_LAST
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ MY_LIST_ARG_END=")"
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$ WRITE MY_PATCH_C_FCB " const int arg''MY_LIST_ARGUMENT'_len''MY_LIST_ARG_END'"
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARGUMENT=MY_LIST_ARGUMENT+1
+$ GOTO ARG_3_LOOP
+$ ENDIF
+$
+$ WRITE MY_PATCH_C_FCB " {"
+$
+$ MY_LIST_LINE=MY_LIST_LINE_BACKUP
+$ MY_LIST_ARGUMENT=1
+$ ARG_3_LOOP:
+$ IF MY_LIST_LINE.EQS.""
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ELSE
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_NEXT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_ARGUMENT.EQ.F$INTEGER(MY_LIST_ARGUMENT_STRING_NEXT)
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=1
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ ELSE
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$ WRITE MY_PATCH_C_FCB " struct dsc$descriptor_s arg''MY_LIST_ARGUMENT'_dsc={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL};"
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARGUMENT=MY_LIST_ARGUMENT+1
+$ GOTO ARG_3_LOOP
+$ ENDIF
+$
+$ WRITE MY_PATCH_C_FCB ""
+$
+$ MY_LIST_LINE=MY_LIST_LINE_BACKUP
+$ MY_LIST_ARGUMENT=1
+$ MY_LIST_ARG_ANY_STRING_FLAG=0
+$ ARG_4_LOOP:
+$ IF MY_LIST_LINE.EQS.""
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ELSE
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_NEXT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_ARGUMENT.EQ.F$INTEGER(MY_LIST_ARGUMENT_STRING_NEXT)
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=1
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ ELSE
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$ WRITE MY_PATCH_C_FCB " arg''MY_LIST_ARGUMENT'_dsc.dsc$w_length=",F$EDIT(MY_LIBRARY,"LOWERCASE"),-
+"$vms_cstrlen_to_strlen(arg''MY_LIST_ARGUMENT'_len);"
+$ WRITE MY_PATCH_C_FCB " arg''MY_LIST_ARGUMENT'_dsc.dsc$a_pointer=arg''MY_LIST_ARGUMENT';"
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARGUMENT=MY_LIST_ARGUMENT+1
+$ GOTO ARG_4_LOOP
+$ ENDIF
+$
+$ WRITE MY_PATCH_C_FCB ""
+$
+$ IF MY_LIST_KIND.EQS."FUNCTION"
+$ THEN
+$ WRITE MY_PATCH_C_FCB " return ''MY_LIST_MODULE'("
+$ ELSE
+$ WRITE MY_PATCH_C_FCB " ''MY_LIST_MODULE'("
+$ ENDIF
+$
+$ MY_LIST_LINE=MY_LIST_LINE_BACKUP
+$ MY_LIST_ARGUMENT=1
+$ MY_LIST_ARG_ANY_STRING_FLAG=0
+$ ARG_5_LOOP:
+$ IF MY_LIST_LINE.EQS.""
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ELSE
+$ MY_LIST_SEPARATOR=F$LOCATE(" ",MY_LIST_LINE)
+$ MY_LIST_ARGUMENT_STRING_NEXT=F$EXTRACT(0,MY_LIST_SEPARATOR,MY_LIST_LINE)
+$ IF MY_LIST_ARGUMENT.EQ.F$INTEGER(MY_LIST_ARGUMENT_STRING_NEXT)
+$ THEN
+$ MY_LIST_ARG_STRING_FLAG=1
+$ MY_LIST_LINE=F$EXTRACT(MY_LIST_SEPARATOR+1,F$LENGTH(MY_LIST_LINE)-MY_LIST_SEPARATOR-1,MY_LIST_LINE)
+$ ELSE
+$ MY_LIST_ARG_STRING_FLAG=0
+$ ENDIF
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARG_END=","
+$ ELSE
+$ MY_LIST_ARG_END=");"
+$ ENDIF
+$ IF MY_LIST_ARG_STRING_FLAG
+$ THEN
+$ WRITE MY_PATCH_C_FCB " &arg;''MY_LIST_ARGUMENT'_dsc''MY_LIST_ARG_END'"
+$ ELSE
+$ WRITE MY_PATCH_C_FCB " arg''MY_LIST_ARGUMENT'''MY_LIST_ARG_END'"
+$ ENDIF
+$ IF MY_LIST_ARGUMENT.NE.MY_LIST_ARGUMENT_COUNT
+$ THEN
+$ MY_LIST_ARGUMENT=MY_LIST_ARGUMENT+1
+$ GOTO ARG_5_LOOP
+$ ENDIF
+$
+$ WRITE MY_PATCH_C_FCB " }"
+$ENDIF
+$GOTO LIST_LOOP
+$LIST_DONE:
+$WRITE MY_PATCH_H_FCB "#endif"
+$WRITE MY_PATCH_H_FCB "#endif"
+$CLOSE MY_PATCH_H_FCB
+$CLOSE MY_PATCH_C_FCB
+$CLOSE MY_LIST_FCB
+$
+$CALL UPDATE CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_FORTRAN_'F$GETJPI("","PID")'.C -
+SYS$DISK:[]'MY_LIBRARY'$PATCH_WORK_FORTRAN.C
+$CALL UPDATE CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_FORTRAN_'F$GETJPI("","PID")'.H -
+CLAS$INCLUDE:'MY_LIBRARY'$PATCH_WORK_FORTRAN.H
+$
+$DELETE CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_FORTRAN_'F$GETJPI("","PID")'.C;*
+$DELETE CLAS$SCRATCH_PATCH_WORK:'MY_LIBRARY'$PATCH_WORK_FORTRAN_'F$GETJPI("","PID")'.H;*
+$
+$EXIT
+$
+$UPDATE: SUBROUTINE
+$IF F$SEARCH(P2).NES.""
+$THEN
+$ DIFFERENCES/IGNORE=(BLANK_LINES,CASE,FORM_FEEDS,SPACING,TRAILING_SPACES)/OUTPUT=NL: 'P1' 'P2'
+$ IF $STATUS.NE.%X006C8009
+$ THEN
+$ !****************************
+$ !* Files are not identical. *
+$ !****************************
+$ IF $STATUS.EQ.%X006C8013
+$ THEN
+$ COPY/LOG 'P1' 'P2'_TMP
+$ RENAME 'P2'_TMP 'P2'
+$ PURGE 'P2'
+$ RENAME 'P2' ;1
+$ ELSE
+$ MY_STATUS=$STATUS
+$ WRITE SYS$OUTPUT "Unknown status from DIFFERENCES, procedure stopped."
+$ EXIT 'MY_STATUS'
+$ ENDIF
+$ ENDIF
+$ELSE
+$ COPY/LOG 'P1' 'P2'
+$ENDIF
+$EXIT
+$ENDSUBROUTINE
diff --git a/diskspace-dcl b/diskspace-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_ZGlza3NwYWNlLWRjbA==
--- /dev/null
+++ b/diskspace-dcl
@@ -0,0 +1,66 @@
+diskspace.com
+Mike Ford, Monday November 03 2003 @ 03:26PM EST
+$! DISKSPACE.COM - 911216 M.BALDERSTON/M.FORD
+$! Comfile monitors for disks over a certain percentage full (MAXFUL).
+$! This comfile can be run in batch or interactive modes.
+$! If run in batch, messages should go system console.
+$!
+$! Modified - 911206 M. Ford to simplify using new lexical
+$!
+$ VAR:
+$! SET VERIFY
+$! *************************
+$! SYSTEM SPECIFIC VARIABLES
+$!
+$ DEFINE $CMDDIR gte_std_com ! DIR WHERE THIS COMFILE RESIDES
+$ DEFINE $LOGDIR gte_out_scr ! DIR WHERE LOGS ARE SENT
+$ LOGNAME = "DISKSPACE.LOG" ! NAME OF LOGFILE
+$ YELLOW = 88 ! WARNING % USED
+$ RED = 90 ! CRITICAL % USED
+$ YELLOW_ALERT = -
+"SYSwatch DISK, YELLOW ALERT for disk ''DISK', free space = "
+$ RED_ALERT = -
+"SYSwatch DISK, RED ALERT for disk ''DISK', free space = "
+$ BELL[0,8]=7
+$ NODE = F$GETSYI("NODENAME")
+$ DATE = F$EXTRACT(0,6,F$TIME())
+$ TIME = F$EXTRACT(12,5,F$TIME())
+$ HOUR = F$EXTRACT(12,2,F$TIME())
+$ NEWTIME = HOUR + 1
+$ IF NEWTIME .GE. 24 THEN NEWTIME = "TOMORROW"
+$!
+$ START:
+$ @$CMDDIR:CLEANUP_LOGS.COM $LOGDIR:'LOGNAME 30
+$!
+$ GET_DEV:
+$ DISK = F$DEVICE("*","DISK") - "_" - ":"
+$ IF DISK .EQS. "" THEN GOTO DONE
+$ FOR = F$GETDVI("''DISK'","FOR")
+$ IF FOR THEN GOTO GET_DEV
+$ MOUNTED = F$GETDVI("''DISK'","MNT")
+$ IF .NOT. MOUNTED THEN GOTO GET_DEV
+$ IF DISK .EQS. "$1$DUA100" THEN GOTO GET_DEV
+$! WRITE SYS$OUTPUT "''DISK'"
+$ FREE = F$GETDVI("''DISK'","FREEBLOCKS")
+$! SH SYM FREE
+$ TOTAL = F$GETDVI("''DISK'","MAXBLOCK")
+$! SHOW SYM TOTAL
+$ USED = TOTAL - FREE
+$! SHOW SYM USED
+$ USED% = (USED * 100)/TOTAL
+$! SHOW SYM USED%
+$ FREE% = 100 - USED%
+$! SHOW SYM FREE%
+$!
+$ IF USED% .GE. YELLOW .AND. USED% .LT. RED THEN REQUEST "''YELLOW_ALERT'''FREE%
+'"
+$ IF USED% .GE. RED THEN REQUEST "''RED_ALERT'''FREE%'"
+$ GOTO GET_DEV
+$ DONE:
+$ SET NOON
+$ SUBMIT/AFTER='NEWTIME'/NOPRINT/LOG=$LOGDIR:'LOGNAME'/user=SYSTEM -
+! $CMDDIR:DISKSPACE.COM
+$ SET NOVERIFY
+$ EXIT
+
+
diff --git a/display-jobs-dcl b/display-jobs-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_ZGlzcGxheS1qb2JzLWRjbA==
--- /dev/null
+++ b/display-jobs-dcl
@@ -0,0 +1,439 @@
+DISPLAY_JOBS.COM
+Jess Goodman, Tuesday July 14 2009 @ 01:31PM EDT
+Retrieves all specifications for a set of batch job(s) using F$GETQUI and formats the data into SUBMIT command(s). Use $ @DISPLAY_JOBS ? for full documentation. (updated version required for QUEUE_MANAGER_SAVE.COM)
+
+$ VFY = 'F$VERIFY(0)' !So no DCL output lines in a created command file
+$ IF (F$TRNLNM("DISPLAY_JOBS_VERIFY")) THEN SET VERIFY !Use for debugging
+$ ON WARNING THEN EXIT ($STATUS.OR.%X10000000)+F$VERIFY(VFY)*F$GETQUI("")
+$ IF (P1 .EQS. "?") THEN GOTO HELP_THEM !TYPE help text at bottom
+$! DISPLAY_JOBS.COM
+$! This retrieves all specifications for a set of batch job(s)
+$! using F$GETQUI and formats the data into SUBMIT command(s).
+$! Mar. 2009 - Jess Goodman (email: last name@accuweather.com)
+$!
+$!Create some symbols that are required below
+$ STATUS = 1+0*F$GETQUI("CANCEL_OPERATION") !and clear $getqui context
+$ QT := """" !one " quotation mark character
+$ QTS = QT+QT !that makes two quotes in a row
+$ SAY := WRITE/SYMBOL SYS$OUTPUT !Need /SYMBOL for very long tokens
+$ MYSELF = F$EDIT(F$GETJPI(0,"USERNAME"),"TRIM")
+$ DEFQUEPRI = F$GETSYI("DEFQUEPRI") !Assume same on queue manager node
+$ JCOUNT = 0
+$!
+$!Can write lines longer than 256 bytes on VMS 7.3-2+ unless we are in a PIPE.
+$ XDCL = (F$GETSYI("VERSION") .GES. "V7.3-2") !Boolean flag for eXtended DCL
+$ NOLL = (.NOT.XDCL) !NO Long Lines opposite unless
+$ IF F$GETDVI("SYS$OUTPUT","EXISTS") THEN - !Won't "exist" if reDEFINEd to PPF
+$ IF (F$EXTRACT(0,4,F$GETDVI("SYS$OUTPUT","DEVNAM")).EQS."_MPA") THEN NOLL=1
+$!
+$!Use P4-P8 to add to or to override SUBMIT qualifiers (/COMFIRM /NOIDENTIFY).
+$!P4-P8 can also specify our four keyword options (KILL,VERSION,USER,DELAYED).
+$ NEW_QUALS = P4+P5+P6+P7+P8
+$ KWO = F$ELEMENT(0,"/",NEW_QUALS) !options must precede any /qualifiers
+$ NEW_QUALS = NEW_QUALS-KWO
+$ KWO = F$EDIT(KWO,"UPCASE")
+$!
+$ IF (P3-"+" .EQS. "") !P3 can be used to override below default job flags
+$ THEN !P3="" default skips executing jobs & retained jobs
+$ JF := ALL_JOBS,HOLDING_JOBS,TIMED_RELEASE_JOBS,PENDING_JOBS
+$ ELSE !P3=" " will not skip any job owned by current user
+$ JF = F$EDIT(P3,"COLLAPSE,UPCASE")
+$ IF (JF .EQS. "*") THEN JF := ALL_JOBS !P3="*" will not skip any jobs
+$ IF (JF-"SYMBIONT"-"PRINTER"-"SERVER"-"TERMINAL".NES.JF) THEN GOTO BADQTYPE
+$ IF (JF-"THIS_JOB"-"FREEZE_CONTEXT".NES.JF) THEN STATUS = F$GETQUI("",,,JF)
+$ ENDIF !Force IVKEYW error for THIS_JOB/FREEZE_CONTEXT or we won't exit loop
+$!
+$!P1 can pass in a specific queue name or a wildcarded string.
+$!If P1 is null or "+" then P2 can be an entry number or name.
+$!If P1 and P2 are both null then we process all batch queues.
+$ IF (P1-"+" .EQS. "")
+$ THEN
+$ IF (P2 .NES. "") !P2 can be entry number or job name string
+$ THEN !Set the symbols DISPLAY_ENTRY logic needs
+$ OBJECT_ID := "P2" !Because we must use ",'OBJECT_ID'," below
+$ FN := DISPLAY_ENTRY !First F$GETQUI() argument is the function
+$ FZ := FREEZE_CONTEXT,WILDCARD
+$ IF (JF .NES. "") THEN JF = JF+","
+$ JF = JF-"ALL_JOBS,"+"BATCH,WILDCARD"
+$ QCOUNT = -1 !No queue look-up involved
+$ GOTO JOB_LOOP !Just skip past QUEUE_LOOP
+$ ENDIF
+$ QUEUES_IN := "*" !Default: check all queues
+$ ELSE
+$ QUEUES_IN = P1 !A [wildcarded] queue name
+$ ENDIF
+$!
+$!Symbols required for the DISPLAY_QUEUE/DISPLAY_JOB logic
+$ OBJECT_ID := "" !Can not use an object-id, even null symbol,
+$ FN := DISPLAY_JOB !with DISPLAY_JOB, but ",'OBJECT_ID'," works
+$ FZ := FREEZE_CONTEXT
+$ P2 = F$EDIT(P2,"COLLAPSE,UPCASE")
+$ IF (P2-"SYMBIONT"-"PRINTER"-"SERVER"-"TERMINAL".NES.P2) THEN GOTO BADQTYPE
+$ QF := BATCH,WILDCARD !P2 can be GENERIC, we add it to queue flags
+$ IF (P2-"NOGENERIC" .NES. P2) !or if P2 is NOGENERIC we can check it below
+$ THEN
+$ NOGENERIC = 1
+$ ELSE
+$ NOGENERIC = 0
+$ IF (P2-"GENERIC" .NES. P2) THEN QF := BATCH,GENERIC,WILDCARD
+$ ENDIF
+$ QCOUNT = 0 !So we know if we found a queue
+$!
+$QUEUE_LOOP: !Loop to find all matching batch queues
+$ QUEUE = F$GETQUI("DISPLAY_QUEUE","QUEUE_NAME",QUEUES_IN,QF)
+$ IF (QUEUE .EQS. "") THEN GOTO END_QUEUES
+$ IF (NOGENERIC) THEN -
+$ IF F$GETQUI("DISPLAY_QUEUE","QUEUE_GENERIC","*",FZ) THEN GOTO QUEUE_LOOP
+$ QCOUNT = QCOUNT+1
+$!
+$!If fell thru here from QUEUE_LOOP then loop thru jobs in this batch queue.
+$!If FN="DISPLAY_ENTRY" we jumped here so loop thru jobs matching OBJECT_ID.
+$JOB_LOOP:
+$ ENTRY = F$GETQUI(FN,"ENTRY_NUMBER",'OBJECT_ID',JF)
+$ IF (ENTRY .NES. "")
+$ THEN
+$ JCOUNT = JCOUNT+1
+$ GOSUB FORMAT_JOB
+$ GOTO JOB_LOOP
+$ ENDIF
+$ IF (QCOUNT .GT. 0) THEN GOTO QUEUE_LOOP
+$!
+$ IF (JCOUNT .EQ. 0) THEN STATUS = %x481DA !%JBC-E-NOSUCHENT
+$END_QUEUES:
+$ IF (QCOUNT .EQ. 0) THEN STATUS = %x4803A !%JBC-E-NOSUCHQUE
+$EXIT:
+$ EXIT STATUS + F$VERIFY('VFY')*0
+$BADQTYPE:
+$ STATUS = %X4811C !%JBC-F-INCQUETYP
+$ GOTO EXIT
+$!
+$! The following GOSUB routine does most of our work!
+$FORMAT_JOB:
+$ IF F$GETQUI(FN,"JOB_INACCESSIBLE",,FZ)
+$ THEN
+$ SAY "! no privilege for entry ",ENTRY
+$ STATUS = %x48020 !%JBC-W-NOPRIV
+$ RETURN
+$ ENDIF
+$!
+$ AFTER_TIME = F$GETQUI(FN,"AFTER_TIME",,FZ) !This will always return a time
+$ IF (KWO-"DELAYED" .NES. KWO) !Skip if job was never delayed?
+$ THEN !If after time same as submit time then it was never a TIMED_RELEASE job
+$ IF (AFTER_TIME .EQS. F$GETQUI(FN,"SUBMISSION_TIME",,FZ)) THEN RETURN
+$ ENDIF
+$!
+$!Get the job file specification(s) and use it (them) for our parameter (list).
+$!If "VERSION" is one of our keyword options update filespec to latest version.
+$ FILE = F$GETQUI("DISPLAY_FILE","FILE_SPECIFICATION")
+$ IF (KWO-"VERSION" .NES. KWO) THEN FILE = F$PARSE(";",FILE,,,"SYNTAX_ONLY")
+$ DEFAULT_JOB_NAME = F$EXTRACT( 0, 39, F$PARSE(FILE,,,"NAME"))
+$ IF (NOLL .AND. F$LENGTH(FILE).GE.245) !Can we add on to the filespec?
+$ THEN
+$ SAY "$ SUBMIT -"
+$ LINE = FILE
+$ ELSE
+$ LINE = "$ SUBMIT "+FILE
+$ ENDIF
+$!
+$MULTI_FILE_LOOP:
+$ IF F$GETQUI("DISPLAY_FILE","FILE_DELETE",,"FREEZE_CONTEXT")
+$ THEN !/DELETE is a placement=positional qualifier; it applies to a file.
+$ IF (NOLL .AND. F$LENGTH(LINE).GE.246)
+$ THEN
+$ SAY LINE,"-"
+$ LINE := " /DELETE"
+$ ELSE
+$ LINE = LINE+" /DELETE"
+$ ENDIF
+$ ENDIF
+$ FILE = F$GETQUI("DISPLAY_FILE","FILE_SPECIFICATION") !Another file same job?
+$ IF (FILE .NES. "")
+$ THEN
+$ IF (KWO-"VERSION" .NES. KWO) THEN FILE = F$PARSE(";",FILE,,,"SYNTAX_ONLY")
+$ SAY LINE,",-"
+$ LINE = FILE
+$ GOTO MULTI_FILE_LOOP
+$ ENDIF
+$ SAY LINE," -"
+$!
+$!Checking JOB_TIMED_RELEASE is not sufficient to know if /AFTER is needed.
+$ IF (F$CVTIME(AFTER_TIME) .GTS. F$CVTIME()) !Use it if it is the future
+$ THEN
+$ AFTER_TIME[11,1] := ":" !so we don't have to quote it
+$ SAY " /AFTER=''AFTER_TIME' -"
+$ ENDIF
+$!
+$ CHARAC = F$GETQUI(FN,"CHARACTERISTICS",,FZ)
+$ IF (CHARAC .NES. "") THEN SAY " /CHARAC=(",CHARAC,") -"
+$!
+$ CLI = F$GETQUI(FN,"CLI",,FZ)
+$ IF (CLI .NES. "")
+$ THEN
+$ DQ_SYMBOL := CLI
+$ GOSUB DOUBLE_QUOTE
+$ SAY " /CLI=",QT,CLI,QT," -"
+$ ENDIF
+$!
+$ IF F$GETQUI(FN,"JOB_CPU_LIMIT",,FZ) !Check this flag first - CPU_LIMIT
+$ THEN !is delta 0 for NONE and INFINITE.
+$ CPU_LIMIT = F$EDIT(F$GETQUI(FN,"CPU_LIMIT",,FZ),"TRIM")
+$ PART = F$ELEMENT(0," ",CPU_LIMIT) !days part of delta time
+$ IF (F$TYPE(PART) .NES. "INTEGER") !But check if days valid
+$ THEN !F$GETQUI bug returns an absolute time when the cpu
+$ IF (XDCL) !limit is > 248-13:13:56.47 (>31 bits of cpu ticks)
+$ THEN !but we can fix it by using F$DELTA (if VMS 7.3-2+)
+$ MAGIC_TIME := 28-MAR-1860 02:27:52.95 !with a little bit of magic
+$ CPU_LIMIT = F$EDIT(F$DELTA(CPU_LIMIT,MAGIC_TIME),"TRIM")
+$ ELSE
+$ CPU_LIMIT := 248 00:00:00.00 !can not fix it so use a safe value
+$ ENDIF
+$ ENDIF
+$ CPU_LIMIT[F$LOCATE(" ",CPU_LIMIT),1] := "-" !replace the space
+$ SAY " /CPUTIME=''CPU_LIMIT' -"
+$ ENDIF
+$!
+$ IF F$GETQUI(FN,"JOB_HOLDING",,FZ) THEN SAY " /HOLD -"
+$!
+$ IF F$GETQUI(FN,"JOB_LOG_NULL",,FZ)
+$ THEN
+$ SAY " /NOLOG -"
+$ ELSE
+$ LOGSPEC = F$GETQUI(FN,"LOG_SPECIFICATION",,FZ)
+$ IF (LOGSPEC .NES. "")
+$ THEN
+$ IF (NOLL .AND. F$LENGTH(LOGSPEC).GE.240)
+$ THEN !On a line by itself so it can be up to 255 bytes
+$ SAY " /LOG=-"
+$ SAY LOGSPEC,"-"
+$ ELSE !Quote it in case ODS5 spec and /PARSE=TRADITIONAL
+$ IF (LOGSPEC-QT .EQS. LOGSPEC) THEN LOGSPEC = QT+LOGSPEC+QT
+$ SAY " /LOG=",LOGSPEC," -" !Do not double quotes here
+$ ENDIF
+$ ENDIF
+$ ENDIF
+$!
+$ IF F$GETQUI(FN,"JOB_LOG_SPOOL",,FZ)
+$ THEN
+$ PRINTQ = F$GETQUI(FN,"LOG_QUEUE",,FZ)
+$ IF (PRINTQ .NES. "") THEN SAY " /PRINTER=''PRINTQ': -"
+$ IF (.NOT.F$GETQUI(FN,"JOB_LOG_DELETE",,FZ)) THEN SAY " /KEEP -"
+$ ELSE
+$ SAY " /NOPRINT -"
+$ IF F$GETQUI(FN,"JOB_LOG_DELETE",,FZ) THEN SAY " /NOKEEP -"
+$ ENDIF
+$!
+$ JOB_NAME = F$GETQUI(FN,"JOB_NAME",,FZ)
+$ IF (JOB_NAME .NES. DEFAULT_JOB_NAME) !Skip /NAME= if not needed so SUBMIT
+$ THEN !won't do unnecessary log file parse
+$ DQ_SYMBOL := JOB_NAME
+$ GOSUB DOUBLE_QUOTE !In case it has some imbedded quotes
+$ SAY " /NAME=",QT,JOB_NAME,QT," -"
+$ ENDIF
+$!
+$!Job note can be any string up to 255 bytes and it can have imbedded quotes.
+$ NOTE = F$GETQUI(FN,"NOTE",,FZ)
+$ IF (NOTE .NES. "")
+$ THEN
+$ DQ_SYMBOL := NOTE
+$ GOSUB DOUBLE_QUOTE !After this it could be > 255 bytes
+$ IF (NOLL .AND. F$LENGTH(NOTE).GE.240)
+$ THEN
+$ !This is a workaround for the (pre 7.3-2) 256 byte RMS limit on records
+$ !in a command file. It's not easy to continue a DCL line in the middle
+$ !of a quoted string but it can be done with a trick involving F$STRING.
+$ PART = F$EXTRACT(0,100,NOTE) !First line will fit screen width 132
+$ DQ_SYMBOL := PART
+$ GOSUB DOUBLE_QUOTE !Redouble
+$ SAY " /NOTE=""'","'F$STRING(",QT,PART,QT,"+ -"
+$ PART = F$EXTRACT(100,999,NOTE)
+$ GOSUB DOUBLE_QUOTE !Redouble
+$ SAY " ",QT,PART,QT,")"" -" !Do not put an ending ' after that )
+$ ELSE
+$ SAY " /NOTE=",QT,NOTE,QT," -"
+$ ENDIF
+$ ENDIF
+$!
+$ IF F$GETQUI(FN,"JOB_NOTIFY",,FZ) THEN SAY " /NOTIFY -"
+$!
+$ GOSUB PARAM_LINES !Will output zero or more lines with any job parameters
+$!
+$ PRIORITY = F$GETQUI(FN,"PRIORITY",,FZ)
+$ IF (PRIORITY .NE. DEFQUEPRI) THEN SAY " /PRIORITY=''PRIORITY' -"
+$!
+$ IF F$GETQUI(FN,"JOB_RESTART",,FZ) THEN SAY " /RESTART -"
+$!
+$ RETAIN_TIME = F$EDIT(F$GETQUI(FN,"JOB_RETENTION_TIME",,FZ),"TRIM")
+$ IF (RETAIN_TIME .NES. "17-NOV-1858 00:00:00.00")
+$ THEN
+$ PART = F$ELEMENT(0," ",RETAIN_TIME)
+$ IF (F$TYPE(PART) .EQS. "INTEGER") !Is it number of days or a date string?
+$ THEN TIME_PREFIX := "-" !DCL requires dash after the days in delta time
+$ ELSE TIME_PREFIX := ":" !add colon so don't have to quote absolute time
+$ ENDIF !next line replaces the first space
+$ RETAIN_TIME[F$LOCATE(" ",RETAIN_TIME),1] := "''TIME_PREFIX'"
+$ SAY " /RETAIN=UNTIL=''RETAIN_TIME' -"
+$ ELSE
+$ IF F$GETQUI(FN,"JOB_ERROR_RETENTION",,FZ)
+$ THEN SAY " /RETAIN=ERROR -"
+$ ELSE IF F$GETQUI(FN,"JOB_RETENTION",,FZ) THEN SAY " /RETAIN=ALWAYS -"
+$ ENDIF
+$ ENDIF
+$!
+$!Do not add /USER=user when user is me, unless "USER" is in keyword options.
+$!This is so a user without CMKRNL privilege can resubmit his/her batch jobs.
+$ USER = F$GETQUI(FN,"USERNAME",,FZ)
+$ IF (USER.NES.MYSELF .OR. KWO-"USER".NES.KWO) THEN SAY " /USER=''USER' -"
+$!
+$ WSDEF = F$GETQUI(FN,"WSDEFAULT",,FZ)
+$ IF (WSDEF .NE. 0) THEN SAY " /WSDEFAULT=''WSDEF' -"
+$ WSEXT = F$GETQUI(FN,"WSEXTENT",,FZ)
+$ IF (WSEXT .NE. 0) THEN SAY " /WSEXTENT=''WSEXT' -"
+$ WSQUO = F$GETQUI(FN,"WSQUOTA",,FZ)
+$ IF (WSQUO .NE. 0) THEN SAY " /WSQUOTA=''WSQUO' -"
+$!
+$!Use same queue this job was originally submitted to (generic, not target).
+$!Do last since always needed. Add ":" to prevent logical name translation.
+$ QUEUE = F$GETQUI(FN,"RESTART_QUEUE_NAME",,FZ)
+$ IF (NEW_QUALS .EQS. "") !Anything else to add?
+$ THEN
+$ SAY " /QUEUE=''QUEUE':"
+$ ELSE
+$ SAY " /QUEUE=''QUEUE': -"
+$ IF (NEW_QUALS-("'"+"'") .EQS. NEW_QUALS) !Any double ''s in NEW_QUALS?
+$ THEN SAY NEW_QUALS !No so don't mess up normal /NOTE="a b" stuff
+$ ELSE SAY "''NEW_QUALS'"
+$ ENDIF !but ELSE allows: "" 'ENTRY' * "/AFTER=""""'" "'AFTER_TIME'+1"""""
+$ ENDIF !to use the target "/QUEUE='" "'F$GETQUI(FN,""QUEUE_NAME"",,FZ)':"
+$ IF (QUEUE .EQS. "")
+$ THEN !If job went away in the middle of FORMAT_JOB then QUEUE would be null
+$ SAY "! Entry ''ENTRY' is no longer a batch job"
+$ STATUS = %x48040 !%JBC-W-NOSUCHJOB
+$ RETURN !Execution error could be either %DCL-W-VALREQ or %SUBMIT-F-CREJOB
+$ ENDIF
+$!
+$!If "KILL" is in keyword options then delete the old entry.
+$ IF (KWO-"KILL" .NES. KWO) THEN SAY "$ DELETE/ENTRY=",ENTRY
+$ RETURN !from FORMAT_JOB
+$!
+$!GOSUB routine outputs zero or more lines of comma separated job parameters.
+$!Each non-null parameter gets its own line, preceded by any null parameters.
+$PARAM_LINES:
+$ LINE := ""
+$ BEFORE_PARAM := " /PARAM=("
+$ PN = 0 !parameter counter goes up to 8
+$JP_LOOP:
+$ PN = PN+1
+$ PARAM = F$GETQUI(FN,"PARAMETER_''PN'",,FZ)
+$ IF (PARAM .NES. "")
+$ THEN
+$ IF (LINE .NES. "") THEN SAY LINE,", -" !write line; more to come
+$ DQ_SYMBOL := PARAM
+$ GOSUB DOUBLE_QUOTE
+$ LINE = BEFORE_PARAM+QT+PARAM+QT !know how line ends later
+$ IF (NOLL .AND. F$LENGTH(LINE).GE.253)
+$ THEN !See comment about too-long quoted string in /NOTE code above
+$ PART = F$EXTRACT(0,100,PARAM)
+$ DQ_SYMBOL := PART
+$ GOSUB DOUBLE_QUOTE !Redouble
+$ SAY BEFORE_PARAM,QT,"'","'F$STRING(",QT,PART,QT,"+ -"
+$ PART = F$EXTRACT(100,999,PARAM)
+$ GOSUB DOUBLE_QUOTE !Redouble
+$ LINE = " "+QT+PART+QT+")"+QT !no ending ' after that )
+$ ENDIF
+$ BEFORE_PARAM = " "
+$ ELSE
+$ BEFORE_PARAM = BEFORE_PARAM+QTS+"," !"", for a null parameter
+$ ENDIF
+$ IF (PN .LT. 8) THEN GOTO JP_LOOP
+$ IF (LINE .NES. "") THEN SAY LINE,") -" !last line with closing )
+$ RETURN !From PARAM_LINES
+$!
+$!This GOSUB routine replaces each " found in symbol 'DQ_SYMBOL' with "".
+$!The updated string symbol can be used to write out a quoted string that
+$!has all imbedded quotes doubled with a command like: $ SAY QT,SYMBOL,QT
+$DOUBLE_QUOTE:
+$ IN_STRING = 'DQ_SYMBOL'
+$ OUT_STRING := ""
+$QUOTE_LOOP:
+$ BEFORE_QUOTE = F$ELEMENT(0,QT,IN_STRING)
+$ OUT_STRING = OUT_STRING+BEFORE_QUOTE
+$ IF (BEFORE_QUOTE .NES. IN_STRING)
+$ THEN
+$ OUT_STRING = OUT_STRING+QTS
+$ IN_STRING = IN_STRING-BEFORE_QUOTE-QT
+$ GOTO QUOTE_LOOP
+$ ENDIF
+$ 'DQ_SYMBOL' = OUT_STRING
+$ RETURN !from DOUBLE_QUOTE
+$!
+$HELP_THEM:
+$ TYPE/PAGE SYS$INPUT:
+$DECK
+This retrieves all specifications for a set of batch job(s)
+using F$GETQUI and formats the data into SUBMIT command(s).
+The output goes to your SYS$OUTPUT: by default, but you can
+redirect the output to a .COMmand file that can be executed
+by using the @ /OUTPUT qualifier; for example:
+$ @DISPLAY_JOBS/OUTPUT=RESUBMIT_BATCH_JOBS.COM
+
+P1 can pass in a specific queue name or a wildcarded string.
+If P1 is null or "+" then P2 can be an entry number or name.
+If P1 is not null then P2 can be keywords GENERIC/NOGENERIC.
+If P1 and P2 are both null then we process all batch queues.
+
+@DISPLAY_JOBS * !All batch queues (all users' jobs)
+@DISPLAY_JOBS WORKQ !Only WORKQ queue (all users' jobs)
+@DISPLAY_JOBS "" * !All batch entries for current user
+@DISPLAY_JOBS "" MYWORK !Any MYWORK job(s) for current user
+
+P3 can be used to set the list of job flags; the default is:
+ALL_JOBS,HOLDING_JOBS,TIMED_RELEASE_JOBS,PENDING_JOBS,BATCH.
+So EXECUTING_JOBS and RETAINED_JOBS will be skipped when the
+default is used. If P3=* then no batch job will be skipped.
+
+P4-P8 can be used for any additional /qualifiers to be added
+to the end of the SUBMIT command line. You can use this for
+/CONFIRM /NOIDENTIFY or /STYLE= since they do not affect the
+resulting job. Or you can override a qualifier; for example
+P4="/USER=SYSTEM" will submit all jobs under that user name.
+
+P4-P8 can also be used for option keyword(s), but these must
+be before any /qualifier. Four keyword options are allowed:
+
+KILL
+If option KILL is specified then each SUBMIT command will be
+followed with the command "$ DELETE/ENTRY=old_entry_number".
+
+VERSION
+With option VERSION the most recent version ";" of the batch
+job command procedure will be used with each SUBMIT command.
+The default is to use the version that was submitted before.
+
+USER
+By default SUBMIT commands for jobs owned by the current user
+will not have /USER= (so that CMKRNL priv. is not necessary).
+When option USER is specified every command will have /USER=.
+
+DELAYED
+This option skips jobs that were submitted to run immediately,
+but processes all jobs that were TIMED_RELEASED when they were
+submitted even if they are now PENDING or (if P3=*) EXECUTING.
+
+The PIPE command can be used to directly execute our command
+output, but use it only when you specify a single batch job.
+This one-liner will resubmit batch job entry 123 using a new
+version of its batch command procedure and kill the old job:
+$ PIPE @DISPLAY_JOBS "" 123 * VERSION,KILL /CONF | @SYS$PIPE
+
+THIS_JOB is not allowed as a P3 keyword, but these two lines
+when added to any batch job .COM file reschedules the job to
+run again one hour later with identical job characteristics:
+$ ENTRY=F$GETQUI("DISPLAY_ENTRY","ENTRY_NUMBER",,"THIS_JOB")
+$ PIPE @DISPLAY_JOBS "" 'ENTRY' * /AFTER="+1:00" | @SYS$PIPE
+
+If this is used for a large number of batch jobs you may, or
+may not, wish to edit the output file to add a "$ SET NOON".
+But if you do, and the KILL option was used, you should also
+add "IF $STATUS THEN" before every "DELETE/ENTRY=n" command.
+$EOD
+$ EXIT $STATUS + F$VERIFY('VFY')*0
diff --git a/display-link-dcl b/display-link-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_ZGlzcGxheS1saW5rLWRjbA==
--- /dev/null
+++ b/display-link-dcl
@@ -0,0 +1,19 @@
+Display_Link
+Aaron, Saturday November 06 2004 @ 04:42PM EST
+$ SrcDir = "Apache$Common:[HTdocs.Links]"
+$ Ext = ".DAT"
+$ FileSpec = SrcDir + Query_String + Ext
+$ if f$search(FileSpec) .eqs. "" then goto FileErr
+$ Open/Read/Error=FileErr InFile 'FileSpec'
+$ Write Sys$Output f$fao("!AS!/!/", "Content-type: text/plain")
+$ Loop:
+$ Read /End=Done InFile Data
+$ Text = f$element(0,",",Data)
+$ Link = f$element(1,",",Data)
+$ write sys$output f$fao("<a href=""!AS"">!AS</a><br>",Link,Text)
+$ GoTo Loop
+$ Done:
+$ Close /NoLog InFile
+$ FileErr:
+$ Exit
+
diff --git a/display-queues-dcl b/display-queues-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_ZGlzcGxheS1xdWV1ZXMtZGNs
--- /dev/null
+++ b/display-queues-dcl
@@ -0,0 +1,829 @@
+DISPLAY_QUEUES.COM
+Jess Goodman, Monday July 13 2009 @ 04:40PM EDT
+DISPLAY_QUEUES elicits the complete specifications for a set of queues using F$GETQUI and outputs DCL command lines to recreate the queue(s). The commands go to SYS$OUTPUT: or you can use @DISPLAY_QUEUES/OUTPUT=.
+P1 can be a specific queue name or a wildcarded string; default is *.
+
+P2-P8 can be used for the following /options that select what type of queues are processed and what DCL commands are output for each queue: /BATch - select batch queues only /DEVice - select printer, terminal, and server queues only /GENeric - select generic and logical queues only /NOGENeric - select execution queues only /STOP - output a STOP/QUEUE/RESET queue as the first command for each queue /DEASsign - output a DEASSIGN/QUEUE command for logical queues before INITs /DELEte - output a DELETE/QUEUE command just before each INIT/QUEUE command /STARt - start each queue with the INIT or after ASSIGNs for logical queues /NOSTARt - do not start any queue (default is to start only started queues) /FORM - output /FORM_MOUNTED=current_form for device execution queues /NOASSIgn - do not output the ASSIGN/QUEUE command for logical queues /ASSIgn_only - only output the ASSIGN/QUEUE command for logical queues /NOACL - do not output the SET SECURITY command for queues with ACLs /ACL_only - only output the SET SECURITY command for queues with ACLs /NOIDentifiers - translate owner and ACL identifier names to numeric values
+
+$ VFY = 'F$VERIFY(0)' !So no DCL output lines in generated command file
+$ IF (F$TRNLNM("DISPLAY_QUEUES_VERIFY")) THEN SET VERIFY !For debugging
+$ ON WARNING THEN EXIT ($STATUS.OR.%X10000000)+F$VERIFY(VFY)*F$GETQUI("")
+$ IF (P1 .EQS. "?") THEN GOTO HELP_THEM !TYPE help text at bottom
+$! DISPLAY_QUEUES.COM
+$! DISPLAY_QUEUES elicits the complete specifications for a set of queues
+$! using F$GETQUI and outputs DCL command lines to recreate the queue(s).
+$! Mar. 2009 - Jess Goodman (comments welcome: last name@accuweather.com)
+$!
+$ QUEUES_IN = F$ELEMENT(0, "/", P1)
+$ OPTIONS = P1-QUEUES_IN
+$ IF (QUEUES_IN .EQS. "") THEN QUEUES_IN := * !default is all the queues
+$ N = 2
+$PLOOP:
+$ THISP = P'N'
+$ IF (THISP .NES. "")
+$ THEN
+$ IF (F$EXTRACT(0,1,THISP) .NES. "/") THEN GOTO MAXPARM_ERR
+$ OPTIONS = OPTIONS + THISP
+$ N = N+1
+$ IF (N .LE. 8) THEN GOTO PLOOP
+$ ENDIF
+$ OPTIONS = F$EDIT(OPTIONS,"UPCASE")
+$!
+$! Check for all the valid user options and for any option conflict
+$!
+$ IF (OPTIONS-"/NOBAT"-"/NODEV" .NES. OPTIONS) THEN GOTO NOTNEG_ERR
+$ BATCH_ONLY = (OPTIONS-"/BAT" .NES. OPTIONS) !Select batch queues
+$ DEVICE_ONLY = (OPTIONS-"/DEV" .NES. OPTIONS) !All symbiont queues
+$ IF (BATCH_ONLY .AND. DEVICE_ONLY)
+$ THEN !If both /BATCH and /DEVICE treat it the same as if neither
+$ BATCH_ONLY = 0
+$ DEVICE_ONLY = 0
+$ ENDIF
+$!
+$ GENERIC_ONLY = (OPTIONS-"/GEN" .NES. OPTIONS) !Generic or logical
+$ SKIP_GENERIC = (OPTIONS-"/NOGEN" .NES. OPTIONS) !"execution" queues
+$ IF (GENERIC_ONLY .AND. SKIP_GENERIC) THEN GOTO CONFLICT_ERR
+$!
+$! /STOP and /DELETE should be used with caution. Recommended instead
+$! is using QUEUE_COMMANDS.COM so that these are separate steps. Note
+$! we must initialize target queues before generic/logical queues, but
+$! queues must be deleted in the opposite order (generic then target).
+$! It should be unnecessary to delete a queue unless it needs emptied.
+$ DO_STOP = (OPTIONS-"/STOP" .NES. OPTIONS) !STOP/QUEU/RESET first
+$ DO_DELETE = (OPTIONS-"/DELE" .NES. OPTIONS) !Delete it before INIT
+$!
+$ ACL_ONLY = (OPTIONS-"/ACL" .NES. OPTIONS) !Only do SET SECURITYs
+$ SKIP_ACL = (OPTIONS-"/NOACL" .NES. OPTIONS) !Skip any SET SECURITY
+$ IF (ACL_ONLY .AND. (SKIP_ACL.OR.DO_STOP.OR.DO_DELETE)) THEN GOTO CONFLICT_ERR
+$!
+$ ASSIGN_ONLY = (OPTIONS-"/ASSI" .NES. OPTIONS) !Do ASSIGN/QUEUEs only
+$ SKIP_ASSIGN = (OPTIONS-"/NOASSI" .NES. OPTIONS) !Skip ASSIGN/QUEUEs
+$ IF (ASSIGN_ONLY)
+$ THEN
+$ IF (SKIP_ASSIGN.OR.ACL_ONLY.OR.DO_DELETE) THEN GOTO CONFLICT_ERR
+$ DEVICE_ONLY = 1
+$ GENERIC_ONLY = 1
+$ ENDIF
+$!
+$ DO_DEASSIGN = (OPTIONS-"/DEAS" .NES. OPTIONS) !DEASSIGN logical queues
+$ IF (DO_DEASSIGN .AND. (ASSIGN_ONLY.OR.ACL_ONLY)) THEN GOTO CONFLICT_ERR
+$ IF ((ASSIGN_ONLY.OR.DO_DEASSIGN) .AND. (BATCH_ONLY.OR.SKIP_GENERIC)) THEN -
+$ GOTO CONFLICT_ERR
+$!
+$! By default: If a queue is currently started, either we add /START to
+$! INIT/QUEUE or we use START/QUEUE after ASSIGN/QUEUE (logical queue).
+$! For the /ASSIGN_ONLY option the default is no queue will be started.
+$! If /NOASSIGN we won't start a logical queue even with option /START.
+$ ALLSTART = (OPTIONS-"/STAR" .NES. OPTIONS) !Start stopped queues too
+$ IF_START = (OPTIONS-"/NOSTAR" .EQS. OPTIONS) !Do not start any queue
+$ IF (ALLSTART .AND. (.NOT.IF_START .OR. ACL_ONLY)) THEN GOTO CONFLICT_ERR
+$!
+$ DO_FORM = (OPTIONS-"/FORM" .NES. OPTIONS) !output /FORM_MOUNTED="form"
+$ NO_IDNAMES = (OPTIONS-"/NOID" .NES. OPTIONS) !do not use identifier names
+$ SAFE_NAMES = (OPTIONS-"/SAFE" .NES. OPTIONS) !logical managers protection
+$!
+$! Check if there were any unrecognized /options or if any option had a value.
+$LEGAL_STRIP:
+$ STRING = OPTIONS
+$ OPTIONS = STRING-"/BAT"-"/DEV"-"/GEN"-"/NOGEN"-"/STOP"-"/DELE"-"/NOSTAR"- -
+"/STAR"-"/ACL"-"/NOACL"-"/ASSI"-"/NOASSI"-"/DEAS"-"/FORM"-"/NOID"-"/SAFE"
+$ IF (OPTIONS .NES. STRING) THEN GOTO LEGAL_STRIP !Could be a duplicate
+$ IF (OPTIONS-"/" .NES. OPTIONS) THEN GOTO IVQUAL_ERR !Any /option left?
+$ IF (OPTIONS-"="-":" .NES. OPTIONS) THEN GOTO NOVALU_ERR !=value or :value?
+$!
+$! Now we can decide which commands to output.
+$ DO_INIT = (.NOT.(ACL_ONLY .OR. ASSIGN_ONLY))
+$ DO_ACL = (.NOT.(SKIP_ACL .OR. ASSIGN_ONLY))
+$ DO_ASSIGN = (.NOT.(SKIP_ASSIGN .OR. ACL_ONLY))
+$ DO_START = ALLSTART !for /ASSIGN_ONLY, otherwise DO_START set in queue loop
+$!
+$!If /NOASSIGN was used and /[NO]GENERIC was not, process logical queues in the
+$!non-generic pass. So [DE]ASSIGN/QUEUE commands won't affect our queue order.
+$ LOGICAL_ORDER = (SKIP_ASSIGN .AND. .NOT.GENERIC_ONLY .AND. .NOT.SKIP_GENERIC)
+$!
+$! Can write lines longer than 256 bytes on VMS 7.3-2+ unless we're in a PIPE.
+$! On any earlier version we break up long lines, but DCL also had a 1024 byte
+$! limit for the whole command (counting continuations) which we might exceed.
+$ VMS_VERSION = F$GETSYI("VERSION") !This is compared below thrice
+$ XDCL = (VMS_VERSION .GES. "V7.3-2") !Boolean flag for eXtended DCL
+$ NOLL = (.NOT.XDCL) !NO Long Lines opposite unless
+$ IF F$GETDVI("SYS$OUTPUT","EXISTS") THEN - !Won't "exist" if reDEFINEd to PPF
+$ IF (F$EXTRACT(0,4,F$GETDVI("SYS$OUTPUT","DEVNAM")).EQS."_MPA") THEN NOLL=1
+$!
+$! Use bitmasks of QUEUE_FLAGS and QUEUE_STATUS fields to limit the number
+$! of F$GETQUI calls needed for each queue. Tests showed this was faster.
+$! Create a bitmask for all of the states that describe any started queue.
+$ GOSUB QUIDEF !Sets needed QUI$M_QUEUE_* bit field value symbols
+$ QSTARTED = QUI$M_QUEUE_IDLE.OR.QUI$M_QUEUE_AVAILABLE.OR.QUI$M_QUEUE_BUSY
+$!
+$! Define a couple symbols to make life easier.
+$ QT := """" !one " quotation mark character
+$ QTS = QT+QT !that makes two quotes in a row
+$ DQ := DISPLAY_QUEUE
+$ FZ := FREEZE_CONTEXT
+$ ASSIGNED_QNAME := ":" !for batch passes
+$ MANAGER := SYS$QUEUE_MANAGER !for VMS pre-V6.0
+$ STATUS = F$GETQUI("") !cancel operation
+$ STATUS = %X4803A !%JBC-E-NOSUCHQUE
+$!
+$! Search for queues that match P1 string. Do batch queues first and then
+$! do device queues. For each of them do non-generic queues first so that
+$! targets exist before we create a generic queue or assign a logical one.
+$!
+$ IF (.NOT.DEVICE_ONLY)
+$ THEN
+$ QUEUE_BATCH = 1
+$ SELECT := BATCH
+$ IF (.NOT.GENERIC_ONLY) THEN GOSUB QUEUE_LOOP
+$ SELECT := BATCH,GENERIC
+$ IF (.NOT.SKIP_GENERIC) THEN GOSUB QUEUE_LOOP
+$ ENDIF
+$ IF (.NOT.BATCH_ONLY)
+$ THEN
+$ QUEUE_BATCH = 0
+$ SELECT := SYMBIONT
+$ IF (.NOT.GENERIC_ONLY) THEN GOSUB QUEUE_LOOP
+$ SELECT := SYMBIONT,GENERIC !generic finds logical queues too
+$ IF (.NOT.SKIP_GENERIC) THEN GOSUB QUEUE_LOOP
+$ ENDIF
+$!
+$ EXIT STATUS + F$VERIFY('VFY')*0
+$!
+$CONFLICT_ERR: EXIT %X38258 + F$VERIFY('VFY')*0
+$MAXPARM_ERR: EXIT %X38098 + F$VERIFY('VFY')*0
+$NOTNEG_ERR: EXIT %X380D8 + F$VERIFY('VFY')*0
+$IVQUAL_ERR: EXIT %X38240 + F$VERIFY('VFY')*0
+$NOVALU_ERR: EXIT %X380D0 + F$VERIFY('VFY')*0
+$NOPRIV_ERR: EXIT %X48022 + F$VERIFY('VFY')*F$GETQUI("")
+$BADACL_ERR: EXIT %X00E3A + F$VERIFY('VFY')*F$GETQUI("")
+$!
+$! Outer GOSUB routine will find all selected queues and process them.
+$QUEUE_LOOP:
+$! Add : to the end of queue names so they won't match a logical name.
+$ QNAME = F$GETQUI(DQ,"QUEUE_NAME",QUEUES_IN,SELECT+",WILDCARD") + ":"
+$ IF (QNAME .EQS. ":") THEN RETURN !From QUEUE_LOOP
+$!
+$ IF (.NOT.QUEUE_BATCH)
+$ THEN
+$ ASSIGNED_QNAME = F$GETQUI(DQ,"ASSIGNED_QUEUE_NAME","*",FZ) + ":"
+$ IF (ASSIGN_ONLY .AND. ASSIGNED_QNAME.EQS.":") THEN GOTO QUEUE_LOOP
+$ ENDIF
+$!
+$ QFLAGS = F$GETQUI(DQ,"QUEUE_FLAGS","*",FZ)
+$ QUEUE_GENERIC = ((QFLAGS.AND.QUI$M_QUEUE_GENERIC) .NE. 0)
+$!
+$! We may need to filter out generic and/or logical queues as F$GETQUI can't.
+$ IF (SELECT-"GENERIC" .EQS. SELECT)
+$ THEN !non-generic pass
+$ IF (QUEUE_GENERIC) THEN GOTO QUEUE_LOOP
+$ IF (.NOT.LOGICAL_ORDER .AND. ASSIGNED_QNAME.NES.":") THEN GOTO QUEUE_LOOP
+$ ELSE !generic pass
+$ IF (LOGICAL_ORDER .AND. ASSIGNED_QNAME.NES.":") THEN GOTO QUEUE_LOOP
+$ ENDIF
+$!
+$ IF ((QFLAGS.AND.QUI$M_SECURITY_INACCESSIBLE) .NE. 0) THEN GOTO NOPRIV_ERR
+$!
+$ J = 0 !J is last saved line number
+$ IF (DO_STOP)
+$ THEN
+$ J = 1
+$ LINE1 := $ STOP /QUEUE /RESET 'QNAME'
+$ ENDIF
+$ IF (DO_DEASSIGN .AND. ASSIGNED_QNAME.NES.":")
+$ THEN
+$ J = J+1
+$ LINE'J' := $ DEASSIGN /QUEUE 'QNAME'
+$ ENDIF
+$ IF (DO_DELETE)
+$ THEN
+$ J = J+1
+$ LINE'J' := $ DELETE /QUEUE 'QNAME'
+$ ENDIF
+$!
+$! Generate an INIT/QUEUE command using GOSUBs for the queue types.
+$ IF (DO_INIT)
+$ THEN
+$ GOSUB EVERYQ !First do work needed for all types
+$ IF (QUEUE_GENERIC)
+$ THEN
+$ GOSUB GENERICQ !Truly generic (not logical) queues
+$ ELSE
+$ GOSUB EXECUTIONQ !Do for all non-true generic queues
+$ IF (QUEUE_BATCH)
+$ THEN
+$ GOSUB BATCHQ !Do for batch execution queues only
+$ ELSE
+$ GOSUB SYMBIONTQ !Printer, terminal or server queues
+$ ENDIF
+$ ENDIF
+$ ENDIF
+$!
+$! If queue has an access control list recreate it using SET SECURITY.
+$ IF (DO_ACL .AND. (QFLAGS.AND.QUI$M_QUEUE_ACL_SPECIFIED).NE.0) THEN -
+$ GOSUB RECREATE_ACL
+$!
+$! If this a logical queue then generate an ASSIGN/QUEUE command.
+$! A logical queue can not be started until after it is assigned.
+$ IF (DO_ASSIGN .AND. ASSIGNED_QNAME.NES.":")
+$ THEN
+$ J = J+1
+$ LINE'J' := $ ASSIGN /QUEUE 'ASSIGNED_QNAME' 'QNAME'
+$ IF (DO_START)
+$ THEN
+$ J = J+1
+$ LINE'J' := $ START /QUEUE 'QNAME'
+$ ENDIF
+$ ENDIF
+$ IF (J .EQ. 0) THEN GOTO QUEUE_LOOP !/ACL_ONLY for queue with no ACL
+$!
+$! We are ready to write out the command(s) saved in LINE1 thru LINE'J'.
+$! Add a hyphen to end of continued lines and indent continuation lines.
+$ INDENT := ""
+$ N = 1
+$LINE_PLEASE:
+$ IF (N .LT. J)
+$ THEN
+$ K = N+1 !first check the next line
+$ IF (F$EXTRACT(0,2,LINE'K') .EQS. "$ ")
+$ THEN !last line of this command
+$ WRITE /SYMBOL SYS$OUTPUT INDENT,LINE'N'
+$ INDENT := ""
+$ ELSE !this command is continued
+$ WRITE /SYMBOL SYS$OUTPUT INDENT,LINE'N'," -"
+$ INDENT := " "
+$ ENDIF
+$ N = K
+$ GOTO LINE_PLEASE
+$ ENDIF
+$ WRITE /SYMBOL SYS$OUTPUT INDENT,LINE'N'
+$!
+$ STATUS = 1 !This queue done.
+$ GOTO QUEUE_LOOP !Find next queue.
+$!
+$! Do work required on all of the queue types.
+$EVERYQ:
+$ QSTATUS = F$GETQUI(DQ,"QUEUE_STATUS","*",FZ)
+$ DO_START = (ALLSTART .OR. (IF_START .AND. (QSTATUS.AND.QSTARTED).NE.0))
+$!
+$ IF (VMS_VERSION .GES. "V6.0")
+$ THEN
+$ MANAGER = F$GETQUI(DQ,"MANAGER_NAME","*",FZ)
+$ IF (SAFE_NAMES) !Use protection against manager being a logical name
+$ THEN
+$ J = J+1
+$ LINE'J' := $ DEFINE /USER /TRANSLATION=TERMINAL 'MANAGER' 'MANAGER'
+$ ENDIF
+$ ENDIF
+$!
+$ J = J+1
+$ IF (QUEUE_BATCH)
+$ THEN
+$ LINE'J' := "$ INITIALIZE /QUEUE /BATCH "
+$ ELSE
+$ IF ((QFLAGS.AND.QUI$M_QUEUE_PRINTER) .NE. 0) THEN -
+$ LINE'J' := "$ INITIALIZE /QUEUE /DEVICE=PRINTER "
+$ IF ((QFLAGS.AND.QUI$M_QUEUE_TERMINAL) .NE. 0) THEN -
+$ LINE'J' := "$ INITIALIZE /QUEUE /DEVICE=TERMINAL "
+$ IF ((QSTATUS.AND.QUI$M_QUEUE_SERVER) .NE. 0) THEN -
+$ LINE'J' := "$ INITIALIZE /QUEUE /DEVICE=SERVER "
+$ ENDIF
+$ IF ((QSTATUS.AND.QUI$M_QUEUE_CLOSED).NE.0) THEN LINE'J' = LINE'J' + "/CLOSE "
+$ IF (DO_START .AND. ASSIGNED_QNAME.EQS.":") THEN LINE'J' = LINE'J' + "/START "
+$ LINE'J' = LINE'J' + QNAME
+$!
+$! The queue description can be up to 255 bytes and can have imbedded quotes.
+$ J = J+1
+$ DESCRIPTION = F$GETQUI(DQ,"QUEUE_DESCRIPTION","*",FZ)
+$ IF (DESCRIPTION .EQS. "")
+$ THEN
+$ LINE'J' := /NODESCRIPTION
+$ ELSE
+$ DQ_SYMBOL := DESCRIPTION
+$ GOSUB DOUBLE_QUOTE !but after this it can be > 255 bytes
+$ LINE'J' = "/DESCRIPTION=" + QT + DESCRIPTION + QT
+$ IF (NOLL .AND. F$LENGTH(LINE'J').GT.250) !output line six bytes longer
+$ THEN
+$ !This is a workaround for the (pre 7.3-2) 256 byte RMS limit on records
+$ !in a command file. It's not easy to continue a DCL line in the middle
+$ !of a quoted string but it can be done with a trick involving F$STRING.
+$ STRING = F$EXTRACT(0,98,DESCRIPTION)
+$ DQ_SYMBOL := STRING
+$ GOSUB DOUBLE_QUOTE !Redouble
+$ LINE'J' = "/DESCRIPTION=""'" + "'F$STRING(" + QT + STRING + QT + "+"
+$ STRING = F$EXTRACT(98,999,DESCRIPTION)
+$ GOSUB DOUBLE_QUOTE !Redouble
+$ J = J+1
+$ LINE'J' = QT + STRING + QT + ")" + QT !no ending ' after that )
+$ ENDIF
+$ ENDIF
+$!
+$!What queue manager controls the queue?
+$ IF (MANAGER .NES. "SYS$QUEUE_MANAGER")
+$ THEN !Was not default so must specify
+$ J = J+1
+$ LINE'J' := /NAME_OF_MANAGER='MANAGER'
+$ ENDIF
+$!
+$ J = J+1
+$ IDENTIFIER = F$GETQUI(DQ,"OWNER_UIC","*",FZ)
+$ IF (NO_IDNAMES) THEN GOSUB TRANSLATE_IDENTIFIER
+$ LINE'J' := /OWNER_UIC='IDENTIFIER'
+$!
+$ J = J+1
+$ PROTECTION = F$GETQUI(DQ,"PROTECTION","*",FZ)
+$ LINE'J' := /PROTECTION=('F$EDIT(PROTECTION,"COLLAPSE")')
+$!
+$ J = J+1
+$ IF ((QFLAGS.AND.QUI$M_QUEUE_RETAIN_ALL) .NE. 0)
+$ THEN
+$ LINE'J' := /RETAIN=ALL
+$ ELSE
+$ IF ((QFLAGS.AND.QUI$M_QUEUE_RETAIN_ERROR) .NE. 0)
+$ THEN LINE'J' := /RETAIN=ERROR
+$ ELSE LINE'J' := /NORETAIN
+$ ENDIF
+$ ENDIF
+$!
+$ RETURN !from EVERYQ
+$!
+$! Work required for all true-generic queues.
+$GENERICQ:
+$ J = J+1
+$ LIST = F$GETQUI(DQ,"GENERIC_TARGET","*",FZ)
+$ IF (LIST .EQS. "")
+$ THEN
+$ LINE'J' := /GENERIC
+$ ELSE
+$ LINE'J' := /GENERIC=
+$ ADD_COLON = 1 !put a : after queues
+$ ADD_QUOTES = 0
+$ GOSUB PROCESS_LIST
+$ ENDIF
+$!
+$ IF (.NOT.QUEUE_BATCH)
+$ THEN
+$ J = J+1
+$ IF ((QFLAGS.AND.QUI$M_QUEUE_JOB_SIZE_SCHED) .NE. 0)
+$ THEN LINE'J' := /SCHEDULE=SIZE
+$ ELSE LINE'J' := /SCHEDULE=NOSIZE
+$ ENDIF !Also allowed with execution symbiont queues
+$ ENDIF
+$!
+$ RETURN !from GENERICQ
+$!
+$! Work required for all execution queues and for logical queues.
+$EXECUTIONQ:
+$ J = J+1
+$ IF ((QFLAGS.AND.QUI$M_QUEUE_AUTOSTART) .NE. 0)
+$ THEN
+$ LIST = F$EDIT(F$GETQUI(DQ,"AUTOSTART_ON","*",FZ), "COLLAPSE")
+$ IF (F$EDIT(LIST+" ","TRIM") .NES. LIST) THEN LIST = LIST + QT
+$ LINE'J' := /AUTOSTART_ON=
+$ ADD_COLON = 0
+$ ADD_QUOTES = 0
+$ GOSUB PROCESS_LIST
+$ ELSE
+$ STRING = F$GETQUI(DQ,"SCSNODE_NAME","*",FZ) + "::" !null node ok
+$ IF (.NOT.QUEUE_BATCH) THEN STRING=STRING+F$GETQUI(DQ,"DEVICE_NAME","*",FZ)
+$ STRING = F$EDIT( STRING, "COLLAPSE")
+$ IF (F$EDIT(STRING+" ","TRIM") .NES. STRING) THEN STRING = STRING + QT
+$ LINE'J' = "/ON=" + STRING
+$ ENDIF
+$!
+$ J = J+1
+$ LINE'J' := /BASE_PRIORITY='F$GETQUI(DQ,"BASE_PRIORITY","*",FZ)'
+$!
+$ J = J+1
+$ LIST = F$GETQUI(DQ,"CHARACTERISTICS","*",FZ)
+$ IF (LIST .EQS. "")
+$ THEN
+$ LINE'J' := /NOCHARACTERISTICS
+$ ELSE
+$ LINE'J' := /CHARACTERISTICS=
+$ ADD_COLON = 0
+$ ADD_QUOTES = 0
+$ GOSUB PROCESS_LIST
+$ ENDIF
+$!
+$ J = J+1
+$ IF ((QFLAGS.AND.QUI$M_QUEUE_GENERIC_SELECTION) .NE. 0)
+$ THEN LINE'J' := /ENABLE_GENERIC
+$ ELSE LINE'J' := /NOENABLE_GENERIC
+$ ENDIF
+$!
+$ J = J+1
+$ WSDEF = F$GETQUI(DQ,"WSDEFAULT","*",FZ)
+$ WSEXT = F$GETQUI(DQ,"WSEXTENT","*",FZ)
+$ WSQUO = F$GETQUI(DQ,"WSQUOTA","*",FZ)
+$ LINE'J' := /WSDEFAULT='WSDEF' /WSEXTENT='WSEXT' /WSQUOTA='WSQUO'
+$!
+$ RETURN !from EXECUTIONQ
+$!
+$! Work required for all non-generic batch queues.
+$BATCHQ:
+$ J = J+1
+$ IF ((QFLAGS.AND.QUI$M_QUEUE_CPU_DEFAULT) .NE. 0)
+$ THEN
+$ CPU_DELTA = F$EDIT( F$GETQUI(DQ,"CPU_DEFAULT","*",FZ), "TRIM")
+$ GOSUB FIX_CPU_DELTA
+$ LINE'J' := /CPUDEFAULT='CPU_DELTA'
+$ ELSE
+$ LINE'J' := /CPUDEFAULT=NONE
+$ ENDIF
+$!
+$ J = J+1
+$ IF ((QFLAGS.AND.QUI$M_QUEUE_CPU_LIMIT) .NE. 0)
+$ THEN
+$ CPU_DELTA = F$EDIT( F$GETQUI(DQ,"CPU_LIMIT","*",FZ), "TRIM")
+$ GOSUB FIX_CPU_DELTA
+$ LINE'J' := /CPUMAXIMUM='CPU_DELTA'
+$ ELSE
+$ LINE'J' := /CPUMAXIMUM=NONE
+$ ENDIF
+$!
+$ J = J+1
+$ IF ((QFLAGS.AND.QUI$M_QUEUE_SWAP) .NE. 0)
+$ THEN LINE'J' := /NODISABLE_SWAPPING
+$ ELSE LINE'J' := /DISABLE_SWAPPING
+$ ENDIF
+$!
+$ J = J+1
+$ LINE'J' := /JOB_LIMIT='F$GETQUI(DQ,"JOB_LIMIT","*",FZ)'
+$!
+$ IF ((QFLAGS.AND.QUI$M_QUEUE_RAD) .NE. 0)
+$ THEN !This can only occur on AlphaServer GS
+$ J = J+1
+$ LINE'J' := /RAD='F$GETQUI(DQ,"RAD","*",FZ)'
+$ ENDIF
+$!
+$ RETURN !from BATCHQ
+$!
+$! Work required for symbiont execution and logical queues.
+$SYMBIONTQ:
+$ J = J+1
+$ JOB_SIZE_MAXIMUM = F$GETQUI(DQ,"JOB_SIZE_MAXIMUM","*",FZ)
+$ JOB_SIZE_MINIMUM = F$GETQUI(DQ,"JOB_SIZE_MINIMUM","*",FZ)
+$ IF (JOB_SIZE_MINIMUM .EQ. 0)
+$ THEN
+$ IF (JOB_SIZE_MAXIMUM .EQ. 0)
+$ THEN LINE'J' := /NOBLOCK_LIMIT
+$ ELSE LINE'J' := /BLOCK_LIMIT='JOB_SIZE_MAXIMUM'
+$ ENDIF
+$ ELSE
+$ IF (JOB_SIZE_MAXIMUM .EQ. 0)
+$ THEN LINE'J' = "/BLOCK_LIMIT=(''JOB_SIZE_MINIMUM'," + QTS + ")"
+$ ELSE LINE'J' := /BLOCK_LIMIT=('JOB_SIZE_MINIMUM','JOB_SIZE_MAXIMUM')
+$ ENDIF
+$ ENDIF
+$!
+$ J = J+1
+$ BURST := NOBURST
+$ IF ((QFLAGS.AND.QUI$M_QUEUE_FILE_BURST_ONE) .NE. 0)
+$ THEN BURST := BURST=ONE
+$ ELSE IF ((QFLAGS.AND.QUI$M_QUEUE_FILE_BURST) .NE. 0) THEN BURST:= BURST=ALL
+$ ENDIF
+$ FEED := NOFEED
+$ IF ((QFLAGS.AND.QUI$M_QUEUE_FILE_PAGINATE) .NE. 0) THEN FEED := FEED
+$ FLAG := NOFLAG
+$ IF ((QFLAGS.AND.QUI$M_QUEUE_FILE_FLAG_ONE) .NE. 0)
+$ THEN FLAG := FLAG=ONE
+$ ELSE IF ((QFLAGS.AND.QUI$M_QUEUE_FILE_FLAG) .NE. 0) THEN FLAG := FLAG=ALL
+$ ENDIF
+$ TRAILER := NOTRAILER
+$ IF ((QFLAGS.AND.QUI$M_QUEUE_FILE_TRAILER_ONE) .NE. 0)
+$ THEN TRAILER := TRAILER=ONE
+$ ELSE IF ((QFLAGS.AND.QUI$M_QUEUE_FILE_TRAILER) .NE. 0) THEN -
+$ TRAILER := TRAILER=ALL
+$ ENDIF
+$ DEFAULT_FORM = F$GETQUI(DQ,"DEFAULT_FORM_NAME","*",FZ)
+$ LINE'J' := /DEFAULT=('BURST','FEED','FLAG','TRAILER',FORM='DEFAULT_FORM')
+$!
+$!Our default is to not generate a /FORM_MOUNTED=form line; thus on existing
+$!queues the form won't change, and for deleted queues the default form gets
+$!mounted. This is so saved output files won't differ due to a job running.
+$!If we do add it use a space at the end to inhibit matching a logical name.
+$ IF (DO_FORM) !Was /FORM on the command line?
+$ THEN
+$ J = J+1
+$ FORM_NAME = F$GETQUI(DQ,"FORM_NAME","*",FZ)
+$ LINE'J' = "/FORM_MOUNTED=" + QT + FORM_NAME + " " + QT
+$ ENDIF
+$!
+$ J = J+1
+$ LIBRARY = F$GETQUI(DQ,"LIBRARY_SPECIFICATION","*",FZ)
+$ IF (LIBRARY .EQS. "")
+$ THEN
+$ LINE'J' := /NOLIBRARY
+$ ELSE
+$ DQ_SYMBOL := LIBRARY
+$ GOSUB DOUBLE_QUOTE
+$ LINE'J' = "/LIBRARY=" + QT + LIBRARY + QT
+$ ENDIF
+$!
+$ IF (VMS_VERSION .GES. "V7.0")
+$ THEN
+$ J = J+1
+$ IF ((QFLAGS.AND.QUI$M_QUEUE_NO_INITIAL_FF) .NE. 0)
+$ THEN LINE'J' := /NO_INITIAL_FF
+$ ELSE LINE'J' := /NONO_INITIAL_FF
+$ ENDIF
+$ ENDIF
+$!
+$ J = J+1
+$ PROCESSOR = F$GETQUI(DQ,"PROCESSOR","*",FZ)
+$ IF (PROCESSOR .EQS. "")
+$ THEN
+$ LINE'J' := /NOPROCESSOR
+$ ELSE
+$ DQ_SYMBOL := PROCESSOR
+$ GOSUB DOUBLE_QUOTE
+$ LINE'J' = "/PROCESSOR=" + QT + PROCESSOR + QT
+$ ENDIF
+$!
+$ J = J+1
+$ IF ((QFLAGS.AND.QUI$M_QUEUE_RECORD_BLOCKING) .NE. 0)
+$ THEN LINE'J' := /RECORD_BLOCKING
+$ ELSE LINE'J' := /NORECORD_BLOCKING
+$ ENDIF
+$!
+$ J = J+1
+$ IF ((QFLAGS.AND.QUI$M_QUEUE_JOB_SIZE_SCHED) .NE. 0)
+$ THEN LINE'J' := /SCHEDULE=SIZE
+$ ELSE LINE'J' := /SCHEDULE=NOSIZE
+$ ENDIF !Is also allowed for generic symbiont queues
+$!
+$ J = J+1
+$ BURST := NOBURST
+$ IF ((QFLAGS.AND.QUI$M_QUEUE_JOB_BURST) .NE. 0) THEN BURST := BURST
+$ FLAG := NOFLAG
+$ IF ((QFLAGS.AND.QUI$M_QUEUE_JOB_FLAG) .NE. 0) THEN FLAG := FLAG
+$ TRAILER := NOTRAILER
+$ IF ((QFLAGS.AND.QUI$M_QUEUE_JOB_TRAILER) .NE. 0) THEN TRAILER := TRAILER
+$ LIST = F$GETQUI(DQ,"JOB_RESET_MODULES","*",FZ)
+$ IF (LIST .EQS. "")
+$ THEN
+$ LINE'J' := /SEPARATE=('BURST','FLAG','TRAILER',NORESET)
+$ ELSE
+$ LINE'J' := /SEPARATE=('BURST','FLAG','TRAILER',RESET=
+$ ADD_COLON = 0
+$ ADD_QUOTES = 1 !Quote every "module"
+$ GOSUB PROCESS_LIST
+$ LINE'J' = LINE'J' + ")"
+$ ENDIF
+$!
+$ RETURN !from SYMBIONTQ
+$!
+$! Routine to break up lists (reset modules, autostart nodes, generic targets)
+$! so that no line is too long and all line continuations will come at the end
+$! of a list element (dashes follow commas). We add a : to the end of generic
+$! target queue names, and we add quotes around every queue reset module name.
+$PROCESS_LIST:
+$ LINE'J' = LINE'J' + "("
+$ DQ_SYMBOL := ELEMENT
+$ IDX = 0
+$ ELEMENT = F$ELEMENT(0,",",LIST)
+$LIST_LOOP:
+$ IF (ADD_COLON) THEN ELEMENT = ELEMENT + ":"
+$ IF (ADD_QUOTES)
+$ THEN
+$ GOSUB DOUBLE_QUOTE
+$ ELEMENT = QT + ELEMENT + QT
+$ ENDIF
+$ IF (F$LENGTH(LINE'J') .GT. 90) !Line getting long?
+$ THEN
+$ J = J+1 !New line
+$ LINE'J' = ELEMENT
+$ ELSE
+$ LINE'J' = LINE'J' + ELEMENT
+$ ENDIF
+$ IDX = IDX+1
+$ ELEMENT = F$ELEMENT(IDX,",",LIST)
+$ IF (ELEMENT .NES. ",")
+$ THEN
+$ LINE'J' = LINE'J' + ","
+$ GOTO LIST_LOOP
+$ ENDIF
+$ LINE'J' = LINE'J' + ")"
+$ RETURN !from PROCESS_LIST
+$!
+$! This GOSUB routine replaces every " found in symbol 'DQ_SYMBOL' with "".
+$DOUBLE_QUOTE:
+$ IN_STRING = 'DQ_SYMBOL'
+$ OUT_STRING = ""
+$QUOTE_LOOP:
+$ BEFORE_QUOTE = F$ELEMENT(0,QT,IN_STRING)
+$ OUT_STRING = OUT_STRING + BEFORE_QUOTE
+$ IF (BEFORE_QUOTE .NES. IN_STRING)
+$ THEN
+$ OUT_STRING = OUT_STRING + QTS
+$ IN_STRING = IN_STRING - BEFORE_QUOTE - QT
+$ GOTO QUOTE_LOOP
+$ ENDIF
+$ 'DQ_SYMBOL' = OUT_STRING
+$ RETURN !from DOUBLE_QUOTE
+$!
+$! Fix up CPU delta time; we validate its format and add a dash after days.
+$FIX_CPU_DELTA:
+$ STRING = F$ELEMENT(0," ",CPU_DELTA) !Get day part of delta time
+$ IF (F$TYPE(STRING) .NES. "INTEGER") !First check if it is valid
+$ THEN !F$GETQUI bug returns absolute time if delta time > 248-13:13:56.47
+$ IF (XDCL) !Version with extended DCL?
+$ THEN !Can fix it using F$DELTA()
+$ MAGIC_TIME := 28-MAR-1860 02:27:52.95 !with a little bit of magic
+$ CPU_DELTA = F$EDIT(F$DELTA(CPU_DELTA,MAGIC_TIME),"TRIM")
+$ ELSE
+$ CPU_DELTA := 248 00:00:00.00 !no fix so use a safe value
+$ ENDIF
+$ ENDIF
+$ CPU_DELTA[F$LOCATE(" ",CPU_DELTA),1] := "-" !overwrite space after days
+$ RETURN !from FIX_CPU_DELTA
+$!
+$! Get all the ACEs placed on the queue and generate a SET SECURITY command.
+$RECREATE_ACL:
+$ CLOSE /NOLOG DQ_ACL_
+$ CONTROL = F$ENVIRONMENT("CONTROL")
+$ SCRATCH := SYS$SCRATCH:DISPLAY_QUEUES_ACL_'F$GETJPI(0,"PID")'.LIS
+$ CREATE /NOLOG /FDL=_NL: 'SCRATCH' !Pre-create a new empty scratch file
+$ SET NOCONTROL=Y !No interruptions while file is open
+$ DEFINE /USER SYS$OUTPUT 'SCRATCH' !Append to the existing scratch file
+$ SHOW ACL /OBJECT_TYPE=QUEUE 'QNAME' !SHOW SECURITY more likely to change
+$ IF (.NOT.$STATUS) THEN GOTO ACL_END !Just in case the ACL suddenly empty
+$!
+$ OPEN /READ DQ_ACL_ 'SCRATCH'
+$ READ /END=ACL_END DQ_ACL_ ACE !Skip SHOW ACL's single heading line
+$ READ /END=ACL_END DQ_ACL_ ACE
+$ ACE = F$EDIT(ACE,"TRIM")
+$ J = J+1
+$ IF (VMS_VERSION .GES. "V6.0")
+$ THEN LINE'J' := $ SET SECURITY /CLASS=QUEUE /DELETE=ALL 'QNAME'
+$ ELSE LINE'J' := $ SET ACL /OBJECT_TYPE=QUEUE /NEW 'QNAME'
+$ ENDIF
+$ J = J+1
+$ LINE'J' := /ACL=(
+$ACE_LOOP:
+$ IF (NO_IDNAMES) THEN GOSUB REPLACE_IDS
+$ LINE'J' = LINE'J' + ACE
+$ READ /END=NO_MORE_ACES DQ_ACL_ ACE
+$ ACE = F$EDIT(ACE,"TRIM")
+$ IF (F$EXTRACT(0,1,ACE) .EQS. "(") THEN LINE'J' = LINE'J' + ","
+$ J = J+1
+$ LINE'J' := " "
+$ GOTO ACE_LOOP
+$NO_MORE_ACES:
+$ LINE'J' = LINE'J' + ")"
+$ACL_END:
+$ GOSUB ACL_CLEANUP
+$ RETURN !from RECREATE_ACL
+$!
+$ACL_CLEANUP:
+$ CLOSE /NOLOG DQ_ACL_
+$ DELETE /NOLOG /NOCONFIRM 'SCRATCH';*
+$ IF (CONTROL-"Y" .NES. CONTROL) THEN SET CONTROL=Y
+$ RETURN !from ACL_CLEANUP
+$!
+$! Replace identifier names in this ACE with their numeric values.
+$REPLACE_IDS:
+$ IDX = F$LOCATE("IDENTIFIER=",ACE) + 11
+$ IF (IDX .GT. F$LENGTH(ACE)) THEN RETURN
+$ LINE'J' = LINE'J' + F$EXTRACT(0,IDX,ACE)
+$ ACE = F$EXTRACT(IDX,999,ACE)
+$ IDENTIFIER := ""
+$ID_LOOP:
+$ IF (ACE .EQS. "") !continued IDENTIFIERS
+$ THEN
+$ READ /END=BADACL DQ_ACL_ ACE
+$ ACE = F$EDIT(ACE,"TRIM")
+$ J = J+1
+$ LINE'J' := " "
+$ ENDIF
+$ BYTE = F$EXTRACT(0,1,ACE)
+$ IF (BYTE .EQS. "[")
+$ THEN
+$ IDENTIFIER = F$ELEMENT(0,"]",ACE) + "]"
+$ ACE = ACE - IDENTIFIER
+$ BYTE = F$EXTRACT(0,1,ACE)
+$ ENDIF
+$ ACE = ACE - BYTE
+$ IF (BYTE.NES."," .AND. BYTE.NES."+")
+$ THEN
+$ IDENTIFIER = IDENTIFIER + BYTE
+$ GOTO ID_LOOP
+$ ENDIF
+$ GOSUB TRANSLATE_IDENTIFIER
+$ LINE'J' = LINE'J' + IDENTIFIER + BYTE
+$ IDENTIFIER := ""
+$ IF (BYTE .EQS. "+") THEN GOTO ID_LOOP
+$ RETURN !from REPLACE_IDS
+$BADACL:
+$ GOSUB ACL_CLEANUP
+$ GOTO BADACL_ERR
+$!
+$! This routine translates a named IDENTIFIER to its equivalent numerical value
+$! which is safer for saved output since identifiers can be renamed or removed.
+$TRANSLATE_IDENTIFIER:
+$ NAME = IDENTIFIER - "[" - "]"
+$ IF (NAME .NES. IDENTIFIER)
+$ THEN !UIC format
+$ IF (NAME-"," .NES. NAME) THEN NAME = F$ELEMENT(1,",",NAME)
+$ FAOCS := "!%U" ! [group#,member#]
+$ ELSE !general ID
+$ FAOCS := "%X!XL" ! %X(8 hex digits)
+$ ENDIF
+$ IF (F$TYPE(NAME) .NES. "INTEGER")
+$ THEN
+$ NUMBER = F$IDENTIFIER(NAME,"NAME_TO_NUMBER")
+$ IF (NUMBER .NE. 0) THEN IDENTIFIER = F$FAO(FAOCS,NUMBER)
+$ ENDIF
+$ RETURN !from TRANSLATE_IDENTIFIER
+$!
+$QUIDEF:
+$!The following are bits in QUEUE_FLAGS
+$ QUI$M_QUEUE_BATCH = %x1
+$ QUI$M_QUEUE_CPU_DEFAULT = %x2
+$ QUI$M_QUEUE_CPU_LIMIT = %x4
+$ QUI$M_QUEUE_FILE_BURST = %x8
+$ QUI$M_QUEUE_FILE_BURST_ONE = %x10
+$ QUI$M_QUEUE_FILE_FLAG = %x20
+$ QUI$M_QUEUE_FILE_FLAG_ONE = %x40
+$ QUI$M_QUEUE_FILE_TRAILER = %x80
+$ QUI$M_QUEUE_FILE_TRAILER_ONE = %x100
+$ QUI$M_QUEUE_GENERIC = %x200
+$ QUI$M_QUEUE_GENERIC_SELECTION = %x400
+$ QUI$M_QUEUE_JOB_BURST = %x800
+$ QUI$M_QUEUE_JOB_FLAG = %x1000
+$ QUI$M_QUEUE_JOB_SIZE_SCHED = %x2000
+$ QUI$M_QUEUE_JOB_TRAILER = %x4000
+$ QUI$M_QUEUE_RETAIN_ALL = %x8000
+$ QUI$M_QUEUE_RETAIN_ERROR = %x10000
+$ QUI$M_QUEUE_SWAP = %x20000
+$ QUI$M_QUEUE_TERMINAL = %x40000
+$ QUI$M_QUEUE_WSDEFAULT = %x80000
+$ QUI$M_QUEUE_WSEXTENT = %x100000
+$ QUI$M_QUEUE_WSQUOTA = %x200000
+$ QUI$M_QUEUE_FILE_PAGINATE = %x400000
+$ QUI$M_QUEUE_RECORD_BLOCKING = %x800000
+$ QUI$M_QUEUE_PRINTER = %x1000000
+$ QUI$M_QUEUE_ACL_SPECIFIED = %x2000000
+$ QUI$M_QUEUE_NOTIFY_ON_INTERRUPT = %x4000000
+$ QUI$M_QUEUE_CHECKPOINT_FREQ = %x8000000
+$ QUI$M_QUEUE_AUTOSTART = %x10000000
+$ QUI$M_SECURITY_INACCESSIBLE = %x20000000
+$ QUI$M_QUEUE_NO_INITIAL_FF = %x40000000
+$ QUI$M_QUEUE_RAD = %x80000000
+$!
+$!The following are bits in QUEUE_STATUS
+$ QUI$M_QUEUE_ALIGNING = %x1
+$ QUI$M_QUEUE_IDLE = %x2
+$ QUI$M_QUEUE_LOWERCASE = %x4
+$ QUI$M_QUEUE_OPERATOR_REQUEST = %x8
+$ QUI$M_QUEUE_PAUSED = %x10
+$ QUI$M_QUEUE_PAUSING = %x20
+$ QUI$M_QUEUE_REMOTE = %x40
+$ QUI$M_QUEUE_RESETTING = %x80
+$ QUI$M_QUEUE_RESUMING = %x100
+$ QUI$M_QUEUE_SERVER = %x200
+$ QUI$M_QUEUE_STALLED = %x400
+$ QUI$M_QUEUE_STARTING = %x800
+$ QUI$M_QUEUE_STOPPED = %x1000
+$ QUI$M_QUEUE_STOPPING = %x2000
+$ QUI$M_QUEUE_UNAVAILABLE = %x4000
+$ QUI$M_QUEUE_CLOSED = %x8000
+$ QUI$M_QUEUE_BUSY = %x10000
+$ QUI$M_QUEUE_UNDEFINED = %x20000
+$ QUI$M_QUEUE_AVAILABLE = %x40000
+$ QUI$M_QUEUE_DISABLED = %x80000
+$ QUI$M_QUEUE_AUTOSTART_INACTIVE = %x100000
+$ QUI$M_QUEUE_STOP_PENDING = %x200000
+$!
+$ RETURN !from QUIDEF
+$!
+$HELP_THEM:
+$ TYPE SYS$INPUT:
+$DECK
+DISPLAY_QUEUES elicits the complete specifications for a set of queues
+using F$GETQUI and outputs DCL command lines to recreate the queue(s).
+The commands go to SYS$OUTPUT: or you can use @DISPLAY_QUEUES/OUTPUT=.
+
+P1 can be a specific queue name or a wildcarded string; default is *.
+
+
+P2-P8 can be used for the following /options that select what type of
+queues are processed and what DCL commands are output for each queue:
+ /BATch - select batch queues only
+ /DEVice - select printer, terminal, and server queues only
+ /GENeric - select generic and logical queues only
+ /NOGENeric - select execution queues only
+ /STOP - output a STOP/QUEUE/RESET queue as the first command for each queue
+ /DEASsign - output a DEASSIGN/QUEUE command for logical queues before INITs
+ /DELEte - output a DELETE/QUEUE command just before each INIT/QUEUE command
+ /STARt - start each queue with the INIT or after ASSIGNs for logical queues
+ /NOSTARt - do not start any queue (default is to start only started queues)
+ /FORM - output /FORM_MOUNTED=current_form for device execution queues
+ /NOASSIgn - do not output the ASSIGN/QUEUE command for logical queues
+ /ASSIgn_only - only output the ASSIGN/QUEUE command for logical queues
+ /NOACL - do not output the SET SECURITY command for queues with ACLs
+ /ACL_only - only output the SET SECURITY command for queues with ACLs
+ /NOIDentifiers - translate owner and ACL identifier names to numeric values
+$EOD
+$ EXIT $STATUS + F$VERIFY(VFY)*0
+
diff --git a/do-delicious-dcl b/do-delicious-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_ZG8tZGVsaWNpb3VzLWRjbA==
--- /dev/null
+++ b/do-delicious-dcl
@@ -0,0 +1,44 @@
+Do_delicious
+Aaron, Saturday April 28 2007 @ 03:30PM EDT
+$ Set NoOn
+$ define/NoLog CacheDir Apache$Common:[HTdocs.Links]
+$ Username = "your-del.icio.us-name"
+$ CacheLife = "-04:00:00"
+$ ShortList = "5"
+$ DefaultList = "15"
+$ LongList = "99"
+$ Ext = ".DAT"
+$ Tag = Query_String
+$ FileSpec = "CacheDir:" + Tag + Ext
+$ type sys$input
+Content-type: text/plain
+
+$ eod
+$ if f$search(FileSpec) .eqs. ""
+$ then
+$ GoSub GetFile
+$ else
+$ set message /NoFacility /NoSeverity /NoIdentification /NoText
+$ on Severe_Error then Gosub GetFile
+$ a = f$delta_time(f$cvtime(CacheLife,"Absolute","DateTime"),-
+f$file(FileSpec,"CDT"))
+$ set NoOn
+$ set message /Facility /Severity /Identification /Text
+$ endif
+$ type 'FileSpec'
+$ exit
+$
+$ GetFile:
+$ set message /Facility /Severity /Identification /Text
+$ if f$edit(Tag,"UpCase") .eqs. "DEFAULT"
+$ then
+$ Tag = ""
+$ Count = ShortList
+$ else
+$ Count = LongList
+$ endif
+$ define /user sys$output nl:
+$ define /user sys$error nl:
+$ wget --output-document='FileSpec' --timeout=5 -
+http://del.icio.us/html/'Username'/'Tag'?tags=no&rssbutton;=no&count;='Count'
+$ return
\ No newline at end of file
diff --git a/dyndns-dcl b/dyndns-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_ZHluZG5zLWRjbA==
--- /dev/null
+++ b/dyndns-dcl
@@ -0,0 +1,134 @@
+DynDNS_VMS.com
+Aaron Sakovich, Tuesday October 26 2004 @ 11:44PM EDT
+$! DynDNS_VMS -- Dynamic DNS client for OpenVMS
+$! ACSakovich, 26-Oct-2004
+$!
+$! Please send problem reports to aaron@openvms.org
+$!
+$ Version = "0.5"
+$!
+$! The following variables should be set to match your configuration.
+$! See the following URL for specific details regarding these values:
+$! https://www.dyndns.org/developers/specs/syntax.html
+$!
+$ Setup:
+$ UserName = "test" ! Your dyndns username
+$ Passwd = "test" ! Your account's password
+$ System = "dyndns" ! DYNDNS|STATDNS|CUSTOM
+$ Host = "test.dyndns.org"! Your hostname{,host2,...}
+$ Wildcard = "OFF" ! ON|OFF|NOCHG
+$ mx = "" ! MX hostname
+$ backmx = "NO" ! YES|NO
+$ offline = "NO" ! YES|NO
+$ ErrMail = "system" ! email address to receive error reports
+$
+$! ========================================================================
+$! You shouldn't have to change anything after this
+$!
+$! Note that there are some logicals that this program uses to
+$! manage updates. If these logicals don't exist, this program
+$! will create them as necessary, save for DynDNS$ForceUpdate,
+$! which should only be created if you want to do that. They are:
+$!
+$! Program generated:
+$! DynDNS$LastIP - the last IP recorded by DynDNS
+$! DynDNS$LastUpdate - date of last update
+$! User setable/resetable
+$! DynDNS$ForceUpdate - if True, an update is forced
+$! DynDNS$NoMoreUpdates - if True, severe error occured, and this
+$! program won't do any more updates without
+$! user intervention & resetting this logical
+$!
+$ agent = "--user-agent=""DynDNS_VMS/" + Version + """"
+$ if f$trnlnm("DynDNS$NoMoreUpdates")
+$ then
+$ mail nl: "''ErrMail'" /nosignature -
+/subject="DynDNS updates prohibited by logical DynDNS$NoMoreUpdates"
+$ exit
+$ endif
+$
+$ DoUpd = "False"
+$ if f$trnlnm("DynDNS$ForceUpdate")
+$ then
+$ DoUpd = "True"
+$ define /system DynDNS$ForceUpdate "False"
+$ endif
+$ gosub GetCurrentIP
+$ if CurrentIP .nes. f$trnlnm("DynDNS$LastIP") then DoUpd = "True"
+$ if f$trnlnm("DynDNS$LastUpdate") .les. f$cvt("-25-",,"Date") then -
+DoUpd = "True"
+$ gosub ValidateIP
+$ if InvalidIP then DoUpd = "False"
+$ if DoUpd
+$ then
+$ gosub UpdateIP
+$ define /system DynDNS$LastIP "''CurrentIP'"
+$ endif
+$ Exit
+$!
+$! End of main code loop
+$! Subroutines follow............................................
+$!
+$ GetCurrentIP:
+$ wget --output-document=ip.txt http://checkip.dyndns.org/
+$ close/nolog IPfile
+$ open/read IPfile ip.txt
+$ read/end=NoIP IPfile ip
+$ close IPfile
+$ ip = f$edit(ip,"Collapse,LowerCase")
+$ start = f$locate("<body>",ip) + 6
+$ end = f$locate("</body",ip) - start
+$ CurrentIP = f$elem(1,":",f$extr(start,end,ip))
+$ delete /nolog ip.txt.*
+$ Return
+$ NoIP:
+$ close/nolog IPfile
+$ wait 00:00:30
+$ goto GetCurrentIP
+$
+$ UpdateIP:
+$ URL = "http://members.dyndns.org/nic/update?system=" + system + -
+"&hostname;=" + host + "&wildcard;=" + Wildcard + -
+"&mx;=" + mx + "&backmx;=" + backmx + "&offline;=" + offline
+$ wget --http-user='username' --http-passwd='passwd' 'agent' -
+--output-document=new_ip.txt 'URL'
+$ close /nolog NewIP
+$ open/read NewIP new_ip.txt
+$ read/end=NoUpdate NewIP IPstatus
+$ close NewIP
+$ status = f$elem(0," ",IPstatus)
+$ CurrentIP = f$elem(1," ",IPstatus)
+$ if (status .nes. "good") .and. (status .nes. "nochg")
+$ then
+$ pipe write sys$output "Update status is ''IPstatus'; updates halted" | -
+mail sys$pipe 'ErrMail' /subj="Error processing DynDNS update"
+$ define/system DynDNS$NoMoreUpdates "True"
+$ else
+$ define/system DynDNS$LastUpdate "''f$cvtime(,,"Date")'"
+$ endif
+$ delete /nolog new_ip.txt.*
+$ Return
+$ NoUpdate:
+$ close/nolog NewIP
+$ wait 00:00:30
+$ got UpdateIP
+$
+$ ValidateIP:
+$ Octet1 = 'f$element(0,".",CurrentIP)'
+$ Octet2 = 'f$element(1,".",CurrentIP)'
+$ Octet3 = 'f$element(2,".",CurrentIP)'
+$ Octet4 = 'f$element(3,".",CurrentIP)'
+$ if Octet1 .ge. 0 .and. Octet1 .le. 255 .and. -
+Octet2 .ge. 0 .and. Octet2 .le. 255 .and. -
+Octet3 .ge. 0 .and. Octet3 .le. 255 .and. -
+Octet4 .ge. 0 .and. Octet4 .le. 255 .and. -
+CurrentIP .nes. "255.255.255.255" .and. -
+CurrentIP .nes. "0.0.0.0"
+$ then
+$ InvalidIP = "False"
+$ else
+$ InvalidIP = "True"
+$ endif
+$ Return
+
+
diff --git a/eachline-dcl b/eachline-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_ZWFjaGxpbmUtZGNs
--- /dev/null
+++ b/eachline-dcl
@@ -0,0 +1,27 @@
+EachLine
+Aaron Sakovich, Friday January 21 2005 @ 11:27AM EST
+$! EachLine
+$! By ACSakovich, 21-Jan-2005
+$! Input: P1 = variable name
+$! P2 = command line
+$! Sys$Pipe = data stream
+$! Output: Sys$Output = each line of Sys$Pipe is named by P1 and processed
+$! by command line
+$
+$! Example usage:
+$! Presume you've a file, SPAMMERS.TXT, which is a list of email addresses
+$! extracted from mail you've received (probably extracted by using EachLine
+$! itself, but that exercise is left to the reader). You want to get a sorted
+$! list of their domains? Use the following
+$!
+$! pipe type spammers.txt | -
+$! eachline email "write sys$output f$elem(1,""@"",email)" | -
+$! sort sys$pipe sys$output
+$
+$ Loop:
+$ Read/End=Done Sys$Pipe 'p1'
+$ 'p2'
+$ Goto Loop
+$ Done:
+$ Exit
+
diff --git a/entry-rel-dcl b/entry-rel-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_ZW50cnktcmVsLWRjbA==
--- /dev/null
+++ b/entry-rel-dcl
@@ -0,0 +1,274 @@
+PQGRM.COM
+Kevin Fouse, Thursday June 23 2005 @ 10:25PM EDT
+$! PQGRM.COM
+$!
+$! This program will release or put entries on hold in a selected print
+$!queue.
+$!
+$!-------------------------------DEFINE SYMBOLS---------------------------------
+$!
+$ ACTION = ""
+$ C = 0
+$ CHK = "ON"
+$ CHRTR = ""
+$ DSPC = "DISPLAY_CHARACTERISTIC"
+$ DSPJ = "DISPLAY_JOB"
+$ DSPQ = "DISPLAY_QUEUE"
+$ E = 0
+$ ENTN = "ENTRY_NUMBER"
+$ ETRTH = ""
+$ GTLTE = ""
+$ HJNS = "ALL_JOBS,HOLDING_JOBS"
+$ LNOUT = ""
+$ N = 0
+$ PJNS = "ALL_JOBS,PENDING_JOBS"
+$ QNSYMB = "/CLU$Q2/CLU$DJDE/PRI$DJDE/AC4$DJDE/CLU$Q1"
+$ SCRN = "SET TERM/WIDTH=80"
+$ TB = 5
+$ TRTH = "There/are/no/"
+$ TSTING = ""
+$ USENM = ""
+$ WRS = "WRITE SYS$OUTPUT"
+$!
+$!------------------------------SELECT QUEUE MENU-------------------------------
+$!
+$LOOP0:
+$ SCRN
+$ WRS F$FAO("!9(/)!34* (1) CLU$Q2!(/)!34* (2) CLU$DJDE!(/)!34* (3) AC4$DJDE")
+$ WRS F$FAO("!34* (4) PRI$DJDE!(/)")
+$ INQUIRE QNUMB "''F$FAO("!28* Please select a queue")'"
+$ IF F$TYPE(QNUMB) .EQS. "STRING" .OR. QNUMB .LT. 1 .OR. QNUMB .GT. 5
+$ THEN GOSUB INVLD
+$ GOTO LOOP0
+$ ENDIF
+$ QNAME = F$ELEMENT(QNUMB,"/",QNSYMB)
+$ IF F$GETQUI(DSPQ,"OWNER_UIC",QNAME) .EQS. ""
+$ THEN TRTH = "The/" + QNAME + "/queue/is/no/longer/valid."
+$ GOSUB OUTSTMT
+$ EXIT
+$ ENDIF
+$ GOSUB CHKQUE
+$ PNDJC = F$GETQUI(DSPQ,"PENDING_JOB_COUNT",QNAME,)
+$ HLDJC = F$GETQUI(DSPQ,"HOLDING_JOB_COUNT",QNAME,)
+$ IF PNDJC + HLDJC .EQ. 0 THEN GOTO OUTTRTHERR
+$!
+$!-----------------------------SELECT ACTION MENU-------------------------------
+$!
+$LOOP1:
+$ SCRN
+$ WRS F$FAO("!8(/)!26* (1) RELEASE ALL JOBS!(/)!26* (2) RELEASE SELECT JOBS")
+$ WRS F$FAO("!26* (3) HOLD ALL JOBS!(/)!26* (4) HOLD SELECT JOBS!(/)")
+$ WRS F$FAO("!18* This procedure will ignore time release jobs.!(/)")
+$ INQUIRE ANUMB "''F$FAO("!26* Plese make a selection")'"
+$ IF F$TYPE(ANUMB) .EQS. "STRING" .OR. ANUMB .LT. 1 .OR. ANUMB .GT. 4
+$ THEN GOSUB INVLD
+$ GOTO LOOP1
+$ ENDIF
+$ IF ANUMB .LT. 3 THEN ACTION = "RELEASE"
+$ IF ANUMB .GT. 2 THEN ACTION = "HOLD"
+$ IF ACTION .EQS. "HOLD" .AND. PNDJC .EQ. 0 THEN GOTO OUTTRTHERR
+$ IF ACTION .EQS. "RELEASE" .AND. HLDJC .EQ. 0 THEN GOTO OUTTRTHERR
+$ IF ANUMB .EQ. 1 .OR. ANUMB .EQ. 3 THEN GOTO ENDACTN
+$!
+$!-----------------------------GET CHARACTERISTIC-------------------------------
+$!
+$GETCHRTR:
+$ SCRN
+$ WRS F$FAO("!8(/)")
+$ TYPE SYS$INPUT
+Please enter a valid characteristic name or number. Type in the word NONE
+for entries submitted without charactersitics. Press RETURN or ENTER to ignore
+characteristics.
+EXAMPLE: You can either enter the word "QUAD" or the number 23.
+$ WRS ""
+$ INQUIRE CHRTR " Please enter characteristic"
+$ IF CHRTR .EQS. "" THEN GOTO GETBLKSZ
+$ IF F$TYPE(CHRTR) .EQS. "INTEGER" THEN -
+CHRTR = F$GETQUI(DSPC,"CHARACTERISTIC_NAME",CHRTR)
+$ NCHRTR = F$GETQUI(DSPC,"CHARACTERISTIC_NUMBER",CHRTR)
+$ IF NCHRTR .EQS. "" .AND. CHRTR .NES. "NONE"
+$ THEN GOSUB INVLD
+$ GOTO GETCHRTR
+$ ENDIF
+$ GOSUB GOFORJOBS
+$ IF JBMTCH .EQ. 0 THEN GOTO OUTTRTHERR
+$!
+$!-------------------------------GET BLOCK SIZE---------------------------------
+$!
+$GETBLKSZ:
+$ SCRN
+$ WRS F$FAO("!10(/)")
+$ WRS F$FAO("!12* Please enter a Block Size. Press RETURN or ENTER to skip.")
+$ INQUIRE BLKSZ "''F$FAO("!(/)!31* Block Size")'"
+$ IF BLKSZ .EQS. "" THEN GOTO GETUSERNM
+$ IF F$TYPE(BLKSZ) .EQS. "STRING" .OR. BLKSZ .LT. 0 .OR. BLKSZ .GT. 500000
+$ THEN GOSUB INVLD
+$ GOTO GETBLKSZ
+$ ENDIF
+$LOOPA:
+$ WRS F$FAO("!(/)!34* (1) ABOVE!(/)!34* (2) BELOW!(/)")
+$ INQUIRE GTLTE "''F$FAO("!30* Please select one")'"
+$ IF F$TYPE(GTLTE) .EQS. "STRING" .OR. GTLTE .LT. 1 .OR. GTLTE .GT. 2
+$ THEN GOSUB INVLD
+$ GOTO GETBLKSZ
+$ ENDIF
+$ IF GTLTE .EQ. 1 THEN GTLTE = "ABOVE"
+$ IF GTLTE .EQ. 2 THEN GTLTE = "BELOW"
+$ GOSUB GOFORJOBS
+$ IF JBMTCH .EQ. 0 THEN GOTO OUTTRTHERR
+$!
+$!--------------------------------GET USERNAME----------------------------------
+$!
+$GETUSERNM:
+$ SCRN
+$ WRS F$FAO("!10(/)")
+$ WRS " Please enter a valid username. Press RETURN or ENTER to skip."
+$ INQUIRE USENM "''F$FAO("!(/)!30* Username")'"
+$ IF USENM .EQS. "" THEN GOTO ENDACTN
+$ IF F$IDENTIFIER(USENM,"NAME_TO_NUMBER") .EQ. 0
+$ THEN GOSUB INVLD
+$ GOTO GETUSERNM:
+$ ENDIF
+$ GOSUB GOFORJOBS
+$ IF JBMTCH .EQ. 0 THEN GOTO OUTTRTHERR
+$!
+$!---------------------------------END ACTION-----------------------------------
+$!
+$ENDACTN:
+$ TRTH = ACTION + "/all/"
+$ GOSUB TRTHBLD
+$ TRTH = TRTH + "?"
+$ GOSUB OUTSTMT
+$ INQUIRE GOON "''F$FAO("!(/) Is the preceeding statement correct? Y/N")'"
+$ IF F$EXTRACT(0,1,GOON) .NES. "Y" .AND. F$EXTRACT(0,1,GOON) .NES. "N"
+$ THEN GOSUB INVLD
+$ GOTO ENDACTN
+$ ENDIF
+$ IF F$EXTRACT(0,1,GOON) .NES. "Y" THEN EXIT
+$ SCRN
+$ TSTING = "FALSE"
+$ GOSUB GOFORJOBS
+$ EXIT
+$!
+$!------------------------------GO THROUGH JOBS---------------------------------
+$!
+$GOFORJOBS:
+$ JBMTCH = 0
+$ TEMP = F$GETQUI("")
+$LOOP8:
+$ CQNAME = F$GETQUI(DSPQ,"QUEUE_NAME","*","PRINTER")
+$ IF CQNAME .EQS. ""
+$ THEN TRTH = "This/program/was/unable/to/locate/the/" + QNAME + "/queue."
+$ GOSUB OUTSTMT
+$ EXIT
+$ ENDIF
+$ IF CQNAME .NES. QNAME THEN GOTO LOOP8
+$LOOP9:
+$ IF ACTION .EQS. "HOLD" THEN JNUM = F$GETQUI(DSPJ,ENTN,,PJNS)
+$ IF ACTION .EQS. "RELEASE" THEN JNUM = F$GETQUI(DSPJ,ENTN,,HJNS)
+$ IF JNUM .EQ. 0 THEN RETURN
+$ IF CHRTR .NES. ""
+$ THEN JCHRTR = F$GETQUI(DSPJ,"CHARACTERISTICS",,"FREEZE_CONTEXT")
+$ IF CHRTR .EQS. "NONE" .AND. JCHRTR .NES. "" THEN GOTO LOOP9
+$ IF JCHRTR .NE. NCHRTR THEN GOTO LOOP9
+$ ENDIF
+$ IF GTLTE .NES. ""
+$ THEN FLSZE = F$GETQUI(DSPJ,"JOB_SIZE",,"FREEZE_CONTEXT")
+$ IF GTLTE .EQS. "ABOVE" .AND. FLSZE .LE. BLKSZ THEN GOTO LOOP9
+$ IF GTLTE .EQS. "BELOW" .AND. FLSZE .GE. BLKSZ THEN GOTO LOOP9
+$ ENDIF
+$ IF USENM .NES. ""
+$ THEN CUSENM = F$GETQUI(DSPJ,"USERNAME",,"FREEZE_CONTEXT")
+$ IF USENM .NES. CUSENM THEN GOTO LOOP9
+$ ENDIF
+$ JBMTCH = JBMTCH + 1
+$ IF TSTING .NES. "FALSE" THEN GOTO LOOP9
+$ IF ACTION .EQS. "RELEASE" THEN SET QUEUE/RELEASE/ENTRY='JNUM' 'QNAME'
+$ IF ACTION .EQS. "RELEASE" THEN WRS F$FAO("!30* ENTRY")," ",JNUM," RELEASED"
+$ IF ACTION .EQS. "HOLD" THEN SET QUEUE/HOLD/ENTRY='JNUM' 'QNAME'
+$ IF ACTION .EQS. "HOLD" THEN WRS F$FAO("!30* ENTRY")," ",JNUM," HELD"
+$ GOTO LOOP9
+$!
+$!-----------------------------CHECK QUEUE STATUS-------------------------------
+$!
+$CHKQUE:
+$ IF F$GETQUI(DSPQ,"QUEUE_STOPPED",QNAME,) .EQS. "FALSE"
+$ THEN TRTH = "The/" + QNAME + "/queue/must/be/stopped/before/executing/this"-
++ "/command/procedure."
+$ GOSUB OUTSTMT
+$ EXIT
+$ ENDIF
+$ RETURN
+$!
+$!---------------------------INVALID SELECTION MADE-----------------------------
+$!
+$INVLD:
+$ WRS ""
+$ WRS F$FAO("!25* AN INVALID SELECTION WAS MADE.")
+$ WRS ""
+$ IF E .EQ. 2 THEN EXIT
+$ E = E + 1
+$ INQUIRE GOON " PRESS RETURN TO CONTINUE"
+$ RETURN
+$!
+$!------------------------------OUTPUT TRTH ERROR-------------------------------
+$!
+$OUTTRTHERR:
+$ GOSUB TRTHBLD
+$ TRTH = TRTH + ETRTH
+$ GOSUB OUTSTMT
+$ EXIT
+$!
+$!----------------------------TRUTH STATEMENT BUILD-----------------------------
+$!
+$TRTHBLD:
+$ IF CHRTR .NES. "NONE"
+$ THEN TRTH = TRTH + CHRTR + "/entries/"
+$ ELSE TRTH = TRTH + "entries/WITHOUT/CHARACTERISTICS/"
+$ ENDIF
+$ IF GTLTE .NES. "" THEN TRTH = TRTH + GTLTE + "/" + F$STRING(BLKSZ) + "/blocks"
+$ IF USENM .NES. "" THEN TRTH = TRTH + "/for/username/" + USENM
+$ TRTH = TRTH + "/in/the/" + QNAME + "/queue"
+$ IF ACTION .EQS. "RELEASE"
+$ THEN ETRTH = ETRTH + "/to/" + ACTION + "."
+$ ELSE ETRTH = ETRTH + "/to/put/on/" + ACTION + "."
+$ ENDIF
+$ IF ACTION .EQS. "" THEN ETRTH = "/to/release/or/put/on/hold."
+$ RETURN
+$!
+$!----------------------------OUTPUT TRTH STATEMENT-----------------------------
+$!
+$OUTSTMT:
+$ IF F$ELEMENT(C,"/",TRTH) .EQS. "/"
+$ THEN GOSUB OUTSCRN
+$ N = 0
+$ C = 0
+$ TB = 5
+$ RETURN
+$ ENDIF
+$ IF F$LENGTH(LNOUT) + F$LENGTH(F$ELEMENT(C,"/",TRTH)) + TB + 1 .GT. 80 THEN-
+GOSUB OUTSCRN
+$ LNOUT = LNOUT + F$ELEMENT(C,"/",TRTH) + " "
+$ C = C + 1
+$ GOTO OUTSTMT
+$OUTSCRN:
+$ LNOUT = F$EDIT(F$EDIT(LNOUT,"TRIM"),"COMPRESS")
+$ IF N .EQ. 0
+$ THEN LNOUT = " " + LNOUT
+$ SCRN
+$ WRS F$FAO("!10(/)")
+$ TB = 0
+$ ENDIF
+$ WRS LNOUT
+$ LNOUT = ""
+$ N = N + 1
+$ RETURN
+$!
+$!-----------------------------------HISTORY------------------------------------
+$!
+$! PQGRM.COM; V1.0
+$!
+$! The final release build for this procedure was completed by KJF on
+$!20-JUN-2002.
+$!
+$!------------------------------------------------------------------------------
diff --git a/environmental-check-dcl b/environmental-check-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_ZW52aXJvbm1lbnRhbC1jaGVjay1kY2w=
--- /dev/null
+++ b/environmental-check-dcl
@@ -0,0 +1,98 @@
+Environmental Check
+Scott Belviso, Thursday July 10 2003 @ 11:30AM EDT
+$! Program: ENV_CHECK.COM
+$!
+$! Purpose: Gathers and displays the state of the internal Fans/Temperature/Thermal/Power Supplies of the system. Not all systems
+$! are capable of reporting this information so the output will be different for each type. Some systems can't report any.
+$!
+$! History:
+$! Scott Belviso 02/07/03 - Original Creation
+$!
+$! Paramaters:
+$! none
+$!
+$! Run instructions:
+$! @env_check
+$!
+$!
+$ thermal_ctr = 0
+$ thermal_size = 2
+$ thermal_length = 32
+$ fan_ctr = 0
+$ fan_size = 2
+$ fan_length = 32
+$ temp_ctr = 0
+$ temp_size = 2
+$ temp_length = 32
+$ power_ctr = 0
+$ power_size = 2
+$ power_length = 32
+$ tv = f$getsyi("thermal_vector")
+$ fv = f$getsyi("fan_vector")
+$ temp_v = f$getsyi("temperature_vector")
+$ pv = f$getsyi("power_vector")
+$!
+$! Main
+$!
+$main:
+$ gosub thermal_loop
+$ gosub fan_loop
+$ gosub temp_loop
+$ gosub power_loop
+$ goto done
+$!
+$! Begin subroutines
+$!
+$thermal_loop:
+$ thermal_ctr = thermal_ctr + 1
+$ if thermal_ctr * thermal_size .gt. thermal_length then return
+$ thermal'thermal_ctr = -
+f$extract(thermal_length - (thermal_size * thermal_ctr),thermal_size,tv)
+$ if thermal'thermal_ctr .eqs. "01" -
+then write sys$output "Thermal ''thermal_ctr' is Good"
+$ if thermal'thermal_ctr .eqs. "00" -
+then write sys$output "Thermal ''thermal_ctr' is BAD"
+$! if thermal'thermal_ctr .eqs. "FF" -
+$! then write sys$output "Thermal ''thermal_ctr' is Not Present"
+$ goto thermal_loop
+$!
+$fan_loop:
+$ fan_ctr = fan_ctr + 1
+$ if fan_ctr * fan_size .gt. fan_length then return
+$ fan'fan_ctr = f$extract(fan_length - (fan_size * fan_ctr),fan_size,fv)
+$ if fan'fan_ctr .eqs. "01" -
+then write sys$output "FAN ''fan_ctr' is Good"
+$ if fan'fan_ctr .eqs. "00" -
+then write sys$output "FAN ''fan_ctr' is BAD"
+$! if fan'fan_ctr .eqs. "FF" -
+$! then write sys$output "FAN ''fan_ctr' is Not Present"
+$ goto fan_loop
+$!
+$temp_loop:
+$ temp_ctr = temp_ctr + 1
+$ if temp_ctr * temp_size .gt. temp_length then return
+$ temp'temp_ctr = -
+f$extract(temp_length - (temp_size * temp_ctr),temp_size,temp_v)
+$ if temp'temp_ctr .nes. "FF"
+$ then
+$ actual_temp = temp'temp_ctr
+$ actual_temp = %x'actual_temp
+$ write sys$output "Temp ''temp_ctr' is ''actual_temp' Celsius"
+$ endif
+$ goto temp_loop
+$!
+$power_loop:
+$ power_ctr = power_ctr + 1
+$ if power_ctr * power_size .gt. power_length then return
+$ power'power_ctr = -
+f$extract(power_length - (power_size * power_ctr),power_size,pv)
+$ if power'power_ctr .eqs. "01" -
+then write sys$output "Power Supply ''power_ctr' is Good"
+$ if power'power_ctr .eqs. "00" -
+then write sys$output "Power Supply ''power_ctr' is BAD"
+$! if power'power_ctr .eqs. "FF" -
+$! then write sys$output "Power Supply ''power_ctr' is Not Present"
+$ goto power_loop
+$!
+$done:
+$ exit
diff --git a/extract-oper-log-dcl b/extract-oper-log-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_ZXh0cmFjdC1vcGVyLWxvZy1kY2w=
--- /dev/null
+++ b/extract-oper-log-dcl
@@ -0,0 +1,14 @@
+EXTRACT_OPER_LOG.COM
+Richard B. Gilbert, Wednesday February 04 2004 @ 08:00PM EST
+In response to a request on comp.os.vms for a script to "...to read a log file which contains a list of events with timestamps. Only events from yesterday should be extracted into another text file, which would be mailed.
+27-jan-2004 14:00:02
+fsdfsdfdsfdfdfdfs
+28-jan-2004 12:00:00
+sample2,sample2
+
+Only entries from yesterday need to be extracted. How can I do this?"
+
+I replied with this two liner. It does what he asks for but it's not the best way to handle the problem. Best would have been to use REPLY /LOG to close the log file at midnight each day and then mail the old logfile entire.
+
+$ SEARCH SYS$MANAGER:OPERATOR.LOG /WINDOW=(0,1) /OUTPUT=XX.TMP -
+'F$CVTIME("YESTERDAY", "ABSOLUTE", "DATE")'
\ No newline at end of file
diff --git a/fallback-dcl b/fallback-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_ZmFsbGJhY2stZGNs
--- /dev/null
+++ b/fallback-dcl
@@ -0,0 +1,178 @@
+FALLBACK.COM
+David B Sneddon, Monday November 01 2004 @ 06:31AM EST
+
+$ ! Procedure: FALLBACK.COM
+$ __vfy = "VFY_''f$parse(f$environment("procedure"),,,"name")'"
+$ if (f$type('__vfy') .eqs. "") then __vfy = 0
+$ __vfy_saved = f$verify(&__vfy)
+$ procedure = f$element(0,";",f$environment("PROCEDURE"))
+$ procedure_name = f$parse(procedure,,,"NAME")
+$ facility = procedure_name
+$ location = f$parse(procedure,,,"DEVICE","NO_CONCEAL") -
++ f$parse(procedure,,,"DIRECTORY","NO_CONCEAL") - "]["
+$ set noon
+$ on control_y then goto bail_out
+$ _arch_type = f$getsyi("ARCH_TYPE")
+$!$ _arch_name = f$getsyi("ARCH_NAME") ! "OTHER,VAX,Alpha,IA-64"
+$ _arch_name = f$element(_arch_type,",","OTHER,VAX,ALPHA,IPF") - ","
+$ _vax = (_arch_type .eq. 1)
+$ _axp = (_arch_type .eq. 2)
+$ _ipf = (_arch_type .eq. 3)
+$ _other = (.not. (_vax .or. _axp .or. _ipf))
+$ scsnode = f$edit(f$getsyi("SCSNODE"),"COLLAPSE,UPCASE")
+$ special_nodes = "/NODE1/NODE2/" !*** these nodes have a tick length of 8333
+$ say = "write sys$output"
+$ set default sys$manager
+$ if (_vax)
+$ then call do_vax
+$ linkit = "link"
+$ else
+$ if (_axp)
+$ then call do_axp
+$ linkit = "link/sysexe"
+$ else
+$ if (_ipf)
+$ then call do_ipf
+$ linkit = "link/sysexe"
+$ endif
+$ endif
+$ endif
+$ macroo/nolist fallback
+$ linkit/notrace/nomap fallback
+$ deletee/nolog fallback.obj;*
+$ deletee/nolog fallback.mar;*
+$ run fallback
+$ wait 03:00:00.00
+$ set time = "''f$time()'"
+$ set time
+$ deletee/nolog sys$manager:fallback.exe;*
+$bail_out:
+$ !'f$verify(__vfy_saved)'
+$ exitt 1
+$
+$do_axp: subroutine
+$ if (f$locate("/''scsnode'/",special_nodes) .ne. f$length(special_nodes))
+$ then
+$ call do_axp_special
+$ else
+$ call do_axp_standard
+$ endif
+$ exitt 1
+$ endsubroutine
+$
+$do_axp_standard: subroutine
+$ set noon
+$ ! ticklength is 9765
+$ copyy sys$input fallback.mar
+.title fallback, adjust VMS clock to run 25% slow for four hours
+.library "SYS$LIBRARY:LIB.MLB"
+.entry fallback, ^m<>
+$cmkrnl_s routin=fixit
+movl #1, r0
+ret
+.entry fixit, ^m<>
+lock hwclk
+movl #14745600, g^exe$gl_timeadjust ; 4*60*60*1024 = four hours
+; 1024 = 10000000/9765
+movl #7323, g^exe$gl_ticklength ; that's 9765*75/100
+unlock hwclk
+movl #1, r0
+ret
+.end fallback
+$ exitt 1
+$ endsubroutine
+$
+$do_axp_special: subroutine
+$ set noon
+$ ! ticklength is 8333
+$ copyy sys$input fallback.mar
+.title fallback, adjust VMS clock to run 25% slow for four hours
+.library "SYS$LIBRARY:LIB.MLB"
+.entry fallback, ^m<>
+$cmkrnl_s routin=fixit
+movl #1, r0
+ret
+.entry fixit, ^m<>
+lock hwclk
+movl #17280000, g^exe$gl_timeadjust ; 4*60*60*1200 = four hours
+; 1200 = 10000000/8333
+movl #6249, g^exe$gl_ticklength ; that's 8333*75/100
+unlock hwclk
+movl #1, r0
+ret
+.end fallback
+$ exitt 1
+$ endsubroutine
+$
+$do_ipf: subroutine
+$ set noon
+$ ! ticklength is 10000
+$ copyy sys$input fallback.mar
+.title fallback, adjust VMS clock to run 25% slow for four hours
+.library "SYS$LIBRARY:LIB.MLB"
+.entry fallback, ^m<>
+$cmkrnl_s routin=fixit
+movl #1, r0
+ret
+.entry fixit, ^m<>
+lock hwclk
+movl #14400000, g^exe$gl_timeadjust ; 4*60*60*1000 = four hours
+; 1000 = 10000000/10000
+movl #7500, g^exe$gl_ticklength ; that's 10000*75/100
+unlock hwclk
+movl #1, r0
+ret
+.end fallback
+$ exitt 1
+$ endsubroutine
+$
+$do_vax: subroutine
+$ set noon
+$ copyy sys$input fallback.mar
+.title fallback, adjust VMS clock to run 25% slow for four hours
+.library "SYS$LIBRARY:LIB.MLB"
+.link "SYS$SYSTEM:SYS.STB" /selective_search
+.entry fallback, ^m<>
+$cmkrnl_s routin=fixit
+movl #1, r0
+ret
+.entry fixit, ^m<>
+lock hwclk
+movl #1440000, g^exe$gl_timeadjust ; 4*60*60*100 = four hours
+movl #75000, g^exe$gl_ticklength ; that's 100000*75/100
+unlock hwclk
+movl #1, r0
+ret
+.end fallback
+$ exitt 1
+$ endsubroutine
+$ !+==========================================================================
+$ !
+$ ! Procedure: FALLBACK.COM
+$ !
+$ ! Purpose: This procedure will set the VMS clock to run 25% slow for four
+$ ! hours resulting in a one hour gradual retarding of the time.
+$ ! The gradual change has advantages for things like database
+$ ! timestamps and the like.
+$ !
+$ ! PLEASE read the above procedure and understand what it does before
+$ ! using it -- pay particular attention to the special_nodes symbol.
+$ ! That symbol should contain a list of Alpha nodes that have a tick
+$ ! length of 8333 as opposed to the more common 9765.
+$ ! In SDA, use EXAMINE EXE$GL_TICKLENGTH.
+$ !
+$ ! Parameters:
+$ !
+$ ! History:
+$ ! 18-Jan-1999, DBS; Version X1-001
+$ ! 001 - Original version (in this format).
+$ ! 14-Mar-1999, DBS; Version X1-002
+$ ! 002 - Fixup /SYSEXE link option to be alpha only.
+$ ! 02-Aug-1999, DBS; Version X1-003
+$ ! 003 - Now use a list of node names to determine which code to
+$ ! generate - should really use something else, but...
+$ ! 31-Oct-2004, DBS; Version X1-004
+$ ! 004 - Update architecture checking stuff to handle Itanium and
+$ ! added a routine for Itanium.
+$ !-==========================================================================
+
diff --git a/file-identifiers-dcl b/file-identifiers-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_ZmlsZS1pZGVudGlmaWVycy1kY2w=
--- /dev/null
+++ b/file-identifiers-dcl
@@ -0,0 +1,169 @@
+
+
+
+Latest Procedures & News
+
+find_identifiers.com
+Eric Onspaugh, Friday September 07 2007 @ 02:04PM EDT
+$! find_identifiers.com
+$!
+$!------------------------------------------------------------------------------
+$!
+$ idenam = p1 ! identifier name
+$ patnam = p2 ! path lookup name
+$ prcopt = p3 ! search options
+$ kilopt = p4 ! Kill options
+$!
+$ if prcopt .EQS. "" ! if p3 omitted then
+$ then ! default the param
+$ prcopt = "FIND" ! to "FIND"
+$ endif
+$!
+$ if kilopt .EQS. ""
+$ then
+$ kilopt = "NO"
+$ endif
+$!
+$ thipro = f$environment("PROCEDURE") ! what's this comm file
+$ say == "write sys$output" ! the short version
+$!
+$ if idenam .EQS. "" ! if no params then
+$ then ! give them some help
+$ say "p1 - full or partial identifier name to look for in ACE entries"
+$ say ""
+$ say "p2 - path to lookup. ie. Device, directory, file, name, etc."
+$ say ""
+$ say "p3 - STARTS_WITH - Find all ACE's with and identifier that starts with p1"
+$ say " CONTAINS - Find all ACE's with and identifier that contain p1 in the name"
+$ say " EQUAL_TO - Find all ACE's with the exact identifier specified in p1"
+$ say " "
+$ say "p4 - KILL - Deletes all ACE's where the identifier in p1 matches exactly"
+$ say " This parameter only applies if p3 is equal to EQUAL_TO"
+$
+$ exit
+$ endif
+$!
+$ if f$trnlnm("SYS$PIPE") .NES. "" ! this procedure is
+$ then ! piped so lets goto
+$ goto pipeline ! the pipeline
+$ endif ! end of this if
+$!
+$ pipfao="pipe dir/nohead/nosiz/nodat/noprot/acl !AS "+-! set up the pipe
+"| @!AS !AS !AS !AS !AS"! command fao string
+$!
+$ pipcom = f$fao(pipfao, patnam, thipro, idenam, patnam, prcopt, kilopt)
+$ ! build the pipe command
+$ 'pipcom' ! execute it
+$ ! Please note that this
+$ ! command needs to be
+$ ! set up a symbol for
+$ ! some reason.
+$!
+$ exit ! Fini
+$!
+$ PIPELINE: ! attach to the pipe
+$!
+$ read/end_of_file=end_of_pipe sys$pipe inrec ! get a record
+$!
+$! say ''inrec'
+$ if f$edit(f$extract(0, 4, inrec), "COLLAPSE") .NES. ""! if the first few
+$ then ! characters are spaces
+$ filnam=f$element(0, " ", inrec) ! then skip it. if not
+$ dspfil = filnam - f$parse(filnam,,, "DEVICE") ! then it's a file name
+$ endif
+$!
+$ paridn=f$element(1, "=", inrec) ! from the "=" on
+$ paridn=f$element(0, ",", paridn) ! get ident name
+$!
+$ if f$locate(prcopt, "STARTS_WITH") .EQ. 0 ! if the want to FIND
+$ then ! an identifier then
+$ if f$locate(idenam, paridn) .EQ. 0 ! the identifier must
+$ then ! STARTS_WITH with the
+$ say f$fao("Found !AS in file !AS",paridn,dspfil)! string specified
+$ endif ! in the identifier
+$ endif
+$!
+$ if f$locate(prcopt, "CONTAINS") .EQ. 0 ! if the want to FIND
+$ then ! an identifier then
+$ if f$locate(idenam, paridn) .NE. f$length(paridn) ! the identifier must
+$ then ! CONTAIN the string
+$ say f$fao("Found !AS in file !AS",paridn,dspfil)! anywhere embedded
+$ endif ! in the identifier
+$ endif
+$!
+$ if f$locate(prcopt, "EQUAL_TO") .EQ. 0 ! if the want to FIND
+$ then ! an identifier then
+$ if idenam .EQS. paridn ! the identifier must
+$ then ! be EQUAL to the string
+$ say f$fao("Found !AS in file !AS",paridn,dspfil)! and nothing else
+
+$ if f$locate(kilopt, "KILL") .EQ. 0 ! if the want to KILL
+$ then ! an identifier then
+$ set security/acl='f$edit(inrec,"COLLAPSE")' -! build the command to
+'filnam'/delete ! kill the ace
+$ if $status .AND. 1 ! verify that it
+$ then ! completed successfuly
+$ say f$fao("ACE !AS deleted on !AS", -! and if it did then
+f$edit(inrec, "COLLAPSE"), dspfil) ! say so
+$ endif ! and finally we have
+$ endif ! close out all of
+$ endif ! these if statements
+$ endif
+$!
+$ goto pipeline ! be glutonous, get more
+$!
+$ end_of_pipe: ! end of the line
+$!
+$ exit ! C-Ya
+$!
+$!
+$!------------------------------------------------------------------------------
+$!
+$! find_identifiers.com
+$!
+$! SYNOPSIS:
+$!
+$! This procedure does nothing more than find acl in a specified device that
+$! match what is provided on a command line. The match type type is one of
+$! three possible and behaves depending on the parameters passed.
+$!
+$!
+$! Parameters
+$!
+$! p1 - whole or partial identifier name
+$! p2 - device and directory name. wildcards are allowed in the directory
+$! name using rms astandard characters.
+$! p3 - match criteria for p1. a will occur if the parameter in p1 either is
+$! EQUAL_TO, STARTS_WITH or CONTAINS
+$! p4 - Kill option. if this parameter is apecified the procedure will remove
+$! all ACE's on files that meet the criteria of the first 3 parameters.
+$! This parameter only will be effective if p3 is set to EQUAL_TO. This
+$! is to prevent widespread "accidental" deletion of ACE's
+$!
+$! AUTHOR:
+$!
+$! Eric Onspaugh
+$!
+$! CREATION DATE:
+$!
+$! 3 March 2004
+$!
+$!
+$! SYMBOL USAGE:
+$!
+$! dspfil displayed filename minus device name
+$! filnam retrieved file name
+$! idenam identifier name (or part of one) to look for
+$! paridn parsed ACE identifier deom directory listing
+$! patnam device/directory/name/type path to search
+$! prcopt search optionsSearch options
+$! kilopt ace removal option
+$! thipro theactual name and location of this command procedure
+$!
+$! MODIFICATION HISTORY:
+$!
+$! Date | Name | Description
+$! -------------+------+------------------------------------------------------
+$! 3-Mar-2004 | Eric Onspaugh | Orignal Version
+$!
+$! ------------------------------------------
\ No newline at end of file
diff --git a/find-file-dcl b/find-file-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_ZmluZC1maWxlLWRjbA==
--- /dev/null
+++ b/find-file-dcl
@@ -0,0 +1,58 @@
+find_file.com
+Peter Barkas, Thursday May 05 2005 @ 09:19AM EDT
+$! Find specified file on any disk
+$! Requires DFU (freeware)
+$! PHB 05-May-05
+$!
+$ if p1.eqs.""
+$ then
+$ inq p1 "File to find"
+$ endif
+$ if p1.eqs.""
+$ then
+$ goto exit
+$ endif
+$ if p1.eqs."?"
+$ then
+$ goto help
+$ endif
+$ file_spec=p1
+$ tmpfil:=find_file.tmp
+$ dfuout="/out="+tmpfil
+$next_disk:
+$ disk_name=f$device("*","disk")
+$ if disk_name.eqs.""
+$ then
+$ goto no_more_disks
+$ endif
+$ if.not.f$getdvi(disk_name,"mnt")
+$ then
+$ goto next_disk
+$ endif
+$ say disk_name
+$ define dfu$nosmg "Y"
+$ define/user sys$output nl:
+$ dfu search 'disk_name'/file='file_spec''dfuout'
+$ deass dfu$nosmg
+$ dfuout="/app="+tmpfil
+$ goto next_disk
+$no_more_disks:
+$ type/page=save 'tmpfil'
+$exit:
+$ exit
+$help:
+$ type sys$input
+Find file(s) fast
+
+Each mounted disk on the system is searched in turn using DFU
+
+
+If required you can include DFU qualifiers with the file specification
+for example:
+
+
+$ File to find: *.log/mod=sin=tod
+
+
+$ exit
+
diff --git a/findfile-dcl b/findfile-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_ZmluZGZpbGUtZGNs
--- /dev/null
+++ b/findfile-dcl
@@ -0,0 +1,24 @@
+FINDFILE
+Michelle Popejoy, Wednesday August 27 2003 @ 09:42AM EDT
+$!FINDFILE.COM
+$! Find specified file (P1) anywhere on any disk
+$! Author: Michelle Popejoy
+$!
+$ ON CONTROL_Y THEN GOTO EXIT
+$ OPENPRV = F$SETPRV("SYSPRV")
+$ IF P1 .EQS. "" THEN GOTO MISSINGP1
+$ FINDFILE = P1
+$LOOPDISKS:
+$ DISK_NAME = F$DEVICE("*","DISK")
+$ IF DISK_NAME .EQS. "" THEN GOTO EXIT
+$ IF .NOT. F$GETDVI(DISK_NAME,"MNT") THEN GOTO LOOPDISKS
+$LOOPFILES:
+$ FILE = F$SEARCH ("''DISK_NAME'[000000...]''FINDFILE'")
+$ IF FILE .EQS. "" THEN GOTO LOOPDISKS
+$ SHOW SYMBOL FILE
+$ GOTO LOOPFILES
+$MISSINGP1:
+$ WRITE SYS$OUTPUT "FINDFILE.COM-E-MISSINGP1 P1 (File Name to search for) missing"
+$EXIT:
+$ CLOSEPRV = F$SETPRV(OPENPRV)
+$ EXIT
diff --git a/findjob-dcl b/findjob-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_ZmluZGpvYi1kY2w=
--- /dev/null
+++ b/findjob-dcl
@@ -0,0 +1,224 @@
+FINDJOB.COM
+Robert Boyd, Monday April 04 2005 @ 05:42PM EDT
+$ vfl = f$verify(0.or.f$trnlnm("debug$dcl"))
+$!
+$! FINDJOB.COM, VMS V5+ compatible version
+$!
+$! TARGET_INCLUDE = TOOLS_TARGETS.COM
+$!
+$!Abstract:
+$!
+$! Look in specified queue(s) to find a particular job with various
+$! specifiers: may include username and job status types
+$!
+$! Author: Robert L. Boyd
+$! Date: April 1989
+$!
+$!PARAMETERS:
+$! p1 -- job name(s) (may include % and * wildcards, match is case sensitive)
+$! p2 -- queue name (may include wildcards)
+$! p3 -- username (optional, may include wildcards)
+$! p4 -- global symbol to return entry number to (optional)
+$! p5 -- qualifiers -- such as pending_jobs,holding_jobs,timed_release_jobs
+$! ...etc. (Optional)
+$! p6 -- job number(s) to exclude (Optional, may include wildcards)
+$! p7 -- queue type, default = BATCH
+$!
+$! Change History
+$!=========================================================================
+$!
+$! 02-Aug-2000 R.L. Boyd add queue type selection to enable finding
+$! print jobs
+$! 18-Apr-1997 R.L. Boyd changed MATCH_WILD parameters to deal with
+$! " characters in job names.
+$! 11-May-1995 R.L. Boyd Added job number exclusion and wildcard matching
+$! 09-Jan-1995 R.L. Boyd Updated targets for more complete distribution
+$! 13-Apr-1994 R.L. Boyd Added self updating feature for
+$! jbc$_nosuchjob message number
+$!
+$ null = ""
+$ star = "*"
+$ pcnt = "%"
+$ comma = ","
+$ bl = " "
+$ jbc$_nosuchjob = %X00048042
+$ test_msg = f$message(jbc$_nosuchjob)
+$ if f$locate("%JBC-E-NOSUCHJOB, no such job",test_msg).ge.f$length(test_msg)
+$ then ! VMS codes have changed
+$ search sys$share:starlet.req jbc$_nosuchjob-
+/output=sys$Login:jbc_newvalue.tmp/noheading/window=1
+$ open/read tmp jbc_newvalue.tmp
+$ read tmp tmp_rec
+$ 'f$element(1," ",tmp_rec)' = 'f$element(0,";",f$element(3," ",tmp_rec))
+$ close tmp
+$ delete jbc_newvalue.tmp;
+$ write sys$output f$parse(f$environment("PROCEDURE"),,,"NAME"),-
+"-W-NEWVMSVERS, Update JBC$_NOSUCHJOB to %X",-
+f$fao("!XL",jbc$_nosuchjob)," in ",f$environment("procedure")
+$ endif ! VMS codes have changed
+$ match_job = p1
+$ match_queue = p2
+$ if match_queue.eqs.null then $ match_queue = "*"
+$ match_user = f$edit(p3,"trim,upcase,compress")
+$ my_user = f$edit(f$getjpi("","username"),"trim,compress")
+$
+$ return_symbol = p4
+$ job_flags = "all_jobs"
+$ if p5.nes."" then $ job_flags = job_flags+","+p5
+$ exclude_entry = p6
+$ queue_type = p7
+$ if queue_type.eqs.null then $ queue_type = "BATCH"
+$ queue_type = queue_type+",wildcard"
+$! if (match_user.nes."") .and. (my_user.nes.match_user) then -
+$! job_flags = job_flags+",all_jobs"
+$ freeze_flags = "freeze_context,all_jobs"
+$ tmp = f$getqui("CANCEL_OPERATION")
+$! establish queue context
+$QUEUE_LOOP:
+$ nxt_queue = f$getqui("display_queue","queue_name",match_queue,queue_type)
+$ if f$verify() then $ show symbol/local/all
+$ if nxt_queue.nes.null
+$ then
+$ if f$ver() then $ show symbol NXT_QUEUE
+$JOB_LOOP:
+$ job_entry = f$getqui("display_job","entry_number",,job_flags)
+$ if job_entry.eqs.null then $ goto QUEUE_LOOP
+$ job_name = f$getqui("display_job","job_name",,freeze_flags)
+$ if match_job.nes.null
+$ then ! job name check
+$ call MATCH_LIST job_name match_job matched_job 1
+$ if matched_job.eqs.null then $ goto JOB_LOOP
+$ endif ! job name check
+$!
+$ if match_user.nes.null
+$ then ! username check
+$ job_user =f$getqui("display_job","username",,freeze_flags)
+$ if f$ver() then $ show symbol job_user
+$ job_user = f$edit(job_user,"trim,compress")
+$ call MATCH_LIST job_user match_user matched_user
+$ if matched_user.eqs.null then $ goto JOB_LOOP
+$ endif ! user check
+$ if exclude_entry.nes.null
+$ then ! check it out
+$ call MATCH_LIST job_entry exclude_entry excluded
+$ if excluded.nes.null then $ goto JOB_LOOP
+$ endif
+$! we seem to have found a job that qualifies
+$ if return_symbol.nes.null then $ 'return_symbol' == job_entry
+$ status = $status
+$ else
+$ status = jbc$_nosuchjob
+$ endif
+$EXIT:
+$ tmp = f$getqui("cancel_operation")+f$ver(vfl)
+$ exit status
+$!
+$! MATCH_LIST: routine to attempt a match between a list and a specific name.
+$! Author R.L. Boyd
+$!
+$! p1 - name to match
+$! p2 - list of patterns to match against
+$! p3 - symbol to return matched value to
+$! p4 - flag for EXACT match using case sensitivity (Default = NO)
+$!
+$MATCH_LIST: subroutine
+$ vfl = f$verify(0.or.f$trnlnm("debug$subroutines"))
+$ target = 'p1'
+$ expression_list = 'p2'
+$ if p3.nes.null then $ 'p3'==null
+$ trim = "trim"
+$ if .not.p4
+$ then ! match any case
+$ trim = trim+",UPCASE"
+$ target = f$edit(target,trim)
+$ endif
+$ matched = 0
+$ il = 0
+$ if f$verify() then $ show sym/local/all
+$LOOP:
+$ nxt_element = f$edit(f$element(il,comma,expression_list),trim)
+$ if nxt_element.nes.comma
+$ then
+$ il = 1+il
+$ if nxt_element .eqs.null then $ goto LOOP
+$ call MATCH_WILD target nxt_element match_status
+$ if match_status.eqs.null then goto LOOP
+$ matched = 1
+$ endif
+$EXIT:
+$ if matched .and. (p3.nes.null) then $ 'p3'== nxt_element
+$ if f$type(match_status).nes.null then $ delete/symbol/global match_status
+$ vfl = f$verify(vfl)
+$ exit
+$endsubroutine ! MATCH_LIST
+$!
+$! MATCH_WILD: DCL routine to match VMS style wildcards in strings
+$!
+$! Author R.L. Boyd
+$! p1 - string to match
+$! p2 - pattern to match
+$! p3 - symbol to return matched string to
+$!
+$match_wild: subroutine
+$ tvfl = f$verify(0.or.f$trnlnm("debug$subroutines"))
+$match_string='p1'
+$match_pattern='p2'
+$if p3.nes.null then $ 'p3' == null
+$if f$verify() then $ show symbol match*
+$im = 0
+$iv = 0
+$bld_vec:
+$pnxt = f$element(im,star,match_pattern)
+$if pnxt.nes.star
+$then
+$ pvec'iv'=pnxt
+$ im=1+im
+$ iv=1+iv
+$ if f$loc(pcnt,pnxt).lt.f$len(pnxt)
+$ then
+$ iv = iv-1
+$ ism=0
+$bld_vec2:
+$ ppnxt = f$element(ism,pcnt,pnxt)
+$ if ppnxt.nes.pcnt
+$ then
+$ ism = 1+ism
+$ if ppnxt.nes.null
+$ then
+$ pvec'iv'= ppnxt
+$ iv = 1+iv
+$ endif
+$ pvec'iv'= pcnt
+$ iv = 1+iv
+$ goto bld_vec2
+$ endif
+$ endif
+$ goto bld_vec
+$endif
+$match=0
+$iptr=0
+$!if f$verify() then -
+$! show symbol/local/all
+$match_loop:
+$ nxt_match=pvec'iptr'
+$ iptr = 1+iptr
+$ if nxt_match.nes.null
+$ then
+$ if nxt_match.eqs.pcnt
+$ then
+$ match_string = f$extract(1,999,match_string)
+$ else
+$ iloc = f$locate(nxt_match,match_string)
+$ if iloc.ge.f$length(match_string) then $ goto exit
+$ match_string = f$extract(iloc+f$length(nxt_match),999,match_string)
+$ if f$verify() then $ show symbol match_string
+$ endif
+$ endif
+$ if iptr.lt. iv then $ goto match_loop
+$ match = 1
+$EXIT:
+$ tvfl = f$verify(tvfl)
+$ if match then $ 'p3' == "1"
+$ exit
+$endsubroutine ! MATCH_WILD
+$!Last Modified: 14-DEC-2004 18:49:06.16
diff --git a/foreach-dcl b/foreach-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_Zm9yZWFjaC1kY2w=
--- /dev/null
+++ b/foreach-dcl
@@ -0,0 +1,20 @@
+ForEach
+Aaron Sakovich, Friday June 20 2003 @ 10:49AM EDT
+$ VariableName = p1
+$ VariableList = p2
+$ CommandTemplate = p3
+$!
+$! For example:
+$! @foreach Node "nala,mufasa,simba" "rsh 'Node' show time"
+$!
+$ ElementNum = 0
+$ Loop:
+$ Element = f$element(ElementNum,",",VariableList)
+$ if Element .eqs. "," then goto Done
+$ 'VariableName' = Element
+$ write sys$output "For ",Element
+$ 'CommandTemplate'
+$ ElementNum = ElementNum+1
+$ GoTo Loop
+$!
+$ Done:
diff --git a/fortran-preprocessor-dcl b/fortran-preprocessor-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_Zm9ydHJhbi1wcmVwcm9jZXNzb3ItZGNs
--- /dev/null
+++ b/fortran-preprocessor-dcl
@@ -0,0 +1,221 @@
+FORTRAN_PREPROCESSOR.COM
+Henry G. Juengst, Monday December 22 2003 @ 02:47PM EST
+First, you may find the idea behind this procedure interesting even if you do not use Fortran (see last paragraph).
+Below is some DCL code which I use to translate "unix" Fortran code into real Fortran code so that I can compile it on VMS systems. Not that I am a Fortran fan, really not, but I need to get my job done with whatever is available.
+
+I have Fortran code from various sources. A long time ago things were working fine in VMS and unix land. But then the unix folks had too much beef. Every bit of code got unix'fied. And because unix is such a great operating system and all unix derivatives are also suppose to be compatible, things got really messy when people started to fix the Fortran code (!) so that it would work on every unix system. They started to add C preprocessor statement, C include files and horrible macros. What was left wasn't that nice anymore. So everybody started to hate the Fortran code and some smart people explained the rest of the world that C and C++ is the future, the very same people who screwed up the Fortran code. The CERN library is a nice example.
+
+So much about history. Here is a command file called FORTRAN_PREPROCESSOR.COM which grow over time. It translates unix Fortran code back into something useful and eliminates any C/C++ stuff. It does this well for CERN code and other code. For example #include becomes INCLUDE 'WIERD$INCLUDE:FUNNY.INC'. Most CERN code uses macros from a file called pilot.h. This tool processes the macros and rewrites the Fortran code. You may have to add new known directory names to FORTRAN_PREPROCESSOR.COM. Ideally this should be specified in an RMS database, but for now adding more lines to the current solution is working for me.
+
+Please take this command file as a starting point. You may have to adapt it for your needs. The idea is to translate unix Fortran code _once_ back into useful code and then work with the translated code only. Kind of an assimilation process. Whenever I find differences between the file I used at the beginning and a new unix version I simply run both versions through FORTRAN_PREPROCESSOR.COM and apply the differences between the two resulting files to my current version. This worked very well for me and allows me to develop code without the need to deal with unix problems. Most efficient.
+
+To translate all Fortran files in the current directory simply call @FORTRAN_PREPROCESSOR *.FOR You may want to make a backup of the original unix files first for comparison later.
+
+This may be also a useful strategy to adapt other unix code, not just Fortran code. The HP "jackets" for VMS transform VMS into a horrible unix derivative. We know too well what the result is (see OpenVMS.org Bug Reports and numerous comp.os.vms articles). I expect zero support from the unix community for VMS and there is absolutely no reason why the transformation of VMS into a pitiful unix derivative should continue. It is time to stop this development. I would go the other direction by transforming the unix code into useful VMS code. For example I/O statements, in particular unix "open", need to be adapted and fixed for VMS. The same is true for parsing DCL arguments. Why not fix the miserable unix style options by translating them into CLD files and CLI calls? Well, this is probably too difficult for the HP IPS group, but I hope that qualified software developers will pick up the idea.
+
+$!FORTRAN_PREPROCESSOR.COM
+$MY_SOURCE_LINE=""
+$MY_FILE_PREVIOUS=""
+$MY_PILOT_FILE=F$SEARCH("PILOT.H",1)
+$SEARCH_LOOP:
+$MY_FILE_SPEC=F$SEARCH(P1,1)
+$IF MY_FILE_SPEC.EQS."" THEN EXIT
+$MY_FILE=F$PARSE(MY_FILE_SPEC,,,"DEVICE")+F$PARSE(MY_FILE_SPEC,,,"DIRECTORY")+F$PARSE(MY_FILE_SPEC,,,"NAME")+-
+F$PARSE(MY_FILE_SPEC,,,"TYPE")
+$IF MY_FILE.EQS.MY_FILE_PREVIOUS THEN EXIT
+$MY_FILE_PREVIOUS=MY_FILE
+$WRITE SYS$OUTPUT "%%%%% ",MY_FILE
+$
+$TCONV/TRIM/TAB/FILTER 'MY_FILE' 'MY_FILE'
+$
+$MY_FILE_PILOT_FOUND_FLAG=0
+$
+$OPEN/READ MY_SOURCE_FCB 'MY_FILE'
+$OPEN/WRITE MY_TARGET_FCB 'MY_FILE'
+$MY_WRITE_FLAG=1
+$MY_SOURCE_PREVIOUS_BLANK_FLAG=1
+$UPDATE_1_LOOP:
+$READ/END=UPDATE_1_DONE MY_SOURCE_FCB MY_SOURCE_LINE
+$IF MY_SOURCE_LINE.NES.""
+$THEN
+$ MY_SOURCE_INCLUDE_POSITION=F$LOCATE("#INCLUDE",F$EDIT(MY_SOURCE_LINE,"UPCASE"))
+$ IF MY_SOURCE_INCLUDE_POSITION.NE.F$LENGTH(MY_SOURCE_LINE) !???check also for leading characters, only accept #include if blank
+$ THEN
+$ MY_SOURCE_LINE_X=F$EXTRACT(MY_SOURCE_INCLUDE_POSITION+9,F$LENGTH(MY_SOURCE_LINE)-MY_SOURCE_INCLUDE_POSITION-9,MY_SOURCE_LINE)
+$ MY_SOURCE_LINE_X=F$EDIT(MY_SOURCE_LINE_X,"TRIM")
+$ MY_SOURCE_QUOTATION_MARK=F$EXTRACT(0,1,MY_SOURCE_LINE_X)
+$ MY_SOURCE_LINE_X=F$EXTRACT(1,F$LENGTH(MY_SOURCE_LINE_X)-1,MY_SOURCE_LINE_X)
+$ MY_SOURCE_INCLUDE_END=F$LOCATE(MY_SOURCE_QUOTATION_MARK,MY_SOURCE_LINE_X)
+$ MY_SOURCE_INCLUDE_FILE_SPEC=F$EDIT(F$EXTRACT(0,MY_SOURCE_INCLUDE_END,MY_SOURCE_LINE_X),"UPCASE,COLLAPSE")
+$ MY_SOURCE_INCLUDE_SLASH=F$LOCATE("/",MY_SOURCE_INCLUDE_FILE_SPEC)
+$ IF MY_SOURCE_INCLUDE_SLASH.EQ.F$LENGTH(MY_SOURCE_INCLUDE_FILE_SPEC)
+$ THEN
+$ MY_SOURCE_INCLUDE_DIRECTORY=""
+$ MY_SOURCE_INCLUDE_FILE=MY_SOURCE_INCLUDE_FILE_SPEC
+$ ELSE
+$ MY_SOURCE_INCLUDE_DIRECTORY=F$EXTRACT(0,MY_SOURCE_INCLUDE_SLASH,MY_SOURCE_INCLUDE_FILE_SPEC)
+$ MY_SOURCE_INCLUDE_FILE=F$EXTRACT(MY_SOURCE_INCLUDE_SLASH+1,F$LENGTH(MY_SOURCE_INCLUDE_FILE_SPEC)-MY_SOURCE_INCLUDE_SLASH,-
+MY_SOURCE_INCLUDE_FILE_SPEC)
+$ ENDIF
+$
+$ IF MY_SOURCE_INCLUDE_FILE.NES."PILOT.H"
+$ THEN
+$ IF MY_SOURCE_INCLUDE_DIRECTORY.NES.""
+$ THEN
+$ MY_SOURCE_INCLUDE_FILE_FLAG=0
+$ IF .NOT.MY_SOURCE_INCLUDE_FILE_FLAG .AND. MY_SOURCE_INCLUDE_DIRECTORY.EQS."COMIS"
+$ THEN
+$ MY_SOURCE_INCLUDE_FILE="COMIS$INCLUDE:"+MY_SOURCE_INCLUDE_FILE
+$ MY_SOURCE_INCLUDE_FILE_FLAG=1
+$ ENDIF
+$ IF .NOT.MY_SOURCE_INCLUDE_FILE_FLAG .AND. MY_SOURCE_INCLUDE_DIRECTORY.EQS."GEANT321"
+$ THEN
+$ MY_SOURCE_INCLUDE_FILE="GEANT3$INCLUDE:"+MY_SOURCE_INCLUDE_FILE
+$ MY_SOURCE_INCLUDE_FILE_FLAG=1
+$ ENDIF
+$ IF .NOT.MY_SOURCE_INCLUDE_FILE_FLAG .AND. MY_SOURCE_INCLUDE_DIRECTORY.EQS."PAW"
+$ THEN
+$ MY_SOURCE_INCLUDE_FILE="PAW$INCLUDE:"+MY_SOURCE_INCLUDE_FILE
+$ MY_SOURCE_INCLUDE_FILE_FLAG=1
+$ ENDIF
+$ IF .NOT.MY_SOURCE_INCLUDE_FILE_FLAG .AND. MY_SOURCE_INCLUDE_DIRECTORY.EQS."HBOOK"
+$ THEN
+$ MY_SOURCE_INCLUDE_FILE="HBOOK$INCLUDE:"+MY_SOURCE_INCLUDE_FILE
+$ MY_SOURCE_INCLUDE_FILE_FLAG=1
+$ ENDIF
+$ IF .NOT.MY_SOURCE_INCLUDE_FILE_FLAG .AND. MY_SOURCE_INCLUDE_DIRECTORY.EQS."HIGZ"
+$ THEN
+$ MY_SOURCE_INCLUDE_FILE="HIGZ$INCLUDE:"+MY_SOURCE_INCLUDE_FILE
+$ MY_SOURCE_INCLUDE_FILE_FLAG=1
+$ ENDIF
+$ IF .NOT.MY_SOURCE_INCLUDE_FILE_FLAG .AND. MY_SOURCE_INCLUDE_DIRECTORY.EQS."ZEBRA"
+$ THEN
+$ MY_SOURCE_INCLUDE_FILE="ZEBRA$INCLUDE:"+MY_SOURCE_INCLUDE_FILE
+$ MY_SOURCE_INCLUDE_FILE_FLAG=1
+$ ENDIF
+$
+$ IF .NOT.MY_SOURCE_INCLUDE_FILE_FLAG
+$ THEN
+$ MY_SOURCE_INCLUDE_FILE=MY_SOURCE_INCLUDE_DIRECTORY+"$INCLUDE:"+MY_SOURCE_INCLUDE_FILE
+$ ENDIF
+$ ELSE
+$ MY_SOURCE_INCLUDE_FILE_FLAG=0
+$ IF .NOT.MY_SOURCE_INCLUDE_FILE_FLAG .AND. F$SEARCH("GEANT3$INCLUDE:''MY_SOURCE_INCLUDE_FILE'",2).NES.""
+$ THEN
+$ MY_SOURCE_INCLUDE_FILE="GEANT3$INCLUDE:"+MY_SOURCE_INCLUDE_FILE
+$ MY_SOURCE_INCLUDE_FILE_FLAG=1
+$ ENDIF
+$ IF .NOT.MY_SOURCE_INCLUDE_FILE_FLAG .AND. F$SEARCH("CLAS$INCLUDE:''MY_SOURCE_INCLUDE_FILE'",2).NES.""
+$ THEN
+$ MY_SOURCE_INCLUDE_FILE="CLAS$INCLUDE:"+MY_SOURCE_INCLUDE_FILE
+$ MY_SOURCE_INCLUDE_FILE_FLAG=1
+$ ENDIF
+$ IF .NOT.MY_SOURCE_INCLUDE_FILE_FLAG .AND. F$SEARCH("GSIM$INCLUDE:''MY_SOURCE_INCLUDE_FILE'",2).NES.""
+$ THEN
+$ MY_SOURCE_INCLUDE_FILE="GSIM$INCLUDE:"+MY_SOURCE_INCLUDE_FILE
+$ MY_SOURCE_INCLUDE_FILE_FLAG=1
+$ ENDIF
+$ ENDIF
+$ MY_SOURCE_LINE=" INCLUDE '"+MY_SOURCE_INCLUDE_FILE+"'"
+$ ELSE
+$ IF MY_SOURCE_INCLUDE_DIRECTORY.NES.""
+$ THEN
+$ MY_FILE_PILOT_FOUND_FLAG=1
+$ IF F$TRNLNM(MY_SOURCE_INCLUDE_DIRECTORY).EQS."" .AND. F$TRNLNM(MY_SOURCE_INCLUDE_DIRECTORY+"$INCLUDE").NES.""
+$ THEN
+$ IF F$SEARCH(MY_SOURCE_INCLUDE_DIRECTORY+".DIR").EQS.""
+$ THEN
+$ MY_SOURCE_LINE="#include """+MY_SOURCE_INCLUDE_DIRECTORY+"$INCLUDE:"+MY_SOURCE_INCLUDE_FILE+""""
+$ ENDIF
+$ ENDIF
+$ ENDIF
+$ ENDIF
+$ ENDIF
+$ENDIF
+$IF F$EXTRACT(0,1,F$EDIT(MY_SOURCE_LINE,"UPCASE")).EQS."C" .OR. F$EXTRACT(0,1,MY_SOURCE_LINE).EQS."!"
+$THEN
+$ IF F$EDIT(MY_SOURCE_LINE,"UPCASE,COLLAPSE").EQS."C" .OR. F$EDIT(MY_SOURCE_LINE,"COLLAPSE").EQS."!"
+$ THEN
+$ MY_SOURCE_LINE=""
+$ ENDIF
+$ IF F$EDIT(MY_SOURCE_LINE,"UPCASE,COLLAPSE").EQS."C_BEGIN_DOC"
+$ THEN
+$ MY_SOURCE_LINE=""
+$ ENDIF
+$ IF F$EDIT(MY_SOURCE_LINE,"UPCASE,COLLAPSE").EQS."C_END_DOC"
+$ THEN
+$ MY_SOURCE_LINE=""
+$ ENDIF
+$ IF F$EDIT(MY_SOURCE_LINE,"UPCASE,COLLAPSE").EQS."C_END_INC"
+$ THEN
+$ MY_SOURCE_LINE=""
+$ ENDIF
+$ IF F$EDIT(MY_SOURCE_LINE,"UPCASE,COLLAPSE").EQS."C_END_VAR"
+$ THEN
+$ MY_SOURCE_LINE=""
+$ ENDIF
+$ENDIF
+$IF F$LENGTH(MY_SOURCE_LINE).GE.6
+$THEN
+$ IF F$EXTRACT(0,1,MY_SOURCE_LINE).NES."!" .AND. F$EXTRACT(0,1,MY_SOURCE_LINE).NES."#" .AND. -
+F$EXTRACT(0,1,MY_SOURCE_LINE).NES."*" .AND. -
+F$EDIT(F$EXTRACT(0,1,MY_SOURCE_LINE),"UPCASE").NES."C" .AND. F$EDIT(F$EXTRACT(0,1,MY_SOURCE_LINE),"UPCASE").NES."D"
+$ THEN
+$ IF F$EXTRACT(5,1,MY_SOURCE_LINE).NES." "
+$ THEN
+$ MY_SOURCE_LINE=F$EXTRACT(0,5,MY_SOURCE_LINE)+"&"+F$EXTRACT(6,F$LENGTH(MY_SOURCE_LINE)-6,MY_SOURCE_LINE)
+$ ENDIF
+$ ENDIF
+$ENDIF
+$IF MY_WRITE_FLAG
+$THEN
+$ IF MY_SOURCE_LINE.NES."" .OR. .NOT.MY_SOURCE_PREVIOUS_BLANK_FLAG
+$ THEN
+$ WRITE MY_TARGET_FCB MY_SOURCE_LINE
+$ MY_SOURCE_PREVIOUS_BLANK_FLAG=MY_SOURCE_LINE.EQS.""
+$ ENDIF
+$ENDIF
+$GOTO UPDATE_1_LOOP
+$UPDATE_1_DONE:
+$CLOSE MY_TARGET_FCB
+$CLOSE MY_SOURCE_FCB
+$
+$CPP_DEFINE="/DEFINE=(CERNLIB_VAX,CERNLIB_VAXVMS,CERNLIB_QMALPH)"
+$IF MY_PILOT_FILE.EQS."" .OR. MY_FILE_PILOT_FOUND_FLAG
+$THEN
+$ CC/PREPROCESS_ONLY='MY_FILE''CPP_DEFINE'/COMMENTS=AS_IS/NOLINE_DIRECTIVES 'MY_FILE'
+$ELSE
+$ CC/PREPROCESS_ONLY='MY_FILE''CPP_DEFINE'/COMMENTS=AS_IS/NOLINE_DIRECTIVES/FIRST_INCLUDE='MY_PILOT_FILE' 'MY_FILE'
+$ENDIF
+$
+$OPEN/READ MY_SOURCE_FCB 'MY_FILE'
+$OPEN/WRITE MY_TARGET_FCB 'MY_FILE'
+$MY_SOURCE_PREVIOUS_BLANK_FLAG=1
+$UPDATE_2_LOOP:
+$READ/END=UPDATE_2_DONE MY_SOURCE_FCB MY_SOURCE_LINE
+$IF MY_SOURCE_LINE.NES."" .OR. .NOT.MY_SOURCE_PREVIOUS_BLANK_FLAG
+$THEN
+$ IF F$LENGTH(MY_SOURCE_LINE).LE.132
+$ THEN
+$ WRITE MY_TARGET_FCB MY_SOURCE_LINE
+$ ELSE
+$ WRITE MY_TARGET_FCB F$EXTRACT(0,132,MY_SOURCE_LINE)
+$ MY_SOURCE_LINE_REMAINING=F$EXTRACT(132,F$LENGTH(MY_SOURCE_LINE)-132,MY_SOURCE_LINE)
+$ SPLIT_LINE_LOOP:
+$ IF F$LENGTH(MY_SOURCE_LINE_REMAINING).LE.126
+$ THEN
+$ WRITE MY_TARGET_FCB " &",MY_SOURCE_LINE_REMAINING
+$ ELSE
+$ WRITE MY_TARGET_FCB " &",F$EXTRACT(0,126,MY_SOURCE_LINE_REMAINING)
+$ MY_SOURCE_LINE_REMAINING=F$EXTRACT(126,F$LENGTH(MY_SOURCE_LINE_REMAINING)-126,MY_SOURCE_LINE_REMAINING)
+$ GOTO SPLIT_LINE_LOOP
+$ ENDIF
+$ ENDIF
+$ MY_SOURCE_PREVIOUS_BLANK_FLAG=MY_SOURCE_LINE.EQS.""
+$ENDIF
+$GOTO UPDATE_2_LOOP
+$UPDATE_2_DONE:
+$CLOSE MY_TARGET_FCB
+$CLOSE MY_SOURCE_FCB
+$GOTO SEARCH_LOOP
+(I use the prefix MY_ for local identifiers, PARAM_ and VAR_ for input and output function arguments and FOO$ for global identifiers of the project FOO$ - this helps to pinpoint the origin of data.)
\ No newline at end of file
diff --git a/gain-dcl b/gain-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_Z2Fpbi1kY2w=
--- /dev/null
+++ b/gain-dcl
@@ -0,0 +1,55 @@
+GAIN.COM
+Brian Tillman, Wednesday May 07 2003 @ 04:53PM EDT
+$ say = "write sys$output"
+$ verify = 'f$verify(0)'
+$ set noon
+$!
+$ getp1:
+$ if p1 .nes. "" then goto gotp1
+$ read/prompt = "_Directory: " sys$command p1
+$ goto getp1
+$!
+$ gotp1:
+$ if f$locate( "/", p1 ) .eq. f$length( p1 ) then goto getp2
+$ p2 = p1
+$ p1 = ""
+$ goto getp1
+$!
+$ getp2:
+$ if p2 .eqs. "" then goto docommands
+$ if f$locate( "/", p2 ) .ne. f$length( p2 ) then goto docommands
+$ temp = p1
+$ p1 = p2
+$ p2 = temp
+$!
+$ docommands:
+$ p2 := 'p2
+$ log = 0
+$ if f$extract( 0, 2, p2 ) .eqs. "/L" then log = 1
+$ totalsize = 0
+$ totalfiles = 0
+$ previousfile = ""
+$!
+$ nextfile:
+$ fullfile = f$search( "''p1'*.*;*", 1 )
+$ if fullfile .eqs. "" then goto summary
+$ currentfile = f$element( 0, ";", fullfile )
+$ if currentfile .eqs. ";" then goto nextfile
+$ if currentfile .eqs. previousfile then goto gather
+$ previousfile = currentfile
+$ goto nextfile
+$!
+$ gather:
+$ totalfiles = totalfiles + 1
+$ size = f$file_attributes( fullfile, "alq" ) + 1
+$ totalsize = totalsize + size
+$ if .not. log then goto nextfile
+$ say fullfile, " is a previous version."
+$ say f$fao( " Deleting it will save !ZL block!%S.", size )
+$ goto nextfile
+$!
+$ summary:
+$ say ""
+$ phrase = "A total of !ZL file!%S can be deleted, saving !ZL block!%S."
+$ say f$fao( phrase, totalfiles, totalsize )
+$ exit 1 + ( 0 * f$verify( verify ) )
\ No newline at end of file
diff --git a/gblinfo-dcl b/gblinfo-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_Z2JsaW5mby1kY2w=
--- /dev/null
+++ b/gblinfo-dcl
@@ -0,0 +1,114 @@
+GBLINFO.COM
+Manny DeAssis, Tuesday June 12 2007 @ 12:02PM EDT
+$ goto start
+$!
+$! GBLINFO.COM
+$!
+$! This procedure will return global memory information. It uses
+$! a display format similar to the DCL "$ SHOW MEMORY" command.
+$!
+$! Manny DeAssis 20-Dec-1993
+$!
+$! Modification History
+$!
+$! Sep 02 1994 mdeassis Added line to show contiguous global pages.
+$!
+$! Jan 04 2003 mdeassis Modified method used for getting GBLPAGFIL
+$!
+$!
+$!-----------------------------------------------------------------------------
+$!
+$start:
+$ on error then goto emergency_exit
+$!
+$ if f$trnlnm("gblinfo_mmg_gl_gblpagfil") .eqs. "" then gosub get_gblpagfil_data
+$!
+$ mmg_addr = f$trnlnm("gblinfo_mmg_gl_gblpagfil")
+$!
+$ max_gblpagfil = f$getsyi("gblpagfil")
+$ free_gblpagfil = f$cvui(0,32,f$fao("!AD",4,%X'mmg_addr'))
+$ used_gblpagfil = max_gblpagfil - free_gblpagfil
+$!
+$ max_gblpages = f$getsyi("gblpages")
+$ free_gblpages = f$getsyi("free_gblpages")
+$ used_gblpages = max_gblpages - free_gblpages
+$!
+$ contig_gblpages = f$getsyi("contig_gblpages")
+$!
+$ max_gblsections = f$getsyi("gblsections")
+$ free_gblsections = f$getsyi("free_gblsects")
+$ used_gblsections = max_gblsections - free_gblsections
+$!
+$! Format output.
+$!
+$ gblpagfil_data = -
+f$fao("!12SL !12SL !12SL",max_gblpagfil,free_gblpagfil,used_gblpagfil)
+$!
+$ gblpages_data = -
+f$fao("!12SL !12SL !12SL",max_gblpages,free_gblpages,used_gblpages)
+$!
+$ gblsections_data = -
+f$fao("!12SL !12SL !12SL",max_gblsections,free_gblsections,used_gblsections)
+$!
+$! Display output.
+$!
+$!
+$ write sys$output ""
+$ write sys$output -
+" Current Global Memory Status on ''f$getsyi("nodename")' ''f$time()'"
+$ write sys$output ""
+$ write sys$output -
+" Maximum Free Used"
+$ write sys$output "Global Page File Count (GBLPAGFIL)"+gblpagfil_data
+$ write sys$output "Global Pages (GBLPAGES) "+gblpages_data
+$ write sys$output "Global Sections (GBLSECTIONS) "+gblsections_data
+$ write sys$output ""
+$ write sys$output -
+"Of the free global pages, ''contig_gblpages' are contiguous."
+$ write sys$output ""
+$!
+$ goto emergency_exit
+$!
+$get_gblpagfil_data:
+$!
+$ define/user sys$output gblinfo_mmg_gl_gblpagfil.tmp
+$ analyze/system
+show symbol mmg$gl_gblpagfil
+exit
+$ open file gblinfo_mmg_gl_gblpagfil.tmp
+$!
+$read_loop:
+$!
+$ read/end=done file record
+$ if f$extract(0,3,record) .eqs. "MMG"
+$ then
+$ mmg_data = f$element(1,"=",f$edit(record,"collapse"))
+$ mmg_sub = f$element(0,":",f$edit(mmg_data,"collapse"))
+$ if f$extract(0,3,mmg_sub) .eqs. "FFF"
+$ then
+$ mmg_info = f$element(1,".",f$edit(mmg_sub,"collapse"))
+$ else
+$ mmg_info = mmg_sub
+$ endif
+$ else
+$ goto read_loop
+$ endif
+$!
+$ define/system gblinfo_mmg_gl_gblpagfil "''mmg_info'"
+$ return 1
+$!
+$done:
+$ write sys$output "%-I-, could not obtain free global page data"
+$ goto emergency_exit
+$!
+$emergency_exit:
+$ set noon
+$ if f$trnlnm("file") .nes. "" then close file
+$ if f$search("gblinfo_mmg_gl_gblpagfil.tmp") .nes. ""
+$ then
+$ delete gblinfo_mmg_gl_gblpagfil.tmp;*
+$ endif
+$!
+$ exit
+
+
diff --git a/get-arch-dcl b/get-arch-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_Z2V0LWFyY2gtZGNs
--- /dev/null
+++ b/get-arch-dcl
@@ -0,0 +1,33 @@
+Get architecture type
+Antonio Vigliotti, Wednesday September 28 2005 @ 10:24AM EDT
+$!
+$! Get VMS architecture.
+$! Return VMS architecture:
+$! VAX, AXP (alpha), I64 (Itanium)
+$! It works since V5.2 until V8.2
+$! Starting V6.0 is avaiable lex F$GETSYI
+$! ("ARCH_TYPE"); before it searchs for
+$! APB.EXE (alpha) or VMB.EXE (vax).
+$! Returns:
+$! CPU -> VAX/AXP/I64
+$! VERS -> Major version of VMS
+$!
+$GET_ARCH:
+$ VERS=F$INTEGER(F$EXTRACT(1,1,F$GETSYI("VERSION")))
+$ IF VERS.GE.6
+$ THEN
+$ CPU="???"
+$ IF F$GETSYI("ARCH_TYPE").EQ.1 THEN CPU = "VAX"
+$ IF F$GETSYI("ARCH_TYPE").EQ.2 THEN CPU = "AXP"
+$ IF F$GETSYI("ARCH_TYPE").EQ.3 THEN CPU = "I64"
+$ ELSE
+$ IF F$SEARCH("SYS$SYSTEM:APB.EXE").NES."" .AND. F$SEARCH("SYS$SYSTEM:VMB.EXE") .EQS. ""
+$ THEN
+$ CPU = "AXP"
+$ ELSE
+$ CPU = "VAX"
+$ ENDIF
+$ ENDIF
+$ RETURN
+
+
diff --git a/get-netx-datum-dcl b/get-netx-datum-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_Z2V0LW5ldHgtZGF0dW0tZGNs
--- /dev/null
+++ b/get-netx-datum-dcl
@@ -0,0 +1,184 @@
+1Get_next_datum.com
+Jan van den Ende, Friday October 15 2004 @ 07:07AM EDT
+$! file: BEPAAL_VOLGENDE_DATUM.COM
+$
+$! Author: J.P. van den Ende
+$! Bowhouse Data
+$! Savannahweg 17
+$! 3542 AW Utrecht
+$!
+$! Revision History:
+$!----------------------------------------------------------------------
+$! # date by description/reason
+$!
+$! 02 041015 jpe Added English comments
+$! 01 981010 JPE Created
+$
+$!========================================================================
+$!
+$! Bepaal eerstvolgende datum volgens params p1 ... p8.
+$! 'Vandaag' telt NIET mee.
+$! p1 etc moeten verschillend zijn, en oplopend gesorteerd.
+$!
+$! De laatste mee te geven param mag de string LAATSTE zijn.
+$
+$! De laatste meegegeven param mag een Engelstalige weekdag zijn;
+$! in dat geval mag de voorlaatste param "LAATSTE" zijn.
+$! Bij 'weekdagen' mogen de meegegeven parameters niet lager dan 7
+$! zijn, het antwoord wordt namelijk de datum welke op die weekdag valt,
+$! NIET NA het gevraagde dagnummer.
+$!
+$! Antwoord: Global Symbol NEXT_DATUM als "dd-mmm-yyyy:"
+$
+$!!! ----------------- English: -------------------------------------------
+$
+$! Get next date according params p1 ... p8
+$! "Today" EXcluded.
+$! p1 etc MUST be different, ascending
+$!
+$! The last passed param may be the string "LAATSTE" or "LAST"
+$
+$! The last passed param may be an Enlish language weekday name;
+$! in that case the one-but-last may be "LAATSTE" or "LAST".
+$! For 'weekdays' the given params may not be below 7, because the answer
+$! becomes the date of that weekday, NO later than the asked-for day number.
+$!
+$! Output: Global symbol NEXT_DATUM as "dd-mmm-yyyy" (normal VMS date format)
+$
+$!==============================================================================
+$ INIT:
+$ vandaag=f$cvtime("today","comparison","date")
+$
+$ maanden="/JAN/FEB/MAR/APR/MAY/JUN/JUL/AUG/SEP/OCT/NOV/DEC"
+$ mndlen ="/31/28/31/30/31/30/31/31/30/31/30/31"
+$
+$ dag = f$cvtime("","comparison","day")
+$ mnd = f$cvtime("","comparison","month")
+$ jaar= f$cvtime("","comparison","year")
+$
+$ if (jaar/4) * 4 .eq. jaar then mndlen[4,2]:="29"
+$!
+$ dagen ="/SUNDAY/MONDAY/TUESDAY/WEDNESDAY/THURSDAY/FRIDAY/SATURDAY/"
+$
+$ aant = 8
+$aant_loop:
+$ if aant .lt. 1 then goto no_params
+$ if p'aant .eqs. ""
+$ then
+$ aant=aant-1
+$ goto aant_loop
+$ endif
+$
+$ if f$locate(p'aant',dagen) .lt. f$length(dagen)
+$ then
+$ weekdag = p'aant
+$ weekdag = f$edit(weekdag,"lowercase")
+$ weekdag[0,1]:= 'f$edit(weekdag,"upcase")
+$ if aant .eq. 1
+$ then ! uitsluitend P1 , dwz: volgende 'weekday'
+$ dagen=1
+$
+$dagenloop:
+$ next_datum = f$cvtime("today+''dagen'-","absolute","date")
+$ if weekdag .eqs. f$cvtime(next_datum,,"weekday")
+$ then
+$ next_datum == next_datum + ":"
+$ goto exit
+$ else
+$ dagen = dagen + 1
+$ if dagen .le. 7
+$ then
+$ goto dagenloop
+$ else
+$ goto wrong_params
+$ endif
+$ endif
+$ else
+$ aant = aant - 1
+$ endif
+$ else
+$ weekdag = ""
+$ endif
+$
+$!==============================================================================
+$
+$ if (p'aant .eqs. "LAATSTE") .or. (p'aant .eqs. "LAST")
+$ then
+$ p'aant = f$element(mnd,"/",mndlen)
+$ laatste= "t"
+$ else
+$ laatste= "f"
+$ endif
+$
+$ if p'aant .gt. f$element(mnd,"/",mndlen) then goto wrong_param
+$
+$ aant=1
+$dag_loop:
+$ if dag .lt. p'aant
+$ then
+$ nx_dag=p'aant
+$ else
+$ aant=aant+1
+$ if f$type(p'aant') .eqs. "INTEGER"
+$ then
+$ goto dag_loop
+$ endif
+$
+$ gosub next_month
+$ endif
+$
+$ if weekdag .nes. ""
+$ then
+$weekdag_loop:
+$ maand = f$element(mnd,"/",maanden)
+$ if nx_dag .lt. 1 then goto wrong_params
+$ cmpdag=f$cvtime("''nx_dag'-''maand'-''jaar'",,"weekday")
+$ if "''cmpdag'" .nes. "''weekdag'"
+$ then
+$ nx_dag = nx_dag - 1
+$ if f$cvtime("''nx_dag'-''maand'-''jaar'","comparison","date") .les. -
+vandaag
+$ then
+$ gosub next_month
+$ if laatste
+$ then
+$ nx_dag = f$element(mnd,"/",mndlen)
+$ endif
+$ endif
+$ goto weekdag_loop
+$ endif
+$ endif
+$!-----------------------------------------------------------------------
+$maak_datum:
+$ maand = f$element(mnd,"/",maanden)
+$ next_datum == "''nx_dag'-''maand'-''jaar':"
+$
+$exit:
+$ exit
+$
+$!===========================================================================
+$! fouten:
+$no_params:
+$ write sys$output "Minimum of 1 day number obligatory!!!"
+$ exit 4 !fatal
+$wrong_params:
+$ write sys$output "Invalid parameter values!!!"
+$ exit 4
+$
+$!===========================================================================
+$
+$next_month:
+$ nx_dag=p1
+$ mnd=mnd+1
+$ if mnd .eq. 13
+$ then
+$ mnd = 1
+$ jaar = jaar + 1
+$ endif
+$
+$ return
+$
+
+
+
+
diff --git a/getlib-dcl b/getlib-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_Z2V0bGliLWRjbA==
--- /dev/null
+++ b/getlib-dcl
@@ -0,0 +1,23 @@
+GETLIB.COM
+Tim Sneddon, Monday October 26 2009 @ 09:29AM EDT
+$ set noon
+$ on warning then goto bail_out
+$ on control_y then goto bail_out
+$
+$ say = "write sys$output"
+$
+$ p1 = f$edit(p1,"TRIM,UNCOMMENT,COLLAPSE,UNCOMMENT")
+$ if (p1 .eqs. "") then p1 = f$getjpi("","PID")
+$
+$ pipe say "show process/id=''p1'" -
+| analyze/system -
+| search sys$pipe "JIB" -
+| ( read sys$pipe result ; -
+define/job/nolog pipe_result &result; )
+$
+$ jibadr = f$element(5," ",f$edit(f$trnlnm("PIPE_RESULT"),"COMPRESS,TRIM"))
+$
+$ say "The job table for process ''p1' is LNM$JOB_''jibadr'"
+$
+$bail_out:
+$ exitt 1
diff --git a/gotolabel-dcl b/gotolabel-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_Z290b2xhYmVsLWRjbA==
--- /dev/null
+++ b/gotolabel-dcl
@@ -0,0 +1,184 @@
+Get_next_datum.com
+Jan van den Ende, Friday October 15 2004 @ 07:07AM EDT
+$! file: BEPAAL_VOLGENDE_DATUM.COM
+$
+$! Author: J.P. van den Ende
+$! Bowhouse Data
+$! Savannahweg 17
+$! 3542 AW Utrecht
+$!
+$! Revision History:
+$!----------------------------------------------------------------------
+$! # date by description/reason
+$!
+$! 02 041015 jpe Added English comments
+$! 01 981010 JPE Created
+$
+$!========================================================================
+$!
+$! Bepaal eerstvolgende datum volgens params p1 ... p8.
+$! 'Vandaag' telt NIET mee.
+$! p1 etc moeten verschillend zijn, en oplopend gesorteerd.
+$!
+$! De laatste mee te geven param mag de string LAATSTE zijn.
+$
+$! De laatste meegegeven param mag een Engelstalige weekdag zijn;
+$! in dat geval mag de voorlaatste param "LAATSTE" zijn.
+$! Bij 'weekdagen' mogen de meegegeven parameters niet lager dan 7
+$! zijn, het antwoord wordt namelijk de datum welke op die weekdag valt,
+$! NIET NA het gevraagde dagnummer.
+$!
+$! Antwoord: Global Symbol NEXT_DATUM als "dd-mmm-yyyy:"
+$
+$!!! ----------------- English: -------------------------------------------
+$
+$! Get next date according params p1 ... p8
+$! "Today" EXcluded.
+$! p1 etc MUST be different, ascending
+$!
+$! The last passed param may be the string "LAATSTE" or "LAST"
+$
+$! The last passed param may be an Enlish language weekday name;
+$! in that case the one-but-last may be "LAATSTE" or "LAST".
+$! For 'weekdays' the given params may not be below 7, because the answer
+$! becomes the date of that weekday, NO later than the asked-for day number.
+$!
+$! Output: Global symbol NEXT_DATUM as "dd-mmm-yyyy" (normal VMS date format)
+$
+$!==============================================================================
+$ INIT:
+$ vandaag=f$cvtime("today","comparison","date")
+$
+$ maanden="/JAN/FEB/MAR/APR/MAY/JUN/JUL/AUG/SEP/OCT/NOV/DEC"
+$ mndlen ="/31/28/31/30/31/30/31/31/30/31/30/31"
+$
+$ dag = f$cvtime("","comparison","day")
+$ mnd = f$cvtime("","comparison","month")
+$ jaar= f$cvtime("","comparison","year")
+$
+$ if (jaar/4) * 4 .eq. jaar then mndlen[4,2]:="29"
+$!
+$ dagen ="/SUNDAY/MONDAY/TUESDAY/WEDNESDAY/THURSDAY/FRIDAY/SATURDAY/"
+$
+$ aant = 8
+$aant_loop:
+$ if aant .lt. 1 then goto no_params
+$ if p'aant .eqs. ""
+$ then
+$ aant=aant-1
+$ goto aant_loop
+$ endif
+$
+$ if f$locate(p'aant',dagen) .lt. f$length(dagen)
+$ then
+$ weekdag = p'aant
+$ weekdag = f$edit(weekdag,"lowercase")
+$ weekdag[0,1]:= 'f$edit(weekdag,"upcase")
+$ if aant .eq. 1
+$ then ! uitsluitend P1 , dwz: volgende 'weekday'
+$ dagen=1
+$
+$dagenloop:
+$ next_datum = f$cvtime("today+''dagen'-","absolute","date")
+$ if weekdag .eqs. f$cvtime(next_datum,,"weekday")
+$ then
+$ next_datum == next_datum + ":"
+$ goto exit
+$ else
+$ dagen = dagen + 1
+$ if dagen .le. 7
+$ then
+$ goto dagenloop
+$ else
+$ goto wrong_params
+$ endif
+$ endif
+$ else
+$ aant = aant - 1
+$ endif
+$ else
+$ weekdag = ""
+$ endif
+$
+$!==============================================================================
+$
+$ if (p'aant .eqs. "LAATSTE") .or. (p'aant .eqs. "LAST")
+$ then
+$ p'aant = f$element(mnd,"/",mndlen)
+$ laatste= "t"
+$ else
+$ laatste= "f"
+$ endif
+$
+$ if p'aant .gt. f$element(mnd,"/",mndlen) then goto wrong_param
+$
+$ aant=1
+$dag_loop:
+$ if dag .lt. p'aant
+$ then
+$ nx_dag=p'aant
+$ else
+$ aant=aant+1
+$ if f$type(p'aant') .eqs. "INTEGER"
+$ then
+$ goto dag_loop
+$ endif
+$
+$ gosub next_month
+$ endif
+$
+$ if weekdag .nes. ""
+$ then
+$weekdag_loop:
+$ maand = f$element(mnd,"/",maanden)
+$ if nx_dag .lt. 1 then goto wrong_params
+$ cmpdag=f$cvtime("''nx_dag'-''maand'-''jaar'",,"weekday")
+$ if "''cmpdag'" .nes. "''weekdag'"
+$ then
+$ nx_dag = nx_dag - 1
+$ if f$cvtime("''nx_dag'-''maand'-''jaar'","comparison","date") .les. -
+vandaag
+$ then
+$ gosub next_month
+$ if laatste
+$ then
+$ nx_dag = f$element(mnd,"/",mndlen)
+$ endif
+$ endif
+$ goto weekdag_loop
+$ endif
+$ endif
+$!-----------------------------------------------------------------------
+$maak_datum:
+$ maand = f$element(mnd,"/",maanden)
+$ next_datum == "''nx_dag'-''maand'-''jaar':"
+$
+$exit:
+$ exit
+$
+$!===========================================================================
+$! fouten:
+$no_params:
+$ write sys$output "Minimum of 1 day number obligatory!!!"
+$ exit 4 !fatal
+$wrong_params:
+$ write sys$output "Invalid parameter values!!!"
+$ exit 4
+$
+$!===========================================================================
+$
+$next_month:
+$ nx_dag=p1
+$ mnd=mnd+1
+$ if mnd .eq. 13
+$ then
+$ mnd = 1
+$ jaar = jaar + 1
+$ endif
+$
+$ return
+$
+
+
+
+
diff --git a/hard-errors-dcl-dcl b/hard-errors-dcl-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_aGFyZC1lcnJvcnMtZGNsLWRjbA==
--- /dev/null
+++ b/hard-errors-dcl-dcl
@@ -0,0 +1,79 @@
+Hardware Errors.com
+Brad Hamilton, Saturday October 01 2005 @ 06:08AM EDT
+!
+! HARDWARE_ERRORS.COM - BJH - 24-FEB-2004
+!
+! Search error log daily, extract and report hardware errors for the previous
+! 24 hours via e-mail. Summary and detail exception reports only.
+!
+$ on error then goto ERROR
+$ on severe then exit
+$ node=f$getsyi("nodename")
+$ say="write sys$output"
+$!
+$ gosub RESUBMIT
+$ gosub SEARCH
+$ gosub MAIL
+$ gosub CLEANUP
+$ exit $status
+$!
+$! subroutine resubmit
+$!
+$!_______
+$RESUBMIT:
+$!
+$ submit/restart/after="tod+1-08:00"/log=sys$tools:[diag] -
+sys$tools:[diag]hardware_errors.com
+$ return
+$!
+$! subroutine search
+$!
+$!_____
+$SEARCH:
+$!
+$ diag/sin="yes-08:00:00"/excl=(vol,tape,swi) -
+/out=sys$tools:[diag]err_det.txt
+$ if f$search("sys$tools:[diag]err_det.txt") .eqs. -
+"" then exit $status
+$ search sys$tools:[diag]err_det.txt -
+"Sense Key ","Unit ",timestamp,errors/out=sys$tools:[diag]err_sum.txt
+$ return
+$!
+$! subroutine mail
+$!
+$!___
+$MAIL:
+$!
+$ mail/subj="''node' Errors" -
+sys$tools:[diag]err_sum.txt "@sys$tools:[diag]err.dis"
+$ mail/subj="''node' Errors" -
+sys$tools:[diag]err_det.txt "@sys$tools:[diag]err.dis"
+$ rename/log sys$tools:[diag]err_sum.txt err_sum.old !once processed, rename
+$ rename/log sys$tools:[diag]err_det.txt err_det.old !so they don't get
+$ return !remailed tomorrow.
+$!
+$! subroutine cleanup
+$!
+$!______
+$CLEANUP:
+$!
+$ delete/log/bef="tod-14-00:00:00" sys$tools:[diag]err*.old;*,*.log;*
+$ return
+$!
+$!____
+$ERROR:
+$!
+$ say "Error ''$status'"
+$ close sys$tools:[diag]err_det.txt
+$ close sys$tools:[diag]err_sum.txt
+$ exit $status
+$!
+$! Revision History
+$!
+$! Author Date Comments
+$!------------------------------------------------------------------------------
+$! BJH 24-FEB-2004 Original Version.
+$! BJH 02-MAR-2004 Add logic after mailing, so that the same files
+$! don't get re-mailed day after day. Fixed
+$! cleanup.
+$!
diff --git a/hex-dcl b/hex-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_aGV4LWRjbA==
--- /dev/null
+++ b/hex-dcl
@@ -0,0 +1,79 @@
+Show Binary
+Don Sykes, Tuesday June 03 2003 @ 01:34PM EDT
+$ !
+$ ! SHOW_BINARY.COM
+$ ! Displays the HEX & Binary values of P1 (a decimal integer)
+$ !
+$ OFF = 0
+$ BINVAL = ""
+$ if f$type(P1).eqs."INTEGER" then goto CONVERT_TO_HEX
+$ if f$extract(0,1,P1).eqs."X"
+$ then
+$ HEXVALUE = P1 - "X"
+$ DECVALUE = %X'HEXVALUE'
+$ display "Decimal: ''DECVALUE'"
+$ if f$length(HEXVALUE).lt.8 then gosub PAD_HEXVALUE
+$ goto BLOOP
+$ endif
+$ display "Invalid P1 parameter <''P1'> must be a decimal integer."
+$ display "or a Hex integer (preceeded by an ""X"")."
+$ exit
+$ !
+$ CONVERT_TO_HEX:
+$ HEXVALUE = f$fao("!XL", 'P1')
+$ display "Hex: ''HEXVALUE'"
+$ goto BLOOP
+$ !
+$ BLOOP:
+$ HEXDIGIT = f$extract(OFF, 1, HEXVALUE)
+$ gosub EVALUATE_HEXDIGIT
+$ BINVAL = BINVAL + HEXVAL
+$ OFF = OFF + 1
+$ if OFF.eq.8 then goto BINARY_END
+$ BINVAL = BINVAL + "-"
+$ goto BLOOP
+$ !
+$ BINARY_END:
+$ display "Binary: ''BINVAL'"
+$ exit
+$ !
+$ !__________________________________
+$ PAD_HEXVALUE:
+$ if f$length(HEXVALUE).eq.8 then return
+$ HEXVALUE = "0" + HEXVALUE
+$ goto PAD_HEXVALUE
+$ !
+$ !
+$ EVALUATE_HEXDIGIT:
+$ HEXVAL = "0000"
+$ if HEXDIGIT.eqs."0" then return
+$ HEXVAL = "0001"
+$ if HEXDIGIT.eqs."1" then return
+$ HEXVAL = "0010"
+$ if HEXDIGIT.eqs."2" then return
+$ HEXVAL = "0011"
+$ if HEXDIGIT.eqs."3" then return
+$ HEXVAL = "0100"
+$ if HEXDIGIT.eqs."4" then return
+$ HEXVAL = "0101"
+$ if HEXDIGIT.eqs."5" then return
+$ HEXVAL = "0110"
+$ if HEXDIGIT.eqs."6" then return
+$ HEXVAL = "0111"
+$ if HEXDIGIT.eqs."7" then return
+$ HEXVAL = "1000"
+$ if HEXDIGIT.eqs."8" then return
+$ HEXVAL = "1001"
+$ if HEXDIGIT.eqs."9" then return
+$ HEXVAL = "1010"
+$ if HEXDIGIT.eqs."A" then return
+$ HEXVAL = "1011"
+$ if HEXDIGIT.eqs."B" then return
+$ HEXVAL = "1100"
+$ if HEXDIGIT.eqs."C" then return
+$ HEXVAL = "1101"
+$ if HEXDIGIT.eqs."D" then return
+$ HEXVAL = "1110"
+$ if HEXDIGIT.eqs."E" then return
+$ HEXVAL = "1111"
+$ return
\ No newline at end of file
diff --git a/housefiles-dcl b/housefiles-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_aG91c2VmaWxlcy1kY2w=
--- /dev/null
+++ b/housefiles-dcl
@@ -0,0 +1,291 @@
+HOUSE_FILES.COM
+Henk van Dorp, Thursday September 09 2004 @ 02:31AM EDT
+$ set prefix "(!5%T) "
+$ do_all="N"
+$ if "''P1'" .eqs. "ALL" then do_all="Y"
+$ goto BEGIN
+$!******************************************************************************
+$! PROGRAM : HOUSE_FILES.COM
+$! AUTHOR : Henk van Dorp
+$! DATE : 13-JAN-1999
+$! P_VERSION : 1.0
+$!******************************************************************************
+$! Privileges : NETMBX,TMPMBX,SYSPRV,OPER
+$! Priv_end
+$!
+$! Purpose : Cleanup files from your system.
+$! P1 : All files (incl today) ("ALL")
+$!
+$!
+$! There are 2 subroutines:
+$!
+$! 1. cleanup_files
+$! LOCATION: directorie or logicalname
+$! FILE_SPEC: filenames (wildcards allowed)
+$! DAYS: nr of days you keep the file on your system
+$!
+$! This routine moves files with creationdate
+$! "yesterday" (or earlier) from into a subdirectory
+$! . If this subdirectorie does not exist it
+$! will be created. yyyymmdd is the creationdate of the file.
+$! After that, files older than days are deleted.
+$! If subdirectorie <.yyyymmdd> becomes empty it will be deleted.
+$!
+$! 2. delete_files
+$! FILE_SPEC: filespecification (wildcards allowed)
+$! DAYS: nr of days you keep the file on your system
+$!
+$! This routine delete files from your system if older
+$! than days.
+$!
+$! Statitics of files moved and files deleted are written in a
+$! logfile
+$! Purpose_end
+$!******************************************************************************
+$! Revisions
+$! Nr Date By Reason
+$! --- --------- --------------- ----------------------------------------------
+$!******************************************************************************
+$!
+$BEGIN:
+$!
+$! set on ! enable error handling
+$ on error then gosub error_cont
+$!
+$! ******************************************************************************
+$! * Needed and usefull symbols *
+$! ******************************************************************************
+$!
+$ procedure = f$environment("procedure")
+$ file_name = f$parse(procedure,,,"name")
+$ facility = "%" + file_name
+$ date = f$cvtime(,,"date") - "-" - "-"
+$ date_yes = f$cvtime("yesterday",,"date") - "-" - "-"
+$ day_delete = f$cvtime("-14-","absolute","date")
+$!
+$ save$veri = 'f$verify(f$trnlnm("HOUSE$VERIFY"))'
+$ set control=(y)
+$ on control_y then goto END
+$ ws = "write sys$output"
+$ ws "''facility'-I-START, Started at ''f$cvtime()'"
+$!
+$! ******************************************************************************
+$! * Check privileges *
+$! ******************************************************************************
+$!
+$ cur_prv = f$getjpi("","PROCPRIV")
+$ req_prv = "NETMBX,TMPMBX,SYSPRV,OPER"
+$ new_prv = f$setprv("noall,''req_prv'")
+$!
+$ if .not. f$privilege("''req_prv'")
+$ then
+$ goto NO_PRIVILEGES
+$ endif
+$!
+$! ******************************************************************************
+$! * Cleanup the logfiles....... *
+$! * by *
+$! * Renaming the log-files to a subdir of their creation-date (yyyymmdd) *
+$! * and *
+$! * deleting the log-files older than x days *
+$! ******************************************************************************
+$!
+$ files_moved == 0
+$ files_deleted == 0
+$!
+$LAB10:
+$! examples:
+$! call cleanup_files SYS$SPECIFIC:[MQS_SERVER] *.log;* 14
+$! call cleanup_files APPL$DISK:[TMP] *.TMP;* 7
+$! call cleanup_files APPL$DISK:[LOG] DAILY*.LOG;* 90
+$! call cleanup_files APPL$DISK:[LOG] MONTHLY*.LOG;* 180
+$!
+$! call delete_files USER$DISK:[000000...]NETSERVER.LOG;* 7
+$!
+$!
+$! ******************************************************************************
+$! * The end; cleanup and exit *
+$! ******************************************************************************
+$!
+$END:
+$!
+$ stat_file := bhr_data:house_files_stat.dat
+$ if f$search("''stat_file'") .nes. ""
+$ then
+$ open/append stat 'stat_file'
+$ else
+$ open/write stat 'stat_file'
+$ write stat "====================================================================="
+$ write stat "= statistics House_Files ="
+$ write stat "====================================================================="
+$ endif
+$ datum = f$extract(0,11,f$time())
+$ write stat f$fao ("!15AS!10AS!10AS!10AS!10AS", "''datum':"," moved:", "''files_moved'"," deleted:", "''files_deleted'" )
+$ close stat
+$!
+$ set process/privileges=noall
+$ new_prv = f$setprv("''cur_prv'")
+$ ws "''facility'-I-END, Ended at ''f$cvtime()'"
+$ if save$veri then set verify
+$ exit
+$!
+$! ******************************************************************************
+$! * E R R O R M E S S A G E S *
+$! ******************************************************************************
+$NO_PRIVILEGES:
+$ ws "You don't have enough privileges to execute this"
+$ ws "procedure..."
+$ ws "You need the following privileges:"
+$ ws "''req_prv'"
+$!
+$ goto END
+$!
+$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+$ cleanup_files: subroutine
+$!
+$! p1 = directorie waaruit files worden renamed
+$! p2 = files to be renamed
+$! p3 = aantal dagen dat ze bewaard moeten worden
+$!
+$ source_dir := 'p1'
+$ to_be_done := 'p2'
+$ day_delete = f$cvtime("-''p3'-","absolute","date")
+$ set default 'source_dir'
+$ year = f$cvtime(,,"year") ! Bepaal jaar (yyyy)
+$ month = f$cvtime(,,"month") ! Bepaal maand (mm)
+$ day = f$cvtime(,,"day") ! Bepaal dag (dd)
+$ vandaag := 'year''month''day' ! Nieuw tijdformat yyyymmdd
+$!
+$ scan_loop1:
+$ file = f$search("''source_dir'''to_be_done'") ! Zoek file
+$ if file .eqs. "" then goto scan_loop1_end ! Aanwezig?
+$ file_cdt = f$file_attributes("''file'","cdt") ! JA, bepaal creatie_datum_tijd
+$ if $severity .eq. 0 then goto scan_loop1
+$ file_cd = f$extract(0,11,file_cdt) ! Vergeet de tijd
+$ year = f$cvtime(file_cdt,,"year") ! Bepaal jaar (yyyy)
+$ month = f$cvtime(file_cdt,,"month") ! Bepaal maand (mm)
+$ day = f$cvtime(file_cdt,,"day") ! Bepaal dag (dd)
+$ new_file_cd := 'year''month''day' ! Nieuw tijdformat yyyymmdd
+$!
+$ if new_file_cd .eq. vandaag .and. do_all .nes. "Y" ! Als creatie-datum vandaag is
+$ then ! dan
+$ goto SCAN_LOOP1 ! Volgende file
+$ endif
+$
+$ call create_dir_if_not_exist "''new_file_cd'" ! Maak subdir [.yyyymmdd]
+$! ! indien deze niet bestaat
+$!
+$ rename 'file' [.'new_file_cd'] /log/nonew_ve ! Rename gevonden file
+$! ! in subdir [.yyyymmdd]
+$ files_moved == files_moved + 1 ! Hou statistiek bij
+$ goto scan_loop1 ! Ga naar volgende file
+$!
+$ scan_loop1_end: ! Geen files meer
+$ set def sys$login ! Keer terug naar login-directorie
+$!
+$!
+$!------------------------------------------------------------------------------
+$! Delete all files older than p3 days.
+$!------------------------------------------------------------------------------
+$! ! Uitgaande van day_delete
+$ year = f$cvtime(day_delete,,"year") ! Bepaal jaar (yyyy)
+$ month = f$cvtime(day_delete,,"month") ! Bepaal maand (mm)
+$ day = f$cvtime(day_delete,,"day") ! Bepaal dag (dd)
+$ new_day_delete := 'year''month''day' ! Nieuw tijdformat yyyymmdd
+$ set default 'source_dir' ! Ga naar te scannen dir
+$!
+$SCAN_LOOP2:
+$ file = f$search("*.dir") ! Zoek na subdir
+$ if file .eqs. "" then goto scan_loop2_end ! Subdir gevonden?
+$ file_date = f$parse("''file'",,,"name") ! Ja,Extract Filenaam-gedeelte
+$!
+$ if file_date .le. new_day_delete ! Als Filenaam < new_day_delete
+$ then ! dan
+$ call CLEANUP_DIR "''file_date'" "''to_be_done'" ! delete juiste files in
+$ endif ! subdir en delete subdir indien leeg
+$!
+$ goto SCAN_LOOP2 ! Ga naar volgende subdir
+$!
+$SCAN_LOOP2_END: ! Geen subdir gevonden
+$ set def sys$login ! Keer terug naar login-dir
+$!
+$ endsubroutine
+$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+$ create_dir_if_not_exist: subroutine
+$!
+$ if f$search("''p1'.dir") .eqs. ""
+$ then
+$ create/dir/log [.'p1']
+$ set directory [.'p1']/version_lim=0
+$ endif
+$ endsubroutine
+$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+$ cleanup_dir: subroutine
+$!
+$! p1 = subdir where files are to be deleted
+$! p2 = file to delete
+$!
+$ if f$search("''p1'.dir") .nes. ""
+$ then
+$ set def [.'p1']
+$ scan_loop3:
+$ file = f$search("''p2'") ! Zoek 'p2'-file
+$ if file .eqs. "" then goto scan_loop3_end ! Aanwezig?
+$ delete/log 'file' ! delete gevonden file
+$ files_deleted == files_deleted + 1 ! Hou statistiek bij
+$ goto scan_loop3 ! Ga naar volgende file
+$ scan_loop3_end: ! Geen 'p2'-files meer
+$!
+$ if f$search("*.*;*") .eqs. "" ! Check of dir nu leeg is
+$ then
+$ set def [-] ! ga naar parent-dir
+$ set file 'p1'.dir/prot=(S:RWED,O:RWED) ! zet protectie goed
+$ delete/log 'p1'.dir;1 ! ruim dir op
+$ else
+$ set def [-] ! ga naar parent-dir
+$ endif
+$ endif
+$!
+$ endsubroutine
+$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+$ delete_files: subroutine
+$!
+$! p1 = directorie waaruit files worden opgeruimd
+$! p2 = aantal dagen dat ze bewaard moeten worden
+$!
+$ sources := 'p1'
+$ day_delete = f$cvtime("-''p2'-","absolute","date")
+$ year = f$cvtime(day_delete,,"year") ! Bepaal jaar (yyyy)
+$ month = f$cvtime(day_delete,,"month") ! Bepaal maand (mm)
+$ day = f$cvtime(day_delete,,"day") ! Bepaal dag (dd)
+$ new_day_delete := 'year''month''day' ! Nieuw tijdformat yyyymmdd
+$!
+$ del_loop:
+$ fil2del = f$search("''sources'") ! zoek naar file
+$ if fil2del .eqs. "" then goto end_del_loop ! bestaat deze?
+$!
+$ fil_cdt = f$file_attr("''fil2del'","cdt") ! Zo ja, bepaal cdt
+$ year = f$cvtime(fil_cdt,,"year") ! Bepaal jaar (yyyy)
+$ month = f$cvtime(fil_cdt,,"month") ! Bepaal maand (mm)
+$ day = f$cvtime(fil_cdt,,"day") ! Bepaal dag (dd)
+$ fil_cdt := 'year''month''day' ! Nieuw tijdformat yyyymmdd
+$!
+$ if fil_cdt .les. new_day_delete ! als cdt < bewaartermijn
+$ then ! dan
+$ delete/log/noconfirm 'fil2del' ! delete file
+$ files_deleted == files_deleted + 1 ! hou statistiek bij
+$ endif !
+$!
+$ goto del_loop ! Zijn er meer?
+$!
+$ end_del_loop:
+$ endsubroutine
+$!
+$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+$!
+$ error_cont:
+$ on error then gosub error_cont
+$!
+$ return
+$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
diff --git a/jpi-dcl b/jpi-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_anBpLWRjbA==
--- /dev/null
+++ b/jpi-dcl
@@ -0,0 +1,267 @@
+jpi.com
+Awk Emqacs, Monday October 03 2005 @ 02:17PM EDT
+$ SET NOON
+$!
+$ CONTEXT = 0
+$ JPICNT = 0
+$ JPICWS = 0
+$ MATCH = 5
+$ OUT_FLAG = 0
+$ JPI_LEGALFLG = 0
+$ SEARTYP_I = 0
+$ SEARTYP_M = 0
+$ SEARTYP_N = 0
+$ SEARTYP_P = 0
+$ SEARTYP_U = 0
+$!
+$ SEARSTR = "Z"
+$ SEARSTR_I = "Z"
+$ SEARSTR_M = "Z"
+$ SEARSTR_N = "Z"
+$ SEARSTR_P = "Z"
+$ SEARSTR_U = "Z"
+$!
+$ JPI_PID:=="N/A"
+$ JPI_COUNT:=="0"
+$ JPI_USER:=="N/A"
+$ JPI_MODE:=="N/A"
+$ JPI_STATE:=="N/A"
+$ JPI_NAME:=="N/A"
+$ JPI_IMAGE:=="N/A"
+$ JPI_PRIORITY:=="N/A"
+$ JPI_CPU:=="N/A"
+$ JPI_WORKINGSET:=="N/A"
+$!
+$ P1 = F$EDIT(P1,"COLLAPSE")
+$ IF P1 .EQS. ""
+$ THEN
+$ SEARTYP_U=1
+$ SEARSTR_U=F$GETJPI("","USERNAME")
+$ GOTO JPI_P2
+$ ENDIF
+$!
+$ TMP = F$EXTRACT(0,1,P1)
+$ TMP2 = F$ELEMENT(1,",",P1)
+$ IF TMP .NES. "(" .AND. TMP2 .EQS. "," THEN GOTO JPI_P1
+$ IF TMP .EQS. "(" .OR. TMP2 .NES. "," THEN GOTO JPI_MP1
+$ JPI_P1:
+$ SEARSTR=F$ELEMENT(1,"=",P1)
+$ SEARTYP=F$ELEMENT(0,"=",P1)
+$ GOSUB JPI_SETFLG
+$ GOTO JPI_P2
+$ JPI_MP1:
+$ INUM=0
+$ MP1=P1-"("-")"
+$ JPI_MP1_LOOP:
+$ TEMPSTR1=F$ELEMENT(INUM,",",MP1)
+$ IF TEMPSTR1 .EQS. "," THEN GOTO JPI_P2
+$ SEARSTR=F$ELEMENT(1,"=",TEMPSTR1)
+$ SEARTYP=F$ELEMENT(0,"=",TEMPSTR1)
+$ GOSUB JPI_SETFLG
+$ INUM=INUM+1
+$ GOTO JPI_MP1_LOOP
+$!
+$ JPI_P2:
+$ IF P2 .NES. ""
+$ THEN
+$ OUTSTR=F$EXTRACT(0,1,P2)
+$ IF OUTSTR .EQS. "O"
+$ THEN
+$ OUT_FLAG=1
+$ OPEN/WRITE FILNM SYS$LOGIN:JPI.TMP
+$ ENDIF
+$ ENDIF
+$!
+$ FS=F$FAO("!8AS !12AS !3AS !4AS !15AS !15AS !2AS !6AS !7AS","PID","USERNAME","MOD","STAT","PROCNAME","IMAGENAME","BP","CPU(S)","WS"
+)
+$ IF OUT_FLAG .EQ. 1
+$ THEN
+$ WRITE FILNM "''FS'"
+$ ELSE
+$ WRITE SYS$OUTPUT "''FS'"
+$ ENDIF
+$!
+$ MAIN_LOOP:
+$ A=F$PID(CONTEXT)
+$ IF A .EQS. "" THEN GOTO JPI_EXIT
+$ MATCH = 5
+$ IF SEARTYP_I
+$ THEN
+$ IMAGNM=F$GETJPI(A,"IMAGNAME")
+$ IF IMAGNM .EQS. "" THEN IMAGNM = "(DCL)"
+$ LEN=F$LENGTH(IMAGNM)
+$ POS=F$LOCATE(SEARSTR_I,F$EDIT(IMAGNM,"UPCASE"))
+$ IF POS .EQ. LEN THEN MATCH=MATCH-1
+$ ENDIF
+$!
+$ IF SEARTYP_M
+$ THEN
+$ MODENM=F$GETJPI(A,"MODE")
+$ LEN=F$LENGTH(MODENM)
+$ POS=F$LOCATE(SEARSTR_M,MODENM)
+$ IF POS .EQ. LEN THEN MATCH=MATCH-1
+$ ENDIF
+$!
+$ IF SEARTYP_N
+$ THEN
+$ PRCNM=F$GETJPI(A,"PRCNAM")
+$ LEN=F$LENGTH(PRCNM)
+$ POS=F$LOCATE(SEARSTR_N,F$EDIT(PRCNM,"UPCASE"))
+$ IF POS .EQ. LEN THEN MATCH=MATCH-1
+$ ENDIF
+$!
+$ IF SEARTYP_P
+$ THEN
+$ LEN=F$LENGTH(A)
+$ POS=F$LOCATE(SEARSTR_P,A)
+$ IF POS .EQ. LEN THEN MATCH=MATCH-1
+$ ENDIF
+$!
+$ IF SEARTYP_U
+$ THEN
+$ USERNM=F$GETJPI(A,"USERNAME")
+$ LEN=F$LENGTH(USERNM)
+$ POS=F$LOCATE(SEARSTR_U,F$EDIT(USERNM,"UPCASE"))
+$ IF POS .EQ. LEN THEN MATCH=MATCH-1
+$ ENDIF
+$ IF MATCH .EQ. 5 THEN GOSUB JPI_SHOW
+$ GOTO MAIN_LOOP
+$!
+$ JPI_HELP:
+$! 1 1 2 3 4 5 6 7 8
+$ WRITE SYS$OUTPUT "%JPI-I-BRHELP, JPI brief help."
+$ WRITE SYS$OUTPUT "Sym p1 p2 Description (p1 can be a item list separated by comma)"
+$ WRITE SYS$OUTPUT "--- -------- ---- ------------------------------------------------------------"
+$ WRITE SYS$OUTPUT "JPI Shows your jobs only. Same as JPI U=MYUSERNAME"
+$ WRITE SYS$OUTPUT "JPI IMAG=str Show all jobs with string in the imagename. Note: Imagename"
+$ WRITE SYS$OUTPUT " is a file specification with all devices translated to their"
+$ WRITE SYS$OUTPUT " physical names. This is a moderately cpu expensive command."
+$ WRITE SYS$OUTPUT "JPI MODE=str Show all jobs with string in the modetype. Mode can be BATCH,"
+$ WRITE SYS$OUTPUT " INTERACTIVE, NETWORK, or OTHER. So make string unique. This"
+$ WRITE SYS$OUTPUT " is an efficient command. Use as needed."
+$ WRITE SYS$OUTPUT "JPI NAME=str Show all jobs with string in the process name. This is an "
+$ WRITE SYS$OUTPUT " efficient command. Use as needed."
+$ WRITE SYS$OUTPUT "JPI PID=str Show all jobs with string in the PID. Use as needed."
+$ WRITE SYS$OUTPUT "JPI USER=str Show all jobs with string in the username. This is an "
+$ WRITE SYS$OUTPUT " efficient command. Use as needed."
+$ WRITE SYS$OUTPUT "JPI USER=str OUT Show jobs... output in SYS$LOGIN:JPI.TMP. This forced file"
+$ WRITE SYS$OUTPUT " specification will prevent lost output files."
+$ WRITE SYS$OUTPUT "JPI USER= Show all jobs. Caution: This is an expensive command. Use"
+$ WRITE SYS$OUTPUT " only when necessary."
+$ WRITE SYS$OUTPUT "REMEMBER: JOBS IN RESOURCE WAIT STATE DO NOT SHOW UP! USE SHOW SYSTEM COMMAND"
+$ WRITE SYS$OUTPUT " IF YOU THINK YOUR JOB IS STUCK IN A RESOURCE WAIT STATE."
+$ WRITE SYS$OUTPUT "GOOD EXAMPLE: $JPI USER=eric,MODE=int,NAME=server (logical AND)"
+$ EXIT
+$!
+$ JPI_EXIT:
+$ JPITMSTR=F$STRING(JPICNT)
+$ JPICWSTR=F$STRING(JPICWS)
+$ IF JPICNT .GT. 1
+$ THEN
+$ JPI_PID:=="N/A"
+$ JPI_COUNT:=="''JPITMSTR'"
+$ JPI_USER:=="N/A"
+$ JPI_MODE:=="N/A"
+$ JPI_STATE:=="N/A"
+$ JPI_NAME:=="N/A"
+$ JPI_IMAGE:=="N/A"
+$ JPI_PRIORITY:=="N/A"
+$ JPI_CPU:=="N/A"
+$ JPI_WORKINGSET:=="N/A"
+$ ENDIF
+$ IF OUT_FLAG .EQ. 1
+$ THEN
+$ WRITE FILNM "%JPI-I-ITMFND, ''JPITMSTR' items found."
+$ WRITE FILNM "%JPI-I-TOTCWS, Total WS is ''JPICWSTR'."
+$ CLOSE/NOLOG FILNM
+$ ELSE
+$ WRITE SYS$OUTPUT "%JPI-I-ITMFND, ''JPITMSTR' items found."
+$ WRITE SYS$OUTPUT "%JPI-I-TOTCWS, Total WS is ''JPICWSTR'."
+$ ENDIF
+$ EXIT
+$!
+$ JPI_SHOW:
+$ JPICNT=JPICNT+1
+$ WSSNUM=F$GETJPI(A,"WSSIZE")
+$ JPICWS=JPICWS+WSSNUM
+$ WSSSTR=F$STRING(WSSNUM)
+$ USERNM=F$GETJPI(A,"USERNAME")
+$ STATENM=F$GETJPI(A,"STATE")
+$ PRCNM=F$GETJPI(A,"PRCNAM")
+$ MODENM=F$GETJPI(A,"MODE")
+$ IMAGNM=F$GETJPI(A,"IMAGNAME")
+$ BPRIO=F$GETJPI(A,"PRIB")
+$ CPUTM=F$GETJPI(A,"CPUTIM")
+$ CPUTM=CPUTM/100
+$ CPUTMSTR=F$STRING(CPUTM)
+$ BPRIOSTR=F$STRING(BPRIO)
+$ IMAGNM=F$PARSE("''IMAGNM'",,,"NAME","SYNTAX_ONLY")
+$ IF IMAGNM .EQS. "" THEN IMAGNM = "(DCL)"
+$ JS=F$FAO("!8AS !12AS !3AS !4AS !15AS !15AS !2AS !6AS !7AS",A,USERNM,MODENM,STATENM,PRCNM,IMAGNM,BPRIOSTR,CPUTMSTR,WSSSTR)
+$ IF OUT_FLAG .EQ. 1
+$ THEN
+$ WRITE FILNM "''JS'"
+$ ELSE
+$ WRITE SYS$OUTPUT "''JS'"
+$ ENDIF
+$ IF JPICNT .EQ. 1
+$ THEN
+$ JPI_PID:=="''A'"
+$ JPI_COUNT:=="''F$STRING(JPICNT)'"
+$ JPI_USER:=="''USERNM'"
+$ JPI_MODE:=="''MODENM'"
+$ JPI_STATE:=="''STATENM'"
+$ JPI_NAME:=="''PRCNM'"
+$ JPI_IMAGE:=="''IMAGNM'"
+$ JPI_PRIORITY:=="''BPRIOSTR'"
+$ JPI_CPU:=="''CPUTMSTR'"
+$ JPI_WORKINGSET:=="''WSSSTR'"
+$ ENDIF
+$ RETURN
+$ JPI_SETFLG:
+$ JPI_LEGALFLG=0
+$ SEARTYP=F$EXTRACT(0,1,SEARTYP)
+$ IF SEARTYP .EQS. "I"
+$ THEN
+$ SEARTYP_I=1
+$ SEARSTR_I=SEARSTR
+$ JPI_LEGALFLG=1
+$ ENDIF
+$ IF SEARTYP .EQS. "M"
+$ THEN
+$ SEARTYP_M=1
+$ SEARSTR_M=SEARSTR
+$ JPI_LEGALFLG=1
+$ ENDIF
+$ IF SEARTYP .EQS. "N"
+$ THEN
+$ SEARTYP_N=1
+$ SEARSTR_N=SEARSTR
+$ JPI_LEGALFLG=1
+$ ENDIF
+$ IF SEARTYP .EQS. "P"
+$ THEN
+$ SEARTYP_P=1
+$ SEARSTR_P=SEARSTR
+$ JPI_LEGALFLG=1
+$ ENDIF
+$ IF SEARTYP .EQS. "N"
+$ THEN
+$ SEARTYP_N=1
+$ SEARSTR_N=SEARSTR
+$ JPI_LEGALFLG=1
+$ ENDIF
+$ IF SEARTYP .EQS. "P"
+$ THEN
+$ SEARTYP_P=1
+$ SEARSTR_P=SEARSTR
+$ JPI_LEGALFLG=1
+$ ENDIF
+$ IF SEARTYP .EQS. "U"
+$ THEN
+$ SEARTYP_U=1
+$ SEARSTR_U=SEARSTR
+$ JPI_LEGALFLG=1
+$ ENDIF
+$ IF JPI_LEGALFLG .NE. 1 THEN GOTO JPI_HELP
+$ RETURN
\ No newline at end of file
diff --git a/lockinfo-dcl b/lockinfo-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_bG9ja2luZm8tZGNs
--- /dev/null
+++ b/lockinfo-dcl
@@ -0,0 +1,138 @@
+LOCKINFO.COM
+Manny DeAssis, Tuesday June 12 2007 @ 11:55AM EDT
+$ goto start
+$!
+$! LOCKINFO.COM
+$!
+$! This procedure will return lock information. It uses a display
+$! format similar to the DCL "$ SHOW MEMORY" command.
+$!
+$! /mdeassis/1-jan-1995/
+$!
+$!
+$! Modification History
+$!
+$! Feb 27 2003 mdeassis Modified method used for getting current
+$! count for LOCKIDTBL & RESHASHTBL.
+$!
+$!
+$!-----------------------------------------------------------------------------
+$!
+$ start: on error then goto emergency_exit
+$ !
+$ current_version = f$extract(0,4,f$getsyi("version"))
+$ if current_version .lts. "V6.2" then goto bad_version
+$ !
+$ lckidtbl = f$getsyi("lockidtbl") ! Initial Size
+$ lckidtbl_max = f$getsyi("lockidtbl_max") ! Maximum
+$ reshashtbl = f$getsyi("reshashtbl") ! Initial
+$!
+$ if f$trnlnm("lockinfo_lck_gl_lckcnt") .eqs. ""
+$ then
+$ gosub get_lockdata
+$ endif
+$!
+$ cur_lck = f$trn("lockinfo_lck_gl_lckcnt")
+$ cur_res = f$trn("lockinfo_lck_gl_rsbcnt")
+$!
+$ lckidtbl_cur = f$cvui(0,32,f$fao("!AD",4,%X'cur_lck')) ! Cur Locks
+$ reshashtbl_cur = f$cvui(0,32,f$fao("!AD",4,%X'cur_res')) ! Cur Resources
+$ !
+$ init_lock = lckidtbl
+$ used_lock = lckidtbl_cur
+$ free_lock = init_lock - used_lock
+$ short_lock = 0
+$ init_res = reshashtbl
+$ used_res = reshashtbl_cur
+$ free_res = init_res - used_res
+$ short_res = 0
+$ !
+$ if free_lock .lt. 0
+$ then
+$ free_lock = 0
+$ short_lock = used_lock - init_lock
+$ endif
+$ !
+$ if free_res .lt. 0
+$ then
+$ free_res = 0
+$ short_res = used_res - init_res
+$ endif
+$ !
+$ lock_data = -
+f$fao("!12SL !9SL !9SL !11SL",init_lock,free_lock,used_lock,short_lock)
+$ res_data = -
+f$fao("!12SL !9SL !9SL !11SL",init_res,free_res,used_res,short_res)
+$ !
+$ write sys$output ""
+$ write sys$output -
+" Current Lock Status on ''f$getsyi("nodename")' ''f$time()'"
+$ write sys$output ""
+$ write sys$output -
+" Initial Free Used Shortage"
+$ write sys$output ""
+$ write sys$output " Locks "+lock_data
+$ write sys$output " Resources "+res_data
+$ !
+$ goto clean_exit
+$ !
+$ emergency_exit: set noon
+$ write sys$output ""
+$ write sys$output "%procedure terminated due to error"
+$ write sys$output ""
+$ exit 1
+$ !
+$ bad_version: set noon
+$ write sys$output ""
+$ write sys$output "%sorry, must at least be VMS Version V6.2"
+$ write sys$output ""
+$ exit 1
+$ !
+$ get_lockdata: set noon
+$ define/user sys$output lockinfo_lck_gl_lckcnt.tmp
+$ analyze/system
+show symbol lck$gl_lckcnt
+show symbol lck$gl_rsbcnt
+exit
+$ !
+$ n = 0
+$ list = "lck rsb"
+$ open file lockinfo_lck_gl_lckcnt.tmp
+$ !
+$ read_loop:
+$ item = f$el(n," ",list)
+$ if item .eqs. " " then return 1
+$ read/end=thats_it file record
+$ if f$ext(0,3,record) .eqs. "LCK"
+$ then
+$ 'item'_data = f$el(1,"=",f$edit(record,"collapse"))
+$ 'item'_sub = f$el(0,":",f$edit('item'_data,"collapse"))
+$ !
+$ if f$ext(0,3,'item'_sub) .eqs. "FFF"
+$ then
+$ 'item'_info = f$el(1,".",f$ed('item'_sub,"collapse"))
+$ else
+$ 'item'_info = 'item'_sub
+$ endif
+$ !
+$ lockdata = 'item'_info
+$ define/system lockinfo_lck_gl_'item'cnt "''lockdata'"
+$ n = n + 1
+$ !
+$ endif
+$ !
+$ goto read_loop
+$ !
+$ thats_it: set noon
+$ write sys$output ""
+$ write sys$output "%could not obtain current lock / rsb data"
+$ write sys$output ""
+$ !
+$ clean_exit:
+$ set noon
+$ if f$trn("file") .nes. "" then close file
+$ if f$sea("lockinfo_lck_gl_lckcnt.tmp") .nes. ""
+$ then
+$ delete lockinfo_lck_gl_lckcnt.tmp;*
+$ endif
+$ exit 1
diff --git a/makeup-dcl b/makeup-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_bWFrZXVwLWRjbA==
--- /dev/null
+++ b/makeup-dcl
@@ -0,0 +1,50 @@
+MAKEUP.COM
+Willem Grooters, Friday June 18 2004 @ 03:42AM EDT
+$ ver = f$verify(0)
+$ set noon
+$! MAKEUP.COM
+$! Sets all filesnames found to UPPERCASE
+$!
+$! P1 = filespec, may include wildcards
+$! if missing, defaults to *.*;* in
+$! current directory
+$! Will not rename directories
+$! requires DELETE access on files (due to 'rename')
+$! (THIS IS NOT CHECKED BEFORE
+$!---------------------------------------------
+$!
+$ searchspec = P1
+$ if searchspec .eqs. "" then searchspec = "*.*;*"
+$!
+$! Loop through all files until done
+$!
+$loop:
+$ foundfile=f$search(searchspec,1)
+$ if foundfile .eqs. "" then goto end_loop
+$!
+$! NO case change if directory
+$!
+$ if f$file_attributes(foundfile,"DIRECTORY") then goto loop
+$!
+$ filedev =f$parse(foundfile,,,"DEVICE")
+$ filepath=f$parse(foundfile,,,"DIRECTORY")
+$ filename=f$parse(foundfile,,,"NAME")
+$ filetype=f$parse(foundfile,,,"TYPE")
+$ filevers=f$parse(foundfile,,,"VERSION")
+$!
+$! Now uppercase name and type
+$!
+$ upname = f$edit(filename,"UPCASE")
+$ uptype = f$edit(filetype,"UPCASE")
+$!
+$! rename the original names to UPPER
+$!
+$ write sys$output "'' foundfile' ==> ''filedev'''filepath'''upname'''uptype'''f
+ilevers"
+$ rename 'foundfile' 'filedev''filepath''upname''uptype''filevers'
+$!
+$ goto loop
+$!
+$end_loop:
+$ ver = f$verify('ver')
+$ exit
diff --git a/memcheck-dcl b/memcheck-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_bWVtY2hlY2stZGNs
--- /dev/null
+++ b/memcheck-dcl
@@ -0,0 +1,22 @@
+MemCheck
+Aaron, Tuesday September 07 2004 @ 11:19PM EDT
+$ Define MailRecipient "aaron" ! Can be VMS or Internet address
+$ DelayTime = "+00:10:00" ! Default time between jobs
+$ DeferDelay = "+01:00:00" ! Don't send too many alerts!
+$ QueueName = "Sys$Batch" ! Where to run
+$ NodeName = f$getsyi("NodeName") ! Node running on
+$ MinFree = 30 ! % free before alert
+$!
+$ TotalMemory = f$getsyi("Total_Pages")
+$ FreeMemory = f$getsyi("Free_Pages")
+$ PcntFree = FreeMemory * 100 / TotalMemory
+$ If PcntFree .lt. MinFree
+$ then
+$ Mail nl: MailRecipient /NoSignature -
+/Subject="ALERT: ''PcntFree'% memory free on node ''NodeName'"
+$ DelayTime = DeferDelay
+$ endif
+$ Submit 'f$environment("Procedure")' /Queue='QueueName' -
+/After="''DelayTime'" /NoPrint
+
+
diff --git a/message-dcl b/message-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_bWVzc2FnZS1kY2w=
--- /dev/null
+++ b/message-dcl
@@ -0,0 +1,155 @@
+MESSAGE.COM
+Neil Sakac, Friday February 18 2005 @ 10:13AM EST
+$ saveverify = f$environment("VERIFY_PROCEDURE") !Get current value of Verify.
+$ IF saveverify THEN SET NOVERIFY !If Verify ON then turn OFF.
+$ ON Control_Y THEN GOTO ABORT_Control_Y !Set Exit if Control_Y Pressed.
+$ ON Error THEN GOTO ABORT_Error !Set Exit if Error Occurs.
+$ GOTO MAIN !Goto Label MAIN, Miss Header.
+$!
+$!****************************************************************************
+$!* MESSAGE.COM *
+$!* *
+$!* Command procedure to extract message text from all the message files *
+$!* in the SYS$MESSAGE directories. *
+$!* *
+$!* Version 1.0-0 *
+$!* Created: 6th November 1981. *
+$!* Last Revised: 6th November 1991. *
+$!* *
+$!* © Written by Neil Sakac *
+$!* *
+$!****************************************************************************
+$!
+$ MAIN:
+$ GOSUB Initialize
+$ IF p2 .NES. NULL THEN SET VERIFY
+$ IF p1 .EQS. NULL
+$ THEN IN msg_code "Enter Message Code: "
+$ ELSE msg_code = p1
+$ ENDIF
+$ IF f$edit(f$extract(0,2,msg_code),"UPCASE") .NES. "%X"
+$ THEN msg_code = "%X"+msg_code
+$ ENDIF
+$ GOSUB Check_MSG_Code
+$! IF found_FLAG .EQS. TRUE THEN GOTO EXIT
+$ GOSUB Create_MSG_File
+$ IF found_FLAG .EQS. FALSE
+$ THEN WS fac+"-I-NOMSG, No Messages found on System."
+$ ENDIF
+$ GOTO EXIT
+$!
+$! ROUTINE to Initialize all variables needed for Procedure
+$!
+$ Initialize:
+$
+$ WS = "WRITE SYS$OUTPUT"
+$ IN = "INQUIRE/NOPUNCTUATION"
+$ NULL = ""
+$ fac = "%MESSAGE" !Facility Name.
+$ QUAL = NULL !Setup for Qualifier string.
+$ SPACE = " "
+$ FALSE = 0
+$ TRUE = 1
+$ verify_FLAG = FALSE !Flag for Verify ON/OFF
+$ opened_FLAG = FALSE !Flag for File Opened ON/OFF
+$ found_FLAG = FALSE !Flag for Message Found ON/OFF
+$ msg_line = "SYS$MESSAGE"
+$ msg_dir = "DIRECTORY/COLUMN=1/NOSIZE/NOPROTECTION/NODATE/NOTOTAL"
+$ old_msg_txt = NULL
+$
+$ RETURN
+$!
+$! ROUTINE to CHECK the Message Code from the File.
+$!
+$ Check_MSG_Code:
+$
+$ msg_txt = f$message(msg_code)
+$ msg_search = f$locate("Message number",msg_txt)
+$ IF msg_txt .NES. old_msg_txt
+$ THEN IF msg_search .EQ. f$length(msg_txt)
+$ THEN WS "("+msg_txt+") in File: "+msg_line
+$ found_FLAG = TRUE
+$ ENDIF
+$ ENDIF
+$ old_msg_txt = msg_txt
+$
+$ RETURN
+$!
+$! ROUTINE to CHECK the Message Code from the File.
+$!
+$ Create_MSG_File:
+$
+$ 'msg_dir' SYS$MESSAGE:*.EXE/OUTPUT=MSG.DAT
+$ PURGE/NOLOG MSG.DAT
+$ OPEN/READ MSG_FILE MSG.DAT
+$ opened_FLAG = TRUE
+$ Read_MSG_File:
+$ READ/END_OF_FILE=END_Read_MSG_File MSG_FILE msg_line
+$ GOSUB Process_MSG_File
+$ GOTO Read_MSG_File
+$ END_Read_MSG_File:
+$ CLOSE MSG_FILE
+$ opened_FLAG = FALSE
+$
+$ RETURN
+$!
+
+$! ROUTINE to CHECK the Message Code from the File.
+$!
+$ Process_MSG_File:
+$
+$ IF msg_line .EQS. NULL THEN GOTO END_Process
+$ IF f$locate("Total",msg_line) .EQS. 0 THEN GOTO END_Process
+$ IF f$locate("Directory",msg_line) .EQS. 0 THEN GOTO END_Process
+$ SET NOON
+$ SET MESSAGE/NOFACILITY/NOIDENTIFICATION/NOTEXT/NOSEVERIFY
+$ SET MESSAGE SYS$MESSAGE:'msg_line'
+$ SET MESSAGE/FACILITY/IDENTIFICATION/TEXT/SEVERIFY
+$ SET ON
+$ GOSUB Check_MSG_Code
+$ END_Process:
+$
+$ RETURN
+$!
+$! ROUTINE to ABORT when ERROR encountered and show error message.
+$!
+$ ABORT_Error:
+$ sts = f$message($STATUS)
+$ error_msg = f$extract(f$locate("-",sts),f$length(sts),sts)
+$ WS fac + error_msg
+$ WS NULL
+$ IF opened_FLAG .EQ. TRUE THEN CLOSE MSG_FILE !Close Message File.
+$ GOTO EXIT
+$!
+$! ROUTINE to ABORT via CONTROL_Y and Close MSG_FILE if Open.
+$!
+$ ABORT_Control_Y:
+$ WS fac+"-W-Control_Y, ABORTING Procedure"
+$ IF opened_FLAG .EQ. TRUE THEN CLOSE MSG_FILE !Close Message File.
+$!
+$! ROUTINE to EXIT from procedure and RESET screen.
+$!
+$ EXIT:
+$ IF p2 .NES. NULL THEN SET NOVERIFY !Switch Verify OFF.
+$ IF f$search("MSG.DAT") .NES. NULL
+$ THEN SET PROTECTION=W:D MSG.DAT
+$ DELETE/NOLOG MSG.DAT;*
+$ ENDIF
+$ SET MESSAGE/FACILITY/IDENTIFICATION/TEXT/SEVERIFY
+$ oldverify = F$VERIFY(saveverify) !Reset Verify to initial state.
+$ EXIT !Exit procedure.
+$ !
+$ !**********************************************************************
+$ ! *
+$ ! Modification History *
+$ ! *
+$ !---------------------------------------------------------------------*
+$ ! Date Name Reason (in full) *
+$ !---------------------------------------------------------------------*
+$ ! *
+$ ! 06_Nov_1991 Neil Sakac Create *
+$ ! *
+$ !**********************************************************************
+
+
+
diff --git a/min-quotas-dcl b/min-quotas-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_bWluLXF1b3Rhcy1kY2w=
--- /dev/null
+++ b/min-quotas-dcl
@@ -0,0 +1,161 @@
+min_quotas.com
+David Jones, Thursday July 28 2005 @ 12:47PM EDT
+$!
+$! Dump the sysuaf database and produce a list of authorize commands in file
+$! min_quotas.input to increase several of the quotas to new minimums needed
+$! for VMS 8.2.
+$!
+$! Procedure assumes SYSUAF logical translates to full file specification for
+$! SYSUAF.DAT file.
+$!
+$! Author: David Jones, the Ohio State University
+$! Date: 8-JUN-2005
+$! Revised: 28-JUL-2005 ! Pare down for openvms.org.
+$!
+$ if p1 .eqs. "PIPE" then goto is_pipe
+$ proc = f$environment("PROCEDURE")
+$!
+$! create new min_quotas.input via create command so it has 'normal' text
+$! file properties rather than what you get when DCL open creates a file.
+$!
+$ create min_quotas.input
+$!
+$! Feed authorize show command output to spawned instance of this
+$! procedure so it can process it without making a temporary file.
+$!
+$ pipe mcr authorize show * | @'proc' "PIPE"
+$!
+$ search min_quotas.input lkjsdflkj/log
+$ inquire ans "Run authorize to apply changes? [y/N]"
+$ if .not. ans then exit
+$ define/user sys$input min_quotas.input
+$ mcr authorize
+$!
+$ exit
+$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+$! Come here when we are the sub-process. Parse show command display.
+$!
+$ is_pipe:
+$ open/append authcmd min_quotas.input
+$!
+$! Minimum quotas are the quotas for the DEFAULT account after a fresh 8.2
+$! install.
+$!
+$ say = "write sys$output"
+$ quota_mins = "/PRCLM=8/FILLM=128/BIOLM=150/DIOLM=150/ASTLM=300/TQELM=100" + -
+"/ENQLM=4000/BYTLM=128000/WSDEF=4069/WSQUO=8192/WSEXTENT=16384" + -
+"/PGFLQUO=256000"
+$!
+$ user_count = 0
+$ mod_count = 0
+$ cur_user = ""
+$ pd_count = 0
+$ has_sysprv = 0
+$ has_grpprv = 0
+$ milemarker = 100
+$ target = "USERNAME:"
+$!
+$! Main loop. Read lines and examine first token for a progression of
+$! target keywords, branching to specific section for each as it is found.
+$!
+$ new_target:
+$ targ_len = f$length(target)
+$ loop:
+$ read sys$pipe line/end=loop_end
+$ line2 = f$edit(line,"COMPRESS,UPCASE")
+$ if f$extract(0,targ_len,line2) .eqs. target then goto line_'f$extract(0,tar
+g_len-1,target)
+$ goto loop
+$!
+$! Pull out username and switch target line to MAXBJOBS:.
+$!
+$ line_username:
+$ cur_user = f$element(1," ",line2)
+$ user_count = user_count + 1
+$ if user_count .gt. milemarker
+$ then
+$ write sys$output f$time(), " processed ", user_count, -
+" users, last: ", cur_user
+$ milemarker = milemarker + 100
+$ endif
+$ target = "MAXJOBS:"
+$ goto new_target
+$!
+$! Maxjobs keyword begins first line of 7 which we need to process for
+$! quotas. Read them all and call subroutine, then switch target to
+$! begin looking for start of next user in listing.
+$!
+$ line_maxjobs:
+$ qline1 = line
+$ read sys$pipe qline2/end=loop_end ! maxacctjobs...
+$ read sys$pipe qline3/end=loop_end ! maxdetach...
+$ read sys$pipe qline4/end=loop_end ! prclm...
+$ read sys$pipe qline5/end=loop_end ! prio...
+$ read sys$pipe qline6/end=loop_end ! queueprio...
+$ read sys$pipe qline7/end=loop_end ! CPU...
+$ gosub process_quota_lines
+$ target = "USERNAME:"
+$ goto new_target
+$!
+$ loop_end:
+$ write sys$output "Total users: ", user_count, ", updates: ", mod_count
+$ close authcmd
+$ exit
+$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+$! Process lines that specify quotas, saved into DCL symbols. Add modify
+$! command to authcmd file for quotas below minimum.
+$! 012345678901234567890123456789012345678901234567890123456789
+$! Maxjobs: 0 Fillm: 128 Bytlm: 128000
+$! 12345678901234567890
+$ process_quota_lines:
+$! write sys$output "User ", cur_user
+$! show symbol qline%
+$!
+$! Process the 7 lines.
+$!
+$ qual_list = ""
+$ i = 0
+$ next_i:
+$ i = i + 1
+$ qline = f$edit(qline'i',"UPCASE")
+$!
+$! Inner loop extracts the 3 quota values on current line.
+$!
+$ col1 = f$extract(0,18,qline)
+$ col2 = f$extract(20,16,qline)
+$ col3 = f$extract(38,19,qline)
+$ j = 0
+$ next_j:
+$ j = j + 1
+$!
+$! Locate position of quota minimum definition for this column's keyword
+$! in the quota_mins symbol.
+$!
+$ name = "/" + f$edit(f$element(0,":",col'j'),"UPCASE") + "="
+$ offset = f$locate(name,quota_mins)
+$ if offset .lt. f$length(quota_mins)
+$ then
+$! Compare value in current column with the value set in the
+$! quota_mins variables. min_spec is of form "qname=value"
+$!
+$ value = f$integer(f$element(1,":",col'j'))
+$ min_spec = f$element(0,"/",f$extract(offset+1,80,quota_mins))
+$ min_value = f$integer(f$element(1,"=",min_spec))
+$ if (value .gt. 0) .and. (value .lt. min_value) then qual_list = -
+qual_list + " /" + min_spec
+$ endif
+$ if j .lt. 3 then goto next_j
+$!
+$ if i .lt. 7 then goto next_i
+$!
+$! All lines processed, generate authorize command if a quota was too low.
+$!
+$ if qual_list .nes. ""
+$ then
+$ write authcmd "MODIFY ", cur_user, qual_list
+$ mod_count = mod_count + 1
+$ endif
+$ return
+$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
diff --git a/monitor-devices-dcl b/monitor-devices-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_bW9uaXRvci1kZXZpY2VzLWRjbA==
--- /dev/null
+++ b/monitor-devices-dcl
@@ -0,0 +1,241 @@
+MONITOR_DEVICES.COM
+Jan van den Ende, Tuesday January 27 2004 @ 10:25AM EST
+$!
+$! DISCLAMER:
+$!
+$! NO RESPONIBILITY WHATSOVER WILL BE ACCEPTED FOR ANY MALFUNCTION; NOR
+$! FOR ANY DAMAGE, DIRECT OR INDIRECT, THAT MAY RESULT FROM USE OF THIS
+$! SOFTWARE.
+$ !+
+$ ! Autors: A.G.M. van Ruitenbeek ! 20040123: Now merged into:
+$ ! J.P. van den Ende
+$ ! PinkRoccade Industry PinkRoccade Industry
+$ ! Hambakenwetering 1 De Brand 16
+$ ! 5213 DD 's-Hertogenbosch Amersfoort
+$ ! Created: 20030219 Netherlands
+$
+$ !
+$!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+$!
+$! The texts above form an integral part of this software.
+$! Modify as needed, but leave us our credits.
+$!
+$!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+$!
+$ ! MONITOR_DEVICES.COM
+$ !----------------------------------------------------------------------
+$ !
+$ !
+$ ! Revisions:
+$ ! #6 20040127 jpe
+$ ! . Tidy. Comment translated to English
+$ ! #5 20031126 AvR
+$ ! . If under merge or copy, display progress %
+$ ! #4 20030528 AvR
+$ ! #3 set mountcount 'reverse', but that frustrates
+$ ! numeric comparison
+$ ! #3 ? jpe
+$ ! . If disk NOT mounted on ALL nodes, then reverse display
+$ ! for mountcount
+$ ! #2 20030318 jpe
+$ ! . Ignore NFS-mounted devices
+$ ! #1 20030312 AvR
+$ ! . Get disks NOT by F$DEVICE but by parsing a temporary file;
+$ ! because F$GETDVI dus not give remote-mounted devices;
+$ ! while just THOSE might be of extra interest.
+$ !
+$ !======================================================================
+$
+$ say = "write sys$output"
+$ esc[0,8] = 27
+$ md_id = f$getjpi("", "PID")
+$ g_on = esc + "(0"
+$ g_off = esc + "(B"
+$ w_on = esc + "[5;7m"
+$ w_off = esc + "[m"
+$ w_un = esc + "[7m"
+$
+$ say esc,"[2J"
+$ start:
+$ aant_nodes = f$getsyi("cluster_nodes")
+$ say f$fao("''esc'[H''g_on'l!78*qk''g_off'")
+$ say f$fao("''g_on'x''g_off'!35AS!20%D on !18ASC''g_on'x''g_off'", -
+" Mounted disk space in use at ",0,f$getsyi("NODENAME"))
+$ say f$fao("''g_on't!13*qw!8*qw!7*qw!3*qw!42*qNx''g_off'")
+$ say g_on,"x''g_off' Device ''g_on'x''g_off'Label ''g_on'x", -
+g_off, "Size Mb''g_on'x''g_off' % ''g_on'x''g_off' 25", -
+" 50 75 100 T''g_on'x",g_off
+$ say f$fao("''g_on't!13*qn!8*qn!7*qn!3*qn!9*qw!9*qw!9*qw!9*qwqqqu''g_off'")
+$
+$ get_devices:
+$ if f$trnlnm("FILE_IN") .nes. "" then -
+close file_in
+$ show device d/output=sys$scratch:monitor_devices.'md_id'
+$ open/read/error=no_file file_in sys$scratch:monitor_devices.'md_id'
+$
+$ dev_loop:
+$ read/end=dev_loop_end file_in regel
+$ device = f$element(0, ":", regel) + ":"
+$ if f$locate("remote mount", regel) .lt. f$lenght(regel)
+$ then
+$ mntcnt = f$edit(f$extract(f$locate("remote mount", regel)+13, 256, regel), "COLLAPSE")
+$ else
+$ if f$extract(0, 1, f$element(1, " ", f$edit(regel, "COMPRESS"))) .eqs. "("
+$ then
+$ mntcnt = f$element(7, " ", f$edit(regel, "COMPRESS"))
+$ else
+$ mntcnt = f$element(6, " ", f$edit(regel, "COMPRESS"))
+$ endif
+$ endif
+$ if device .eqs. "" then -
+goto dev_loop
+$ if .not. f$getdvi(device, "EXISTS") then -
+goto dev_loop
+$ if f$getdvi(device, "SHDW_MEMBER") then -
+goto dev_loop
+$ if f$extract(0,1,device) .eqs. "_" then -
+device = device - "_"
+$ if f$locate("Mounted alloc",regel) .lt. f$length(regel) then -
+goto dev_loop ! private mounted
+$ if f$locate("Mounted wrtlck",regel) .lt. f$length(regel) then -
+goto dev_loop ! write locked, probably CD
+$ if f$extract(0,4,device) .eqs. "DNFS" then -
+goto dev_loop
+$ if f$getdvi(device, "MNT")
+$ then
+$ label = " " + f$getdvi(device,"VOLNAM")
+$ if f$length(label) .gt. 8 then -
+label = "." + f$extract(f$length(label)-7,7,label)
+$ size = f$getdvi(device,"MAXBLOCK")
+$ free = f$getdvi(device,"FREEBLOCKS")
+$ str1 = f$string(size / (2 * 1024))
+$ str1 = f$extract(0,5-f$length(str1)," ") + str1
+$ str2 = f$string(((size - free) + (size/200 )) / (size / 100)) ! rounded
+$ str2 = f$extract(0,3-f$length(str2)," ") + str2
+$ len = (f$integer(str2) * 4) / 10
+$ if len .gt. 39 then -
+$ len = 39
+$ str3 = g_on + f$extract(0,len,f$fao("!39*a")) + g_off
+$ str4 = f$extract(0,39-len,f$fao("!39*."))
+$ if f$integer(str2) .gt. 80
+$ then
+$ str2 = w_on + str2 + w_off
+$ str3 = w_on + f$extract(0,len,f$fao("!39*#")) + w_off
+$ endif
+$ md_perc = 0
+$ temp = label - " "
+$ if f$getdvi(device, "SHDW_MASTER")
+$ then
+$ shdw_name = f$getdvi(temp, "SHDW_MASTER_NAME")
+$ if shdw_name .eqs. "" then -
+shdw_name = "_" + f$trnlnm(temp)
+$ shdw_members = 0
+$ shdw_count = 0
+$ loop_check_shdw:
+$ temp1 = f$extract(shdw_count, 1, "ABC")
+$ cur_member = temp + temp1
+$ if f$trnlnm("''cur_member'") .nes. ""
+$ then
+$ if f$getdvi(cur_member, "EXISTS")
+$ then
+$ if f$getdvi(cur_member, "MNT") .and. -
+f$getdvi(cur_member, "AVL") .and. -
+f$getdvi(cur_member, "SHDW_MASTER_NAME") .eqs. shdw_name
+$ then
+$ if f$getdvi(cur_member, "SHDW_MERGE_COPYING") .or. -
+f$getdvi(cur_member, "SHDW_CATCHUP_COPYING")
+$ then
+$ show device 'cur_member' -
+/output=sys$scratch:monitor_devices.'md_id'a
+$ if f$trnlnm("FILE_IN1") .nes. "" then -
+close file_in1
+$ open/read file_in1 sys$scratch:monitor_devices.'md_id'a
+$ loop1:
+$ read file_in1 md_regel
+$ temp2 = f$locate("%", md_regel)
+$ if temp2 .eq. f$length(md_regel) then -
+goto loop1
+$ loop1_end:
+$ close file_in1
+$ md_perc = f$extract(temp2-2, 2, md_regel)
+$
+$ str4 = str4 + w_on + temp1 + w_off
+$ else
+$ str4 = str4 + temp1
+$ endif
+$ else
+$ str4 = str4 + w_on + "N" + w_off
+$ endif
+$ else
+$ str4 = str4 + w_on + "X" + w_off
+$ endif
+$ else
+$ str4 = str4 + "-"
+$ endif
+$ shdw_count = shdw_count + 1
+$ if shdw_count .lt. 3 then -
+goto loop_check_shdw
+$ else
+$ typenaam = f$getdvi(device, "DEVICE_TYPE_NAME")
+$ if f$locate("RRD", typenaam) .lt. f$length(typenaam) .or. -
+f$locate("CRD", typenaam) .lt. f$length(typenaam)
+$ then
+$ str4 = str4 + g_on + "x''g_off'CD"
+$ else
+$ if f$locate("RX", typenaam) .lt. f$length(typenaam)
+$ then
+$ str4 = str4 + g_on + "x''g_off'FL"
+$ else
+$ str4 = str4 + "---"
+$ endif
+$ endif
+$ endif
+$ if md_perc .gt. 0
+$ then
+$ temp2 = f$length(str4)
+$ loop2:
+$ if f$extract(temp2, 1, str4) .eqs. "." then -
+goto loop2_end
+$ temp2 = temp2 - 1
+$ goto loop2
+$ loop2_end:
+$ temp2 = temp2 - 2
+$ str4['temp2',3] := 'md_perc'%
+$ endif
+$
+$ if (mntcnt .gt. 0) .and. (mntcnt .nes. aant_nodes) then -
+mntcnt = w_un + mntcnt + w_off
+$ say f$fao-
+("''g_on'x''g_off' !12AS''g_on'x''g_off'!8AS''g_on'x''g_off' !AS " +-
+"''g_on'x''g_off'!AS''g_on'x''g_off'!AS!AS!AS''g_on'x''g_off'", -
+device,label,str1,str2,str3,str4,mntcnt)
+$ else
+$ if mntcnt .gt. 0
+$ then
+$ if (mntcnt .gt. 0) .and. (mntcnt .nes. aant_nodes) then -
+mntcnt = w_un + mntcnt + w_off
+$ say f$fao-
+("''g_on'x''g_off' !12AS''g_on'x''g_off' " +-
+"''g_on'x''g_off'"+-
+"''g_on'x''g_off' ''g_on'x''g_off'Remote mount!30* " +-
+"!AS''g_on'x''g_off'", -
+device, mntcnt)
+$ endif
+$ endif
+$ goto dev_loop
+$
+$ dev_loop_end:
+$ say f$fao("''g_on'm!13*qv!8*qv!7*qv!3*qv!43*qj''g_off'"),esc,"[J"
+$ if f$trnlnm("FILE_IN") .nes. "" then -
+close file_in
+$ if f$search("SYS$SCRATCH:MONITOR_DEVICES.''md_id'") .nes. "" then -
+delete/nolog/noconfirm sys$scratch:monitor_devices.'md_id';*
+$ if f$search("SYS$SCRATCH:MONITOR_DEVICES.''md_id'%") .nes. "" then -
+delete/nolog/noconfirm sys$scratch:monitor_devices.'md_id'%;*
+$
+$ if p1 .eqs. "ONCE" then -
+exit
+$ wait 00:10:00
+$ goto start
+$
+$ exit
diff --git a/monitor-ent-dcl b/monitor-ent-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_bW9uaXRvci1lbnQtZGNs
--- /dev/null
+++ b/monitor-ent-dcl
@@ -0,0 +1,728 @@
+MONITOR_ENT.COM
+Neil Sakac, Friday February 18 2005 @ 09:49AM EST
+$ saveverify = f$environment("VERIFY_PROCEDURE") !Get current value of Verify.
+$ IF saveverify THEN SET NOVERIFY !If Verify ON then turn OFF.
+$ ON Control_Y THEN GOTO ABORT_Control_Y !Set Exit if Control_Y Pressed.
+$ ON Error THEN GOTO ABORT_Error !Set Exit if Error Occurs.
+$ GOTO MAIN !Goto Label MAIN, Miss Header.
+$!
+$!****************************************************************************
+$!* MONITOR_ENT.COM *
+$!* *
+$!* Command procedure to WATCH a specific entry on a queue. *
+$!* Version 1.1-0 *
+$!* Created: 17th January 1992. *
+$!* Last Revised: 15th April 1992. *
+$!* *
+$!* Usage: *
+$!* $ @COMMS$DIR:monitor_ent.com [Parameters] *
+$!* or *
+$!* $ MON_ENT [Parameters] *
+$!* *
+$!* Parameters: *
+$!* *
+$!* P1 = Number of the ENTRY to be Monitored. *
+$!* P2 = [<0 or 1>] Set Verify ON/OFF (Default OFF) *
+$!* *
+$!* © Written by Neil Sakac *
+$!* *
+$!****************************************************************************
+$!
+$ MAIN:
+$ GOSUB Initialize
+$ IF p2 .NES. NULL THEN SET VERIFY
+$ IF p1 .EQS. NULL
+$ THEN msg_txt = "NOENTRY, No Entry Number Specified"
+$ GOTO ABORT_Message
+$ ELSE qstatus = f$getqui("CANCEL_OPERATION")
+$ J_entry = p1
+$ M_que = f$getqui("DISPLAY_ENTRY","QUEUE_NAME",p1)
+$ IF M_que .EQS. NULL
+$ THEN msg_txt = "INVENT, Invalid Entry Specified, try valid entry"
+$ GOSUB ABORT_Message
+$ ENDIF
+$ ENDIF
+$ GOSUB TITLE
+$ GOSUB MON_selected_ent
+$ GOTO EXIT
+$!
+$! ROUTINE to Initialize all variables needed for Procedure
+$!
+$ Initialize:
+$
+$ BITS = 7 !Number of Bits for Chars.
+$ esc[0,BITS] = 27 !Escape character
+$ bell[0,BITS] = 7 !Bell character
+$ csi = esc+"[" !Control Sequence Introducer
+$ cls = csi+"2J"+csi+"H" !Clear Screen Sequence
+$ wide = esc+"#6" !Single width/Double Height
+$ narrow = esc+"#5" !Normal Size characters
+$ bo = csi+"1m" !Bold characters
+$ r = csi+"7m" !Reverse video characters
+$ o = csi+"0m" !Reset character attributes
+$ no = esc+"(B" !DEC Special Graphic set OFF
+$ gr = esc+"(0" !DEC Special Graphic set ON
+$ d = esc+"(0x"+esc+"(B" !Vertical Bar character
+$ tl = esc+"(0l" !Top Left corner character
+$ tr = "k"+esc+"(B" !Top Right corner character
+$ bl = esc+"(0m" !Bottom Left corner character
+$ br = "j"+esc+"(B" !Bottom Right corner character
+$ ml = esc+"(0t" !Middle Left character
+$ mr = "u"+esc+"(B" !Middle Right character
+$ m = "n" !Middle character
+$ md = "w" !Middle Down character
+$ mu = "v" !Middle Up character
+$ el = csi+"0K" !Erase to End of Line
+$ ed = csi+"0J" !Erase to End of Screen
+$ UP = csi+"A" !Scoll UP one line
+$ DOWN = csi+"B" !Scroll DOWN on line
+$ SPACE = " "
+$ NULL = ""
+$ q = "qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq"
+$ IN = "READ SYS$COMMAND"
+$ WS = "WRITE SYS$OUTPUT"
+$ fac = "%MONENT" !Facility Name.
+$ FALSE = 0
+$ TRUE = 1
+$ POS = 1 !Default Positon String
+$ answer = NULL !Setup for Prompt
+$ logtim = NULL !Setup for Time JOB executing
+$ Valid_queues = NULL !Setup for Valid Queues.
+$ Q_cnt = 0 !Count for Selected Queue.
+$ V_cnt = 0 !Count for Valid Queues.
+$ device = f$getjpi("","TERMINAL")
+$ sw = f$integer(f$getdvi("''device'","DEVBUFSIZ"))
+$ sl = f$integer(f$getdvi("''device'","TT_PAGE"))
+$ Head2 = " Mounted Form"
+$ Head3 = "Size"
+$ Stop_MON_text = "Type or Exit to STOP, ""S"" to START."
+$ type_string = "PRINTER|BATCH|TERMINAL|GENERIC|SERVER"
+$ File_Options = "FILE_COPIES|FILE_COPIES_DONE|FILE_FLAGS|"+-
+"FILE_IDENTIFICATION|FILE_STATUS|FIRST_PAGE|"+-
+"LAST_PAGE"
+$ TITLE_txt = "ENTRY MONITOR"
+$ TITLE_len = f$length(TITLE_txt)
+$ TITLE_pad = ((sw-TITLE_len)/4)-3
+$ M_que = NULL
+$ F_flags = NULL
+$ IF sw .GT. 80
+$ THEN pad = f$fao("!#AS",(sw-80)/2,SPACE)
+$ ELSE pad = NULL
+$ ENDIF
+$ L1 = pad+tl+"!33AS"+md+"!31AS"+md+"!11AS"+tr+el
+$ L2 = pad+d+r+"!33AS"+o+d+r+"!31AS"+o+d+r+"!11AS"+o+d+el
+$ L3 = pad+d+"!33AS"+d+"!31AS"+d+"!11AS"+d+el
+$ L4 = pad+ml+"!33AS"+mu+"!31AS"+mu+"!11AS"+mr+el
+$ L5 = pad+d+"!77AS"+d+el
+$ L6 = pad+ml+"!41AS"+md+"!6AS"+md+"!5AS"+md+"!22AS"+mr+el
+$ L7 = pad+d+r+"!41AS"+o+d+r+"!6AS"+o+d+r+"!5AS"+o+d+r+"!22AS"+o+d+el
+$ L8 = pad+d+"!41AS"+d+"!6SL"+d+"!5SL"+d+"!22AS"+d+el
+$ L9 = pad+d+"!41AS"+bl+"!6AS"+mu+"!5AS"+mu+"!22AS"+mr+el
+$ L10 = pad+d+"!77AS"+d+el
+$ L11 = pad+d+"File: !71AS"+d+el
+$ L12 = pad+d+"Fid:!16AS Copies:!5AS Pages:!7AS!30AS"+d+el
+$ L13 = pad+bl+"!42AS"+"!7AS"+"!6AS"+"!22AS"+br+el
+$ L14 = pad+f$fao("!15AS",SPACE)+Stop_MON_text+el+ed
+$
+$ RETURN
+$!
+$! ROUTINE to DISPLAY the TITLE of the procedure at the top of the screen.
+$!
+$ TITLE:
+$ WS esc+"7"+csi+f$str(POS)+";"+f$str(sl)+"r"+cls+-
+wide+f$fao("!#AS!#AS",TITLE_pad,SPACE,TITLE_len,TITLE_txt)+el
+$ RETURN
+$!
+$! ROUTINE to DO the Monitoring off the Selected Queue.
+$!
+$ MON_selected_ent:
+$
+$ qstatus = f$getqui("CANCEL_OPERATION")
+$ WS csi+f$str(POS+11)+";"+f$str(sl)+"r"+csi+f$str(POS+1)+"H"+ed
+$ MON_Q_loop:
+$ WS csi+f$str(POS+1)+"H"
+$ M_que = f$getqui("DISPLAY_ENTRY","QUEUE_NAME",J_entry)
+$ Q_stat'Q_cnt' = f$getqui("DISPLAY_QUEUE","QUEUE_STATUS",M_que)
+$ Stat_title = "QUEUE"
+$ GOSUB Get_QUEUE_type
+$ GOSUB Get_STATUS_text
+$ Q_form'Q_cnt' = f$getqui("DISPLAY_QUEUE","FORM_NAME",M_que)
+$ Q_stock'Q_cnt'= f$getqui("DISPLAY_QUEUE","FORM_STOCK",M_que)
+$ IF f$length(Q_form'Q_cnt') .LE. 15
+$ THEN Q_form'Q_cnt' = Q_form'Q_cnt'+",stock="+Q_stock'Q_cnt'
+$ ENDIF
+$ Q_desc'Q_cnt' = f$getqui("DISPLAY_QUEUE","QUEUE_DESCRIPTION",M_que)
+$ IF Q_desc'Q_cnt' .NES. NULL
+$ THEN Q_name = M_que+"<"+Q_desc'Q_cnt'+">"
+$ ELSE Q_name = M_que
+$ ENDIF
+$ IF f$length(Q_name) .LE. 20
+$ THEN Q_name = f$extract(0,1,Q_type'Q_cnt')+f$edit(f$extract(1, -
+f$length(Q_type'Q_cnt'),Q_type'Q_cnt'), -
+"LOWERCASE")+" que "+Q_name
+$ ENDIF
+$ IF Q_type'Q_cnt' .EQS. "BATCH"
+$ THEN
+$ Head2 = NULL
+$ Head3 = "Prior"
+$ Q_priority = f$getqui("DISPLAY_QUEUE","BASE_PRIORITY",M_que)
+$ Q_node'Q_cnt' = f$getqui("DISPLAY_QUEUE","SCSNODE_NAME",M_que)
+$ Q_form'Q_cnt' = " Batch Queue on Node " + Q_node'Q_cnt' + "::"
+$ ENDIF
+$ Q_device = f$getqui("DISPLAY_QUEUE","DEVICE_NAME",M_que)
+$ IF Q_device .NES. NULL
+$ THEN Q_node = f$getqui("DISPLAY_QUEUE","SCSNODE_NAME",M_que)
+$ Q_lat = "/Device="+Q_node+"::"+Q_device
+$ ELSE Q_lat = NULL
+$ ENDIF
+$ Q_processor = f$getqui("DISPLAY_QUEUE","PROCESSOR",M_que)
+$ IF Q_processor .NES. NULL THEN Q_processor = "/Processor="+Q_processor
+$ Q_library = f$getqui("DISPLAY_QUEUE","LIBRARY_SPECIFICATION",M_que)
+$ IF Q_library .NES. NULL THEN Q_library = "/Library="+Q_library
+$ Q_owner = f$getqui("DISPLAY_QUEUE","OWNER_UIC",M_que)
+$ IF Q_owner .NES. NULL THEN Q_owner = "/Owner="+Q_owner
+$ Q_generic = f$getqui("DISPLAY_QUEUE","GENERIC_TARGET",M_que)
+$ IF Q_generic .NES. NULL THEN Q_generic = "/Generic="+Q_generic
+$ WS f$fao(L1,q,q,q)
+$ WS f$fao(L2," Queue Name",Head2," Status")
+$ WS f$fao(L3,Q_name,Q_form'Q_cnt',Q_stat'Q_cnt')
+$ WS f$fao(L4,q,q,q)
+$ WS f$fao(L5,Q_lat+Q_processor+Q_library+Q_owner+Q_generic)
+$ WS f$fao(L6,q,q,q,q)
+$ WS f$fao(L7," Job Name","Entry",Head3," Status")
+$
+$ MON_J_loop_cont:
+$ mon_FLAG = TRUE
+$ J_cnt = 1
+$ J_name = f$getqui("DISPLAY_ENTRY","JOB_NAME",J_entry)
+$ J_note = f$getqui("DISPLAY_ENTRY","NOTE",J_entry)
+$ J_user = f$getqui("DISPLAY_ENTRY","USERNAME",J_entry)
+$ J_form = f$getqui("DISPLAY_ENTRY","FORM_NAME",J_entry)
+$ J_stock = f$getqui("DISPLAY_ENTRY","FORM_STOCK",J_entry)
+$ IF J_note .NES. NULL THEN J_note = "/Note=<"+J_note+">"
+$ IF J_form .NES. NULL
+$ THEN J_form = "/Form="+J_form+" (stock="+J_stock+")"
+$ ENDIF
+$ IF f$length(J_name) .LE. 26 .AND. J_name .NES. NULL
+$ THEN J_name = J_name+"-["+J_user+"]"
+$ ENDIF
+$ IF Q_type'Q_cnt' .EQS. "BATCH"
+$ THEN J_size = Q_priority
+$ ELSE J_size = f$getqui("DISPLAY_ENTRY","JOB_SIZE",J_entry)
+$ ENDIF
+$ J_stat = f$getqui("DISPLAY_ENTRY","JOB_STATUS",J_entry)
+$ Stat_title = "JOB"
+$ GOSUB Get_STATUS_text
+$ IF J_name .EQS. NULL
+$ THEN J_name = " Entry "+f$str(J_entry)+" Completed."
+$ WS f$fao(L8,J_name,f$int(J_entry),J_size,J_stat)
+$ mon_FLAG = FALSE
+$ ELSE WS f$fao(L8,J_name,f$int(J_entry),J_size,J_stat)
+$ mon_FLAG = TRUE
+$ ENDIF
+$ IF mon_FLAG .EQ. FALSE THEN GOTO Exit_MON_loop
+$ GOSUB Get_JOB_Files
+$ GOSUB Get_JOB_Parameters
+$ WS f$fao(L9,J_note,q,q,q)
+$ GOSUB Get_JOB_Flag_Text
+$ J_pri = "/Prio="+f$str(J_pri)
+$ IF J_pid .NES. NULL THEN J_pid = "/Pid="+J_pid
+$ IF J_cli .NES. NULL THEN J_cli = "/CLI="+J_cli
+$ IF J_opr .NES. NULL THEN J_opr = "/Oper=("""+J_opr+""")"
+$ Tot_len = f$len(J_flags+J_pri+J_pid+J_cli+J_opr+J_restart+J_form)
+$ IF Tot_len .LE. 75
+$ THEN WS f$fao(L10,J_flags+J_pri+J_pid+J_cli+J_opr+J_restart+J_form)
+$ ELSE WS f$fao(L10,J_flags+J_form)
+$ WS f$fao(L10,J_pri+J_pid+J_cli+J_opr+J_restart)
+$ ENDIF
+$ IF J_log .NES. NULL THEN WS f$fao(L10,"/Log="+J_log)
+$ IF J_par .NES. NULL THEN WS f$fao(L10,"/Param=("+J_par+")")
+$ F_cnt = 1
+$ J_File_Display_Loop:
+$ F_spec = F_specification'F_cnt'
+$ IF f$len(F_spec) .GT. 53 THEN F_spec = f$element(1,"]",F_spec)
+$ IF F_status'F_cnt' .EQ. 3 THEN F_spec = F_spec+" (Printing)"
+$ IF F_status'F_cnt' .EQ. 2 THEN F_spec = F_spec+" (Executing)"
+$ IF F_status'F_cnt' .EQ. 1 THEN F_spec = F_spec+" (Checkpointed)"
+$ GOSUB Get_FILE_Flag_Text
+$ WS f$fao(L11,F_spec)
+$ WS f$fao(L12,F_identification'F_cnt',-
+f$str(F_copies'F_cnt')+"/"+f$str(F_copies_done'F_cnt'),-
+f$str(F_first_page'F_cnt')+"/"+f$str(F_last_page'F_cnt'),-
+F_flags)
+$ F_cnt = F_cnt+1
+$ IF F_cnt .LT. F_cnt_limit THEN GOTO J_File_Display_Loop
+$ WS f$fao(L13,q,q,q,q)
+$ IN/PROMPT="''L14'"/END=Exit_MON_loop/TIME_OUT=3 answer/ERROR=Timed_OUT
+$ Timed_OUT:
+$ qstatus = f$getqui("CANCEL_OPERATION")
+$ IF f$edit(f$extr(0,1,answer),"UPCASE") .EQS. "E" THEN GOTO Exit_MON_loop
+$ IF f$edit(f$extr(0,1,answer),"UPCASE") .EQS. "S" THEN GOSUB START_queue
+$ IF J_name .EQS. NULL THEN GOTO Exit_MON_loop
+$ answer = NULL
+$ GOTO MON_Q_loop
+$ Exit_MON_loop:
+$ WS no+o+UP
+$ RETURN
+$!
+$! ROUTINE to Get the STATUS of either the JOB or the QUEUE.
+$!
+$ Get_STATUS_text:
+$ IF Stat_title .EQS. "JOB"
+$ THEN
+$ block = f$getqui("DISPLAY_ENTRY","COMPLETED_BLOCKS",J_entry)
+$ IF J_stat .EQ. 0 THEN T_stat'J_cnt' = "********************"
+$ IF J_stat .GE. 1 THEN T_stat'J_cnt' = "Aborting"
+$ IF J_stat .GE. 2
+$ THEN
+$ T_stat'J_cnt' = "Started"
+$ IF Q_type'Q_cnt' .EQS. "BATCH"
+$ THEN
+$ GOSUB Calc_Connect_Time
+$ T_stat'J_cnt' = "Executing " + logtim
+$ ENDIF
+$ IF Q_type'Q_cnt' .EQS. "PRINTER" .OR. -
+Q_type'Q_cnt' .EQS. "TERMINAL" .OR. -
+Q_type'Q_cnt' .EQS. "OUTPUT" .OR. -
+Q_type'Q_cnt' .EQS. "SERVER" .OR. -
+Q_type'Q_cnt' .EQS. "UNKNOWN"
+$ THEN T_stat'J_cnt' = "Printing block "+f$str(block)
+$ ENDIF
+$ ENDIF
+$ IF J_stat .GE. 4 THEN T_stat'J_cnt' = "Holding"
+$ IF J_stat .GE. 8
+$ THEN T_stat'J_cnt' = "Inaccessible"
+$ IF J_name .EQS. NULL THEN J_name = " ** No Privilege **"
+$ ENDIF
+$ IF J_stat .GE. 16 THEN T_stat'J_cnt' = "Refused"
+$ IF J_stat .GE. 32 THEN T_stat'J_cnt' = "Requeue"
+$ IF J_stat .GE. 64
+$ THEN IF block .GT. 0
+$ THEN T_stat'J_cnt' = "Restart at block "+f$str(block)
+$ ELSE T_stat'J_cnt' = "Restarting"
+$ ENDIF
+$ ENDIF
+$ IF J_stat .GE. 128
+$ THEN err = f$getqui("DISPLAY_ENTRY","CONDITION_VECTOR",J_entry)
+$ T_stat'J_cnt' = "Retain Err"+f$elem(1,",",f$message("%X''err'"))
+$ ENDIF
+$ IF J_stat .GE. 256 THEN T_stat'J_cnt' = "Starting"
+$ IF J_stat .GE. 512
+$ THEN hold_time = f$getqui("DISPLAY_ENTRY","AFTER_TIME",J_entry)
+$ T_stat'J_cnt' = "Held "+hold_time
+$ ENDIF
+$ IF J_stat .GE. 1024 THEN T_stat'J_cnt' = "Suspended"
+$ IF J_stat .GE. 2048
+$ THEN IF block .GT. 0
+$ THEN T_stat'J_cnt' = "Pending at block "+f$str(block)
+$ ELSE GOSUB Get_Pending_Reason
+$ T_stat'J_cnt' = "Pending "+reason
+$ ENDIF
+$ ENDIF
+$ J_stat = T_stat'J_cnt'
+$ ENDIF
+$ IF Stat_title .EQS. "QUEUE"
+$ THEN
+$ IF Q_stat'Q_cnt' .EQ. 0 THEN T_stat'Q_cnt' = "Started"
+$ IF Q_stat'Q_cnt' .GE. 1 THEN T_stat'Q_cnt' = "Aligning"
+$ IF Q_stat'Q_cnt' .GE. 2 THEN T_stat'Q_cnt' = "Idle"
+$ IF Q_stat'Q_cnt' .GE. 4 THEN T_stat'Q_cnt' = "Lowercase"
+$ IF Q_stat'Q_cnt' .GE. 8 THEN T_stat'Q_cnt' = "Operator_request"
+$ IF Q_stat'Q_cnt' .GE. 16 THEN T_stat'Q_cnt' = "Paused"
+$ IF Q_stat'Q_cnt' .GE. 32 THEN T_stat'Q_cnt' = "Pausing"
+$ IF Q_stat'Q_cnt' .GE. 64 THEN T_stat'Q_cnt' = "Remote"
+$ IF Q_stat'Q_cnt' .GE. 128 THEN T_stat'Q_cnt' = "Resetting"
+$ IF Q_stat'Q_cnt' .GE. 256 THEN T_stat'Q_cnt' = "Resuming"
+$ IF Q_stat'Q_cnt' .GE. 512 THEN T_stat'Q_cnt' = "Server"
+$ IF Q_stat'Q_cnt' .GE. 1024 THEN T_stat'Q_cnt' = "Stalled"
+$ IF Q_stat'Q_cnt' .GE. 2048 THEN T_stat'Q_cnt' = "Starting"
+$ IF Q_stat'Q_cnt' .GE. 4096 THEN T_stat'Q_cnt' = "Stopped"
+$ IF Q_stat'Q_cnt' .EQ. 4096 THEN T_stat'Q_cnt' = "Stop Pend"
+$ IF Q_stat'Q_cnt'-1024 .EQ. 4096
+$ THEN T_stat'Q_cnt' = "Stall Pend"
+$ ENDIF
+$ IF Q_stat'Q_cnt' .GE. 8192 THEN T_stat'Q_cnt' = "Stopping"
+$ IF Q_stat'Q_cnt' .GE. 16384 THEN T_stat'Q_cnt' = "Unavailable"
+$ IF Q_stat'Q_cnt' .GE. 32768
+$ THEN
+$ IF Q_type'Q_cnt' .EQS. "BATCH"
+$ THEN T_stat'Q_cnt' = "Available "
+$ ELSE T_stat'Q_cnt' = "Busy "
+$ ENDIF
+$ ENDIF
+$ Q_stat'Q_cnt' = T_stat'Q_cnt'
+$ ENDIF
+$ RETURN
+$!
+$! ROUTINE to Convert the File FLAGS to Text.
+$!
+$ Get_FILE_Flag_Text:
+$ T_flags = NULL
+$ F_flags = F_flags'F_cnt'
+$ IF F_flags .GE. 2048
+$ THEN T_flags = T_flags+"/NoPage"
+$ F_flags = F_flags-2048
+$ ENDIF
+$ IF F_flags .GE. 1024
+$ THEN T_flags = T_flags+"/Passall"
+$ F_flags = F_flags-1024
+$ ENDIF
+$ IF F_flags .GE. 512
+$ THEN T_flags = T_flags+"/Page"-"/NoPage"
+$ F_flags = F_flags-512
+$ ENDIF
+$ IF F_flags .GE. 256
+$ THEN T_flags = T_flags+"/Header"
+$ F_flags = F_flags-256
+$ ENDIF
+$ IF F_flags .GE. 128
+$ THEN T_flags = T_flags+"/NoTrail"
+$ F_flags = F_flags-128
+$ ENDIF
+$ IF F_flags .GE. 64
+$ THEN T_flags = T_flags+"/Trail"-"/NoTrail"
+$ F_flags = F_flags-64
+$ ENDIF
+$ IF F_flags .GE. 32
+$ THEN T_flags = T_flags+"/NoFlag"
+$ F_flags = F_flags-32
+$ ENDIF
+$ IF F_flags .GE. 16
+$ THEN T_flags = T_flags+"/Flag"-"/NoFlag"
+$ F_flags = F_flags-16
+$ ENDIF
+$ IF F_flags .GE. 8
+$ THEN T_flags = T_flags+"/Double"
+$ F_flags = F_flags-8
+$ ENDIF
+$ IF F_flags .GE. 4
+$ THEN T_flags = T_flags+"/Delete"
+$ F_flags = F_flags-4
+$ ENDIF
+$ IF F_flags .GE. 2
+$ THEN T_flags = T_flags+"/NoBurst"
+$ F_flags = F_flags-2
+$ ENDIF
+$ IF F_flags .GE. 1
+$ THEN T_flags = T_flags+"/Burst"-"/NoBurst"
+$ F_flags = F_flags-1
+$ ENDIF
+$ F_flags = T_flags
+$ RETURN
+$!
+$! ROUTINE to Convert the JOB Flags to Text.
+$!
+$ Get_JOB_Flag_Text:
+$
+$ J_restart = NULL
+$ T_flags = NULL
+$ J_flags = f$getqui("DISPLAY_ENTRY","JOB_FLAGS",J_entry)
+$ IF J_flags .GE. 1048576
+$ THEN T_flags = T_flags+"/NoPage"
+$ J_flags = J_flags-1048576
+$ ENDIF
+$ IF J_flags .GE. 524288
+$ THEN T_flags = T_flags+"/Page"-"/NoPage"
+$ J_flags = J_flags-524288
+$ ENDIF
+$ IF J_flags .GE. 262144
+$ THEN Wsquota = f$getqui("DISPLAY_ENTRY","WSQUOTA",J_entry)
+$ T_flags = T_flags+"/Wsquota="+f$str(Wsquota)
+$ J_flags = J_flags-262144
+$ ENDIF
+$ IF J_flags .GE. 131072
+$ THEN Wsextent = f$getqui("DISPLAY_ENTRY","WSEXTENT",J_entry)
+$ T_flags = T_flags+"/Wsextent="+f$str(Wsextent)
+$ J_flags = J_flags-131072
+$ ENDIF
+$ IF J_flags .GE. 65536
+$ THEN Wsdefault = f$getqui("DISPLAY_ENTRY","WSDEFAULT",J_entry)
+$ T_flags = T_flags+"/Wsdefault="+f$str(Wsdefault)
+$ J_flags = J_flags-65536
+$ ENDIF
+$ IF J_flags .GE. 32768
+$ THEN restart = f$getqui("DISPLAY_ENTRY","RESTART_QUEUE_NAME",J_entry)
+$ J_restart = "/Restart_Que="+restart
+$ J_flags = J_flags-32768
+$ ENDIF
+$ IF J_flags .GE. 16384
+$ THEN T_flags = T_flags+"/Notify"
+$ J_flags = J_flags-16384
+$ ENDIF
+$ IF J_flags .GE. 8192
+$ THEN T_flags = T_flags+"/Lower"
+$ J_flags = J_flags-8192
+$ ENDIF
+$ IF J_flags .GE. 4096
+$ THEN T_flags = T_flags+"/Print"
+$ J_flags = J_flags-4096
+$ ENDIF
+$ IF J_flags .GE. 2048
+$ THEN T_flags = T_flags+"/NoLog"
+$ J_flags = J_flags-2048
+$ ENDIF
+$ IF J_flags .GE. 1024
+$ THEN T_flags = T_flags+"/Delete"
+$ J_flags = J_flags-1024
+$ ENDIF
+$ IF J_flags .GE. 512
+$ THEN T_flags = T_flags+"/NoTrail"
+$ J_flags = J_flags-512
+$ ENDIF
+$ IF J_flags .GE. 256
+$ THEN T_flags = T_flags+"/Trail_last"-"/NoTrail"
+$ J_flags = J_flags-256
+$ ENDIF
+$ IF J_flags .GE. 128
+$ THEN T_flags = T_flags+"/Trail"-"/Trail_last"-"/NoTrail"
+$ J_flags = J_flags-128
+$ ENDIF
+$ IF J_flags .GE. 64
+$ THEN T_flags = T_flags+"/NoFlag"
+$ J_flags = J_flags-64
+$ ENDIF
+$ IF J_flags .GE. 32
+$ THEN T_flags = T_flags+"/Flag_last"-"/NoFlag"
+$ J_flags = J_flags-32
+$ ENDIF
+$ IF J_flags .GE. 16
+$ THEN T_flags = T_flags+"/Flag"-"/Flag_last"-"/NoFlag"
+$ J_flags = J_flags-16
+$ ENDIF
+$ IF J_flags .GE. 8
+$ THEN T_flags = T_flags+"/NoBurst"
+$ J_flags = J_flags-8
+$ ENDIF
+$ IF J_flags .GE. 4
+$ THEN T_flags = T_flags+"/Burst_last"-"/NoBurst"
+$ J_flags = J_flags-4
+$ ENDIF
+$ IF J_flags .GE. 2
+$ THEN T_flags = T_flags+"/Burst"-"/Burst_last"-"/NoBurst"
+$ J_flags = J_flags-2
+$ ENDIF
+$ IF J_flags .GE. 1
+$ THEN T_flags = T_flags+"/CPU_limit
+$ J_flags = J_flags-1
+$ ENDIF
+$ J_flags = T_flags
+$ RETURN
+$!
+$! ROUTINE to GET theo Pending Reason.
+$!
+$ Get_Pending_Reason:
+$ reason_num = f$getqui("DISPLAY_ENTRY","PENDING_JOB_REASON",J_entry)
+$ reason = NULL
+$ IF reason_num .GE. 1 THEN reason = "Char Mismatch"
+$ IF reason_num .GE. 2 THEN reason = "Job Size Max"
+$ IF reason_num .GE. 4 THEN reason = "Job Size Min"
+$ IF reason_num .GE. 8 THEN reason = "Lower Mismatch"
+$ IF reason_num .GE. 16 THEN reason = "NO Access"
+$ IF reason_num .GE. 32 THEN reason = "Queue Busy"
+$ IF reason_num .GE. 64 THEN reason = "Queue State"
+$ IF reason_num .GE. 128 THEN reason = "Stock Mismatch"
+$ RETURN
+$!
+$! ROUTINE to Get the TYPE of Queue that was Selected.
+$!
+$ Get_QUEUE_type:
+$ Unknown_FLAG = TRUE
+$ type_cnt = 0
+$ Type_LOOP:
+$ type_txt = f$element(type_cnt,"|",type_string)
+$ IF type_txt .EQS. "|" THEN GOTO End_Type_LOOP
+$ Q_type = f$getqui("DISPLAY_QUEUE","QUEUE_''type_txt'",M_que)
+$ IF Q_type .EQS. "TRUE"
+$ THEN Q_type'Q_cnt' = type_txt
+$ Unknown_FLAG = FALSE
+$ ENDIF
+$ type_cnt = type_cnt + 1
+$ GOTO Type_LOOP
+$ End_Type_LOOP:
+$ IF Unknown_FLAG THEN Q_type'Q_cnt' = "UNKNOWN"
+$ RETURN
+$!
+$! ROUTINE to Calculate the Execution Time of the Batch JOB if Privileged.
+$!
+$ Calc_Connect_Time:
+$ oldlogtim = logtim
+$ user_uic = f$user()
+$ job_uic = f$getqui("DISPLAY_ENTRY","UIC" ,J_entry)
+$ job_pid = f$getqui("DISPLAY_ENTRY","JOB_PID" ,J_entry)
+$ IF user_uic .EQS. job_uic THEN GOTO Execute_TIME
+$ IF f$priv("WORLD") .EQS. "TRUE" THEN GOTO Execute_TIME
+$ user_grp = f$element(0,",",user_uic)
+$ job_grp = f$element(0,",",job_uic)
+$ logtim = NULL
+$ IF user_grp .NES. job_grp THEN RETURN
+$ IF f$priv("GROUP") .EQS. "TRUE" THEN GOTO Execute_TIME
+$ RETURN
+$
+$ Execute_TIME:
+$ logintim = f$cvtime(f$getjpi(job_pid,"LOGINTIM"),"ABSOLUTE","DATETIME")
+$ lsecond = f$cvtime(logintim,,"SECOND")
+$ lminute = f$cvtime(logintim,,"MINUTE")
+$ lhour = f$cvtime(logintim,,"HOUR")
+$ lday = f$cvtime(logintim,,"DAY")
+$ currtim = f$cvtime(,"ABSOLUTE","DATETIME")
+$ csecond = f$cvtime(currtim,,"SECOND")
+$ cminute = f$cvtime(currtim,,"MINUTE")
+$ chour = f$cvtime(currtim,,"HOUR")
+$ cday = f$cvtime(currtim,,"DAY")
+$ tlsecond = (lday*86400)+(lhour*3600)+(lminute*60)+lsecond
+$ tcsecond = (cday*86400)+(chour*3600)+(cminute*60)+csecond
+$ totsec = tcsecond-tlsecond
+$ logday = f$str(f$fao("!2ZL",totsec/86400))
+$ totsec = totsec-(logday*86400)
+$ loghour = f$str(f$fao("!2ZL",totsec/3600))
+$ totsec = totsec-(loghour*3600)
+$ logmin = f$str(f$fao("!2ZL",totsec/60))
+$ totsec = totsec-(logmin*60)
+$ logsec = f$str(f$fao("!2ZL",totsec))
+$ logtim = logday+" "+loghour+":"+logmin+":"+logsec
+$ IF oldlogtim .NES. NULL
+$ THEN IF f$edit(logtim,"TRIM") .EQS. "0 00:00:00" THEN logtim = oldlogtim
+$ ENDIF
+$ RETURN
+$!
+$! ROUTINE to GET Entry File Specification and Other information.
+$!
+$ Get_JOB_Files:
+$ F_cnt = 1
+$ stat = f$getqui("DISPLAY_ENTRY","ENTRY_NUMBER",J_entry,"WILDCARD")
+$ J_File_Spec_Loop:
+$ temp = f$getqui("DISPLAY_FILE","FILE_COPIES")
+$ F_specification'F_cnt' = f$getqui("DISPLAY_FILE","FILE_SPECIFICATION")
+$ F_cnt = F_cnt+1
+$ IF F_specification'f$str(F_cnt-1)' .NES. NULL THEN GOTO J_File_Spec_Loop
+$ F_cnt_limit = F_cnt-1
+$ F_E_cnt = 0
+$ F_Opt_Loop:
+$! stat = f$getqui("DISPLAY_ENTRY","ENTRY_NUMBER",J_entry,"WILDCARD")
+$ F_opt = f$element(F_E_Cnt,"|",File_Options)
+$ IF F_opt .EQS. NULL .OR. F_opt .EQS. "|" THEN GOTO END_F_Opt_Loop
+$ F_cnt = 1
+$ J_File_Loop:
+$ F_'f$str(F_opt-"FILE_")''F_cnt' = f$getqui("DISPLAY_FILE","''F_opt'")
+$ F_cnt = F_cnt+1
+$ IF F_cnt .LT. F_cnt_limit THEN GOTO J_File_Loop
+$ F_E_Cnt = F_E_Cnt+1
+$ GOTO F_Opt_Loop
+$ END_F_Opt_Loop:
+$ RETURN
+$!
+$! ROUTINE to GET Entry File Specification and Other information.
+$!
+$ Get_JOB_Parameters:
+$ stat = f$getqui("CANCEL_OPERATION")
+$ J_cli = f$getqui("DISPLAY_ENTRY","CLI",J_entry)
+$ J_pid = f$getqui("DISPLAY_ENTRY","JOB_PID",J_entry)
+$ J_pri = f$getqui("DISPLAY_ENTRY","PRIORITY",J_entry)
+$ J_log = f$getqui("DISPLAY_ENTRY","LOG_SPECIFICATION",J_entry)
+$ J_opr = f$getqui("DISPLAY_ENTRY","OPERATOR_REQUEST",J_entry)
+$ J_par = NULL
+$ P_cnt = 1
+$ PAR_Loop:
+$ P_txt = "PARAMETER_"+f$str(P_cnt)
+$ PAR'P_cnt' = f$getqui("DISPLAY_ENTRY",P_txt,J_entry)
+$ IF PAR'P_cnt' .EQS. NULL .OR. P_cnt .EQ. 8 THEN GOTO END_PAR_Loop
+$ J_par = J_par+""""+PAR'P_cnt'+""","
+$ P_cnt = P_cnt+1
+$ GOTO PAR_Loop
+$ END_PAR_Loop:
+$ J_par = J_par+"|"-",|"-"|"
+$ RETURN
+$!
+
+
+
+$! ROUTINE to ABORT when ERROR encountered and show error message.
+$!
+$ START_queue:
+$ IF q_stat'Q_cnt' .EQS. "Stopped" .OR. -
+q_stat'Q_cnt' .EQS. "Stopping" .OR. -
+q_stat'Q_cnt' .EQS. "Paused" .OR. -
+q_stat'Q_cnt' .EQS. "Pausing" .OR. -
+q_stat'Q_cnt' .EQS. "Stop Pend" .OR. -
+q_stat'Q_cnt' .EQS. "Stalled"
+$ THEN GOSUB DO_START_queue
+$ ELSE WS fac+"-I-NOSTART, Queue "+M_que+" in "+q_stat'Q_cnt'+-
+" status, Cannot Re-start."
+$ ENDIF
+$ RETURN
+$!
+$! ROUTINE to Calculate the Execution Time of the Batch JOB if Privileged.
+$!
+$ DO_START_queue:
+$ user_uic = f$user()
+$ job_uic = f$getqui("DISPLAY_ENTRY","UIC",J_entry)
+$ job_pid = f$getqui("DISPLAY_ENTRY","JOB_PID",J_entry)
+$ IF user_uic .EQS. job_uic THEN GOTO Privileged_START
+$! IF f$priv("WORLD") .EQS. "TRUE" THEN GOTO Privileged_START
+$ IF f$priv("SYSPRV") .EQS. "TRUE" THEN GOTO Privileged_START
+$ user_grp = f$element(0,",",user_uic)
+$ job_grp = f$element(0,",",job_uic)
+$ IF user_grp .NES. job_grp THEN WS fac+"-I-NOPRIV, NO privilege to Start "+M_que
+$ IF user_grp .NES. job_grp THEN RETURN
+$ IF f$priv("GROUP") .EQS. "TRUE" THEN GOTO Privileged_START
+$ WS fac+"-I-NOPRIV, NO privilege to start "+M_que
+$ RETURN
+$
+$ Privileged_START:
+$ ON Error THEN GOTO START_ERROR !Set trap if Error Occurs.
+$ STOP/QUEUE/RESET 'M_que'
+$ START/QUEUE 'M_que'
+$ WS fac+"-I-RESTARTQUE, Queue "+M_que+" Re-started"
+$ GOTO STARTED_OK
+$ START_ERROR:
+$ sts = f$message($STATUS)
+$ error_msg = f$element(1,",",sts)
+$ WS fac+"-F-RESTARTFAIL, Restart failure ("+error_msg+")"
+$ STARTED_OK:
+$ ON Error THEN GOTO ABORT_Error !Set Exit if Error Occurs.
+$ RETURN
+$!
+$! ROUTINE to ABORT when ERROR encountered and show error message.
+$!
+$ ABORT_Error:
+$ sts = f$message($STATUS)
+$ error_msg = f$extract(f$locate("-",sts),f$length(sts),sts)
+$ WS fac + error_msg
+$ WS NULL
+$ GOTO EXIT
+$!
+$! ROUTINE to ABORT with an error message.
+$!
+$ ABORT_Message:
+$ WS esc+"7"+fac+"-F-"+msg_txt
+$ WS NULL
+$ GOTO EXIT
+$!
+$! ROUTINE to ABORT via CONTROL_Y and reset queues.
+$!
+$ ABORT_Control_Y:
+$ WS fac+"-W-Control_Y, ABORTING Procedure"
+$!
+$! ROUTINE to EXIT from procedure and RESET screen.
+$!
+$ EXIT:
+$ WS o+no+csi+"0;"+f$str(sl)+"r"+csi+""+f$str(sl-1)+"H"+esc+"8" !Reset Screen characteristics.
+$ IF p2 .NES. NULL THEN SET NOVERIFY !Switch Verify OFF.
+$ oldverify = F$VERIFY(saveverify) !Reset Verify to initial state.
+$ EXIT !Exit procedure.
+$ !
+$ !**********************************************************************
+$ ! *
+$ ! Modification History *
+$ ! *
+$ !---------------------------------------------------------------------*
+$ ! Date Name Reason (in full) *
+$ !---------------------------------------------------------------------*
+$ ! *
+$ ! 17_Jan_1992 Neil Sakac Create *
+$ ! 06_Apr_1992 Neil Sakac Added Extra Lines to give information *
+$ ! about LIBRARY, PROCESSOR, DEVICE and *
+$ ! OWNER. *
+$ ! *
+$ !**********************************************************************
+
diff --git a/monitor-hs-dcl b/monitor-hs-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_bW9uaXRvci1ocy1kY2w=
--- /dev/null
+++ b/monitor-hs-dcl
@@ -0,0 +1,397 @@
+MONITOR_HS.COM
+Jan van den Ende, Friday January 23 2004 @ 07:33AM EST
+Procedure to check HSZ & HSG statuses. Reports non-optimal batteries, failed disks, mirrorsets etc.
+Routine as-is is intended to present a regularly updated view in a DECwindows display (pleases managers!)
+
+$ ! File: MONITOR_HS.COM
+$!
+$! DISCLAMER:
+$!
+$! NO RESPONIBILITY WHATSOVER WILL BE ACCEPTED FOR ANY MALFUNCTION; NOR
+$! FOR ANY DAMAGE, DIRECT OR INDIRECT, THAT MAY RESULT FROM USE OF THIS
+$! SOFTWARE.
+$ !+
+$ ! Author: J.P. van den Ende ! 20040123: Now merged into:
+$ ! Bowhouse Data PinkRoccade Industry
+$ ! Savannahweg 17 De Brand 16
+$ ! 3542 AW Utrecht Amersfoort
+$ ! Netherlands
+$!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+$!
+$! The texts above form an integral part of this software.
+$! Modify as needed, but leave us our credits.
+$!
+$!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+$!
+$ ! Revision History:
+$ !----------------------------------------------------------------------
+$ ! # date by description/reason
+$ !
+$ ! #08 20040123 / jpe
+$ ! . Cleanup obsolete stuff
+$ ! . Translate comments to English
+$ ! . Although I took primary credits, I should say:
+$ ! 5 % inspiration: jpe
+$ ! 95 % transpiration: Anton van Ruitenbeek (same company)
+$ !
+$ ! others...
+$ !
+$ ! 02# 19971014 AvR
+$ ! . Total revised, add mirror checking
+$ ! 01# 970725 JPE
+$ ! . Created
+$ !
+$ !----------------------------------------------------------------------
+$ !
+$ ! > define SYSMANINI to use file which sets environment & profile
+$ ! > Get list of cluster node-names
+$ ! > Get list and type of their SYS$SYSDEVICEs
+$ ! > Determine whether they are HS devices
+$ ! > If so,
+$ ! - if shadowset use a mounted member
+$ ! - determine node serving it
+$ ! - define this node in SYSMAN$NODE_TABLE
+$ ! - use SYSMAN to SET HOST/SCSI/LOG to found disk, and get all the
+$ ! neeeded informantion
+$ ! - read the created LOG file and substract all the information and
+$ ! send mail if needed
+$ !
+$ !----------------------------------------------------------------------
+$ ! Logical:
+$ ! SYSMANINI
+$ ! Logical pointing to 'init-file' to be executed at SYSMAN activation.
+$ !
+$ ! File:
+$ ! (all in same directory as this procedure)
+$ ! MONITOR_HS.MAIL_DIS
+$ ! File containing the usernames (or distribution list of usernames)
+$ ! of receivers if mail needs to be sent
+$ ! If this file doesn't exist in current directory, SYSTEM will be used
+$ ! MONITOR_HS.A
+$ ! Temporary file containing all the information of the systemdisks
+$ ! clusterwide
+$ ! MONITOR_HS.B
+$ ! Temporary file containing the information during the
+$ ! SET HOST/SCSI/LOG
+$ ! MONITOR_HS.C
+$ ! Temporary file used for the SET HOST/SCSI/LOG command
+$ ! MONITOR_HS.LFC
+$ ! File containing 'Last Failed Codes' of the HSZ controller. The
+$ ! errorcodes in this file don't need any user action. All the other
+$ ! codes will cause a mail message
+$ ! MONITOR_HS.SYSMANINI
+$ ! File used (Logical: SYSMANINI)
+$ ! MONITOR_HS.OTHER
+$ ! File containing HSZ/HSG controllers to be checked, but not carrying
+$ ! any cluster node's system disk.
+$ ! File consists of ONE line per to-be-checked controller
+$ ! Syntax:
+$ ! ,
+$ ! eg:
+$ ! NODE_X,$1$dga321
+$ !
+$ !======================================================================
+$ !-
+$
+$ reqpriv = ("sysnam,cmkrnl,oper,phy_io,diagnose,sysprv")
+$ savepriv = f$setprv(reqpriv)
+$ if .not. f$privilege(reqpriv) then -
+goto not_privileged
+$
+$ cr[0,7] = 13
+$ esc[0,7] = 27
+$ quo[0,7] = 34
+$ say = "write sys$output"
+$ interval = "06:00:00" ! time between checks
+$ pid = f$getjpi("", "PID")
+$ this_proc = f$environment("procedure")
+$ mail_receivers = "@" + f$element(0,";",f$search(f$parse(".MAIL_DIS;0",this_proc)))
+$ if mail_receivers .eqs. "@" then -
+mail_receivers = "SYSTEM"
+$ temp_filea = f$parse(".''pid'a;0",this_proc,,,"no_conceal") - ";0"
+$ temp_fileb = f$parse(".''pid'b;0",this_proc,,,"no_conceal") - ";0"
+$ temp_filec = f$parse(".''pid'c;0",this_proc,,,"no_conceal") - ";0"
+$ other_hs = f$parse(".OTHER;0",this_proc,,,"no_conceal") - ";0"
+$ lfc_file = f$element(0,";",f$search(f$parse(".LFC;0",this_proc)))
+$ set message/nofacil/noident/nosever/text
+$
+$ cluster_loop:
+$ say esc,"[2J''esc'[H HS status at ",f$fao("!17%D",0)
+$ !+
+$ ! create file containing all the SYS$SYSDEVICE
+$ ! logicals over the whole cluster ! allow for multiple system disks
+$ !-
+$ if f$trnlnm("SYSMANINI") .nes. "" then -
+deassign sysmanini
+$ define sys$output 'temp_filea'
+$ define sys$error nl:
+$ mcr sysman
+set environment/cluster
+do write sys$output f$trnlnm("SYS$SYSDEVICE"), " => ", f$getdvi("SYS$SYSDEVICE", "DEVICE_TYPE_NAME")
+exit
+$ deassign sys$output
+$ deassign sys$error
+$
+$ define/nolog sysmanini 'f$parse(".sysmanini;0",this_proc)'
+$ device_done = ","
+$ controller_done = ","
+$ last_fail = ""
+$ if f$trnlnm("FILE_IN") .nes. "" then -
+close file_in
+$ open/read file_in 'temp_filea'
+$ loop_read:
+$ read/end_of_file=loop_read_end file_in regel
+$ pos = f$locate("on node", regel)
+$ if pos .lt. f$length(regel)
+$ then
+$ node = f$extract(pos+8, 12, regel)
+$ read/end_of_file=loop_read_1end file_in regel
+$ device = f$edit(f$element(0, "=", regel), "TRIM")
+$ hs = f$edit(f$element(1, ">", regel), "TRIM")
+$ if hs .eqs. ">"
+$ then
+$ ! do we need to report non-reachable node? May need future addition.
+$ else
+$ if f$locate(",''device',", device_done) .eq. f$length(device_done)
+$ then
+$ device_done = device_done + device + ","
+$ if f$getdvi(device, "EXISTS")
+$ then
+$ if f$locate("HSZ", hs) .lt. f$length(hs)
+$ then
+$ if f$getdvi(device, "SHDW_MASTER") then -
+device = f$getdvi(device, "SHDW_NEXT_MBR_NAME")
+$
+$ gosub controleer
+$
+$ endif
+$ else
+$ call mail_pager "HS - ''device' : Not mounted or not available." no
+$ endif
+$ endif
+$ endif
+$ endif
+$ goto loop_read
+$
+$ loop_read_end:
+$ if f$trnlnm("FILE_IN") .nes. "" then -
+close file_in
+$ if f$search(temp_filea) .nes. "" then -
+delete/nolog/noconfirm 'temp_filea';*
+$
+$ if f$search(other_hs) .nes. ""
+$ then
+$ open/read file_in 'other_hs'
+$ loop_read1:
+$ read/end_of_file=loop_read1_end file_in regel
+$ regel = f$edit(regel, "UNCOMMENT")
+$ if regel .nes. ""
+$ then
+$ node = f$element(0, ",", regel)
+$ device = f$element(1, ",", regel)
+$
+$ gosub controleer
+$
+$ endif
+$ goto loop_read1
+$ loop_read1_end:
+$ if f$trnlnm("FILE_IN") .nes. "" then -
+close file_in
+$ endif
+$
+$ wait 'interval'
+$ goto cluster_loop
+$
+$ !======================================================================
+$ ! S U B R O U T I N E S
+$ !======================================================================
+$
+$ controleer:
+$ if f$getsyi("CLUSTER_MEMBER", node)
+$ then
+$ define/nolog/table=sysman$node_table hs_host_node 'node
+$
+$ open/write file_out 'temp_filec'
+$ write file_out "$ set host/scsi/log=''temp_fileb' ''device'"
+$ write file_out "clear cli"
+$ write file_out "show this_controller"
+$ write file_out "show other_controller" ! if there is no other,
+$ ! only a message will
+$ ! be written in the logfile
+$ write file_out "show mirrorsets full" ! if there is no mirrorset,
+$ ! only a message will
+$ ! be written in the logfile
+$ write file_out "show raidsets full" ! if there is no raidset,
+$ ! only a message will
+$ ! be written in the logfile
+$ close file_out
+$
+$ define/user sys$error nl:
+$ define/user sys$output nl:
+$ mcr sysman do @'temp_filec'
+$ if f$search(temp_filec) .nes. "" then -
+delete/nolog/noconfirm 'temp_filec';*
+$
+$ name = ""
+$ m_device = ""
+$ r_device = ""
+$ if f$trnlnm("FILE1_IN") .nes. "" then -
+close file1_in
+$ open/read/error=loop_read1_error file1_in 'temp_fileb'
+$ loop_read1:
+$ read/end_of_file=loop_read1_end file1_in regel
+$ regel = f$edit(regel, "TRIM,COMPRESS") - cr
+$ if f$extract(0, 2, regel) .eqs. "HS" .and. -
+f$element(1, " ", regel) .nes. "Firmware"
+$ then
+$ type = f$element(0, " ", regel)
+$ name = f$element(1, " ", regel)
+$ if f$locate(",''name',", "''controller_done'") .eq. f$length(controller_done)
+$ then
+$ controller_done = controller_done + name + ","
+$ if f$trnlnm("''type'_''name'") .nes. "" then -
+name = f$trnlnm("''type'_''name'")
+$ if last_fail .nes. ""
+$ then
+$ !+
+$ ! Because errorcode is returned BEFORE 'name'.
+$ !
+$ !-
+$ call mail_pager "''type' - ''name' : Errorcode ''last_fail'" no
+$ last_fail = ""
+$ endif
+$ else
+$ name = ""
+$ endif
+$ endif
+$ if name .nes. ""
+$ then
+$ if f$extract(0, 3, type) .eqs. "HSZ"
+$ then
+$ if f$extract(0, 8, regel) .eqs. "Cache is"
+$ then
+$ if f$locate("GOOD", regel) .eq. f$length(regel)
+$ then
+$ call mail_pager "''type' - ''name' : ''regel'" yes
+$ regel = esc + "[5m" + regel + esc + "[m"
+$ endif
+$ say "%''type'-I-OK - ''name': ",regel
+$ endif
+$ if f$extract(0, 10, regel) .eqs. "Battery is"
+$ then
+$ if f$locate("GOOD", regel) .eq. f$length(regel)
+$ then
+$ call mail_pager "''type' - ''name' : ''regel'" yes
+$ regel = esc + "[5m" + regel + esc + "[m"
+$ endif
+$ say "%''type'-I-OK - ''name': ",regel
+$ endif
+$ else
+$ !
+$ ! Ga ervan uit, geen HSZ, dan een HSG.
+$ !
+$ if f$extract(0, 6, regel) .eqs. "Cache:"
+$ then
+$ read file1_in regel
+$ read file1_in regel
+$ regel = f$edit(regel, "TRIM,COMPRESS") - cr
+$ if f$locate("GOOD", regel) .eq. f$length(regel)
+$ then
+$ call mail_pager "''type' - ''name' : ''regel'" yes
+$ regel = esc + "[5m" + regel + esc + "[m"
+$ endif
+$ say "%''type'-I-OK - ''name': ",regel
+$ endif
+$ if f$extract(0, 9, regel) .eqs. "Battery:"
+$ then
+$ read file1_in regel
+$ read file1_in regel
+$ regel = f$edit(regel, "TRIM,COMPRESS") - cr
+$ if f$locate("FULLY CHARGED", regel) .lt. f$length(regel)
+$ then
+$ regel = "100%"
+$ else
+$ call mail_pager "''type' - ''name' : Battery ''m_device' is ''regel'" yes
+$ regel = esc + "[5m" + regel + esc + "[m"
+$ endif
+$ say "%''type'-I-OK - ''name': Battery is ",regel
+$ read file1_in regel
+$ !regel bevat " Expires: 04-JUN-2004
+"
+$ endif
+$ endif
+$ if f$extract(0, 1, regel) .eqs. "M" .and. -
+f$element(1, " ", regel) .eqs. "mirrorset"
+$ then
+$ m_device = f$element(3, " ", regel)
+$ endif
+$ if m_device .nes. "" .and. -
+f$extract(0, 6, regel) .eqs. "State:"
+$ then
+$ read file1_in regel
+$ regel = f$edit(regel, "TRIM,COMPRESS") - cr
+$ if f$locate("NORMAL", regel) .eq. f$length(regel) then -
+call mail_pager "''type' - ''name' : Mirrorset ''m_device' is ''regel'" yes
+$ m_device = ""
+$ endif
+$ if f$extract(0, 1, regel) .eqs. "R" .and. -
+f$element(1, " ", regel) .eqs. "raidset"
+$ then
+$ r_device = f$element(3, " ", regel)
+$ endif
+$ if r_device .nes. "" .and. -
+f$extract(0, 6, regel) .eqs. "State:"
+$ then
+$ read file1_in regel
+$ regel = f$edit(regel, "TRIM,COMPRESS") - cr
+$ if f$locate("NORMAL", regel) .eq. f$length(regel) then -
+call mail_pager "''type' - ''name' : Raidset ''r_device' is ''regel'" yes
+$ r_device = ""
+$ endif
+$ if f$extract(0, 11, regel) .eqs. "Error 6080:"
+$ then
+$ call mail_pager "''type' - ''name' : Other controller not running." yes
+$ endif
+$ endif
+$ goto loop_read1
+$
+$ loop_read1_error:
+$ call mail_pager "''type' - ''device' : No information for device available." no
+$
+$ loop_read1_end:
+$ if f$trnlnm("FILE1_IN") .nes. "" then -
+close file1_in
+$ if f$search(temp_fileb) .nes. "" then -
+delete/nolog/noconfirm 'temp_fileb';*
+$ endif
+$
+$ return
+$
+$ !======================================================================
+$ ! C A L L A B L E R O U T I N E S
+$ !======================================================================
+$ mail_pager: subroutine
+$ temp = f$search(temp_fileb)
+$ if temp .eqs. "" then -
+temp = "NL:"
+$ mail/subject="''p1'" 'temp' "''mail_receivers'"
+$
+$ ! Automatic semaphone call.
+$ !
+$ ! Assumes there IS a routine that pages a message. Use your own code!
+$ !
+$ if p2 then -
+@user_util:pager_oproep_zenden 010002
+$
+$ endsubroutine
+$ !======================================================================
+$ reset_privileges:
+$ dummy=f$setprv(savepriv)
+$ exit
+$
+$ not_privileged:
+$ dummy=f$setprv(savepriv) ! undo PARTIAL set !!!
+$ write sys$output -
+"%SETPRV-E-NOPRIV - Required privileges ''reqpriv' needed"
+$ exit %x24
+$
diff --git a/monitor-que-dcl b/monitor-que-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_bW9uaXRvci1xdWUtZGNs
--- /dev/null
+++ b/monitor-que-dcl
@@ -0,0 +1,536 @@
+MONITOR_QUE.COM
+Neil Sakac, Friday February 18 2005 @ 09:40AM EST
+$ saveverify = f$environment("VERIFY_PROCEDURE") !Get current value of Verify.
+$ IF saveverify THEN SET NOVERIFY !If Verify ON then turn OFF.
+$ ON Control_Y THEN GOTO ABORT_Control_Y !Set Exit if Control_Y Pressed.
+$ ON Error THEN GOTO ABORT_Error !Set Exit if Error Occurs.
+$ GOTO MAIN !Goto Label MAIN, Miss Header.
+$!
+$!****************************************************************************
+$!* MONITOR_QUE.COM *
+$!* *
+$!* Command procedure to WATCH the entries on a queue. *
+$!* Version 1.5-0 *
+$!* Created: 8nd Febuary 1990. *
+$!* Last Revised: 6th April 1992. *
+$!* *
+$!* Usage: *
+$!* $ @COMMS$DIR:monitor_que.com [Parameters] *
+$!* or *
+$!* $ MON_QUE [Parameters] *
+$!* *
+$!* Parameters: *
+$!* *
+$!* P1 = Name of the QUEUE to be Monitored. *
+$!* P2 = [<0 or 1>] Set Verify ON/OFF (Default OFF) *
+$!* *
+$!* © Written by Neil Sakac *
+$!* *
+$!****************************************************************************
+$!
+$ MAIN:
+$ GOSUB Initialize
+$ IF p2 .NES. NULL THEN SET VERIFY
+$ GOSUB GET_Valid_Queues
+$ GOSUB TITLE
+$ MONITOR_LOOP:
+$ M_que = f$element(Q_cnt,"|",Valid_queues)
+$ IF M_que .EQS. NULL .OR. M_que .EQS. "|" THEN GOTO END_MONITOR
+$ GOSUB MON_selected_que
+$ WS NULL
+$ Q_cnt = Q_cnt+1
+$ GOTO MONITOR_LOOP
+$ END_MONITOR:
+$ GOTO EXIT
+$!
+$! ROUTINE to Initialize all variables needed for Procedure
+$!
+$ Initialize:
+$
+$ BITS = 7 !Number of Bits for Chars.
+$ esc[0,BITS] = 27 !Escape character
+$ bell[0,BITS] = 7 !Bell character
+$ csi = esc+"[" !Control Sequence Introducer
+$ cls = csi+"2J"+csi+"H" !Clear Screen Sequence
+$ wide = esc+"#6" !Single width/Double Height
+$ narrow = esc+"#5" !Normal Size characters
+$ bo = csi+"1m" !Bold characters
+$ r = csi+"7m" !Reverse video characters
+$ o = csi+"0m" !Reset character attributes
+$ no = esc+"(B" !DEC Special Graphic set OFF
+$ gr = esc+"(0" !DEC Special Graphic set ON
+$ d = esc+"(0x"+esc+"(B" !Vertical Bar character
+$ tl = esc+"(0l" !Top Left corner character
+$ tr = "k"+esc+"(B" !Top Right corner character
+$ bl = esc+"(0m" !Bottom Left corner character
+$ br = "j"+esc+"(B" !Bottom Right corner character
+$ ml = esc+"(0t" !Middle Left character
+$ mr = "u"+esc+"(B" !Middle Right character
+$ m = "n" !Middle character
+$ md = "w" !Middle Down character
+$ mu = "v" !Middle Up character
+$ el = csi+"0K" !Erase to End of Line
+$ ed = csi+"0J" !Erase to End of Screen
+$ SPACE = " "
+$ NULL = ""
+$ q = "qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq"
+$ IN = "READ SYS$COMMAND"
+$ WS = "WRITE SYS$OUTPUT"
+$ fac = "%MONQUE" !Facility Name.
+$ FALSE = 0
+$ TRUE = 1
+$ POS = 1 !Default Positon String
+$ answer = NULL !Setup for Prompt
+$ logtim = NULL !Setup for Time JOB executing
+$ Valid_queues = NULL !Setup for Valid Queues.
+$ Q_cnt = 0 !Count for Selected Queue.
+$ V_cnt = 0 !Count for Valid Queues.
+$ device = f$getjpi("","TERMINAL")
+$ sw = f$integer(f$getdvi("''device'","DEVBUFSIZ"))
+$ sl = f$integer(f$getdvi("''device'","TT_PAGE"))
+$ Head2 = " Mounted Form"
+$ Head3 = "Size"
+$ Stop_MON_text = "Type or Exit to STOP, ""S"" to START."
+$ type_string = "PRINTER|BATCH|TERMINAL|GENERIC|SERVER"
+$ TITLE_txt = "QUEUE MONITOR"
+$ TITLE_len = f$length(TITLE_txt)
+$ TITLE_pad = ((sw-TITLE_len)/4)-3
+$ IF p1 .EQS. NULL
+$ THEN M_que = "SYS$PRINT"
+$ ELSE M_que = p1
+$ ENDIF
+$ IF sw .GT. 80
+$ THEN pad = f$fao("!#AS",(sw-80)/2,SPACE)
+$ ELSE pad = NULL
+$ ENDIF
+$ L1 = pad+tl+"!33AS"+md+"!31AS"+md+"!11AS"+tr+el
+$ L2 = pad+d+r+"!33AS"+o+d+r+"!31AS"+o+d+r+"!11AS"+o+d+el
+$ L3 = pad+d+"!33AS"+d+"!31AS"+d+"!11AS"+d+el
+$ L4 = pad+ml+"!33AS"+mu+"!31AS"+mu+"!11AS"+mr+el
+$ L5 = pad+d+"!77AS"+d+el
+$ L6 = pad+ml+"!41AS"+md+"!6AS"+md+"!5AS"+md+"!22AS"+mr+el
+$ L7 = pad+d+r+"!41AS"+o+d+r+"!6AS"+o+d+r+"!5AS"+o+d+r+"!22AS"+o+d+el
+$ L8 = pad+d+"!41AS"+d+"!6SL"+d+"!5SL"+d+"!22AS"+d+el
+$ L9 = pad+bl+"!41AS"+mu+"!6AS"+mu+"!5AS"+mu+"!22AS"+br+el
+$ L0 = pad+f$fao("!15AS",SPACE)+Stop_MON_text+el+ed
+$
+$ RETURN
+$!
+$! ROUTINE to DISPLAY the TITLE of the procedure at the top of the screen.
+$!
+$ TITLE:
+$ WS esc+"7"+csi+f$str(POS)+";"+f$str(sl)+"r"+cls+-
+wide+f$fao("!#AS!#AS",TITLE_pad,SPACE,TITLE_len,TITLE_txt)+el
+$ RETURN
+$!
+$! ROUTINE to GET valid Queues.
+$!
+$ GET_Valid_Queues:
+$ V_que = f$getqui("DISPLAY_QUEUE","QUEUE_NAME",M_que,"WILDCARD")
+$ IF V_que .EQS. NULL THEN GOTO END_Valid_Queues
+$ Valid_queues = Valid_queues+V_que+"|"
+$ V_cnt = V_cnt+1
+$ GOTO GET_Valid_Queues
+$ END_Valid_Queues:
+$ IF f$element(0,"|",Valid_queues) .EQS. NULL
+$ THEN qstatus = f$getqui("CANCEL_OPERATION")
+$ msg_txt = "INVQUE, Invalid Queue, "+M_que+" NOT found on System."
+$ GOTO ABORT_Message
+$ ENDIF
+$ RETURN
+$!
+$! ROUTINE to DO the Monitoring off the Selected Queue.
+$!
+$ MON_selected_que:
+$
+$ qstatus = f$getqui("CANCEL_OPERATION")
+$ WS csi+f$str(POS+9)+";"+f$str(sl)+"r"+csi+f$str(POS+1)+"H"+ed
+$ MON_Q_loop:
+$ WS csi+f$str(POS+1)+"H"
+$ Q_stat'Q_cnt' = f$getqui("DISPLAY_QUEUE","QUEUE_STATUS",M_que)
+$ Stat_title = "QUEUE"
+$ GOSUB Get_QUEUE_type
+$ GOSUB Get_STATUS_text
+$ Q_form'Q_cnt' = f$getqui("DISPLAY_QUEUE","FORM_NAME",M_que)
+$ Q_stock'Q_cnt'= f$getqui("DISPLAY_QUEUE","FORM_STOCK",M_que)
+$ IF f$length(Q_form'Q_cnt') .LE. 15
+$ THEN Q_form'Q_cnt' = Q_form'Q_cnt'+",stock="+Q_stock'Q_cnt'
+$ ENDIF
+$ Q_desc'Q_cnt' = f$getqui("DISPLAY_QUEUE","QUEUE_DESCRIPTION",M_que)
+$ IF Q_desc'Q_cnt' .NES. NULL
+$ THEN Q_name = M_que+"<"+Q_desc'Q_cnt'+">"
+$ ELSE Q_name = M_que
+$ ENDIF
+$ IF f$length(Q_name) .LE. 20
+$ THEN Q_name = f$extract(0,1,Q_type'Q_cnt')+f$edit(f$extract(1, -
+f$length(Q_type'Q_cnt'),Q_type'Q_cnt'), -
+"LOWERCASE")+" que "+Q_name
+$ ENDIF
+$ IF Q_type'Q_cnt' .EQS. "BATCH"
+$ THEN
+$ Head2 = NULL
+$ Head3 = "Prior"
+$ Q_priority = f$getqui("DISPLAY_QUEUE","BASE_PRIORITY",M_que)
+$ Q_node'Q_cnt' = f$getqui("DISPLAY_QUEUE","SCSNODE_NAME",M_que)
+$ Q_form'Q_cnt' = " Batch Queue on Node " + Q_node'Q_cnt' + "::"
+$ ENDIF
+$ Q_device = f$getqui("DISPLAY_QUEUE","DEVICE_NAME",M_que)
+$ IF Q_device .NES. NULL
+$ THEN Q_node = f$getqui("DISPLAY_QUEUE","SCSNODE_NAME",M_que)
+$ Q_lat = "/Device="+Q_node+"::"+Q_device
+$ ELSE Q_lat = NULL
+$ ENDIF
+$ Q_processor = f$getqui("DISPLAY_QUEUE","PROCESSOR",M_que)
+$ IF Q_processor .NES. NULL THEN Q_processor = "/Processor="+Q_processor
+$ Q_library = f$getqui("DISPLAY_QUEUE","LIBRARY_SPECIFICATION",M_que)
+$ IF Q_library .NES. NULL THEN Q_library = "/Library="+Q_library
+$ Q_owner = f$getqui("DISPLAY_QUEUE","OWNER_UIC",M_que)
+$ IF Q_owner .NES. NULL THEN Q_owner = "/Owner="+Q_owner
+$ Q_generic = f$getqui("DISPLAY_QUEUE","GENERIC_TARGET",M_que)
+$ IF Q_generic .NES. NULL THEN Q_generic = "/Generic="+Q_generic
+$ WS f$fao(L1,q,q,q)
+$ WS f$fao(L2," Queue Name",Head2," Status")
+$ WS f$fao(L3,Q_name,Q_form'Q_cnt',Q_stat'Q_cnt')
+$ WS f$fao(L4,q,q,q)
+$ WS f$fao(L5,Q_lat+Q_processor+Q_library+Q_owner+Q_generic)
+$ WS f$fao(L6,q,q,q,q)
+$ WS f$fao(L7," Job Name","Entry",Head3," Status")
+$ J_cnt = 0
+$ ret_name = f$getqui("DISPLAY_QUEUE","QUEUE_NAME",M_que,"WILDCARD")
+$
+$ MON_J_loop:
+$ J_cnt = J_cnt + 1
+$ J_entry'J_cnt' = f$getqui("DISPLAY_JOB","ENTRY_NUMBER",,"ALL_JOBS")
+$ IF J_entry'J_cnt' .NES. NULL THEN GOTO MON_J_loop
+$ J_cnt = 0
+$
+$ MON_J_loop_cont:
+$ mon_FLAG = TRUE
+$ J_cnt = J_cnt + 1
+$ J_name'J_cnt' = f$getqui("DISPLAY_ENTRY","JOB_NAME",J_entry'J_cnt')
+$ J_note'J_cnt' = f$getqui("DISPLAY_ENTRY","NOTE",J_entry'J_cnt')
+$ J_user'J_cnt' = f$getqui("DISPLAY_ENTRY","USERNAME",J_entry'J_cnt')
+$ IF J_note'J_cnt' .NES. NULL .AND. J_name'J_cnt' .NES. NULL
+$ THEN J_name'J_cnt' = J_name'J_cnt'+"("+J_note'J_cnt'+")"
+$ ENDIF
+$ IF f$length(J_name'J_cnt') .LE. 26 .AND. J_name'J_cnt' .NES. NULL
+$ THEN J_name'J_cnt' = J_name'J_cnt'+"-["+J_user'J_cnt'+"]"
+$ ENDIF
+$ IF Q_type'Q_cnt' .EQS. "BATCH"
+$ THEN J_size'J_cnt'=Q_priority
+$ ELSE J_size'J_cnt'=f$getqui("DISPLAY_ENTRY","JOB_SIZE",J_entry'J_cnt')
+$ ENDIF
+$ J_stat'J_cnt' = f$getqui("DISPLAY_ENTRY","JOB_STATUS",J_entry'J_cnt')
+$ Stat_title = "JOB"
+$ GOSUB Get_STATUS_text
+$ IF J_name'J_cnt' .EQS. NULL
+$ THEN
+$ IF J_cnt .EQ. 1
+$ THEN
+$ J_name'J_cnt' = " NO JOBS in Queue"
+$ WS f$fao(L8,J_name'J_cnt',J_entry'J_cnt',J_size'J_cnt',J_stat'J_cnt')
+$ mon_FLAG = FALSE
+$ ELSE
+$ mon_FLAG = FALSE
+$ ENDIF
+$ ELSE
+$ WS f$fao(L8,J_name'J_cnt',J_entry'J_cnt',J_size'J_cnt',J_stat'J_cnt')
+$ ENDIF
+$ IF mon_FLAG THEN GOTO MON_J_loop_cont
+$ WS f$fao(L9,q,q,q,q)
+$ IN/PROMPT="''L0'"/END=Exit_MON_loop/TIME_OUT=3 answer/ERROR=Timed_OUT
+$ Timed_OUT:
+$ qstatus = f$getqui("CANCEL_OPERATION")
+$ IF f$edit(f$extr(0,1,answer),"UPCASE") .EQS. "E" THEN GOTO Exit_MON_loop
+$ IF f$edit(f$extr(0,1,answer),"UPCASE") .EQS. "S" THEN GOSUB START_queue
+$ answer = NULL
+$ GOTO MON_Q_loop
+$ Exit_MON_loop:
+$ WS no+o+csi+f$str(POS+10)+"H"
+$ RETURN
+$!
+$! ROUTINE to Get the STATUS of either the JOB or the QUEUE.
+$!
+$ Get_STATUS_text:
+$ IF Stat_title .EQS. "JOB"
+$ THEN
+$ block = f$getqui("DISPLAY_ENTRY","COMPLETED_BLOCKS",J_entry'J_cnt')
+$ IF J_stat'J_cnt' .EQ. 0 THEN T_stat'J_cnt' = "**********************"
+$ IF J_stat'J_cnt' .GE. 1 THEN T_stat'J_cnt' = "Aborting"
+$ IF J_stat'J_cnt' .GE. 2
+$ THEN
+$ T_stat'J_cnt' = "Started"
+$ IF Q_type'Q_cnt' .EQS. "BATCH"
+$ THEN GOSUB Calc_Connect_Time
+$ T_stat'J_cnt' = "Executing " + logtim
+$ ENDIF
+$ IF Q_type'Q_cnt' .EQS. "PRINTER" .OR. -
+Q_type'Q_cnt' .EQS. "TERMINAL" .OR. -
+Q_type'Q_cnt' .EQS. "OUTPUT" .OR. -
+Q_type'Q_cnt' .EQS. "SERVER" .OR. -
+Q_type'Q_cnt' .EQS. "UNKNOWN"
+$ THEN T_stat'J_cnt' = "Printing block "+f$str(block)
+$ ENDIF
+$ ENDIF
+$ IF J_stat'J_cnt' .GE. 4 THEN T_stat'J_cnt' = "Holding"
+$ IF J_stat'J_cnt' .GE. 8
+$ THEN T_stat'J_cnt' = "Inaccessible"
+$ IF J_name'J_cnt' .EQS. NULL
+$ THEN J_name'J_cnt' = " ** No Privilege **"
+$ ENDIF
+$ ENDIF
+$ IF J_stat'J_cnt' .GE. 16 THEN T_stat'J_cnt' = "Refused"
+$ IF J_stat'J_cnt' .GE. 32 THEN T_stat'J_cnt' = "Requeue"
+$ IF J_stat'J_cnt' .GE. 64
+$ THEN IF block .GT. 0
+$ THEN T_stat'J_cnt' = "Restart at block "+f$str(block)
+$ ELSE T_stat'J_cnt' = "Restarting"
+$ ENDIF
+$ ENDIF
+$ IF J_stat'J_cnt' .GE. 128
+$ THEN err = f$getqui("DISPLAY_ENTRY","CONDITION_VECTOR",J_entry'J_cnt')
+$ T_stat'J_cnt' = "Retain Err"+f$elem(1,",",f$message("%X''err'"))
+$ ENDIF
+$ IF J_stat'J_cnt' .GE. 256 THEN T_stat'J_cnt' = "Starting"
+$ IF J_stat'J_cnt' .GE. 512
+$ THEN hold_time = f$getqui("DISPLAY_ENTRY","AFTER_TIME",J_entry'J_cnt')
+$ T_stat'J_cnt' = "Held "+hold_time
+$ ENDIF
+$ IF J_stat'J_cnt' .GE. 1024 THEN T_stat'J_cnt' = "Suspended"
+$ IF J_stat'J_cnt' .GE. 2048
+$ THEN IF block .GT. 0
+$ THEN T_stat'J_cnt' = "Pending at block "+f$str(block)
+$ ELSE GOSUB Get_Pending_Reason
+$ T_stat'J_cnt' = "Pending "+reason
+$ ENDIF
+$ ENDIF
+$ J_stat'J_cnt' = T_stat'J_cnt'
+$ ENDIF
+$ IF Stat_title .EQS. "QUEUE"
+$ THEN
+$ IF Q_stat'Q_cnt' .EQ. 0 THEN T_stat'Q_cnt' = "Started"
+$ IF Q_stat'Q_cnt' .GE. 1 THEN T_stat'Q_cnt' = "Aligning"
+$ IF Q_stat'Q_cnt' .GE. 2 THEN T_stat'Q_cnt' = "Idle"
+$ IF Q_stat'Q_cnt' .GE. 4 THEN T_stat'Q_cnt' = "Lowercase"
+$ IF Q_stat'Q_cnt' .GE. 8 THEN T_stat'Q_cnt' = "Operator_request"
+$ IF Q_stat'Q_cnt' .GE. 16 THEN T_stat'Q_cnt' = "Paused"
+$ IF Q_stat'Q_cnt' .GE. 32 THEN T_stat'Q_cnt' = "Pausing"
+$ IF Q_stat'Q_cnt' .GE. 64 THEN T_stat'Q_cnt' = "Remote"
+$ IF Q_stat'Q_cnt' .GE. 128 THEN T_stat'Q_cnt' = "Resetting"
+$ IF Q_stat'Q_cnt' .GE. 256 THEN T_stat'Q_cnt' = "Resuming"
+$ IF Q_stat'Q_cnt' .GE. 512 THEN T_stat'Q_cnt' = "Server"
+$ IF Q_stat'Q_cnt' .GE. 1024 THEN T_stat'Q_cnt' = "Stalled"
+$ IF Q_stat'Q_cnt' .GE. 2048 THEN T_stat'Q_cnt' = "Starting"
+$ IF Q_stat'Q_cnt' .GE. 4096 THEN T_stat'Q_cnt' = "Stopped"
+$ IF Q_stat'Q_cnt' .EQ. 4096 THEN T_stat'Q_cnt' = "Stop Pend"
+$ IF Q_stat'Q_cnt'-1024 .EQ. 4096
+$ THEN T_stat'Q_cnt' = "Stall Pend"
+$ ENDIF
+$ IF Q_stat'Q_cnt' .GE. 8192 THEN T_stat'Q_cnt' = "Stopping"
+$ IF Q_stat'Q_cnt' .GE. 16384 THEN T_stat'Q_cnt' = "Unavailable"
+$ IF Q_stat'Q_cnt' .GE. 32768
+$ THEN
+$ IF Q_type'Q_cnt' .EQS. "BATCH"
+$ THEN T_stat'Q_cnt' = "Available "
+$ ELSE T_stat'Q_cnt' = "Busy "
+$ ENDIF
+$ ENDIF
+$ Q_stat'Q_cnt' = T_stat'Q_cnt'
+$ ENDIF
+$ RETURN
+$!
+$! ROUTINE to GET the Pending Reason.
+$!
+$ Get_Pending_Reason:
+$ reason_num = f$getqui("DISPLAY_ENTRY","PENDING_JOB_REASON",J_entry'J_cnt')
+$ reason = NULL
+$ IF reason_num .GE. 1 THEN reason = "Char Mismatch"
+$ IF reason_num .GE. 2 THEN reason = "Job Size Max"
+$ IF reason_num .GE. 4 THEN reason = "Job Size Min"
+$ IF reason_num .GE. 8 THEN reason = "Lower Mismatch"
+$ IF reason_num .GE. 16 THEN reason = "NO Access"
+$ IF reason_num .GE. 32 THEN reason = "Queue Busy"
+$ IF reason_num .GE. 64 THEN reason = "Queue State"
+$ IF reason_num .GE. 128 THEN reason = "Stock Mismatch"
+$ RETURN
+$!
+$! ROUTINE to Get the TYPE of Queue that was Selected.
+$!
+$ Get_QUEUE_type:
+$ Unknown_FLAG = TRUE
+$ type_cnt = 0
+$ Type_LOOP:
+$ type_txt = f$element(type_cnt,"|",type_string)
+$ IF type_txt .EQS. "|" THEN GOTO End_Type_LOOP
+$ Q_type = f$getqui("DISPLAY_QUEUE","QUEUE_''type_txt'",M_que)
+$ IF Q_type .EQS. "TRUE"
+$ THEN Q_type'Q_cnt' = type_txt
+$ Unknown_FLAG = FALSE
+$ ENDIF
+$ type_cnt = type_cnt + 1
+$ GOTO Type_LOOP
+$ End_Type_LOOP:
+$ IF Unknown_FLAG THEN Q_type'Q_cnt' = "UNKNOWN"
+$ RETURN
+$!
+$! ROUTINE to Calculate the Execution Time of the Batch JOB if Privileged.
+$!
+$ Calc_Connect_Time:
+$ oldlogtim = logtim
+$ user_uic = f$user()
+$ job_uic = f$getqui("DISPLAY_ENTRY","UIC" ,J_entry'J_cnt')
+$ job_pid = f$getqui("DISPLAY_ENTRY","JOB_PID" ,J_entry'J_cnt')
+$ IF user_uic .EQS. job_uic THEN GOTO Execute_TIME
+$ IF f$priv("WORLD") .EQS. "TRUE" THEN GOTO Execute_TIME
+$ user_grp = f$element(0,",",user_uic)
+$ job_grp = f$element(0,",",job_uic)
+$ logtim = NULL
+$ IF user_grp .NES. job_grp THEN RETURN
+$ IF f$priv("GROUP") .EQS. "TRUE" THEN GOTO Execute_TIME
+$ RETURN
+$
+$ Execute_TIME:
+$ logintim = f$cvtime(f$getjpi(job_pid,"LOGINTIM"),"ABSOLUTE","DATETIME")
+$ lsecond = f$cvtime(logintim,,"SECOND")
+$ lminute = f$cvtime(logintim,,"MINUTE")
+$ lhour = f$cvtime(logintim,,"HOUR")
+$ lday = f$cvtime(logintim,,"DAY")
+$ currtim = f$cvtime(,"ABSOLUTE","DATETIME")
+$ csecond = f$cvtime(currtim,,"SECOND")
+$ cminute = f$cvtime(currtim,,"MINUTE")
+$ chour = f$cvtime(currtim,,"HOUR")
+$ cday = f$cvtime(currtim,,"DAY")
+$ tlsecond = (lday*86400)+(lhour*3600)+(lminute*60)+lsecond
+$ tcsecond = (cday*86400)+(chour*3600)+(cminute*60)+csecond
+$ totsec = tcsecond-tlsecond
+$ logday = f$str(f$fao("!2ZL",totsec/86400))
+$ totsec = totsec-(logday*86400)
+$ loghour = f$str(f$fao("!2ZL",totsec/3600))
+$ totsec = totsec-(loghour*3600)
+$ logmin = f$str(f$fao("!2ZL",totsec/60))
+$ totsec = totsec-(logmin*60)
+$ logsec = f$str(f$fao("!2ZL",totsec))
+$ logtim = logday+" "+loghour+":"+logmin+":"+logsec
+$ IF oldlogtim .NES. NULL
+$ THEN IF f$edit(logtim,"TRIM") .EQS. "0 00:00:00" THEN logtim = oldlogtim
+$ ENDIF
+$ RETURN
+$!
+$! ROUTINE to ABORT when ERROR encountered and show error message.
+$!
+$ START_queue:
+$ IF q_stat'Q_cnt' .EQS. "Stopped" .OR. -
+q_stat'Q_cnt' .EQS. "Stopping" .OR. -
+q_stat'Q_cnt' .EQS. "Paused" .OR. -
+q_stat'Q_cnt' .EQS. "Pausing" .OR. -
+q_stat'Q_cnt' .EQS. "Stop Pend" .OR. -
+q_stat'Q_cnt' .EQS. "Stalled"
+$ THEN GOSUB DO_START_queue
+$ ELSE WS fac+"-I-NOSTART, Queue "+M_que+" in "+q_stat'Q_cnt'+-
+" status, Cannot Re-start."
+$ ENDIF
+$ RETURN
+$!
+$! ROUTINE to Calculate the Execution Time of the Batch JOB if Privileged.
+$!
+$ DO_START_queue:
+$ user_uic = f$user()
+$ job_uic = f$getqui("DISPLAY_ENTRY","UIC" ,J_entry'J_cnt')
+$ job_pid = f$getqui("DISPLAY_ENTRY","JOB_PID" ,J_entry'J_cnt')
+$ IF user_uic .EQS. job_uic THEN GOTO Privileged_START
+$! IF f$priv("WORLD") .EQS. "TRUE" THEN GOTO Privileged_START
+$ IF f$priv("SYSPRV") .EQS. "TRUE" THEN GOTO Privileged_START
+$ user_grp = f$element(0,",",user_uic)
+$ job_grp = f$element(0,",",job_uic)
+$ IF user_grp .NES. job_grp THEN WS fac+"-I-NOPRIV, NO privilege to Start "+M_que
+$ IF user_grp .NES. job_grp THEN RETURN
+$ IF f$priv("GROUP") .EQS. "TRUE" THEN GOTO Privileged_START
+$ WS fac+"-I-NOPRIV, NO privilege to start "+M_que
+$ RETURN
+$
+$ Privileged_START:
+$ ON Error THEN GOTO START_ERROR !Set trap if Error Occurs.
+$ STOP/QUEUE/RESET 'M_que'
+$ START/QUEUE 'M_que'
+$ WS fac+"-I-RESTARTQUE, Queue "+M_que+" Re-started"
+$ GOTO STARTED_OK
+$ START_ERROR:
+$ sts = f$message($STATUS)
+$ error_msg = f$element(1,",",sts)
+$ WS fac+"-F-RESTARTFAIL, Restart failure ("+error_msg+")"
+$ STARTED_OK:
+$ ON Error THEN GOTO ABORT_Error !Set Exit if Error Occurs.
+$ RETURN
+$!
+$! ROUTINE to ABORT when ERROR encountered and show error message.
+$!
+$ ABORT_Error:
+$ sts = f$message($STATUS)
+$ error_msg = f$extract(f$locate("-",sts),f$length(sts),sts)
+$ WS fac + error_msg
+$ WS NULL
+$ GOTO EXIT
+$!
+$! ROUTINE to ABORT with an error message.
+$!
+$ ABORT_Message:
+$ WS esc+"7"+fac+"-F-"+msg_txt
+$ WS NULL
+$ GOTO EXIT
+$!
+$! ROUTINE to ABORT via CONTROL_Y and reset queues.
+$!
+$ ABORT_Control_Y:
+$ WS fac+"-W-Control_Y, ABORTING Procedure"
+$!
+$! ROUTINE to EXIT from procedure and RESET screen.
+$!
+$ EXIT:
+$ WS o+no+csi+"0;"+f$str(sl)+"r"+csi+""+f$str(sl-1)+"H"+esc+"8" !Reset Screen characteristics.
+$ IF p2 .NES. NULL THEN SET NOVERIFY !Switch Verify OFF.
+$ oldverify = F$VERIFY(saveverify) !Reset Verify to initial state.
+$ EXIT !Exit procedure.
+$ !
+$ !**********************************************************************
+$ ! *
+$ ! Modification History *
+$ ! *
+$ !---------------------------------------------------------------------*
+$ ! Date Name Reason (in full) *
+$ !---------------------------------------------------------------------*
+$ ! *
+$ ! 16_Feb_1990 Neil Sakac Create *
+$ ! 13_Mar_1990 Neil Sakac Added Routine to Determine STATUS of *
+$ ! jobs or queues. *
+$ ! 13_Mar_1990 Neil Sakac Added Routine to get QUEUE TYPE. *
+$ ! 23_Apr_1990 Neil Sakac Added Routine to display TITLE on screen*
+$ ! and detect if 132 or 80 Columns. *
+$ ! 17_Jul_1990 Neil Sakac Added Routine to display Connected Time *
+$ ! in Minutes and Seconds for executing *
+$ ! batch jobs. *
+$ ! 10_Sep_1990 Neil Sakac Removed Control_Y Abort and added Text *
+$ ! Exit or Control_Z Exit. *
+$ ! 13_Sep_1990 Neil Sakac Changed "" for NULL. *
+$ ! 18_Sep_1990 Neil Sakac Added BASE PRIORITY for BATCH Queue's. *
+$ ! 12_Oct_1990 Neil Sakac Modified ROUTINE for the queue status *
+$ ! to detect a Stop Pending queue status. *
+$ ! 29_Nov_1990 Neil Sakac Restructured code to make understanding *
+$ ! what is happening easier. *
+$ ! 07_Dec_1990 Neil Sakac Added NOTE recognition for Jobs and *
+$ ! Queue Name validation. *
+$ ! 21_Jun_1991 Neil Sakac Added UNKNOWN option for queue types *
+$ ! that F$GETQUI doesn't cover, eg. OUTPUT *
+$ ! queues. *
+$ ! 21_Jun_1991 Neil Sakac Added Wildcard Queue routine for *
+$ ! monitoring multiple queues. *
+$ ! 18_Nov_1991 Neil Sakac Added Routine to START selected queue *
+$ ! if stopped. *
+$ ! 29_Nov_1991 Neil Sakac Fixed Routine to Calculate the execute *
+$ ! time for a batch job. *
+$ ! 21_Jan_1992 Neil Sakac Added Routine to Get Pending Reason. *
+$ ! 06_Apr_1992 Neil Sakac Added Extra Lines to give information *
+$ ! about LIBRARY, PROCESSOR, DEVICE and *
+$ ! OWNER. *
+$ ! *
+$ !**********************************************************************
+
diff --git a/monitor-queues-dcl b/monitor-queues-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_bW9uaXRvci1xdWV1ZXMtZGNs
--- /dev/null
+++ b/monitor-queues-dcl
@@ -0,0 +1,353 @@
+Monitor_queues.com
+Henk van Dorp, Monday September 06 2004 @ 03:24PM EDT
+$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+$! File: MCL_ROOT:[COM]MONITOR_QUEUES.COM
+$!
+$! Purpose: Monitoring de queues op soorten entries
+$! Naast een totaaloverzicht (default) kan ook een
+$! overzicht worden gemaakt per status:
+$! - Executing
+$! - Timed Release
+$! - Hold
+$! - Retained
+$! - Pending
+$!
+$! Author: Henk van Dorp
+$!
+$! Date: 24-may-2004
+$!
+$! Parameters: P1 Seconden wachttijd van loop-interval
+$! default 5 sec
+$! P2 C(ompact)(default)
+$! A(ll)
+$! E(xecuting)
+$! T(imed)
+$! R(etained)
+$! H(old)
+$! P(ending)
+$!
+$! Priveleges: OPER
+$!
+$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+$! Updates
+$!
+$! 001
+$! 22-jun-2004 J.H. van Dorp
+$! Monitoren uitgebreid naar per status
+$!
+$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+$!
+$ say := write sys$output
+$!
+$! **************************************************************
+$! * Check de privileges *
+$! **************************************************************
+$!
+$ cur_prv = f$getjpi("","PROCPRIV")
+$ req_prv = "NETMBX,TMPMBX,OPER,WORLD"
+$ new_prv = f$setprv("NOALL,''req_prv'")
+$!
+$ if .not. f$privilege("''req_prv'")
+$ then
+$ say "''facility'-E-NOPRN, Required privileges are ''req_prv'"
+$ exit %X28
+$ endif
+$!
+$! **************************************************************
+$! * Check de parameters *
+$! **************************************************************
+$!
+$ if p1 .eqs. "" then p1 = 5
+$!
+$ view := "COMPACT"
+$ begin:
+$ p2 = f$edit(p2,"collapse,upcase")
+$ if p2 .eqs. "C" then view := "COMPACT"
+$ if p2 .eqs. "A" then view := "ALL"
+$ if p2 .eqs. "E" then view := "EXECUTING"
+$ if p2 .eqs. "T" then view := "TIMED"
+$ if p2 .eqs. "R" then view := "RETAINED"
+$ if p2 .eqs. "H" then view := "HOLD"
+$ if p2 .eqs. "P" then view := "PENDING"
+$!
+$! **************************************************************
+$! * Maak de header van het scherm *
+$! **************************************************************
+$!
+$ say scherm_schoon + cursor_home
+$ say f$fao("!25* !24AS","''f$time()'")
+$ if view .eqs. "COMPACT" .or. -
+view .eqs. "ALL"
+$ then
+$ say f$fao("!30AS!8AS!8AS!8AS!8AS!8AS", -
+"Queue name","Exec","Pend","Timed","Hold","Error")
+$ say f$fao("!79*=")
+$ else
+$ say f$fao("!6AS!1AS!25AS!1AS!12AS!1AS!18AS!1AS!13AS!1AS", -
+"Entry","|","Jobname","|","User","|","Queue","|","Time","|")
+$ say f$fao("!79*=")
+$ endif
+$!
+$! **************************************************************
+$! * Initialiseer de getqui-routine en loop alle queues af *
+$! **************************************************************
+$!
+$ qcancel = f$getqui("CANCEL_OPERATION")
+$loop_queue:
+$ qname = f$getqui("DISPLAY_QUEUE", -
+"QUEUE_NAME", -
+"*",)
+$!
+$! **************************************************************
+$! * Reset de counters van de queue *
+$! **************************************************************
+$!
+$ q_execut = 0
+$ q_retain = 0
+$ q_pendin = 0
+$ q_timed = 0
+$ q_hold = 0
+$!
+$! **************************************************************
+$! * Als symbol qname leeg is zijn alle queues doorlopen *
+$! **************************************************************
+$!
+$ if qname .eqs. "" then goto ENDLOOP_QUEUE
+$!
+$! **************************************************************
+$! * Ga voor elke job in de queue na welke status de job heeft *
+$! * en ga de benodigde gegevens ophalen als jobname, entrienr, *
+$! * useraccount en tijd gerelateerde gegevens. *
+$! **************************************************************
+$!
+$LOOP_JOB:
+$!
+$! **************************************************************
+$! * vraag de status van de job op. *
+$! **************************************************************
+$!
+$ job_stat = f$getqui("DISPLAY_JOB", -
+"JOB_STATUS", -
+, -
+"ALL_JOBS")
+$!
+$! **************************************************************
+$! * vraag de naam van de job op. Indien de job door de *
+$! * scheduler is gesubmit, dient de prefix "SCHEDULER_" eraf *
+$! * gehaald te worden. *
+$! **************************************************************
+$!
+$ job_name = f$getqui("DISPLAY_JOB", -
+"JOB_NAME", -
+, -
+"FREEZE_CONTEXT")
+$ if f$locate("SCHEDULER_",job_name) .eq. 0
+$ then
+$ job_name = job_name - "SCHEDULER_"
+$ endif
+$!
+$! **************************************************************
+$! * vraag het entrienummer van de job op. *
+$! **************************************************************
+$!
+$ job_entry = f$getqui("DISPLAY_JOB", -
+"ENTRY_NUMBER", -
+, -
+"FREEZE_CONTEXT")
+$!
+$! **************************************************************
+$! * vraag de user van de job op. *
+$! **************************************************************
+$!
+$ job_user = f$getqui("DISPLAY_JOB", -
+"USERNAME", -
+, -
+"FREEZE_CONTEXT")
+$!
+$! **************************************************************
+$! * verwerk nu afhankelijk van de jobstatus de gegevens *
+$! **************************************************************
+$!
+$ if job_stat .eq 2
+$ then
+$ q_execut = q_execut + 1
+$ if view .eqs. "EXECUTING"
+$ then
+$!
+$! **************************************************************
+$! * bepaal nu de tijd dat deze job al loopt. *
+$! **************************************************************
+$!
+$ job_pid = f$getqui("DISPLAY_JOB", -
+"JOB_PID", -
+, -
+"FREEZE_CONTEXT")
+$ proc_login = f$getjpi(job_pid,"logintim")
+$ proc_exec = f$delta_time(proc_login,f$time())
+$ say f$fao("!6SL!1AS!25AS!1AS!12AS!1AS!15AS!1AS!16AS!1AS", -
+job_entry," ",job_name," ",job_user," ",qname," ",proc_exec," ")
+$ endif
+$ endif
+$!
+$ if job_stat .eq 4
+$ then
+$ q_hold = q_hold + 1
+$ if view .eqs. "HOLD"
+$ then
+$!
+$! **************************************************************
+$! * bepaal nu de tijd dat deze job gesubmit is. *
+$! **************************************************************
+$!
+$ proc_exec = f$getqui("DISPLAY_JOB", -
+"SUBMISSION_TIME", -
+, -
+"FREEZE_CONTEXT")
+$ proc_time = f$extract(0,6,proc_exec) + -
+" " + -
+f$extract(11,6,proc_exec)
+$ say f$fao("!6SL!1AS!25AS!1AS!12AS!1AS!18AS!1AS!14AS!1AS", -
+job_entry," ",job_name," ",job_user," ",qname," ",proc_time," ")
+$ endif
+$ endif
+$!
+$ if job_stat .eq 128
+$ then
+$ q_retain = q_retain + 1
+$ if view .eqs. "RETAINED"
+$ then
+$!
+$! **************************************************************
+$! * bepaal nu de tijd dat deze job stukgelopen is *
+$! **************************************************************
+$!
+$ proc_exec = f$getqui("DISPLAY_JOB", -
+"JOB_COMPLETION_TIME", -
+, -
+"FREEZE_CONTEXT")
+$ proc_time = f$extract(0,6,proc_exec) + -
+" " + -
+f$extract(11,6,proc_exec)
+$ say f$fao("!6SL!1AS!25AS!1AS!12AS!1AS!18AS!1AS!14AS!1AS", -
+job_entry," ",job_name," ",job_user," ",qname," ",proc_time," ")
+$ endif
+$ endif
+$!
+$ if job_stat .eq 512
+$ then
+$ q_timed = q_timed + 1
+$ if view .eqs. "TIMED"
+$ then
+$!
+$! **************************************************************
+$! * bepaal nu de tijd dat deze job moet gaan lopen *
+$! **************************************************************
+$!
+$ proc_exec = f$getqui("DISPLAY_JOB", -
+"AFTER_TIME", -
+, -
+"FREEZE_CONTEXT")
+$ proc_time = f$extract(0,6,proc_exec) + -
+" " + -
+f$extract(11,6,proc_exec)
+$ say f$fao("!6SL!1AS!25AS!1AS!12AS!1AS!18AS!1AS!14AS!1AS", -
+job_entry," ",job_name," ",job_user," ",qname," ",proc_time," ")
+$ endif
+$ endif
+$!
+$ if job_stat .eq 2048
+$ then
+$ q_pendin = q_pendin + 1
+$ if view .eqs. "TIMED"
+$ then
+$!
+$! **************************************************************
+$! * bepaal nu de tijd dat deze job had moeten lopen. *
+$! **************************************************************
+$!
+$ proc_exec = f$getqui("DISPLAY_JOB", -
+"SUBMISSION_TIME", -
+, -
+"FREEZE_CONTEXT")
+$ proc_time = f$extract(0,6,proc_exec) + -
+" " + -
+f$extract(11,6,proc_exec)
+$ say f$fao("!6SL!1AS!25AS!1AS!12AS!1AS!18AS!1AS!14AS!1AS", -
+job_entry," ",job_name," ",job_user," ",qname," ",proc_time," ")
+$ endif
+$ endif
+$!
+$ if job_name .nes. ""
+$ then
+$ goto loop_job
+$ endif
+$!
+$! **************************************************************
+$! * Schrijf de resultaten naar het scherm bij de COMPACT en *
+$! * ALL overzichten.
+$! * indien compacte view dan skippen indien queue leeg is. *
+$! **************************************************************
+$!
+$ if (q_execut .eq. 0) .and. -
+(q_pendin .eq. 0) .and. -
+(q_timed .eq. 0) .and. -
+(q_hold .eq. 0) .and. -
+(q_retain .eq. 0) .and. -
+(view .eqs. "COMPACT") then goto loop_queue
+$!
+$! **************************************************************
+$! * Haal nullen weg door puntjes *
+$! **************************************************************
+$!
+$ if q_execut .eq. 0 then q_execut := "....."
+$ if q_pendin .eq. 0 then q_pendin := "....."
+$ if q_timed .eq. 0 then q_timed := "....."
+$ if q_hold .eq. 0 then q_hold := "....."
+$ if q_retain .eq. 0 then q_retain := "....."
+$!
+$! **************************************************************
+$! * schrijf de output naar het scherm *
+$! **************************************************************
+$!
+$ if view .eqs. "ALL" .or. -
+view .eqs. "COMPACT"
+$ then
+$ say f$fao("!30AS!8AS!8AS!8AS!8AS!8AS", -
+"''qname'","''q_execut'","''q_pendin'", -
+"''q_timed'","''q_hold'","''q_retain'")
+$ endif
+$!
+$ if qname .nes. "" then goto loop_queue
+$ENDLOOP_QUEUE:
+$!
+$! **************************************************************
+$! * Controleer of de routine verlaten moet worden (CTRL-Z) *
+$! * Of dat er een andere view getoond moet worden. *
+$! **************************************************************
+$!
+$ commands = "CAEHTRP"
+$ answer_me :=""
+$ say " "
+$ say "Press C(ompact),A(ll),E(xecuting),H(old),T(imed),R(etained),P(ending) + "
+$ read/time_out='p1' sys$command -
+/prompt=" (Press CTRL-Z to quit)" -
+/end_of_file=exit -
+/error=timeout -
+answer_me
+$timeout:
+$ answer_me = f$edit(answer_me,"collapse,upcase")
+$ if f$locate(answer_me,commands) .ne. f$length(commands)
+$ then
+$ P2 = answer_me
+$ endif
+$ goto begin
+$!
+$exit:
+$!
+$! **************************************************************
+$! * Restore the privileges *
+$! **************************************************************
+$!
+$ rst_prv = f$setprv("NOALL,''cur_prv'")
+$!
+$ exit
diff --git a/move-project-dcl b/move-project-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_bW92ZS1wcm9qZWN0LWRjbA==
--- /dev/null
+++ b/move-project-dcl
@@ -0,0 +1,125 @@
+MOVE_PROJECT.COM
+Brian Tillman, Thursday April 29 2004 @ 04:08PM EDT
+$! This command procedure copies a project from one disk to another. It takes
+$! two parameters: P1 is the current logical disk name and directory of the
+$! project to be moved. P2 is the physical disk name to which the project is
+$! to be moved. For example, to move The TeX support files from their current
+$! disk to another, say $1$du47, the command would be:
+$!
+$! $ @move_project tex_disk:[tex] $1$du47
+$!
+$! or
+$!
+$! $ submit/param=("tex_disk:[tex]", "$1$du47") move_project
+$!
+$ write sys$output "Moving ", p1, " to ", p2
+$!
+$! Set up the definitions. Strip any colons from disk names. Strip brackets
+$! from directories.
+$!
+$ set noon
+$ sysman = "$sysman"
+$ nodiskquota = %x100003e4
+$ normal = 1
+$ qfnotact = %x100003d4
+$ newdisk = p2 - ":"
+$ logdisk = f$element( 0, ":", p1 )
+$ olddisk = f$trnlnm( logdisk ) - ":"
+$ if olddisk .eqs. "" then olddisk = logdisk
+$ projdir = f$element( 1, ":", p1 ) - "[" - "]"
+$!
+$! Obtain the owner of the original project directory.
+$!
+$ set process/privilege=all
+$ own = f$file_attributes( "''olddisk':[000000]''projdir'.dir", "uic" )
+$ status = $status
+$ if status
+$ then
+$!
+$! Run SYSMAN to place the project's current quota in a file.
+$!
+$ if f$trnlnm( "sysmanini" ) .eqs. ""
+$ then
+$!
+$ saveini = ""
+$!
+$ else
+$!
+$ saveini = f$trnlnm( "sysmanini" )
+$!
+$ endif
+$ create 'projdir'.ini
+$ open/append init 'projdir'.ini
+$ write init "set timeout 0:1:0"
+$ close init
+$ define sysmanini 'projdir'.ini
+$ sysman diskquota show/out='projdir'.lis/device='olddisk' 'own'
+$ if $status ! A quota exists
+$ then
+$!
+$! Read the file to obtain the quota, skipping any unnecessary records.
+$! Place the quota on the new project device.
+$!
+$ open quo 'projdir'.lis
+$!
+$ readit:
+$ read quo quorecord
+$ quorecord = f$edit( quorecord, "compress,trim" )
+$ user = f$element( 0, " ", quorecord )
+$ if user .nes. own then goto readit
+$ quota = f$element( 2, " ", quorecord )
+$ close quo
+$ delete 'projdir'.lis;*
+$ set noon
+$ sysman diskquota add/device='newdisk'/permquota='quota' 'own'
+$ set on
+$!
+$ endif
+$!
+$! Obtain the current directory's protection mask. Create the new project
+$! directory with the same protection mask as the old directory. Copy the
+$! ACL from the old directory to the new directory.
+$!
+$ prot = f$file_attributes( "''olddisk':[000000]''projdir'.dir", "pro" )
+$ create/directory/owner='own'/prot=('prot') 'newdisk':['projdir']
+$ set acl/like=object_name='olddisk':[000000]'projdir'.dir -
+'newdisk':[000000]'projdir'.dir
+$!
+$! Change the project disk logical name to point to the new disk on all
+$! cluster nodes, but only if a logical disk name was supplied in the
+$! source parameter.
+$!
+$ if logdisk .nes. olddisk
+$ then
+$!
+$ open/append init 'projdir'.ini
+$ write init "set environment/cluster"
+$ write init "set profile/priv=all"
+$ close init
+$ sysman do define/system/exec/tran=(conc,term) 'logdisk' 'newdisk':
+$!
+$ endif
+$ delete 'projdir'.ini;
+$ if saveini .eqs. ""
+$ then
+$!
+$ deassign sysmanini
+$!
+$ else
+$!
+$ define sysmanini 'saveini'
+$!
+$ endif
+$!
+$! Copy the files from the old directory to the new directory.
+$!
+$ backup/verify/interchange 'olddisk':['projdir'...] -
+'newdisk':['projdir'...] /owner='own'
+$!
+$! Set the protection mask of subdirectory files to match the top level.
+$!
+$ set protection=('prot') 'newdisk':['projdir'...]*.dir
+$ status = normal
+$!
+$ endif
+$ exit status
diff --git a/ops-dcl b/ops-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_b3BzLWRjbA==
--- /dev/null
+++ b/ops-dcl
@@ -0,0 +1,161 @@
+OPS.COM
+Jim Agnew, Thursday June 05 2003 @ 09:34AM EDT
+This procedure is modeled after Ralph Stamerjohn's OPS.CMD for the RSX-11M operating system.
+It allows for wildcarding operations across filenames, and if you make the action to @ a second file, you can then have more than one operation on a file at a time.
+
+I've used it for years with no problems.
+
+Oh, by the way it did NOT paste correctly, the paste box wrapped a lot of lines.. If you wish me to email you a proper copy, I'll be glad to..
+
+...also attribute the first line to Bob Langford, who figured out how to set noverify w/o displaying the noverify command!!!
+
+Use in Good Faith... Jim Agnew
+
+$ SAVE_VERIFY := "((""''F$ENVIRONMENT(""VERIFY_PROCEDURE"")'"".EQS.""TRUE""),(""''F$ENVIRONMENT(""VERIFY_IMAGE"")'"".EQS.""TRUE""))" ! 'F$VERIFY(0)'
+$ SET NOON ! Let's bomb-proof ourselves.
+$! save state of verification. Do this first to keep from
+$! munging the batch logfiles.
+$!
+$! VAX/VMS version of OPS - select files and perform operation."
+$!
+$! OPS - select files and perform operation.
+$! Original author: Ralph Stamerjohn - RSX Multi-Tasker, April 1983
+$!
+$! Implemented by Jim Agnew on PDP-11/23, RSX-11M 3 April, 1984
+$! Implemented by Jim Agnew on VAX-11/780, VMS June, 1984
+$! User Changes: We must now use '"' instead of '(' and ')' to
+$! delimit commands, and '#' instead of '$' to
+$! indicate wildcard file selections.
+$! MODIFICATIONS:
+$! October 1984: Use 'SET NOON' to bomb-proof the comfile.
+$! January 1985: Add 'P3' handling to enable
+$! batch comfile generation.
+$! March 1986: Add two lines at the front of the output
+$! comfile to set noon, and set verify
+$! to bomb-proof the comfile.
+$! August 1986: Add GOSUB logic to make calling the subroutine
+$! much easier.
+$! December 1987: Add Bob Langford's DCL NOVER at first line.
+$! June 1988: Add SET NOVER and EXIT at the end of the output
+$! comfile to reset the environment.
+$! September 1988: Upgrade to VMS V5.!
+$!
+$! November 1998: Add spacing to allow sorting the comfiles.
+$! This is usefull in NOduping them.
+$!
+$! Initialize all parameters.
+$!
+$ CMDNUM := "1"
+$ CMDFILE := ""
+$ IF F$MODE() .NES. "INTERACTIVE" .AND. -
+P1 .EQS. "" .AND. -
+P2 .EQS. "" .AND. -
+P3 .EQS. "" THEN GOTO TURKEY
+$ IF P1 .NES. "" .AND. P2 .NES. "" THEN GOTO START
+$! WRITE SYS$OUTPUT "[2J[0;0H"
+$! WRITE SYS$OUTPUT "@OPS '"'DIR selection'"' '"' command line'"'"
+$! WRITE SYS$OUTPUT "C...:....1....:....2....:....3....:....4....:....5....:....6....:....7....|....8"
+$ WRITE SYS$OUTPUT " OPS.CMD - Select files and perform operation"
+$ WRITE SYS$OUTPUT " @OPS Dir selection Command line"
+$ WRITE SYS$OUTPUT " Example: @OPS *.EXE/AF:11-APR-83 MACRO/NOLIST #F"
+$ WRITE SYS$OUTPUT " Or: @OPS and then answer questions"
+$ WRITE SYS$OUTPUT " Parameters are: #N is entire filename"
+$ WRITE SYS$OUTPUT " #O is node #D is device #U is directory #F is filename"
+$ WRITE SYS$OUTPUT " #T is filetype #V is version"
+$ WRITE SYS$OUTPUT " Limits: Up to 10 command lines allowed."
+$ WRITE SYS$OUTPUT ""
+$ WRITE SYS$OUTPUT " If you want to 'can' this sequence of commands, enter the name you want
+$ WRITE SYS$OUTPUT " to give the command file, else the command procedure will execute immediately."
+$!
+$ INQUIRE CMDFILE " Enter name of generated command file (the .COM will be added)"
+$ IF CMDFILE .NES. "" THEN CMDFILE = CMDFILE + ".COM"
+$!
+$ WRITE SYS$OUTPUT ""
+$ WRITE SYS$OUTPUT " For the search string, any valid VMS directory command will do."
+$ INQUIRE P1 " Please input wildcard search "
+$ IF P1 .EQS. "" THEN GOTO TURKEY
+$!
+$ INQUIRE P2 " Please input wildcard command "
+$ IF P2 .EQS. "" THEN GOTO TURKEY
+$!
+$!C#?
+$ START:
+$ IF P3 .NES. "" THEN CMDFILE = P3 + ".COM"
+$ SHO SYMBOL CMDFILE
+$ IF CMDFILE .NES. ""
+$ THEN
+$ OPEN OUTPUT 'CMDFILE'/WRITE
+$ WRITE OUTPUT "$ SET NOON"
+$ WRITE OUTPUT "$ SET VERIFY"
+$ ENDIF
+$ MORE:
+$ COMMAND := 'P2'
+$ FILESPEC = F$SEARCH(P1) ! Search directory for more.
+$ IF FILESPEC .EQS. "" THEN GOTO FINIS ! If no more go home.
+$ N = FILESPEC
+$ O = F$PARSE(FILESPEC,,,"NODE")
+$ D = F$PARSE(FILESPEC,,,"DEVICE")
+$ U = F$PARSE(FILESPEC,,,"DIRECTORY")
+$ F = F$PARSE(FILESPEC,,,"NAME")
+$ T = F$PARSE(FILESPEC,,,"TYPE")
+$ V = F$PARSE(FILESPEC,,,"VERSION")
+$ NPARSE:
+$ SPECIFIER := N
+$ GOSUB STRPARSE
+$ OPARSE:
+$ SPECIFIER := O
+$ GOSUB STRPARSE
+$ DPARSE:
+$ SPECIFIER := D
+$ GOSUB STRPARSE
+$ UPARSE:
+$ SPECIFIER := U
+$ GOSUB STRPARSE
+$ FPARSE:
+$ SPECIFIER := F
+$ GOSUB STRPARSE
+$ TPARSE:
+$ SPECIFIER := T
+$ GOSUB STRPARSE
+$ VPARSE:
+$ SPECIFIER := V
+$ GOSUB STRPARSE
+$!C#?
+$ IF CMDFILE .NES. "" THEN WRITE OUTPUT "$ ''COMMAND'"
+$ IF CMDFILE .EQS. ""
+$ THEN
+$ WRITE SYS$OUTPUT "''COMMAND'"
+$ 'COMMAND'
+$ ENDIF
+$ GOTO MORE
+$ TURKEY:
+$ WRITE SYS$OUTPUT " "
+$ WRITE SYS$OUTPUT " See the documentation on this COM file, TURKEY!!"
+$ WRITE SYS$OUTPUT ""
+$ GOTO DIE
+$ FINIS:
+$ WRITE SYS$OUTPUT ""
+$ WRITE SYS$OUTPUT " All done, Master."
+$ WRITE SYS$OUTPUT ""
+$ DIE:
+$ IF CMDFILE .NES. ""
+$ THEN
+$ WRITE OUTPUT "$ SET NOVERIFY"
+$ WRITE OUTPUT "$ EXIT"
+$ CLOSE OUTPUT
+$ ENDIF
+$ IF SAVE_VERIFY THEN SET VERIFY
+$ EXIT
+$ STRPARSE:
+$ TARGET := #'SPECIFIER'
+$ CPOS = F$LOCATE(TARGET, COMMAND)
+$ CEND = F$LENGTH(COMMAND)
+$ IF CPOS .EQ. CEND
+$ THEN
+$ RETURN
+$ ELSE
+$ TAILEND = F$EXTRACT(CPOS+2,CEND,COMMAND)
+$ COMMAND = F$EXTRACT(0,CPOS,COMMAND)
+$ COMMAND = COMMAND + 'SPECIFIER' + TAILEND
+$ ENDIF
+$ GOTO STRPARSE
\ No newline at end of file
diff --git a/parse_cmd_line-dcl b/parse_cmd_line-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_cGFyc2VfY21kX2xpbmUtZGNs
--- /dev/null
+++ b/parse_cmd_line-dcl
@@ -0,0 +1,575 @@
+PARSE_CMD_LINE
+Mark de Bruin, Tuesday September 23 2003 @ 09:24AM EDT
+$! PARSE_CMD_LINE.COM Page 1
+$! A COMMAND LINE PARSER
+$!
+$! COPYRIGHT © 2002 BY:
+$!
+$! Crash Safety Center
+$! of
+$! TNO Automotive, Delft, The Netherlands
+$!
+$! ALL RIGHTS RESERVED
+$!
+$!
+$! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
+$!
+$!++
+$! FACILITY:
+$! Digital Command Procedure (DCL)
+$!
+$! ABSTRACT:
+$! This procedure parses a command line with options specified as -x,
+$! with x a specific character.
+$!
+$! Before calling this routine a global symbol must be specified that holds
+$! the legal parameters. This symbol MUST be called cOptions.
+$! F.i. cOptions == "-F|-O|-D|-Q|-P|-T| ".
+$! The definition MUST end with 2 spaces and the pipe character | must be the
+$! separator between the options.
+$!
+$! The options and parameters must be specified as follows:
+$! -Ftest.tmp -Ol
+$! In this case:
+$! -F implies the definition of a filespecification. The actual
+$! filespecification must follow the -F option immediately and without spaces in
+$! between.
+$! -O implies the definition of the orientation. This must either L of P and
+$! must, like the filespecification immediately foloow the -O option, without
+$! any intermediate spaces.
+$!
+$! The valid values for the different options can be specified in additional
+$! global symbols.
+$! F.i. cValue2=="L|P"
+$! Here this means that for option 2 (i.e. -O) only L and P are allowed as
+$! values.
+$!
+$! ENVIRONMENT:
+$! VAX/VMS
+$! Description of parameters
+$! Name Type R/W Description
+$! ---------------- ----- --- ------------------------------
+$! P1 C R Parameter 1
+$! P2 C R Parameter 2
+$! P3 C R Parameter 3
+$! P4 C R Parameter 4
+$! P5 C R Parameter 5
+$! P6 C R Parameter 6
+$! P7 C R Parameter 7
+$! P8 C R Parameter 8
+$!
+$! Return value:
+$! Name Type R/W Description
+$! ---------------- ---- --- ------------------------------
+$! lOption1 N W 1 - option 1 in list has been specified
+$! 0 - option 1 has not been specified
+$! lParam1 C W Contents of option 1 in parameter list.
+$! Empty if lOption1 = 0
+$! lOption2 N W 1 - option 2 in list has been specified
+$! 0 - option 2 has not been specified
+$! lParam2 C W Contents of option 2 in parameter list.
+$! Empty if lOption2 = 0
+$! lOption3 N W 1 - option 3 in list has been specified
+$! 0 - option 3 has not been specified
+$! lParam3 C W Contents of option 3 in parameter list.
+$! Empty if lOption3 = 0
+$! lOption4 N W 1 - option 4 in list has been specified
+$! 0 - option 4 has not been specified
+$! lParam4 C W Contents of option 4 in parameter list.
+$! Empty if lOption4 = 0
+$! lOption5 N W 1 - option 5 in list has been specified
+$! 0 - option 5 has not been specified
+$! lParam5 C W Contents of option 5 in parameter list.
+$! Empty if lOption5 = 0
+$! lOption6 N W 1 - option 6 in list has been specified
+$! 0 - option 6 has not been specified
+$! lParam6 C W Contents of option 6 in parameter list.
+$! Empty if lOption6 = 0
+$! lOption7 N W 1 - option 7 in list has been specified
+$! 0 - option 7 has not been specified
+$! lParam7 C W Contents of option 7 in parameter list.
+$! Empty if lOption7 = 0
+$! lOption8 N W 1 - option 8 in list has been specified
+$! 0 - option 8 has not been specified
+$! lParam8 C W Contents of option 8 in parameter list.
+$! Empty if lOption8 = 0
+$!
+$! Keywords (max 10)
+$! Revision history
+$! at: by: reason:
+$!----------------------------------------------------------------------
+$! 11-MAR-2002 Mark de Bruin creation
+$!
+$!
+$!--
+$!++
+$! Turn verify OFF (keep mode)
+$ V=F$VERIFY(0)
+$! Catch CONTROL_Y to exit properly
+$ ON CONTROL_Y THEN GOTO LABEL_EXIT
+$!
+$ iOption = 0
+$!
+$!
+$!----------
+$! If length of parameters is lt 2 add spaces.
+$! This prevents a single character (f.i. a L) to be a correct parameter
+$!----------
+$ If F$Lenght(P1) .Lt. 2 Then P1 = P1 + " "
+$ If F$Lenght(P2) .Lt. 2 Then P2 = P2 + " "
+$ If F$Lenght(P3) .Lt. 2 Then P3 = P3 + " "
+$ If F$Lenght(P4) .Lt. 2 Then P4 = P4 + " "
+$ If F$Lenght(P5) .Lt. 2 Then P5 = P5 + " "
+$ If F$Lenght(P6) .Lt. 2 Then P6 = P6 + " "
+$ If F$Lenght(P7) .Lt. 2 Then P7 = P7 + " "
+$ If F$Lenght(P8) .Lt. 2 Then P8 = P8 + " "
+$!----------
+$! Check the validness of the (max 8) parameters
+$!----------
+$ iParam = 1
+$LOOP_PARAMS:
+$ If iParam .LE. 8
+$ Then
+$ cOption'iParam' = F$Extract(0,2,P'iParam')
+$ If F$Locate(cOption'iParam',cOptions) .Eqs. F$Length(cOptions) Then -
+Goto ILLPAR'iParam'
+$ iParam = iParam + 1
+$ Goto LOOP_PARAMS
+$ Endif
+$!
+$! Clear any existing parameter symbol defnitions.
+$!
+$ iParam = 1
+$LOOP_PARAMS1:
+$ If iParam .LE. 8
+$ Then
+$ lOption'iParam' == 0
+$ lParam'iParam' == " "
+$ iParam = iParam + 1
+$ Goto LOOP_PARAMS1
+$ Endif
+$!
+$ iParam = 1
+$LOOP_PARAMS2:
+$ If iParam .LE. 8
+$ Then
+$ If F$Length(F$Edit(cOption'iParam',"COLLAPSE")) .NE. 0
+$ Then
+$ iOption = (F$Locate(cOption'iParam',cOptions)/3+1)
+$ lOption'iOption' == 1
+$ cOption = F$Element(iOption - 1,"|",cOptions)
+$ lParam'iOption' == F$Extract(2,F$Length(P'iParam')-2,P'iParam')
+$ If F$Type(cValues'iOption') .Nes. ""
+$ Then
+$ If F$Locate(lParam'iOption',cValues'iOption') -
+.Eqs. F$Len(cValues'iOption') Then Goto ILLVAL
+$ Endif
+$ Endif
+$ iParam = iParam + 1
+$ Goto LOOP_PARAMS2
+$ Endif
+$ $Error == 1
+$ Goto END
+$!
+$ILLPAR1:
+$ @cls$com:DCL_ERRORS 'cFacility' "ILLPAR1" "Use -h for help" 'P1'
+$ $Error == 2
+$ Goto END
+$ILLPAR2:
+$ @cls$com:DCL_ERRORS 'cFacility' "ILLPAR2" "Use -h for help" 'P2'
+$ $Error == 2
+$ Goto END
+$ILLPAR3:
+$ @cls$com:DCL_ERRORS 'cFacility' "ILLPAR3" "Use -h for help" 'P3'
+$ $Error == 2
+$ Goto END
+$ILLPAR4:
+$ @cls$com:DCL_ERRORS 'cFacility' "ILLPAR4" "Use -h for help" 'P4'
+$ $Error == 2
+$ Goto END
+$ILLPAR5:
+$ @cls$com:DCL_ERRORS 'cFacility' "ILLPAR5" "Use -h for help" 'P5'
+$ $Error == 2
+$ Goto END
+$ILLPAR6:
+$ @cls$com:DCL_ERRORS 'cFacility' "ILLPAR6" "Use -h for help" 'P6'
+$ $Error == 2
+$ Goto END
+$ILLPAR7:
+$ @cls$com:DCL_ERRORS 'cFacility' "ILLPAR7" "Use -h for help" 'P7'
+$ $Error == 2
+$ Goto END
+$ILLPAR8:
+$ @cls$com:DCL_ERRORS 'cFacility' "ILLPAR8" "Use -h for help" 'P8'
+$ $Error == 2
+$ Goto END
+$ILLVAL:
+$ cValues = cValues'iOption'
+$ @cls$com:DCL_ERRORS 'cFacility' "ILLVAL''iOption'" "Use -h for help" -
+"''cOption'" "''cValues'"
+$ $Error == 2
+$ Goto END
+$END:
+below DCL_ERRORS.COM
+
+$!
+$! COPYRIGHT © 1996 BY:
+$!
+$! Crash Safety ReSEARCH Center
+$! of the
+$! Road Vehicles ReSEARCH Institute TNO, Delft, The Netherlands
+$!
+$! ALL RIGHTS RESERVED
+$!
+$!
+$! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
+$!
+$!++
+$! FACILITY:
+$! Digital Command Procedure (DCL)
+$!
+$! ABSTRACT:
+$! Display of error messages during the execution of a BEGRIP command
+$! procedure in a standard format
+$!
+$!
+$! ENVIRONMENT:
+$! VAX/VMS
+$! Description of parameters
+$! Name Type R/W Description
+$! ---------------- ------------ --- ------------------------------
+$! P1 C R Facility code
+$! P2 C R Message mnemonic/Id
+$! P3 C R Help text
+$! P4 C R Parameter 4 (message dependend)
+$! P5 C R Parameter 5 (message dependend)
+$! P6 C R Parameter 6 (message dependend)
+$! P7 C R Parameter 7 (message dependend)
+$! P8 C R Parameter 8 (message dependend)
+$!
+$! Return value:
+$! Name Type R/W Description
+$! ---------------- ------------ --- ------------------------------
+$! $STATUS I W Exit status (DCL)
+$!
+$! Keywords (max 10)
+$!
+$! BEGRIP DCL ERROR DISPLAY
+$!
+$! Revision history
+$! at: by: reason:
+$!----------------------------------------------------------------------
+$! 26-SEP-1996 Mark de Bruin creation
+$!
+$!++
+$! Catch CONTROL_Y to exit properly
+$ ON CONTROL_Y THEN GOTO LABEL_EXIT
+$
+$ TELL = "Write SYS$OUTPUT"
+$ BELL[0,8] = %X7
+$!
+$ cFacility = P1
+$ cId = P2
+$ cHlpTxt = P3
+$!
+$ GOTO 'cId'
+$
+$NOFILE:
+$ cSeverity = "E"
+$ cMsgTxt = "No file specified"
+$ Goto MSG
+$NOACTION:
+$ cSeverity = "E"
+$ cMsgTxt = "No action defined as parameter !AS"
+$ Goto MSG
+$ERRPRSFIL:
+$ cSeverity = "E"
+$ cMsgTxt = "Error parsing !AS file !AS"
+$ Goto MSG
+$FILNOTFOU:
+$ cSeverity = "E"
+$ cMsgTxt = "!AS File !AS not found"
+$ Goto MSG
+$ILLORIENT:
+$ cSeverity = "E"
+$ cMsgTxt = "Illegal specification of orientation"
+$ Goto MSG
+$ILLPAR1:
+$ cSeverity = "E"
+$ cMsgTxt = "1st parameter !AS is illegal"
+$ Goto MSG
+$ILLPAR2:
+$ cSeverity = "E"
+$ cMsgTxt = "2nd parameter !AS is illegal"
+$ Goto MSG
+$ILLPAR3:
+$ cSeverity = "E"
+$ cMsgTxt = "3rd parameter !AS is illegal"
+$ Goto MSG
+$ILLPAR4:
+$ cSeverity = "E"
+$ cMsgTxt = "4th parameter !AS is illegal"
+$ Goto MSG
+$ILLPAR5:
+$ cSeverity = "E"
+$ cMsgTxt = "5th parameter !AS is illegal"
+$ Goto MSG
+$ILLPAR6:
+$ cSeverity = "E"
+$ cMsgTxt = "6th parameter !AS is illegal"
+$ Goto MSG
+$ILLPAR7:
+$ cSeverity = "E"
+$ cMsgTxt = "7th parameter !AS is illegal"
+$ Goto MSG
+$ILLPAR8:
+$ cSeverity = "E"
+$ cMsgTxt = "8th parameter !AS is illegal"
+$ Goto MSG
+$ILLVAL1:
+$ cSeverity = "E"
+$ cMsgTxt = "Value of option 1 (!AS) is invalid. Allowed are !AS"
+$ Goto MSG
+$ILLVAL2:
+$ cSeverity = "E"
+$ cMsgTxt = "Value of option 2 (!AS) is invalid. Allowed are !AS"
+$ Goto MSG
+$ILLVAL3:
+$ cSeverity = "E"
+$ cMsgTxt = "Value of option 3 (!AS) is invalid. Allowed are !AS"
+$ Goto MSG
+$ILLVAL4:
+$ cSeverity = "E"
+$ cMsgTxt = "Value of option 4 (!AS) is invalid. Allowed are !AS"
+$ Goto MSG
+$ILLVAL5:
+$ cSeverity = "E"
+$ cMsgTxt = "Value of option 5 (!AS) is invalid. Allowed are !AS"
+$ Goto MSG
+$ILLVAL6:
+$ cSeverity = "E"
+$ cMsgTxt = "Value of option 6 (!AS) is invalid. Allowed are !AS"
+$ Goto MSG
+$ILLVAL7:
+$ cSeverity = "E"
+$ cMsgTxt = "Value of option 7 (!AS) is invalid. Allowed are !AS"
+$ Goto MSG
+$!
+$ILLVAL8:
+$ cSeverity = "E"
+$ cMsgTxt = "Value of option 8 (!AS) is invalid. Allowed are !AS"
+$ Goto MSG
+$!
+$NOQUEUE:
+$ cSeverity = "E"
+$ cMsgTxt = "No such queue SYS$PRINT"
+$ Goto MSG
+$!
+$ILLSTAT:
+$ cSeverity = "E"
+$ cMsgTxt = "!AS has improper last status."
+$ cHlpTxt = "Use SOURCEHISTORYF*ull for more info."
+$ Goto MSG
+$!
+$PSONANSI:
+$ cSeverity = "E"
+$ cMsgTxt = "Will not print Postscript file on ANSI printer"
+$ Goto MSG
+$!
+$ERRDUROPE:
+$ cSeverity = "E"
+$ cMsgTxt = "Error opening !AS file !AS"
+$ Goto MSG
+$!
+$SRCINSRC:
+$ cSeverity = "E"
+$ cMsgTxt = "!AS already in source directory !AS"
+$ Goto MSG
+$!
+$ERRDURREA:
+$ cSeverity = "E"
+$ cMsgTxt = "Error reading !AS file !AS"
+$ Goto MSG
+$!
+$NOFORM:
+$ cSeverity = "E"
+$ cMsgTxt = "No form specified"
+$ Goto MSG
+$!
+$SRCEXIST:
+$ cSeverity = "E"
+$ cMsgTxt = "!AS already exists."
+$ cHlpTxt = "Title : !AS"
+$ Goto MSG
+$!
+$SRCNOTREG:
+$ cSeverity = "E"
+$ cMsgTxt = "!AS not registered."
+$ cHlpTxt = "Use NEW to register."
+$ Goto MSG
+$!
+$WRNGSTAT:
+$ cSeverity = "E"
+$ cMsgTxt = "Previous action (!AS) for !AS not valid."
+$ cHlpTxt = "Required: !AS"
+$ Goto MSG
+$!
+$UNDEFEXT:
+$ cSeverity = "E"
+$ cMsgTxt = "Undefined/wrong extension !AS"
+$ cHlpTxt = "Correct command or contact support to add extension."
+$ Goto MSG
+$!
+$SRCNOTEXI:
+$ cSeverity = "I"
+$ cMsgTxt = "Source !AS not in current directory."
+$ cHlpTxt = "(!AS)"
+$ Goto MSG
+$!
+$SRCNOTINSRC:
+$ cSeverity = "E"
+$ cMsgTxt = "Source !AS not in source directory."
+$ Goto MSG
+$!
+$LINNOTEXI:
+$ cSeverity = "W"
+$ cMsgTxt = "Linked module !AS not in current directory"
+$ Goto MSG
+$!
+$MAPNOTEXI:
+$ cSeverity = "W"
+$ cMsgTxt = "Map file !AS not in current directory"
+$ Goto MSG
+$!
+$ALRDYRETR:
+$ cSeverity = "E"
+$ cMsgTxt = "!AS already retracted by !AS"
+$ Goto MSG
+$!
+$NOTREL:
+$ cSeverity = "E"
+$ cMsgTxt = "!AS has not been released."
+$ cHlpTxt = "Use REL*ease to release."
+$ Goto MSG
+$!
+$NOTRETR:
+$ cSeverity = "E"
+$ cMsgTxt = "!AS has not been retracted."
+$ cHlpTxt = "Use RET*ract to retract."
+$ Goto MSG
+$!
+$RELNOTFND:
+$ cSeverity = "E"
+$ cMsgTxt = "!AS has been released by !AS"
+$ Goto MSG
+$!
+$NOHIST:
+$ cSeverity = "E"
+$ cMsgTxt = "There is no history for !AS."
+$ Goto MSG
+$!
+$NOTWRKDIR:
+$ cSeverity = "E"
+$ cMsgTxt = "Current directory is not a work directory"
+$ cHlpTxt = "Active project: !AS"
+$ Goto MSG
+$!
+$NOCURMOD:
+$ cSeverity = "E"
+$ cMsgTxt = "No current module specification exists - you must specify one"
+$ Goto MSG
+$!
+$RETSRC:
+$ cSeverity = "I"
+$ cMsgTxt = "Retracting source!AS module !AS"
+$ cHlpTxt = "--------> !AS"
+$ Goto MSG
+$!
+$RELEASE:
+$ cSeverity = "I"
+$ cMsgTxt = "Releasing !AS module !AS"
+$ cHlpTxt = "--------> !AS"
+$ Goto MSG
+$!
+$LIBNOTEXI:
+$ cSeverity = "E"
+$ cMsgTxt = "Library !AS does not exist."
+$ Goto MSG
+$!
+$MODNOTINLIB:
+$ cSeverity = "E"
+$ cMsgTxt = "Module not found in library !AS"
+$ Goto MSG
+$!
+$SRCDIR:
+$ cSeverity = "E"
+$ cMsgTxt = "Default directory is NOT work- but source directory"
+$ cHlpTxt = "Change to work directory and retry command"
+$ Goto MSG
+$!
+$CMPDIR:
+$ cSeverity = "E"
+$ cMsgTxt = "Default directory is NOT work- but compiled directory"
+$ cHlpTxt = "Change to work directory and retry command"
+$ Goto MSG
+$!
+$NOCMP:
+$ cSeverity = "E"
+$ cMsgTxt = "Compiled module !AS can be located."
+$ cHlpTxt = "Retract module, compile and release first before moving to test"
+$ Goto MSG
+$!
+$NOSRCDIR:
+$ cSeverity = "E"
+$ cMsgTxt = "No source directory specified for current extension (!AS)"
+$ Goto MSG
+$!
+$NOEXT:
+$ cSeverity = "E"
+$ cMsgTxt = "No current extension exists"
+$ cHlpTxt = "Change command parameters by adding extension to modulename."
+$ Goto MSG
+$!
+$ABONONAME:
+$ cSeverity = "W"
+$ cMsgTxt = "Aborted. No name specified"
+$ Goto MSG
+$!
+$ILLVERBOSE:
+$ cSeverity = "E"
+$ cMsgTxt = "Illegal verbose value in parameter !AS"
+$ cHlpTxt = "Change command"
+$ Goto MSG
+$!
+$ABOSRCRUN:
+$ cSeverity = "W"
+$ cMsgTxt = "Aborted. No sourcerun indicator specified"
+$ Goto MSG
+$!
+$MSG:
+$!
+$ cRing = ""
+$ If cSeverity .Eqs. "E" Then cRing = BELL
+$ iNr = F$Length(cFacility) + F$Length(cId) + 5
+$ If F$Length(cHlpTxt) .Nes. 0 .And. cSeverity .Nes. "I" -
+Then cHlpTxt = "*I* " + cHlpTxt
+$ cFaoTxt = "!AS%!3-!1-!AS " -
++ cMsgTxt -
++ "!/!''iNr'< !>" -
++ cHlpTxt
+
+$ cMsg = F$Fao ( cFaoTxt, -
+cRing, -
+cFacility, -
+cSeverity, -
+cId, -
+p4, p5, p6, p7, p8 )
+$!----------
+$! Display actual message
+$!----------
+$ Tell cMsg
+$ Goto END
+$!
+$LBL_EXIT:
+$END:
+$ Exit
\ No newline at end of file
diff --git a/pf-percent-free-dcl b/pf-percent-free-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_cGYtcGVyY2VudC1mcmVlLWRjbA==
--- /dev/null
+++ b/pf-percent-free-dcl
@@ -0,0 +1,230 @@
+PF.COM (PercentFree)
+John Moore, Monday May 21 2007 @ 09:49AM EDT
+$ ver = 'f$verify(0)'
+$ ep = "!"
+$ if .not. f$trnlnm("DEBUGGING_FLAG") then goto top
+$ ep = ""
+$ set verify
+$!++
+$! file: PF.COM (percentfind)
+$!
+$! author: Tom Cloyd, Compaq (Digital CMC)
+$!
+$! hacked by: John Moore, Reynolds + Reynolds
+$!
+$! purpose: Generate a snapshot of disks that meet the requested criteria
+$!
+$! args: p1 = single disk-device eg. - dsa23 or $4$dua23 or user23
+$! or comma-separated list of disks
+$! or either ( high %-freespace | #-freeblocks )
+$!
+$! p2 = either ( low %-freespace | #-freeblocks )
+$!
+$! p3 = +/-sort (actually, this may be specified any parameter
+$! position but only makes sense in p1 or p3 where a range
+$! of disks is returned)
+$!
+$! defaults: first range (p1) defaults to 100 %
+$! second range (p2) defaults to 0 %
+$!
+$!--
+$top:
+$ on control_y then goto bottom
+$ if p1 .eqs. "?"
+$ then
+$ type sys$input
+
+Usage: @pf ( disk | high %-freespc | #-freeblks ) ( low %-freespc | #-freeblks )
+
+
+May also specify +/-sort to sort on percent_used
+
+
+Examples: @pf +sort ! show info for all disks in ascending order
+@pf dsa23 ! show disk dsa23: only
+@pf 5 ! show disks %5 or less freespace
+@pf 25 0 ! show disks between %25 and %0 freespace
+@pf 1000 ! show disks with less than 1000 blocks free
+@pf 9000000 3000000 ! show disks with 3mil or more blocks free
+@pf dsa23,dsa53,dsa30 ! show comma-separated list of disks
+
+
+$ exit
+$ endif
+$ total_disk = 0
+$ total_blocks = 0
+$ total_free_blocks = 0
+$ i = 0
+$!
+$!
+$if p1 .eqs. ""
+$then
+$ diskspec = "*"
+$else
+$ if f$element(0,",",p1) .nes. "," .and. f$type(p1) .eqs. "STRING"
+$ then
+$ diskspec = ""
+$ disklist = p1
+$ endif
+$endif
+$if p1 .nes. "" .and. f$type(p1) .nes. "STRING"
+$then ! takin' what they're givin'
+$ diskspec = "*"
+$ high_range = p1
+$else
+$ high_range = 100 ! set the default high_range
+$endif
+$if p2 .nes. ""
+$then
+$ low_range = p2
+$else
+$ low_range = 0 ! set the default low_range
+$endif
+$ output_stream = "sys$output"
+$ if f$locate("+SORT",p1+p2+p3) .ne. f$length(p1+p2+p3)
+$ then
+$ user := 'f$getjpi("","USERNAME")
+$ pid := 'f$getjpi("","PID")
+$ sort_file = "sys$scratch:''user'-''pid'.tmp"
+$ output_stream = "sortfile"
+$ a_or_d = "ascending"
+$ open/write sortfile 'sort_file'
+$ endif
+$ if f$locate("-SORT",p1+p2+p3) .ne. f$length(p1+p2+p3)
+$ then
+$ user := 'f$getjpi("","USERNAME")
+$ pid := 'f$getjpi("","PID")
+$ sort_file = "''user'-''pid'.tmp"
+$ output_stream = "sortfile"
+$ a_or_d = "descending"
+$ open/write sortfile 'sort_file'
+$ endif
+$!
+$!print header for report
+$!
+$ write sys$output -
+"____________________________________________________________________+"
+$ write sys$output -
+" Device name |Label name | Total | Free | In use |%Used|"
+$ write sys$output -
+"----------------|---------------|---------|---------|---------|-----| "
+$!
+$!begin loop to loop through all mounted disks on the system.
+$!
+$loop:
+$ if diskspec .eqs. "*" then goto wild
+$ if f$extract(1,4,disklist) .eqs. "SORT"
+$ then
+$ diskspec = "*"
+$ goto wild
+$ endif
+$ if "''disklist'" .nes. "" then diskspec = f$element(i,",",disklist)
+$'ep'sh sym i
+$ i = i + 1
+$'ep'sh sym i
+$ if diskspec .eqs. ","
+$ then
+$ disk = ""
+$ goto loop_done
+$ endif
+$'ep'sh sym diskspec
+$ if .not. f$getdvi(diskspec,"EXISTS")
+$ then
+$ write sys$output -
+"%BOGUS-DEV, '",diskspec,"': p1 must be a disk or integer range"
+$ goto loop
+$ else
+$ diskspec = diskspec - ":" + ":"
+$ diskspec = f$parse(diskspec,,,"DEVICE","NO_CONCEAL")
+$ diskspec = "_" + diskspec ! f$device seems to want a leading underscore
+$ endif
+$wild:
+$ disk = f$device("''diskspec'","DISK") - "_"
+$!
+$!
+$loop_done:
+$'ep'sh sym disk
+$if disk .eqs. ""
+$then
+total_used = total_blocks - total_free_blocks
+$! percent_free = (total_free_blocks / 100) / (total_blocks / 10000)
+$ percent_used = (total_used / 100) / (total_blocks / 10000)
+$ if output_stream .eqs. "sortfile"
+$ then
+$ close sortfile
+$ sort/key=(pos:65,siz:2,decimal,'a_or_d') 'sort_file' 'sort_file'
+$ type 'sort_file'
+$ delete/nolog 'sort_file';*
+$ endif
+$ write sys$output -
+"----------------|---------------|---------|---------|---------|-----| "
+$ write sys$output "Disks found ''total_disk'"
+$write sys$output "Total blocks ''total_blocks'"
+$write sys$output "Total free ''total_free_blocks'"
+$write sys$output "Total used ''total_used'"
+$write sys$output "Total percent used ''percent_used'"
+
+
+goto bottom ! exit program after last disk.
+$endif
+$!
+$! skip shadowset members
+$!
+$if f$getdvi("''disk'","SHDW_MEMBER") .eqs. "TRUE" then goto loop
+$!
+$ mount = f$getdvi(disk,"MNT")
+$ if mount .eqs. "FALSE" then goto loop
+$!
+$ maxblock = f$getdvi(disk,"MAXBLOCK")
+$ freeblocks = f$getdvi(disk,"FREEBLOCKS")
+$ used = maxblock - freeblocks
+$ volume_name = f$getdvi(disk,"VOLNAM")
+$ percent_free = (freeblocks/100) / (maxblock/10000)
+$ percent_used = (used/100) / (maxblock/10000)
+$!
+$ total_disk = total_disk + 1
+$ total_blocks = total_blocks + maxblock
+$ total_free_blocks = total_free_blocks + freeblocks
+$ char = "|"
+$ if percent_used .gt. 79 then char = "*"
+$ if percent_used .lt. 10 then percent_used = "0" + f$string(percent_used)
+$ stars_or_bars = percent_used / 10
+$ bargraph = f$fao("!''stars_or_bars'*''char'")
+$!
+$ outline[0,15] := 'disk
+$ outline[16,1] := "|"
+$ outline[17,15] := 'volume_name
+$ outline[32,1] := "|"
+$ outline[33,8] := 'maxblock
+$ outline[42,1] := "|"
+$ outline[43,8] := 'freeblocks
+$ outline[52,1] := "|"
+$ outline[53,8] := 'used
+$ outline[62,1] := "|"
+$ outline[63,5] := "%''percent_used' "
+$ outline[68,1] := "|"
+$ outline[69,10] := 'bargraph
+$!
+$'ep'sh sym percent_free
+$'ep'sh sym high_range
+$'ep'sh sym low_range
+$'ep'sh sym freeblocks
+$'ep'inquire dummy ""
+$if high_range .gt. 100 .and. -
+(f$integer(freeblocks) .gt. high_range .or. -
+f$integer(freeblocks) .lt. low_range) then goto loop
+$if high_range .le. 100 .and. -
+(percent_free .gt. high_range .or. -
+percent_free .lt. low_range) then goto loop
+$!
+$write 'output_stream' "''outline'"
+$!
+$goto loop
+$
+$bottom:
+$ close/nolog sortfile
+$ if "''sort_file'" .nes. "" .and. f$search("''sort_file'") .nes. "" -
+then delete/nolog 'sort_file';*
+$ set noverify
+$ if ver then set verify
+
diff --git a/pom-dcl b/pom-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_cG9tLWRjbA==
--- /dev/null
+++ b/pom-dcl
@@ -0,0 +1,31 @@
+POM
+Aaron, Monday August 04 2003 @ 09:26PM EDT
+$! Updated for VMS V4.6, 16-Aug-1987
+$! from Martin Minow's TECO program, which was from Knuth's "The
+$! Art of Computer Programming", vol. 1. Also, CACM, Apr 63.
+$! Updated for OpenVMS v7.3-1, 4-Aug-2003 to retrieve DayOfYear, ACSakovich.
+$!
+$ now = f$time()
+$ daynumber = f$cvtime(now,,"DayOfYear")
+$got_date:
+$ year = f$cvtime(now,,"year")
+$ century = year/100 + 1
+$ golden = year - ((year/19)*19) + 1
+$ epact = golden*11+20 + ((8*century+5)/25-5) - (3*century/4-12)
+$ epact = epact - ((epact/30)*30)
+$ if epact .eq. 25 .and. golden .gt. 11 then epact = 26
+$ if epact .eq. 24 then epact = 25
+$! Calculate the phase of the moon.
+$! The moon's period is 29.5 days; we need to /8, and then /2,
+$! and the period already has a divisor of 2, so we *64, giving
+$! the moon's period expressed in sixty-fourths of a day.
+$ multiplier = 64
+$ period = 29*multiplier+multiplier/2 ! =29.5 * 64
+$ eighth = period/8 ! =29.5 * 8 ! duration of one phase
+$ sixteenth = eighth/2 ! =29.5 * 4 ! used for rounding
+$ phase = (daynumber+epact-1)*multiplier+sixteenth
+$ phase = ((phase - ((phase/period)*period))/eighth) .and. %O7
+$ phase_names = "new,waxing crescent,in the first quarter,"+ -
+"waxing gibbous,full,waning gibbous,"+ -
+"in the last quarter,waning crescent"
+$ write sys$output "The moon is ",f$element(phase,",",phase_names),"."
diff --git a/pot-conv-dcl b/pot-conv-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_cG90LWNvbnYtZGNs
--- /dev/null
+++ b/pot-conv-dcl
@@ -0,0 +1,5 @@
+PORT_CONV
+John Moore, Wednesday May 23 2007 @ 10:46AM EDT
+$wrt:=write sys$output
+$ans=('p1'-('p1'/256)*256)
+$wrt ans
\ No newline at end of file
diff --git a/qman-del-node-dcl b/qman-del-node-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_cW1hbi1kZWwtbm9kZS1kY2w=
--- /dev/null
+++ b/qman-del-node-dcl
@@ -0,0 +1,54 @@
+QMAN_DEL_NODE_QMNGR.COM
+John Brandon, Thursday February 26 2004 @ 11:14AM EST
+$!
+$! procedure to remove this node from existing queue manager role
+$!
+$!
+$ pid = f$getjpi("","PID")
+$ dts = f$cvtime() - "-" - "-" - " " - ":" - ":" - "."
+$!
+$!
+$ pipe show queue /manager /full | -
+search sys$pipe "Queue manager","/ON=(" /output=sys$scratch:_'pid'_'dts'.scr;
+$!
+$ open qmfl sys$scratch:_'pid'_'dts'.scr; /read
+$!
+$!
+$!----------------------------------------
+$ qmfl_read:
+$ read qmfl data1 /err=qmfl_eof
+$ read qmfl data2 /err=qmfl_eof
+$ qm = f$element(2," ",data1) - ","
+$ nodelist = f$element(1,"=",data2) - "(" - ")"
+$!
+$!
+$ if (f$locate(nodename,nodelist) .ge. f$length(nodelist))
+$ then
+$ write sys$output "%QMAN-E-NODELIST; node does not exist as queue manager role /''qm'/"
+$ goto qmfl_read
+$ endif
+$!
+$!
+$ nodelist = "*" + nodelist - ",''nodename'" - "''nodename'," + "*"
+$ nodelist = nodelist - "*," - ",*" - "*" - "*"
+$ if (nodelist .eqs. "")
+$ then
+$ write sys$output "%QMAN-E-NODELIST; null nodelist /''qm'/"
+$ goto qmfl_read
+$ endif
+$!
+$ start /queue -
+/manager -
+/name_of_manager='qm' -
+/on=('nodelist')
+$ write sys$output "%QMAN-I-DEL; node deleted from queue manager role /''qm'/"
+$ goto qmfl_read
+$!
+$!
+$!----------------------------------------
+$ qmfl_eof:
+$ close qmfl
+$ delete /nolog sys$scratch:_'pid'_'dts'.scr;
+$ show queue /manager /full
+$!
+$!
diff --git a/queue-control-dcl b/queue-control-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_cXVldWUtY29udHJvbC1kY2w=
--- /dev/null
+++ b/queue-control-dcl
@@ -0,0 +1,229 @@
+queue_control.com
+Brian Tillman, Wednesday May 07 2003 @ 04:50PM EDT
+$ set noon
+$! This procedure starts or stops all print queues, or the specified type of
+$! queue.
+$!
+$! P1 = "HELP" prints a short HELP message
+$! P1 = "START" starts all chosen queues
+$! P1 = "STOP" stops all chosen queues
+$!
+$! P2 = "" or "ALL" selects all queues
+$! P2 = "GENERIC" selects generic print queues or print queues with
+$! processor PRTSMB
+$! P2 = "LAT" selects print queues with processor LATSYM
+$! P2 = "LPR" selects print queues with processor LPRSMB or LPDSMB
+$! P2 = "LPD" selects print queues with processor LPDSMB
+$! P2 = "SCRIPTSERVER" selects print queues with processor SSV$SMB
+$! P2 = "TALARIS" selects print queues with processor TLAPSMB
+$! P2 = "TCP" selects print queues with processor TCPSYMB
+$!
+$! P3 = "" or "LOG" displays the START or STOP command to be used
+$! P3 = "NOLOG" supresses displaying the START or STOP command to be
+$! used
+$!
+$! Determine the operation to be performed.
+$!
+$ getp1:
+$ if p1 .nes. "" then goto gotp1
+$ read/prompt="_Operation: " sys$command p1
+$ goto getp1
+$!
+$ gotp1:
+$ p1 := 'p1'
+$ firstchar = f$extract( 0, 1, p1 )
+$ if firstchar .nes. "H"
+$ then
+$!
+$ if f$length( p1 ) .ge. 3
+$ then
+$!
+$ operation = "DUMMY"
+$ firstchar = f$extract( 0, 3, p1 )
+$ if firstchar .eqs. "STA" then operation = "START"
+$ if firstchar .eqs. "STO" then operation = "STOP/NEXT"
+$ if operation .nes. "DUMMY"
+$ then
+$!
+$! The selected operation is valid. Determine which type of queue
+$! to control.
+$!
+$ if p2 .eqs. "" then p2 = "ALL"
+$ p2 := 'p2'
+$ symbiont = "DUMMY"
+$ firstchar = f$extract( 0, 1, p2 )
+$ if firstchar .eqs. "A" then symbiont = "ANY"
+$ if firstchar .eqs. "G" then symbiont = ""
+$ if firstchar .eqs. "L"
+$ then
+$!
+$ secondchar = f$extract( 1, 1, p2 )
+$ if secondchar .eqs. "A" then symbiont = "LATSYM"
+$ if secondchar .eqs. "P"
+$ then
+$!
+$ thirdchar = f$extract( 2, 1, p2 )
+$ if thirdchar .eqs. "D" then symbiont = "LPDSMB"
+$ if thirdchar .eqs. "R" then symbiont = "LPRSMB"
+$!
+$ endif
+$!
+$ endif
+$ if firstchar .eqs. "S" then symbiont = "SSV$SMB"
+$ if firstchar .eqs. "T"
+$ then
+$!
+$ secondchar = f$extract( 1, 1, p2 )
+$ if secondchar .eqs. "A" then symbiont = "TLAPSMB"
+$ if secondchar .eqs. "C" then symbiont = "TCPSYMB"
+$!
+$ endif
+$ if symbiont .nes. "DUMMY"
+$ then
+$!
+$! If the third parameter is present, determine the logging.
+$!
+$ if p3 .eqs. "" then p3 = "LOG"
+$ firstchar = f$extract( 0, 1, p3 )
+$ if firstchar .eqs. "L"
+$ then logging = "true"
+$ else logging = "false"
+$ endif
+$!
+$! A valid queue type was specified. Clear the F$GETQUI
+$! context and check each printer queue.
+$!
+$ context = f$getqui( "cancel_operation" )
+$ more = "true"
+$!
+$ next:
+$ queue = f$getqui( "display_queue", "queue_name", "*", -
+"printer,server,terminal" )
+$ if queue .nes. ""
+$ then
+$!
+$! Determine if the queue is stopped and if it's processor
+$! matches the target symbiont. Special cases are for all
+$! symbionts and for the WIN$LPD queue.
+$!
+$ stopped = f$getqui( "display_queue", "queue_stopped", -
+"*", "freeze_context" )
+$ processor = f$getqui( "display_queue", "processor", -
+"*", "freeze_context" )
+$ procmatch = ( symbiont .eqs. processor ) .or. -
+( symbiont .eqs. "ANY" )
+$ lpdmatch = ( symbiont .eqs. "LPDSMB" ) .and. -
+( queue .eqs. "WIN$LPD" )
+$ lprmatch = ( symbiont .eqs. "LPRSMB" ) .and. -
+( ( processor .eqs. "LPDSMB" ) .or. -
+( queue .eqs. "WIN$LPD" ) )
+$ matchsym = procmatch .or. lpdmatch .or. lprmatch
+$!
+$! Perform the appropriate operation.
+$!
+$ if matchsym
+$ then
+$!
+$ if operation .eqs. "START"
+$ then
+$!
+$ if stopped
+$ then
+$!
+$ if logging then write sys$output -
+"Starting ", queue
+$ 'operation' 'queue'
+$!
+$ endif
+$!
+$ else
+$!
+$ if .not. stopped
+$ then
+$!
+$ if logging then write sys$output -
+"Stopping ", queue
+$ 'operation' 'queue'
+$!
+$ endif
+$!
+$ endif
+$!
+$ endif
+$!
+$ else
+$!
+$! No more queues to process.
+$!
+$ more = "false"
+$!
+$ endif
+$ if more then goto next
+$ status = 1
+$!
+$ else
+$!
+$! An invalid queue type was specified. Tell the user.
+$!
+$ status = %x38060
+$!
+$ endif
+$!
+$ else
+$!
+$! An invalid operation was specified. Tell the user
+$!
+$ status = %x38060
+$!
+$ endif
+$!
+$ else
+$!
+$! No operation was given. Tell the user.
+$!
+$ status = %x38010
+$!
+$ endif
+$!
+$ else
+$!
+$! HELP was requested. Display a message.
+$!
+$ write sys$output "This procedure starts or stops all print ", -
+"queues, or the specified type of
+$ write sys$output "queue."
+$ write sys$output ""
+$ write sys$output " P1 = ""HELP"" displays this message"
+$ write sys$output " P1 = ""START"" starts all chosen ", -
+"queues"
+$ write sys$output " P1 = ""STOP"" stops all chosen ", -
+"queues"
+$ write sys$output ""
+$ write sys$output " P2 = """" or ""ALL"" selects all queues"
+$ write sys$output " P2 = ""GENERIC"" selects generic ", -
+"print queues or print queues with"
+$ write sys$output " processor PRTSMB"
+$ Write sys$output " P2 = ""LAT"" selects print ", -
+"queues with processor LATSYM"
+$ write sys$output " P2 = ""LPR"" selects print ", -
+"queues with processor LPRSMB or LPDSMB"
+$ write sys$output " P2 = ""LPD"" selects print ", -
+"queues with processor LPDSMB"
+$ write sys$output " P2 = ""SCRIPTSERVER"" selects print ", -
+"queues with processor SSV$SMB"
+$ write sys$output " P2 = ""TALARIS"" selects print ", -
+"queues with processor TLAPSMB"
+$ write sys$output " P2 = ""TCP"" selects print ", -
+"queues with processor TCPSYMB"
+$ write sys$output ""
+$ write sys$output " P3 = """" or ""LOG"" displays the START ", -
+"or STOP command to be used"
+$ write sys$output " P3 = ""NOLOG"" supresses ", -
+"displaying the START or STOP command to be"
+$ write sys$output " used"
+$ status = 1
+$!
+$ endif
+$ exit status
+
+
diff --git a/queue-manager-save-dcl b/queue-manager-save-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_cXVldWUtbWFuYWdlci1zYXZlLWRjbA==
--- /dev/null
+++ b/queue-manager-save-dcl
@@ -0,0 +1,69 @@
+QUEUE_MANAGER_SAVE.COM
+Jess Goodman, Tuesday July 14 2009 @ 01:37PM EDT
+Run this in a daily batch job (preferably on the queue manager node) to save off in six command files all of the DCL commands required to recreate the queue manager database (queues, forms, characteristics) and to resubmit scheduled batch jobs. Uses DISPLAY_JOBS.COM, DISPLAY_QUEUES.COM, DISPLAY_FORMS.COM and DISPLAY_CHARACTERISTICS.COM.
+
+$! Run this in a daily batch job (preferably on the queue manager node)
+$! to save off in six command files all of the DCL commands required to
+$! recreate the queue manager database (queues, forms, characteristics)
+$! and to resubmit batch jobs. DISPLAY*.COMs must be in same directory.
+$! Mar 2009 - Jess Goodman (comments welcome: lastname@accuweather.com)
+$!
+$ MAIL_TO = P1 !Optional: mail address(es) to notify of changes
+$ OUTSPEC = P2 !Optional: Device/directory/type of output files
+$ IF (OUTSPEC .EQS. "") THEN OUTSPEC := SYS$COMMON:[SYSMGR].COM
+$ MYSELF = F$ENVIRONMENT("PROCEDURE")
+$ MYPATH = F$PARSE(MYSELF,,,"DEVICE") + F$PARSE(MYSELF,,,"DIRECTORY")
+$ SET NOON
+$!
+$!Save SUBMIT commands for current batch jobs that were submitted /AFTER=.
+$ OUTFILE = F$PARSE("SUBMIT_JOBS",OUTSPEC)-";"
+$ @'MYPATH'DISPLAY_JOBS /OUTPUT='OUTFILE' * * * VERSION,USER,DELAYED
+$ PURGE 'OUTFILE' /KEEP=5
+$!
+$!Save DEFINE/CHAR commands for all the characteristics.
+$ OUTFILE = F$PARSE("DEFINE_CHARACTERISTICS",OUTSPEC)-";"
+$ @'MYPATH'DISPLAY_CHARACTERISTICS /OUTPUT='OUTFILE' * /SAFE
+$ GOSUB CHECK_FOR_CHANGES
+$!
+$!Save DEFINE/FORM commands for all the forms.
+$ OUTFILE = F$PARSE("DEFINE_FORMS",OUTSPEC)-";"
+$ @'MYPATH'DISPLAY_FORMS /OUTPUT='OUTFILE' * /SAFE
+$ GOSUB CHECK_FOR_CHANGES
+$!
+$!Save INIT/QUEUE/BATCH commands for all batch queues.
+$ OUTFILE = F$PARSE("INIT_BATCH_QUEUES",OUTSPEC)-";"
+$ @'MYPATH'DISPLAY_QUEUES /OUTPUT='OUTFILE' * /BATCH/NOSTART/NOID
+$ GOSUB CHECK_FOR_CHANGES
+$!
+$!Save INIT/QUEUE/DEVICE= commands for all symbiont queues.
+$ OUTFILE = F$PARSE("INIT_DEVICE_QUEUES",OUTSPEC)-";"
+$ @'MYPATH'DISPLAY_QUEUES /OUTPUT='OUTFILE' * /DEVICE/NOASSIGN/NOSTART/NOID
+$ GOSUB CHECK_FOR_CHANGES
+$!
+$!Save ASSIGN/QUEUE commands for all logical queues.
+$ OUTFILE = F$PARSE("ASSIGN_QUEUES",OUTSPEC)-";"
+$ @'MYPATH'DISPLAY_QUEUES /OUTPUT='OUTFILE' * /ASSIGN_ONLY
+$ GOSUB CHECK_FOR_CHANGES
+$!
+$ EXIT
+$!
+$CHECK_FOR_CHANGES:
+$ IF (F$SEARCH("''OUTFILE';-1") .NES. "")
+$ THEN
+$ IF (MAIL_TO .NES. "")
+$ THEN
+$ DIFFERENCE /OUTPUT=NL: 'OUTFILE' !Any changes today?
+$ IF ($STATUS .NE. %X006C8009) THEN -
+$ MAIL /SUBJ="''OUTFILE' changed" NL: "''MAIL_TO'"
+$ ENDIF
+$ IF (F$SEARCH("''OUTFILE';-2") .NES. "")
+$ THEN !Are previous 2 versions identical?
+$ DIFFERENCE /OUTPUT=NL: 'OUTFILE';-1
+$ IF ($STATUS .EQ. %X006C8009)
+$ THEN !yes, save oldest
+$ DELETE 'OUTFILE';-1
+$ RENAME 'OUTFILE' ;0
+$ ENDIF
+$ ENDIF
+$ ENDIF
+$ RETURN
diff --git a/rand-dcl b/rand-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_cmFuZC1kY2w=
--- /dev/null
+++ b/rand-dcl
@@ -0,0 +1,20 @@
+RAND
+Aaron, Sunday July 27 2003 @ 09:47AM EDT
+$! __CEIL - 1. If P1 is provided, it is used as a new __CEIL.
+$! Based on the original work provided in the OpenVMS FAQ.
+$ RAND:
+$ IF F$TYPE(__SEED) .EQS. ""
+$ THEN
+$! seed the random number generator, ...
+$ __SEED == (10*(f$cvtime(,,"hundredth") + f$cvtime(,,"second") + -
+f$cvtime(,,"minute") + f$cvtime(,,"hour") + -
+f$cvtime(,,"day") -
+.AND. %X7FFFFFFF) .OR. 1)
+$ ENDIF
+$
+$ If P1 .nes. "" then __CEIL = F$Integer(P1)
+$ IF F$TYPE(__CEIL) .EQS. "" THEN __CEIL = %X3FFFFFFF
+$! the generator tends to do better with a large, odd seed, ...
+$ __SEED == (((__SEED * 69069) .and. %x7ffffffe) + 1)
+$ RANDOM == (__SEED .and. %x3fffffff)/(%X40000000/__CEIL)
+$ RETURN
diff --git a/randv2-dcl b/randv2-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_cmFuZHYyLWRjbA==
--- /dev/null
+++ b/randv2-dcl
@@ -0,0 +1,43 @@
+RAND V2
+Ira Carmel, Friday January 16 2004 @ 02:59PM EST
+I made some mods to the classic random.com program that allows you to "pass parameters" where by you pass a symbol into the rand program and you get your random number back out in that symbol. Kind of like variables in pascal where you pass a variable name into the procedure and get the value back out in that variable. I call it like this;
+$ @batch$dir:random 10000 uniq
+Which will return a number random number 10000-1 into the symbol UNIQ
+
+I also added a system logical to store the last seed, and use it in the calculation of the next seed. I was trying to fix the problem where two calls to RANDOM at exactly the same time would produce the same number. (I have had this problem on a multi processor system.) I don't know if it works, but it makes me feel better. Maybe two calls to this will try and define the logical at the same time, and cause some trouble, but I'm not sure. Maybe one program would make the other wait while it finished trying to assign the logical, thus changing the seed through the tick part.
+
+$! __CEIL - 1. If P1 is provided, it is used as a new __CEIL.
+$! Based on the original work provided in the OpenVMS FAQ.
+$ RAND:
+$! Ira Carmel 1/16/2004
+$! setup the passback symbol and try and get the old seed from the system logical __SEED
+$ __PASSBACK = p2
+$ if f$trnlnm("__SEED") .nes. "" then __OLDSEED = f$integer(f$trnlnm("__SEED"))
+$! Try and grab the old seed value from the system logical __SEED
+$ IF F$TYPE(__SEED) .EQS. ""
+$ THEN
+$! seed the random number generator, ...
+$ __SEED == (10*(f$cvtime(,,"hundredth") + f$cvtime(,,"second") + -
+f$cvtime(,,"minute") + f$cvtime(,,"hour") + -
+f$cvtime(,,"day") + __OLDSEED -
+.AND. %X7FFFFFFF) .OR. 1)
+$ ENDIF
+$
+$ If P1 .nes. "" then __CEIL = F$Integer(P1)
+$ IF F$TYPE(__CEIL) .EQS. "" THEN __CEIL = %X3FFFFFFF
+$! the generator tends to do better with a large, odd seed, ...
+$ __SEED == (((__SEED * 69069) .and. %x7ffffffe) + 1)
+$ RANDOM == (__SEED .and. %x3fffffff)/(%X40000000/__CEIL)
+$! Ira Carmel 1/16/2004
+$! Now try and define a system logical for the seed value for next time.
+$! Maybe if you don't have access to the system table
+$! you could make your own table, or use a group table.
+$ define/system/nolog __SEED 'RANDOM'
+$! Ira Carmel 1/16/2004
+$! Now set the variable given in p2 to the random number generated.
+$! Call from another program like this:
+$! @RAND.COM |""
+$! Example: @RAND.COM 1000 UNIQ
+$! The number is returned in the symbol UNIQ
+$ '__PASSBACK' == RANDOM
+$ RETURN
diff --git a/reboot-dcl b/reboot-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_cmVib290LWRjbA==
--- /dev/null
+++ b/reboot-dcl
@@ -0,0 +1,11 @@
+REBOOT.COM
+Henry G. Juengst, Tuesday October 28 2003 @ 01:12AM EST
+$IF F$MODE().NES."OTHER"
+$THEN
+$ RUN/DETACH/INPUT='F$ENVIRONMENT("PROCEDURE")'/OUTPUT=OPA0:/PRIVILEGE=ALL SYS$SYSTEM:LOGINOUT
+$ELSE
+$ SET PROC/PRIV=ALL
+$ ASS OPA0: SYS$COMMAND
+$ SYSMAN SHUTDOWN NODE/AUTO
+$ WAIT 08:00
+$ENDIF
\ No newline at end of file
diff --git a/rem-que-jobs-ddcl b/rem-que-jobs-ddcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_cmVtLXF1ZS1qb2JzLWRkY2w=
--- /dev/null
+++ b/rem-que-jobs-ddcl
@@ -0,0 +1,22 @@
+REMOVE_QUEUE_JOBS.COM
+Frits A.M. Storms, Friday May 20 2005 @ 04:22AM EDT
+$ type sys$input
+!
+! REMOVE_QUEUE_JOBS.COM
+!
+! Procedure to remove "many" jobs from a queue. Takes two parameters:
+! P1 = queue name; P2 = "type" of queue ("batch","printer","terminal","server")
+!
+$ QType = ""
+$ IF P2.EQS."BATCH" THEN Qtype = "/BATCH" ! at worst the operation is refused
+$ INITIALIZE/QUEUE'Qtype' FOOBAR_TEMPORARY_Q !just 1 _very_ implausible queuename
+$ ASSIGN/MERGE FOOBAR_TEMPORARY_Q 'P1' ! leaves running jobs alone
+$ DELETE/QUEUE FOOBAR_TEMPORARY_Q ! this should be somewhat faster...
+$ exit
+$!________________________________________________________________________________
+$! Revision History
+$!
+$! Date Author Comments
+$!________________________________________________________________________________
+$! 29-JUL-2003 BJH Original Version
+$! 20-MAY-2005 Frits A.M. Storms first revision, removed iteration...
diff --git a/reminder-dcl b/reminder-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_cmVtaW5kZXItZGNs
--- /dev/null
+++ b/reminder-dcl
@@ -0,0 +1,22 @@
+Reminder
+Aaron, Saturday June 12 2004 @ 11:35PM EDT
+$! Reminder
+$! by ACSakovich, 12-Jun-2004
+$!
+$! Submit this to a batch queue, using the /After switch to schedule it,
+$! and the /Parameter switch to pass up to 2 parameters as follows:
+$!
+$! P1. Email address to receive the reminder
+$! P2. Reminder subject line
+$!
+$ if p1 .nes. ""
+$ then
+$ if p2 .nes. ""
+$ then
+$ mail nl: "''p1'" /NoSig /Subject="''p2'"
+$ else
+$ mail nl: "''p1'" /NoSig /Subject="Reminder: no subject"
+$ endif
+$ else
+$ mail nl: 'f$getjpi(0,"UserName")' /NoSig /Subject="Reminder: no addressee"
+$ endif
diff --git a/remove-queue-jobs-dcl b/remove-queue-jobs-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_cmVtb3ZlLXF1ZXVlLWpvYnMtZGNs
--- /dev/null
+++ b/remove-queue-jobs-dcl
@@ -0,0 +1,34 @@
+REMOVE_QUEUE_JOBS.COM
+Brad Hamilton, Tuesday February 22 2005 @ 08:10AM EST
+$ type sys$input
+!
+! REMOVE_QUEUE_JOBS.COM - BJH - 29-JUL-2003
+!
+! Procedure to remove "many" jobs from a queue. Takes two parameters:
+! P1 = queue name; P2 = "type" of queue ("batch","printer","terminal","server")
+!
+$!
+$ queue_name = f$getqui("display_queue","queue_name","''P1'","''P2'")
+$ queue_name = f$getqui("display_queue","queue_name","''P1'","wildcard")
+$ !Establishes queue context...
+$!
+$!
+$!__
+$top:
+$ entry_number = f$getqui("display_job","entry_number",,"all_jobs")
+$ if entry_number .eqs. "" then GOTO exit !No more entries, exit...
+$!
+$ delete/entry='entry_number
+$ GOTO top
+$!
+$!
+$!___
+$exit:
+$ exit
+$!------------------------------------------------------------------------------
+$! Revision History
+$!
+$! Date Author Comments
+$!------------------------------------------------------------------------------
+$! 29-JUL-2003 BJH Original Version
+$!
diff --git a/rename-dcl b/rename-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_cmVuYW1lLWRjbA==
--- /dev/null
+++ b/rename-dcl
@@ -0,0 +1,74 @@
+RENAME.COM
+Brad Hamilton, Tuesday February 22 2005 @ 08:25AM EST
+$ type sys$input
+!
+! RENAME.COM - Procedure to purge and rename multiple file versions.
+! BJH - 10-MAR-2004
+! INPUTS - P1 = Full file specification (mandatory)
+! - P2 = number of versions to purge (default = 5)
+! USAGE - @sys$tools:[general]rename "disk:[dir]foo.bar" "5"
+!
+$ if f$mode() .eqs. "INTERACTIVE"
+$ then
+$ GOTO skip_submit
+$ else
+$ endif
+$!
+$! Resubmit each hour, for those nasty problems... :-)
+$!
+$ submit/after="+01:00"/restart/nolog -
+/param="''p1'" -
+sys$login:rename.com
+$!
+$!
+$!__________
+$skip_submit:
+$!
+$! Inputs
+$!
+$ if p1 .eqs. "" then GOTO bad_input
+$!
+$ numvers = f$integer("''p2'")
+$ if p2 .eqs. "" then numvers = f$integer("5")
+$!
+$ pur/log/keep='numvers' 'p1'
+$!
+$! Setup
+$!
+$ device = f$parse(f$search("''p1'"),,,"device")
+$ directory = f$parse(f$search("''p1'"),,,"directory")
+$ name = f$parse(f$search("''p1'"),,,"name")
+$ type = f$parse(f$search("''p1'"),,,"type")
+$ file = device+directory+name+type
+$ filenotype = device+directory+name
+$ orig_file = file + ".*"
+$ temp_file = filenotype + ".666."
+$ temp_temp_file = filenotype + ".666.*"
+$ renamed_file = file + "."
+$!
+$! Rename
+$!
+$ rename/log 'orig_file' 'temp_file'
+$ rename/log 'temp_temp_file' 'renamed_file'
+$ GOTO exit
+$!
+$!
+$!________
+$bad_input:
+$ write sys$output "You must supply a file name, try again!"
+$ exit
+$!
+$!
+$!___
+$exit:
+$ exit
+$!------------------------------------------------------------------------------
+$! Revision History
+$!
+$! Date Author Comments
+$!------------------------------------------------------------------------------
+$! 10-MAR-2004 BJH Original version
+$! 01-DEC-2004 BJH Redone, from a suggestion posted on comp.os.vms.
+$!
+
+
diff --git a/reorg-dcl b/reorg-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_cmVvcmctZGNs
--- /dev/null
+++ b/reorg-dcl
@@ -0,0 +1,60 @@
+reorg.com
+Peter Barkas, Tuesday April 05 2005 @ 08:09AM EDT
+$! PHB 06-Dec-2004
+$! Reorganise and optionally optimise an indexed file
+$! Original file is retained as .old
+$! p1 indexed file to reorganise
+$! p2 fdl file to use
+$! if no fdl specified use ana/rms, edi/fdl to optimise file
+$!
+$ say:==write sys$output
+$ if p1.eqs.""
+$ then
+$ inq p1 "File to reorganise"
+$ inq p2 "FDL file (press return to optimise)"
+$ endif
+$ infil=f$sea(p1)
+$ if infil.eqs.""
+$ then
+$ say "ERROR: No files matching ",p1
+$ goto exit
+$ endif
+$ filnam=f$par(infil,,,"name")
+$ filtyp=f$par(infil,,,"type")
+$ filver=f$par(infil,,,"version")
+$ fildev=f$par(infil,,,"device")
+$ newfil=infil-filtyp-filver+".new"
+$ free_blocks=f$getdvi(newfil,"freeblocks")
+$ file_size=f$file(infil,"alq")
+$ say "Processing ",infil
+$ if file_size.gt.free_blocks
+$ then
+$ say "ERROR: Input file size ",file_size," exceeds free space of ",free_blocks," on ",fildev
+$ say " File will not be processed"
+$ goto exit
+$ endif
+$ if p2.eqs."" ! No FDL specified, so optimise
+$ then
+$ say " - ",f$ext(12,8,f$tim())," creating optimised FDL..."
+$ anafil=filnam+"_ana.tmp"
+$ optfil=filnam+"_opt.tmp"
+$ say " - ",f$ext(12,8,f$tim())," analysing..."
+$ analyzex/rms/fdl/out='anafil' 'infil'
+$ say " - ",f$ext(12,8,f$tim())," optimising..."
+$ editx/fdl/nointe/out='optfil'/anal='anafil' 'anafil'
+$ say " - ",f$ext(12,8,f$tim())," optimised FDL is ",optfil
+$ sortopt="/noso"
+$ else
+$ defnam=filnam+".fdl"
+$ optfil=f$par(p2,defnam)
+$ say " - ",f$ext(12,8,f$tim())," using FDL ",optfil
+$ sortopt=""
+$ endif
+$ say " - ",f$ext(12,8,f$tim())," converting..."
+$ convertx/fdl='optfil''sortopt' 'infil' 'newfil'
+$ rena 'infil' .old
+$ rena 'newfil' 'filtyp'
+$ say " - ",f$ext(12,8,f$tim())," job's done"
+$!
+$exit:
+$ exit
diff --git a/repeat-dcl b/repeat-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_cmVwZWF0LWRjbA==
--- /dev/null
+++ b/repeat-dcl
@@ -0,0 +1,32 @@
+Repeat.com
+Aaron, Wednesday April 02 2003 @ 12:35AM EST
+$! REPEAT.COM
+$! written by ACSakovich, ca 1990
+$!
+$! Correct syntax is:
+$! repeat command This will repeat the command until the user presses
+$! the exit key (F10, Ctl-Z) or one of the special
+$! command keys: C (clear), W (132 col wide), N (80
+$! col narrow)
+$!
+$ esc[0,8] = 27
+$ command = ""
+$ on control_y then goto terminate
+$ open/read user$input 'f$trnlnm("sys$command")
+$ write sys$output "''esc'[H''esc'[J"
+$ term$page = f$getdvi("TT:","TT_PAGE")
+$ set message/nofac/nosev/noid/notext
+$ loop:
+$ 'p1 'p2 'p3 'p4 'p5 'p6 'p7 'p8
+$ read user$input command/time_out=1/end_of_file=terminate/prompt=" "
+$ write sys$output "''esc'[0;0H"
+$ if command .eqs. "" then goto loop
+$ if f$edit(command,"upcase") .eqs. "C" then write sys$output "''esc'[H''esc'[J"
+$ if f$edit(command,"upcase") .eqs. "W" then set term /wid=132
+$ if f$edit(command,"upcase") .eqs. "N" then set term /wid=80
+$ command = ""
+$ goto loop
+$ terminate:
+$ set message/fac/sev/id/text
+$ write sys$output "''esc'[''term$page';1H''esc'[K"
+$ exit
diff --git a/reset-file-versions-dcl b/reset-file-versions-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_cmVzZXQtZmlsZS12ZXJzaW9ucy1kY2w=
--- /dev/null
+++ b/reset-file-versions-dcl
@@ -0,0 +1,26 @@
+Reset_File_Versions
+Aaron, Tuesday October 02 2007 @ 11:19AM EDT
+$! Reset_File_Versions
+$! by ACSakovich, 2-Oct-2007
+$! The only part that needs customization are the CALL statements, following
+$! the syntax of this example:
+$
+$! call ResetFiles {dev:[dir]file.ext}
+$
+$ call ResetFiles Sys$SysRoot:[TCPIP$SMTP]TCPIP$SMTP_RECV_RUN.LOG
+$ exit
+$
+$ ResetFiles: subroutine
+$ if f$search(p1) .nes. ""
+$ then
+$ TgtDir = f$parse(P1,,,"Device") + f$parse(P1,,,"Directory")
+$ TgtFil = f$parse(P1,,,"Name")
+$ TgtExt = f$parse(P1,,,"Type") - "."
+$ BackHome = f$env("Default")
+$ set default 'TgtDir'
+$ rename 'TgtFil'.'TgtExt;* *.tmp;
+$ rename 'TgtFil'.tmp;* *.'TgtExt';
+$ set default 'BackHome'
+$ endif
+$ exit
+$ endsubroutine
diff --git a/resubmit-dcl b/resubmit-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_cmVzdWJtaXQtZGNs
--- /dev/null
+++ b/resubmit-dcl
@@ -0,0 +1,367 @@
+RESUBMIT.COM
+Henk van Dorp, Tuesday September 07 2004 @ 02:35PM EDT
+$ save$veri = 'f$verify(f$trnlnm("CHECK$VERIFY"))'
+$ goto BEGIN
+$!******************************************************************************
+$! PROGRAM : BHR_ROOT:[COM]RESUBMIT.COM
+$! AUTHOR : Henk van Dorp (AAB)
+$! DATE : 07-APR-2004
+$!******************************************************************************
+$! Privileges : NETMBX,TMPMBX,CMKRNL,OPER,SYSPRV
+$! Priv_end
+$!
+$! Purpose : Procedure delete eerst alle queue-entries van een job
+$! en submit deze dan in een op te geven queue, voor een
+$! op te geven tijd, onder een op te geven usernaam.
+$! Purpose_end
+$!
+$! Parameters : P1 = Jobname
+$! P2 = Filespecificatie job
+$! P3 = Locatie Logfile
+$! P4 = Queue
+$! P5 = User
+$! P6 = Tijd
+$! P7 = switch datumstempel in logfilenaam opnemen
+$! P8 = doorgeven van parameters aan te submitten procedure
+$!******************************************************************************
+$! Revisions
+$! Nr Date By Reason
+$! --- --------- --------------- ----------------------------------------------
+$! 001 20040408 Henk van Dorp p7 en p8 toegevoegd
+$! 002 20040420 Henk van Dorp Kleine aanpassing tbv interactief gebruik
+$!******************************************************************************
+$!
+$!
+$!
+$BEGIN:
+$!
+$!------------------------------------------------------------------------------
+$! Default symbols and stuff
+$!------------------------------------------------------------------------------
+$ set noon
+$ say = "write sys$output"
+$ ask = "read sys$command/prompt="
+$! *********************************************************************
+$! * Bepaal de filespecificatie van deze procedure en verwijder *
+$! * het versienummer *
+$! *********************************************************************
+$ procedure = f$environment("procedure")
+$ procedure = procedure - f$parse(procedure,,,"version")
+$!
+$ file_name = f$parse(procedure,,,"name")
+$ facility = "%" + file_name
+$!
+$ set control = (t,y)
+$!
+$!------------------------------------------------------------------------------
+$ say "''facility'-I-START, Started at ''f$cvtime()'"
+$! *********************************************************************
+$! * Check parameters *
+$! *********************************************************************
+$ gosub check_params
+$! *********************************************************************
+$! * display opgegeven parameters *
+$! *********************************************************************
+$ say "procedure: ''procedure'"
+$ say "p1 (job) : ''p1'"
+$ say "p2 (file) : ''p2'"
+$ say "p3 (log) : ''p3'"
+$ say "p4 (queue) : ''p4'"
+$ say "p5 (user) : ''p5'"
+$ say "p6 (time) : ''p6'"
+$ say "p7 (logfilename extension) : ''p7'"
+$ say " logfilename : ''log_filename''"
+$ say "p8 (submit parameters) : "
+$ sho sym p8
+$!
+$ gosub CHECK_PRIVS !Check privileges
+$!
+$ gosub RESUBMIT !Resubmit myself.
+$!
+$ if f$mode() .nes. "BATCH" then goto END !Continue only in batch
+$!
+$!------------------------------------------------------------------------------
+$! The end
+$!-----------------------------------------------------------------------------
+$END:
+$ say "''facility'-I-END, Ended at ''f$cvtime()'"
+$ close/nolog database
+$ rst_prv = f$setprv("NOALL,''cur_prv'") !Restore old privs
+$ if save$veri then set verify
+$ exit
+$!
+$!
+$!
+$!
+$!==============================================================================
+$!==============================================================================
+$!==============================================================================
+$!
+$! S U B R O U T I N E S
+$!
+$!==============================================================================
+$!==============================================================================
+$!==============================================================================
+$CHECK_PRIVS:
+$! Subroutine to check the privs
+$!------------------------------------------------------------------------------
+$ cur_prv = f$getjpi("","PROCPRIV")
+$ req_prv = "NETMBX,TMPMBX,CMKRNL,OPER,SYSPRV"
+$ new_prv = f$setprv("NOALL,''req_prv'")
+$!
+$ if .not. f$privilege("''req_prv'")
+$ then
+$ say "''facility'-E-NOPRN, Required privileges are ''req_prv'"
+$ exit %X28
+$ endif
+$!
+$ return
+$!
+$!
+$!
+$!==============================================================================
+$RESUBMIT:
+$! Subroutine checks presence of job and resubmits it.
+$!------------------------------------------------------------------------------
+$! **********************************************************************
+$! * Bepaal het job_entry_number van de huidige job. *
+$! * Alle jobs met dezelfde naam worden nu gedelete, *
+$! * maar je eigen proces mag natuurlijk niet worden gestopt. *
+$! * Indien interactief gedraaid, dan wordt job_entry_number op 0 gezet *
+$! * Dit nummer komt niet voor in entry-nummering. *
+$! **********************************************************************
+$ if f$mode() .eqs. "BATCH"
+$ then
+$ this_job_entry = f$getqui( "display_entry", -
+"entry_number", -
+, -
+"this_job")
+$ else
+$ this_job_entry = 0
+$ endif
+$! **********************************************************************
+$! * Reset context van de wandeling door de queues *
+$! **********************************************************************
+$ qcancel = f$getqui("CANCEL_OPERATION")
+$!
+$LOOP_QUEUE:
+$! **********************************************************************
+$! * Bepaal queuenaam *
+$! **********************************************************************
+$ qname = f$getqui("DISPLAY_QUEUE", -
+"QUEUE_NAME", -
+"*",)
+$! **********************************************************************
+$! * indien queuenaam leeg is, dan heb je alle queues gehad *
+$! **********************************************************************
+$ if qname .eqs. "" then goto ENDLOOP_QUEUE
+$!
+$LOOP_JOB:
+$! **********************************************************************
+$! * Bepaal jobnaam in queue en zet deze om in hoofdletters *
+$! **********************************************************************
+$ job_name = f$edit( -
+f$getqui("DISPLAY_JOB", -
+"JOB_NAME", -
+, -
+"ALL_JOBS"), -
+"upcase")
+$! **********************************************************************
+$! * Als jobnaam leeg is, dan zijn er geen jobs meer in deze queue *
+$! **********************************************************************
+$ if job_name .eqs. "" then goto LOOP_QUEUE
+$! **********************************************************************
+$! * Als jobnaam de gezochte jobnaam is dan is het een kandidaat om *
+$! * opgeruimd te worden *
+$! **********************************************************************
+$ if job_name .eqs. "''p1'"
+$ then
+$! **********************************************************************
+$! * Bepaal job_entry_nummer van deze job *
+$! **********************************************************************
+$ job_nr = f$getqui("DISPLAY_JOB", -
+"ENTRY_NUMBER", -
+, -
+"ALL_JOBS,FREEZE_CONTEXT")
+$! **********************************************************************
+$! * Als job_entry_number <> job_entry_number van eigen proces *
+$! * dan kan deze worden opgeruimd *
+$! **********************************************************************
+$ if 'job_nr' .ne. 'this_job_entry'
+$ then
+$ delete/entry='job_nr'
+$ endif
+$ endif
+$ goto LOOP_JOB
+$ENDLOOP_QUEUE:
+$! **********************************************************************
+$! * Submit nu de job opnieuw volgens richtlijnen opgegeven parameters *
+$! **********************************************************************
+$ submit -
+/queue='p4' -
+/user='p5' -
+/log='log_filename' -
+/noprint -
+/keep -
+/after='p6' -
+/name='p1' -
+/param='p8' -
+'p2'
+$!
+$ return
+$!
+$!==============================================================================
+$ check_params:
+$! subroutine that check the parameters
+$!==============================================================================
+$!
+$! check p2 (filespecificatie van de te submitten job)
+$!
+$ if f$search(p2) .eqs. "" ! bestaat deze?
+$ then
+$ say " "
+$ say " p2 (file specificatie) is onjuist: ''p2'"
+$ say " "
+$ gosub help_info
+$ exit %X28
+$ endif
+$!
+$! check p1 (jobname)
+$!
+$ if p1 .eqs. "" ! als jobname = ""
+$ then ! dan filenaam als jobname nemen
+$ say " "
+$ say " P1 is leeg. Neem filenaam als jobnaam..."
+$ say " "
+$ p1 = f$parse(p2,,"NAME")
+$ endif
+$!
+$! check p3 (plaats tbv logfile)
+$!
+$ if f$trnlnm("''p3'") .nes. "" ! Als locatie log een logical is
+$ then ! deze vertalen (ivm einde : of ])
+$ p3 = f$trnlnm("''p3'")
+$ endif
+$ dir/out=nl: 'p3' ! bestaat de opgegeven locatie?
+$ if $status .nes. "%X00000001"
+$ then
+$ say " "
+$ say "Locatie logfile bestaat niet: ''p3' "
+$ say " "
+$ gosub help_info
+$ exit %X28
+$ endif
+$!
+$! check p4 (queue waar job moet draaien)
+$!
+$ if f$trnlnm("''p4'") .nes. "" ! als waarde logical is
+$ then ! dan deze vertalen
+$ p4 = f$trnlnm("''p4'")
+$ endif
+$ qcancel = f$getqui("CANCEL_OPERATION")! init zoekactie queue
+$!
+$CHECK_QUEUE: ! zoek of queue bestaat
+$ qname = f$getqui("DISPLAY_QUEUE", -
+"QUEUE_NAME", -
+"*",)
+$ if qname .eqs. ""
+$ then
+$ say " "
+$ say " Queue ''p4' bestaat niet "
+$ say " "
+$ gosub help_info
+$ exit %X28
+$ endif
+
+$ if qname .nes. "''p4'" then goto check_queue
+$!
+$! check p5 (gebruikers-id waaronder job moet draaien)
+$!
+$ if p5 .eqs. "" ! als p5 leeg is
+$ then ! neem dan account van
+$ my_uic := 'f$user() ! huidig proces
+$ my_id = my_uic - "[" - "]" ! haal blokhaken weg
+$ if f$element (0,",",my_id) .eqs. "," ! indien geen komma aanwezig
+$ then
+$ p5 := 'my_id' ! neem argument over
+$ else ! anders het argument na de komma
+$ p5 = f$element (1,",",my_id) !
+$ endif
+$ endif
+$!
+$ assign nl: sys$output
+$ mc authorize show 'p5' ! check of account bestaat
+$ if $status .nes. "%X00000001"
+$ then
+$ deassign sys$output
+$ say " "
+$ say " User ''p5' bestaat niet "
+$ say " "
+$ gosub help_info
+$ exit %X28
+$ endif
+$ deassign sys$output
+$!
+$! check p6 (tijd of deltatijd)
+$!
+$ if p6 .nes. ""
+$ then
+$ set noon ! disable errorhandling
+$ p6 := 'f$cvtime(p6,"ABSOLUTE",) ! converteer parameter
+$ if $status .eqs. "%X00038290" ! fout-afhandeling
+$ then
+$ say " "
+$ say " onjuiste tijd parameter: ''p6'"
+$ say " "
+$ gosub help_info
+$ exit %X28
+$ endif
+$ set on ! enable errorhandling
+$ p6 := 'f$element(0," ",p6):'f$element(1," ",p6)
+$ endif
+$!
+$! Check p7 (datumstempel opnemen in filenaam logfile)
+$! default is NO, anders = YES
+$!
+$ log_filename := 'p3''p1'
+$ if p7 .nes. "YES"
+$ then
+$ p7 = "NO"
+$ else
+$ commentdate = f$cvtime(''p6',,"DATE") - "-" - "-"
+$ log_filename := 'log_filename'_'commentdate'.LOG
+$ endif
+$!
+$! Check P8 (parameters doorgeven aan te submitten batch)
+$!
+$ if f$locate("(",p8) .eqs. 0 ! check of p8 met "(" begint
+$ then
+$ if f$locate(")",p8) .nes. (f$length(p8)-1) ! maar niet met ")" eindigt
+$ then
+$ say " "
+$ say " parameterstring p8 niet goed:"
+$ say " ''p8'"
+$ say " "
+$ gosub help_info
+$ exit %X28
+$ endif
+$ endif
+$ return
+$!
+$!==============================================================================
+$ Help_info:
+$! display help info
+$!==============================================================================
+$ say "Usage:"
+$ say " $@BHR_COM:RESUBMIT -
+$ say " -"
+$ say " -"
+$ say " -"
+$ say " -"
+$ say " -"
+$ say " -"
+$ say " YES (if date must be part in logfilename) -"
+$ say " "
+$!
+$ return
+
diff --git a/resubmit-entry-dcl b/resubmit-entry-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_cmVzdWJtaXQtZW50cnktZGNs
--- /dev/null
+++ b/resubmit-entry-dcl
@@ -0,0 +1,172 @@
+resubmit_entry
+Ira Carmel, Friday January 16 2004 @ 05:07PM EST
+Example run:
+$ resubmit track_intruders
+Wait while I locate your job entry.
+
+
+
+Found TRACK_INTRUDERS entry number 3002505. Executing status is FALSE
+Job not executing, ok to resubmit.
+
+
+These commands will be executed if you go ahead to delete the entry, and resubmit as before.
+$ del/entry= 3002505
+$ submit _$1$DGA106:[IS.OPERATOR.BATCH]TRACK_INTRUDERS.COM /AFTER=16-JAN-2004:13:49:33.41 -
+/USER=OPERATOR /LOG=$1$DGA106:[IS.OPERATOR.BATCH.LOG].LOG; /QUE=SYS$BATCH_PROD1 -
+/PRIORITY=100 /NOTE=""
+
+
+Entry Jobname Username Blocks Status
+----- ------- -------- ------ ------
+3002505 TRACK_INTRUDERS OPERATOR Holding until 16-JAN-2004 13:49:33.41
+On idle batch queue SYS$BATCH_PROD1
+Submitted 16-JAN-2004 13:19:33.49 /LOG=$1$DGA106:[IS.OPERATOR.BATCH.LOG].LOG; /PRIORITY=100
+File: _$1$DGA106:[IS.OPERATOR.BATCH]TRACK_INTRUDERS.COM;9
+Do you want to freshen this batch job? Y/N: n
+Aborted, NOTHING DONE!
+$ resubmit track_intruders
+Wait while I locate your job entry.
+
+
+
+
+Found TRACK_INTRUDERS entry number 3002505. Executing status is FALSE
+Job not executing, ok to resubmit.
+
+
+These commands will be executed if you go ahead to delete the entry, and resubmit as before.
+$ del/entry= 3002505
+$ submit _$1$DGA106:[IS.OPERATOR.BATCH]TRACK_INTRUDERS.COM /AFTER=16-JAN-2004:13:49:33.41 -
+/USER=OPERATOR /LOG=$1$DGA106:[IS.OPERATOR.BATCH.LOG].LOG; /QUE=SYS$BATCH_PROD1 -
+/PRIORITY=100 /NOTE=""
+
+
+Entry Jobname Username Blocks Status
+----- ------- -------- ------ ------
+3002505 TRACK_INTRUDERS OPERATOR Holding until 16-JAN-2004 13:49:33.41
+On idle batch queue SYS$BATCH_PROD1
+Submitted 16-JAN-2004 13:19:33.49 /LOG=$1$DGA106:[IS.OPERATOR.BATCH.LOG].LOG; /PRIORITY=100
+File: _$1$DGA106:[IS.OPERATOR.BATCH]TRACK_INTRUDERS.COM;9
+Do you want to freshen this batch job? Y/N: Y
+Job TRACK_INTRUDERS (queue SYS$BATCH_PROD1, entry 3003098) holding until 16-JAN-2004 13:49
+
+$! This program will resubmit named job entries.
+$! It establishes a queue Context, and then loops through batch jobs looking for the one that you have specified in P1.
+$! This code is helpful for resubmitting reoccuring batch jobs that resubmit themselves after you have made changes.
+$!
+$! Usage:
+$! @RESUBMIT_ENTRY.COM BATCHJOBNAME
+$!
+$! P1 = JOB NAME to release.
+$!
+$! Ira Carmel 2/12/2002
+$! Some code pilfered from vms examples.
+$! Sometimes this code gets the username wrong. It prints out what it is planning on doing and then asking for a confirm.
+$! This way if you want to change something about the job submission, you can just say No, and then copy and paste the
+$! output of what is going to be done, change it, and then execute it.
+$!
+$ write sys$output "Wait while I locate your job entry."
+$ JOB_NAMEO = p1
+$ TEMP = F$GETQUI("")
+$ QLOOP:
+$ QNAME = F$GETQUI("DISPLAY_QUEUE","QUEUE_NAME","*","BATCH")
+$ IF QNAME .EQS. "" THEN EXIT
+$ JLOOP:
+$ NOACCESS = F$GETQUI("DISPLAY_JOB","JOB_INACCESSIBLE",,"ALL_JOBS")
+$ IF NOACCESS .EQS. "TRUE" THEN GOTO JLOOP
+$ IF NOACCESS .EQS. "" THEN GOTO QLOOP
+$ JNAME = F$GETQUI("DISPLAY_JOB","JOB_NAME",,"FREEZE_CONTEXT")
+$ JSTATUS = F$GETQUI("DISPLAY_JOB","JOB_EXECUTING",,"FREEZE_CONTEXT")
+$ JENTRY = F$GETQUI("DISPLAY_JOB","ENTRY_NUMBER",,"FREEZE_CONTEXT")
+$ JHOLD = F$GETQUI("DISPLAY_JOB","JOB_TIMED_RELEASE",,"FREEZE_CONTEXT")
+$ JTIME = F$GETQUI("DISPLAY_JOB","AFTER_TIME",,"FREEZE_CONTEXT")
+$ JTIME = F$EDIT(JTIME,"COMPRESS,TRIM")
+$ njtime = f$element(0," ",jtime) + ":" + f$element(1," ",jtime)
+$ JLOG = F$GETQUI("DISPLAY_JOB","JOB_LOG_SPOOL",,"FREEZE_CONTEXT")
+$ JFLAGS = F$GETQUI("DISPLAY_JOB","JOB_FLAGS",,"FREEZE_CONTEXT")
+$! JASSQ = F$GETQUI("DISPLAY_JOB","ASSIGNED_QUEUE_NAME",,"FREEZE_CONTEXT")
+$ JLOG = F$GETQUI("DISPLAY_JOB","LOG_SPECIFICATION",,"FREEZE_CONTEXT")
+$ JSPEC = F$GETQUI("DISPLAY_FILE","FILE_SPECIFICATION",,"FREEZE_CONTEXT")
+$ Jspec = f$extract(0,f$locate(";",jspec),Jspec)
+$! JASSQ = F$GETQUI("DISPLAY_JOB","ASSIGNED_QUEUE_NAME",,"FREEZE_CONTEXT")
+$ JCHAR = F$GETQUI("DISPLAY_JOB","CHARACTERISTICS",,"FREEZE_CONTEXT")
+$ JOWN = F$GETQUI("DISPLAY_JOB","UIC",,"FREEZE_CONTEXT")
+$ JPRIO = F$GETQUI("DISPLAY_JOB","PRIORITY",,"FREEZE_CONTEXT")
+$ JNOTE = F$GETQUI("DISPLAY_JOB","NOTE",,"FREEZE_CONTEXT")
+$!
+$ p1 = F$GETQUI("DISPLAY_JOB","PARAMETER_1",,"FREEZE_CONTEXT")
+$ p2 = F$GETQUI("DISPLAY_JOB","PARAMETER_2",,"FREEZE_CONTEXT")
+$ p3 = F$GETQUI("DISPLAY_JOB","PARAMETER_3",,"FREEZE_CONTEXT")
+$ p4 = F$GETQUI("DISPLAY_JOB","PARAMETER_4",,"FREEZE_CONTEXT")
+$ p5 = F$GETQUI("DISPLAY_JOB","PARAMETER_5",,"FREEZE_CONTEXT")
+$ p6 = F$GETQUI("DISPLAY_JOB","PARAMETER_6",,"FREEZE_CONTEXT")
+$ p7 = F$GETQUI("DISPLAY_JOB","PARAMETER_7",,"FREEZE_CONTEXT")
+$ p8 = F$GETQUI("DISPLAY_JOB","PARAMETER_8",,"FREEZE_CONTEXT")
+$!
+$!
+$ params = ""
+$ if p1 .nes. "" then params = params + p1
+$ if p2 .nes. "" then params = params + p2
+$ if p3 .nes. "" then params = params + p3
+$ if p4 .nes. "" then params = params + p4
+$ if p5 .nes. "" then params = params + p5
+$ if p6 .nes. "" then params = params + p6
+$ if p7 .nes. "" then params = params + p7
+$ if p8 .nes. "" then params = params + p8
+$!
+$ if params .eqs. ""
+$ then para = ""
+$ else para = "/params=(''params')"
+$ endif
+$!
+$!
+$ JOWN = JOWN - "]" - "["
+$ if f$locate(",",jown) .lt. f$length(jown) then JOWN=f$element(1,",",jown)
+$!
+$!
+$ if JNAME .eqs. JOB_NAMEO
+$ then write sys$output ""
+$ write sys$output ""
+$ write sys$output "Found ''JOB_NAMEO' entry number ''JENTRY'. Executing status is ''Jstatus'"
+$ if .NOT. JSTATUS
+$ then write sys$output "Job not executing, ok to resubmit."
+$ if .NOT. JHOLD
+$ then NJTIME = "/HOLD"
+$ else NJTIME = "/AFTER=" + NJTIME
+$ endif
+$ write sys$output ""
+$ write sys$output "These commands will be executed if you go ahead to delete the entry, and resubmit as before."
+$ write sys$output "$ del/entry= ''jentry'"
+$ write sys$output "$ submit ''jspec' ''NJTIME' -"
+$ write sys$output " /USER=''JOWN' /LOG=''JLOG' /QUE=''QNAME' ''para' -
+$ write sys$output " /PRIORITY=''JPRIO' /NOTE=""''JNOTE'"""
+$! write sys$output " /USER=''JOWN' /LOG=''JLOG' /QUE=''QNAME' ''para'
+$ write sys$output ""
+$ show entry/full 'jentry'
+$ inquire action "Do you want to freshen this batch job? Y/N"
+$ If action .eqs. "Y"
+$ THEN
+$ del/entry= 'jentry'
+$ submit 'jspec' 'NJTIME' /USER='JOWN' /LOG='JLOG' /QUE='QNAME' 'para' /PRIORITY='JPRIO' /NOTE="''JNOTE'"
+$ else write sys$output "Aborted, NOTHING DONE!"
+$ endif
+$! show sym JOWN
+$! show sym JNAME
+$! show sym JSTATUS
+$! show sym JENTRY
+$! show sym JHOLD
+$! show sym Jtime
+$! show sym nJTIME
+$! show sym JLOG
+$! show sym JFLAGS
+$! show sym JSPEC
+$! ! show sym JCHAR
+$ else write sys$output "Job already executing, aborting."
+$ inquire action "Look for another job with this name?"
+$ if action .eqs. "Y" then goto JLOOP
+$ exit 44
+$ endif
+$ exit
+$ endif
+$ GOTO JLOOP
diff --git a/robot-status-dcl b/robot-status-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_cm9ib3Qtc3RhdHVzLWRjbA==
--- /dev/null
+++ b/robot-status-dcl
@@ -0,0 +1,47 @@
+ROBOT_STATUS
+Ian Miller, Tuesday June 03 2003 @ 04:43AM EDT
+$ DEFINE/USER SYS$OUTPUT 'tmpfile'
+$ ROBOT SHOW DRIVE
+$ OPEN/READ/ERROR=TIDY TMP 'tmpfile'
+$ READ/ERROR=TIDY TMP LINE
+$ CLOSE TMP
+$ IF F$SEARCH(tmpfile) THEN DELETE/NOCONFIRM/NOLOG 'tmpfile';*
+$ LINE = F$EDIT(LINE,"COMPRESS,UPCASE")
+$ IF F$ELEMENT(0," ",LINE) .EQS. "DRIVE:" ! sanity check
+$ THEN
+$ IF F$ELEMENT(2," ",LINE) .EQS. "FULL"
+$ THEN
+$ drivefull == 1
+$ ELSE
+$ drivefull == 0
+$ ENDIF
+$ ENDIF
+$! determine slot status
+$ DEFINE/USER SYS$OUTPUT 'tmpfile'
+$ ROBOT SHOW SLOT
+$ OPEN/READ/END=DONE/ERROR=TIDY TMP 'tmpfile'
+$ NSLOTS == 0
+$L1:
+$ READ/ERROR=TIDY/END=DONE TMP LINE
+$ LINE = F$EDIT(LINE,"COMPRESS,UPCASE")
+$ IF F$ELEMENT(0," ",LINE) .EQS. "SLOT:" ! sanity check
+$ THEN
+$ sn = F$INTEGER(F$ELEMENT(1," ",LINE))
+$ NSLOTS == NSLOTS + 1
+$ IF F$ELEMENT(2," ",LINE) .EQS. "FULL"
+$ THEN
+$ slot'sn'full == 1
+$ ELSE
+$ slot'sn'full == 0
+$ ENDIF
+$ ENDIF
+$ GOTO L1
+$DONE:
+$ CLOSE TMP
+$ IF F$SEARCH(tmpfile) THEN DELETE/NOCONFIRM/NOLOG 'tmpfile';*
+$ EXIT
+$TIDY:
+$ SET NOON
+$ IF F$TYPE(TMP) .NES. "" THEN CLOSE TMP
+$ IF F$SEARCH(tmpfile) THEN DELETE/NOCONFIRM/NOLOG 'tmpfile';*
+$ EXIT
diff --git a/sars-dcl b/sars-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_c2Fycy1kY2w=
--- /dev/null
+++ b/sars-dcl
@@ -0,0 +1,68 @@
+sars.com
+Peter Barkas, Monday April 11 2005 @ 07:21AM EDT
+$! PHB 02-Mar-2005
+$! SARS Search and replace string
+$!
+$ cnt=0
+$ say:=write sys$output
+$ if p1.eqs."".or.p2.eqs."".or.p3.eqs.""
+$ then
+$ say "SARS Global search and replace string"
+$ endif
+$ if p1.eqs.""
+$ then
+$ inq file_spec "Files to process"
+$ else
+$ file_spec=p1
+$ endif
+$ if file_spec.eqs.""
+$ then
+$ goto finished
+$ endif
+$ if p2.eqs.""
+$ then
+$ inq old_string "Old string"
+$ else
+$ old_string=p2
+$ endif
+$ if old_string.eqs.""
+$ then
+$ goto finished
+$ endif
+$ if p3.eqs.""
+$ then
+$ inq new_string "New string"
+$ else
+$ new_string=p3
+$ endif
+$ if new_string.eqs.""
+$ then
+$ goto finished
+$ endif
+$ open/write tmp_ch sys$scratch:sars.tmp
+$ wri tmp_ch "global replace ",old_string," ",new_string
+$ close tmp_ch
+$ prev_file=""
+$ cnt=0
+$next_file:
+$ this_file=f$sea(file_spec)
+$ if this_file.eqs.""
+$ then
+$ goto finished
+$ endif
+$ cnt=cnt+1
+$ edit/tpu/nodisplay 'this_file'/ini=sys$scratch:sars.tmp
+$ goto next_file
+$finished:
+$ if file_spec.nes.""
+$ then
+$ if cnt.eq.0
+$ then
+$ say "No files matching ",file_spec
+$ else
+$ say cnt," files processed"
+$ endif
+$ exit
+
+
+< check_compression.com | find_file.com >
diff --git a/save-pipe-output-dcl b/save-pipe-output-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_c2F2ZS1waXBlLW91dHB1dC1kY2w=
--- /dev/null
+++ b/save-pipe-output-dcl
@@ -0,0 +1,25 @@
+AVE_PIPE_OUTPUT.COM
+Matthias Naidu, Thursday June 09 2005 @ 03:18AM EDT
+$!......Retain result of SYS$PIPE
+$ PIPE SEARCH SYS$LOGIN:LOGIN.COM "$!Author" | -
+(READ SYS$PIPE Rec ; DEFINE/NOLOG/JOB PipeResult &Rec;)
+$SHOW LOGICAL PipeResult
+$!......Loop through SYS$PIPE
+$ ProcNam = F$ENVIRONMENT("PROCEDURE")
+$!----------------------------------------------------------------------------
+$!......Check if Subroutine is called
+$ IF P1 .EQS. "ReadPipe"
+$ THEN CALL ReadPipe
+$ EXIT
+$ ENDIF
+$ PIPE command | @'ProcNam' "ReadPipe"
+$EndIt:
+$ EXIT
+$!============================================
+$ReadPipe: SUBROUTINE
+$ReadLoop:
+$ READ/END_OF_FILE=EndRead SYS$PIPE Rec
+$!------process records here
+$ GOTO ReadLoop
+$EndRead:
+$ ENDSUBROUTINE
\ No newline at end of file
diff --git a/search-replace-string-dcl b/search-replace-string-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_c2VhcmNoLXJlcGxhY2Utc3RyaW5nLWRjbA==
--- /dev/null
+++ b/search-replace-string-dcl
@@ -0,0 +1,65 @@
+sars.com
+Peter Barkas, Monday April 11 2005 @ 07:21AM EDT
+$! PHB 02-Mar-2005
+$! SARS Search and replace string
+$!
+$ cnt=0
+$ say:=write sys$output
+$ if p1.eqs."".or.p2.eqs."".or.p3.eqs.""
+$ then
+$ say "SARS Global search and replace string"
+$ endif
+$ if p1.eqs.""
+$ then
+$ inq file_spec "Files to process"
+$ else
+$ file_spec=p1
+$ endif
+$ if file_spec.eqs.""
+$ then
+$ goto finished
+$ endif
+$ if p2.eqs.""
+$ then
+$ inq old_string "Old string"
+$ else
+$ old_string=p2
+$ endif
+$ if old_string.eqs.""
+$ then
+$ goto finished
+$ endif
+$ if p3.eqs.""
+$ then
+$ inq new_string "New string"
+$ else
+$ new_string=p3
+$ endif
+$ if new_string.eqs.""
+$ then
+$ goto finished
+$ endif
+$ open/write tmp_ch sys$scratch:sars.tmp
+$ wri tmp_ch "global replace ",old_string," ",new_string
+$ close tmp_ch
+$ prev_file=""
+$ cnt=0
+$next_file:
+$ this_file=f$sea(file_spec)
+$ if this_file.eqs.""
+$ then
+$ goto finished
+$ endif
+$ cnt=cnt+1
+$ edit/tpu/nodisplay 'this_file'/ini=sys$scratch:sars.tmp
+$ goto next_file
+$finished:
+$ if file_spec.nes.""
+$ then
+$ if cnt.eq.0
+$ then
+$ say "No files matching ",file_spec
+$ else
+$ say cnt," files processed"
+$ endif
+$ exit
diff --git a/sendmail-dcl b/sendmail-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_c2VuZG1haWwtZGNs
--- /dev/null
+++ b/sendmail-dcl
@@ -0,0 +1,293 @@
+sendmail.com
+Jerry Alan Braga, Monday March 29 2004 @ 11:17AM EST
+$!
+$! Send Mail with Mime
+$!
+$! Requirements:
+$! MC MIME utility for attachment rendering
+$! TCPIP send from File utility if using SMTP
+$!
+$! Logicals if Defined
+$! define/system sendmail_mode ! "SMTP" or "MAIL"
+$! define/system sendmail_domain ! Overrides the default domain
+$! define/system sendmail_sff ! Send from file image to use for smtp
+$!
+$! Usage:
+$! @sendmail "to_address,..." "Subject" "Body" "Attachment,..." "Mode"
+$!
+$ Main:
+$!-----
+$ Gosub Initialize
+$ Gosub Header
+$ Gosub Body
+$ Gosub Attachments
+$ Gosub Send
+$ Gosub Finish
+$!
+$ Exit
+$!
+$ Initialize:
+$!-----------
+$!
+$ proc = f$edit(f$parse(f$enviornment("PROCEDURE"),,,"NAME"),"LOWERCASE,COLLAPSE")
+$ username = f$edit(f$getjpi("","USERNAME"),"LOWERCASE,COLLAPSE")
+$ pid = f$getjpi("","PID")
+$ tmp_inp = "sys$scratch:''proc'''pid'.tmp"
+$ tmp_eml = "sys$scratch:''proc'''pid'.eml"
+$ dq = """
+$!
+$! -- Get the Send From File Image --
+$!
+$ sff = f$trnlnm("''proc'_sff")
+$ if (sff .eqs. "")
+$ then sff = "$sys$system:tcpip$smtp_sff.exe"
+$ else sff = "$''sff'"
+$ endif
+$!
+$! -- Get Email Domain --
+$!
+$ inet_domain = f$edit(f$trnlnm("''proc'_domain"),"LOWERCASE,COLLAPSE")
+$ if (inet_domain .eqs. "") then inet_domain = f$edit(f$trnlnm("TCPIP$INET_DOMAIN"),"LOWERCASE,COLLAPSE")
+$!
+$! -- RFC Message ID xxxxx.xxxxx --
+$!
+$ message_id = "''f$cvtime(,,"DAYOFYEAR")'''f$cvtime(,,"SECONDOFYEAR")'"
+$ message_id = "''message_id'.''f$cvtime(,,"HOUROFYEAR")'''f$cvtime(,,"SECONDOFYEAR")'"
+$!
+$! -- RFC Date time Day, DD MON YYYY HH:MM:SS.CC --
+$!
+$ datetime = -
+f$extract(0,3,f$cvtime(,"ABSOLUTE","WEEKDAY")) + ", " + -
+f$cvtime(,"ABSOLUTE","DAY") + " " + f$cvtime(,"ABSOLUTE","MONTH") + " " + -
+f$cvtime(,"ABSOLUTE","YEAR") + " " + f$cvtime(,"ABSOLUTE","TIME")
+$!
+$! *** Start Parameters ***
+$!
+$ p_address = f$edit("''p1'","TRIM") ! Email address(s)
+$ p_subject = f$edit("''p2'","TRIM") ! Subject
+$ p_body = f$edit("''p3'","TRIM") ! Can be A Filename or message
+$ p_attach = f$edit("''p4'","TRIM") ! File(s)
+$ p_mode = f$edit("''p5'","UPCASE,COLLAPSE") ! SMTP, MAIL
+$!
+$! *** End Parameters ***
+$!
+$! -- Check Mode Logical --
+$!
+$ l_mode = f$edit(f$trnlnm("''proc'_mode"),"UPCASE,COLLAPSE")
+$ if (l_mode .nes. "" .and. p_mode .eqs. "") then p_mode = l_mode
+$!
+$! -- Address Must be passed ---
+$!
+$ if (p_address .eqs. "")
+$ then
+$ write sys$output ""
+$ write sys$output "Email Address Required"
+$ exit
+$ endif
+$!
+$! If Mode is SMTP the check for the Image Required
+$!
+$ if (p_mode .eqs. "SMTP" .and. f$search(f$extract(1,f$length(sff),sff)) .eqs. "")
+$ then
+$ write sys$output ""
+$ write sys$output "Cannot Find ''sff'"
+$ exit
+$ endif
+$!
+$! Check to See if To Address is a single address with No Domain
+$! If this is true assume the same domain as sender
+$! This emulates VMS mail based
+$! This is required as the mail/for will not work without @domain.com
+$!
+$ if (f$locate(",",p_address) .eq. f$length(p_address) .and. f$locate("@",p_address) .eq. f$length(p_address))
+$ then
+$ p_address = "''p_address'@''inet_domain'"
+$ endif
+$!
+$ return
+$!
+$ Header:
+$!-------
+$!
+$ open/write f 'tmp_eml'
+$!
+$! If No Attachments are to be Used then Must Write Text Header
+$! As MC MIME will not be used to Create it
+$!
+$ if (p_attach .eqs. "")
+$ then
+$ boundry = "OpenVMS/MIME.''message_id'"
+$ write f "Mime-version: 1.0"
+$ write f "Content-Type: multipart/mixed; boundary=''boundry'"
+$ write f "Content-Transfer-Encoding: 7bit"
+$ write f "Message-ID: <''message_id'@OpenVMS>"
+$ write f ""
+$ write f ""
+$ write f "--''boundry'"
+$ endif
+$ write f "Content-Type: text/plain; charset=ISO-8859-1"
+$ write f "Content-Transfer-Encoding: 7bit"
+$ write f "Content-Disposition: inline"
+$ write f ""
+$!
+$ close f
+$!
+$ Return
+$!
+$ Body:
+$!-----
+$!
+$! Body Of Message Can be an input file or a Text String
+$!
+$ if (f$search("''p_body'") .nes. "")
+$ then
+$ convert/append 'p_body' 'tmp_eml'
+$ else
+$ open/append f 'tmp_eml'
+$ write f "''p_body'"
+$ close f
+$ endif
+$!
+$ Return
+$!
+$ Attachments:
+$!------------
+$!
+$! Parse Multiple attachments and add according to file format
+$! using the MIME utility
+$!
+$ files = p_attach
+$ afnd = 0
+$ aloop:
+$ if (files .eqs. "") then goto aeof
+$ comma = f$locate(",",files)
+$ if (comma .ne. f$length(files))
+$ then file = f$extract(0,comma,files)
+$ else file = files
+$ endif
+$!
+$ fspec = f$search(file)
+$ if (fspec .eqs. "") then goto aloop
+$
+$ if (.not. afnd)
+$ then
+$ open/write f 'tmp_inp'
+$ write f "open/draft ''tmp_eml'"
+$ afnd = 1
+$ endif
+$!
+$! If File is FIX then must use binary type attachment
+$! Otherwise allow MIME utility to detect it
+$!
+$ rfm = f$file_attributes(fspec, "RFM")
+$ if (rfm .eqs. "FIX")
+$ then mime_type = "/BINARY"
+$ else mime_type = ""
+$ endif
+$!
+$ open/append f 'tmp_inp'
+$ write f "add''mime_type' ''file'"
+$ close f
+$!
+$ if (comma .eq. f$length(files))
+$ then files = ""
+$ else files = f$extract(comma+1,f$length(files),files)
+$ endif
+$ goto aloop
+$ aeof: if (.not. afnd) then return
+$ open/append f 'tmp_inp'
+$ write f "save"
+$ write f "exit"
+$ close f
+$!
+$! Run MIME utility with the imput file above
+$!
+$ define/user sys$input 'tmp_inp'
+$ define/user sys$output nl:
+$!
+$ mc mime
+$!
+$ delete/nolog/noconfirm 'tmp_inp';*
+$!
+$ Return
+$!
+$ Send:
+$!-----
+$!
+$ if (p_mode .eqs. "SMTP")
+$ then
+$!
+$! Parse thru all addresses and send out a email for each
+$!
+$ address = p_address - "<" - ">"
+$ fspec = f$search(tmp_eml)
+$ eloop:
+$ if (address .eqs. "") then goto eeof
+$ comma = f$locate(",",address)
+$ if (comma .ne. f$length(address))
+$ then taddress = f$extract(0,comma,address)
+$ else taddress = address
+$ endif
+$!
+$! Look for a SMTP extended formated message Name Address
+$! and Rewrite Address as "Name"
+
+$!
+$ len = f$length(taddress)
+$ pos = f$locate(" ",taddress)
+$ if (pos .ne. f$length(taddress))
+$ then
+$ pos = len
+$ al: pos = pos - 1
+$ if (f$extract(pos,1,taddress) .nes. " ") then goto al
+$ to_address = "<" + f$extract(pos+1,len,taddress) + ">"
+$ to_name = dq + f$extract(0,pos,taddress) + dq + " " + to_address
+$ else
+$ to_address = "<" + taddress + ">"
+$ to_name = to_address
+$ endif
+$!
+$! If Email is Based on Using SMTP must write full Envelope Header
+$! Have to Write the Envelope Header for Each Destination
+$!
+$ open/write f 'tmp_eml'
+$ write f "MAIL FROM:<''username'@''inet_domain'>"
+$ write f "RCPT TO:",to_address
+$ write f "DATA"
+$ write f "Reply-To: <''username'@''inet_domain'>"
+$ write f "From: <''username'@''inet_domain'>"
+$ write f "To: ",to_name
+$ write f "Subject: ",p_subject
+$ write f "Date: ",datetime
+$ close f
+$!
+$! Append the MIME rendered Version to This
+$!
+$ convert/append 'fspec' 'tmp_eml'
+$!
+$! Use the TCPIP SMTP Send From File Utility
+$!
+$ sff 'tmp_eml'
+$! sff 'tmp_eml' -loglevel 1
+$!
+$ if (comma .eq. f$length(address))
+$ then address = ""
+$ else address = f$extract(comma+1,f$length(address),address)
+$ endif
+$ goto eloop
+$ eeof:
+$ else
+$!
+$! Use Standard Mail With the Foreign Switch
+$!
+$ mail/for/subject="''p_subject'" 'tmp_eml' "''p_address'"
+$ endif
+$!
+$ delete/nolog/noconfirm 'tmp_eml';*
+$!
+$ return
+$!
+$ Finish:
+$!-------
+$!
+$ exit
diff --git a/sendmailmime-dcl b/sendmailmime-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_c2VuZG1haWxtaW1lLWRjbA==
--- /dev/null
+++ b/sendmailmime-dcl
@@ -0,0 +1,23 @@
+GETLIB.COM
+Tim Sneddon, Monday October 26 2009 @ 09:29AM EDT
+$ set noon
+$ on warning then goto bail_out
+$ on control_y then goto bail_out
+$
+$ say = "write sys$output"
+$
+$ p1 = f$edit(p1,"TRIM,UNCOMMENT,COLLAPSE,UNCOMMENT")
+$ if (p1 .eqs. "") then p1 = f$getjpi("","PID")
+$
+$ pipe say "show process/id=''p1'" -
+| analyze/system -
+| search sys$pipe "JIB" -
+| ( read sys$pipe result ; -
+define/job/nolog pipe_result &result; )
+$
+$ jibadr = f$element(5," ",f$edit(f$trnlnm("PIPE_RESULT"),"COMPRESS,TRIM"))
+$
+$ say "The job table for process ''p1' is LNM$JOB_''jibadr'"
+$
+$bail_out:
+$ exitt 1
diff --git a/setdef-dcl b/setdef-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_c2V0ZGVmLWRjbA==
--- /dev/null
+++ b/setdef-dcl
@@ -0,0 +1,100 @@
+setdef.com
+Peter Barkas, Tuesday April 05 2005 @ 08:05AM EDT
+$ say:==write sys$output
+$
+$ user_size=p1
+$ node_size=p2
+$ devi_size=p3
+$ dire_size=p4
+$ subd_size=p5
+$ last_bit=p6
+$
+$ new_default=""
+$ if p7.eqs.""
+$ then
+$ if f$type(sdthere).nes.""
+$ then
+$ if sdthere.nes.""
+$ then
+$ new_default=sdthere
+$ endif
+$ endif
+$ else
+$ if p7.eqs."."
+$ then
+$ new_default=sdhome
+$ else
+$ if p7.eqs."?"
+$ then
+$ goto help
+$ else
+$ new_default=p7
+$ endif
+$ endif
+$ endif
+$ default=f$env("default")
+$ sdthere==default
+$ define/key/nolog/term/noecho/erase pf3 "sd ''sdthere'"
+$ set def 'new_default'
+$ sdhere==f$env("default")
+$ if f$type(sdhome).eqs.""
+$ then
+$ sdhome==new_default
+$ endif
+$ nodename=f$getsyi("nodename")
+$ username=f$edi(f$getjpi(0,"username"),"collapse")
+$ dev=f$par(f$env("default"),,,"device")
+$ dire_bit=f$ext(0,1,dir_dir)+f$edi(f$ext(1,dire_size-1,dir_dir),"lowercase")
+$ subd_bit=f$ext(0,1,sub_dir)+f$edi(f$ext(1,dire_size-1,sub_dir),"lowercase")
+$ if dir_dir.eqs.username
+$ then
+$ dire_bit=""
+$ endif
+$ if sub_dir.eqs.username
+$ then
+$ subd_bit=""
+$ endif
+$
+$ prompt=node_bit+user_bit+devi_bit+dire_bit+subd_bit+last_bit
+$
+$ set prompt="''prompt'"
+$ exit
+$help:
+$ type sys$input
+
+P.H.Barkas 24-Nov-2004
+A set def procedure setting prompt to node/user/device/directory/sub-directory/suffix
+
+
+p1 Size of Node bit
+p2 Size of User bit
+p3 Size of Device bit
+p4 Size of Directory bit
+p5 Size of Sub-directory bit
+p6 Suffix
+p7 Required Default Directory
+
+
+Example usage:
+
+
+sd:==@setdef.com 2 3 5 4 5 """> ""
+sd [.PROCEDURES.SETUP]
+If node is MYNODE user is SMITH disk is SHORT the prompt is set to "MySmiShortProcSetup> "
+
+
+If the directory bit is the same as the user bit it is omitted
+SD with no argument or PF3 returns to the previous directory
+SD [] just sets the prompt
+SD . returns to the directory that was specified when SD was first used in this session
+
+
+Symbol sdthere is set to the previous default
+sdhere is set to the current default
+
+
+$ exit
+
+
+
+< SHOW_NODE_INFO.COM | reorg.com >
diff --git a/show-bg-dcl b/show-bg-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_c2hvdy1iZy1kY2w=
--- /dev/null
+++ b/show-bg-dcl
@@ -0,0 +1,46 @@
+SHOW_BG
+Ian Miller, Tuesday June 03 2003 @ 04:38AM EDT
+$!
+$! SHOW_BG.COM - shows UCX BG devices
+$!
+$ ON CONTROL_Y THEN GOTO END
+$ ON WARNING THEN GOTO END
+$ tmpfilename = "SYS$SCRATCH:TEMP''F$GETJPI(0,"PID")'.TMP"
+$ DEFINE/USER SYS$OUTPUT 'tmpfilename'
+$ UCX SHOW DEVICE
+$ OPEN/READ/ERR=NOFILE TMP 'tmpfilename'
+$ READ/ERROR=ENDOFFILE TMP LINE
+$L1:
+$ READ/ERROR=ENDOFFILE TMP LINE
+$ devname = F$EDIT(F$EXTRACT(2,6,LINE),"COLLAPSE")
+$ IF devname .EQS. "" THEN GOTO L1
+$ addr = F$EDIT(F$EXTRACT(55,20,LINE),"COLLAPSE")
+$ IF addr .EQS. "0.0.0.0" THEN GOTO L1
+$ addr = F$FAO("!15AS",addr)
+$ local_port = F$EDIT(F$EXTRACT(23,5,LINE),"COLLAPSE")
+$ remote_port = F$EDIT(F$EXTRACT(31,5,LINE),"COLLAPSE")
+$ ownerpid = F$GETDVI(devname,"PID")
+$ username = F$GETJPI(ownerpid,"USERNAME")
+$ service = "local ''local_port' remote ''remote_port'"
+$ IF local_port .EQS. "118" THEN service = "SQL/Services"
+$ IF local_port .EQS. "23" THEN service = "TELNET"
+$ IF local_port .EQS. "611" THEN service = "RDBSERVER"
+$ IF local_port .EQS. "512" THEN service = "REXEC"
+$ IF local_port .EQS. "514" THEN service = "RSH"
+$ IF local_port .EQS. "139" THEN service = "Pathworks"
+$ IF local_port .EQS. "1995" THEN service = "FTSO"
+$ IF local_port .EQS. "21" THEN service = "REXEC"
+$ IF remote_port .EQS. "6000" THEN service = "X Window"
+$ WRITE SYS$OUTPUT "''devname' ''addr' ''ownerpid' ''username' ''service'"
+$ GOTO L1
+$ENDOFFILE:
+$ CLOSE TMP
+$END:
+$ IF F$TYPE(TMP) .NES. "" THEN CLOSE TMP
+$ IF F$SEARCH(tmpfilename) .NES. "" THEN DELETE/NOLOG/NOCONFIRM 'tmpfilename';*
+$ EXIT
+$NOFILE:
+$ xx = $STATUS
+$ WRITE SYS$OUTPUT "Error opening temporary file"
+$ WRITE SYS$OUTPUT F$MESSAGE(XX)
+$ GOTO END
\ No newline at end of file
diff --git a/show-node-info-dcl b/show-node-info-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_c2hvdy1ub2RlLWluZm8tZGNs
--- /dev/null
+++ b/show-node-info-dcl
@@ -0,0 +1,318 @@
+SHOW_NODE_INFO.COM
+Robert Boyd, Monday April 04 2005 @ 06:33PM EDT
+$!From: rapickering@miavx1.acs.muohio.edu
+$! Significantly edited by R.L. Boyd
+$!
+$! TARGET_INCLUDE = TOOLS_TARGETS.COM
+$!
+$ say := write sys$output
+$ say " "
+$ nform = "!47AS !SL"
+$ tform = "!47AS !AS"
+$ hform = "!47AS %X!XL"
+$
+$SERIAL_NUMBER: subroutine
+$ set noon
+$ synum = f$getsyi("SERIAL_NUMBER")
+$ serial_number = synum
+$ if version.lts."V7.3-1"
+$then
+$ if f$type(synum).nes.""
+$ then
+$ if synum.nes.""
+$ then
+$ byte = 1
+$ serial_number = " "
+$Byte_Loop:
+$ nxt_byte = f$extract(2*(byte-1),2,synum)
+$ byte = 1+byte
+$ if nxt_byte.eqs."00" then $ goto Byte_Loop
+$ if nxt_byte.nes.""
+$ then ! non-null byte
+$ nxt_byte_char[0,8] = %X'nxt_byte'
+$ serial_number = nxt_byte_char+serial_number
+$! show symbol serial_number
+$ goto Byte_Loop
+$ endif ! non-null byte
+$ endif ! synum not null
+$ endif ! synum exists
+$endif ! version number
+$
+$ serial_number == f$edit(serial_number,"TRIM")
+$EXIT:
+$ exit
+$endsubroutine
+$
+$ nodename = f$getsyi("nodename")
+$ arch_name = f$getsyi("ARCH_NAME")
+$ version = f$edit(f$getsyi("version"),"trim")
+$ topsys = f$trnlnm("SYS$TOPSYS")
+$ say "You are on a ", f$getsyi("HW_NAME"), " named ", f$getsyi("NODENAME"), "."
+$ say "It's DECnet address is ",f$getsyi("node_area"),".",-
+f$getsyi("node_number")
+$ say "The operating system is ",f$getsyi("node_swtype")," ",f$getsyi("Arch_NAME"),-
+" ",version
+$ say "It was last booted on ", f$getsyi("boottime"),"."
+$ say "From system root SYS$SYSDEVICE:[",topsys,"]"
+$ say f$fao("This system has !SL cpu!1%C!%Es!%F; !SL !1%Cis!%Eare!%F active.",-
+f$getsyi("availcpu_cnt"), f$getsyi("activecpu_cnt"))
+$ page_size = f$getsyi("PAGE_SIZE")
+$ ram_size = (f$getsyi("MEMSIZE")/1024)*page_size/1024
+$ say "This system has ", ram_size," MB of RAM"
+$ if .not. f$getsyi("cluster_member")
+$ then
+$ say "It is not a member of a VMScluster."
+$ else
+$ say f$fao("It is a member of a VMScluster containing !SL node!1%C!%Es!%F."-
+, f$getsyi("cluster_nodes"))
+$ if f$trnlnm("SYS$CLUSTER_NODE").nes."" then -
+$ say "The cluster alias nodename is: ",f$trnlnm("SYS$CLUSTER_NODE")
+$ say F$fao("This VMScluster has a total cluster quorum of !SL votes, and "-
+, f$getsyi("cluster_quorum"))
+$ say f$fao("!19* !SL total cluster vote!1%C!%Es!%F.",-
+f$getsyi("cluster_votes"))
+$ say F$fao("This node's quorum value is !SL and it has !SL vote!1%C!%Es!%F.", -
+f$getsyi("node_quorum"), f$getsyi("node_votes"))
+$ endif
+$ say " "
+$ say "F$GETSYI Items for the Local Node Only"
+$ say " "
+$ say f$fao(tform,"Node name:",f$getsyi("decnet_fullname"))
+$ say f$fao(nform,"The DECnet area for ''nodename':",f$getsyi("node_area"))
+$ say f$fao(nform,"The DECnet number:",f$getsyi("node_number"))
+$ say f$fao(nform,"The CSID:",f$getsyi("node_csid"))
+$ say f$fao(nform,"Node's ''ARCH_NAME' model type:",f$getsyi("hw_model"))
+$ say f$fao(tform,"The ''ARCH_NAME' model name:",f$getsyi("hw_name"))
+$ say f$fao(tform,"Hardware type:",f$getsyi("node_hwtype"))
+$ say f$fao(tform,"Hardware version:",f$getsyi("node_hwvers"))
+$ if arch_name.eqs."VAX" then -
+$ say f$fao(nform,"Processor type:",f$getsyi("cpu"))
+$ if arch_name.eqs."Alpha"
+$ then
+$ call Serial_Number
+$ say f$fao(tform,"Serial Number:",serial_number)
+$ say f$fao(tform,"Console Version:",f$getsyi("console_version"))
+$ say f$fao(tform,"Palcode Version:",f$getsyi("palcode_version"))
+$ say f$fao(nform,"CPU type:",f$getsyi("cputype"))
+$ say f$fao(nform,"Real CPU type:",f$getsyi("real_cputype"))
+$ say f$fao(nform,"System type:",f$getsyi("systype"))
+$ say f$fao(tform,"Auto Action:",f$getenv("Auto_action"))
+$ say f$fao(tform,"Boot device:",f$getenv("boot_dev"))
+$ say f$fao(tform,"Boot File:",f$getenv("booted_file"))
+$ say f$fao(tform,"Boot OS Flags",f$getenv("booted_osflags"))
+$ if version.gts."V7.1" then -
+$ say f$fao(tform,"Boot Default device:",f$getenv("bootdef_dev"))
+$ say f$fao(tform,"Boot Default File:",f$getenv("boot_file"))
+$ say f$fao(tform,"Boot Default OS Flags",f$getenv("boot_osflags"))
+$ say f$fao(tform,"Boot_Reset:",f$getenv("boot_reset"))
+$ say f$fao(tform,"Console Dump Device:",f$getenv("Dump_dev"))
+$ endif
+$ if f$trnlnm("CLUE$DOSD_DEVICE").nes.""
+$ then
+$ dump_device = f$trnlnm("CLUE$DOSD_DEVICE")
+$ else
+$ dump_device = f$trnlnm("SYS$SYSDEVICE")
+$ endif
+$ dump_style = f$getsyi("DUMPSTYLE")
+$ dump_selective = 1
+$ dump_console_full = 2
+$ dump_off_system_disk = 4
+$ dump_compressed = 8
+$ dump_enable_range = %X0008000
+$ dump_dosd_range = %X0FFF0000
+$ dump_dosd_shift = %X00010000
+$
+$ if (dump_style.and.dump_selective) .eq. (dump_selective)
+$ then
+$ dump_form = "selective"
+$ else
+$ dump_form = "full"
+$ endif
+$ if (dump_style.and.dump_console_full) .eq. (dump_console_full)
+$ then
+$ dump_console = "minimal"
+$ else
+$ dump_console = "full"
+$ endif
+$!
+$ if (dump_style.and.dump_off_system_disk) .eq. (dump_off_system_disk)
+$ then
+$ dump_location = "off of the system disk"
+$ else
+$ dump_location = "to the system disk"
+$ endif
+$!
+$ if (dump_style.and.dump_compressed) .eq. (dump_compressed )
+$ then
+$ dump_way = "compressed (Valid for Alpha)"
+$ if arch_name.eqs."VAX" then -
+$ dump_way = "compressed (INVALID for VAX)"
+$ else
+$ dump_way= "uncompressed"
+$ endif
+$!
+$ if (dump_style.and.dump_enable_range) .eq. (dump_enable_range )
+$ then
+$ dump_unit = (dump_style.and.dump_dosd_range)/dump_dosd_shift
+$ endif
+$!
+$ dump_device = dump_device -":" + ":"
+$ dump_file = f$search(dump_device+"["+topsys+".sysexe]sysdump.dmp;")
+$ dump_size = f$file_attribute(dump_file,"EOF")
+$ say f$fao(tform,"The "+dump_form+" dump will be written:",dump_location)
+$ if f$type(dump_unit).nes."" then -
+$ say f$fao(tform,"The dump will be written to disk unit:",dump_unit)
+$ say f$fao(tform,"System Dump Device:",dump_device)
+$ say f$fao(tform,"The dump format will be:",dump_way)
+$ say f$fao(tform,"The console dump output format will be:",dump_console)
+$ say f$fao(tform,"Dump file:",dump_file-dump_device)
+$ say f$fao(nform,"Dump File Size in blocks:",dump_size)
+$ ratio_dump_ram = f$fao("!SL%",100*(dump_size/2054)/ram_size)
+$ say f$fao(tform,"Dump size as a percent of RAM size",RATIO_DUMP_RAM)
+$ say f$fao(nform,"Count of CPUs actively participating in boot:",f$getsyi("activecpu_cnt"))
+$ say f$fao(nform,"CPUs recognized in the system:",f$getsyi("availcpu_cnt"))
+$ say f$fao(tform,"Type of operating system software used:",f$getsyi("node_swtype"))
+$ say f$fao(tform,"Software version:",f$getsyi("node_swvers"))
+$ say f$fao(nform,"System identification number:",f$getsyi("node_systemid"))
+$ say f$fao(tform,"System identification register:",f$fao("!XL",f$getsyi("sid")))
+$ say f$fao(hform,"Architecture flags for the system:",f$getsyi("archflag"))
+$ say f$fao(tform,"Time the system was booted:",f$getsyi("boottime"))
+$ say f$fao(nform,"Number of bytes per system page unit:",page_size)
+$ say f$fao(nform,"Number of free pages in current paging files:",f$getsyi("pagefile_free"))
+$ say f$fao(nform,"Number of pages in current paging files:",f$getsyi("pagefile_page"))
+$ say f$fao(nform,"Number of free pages in swapping files:",f$getsyi("swapfile_free"))
+$ say f$fao(nform,"Number of pages in swapping files:",f$getsyi("swapfile_page"))
+$ say f$fao(nform,"Number of system pages for error log buffers:",f$getsyi("errorlogbuffers"))
+$ say f$fao(nform,"Total number free, contiguous global pages:",f$getsyi("contig_gblpages"))
+$ free_gblpages = f$getsyi("free_gblpages")
+$ used_gblpagcnt = f$getsyi("used_gblpagcnt")
+$ used_gblpagmax = f$getsyi("used_gblpagmax")
+$ total_gblpages = free_gblpages+used_gblpagcnt
+$ ratio_gblpages = f$fao("!SL%",(10*free_gblpages/(total_gblpages/10)))
+$ ratio_gblpagmax = f$fao("!SL%",(10*(total_gblpages-used_gblpagmax)/(total_gblpages/10)))
+$ say f$fao(nform,"Current # of free global pages:",free_gblpages)
+$ say f$fao(nform,"Current # of global pages in use:",used_gblpagcnt)
+$ say f$fao(tform,"Current % of global pages free:",ratio_gblpages)
+$ say f$fao(nform,"Maximum # of global pages used since boot:",used_gblpagmax)
+$ say f$fao(tform,"Minimum % of global pages free since boot:",ratio_gblpages)
+$ say f$fao(nform,"Current count of free global sections:",f$getsyi("free_gblsects"))
+$ say f$fao(tform,"Character string instructions are emulated:",f$getsyi("character_emulated"))
+$ say f$fao(tform,"Decimal string instructions are emulated:",f$getsyi("decimal_emulated"))
+$ say f$fao(tform,"D_floating string instructions are emulated:",f$getsyi("d_float_emulated"))
+$ say f$fao(tform,"F_floating string instructions are emulated:",f$getsyi("f_float_emulated"))
+$ say f$fao(tform,"G_floating string instructions are emulated:",f$getsyi("g_float_emulated"))
+$ say " "
+$ if f$getsyi("cluster_member")
+$ then
+$ say "F$GETSYI Items related to the VMScluster."
+$ call show_cluster
+$ say f$fao(tform,"System Communication Subsystem installed:",f$getsyi("scs_exists"))
+$! say f$fao(tform,"Node is member of the local VMScluster:",f$getsyi("cluster_member"))
+$! say f$fao(tform,"Time first node in VMScluster was booted:",f$getsyi("cluster_ftime"))
+$ say f$fao(hform,"System identification number - founding node:",f$getsyi("cluster_fsysid"))
+$! say f$fao(nform,"Total number of nodes in the VMScluster:",f$getsyi("cluster_nodes"))
+$! say f$fao(nform,"Quorum that the node has:",f$getsyi("node_quorum"))
+$! say f$fao(nform,"Number of votes that the node has:",f$getsyi("node_votes"))
+$! say f$fao(nform,"Total quorum for the VMScluster:",f$getsyi("cluster_quorum"))
+$! say f$fao(nform,"Total number of votes in the VMScluster:",f$getsyi("cluster_votes"))
+$ say f$fao(hform,"Software incarnation number:",f$getsyi("node_swincarn"))
+$endif ! cluster member
+$ say " "
+$ say "F$GETSYI Items 'not supported' - Not in DCL dictionary"
+$ say " "
+$ say f$fao(tform,"System rights:",f$getsyi("system_rights"))
+$ say f$fao(nform,"Vector Processor emulation installed:",f$getsyi("vector_emulator"))
+$ say f$fao(nform,"Vector Processor mask:",f$getsyi("vp_mask"))
+$ say f$fao(nform,"Vector processor number:",f$getsyi("vp_number"))
+$EXIT:
+$ exit
+$SHOW_CLUSTER: SUBROUTINE
+$ IF F$GETSYI("CLUSTER_MEMBER") .EQS. "FALSE" THEN GOTO NOT_CLUSTER
+$ IF p1 .nes. "" THEN GOTO NOT_CLUSTER
+$ ftime = f$getsyi( "cluster_ftime" )
+$ fsysid = f$getsyi( "cluster_fsysid" )
+$ nodes = f$getsyi( "cluster_nodes" )
+$ votes = f$getsyi( "cluster_votes" )
+$ quorum = f$getsyi( "cluster_quorum" )
+$ FDAY = F$CVTIME( FTIME,, "WEEKDAY" )
+$ FDATE = F$CVTIME( FTIME, "ABSOLUTE", "DATE" )
+$ FTIME = F$CVTIME( FTIME,, "TIME" )
+$ SAY ""
+$ SAY F$FAO( "OpenVMS Cluster founded on !AS, !AS at !AS", FDAY, FDATE, FTIME )
+$ SAY F$FAO( "by System Id !AS; Membership: !UL, Total Votes: !UL, Quorum:!UL", -
+F$EXTR( 4, 8, FSYSID ), nodes, votes, quorum )
+$ SAY ""
+$ SAY "Node Vo Qu System O/S Arch O/S Hardware"
+$ SAY "Name te or Id CSID Name Name Vers Name"
+$ CONTEXT = ""
+$START:
+$ id = F$CSID (CONTEXT)
+$ IF id .EQS. "" THEN goto clu_EXIT
+$ nodename = F$GETSYI ("NODENAME",,id)
+$ hdwe_name = F$GETSYI("HW_NAME",,id)
+$ arch_name = F$GETSYI("ARCH_NAME",,id) ! This works on V7.2 and later only.
+$ if arch_name .eqs. ""
+$ then
+$ gosub mk_arch_name
+$ endif
+$ soft_type = F$GETSYI("NODE_SWTYPE",,id)
+$ soft_vers = F$GETSYI("NODE_SWVERS",,id)
+$ soft_vers = F$GETSYI("VERSION", nodename )
+$ syst_idnt = F$GETSYI("NODE_SYSTEMID",,id)
+$ node_votes = F$GETSYI("NODE_VOTES",,id)
+$ node_quorum = F$GETSYI("NODE_QUORUM",,id)
+$ gosub op_node_info
+$ GOTO START
+$clu_EXIT:
+$ qdsk = f$edit( f$getsyi( "disk_quorum" ), "trim" )
+$ qdkv = f$getsyi( "qdskvotes" )
+$ if qdsk .nes. ""
+$ then
+$ say ""
+$ say f$fao( " Quorum disk !AS contributes !UL vote!%S.", qdsk, 'qdkv' )
+$ endif
+$ say ""
+$ exit
+$!
+$NOT_CLUSTER:
+$ nodename = F$GETSYI ("NODENAME")
+$ hdwe_name = F$GETSYI("HW_NAME")
+$ arch_name = F$GETSYI("ARCH_NAME") ! This works on V7.2 and later only.
+$ if arch_name .eqs. ""
+$ then
+$ gosub mk_arch_name
+$ endif
+$ soft_type = F$GETSYI("NODE_SWTYPE")
+$ soft_vers = F$GETSYI("NODE_SWVERS")
+$ syst_idnt :=
+$ IF F$GETSYI("CLUSTER_MEMBER") .EQS. "FALSE"
+$ THEN
+$ SAY ""
+$ SAY " Not a member of a cluster."
+$ ENDIF
+$ SAY ""
+$ SVERS = F$GETSYI( "VERSION" )
+$ btime = F$EDIT( f$getsyi( "boottime" ), "TRIM" )
+$ BDAY = F$CVTIME( BTIME,, "WEEKDAY" )
+$ BDATE = F$CVTIME( BTIME, "ABSOLUTE", "DATE" )
+$ BTIME = F$CVTIME( BTIME,, "TIME" )
+$ sroot = f$trnlnm( "sys$topsys" )
+$ SAY F$FAO( " OpenVMS !AS booted on !AS, !AS at !AS", SVERS, BDAY, BDATE, BTIME )
+$ SAY F$FAO( " from root !AS (!AS)", SROOT - "SYS", SROOT )
+$ SAY ""
+$ gosub op_node_info
+$ EXIT
+$!
+$mk_arch_name:
+$ arch_name = f$elem( 0, " ", hdwe_name - "Compaq " - "COMPAQ " ) -
+- "Server" - "server" - "Station" - "station" - "Micro"
+$ return
+$!
+$op_node_info:
+$ say f$fao( "!8AS !2SL !2SL !AS !AS - !AS !AS !AS !AS", -
+nodename, node_votes, node_quorum, F$EXTR( 4, 8, syst_idnt ), "''id'", -
+soft_type, arch_name, soft_vers, hdwe_name )
+$ return
+$
+$ENDSUBROUTINE ! showcluster
+$!Last Modified: 21-MAR-2005 15:41:48.38
\ No newline at end of file
diff --git a/show-pagefile-dcl b/show-pagefile-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_c2hvdy1wYWdlZmlsZS1kY2w=
--- /dev/null
+++ b/show-pagefile-dcl
@@ -0,0 +1,44 @@
+SHOW_PAGEFILE
+Ian Miller, Tuesday June 03 2003 @ 04:39AM EDT
+$ say := WRITE SYS$OUTPUT
+$ say "USERNAME PROCESS STATE ",-
+"PGF# PGFCNT SWF# SWFCNT WSSIZE IMAGE NAME"
+$ a = """
+$ pid = ""
+$ context = ""
+$ approx_pagefile = 0
+$ approx_swapfile = 0
+$COM_LOOP:
+$ pid = F$PID(context)
+$ IF pid .EQS. "" THEN GOTO COM_LOOP_DONE
+$ pid = a+pid+a
+$ state = F$GETJPI('pid,"STATE")
+$ username = F$GETJPI('pid,"USERNAME")
+$ IF username .EQS. "" THEN username = ""
+$ IF F$LENGTH(username).GT.8 THEN username = F$EXTRACT(0,7,username)
+$ prcnam = F$GETJPI('pid,"PRCNAM")
+$ imagename = F$GETJPI('pid,"IMAGNAME")
+$ imagename = F$PARSE(imagename,,,"NAME")
+$ pagfilloc = F$GETJPI('pid,"PAGFILLOC") !page file location #
+$ pagfilloc = F$EXTRACT(0,2,pagfilloc)
+$ IF pagfilloc .EQS. "" THEN pagfilloc = "--"
+$ pagfilcnt = F$GETJPI('pid,"PAGFILCNT") !remaning pagefile quota
+$ pgflquota = F$GETJPI('pid,"PGFLQUOTA") !initial page file quota
+$ pages_used = pgflquota - pagfilcnt !approx page file usage
+$ approx_pagefile = approx_pagefile + pages_used
+$ swpfilloc = F$GETJPI('pid,"SWPFILLOC") !swap file location #
+$ swpfilloc = F$EXTRACT(0,2,swpfilloc)
+$ IF swpfilloc .EQS. "" THEN swpfilloc = "--"
+$ wssize = F$GETJPI('pid,"WSSIZE") !approx swap slot usage
+$ wsquota = F$GETJPI('pid,"WSQUOTA") !working set quota
+$ swfcnt = wssize
+$ IF swfcnt .GT. wsquota THEN swfcnt = wsquota !swapslot goes to WSQUOTA
+$ approx_swapfile = approx_swapfile + wssize
+$ text = F$FAO("!8AS !15AS !6AS !2AS !6SL !2AS !6SL !6SL !32AS", -
+username,prcnam,state,pagfilloc,pages_used,swpfilloc,swfcnt,wssize, -
+" "+imagename)
+$ text = F$EXTRACT(0,79,text)
+$ say text
+$ GOTO COM_LOOP
+$COM_LOOP_DONE:
+$ say "Approx. total Pagefile Space = ",approx_pagefile
diff --git a/show-quotas-dcl b/show-quotas-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_c2hvdy1xdW90YXMtZGNs
--- /dev/null
+++ b/show-quotas-dcl
@@ -0,0 +1,213 @@
+SHOW_QUOTA.COM
+Ian Miller, Tuesday June 03 2003 @ 04:34AM EDT
+$!----------------------------------------------------------------------------
+$! This procedure shows the given quota and the remaining quota of a process.
+$! It uses the process id as first parameter.
+$!
+$! Take the results as an idea of how much quota is used. Do not take all
+$! the values for granted because they are updated in a certain interval.
+$! Specialy the peak values may differ from what SHOW PROCESS/ACCOUNTING
+$! does give you.
+$!
+$!
+$! Written 1990 by A.Schwarz
+$! Softwaresupport Digital Equipment Corporation Switzerland
+$!
+$! Modified 1992 (with Ideas of Eric)
+$! ADDED SYSGEN VALUES (MAX and PQL)
+$! ADDED recalculation of vaules after subprocess creatation.(Quota sharing)
+$!
+$!----------------------------------------------------------------------------
+$ waittime := "00:00:02" ! Time till new values are read and displayed.
+$!======================
+$!
+$ on control_y then gosub set_flag
+$ on error then goto end
+$ on warning then goto end
+$ set broadcast=none
+$ flag := false
+$ ini_time = F$TIME()
+$!
+$! User def. symbols
+$!
+$ IF "''P1'" .EQS. "" THEN P1 = F$GETJPI("","PID")
+$ A = """
+$ SIMPLE_PID = P1
+$ PID = A+SIMPLE_PID+A
+$! delete screen
+$!===============
+$ ESC[0,7]=27
+$ WRITE SYS$OUTPUT "''ESC'[2J"
+$ WRITE SYS$OUTPUT "''ESC'[0;0H"
+$ WRITE SYS$OUTPUT " "
+$!
+$BASE:
+$!
+$ FIRST_LOOP := TRUE
+$!
+$ NAME = F$GETJPI('PID,"PRCNAM")
+$ ASTLM = F$GETJPI('PID,"ASTLM")
+$ FILLM = F$GETJPI('PID,"FILLM")
+$ DIOLM = F$GETJPI('PID,"DIOLM")
+$ BIOLM = F$GETJPI('PID,"BIOLM")
+$ BYTLM = F$GETJPI('PID,"BYTLM")
+$ TQLM = F$GETJPI('PID,"TQLM")
+$ ENQLM = F$GETJPI('PID,"ENQLM")
+$ MODE = F$GETJPI('PID,"MODE")
+$ PRIB = F$GETJPI('PID,"PRIB")
+$ PRCLM = F$GETJPI('PID,"PRCLM")
+$ LOGINTIM = F$GETJPI('PID,"LOGINTIM")
+$ PGFLQUOTA = F$GETJPI('PID,"PGFLQUOTA")
+$ WSDEFAULT = F$GETJPI('PID,"DFWSCNT")
+$ WSQUOTA = F$GETJPI('PID,"WSQUOTA")
+$ WSEXTENT = F$GETJPI('PID,"WSEXTENT")
+$ WSMAX = F$GETSYI("WSMAX")
+$ PQL_DWSDEFAULT= F$GETSYI("PQL_DWSDEFAULT")
+$ PQL_DWSQUOTA = F$GETSYI("PQL_DWSQUOTA")
+$ PQL_DWSEXTENT = F$GETSYI("PQL_DWSEXTENT")
+$ VIRTUALPAGECNT= F$GETSYI("VIRTUALPAGECNT")
+$ PRCCNT = F$GETJPI('PID,"PRCCNT")
+$ PRCCNT_INI = PRCCNT
+$!
+$LOOP:
+$!
+$!
+$ STATE = F$GETJPI('PID,"STATE")
+$ IMAGE = F$GETJPI('PID,"IMAGNAME")
+$ ASTCNT = 'ASTLM - F$GETJPI('PID,"ASTCNT")
+$ FILCNT = 'FILLM - F$GETJPI('PID,"FILCNT")
+$ DIOCNT = 'DIOLM - F$GETJPI('PID,"DIOCNT")
+$ BIOCNT = 'BIOLM - F$GETJPI('PID,"BIOCNT")
+$ BYTCNT = 'BYTLM - F$GETJPI('PID,"BYTCNT")
+$ TQCNT = 'TQLM - F$GETJPI('PID,"TQCNT")
+$ ENQCNT = 'ENQLM - F$GETJPI('PID,"ENQCNT")
+$ PAGFILCNT = 'PGFLQUOTA - F$GETJPI('PID,"PAGFILCNT")
+$ WSSIZE = F$GETJPI('PID,"WSSIZE")
+$ GLOBAL = F$GETJPI('PID,"GPGCNT")
+$ PROCESS = F$GETJPI('PID,"PPGCNT")
+$ FAULTS = F$GETJPI('PID,"PAGEFLTS")
+$ CPUTIM = F$GETJPI('PID,"CPUTIM")
+$ CPU_SEC = CPUTIM / 100
+$ CPU_HUND = CPUTIM - (CPU_SEC * 100)
+$ CPUTIME = "''CPU_SEC'.''CPU_HUND'"
+$!
+$ IF FIRST_LOOP THEN GOSUB INIT
+$!
+$! Get max used quotas
+$!=====================
+$!
+$ IF 'ASTCNT .gt. 'MAX_ASTCNT THEN MAX_ASTCNT = 'ASTCNT
+$ IF 'FILCNT .gt. 'MAX_FILCNT THEN MAX_FILCNT = 'FILCNT
+$ IF 'DIOCNT .gt. 'MAX_DIOCNT THEN MAX_DIOCNT = 'DIOCNT
+$ IF 'BIOCNT .gt. 'MAX_BIOCNT THEN MAX_BIOCNT = 'BIOCNT
+$ IF 'BYTCNT .gt. 'MAX_BYTCNT THEN MAX_BYTCNT = 'BYTCNT
+$ IF 'TQCNT .gt. 'MAX_TQCNT THEN MAX_TQCNT = 'TQCNT
+$ IF 'ENQCNT .gt. 'MAX_ENQCNT THEN MAX_ENQCNT = 'ENQCNT
+$ IF 'PAGFILCNT .gt. 'MAX_PAGFILCNT THEN MAX_PAGFILCNT = 'PAGFILCNT
+$ IF 'WSSIZE .gt. 'MAX_WSSIZE THEN MAX_WSSIZE = 'WSSIZE
+$ IF 'GLOBAL .gt. 'MAX_GLOBAL THEN MAX_GLOBAL = 'GLOBAL
+$!
+$! Print quotas and counts
+$!========================
+$!
+$! WRITE SYS$OUTPUT
+$!
+$ TEXT = F$FAO("!ASProcess Name: !AS State: !AS Actual time: !AS", -
+"''ESC'[0;0H",NAME, STATE, F$TIME()," ")
+$ WRITE SYS$OUTPUT TEXT
+$ IMAGE = F$PARSE(IMAGE,,,"NAME")
+$!
+$ TEXT = F$FAO("Image Name: !AS PID: !AS Mode: !AS !AS", -
+IMAGE, SIMPLE_PID, MODE," ")
+$ WRITE SYS$OUTPUT TEXT
+$ TEXT = F$FAO("!10AS!AS!AS!30AS!2SL!1AS!2SL", -
+"CpuTime :",CPUTIME," seconds"," SubprocessLimit/Count : ", PRCLM, "/", PRCCNT)
+$ WRITE SYS$OUTPUT TEXT
+$ WRITE SYS$OUTPUT " "
+$ WRITE SYS$OUTPUT "Process Quota Information:"
+$ WRITE SYS$OUTPUT -
+" Quota Used (pct.) MAX_Used since ''ini_time'"
+$ PERCENT = ( ASTCNT * 100 / ASTLM )
+$ TEXT = F$FAO("!10AS!3(8SL)%!8SL", "ASTLM", ASTLM, ASTCNT, PERCENT, MAX_ASTCNT)
+$ WRITE SYS$OUTPUT TEXT
+$ PERCENT = ( FILCNT * 100 / FILLM )
+$ TEXT = F$FAO("!10AS!3(8SL)%!8SL", "FILLM", FILLM, FILCNT, PERCENT, MAX_FILCNT)
+$ WRITE SYS$OUTPUT TEXT
+$ PERCENT = ( DIOCNT * 100 / DIOLM )
+$ TEXT = F$FAO("!10AS!3(8SL)%!8SL", "DIOLM", DIOLM, DIOCNT, PERCENT, MAX_DIOCNT)
+$ WRITE SYS$OUTPUT TEXT
+$ PERCENT = ( BIOCNT * 100 / BIOLM )
+$ TEXT = F$FAO("!10AS!3(8SL)%!8SL", "BIOLM", BIOLM, BIOCNT, PERCENT, MAX_BIOCNT)
+$ WRITE SYS$OUTPUT TEXT
+$ PERCENT = ( BYTCNT * 100 / BYTLM )
+$ TEXT = F$FAO("!10AS!3(8SL)%!8SL", "BYTLM", BYTLM, BYTCNT, PERCENT, MAX_BYTCNT)
+$ WRITE SYS$OUTPUT TEXT
+$ PERCENT = ( ENQCNT * 100 / ENQLM )
+$ TEXT = F$FAO("!10AS!3(8SL)%!8SL", "ENQLM", ENQLM, ENQCNT, PERCENT, MAX_ENQCNT)
+$ WRITE SYS$OUTPUT TEXT
+$ PERCENT = ( TQCNT * 100 / TQLM )
+$ TEXT = F$FAO("!10AS!3(8SL)%!8SL", "TQLM", TQLM, TQCNT, PERCENT,MAX_TQCNT)
+$ WRITE SYS$OUTPUT TEXT
+$ PERCENT = ( PAGFILCNT * 100 / PGFLQUOTA )
+$ TEXT = F$FAO("!10AS!3(8SL)%!8SL!8SL!18AS", -
+"PGFLQUOTA", PGFLQUOTA, PAGFILCNT, -
+PERCENT,MAX_PAGFILCNT,VIRTUALPAGECNT," VIRTUALPAGECNT")
+$ WRITE SYS$OUTPUT TEXT
+$ WRITE SYS$OUTPUT ""
+$ WRITE SYS$OUTPUT "Working Set Information: "
+$ WRITE SYS$OUTPUT " Max_size "
+$ TEXT = F$FAO("!10AS!8SL!33SL!15AS", -
+"WSEXTENT", WSEXTENT, PQL_DWSEXTENT," PQL_DWSEXTENT")
+$ WRITE SYS$OUTPUT TEXT
+$ TEXT = F$FAO("!10AS!8SL!33SL!15AS", -
+"WSQUOTA", WSQUOTA, PQL_DWSQUOTA," PQL_DWSQUOTA")
+$ WRITE SYS$OUTPUT TEXT
+$ TEXT = F$FAO("!10AS!8SL!33SL!15AS", -
+"WSDEFAULT", WSDEFAULT, PQL_DWSDEFAULT," PQL_DWSDEFAULT")
+$ WRITE SYS$OUTPUT TEXT
+$ TEXT = F$FAO("!10AS!2(8SL)!25SL!15AS", -
+"WSSIZE", WSSIZE, MAX_WSSIZE, WSMAX," WSMAX")
+$ WRITE SYS$OUTPUT TEXT
+$ TOTAL = GLOBAL + PROCESS
+$ TEXT = F$FAO("!10AS!8SL", "PAGES", TOTAL)
+$ WRITE SYS$OUTPUT TEXT
+$ TEXT = F$FAO("!10AS!8SL", "FAULTS", FAULTS)
+$ WRITE SYS$OUTPUT TEXT
+$ WAIT 'waittime
+$ if flag then goto end
+$!
+$!
+$ PRCCNT = F$GETJPI('PID,"PRCCNT")
+$ IF PRCCNT .EQ. PRCCNT_INI THEN GOTO BASE
+$!
+$ GOTO LOOP
+$!------------------------------------------------------------------------------
+$!
+$end:
+$!
+$ set broadcast=all
+$ WRITE SYS$OUTPUT "''ESC'[22;0H"
+$ exit
+$!
+$!------------------------------------------------------------------------------
+$set_flag:
+$!
+$ flag := true
+$ return
+$!------------------------------------------------------------------------------
+$!
+$INIT:
+$!
+$ MAX_ASTCNT = 'ASTCNT
+$ MAX_FILCNT = 'FILCNT
+$ MAX_DIOCNT = 'DIOCNT
+$ MAX_BIOCNT = 'BIOCNT
+$ MAX_BYTCNT = 'BYTCNT
+$ MAX_TQCNT = 'TQCNT
+$ MAX_ENQCNT = 'ENQCNT
+$ MAX_PAGFILCNT = 'PAGFILCNT
+$ MAX_WSSIZE = 'WSSIZE
+$ MAX_GLOBAL = 'GLOBAL
+$!
+$ FIRST_LOOP := FALSE
+$ RETURN
diff --git a/show-uaf-dcl b/show-uaf-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_c2hvdy11YWYtZGNs
--- /dev/null
+++ b/show-uaf-dcl
@@ -0,0 +1,23 @@
+GETLIB.COM
+Tim Sneddon, Monday October 26 2009 @ 09:29AM EDT
+$ set noon
+$ on warning then goto bail_out
+$ on control_y then goto bail_out
+$
+$ say = "write sys$output"
+$
+$ p1 = f$edit(p1,"TRIM,UNCOMMENT,COLLAPSE,UNCOMMENT")
+$ if (p1 .eqs. "") then p1 = f$getjpi("","PID")
+$
+$ pipe say "show process/id=''p1'" -
+| analyze/system -
+| search sys$pipe "JIB" -
+| ( read sys$pipe result ; -
+define/job/nolog pipe_result &result; )
+$
+$ jibadr = f$element(5," ",f$edit(f$trnlnm("PIPE_RESULT"),"COMPRESS,TRIM"))
+$
+$ say "The job table for process ''p1' is LNM$JOB_''jibadr'"
+$
+$bail_out:
+$ exitt 1
diff --git a/smtpproc-dcl b/smtpproc-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_c210cHByb2MtZGNs
--- /dev/null
+++ b/smtpproc-dcl
@@ -0,0 +1,145 @@
+MTP_PROC.COM
+Edward Alexander, Tuesday December 07 2004 @ 02:24PM EST
+$ Set NoOn
+$ MYPID = F$GETJPI("","PID")
+$ MYFILE = "[.MAIL]SMTP_PROC_" + F$STRING(MYPID) + ".SMTP$MSG"
+$ SMTP_NORMAL_QUEUE = "TCPWARE_SMTP"
+$
+$! Check DEBUG
+$ DEBUG = 0
+$ DEBUG_LOGICAL = F$TRNLNM("SMTP_PROC_DEBUG")
+$ IF F$STRING(DEBUG_LOGICAL) .NES. "" THEN DEBUG = 1
+$!
+$! Get TO: and HEADER_LIST_NAME lines from subroutine
+$ HEADER_LIST = "X-DELIVER-LIST-NAME: "
+$ HEADER_LIST_NAME = "NONE"
+$ GOSUB SUB_GET_ADDR
+$! End GOSUB
+$! Convert FROM to a RFC addr (ie strip SMTP%)
+$
+$ ORIG_FROM = FROM
+$ NEW_FROM = "<" + F$EXTRACT(6,F$LENGTH(FROM) - 6,FROM)
+$ QUOTE_LOC = F$LOCATE("""",NEW_FROM)
+$ NEW_FROM['QUOTE_LOC',1] := >
+$ IF DEBUG .EQ. 1 THEN WRITE SYS$OUTPUT "NEW_FROM: " + NEW_FROM
+$
+$ IF F$EXTRACT(0,4,ORIG_FROM) .NES. "SMTP"
+$ THEN
+$! Undo the removal above
+$! N.B. This should *NEVER* happen as DELIVER only passes us SMTP% addrs, but....
+$ FROM = ORIG_FROM
+$ NEW_FROM = ORIG_FROM
+$ ENDIF
+$
+$!
+$ OPEN/WRITE OF 'MYFILE'
+$ WRITE OF "MAIL FROM:" + NEW_FROM
+$ IF DEBUG .EQ. 1 THEN WRITE SYS$OUTPUT "MAIL FROM:" + NEW_FROM
+$ WRITE OF "RCPT TO:" + SEND_TO
+$ IF DEBUG .EQ. 1 THEN WRITE SYS$OUTPUT "RCPT TO:" + SEND_TO
+$ WRITE OF "ARRIVAL_TIME: " + f$time()
+$ IF DEBUG .EQ. 1 THEN WRITE SYS$OUTPUT "ARRIVAL_TIME: " + f$time()
+$ WRITE OF "X-DELIVER-From: " + FROM
+$ IF DEBUG .EQ. 1 THEN WRITE SYS$OUTPUT "X-DELIVER-From: " + FROM
+$ WRITE OF "X-DELIVER-MailFrom: " + NEW_FROM
+$ IF DEBUG .EQ. 1 THEN WRITE SYS$OUTPUT "X-DELIVER-MailFrom: " + NEW_FROM
+$ WRITE OF "X-DELIVER-To: " + TO
+$ IF DEBUG .EQ. 1 THEN WRITE SYS$OUTPUT "X-DELIVER-To: " + TO
+$ WRITE OF "X-DELIVER-Subject: " + SUBJECT
+$ IF DEBUG .EQ. 1 THEN WRITE SYS$OUTPUT "X-DELIVER-Subject: " + SUBJECT
+$ WRITE OF "X-DELIVER-RCPT-To: " + SEND_TO
+$ IF DEBUG .EQ. 1 THEN WRITE SYS$OUTPUT "X-DELIVER-RCPT-To: " + SEND_TO
+$ WRITE OF HEADER_LIST + HEADER_LIST_NAME
+$ IF DEBUG .EQ. 1 THEN WRITE SYS$OUTPUT HEADER_LIST + HEADER_LIST_NAME
+
+$! Build Received line
+$ HOST = F$TRNLNM("TCPWARE_DOMAINNAME")
+$ ACCT = f$getjpi("","UIC")
+$ VMSVER = f$getjpi("","NODE_VERSION")
+$ RECEV1 = "Received: from " + HOST + " (" + MESSAGE_FILE + ")"
+$ RECEV2 = " by " + HOST + " (TCPware on OpenVMS " + VMSVER + ")"
+$ RECEV3 = " with DELIVER (" + ACCT + ") for " + TO
+$ RECEV4 = " from "+ NEW_FROM + " at " + f$time()
+$! RECEV = RECEV1 + RECEV2
+$! End build received line
+$ WRITE/SYM OF RECEV1
+$ IF DEBUG .EQ. 1 THEN WRITE/SYM SYS$OUTPUT RECEV1
+$ WRITE/SYM OF RECEV2
+$ IF DEBUG .EQ. 1 THEN WRITE/SYM SYS$OUTPUT RECEV2
+$ WRITE/SYM OF RECEV3
+$ IF DEBUG .EQ. 1 THEN WRITE/SYM SYS$OUTPUT RECEV3
+$ WRITE/SYM OF RECEV4
+$ IF DEBUG .EQ. 1 THEN WRITE/SYM SYS$OUTPUT RECEV4
+$ OPEN/READ IF 'MESSAGE_FILE'
+$READ_LOOP:
+$ READ/ERR=READ_END/END=READ_END IF IR
+$ WRITE OF IR
+$ GOTO READ_LOOP
+$READ_END:
+$ CLOSE IF
+$END_PROC:
+$ CLOSE OF
+$ IF DEBUG .EQ. 1
+$ THEN
+$ SUBMIT/DELETE/QUEUE='SMTP_NORMAL_QUEUE'/HOLD 'MYFILE'
+$ ELSE
+$ SUBMIT/DELETE/QUEUE='SMTP_NORMAL_QUEUE' 'MYFILE'
+$ ENDIF
+$ EXIT
+$
+$! Subroutines
+$SUB_GET_ADDR:
+$!! **** CHANGE THE ADDRESSES BELOW ****
+$ SEND_TO = ""
+$ LIST_TO = ""
+$! HEADER_LIST_NAME should be set to mailing list name.
+$! If left alone, then will default to NONE - i.e. personal msg.
+$!
+$ IF F$EDIT(TO,"UPCASE,COLLAPSE") .EQS. "INFO-VAX@MVB.SAIC.COM"
+$ THEN
+$ HEADER_LIST_NAME = "INFO-VAX"
+$ SEND_TO = LIST_TO
+$ RETURN
+$ ENDIF
+$!
+$ IF F$EDIT(TO,"UPCASE,COLLAPSE") .EQS. "HERCULES-390@YAHOOGROUPS.COM"
+$ THEN
+$ HEADER_LIST_NAME = "HERCULES"
+$ SEND_TO = LIST_TO
+$ RETURN
+$ ENDIF
+$!
+$!
+$ IF F$EDIT(TO,"UPCASE,COLLAPSE") .EQS. "TURNKEY-MVS@YAHOOGROUPS.COM"
+$ THEN
+$ HEADER_LIST_NAME = "HERCULES"
+$ SEND_TO = LIST_TO
+$ RETURN
+$ ENDIF
+$!
+$ IF F$LOCATE("SECURITYFOCUS.COM",F$EDIT(TO,"UPCASE,COLLAPSE")) .NE. F$LENGTH(F$EDIT(TO,"COLLAPSE"))
+$ THEN
+$ HEADER_LIST_NAME = "BUGTRAQ"
+$ SEND_TO = LIST_TO
+$ RETURN
+$ ENDIF
+$
+$ IF F$LOCATE("SECURITYFOCUS.COM",F$EDIT(CC,"UPCASE,COLLAPSE")) .NE. F$LENGTH(F$EDIT(CC,"COLLAPSE"))
+$ THEN
+$ HEADER_LIST_NAME = "BUGTRAQ"
+$ SEND_TO = LIST_TO
+$ RETURN
+$ ENDIF
+$
+$!!!
+$ RETURN
+$!!!
+$!!
+$ IF P1 .NES. ""
+$ THEN
+$ WRITE SYS$OUTPUT "Overriding SEND_TO with P1: " + P1
+$ SEND_TO = "<" + P1 + ">"
+$ RETURN
+$ ENDIF
+$RETURN
+
diff --git a/space-dcl b/space-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_c3BhY2UtZGNs
--- /dev/null
+++ b/space-dcl
@@ -0,0 +1,107 @@
+
+
+
+
+
+TOP_DISCONNECT
+Jan van den Ende, Friday January 23 2004 @ 10:07AM EST
+Finds, kills, and reports disconnected processes ( submitted after a request at the ITRC forum )
+$!
+$! DISCLAMER:
+$!
+$! NO RESPONIBILITY WHATSOVER WILL BE ACCEPTED FOR ANY MALFUNCTION; NOR
+$! FOR ANY DAMAGE, DIRECT OR INDIRECT, THAT MAY RESULT FROM USE OF THIS
+$! SOFTWARE.
+$!
+$! The texts above form an integral part of this software.
+$!
+$! Filename : Stop_disconnect.com
+$! Author : Frank Wagenaar
+$! Date : november 2000
+$! 021129 jpe: Logfile, to find WHY the job disappears
+$! 010928 jpe: Move to MONITOR_SPU, Auto resubmit
+$! 001127 JHA: Adapt for batch processing, add logging.
+$!
+$!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+$!
+$! The texts above form an integral part of this software.
+$
+$!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+$
+$! For all kind of privilege-requiring general jobs, we have a special user
+$! account, with NO interactive access. ( SPU means Special Privileged User )
+$
+$!---------------
+$
+$! USER_PERS_LOG is the logical name of a directory that receives logging.
+$! Make sure to have some cleanup of it as well!
+$
+$!-----------------------------------------------------------------------------
+$
+$ reqpriv=("sysprv,world")
+$!
+$ if f$getjpi("","mode") .nes. "BATCH"
+$ then
+$ reqpriv = reqpriv + ",cmkrnl"
+$ sub_user = "/user=monitor_spu"
+$ endif
+$
+$ savepriv=f$setprv(reqpriv)
+$ if .not. f$privilege(reqpriv) then goto not_privileged
+$
+$ vandaag = f$cvtime("today","comparison","date") - "-" - "-"
+$ thisproc=f$environment("procedure")
+$
+$ submit -
+'sub_user' -
+/after="+0:10" -
+/nolog -
+/noprint -
+/queue=axp_batch -
+/restart -
+'f$parse(";0",thisproc)
+$
+$ if f$getjpi("","mode") .eqs. "INTERACTIVE" then goto reset_privileges
+$
+$ if f$search("user_pers_log:stop_disconn_proc.*") .nes. ""
+$ then
+$ deletee user_pers_log:stop_disconn_proc.*.* /before="today-35-"
+$ endif
+$
+$ pipe show user/full |search sys$input disconnected/output=sys$login:disc.tmp
+$ wait 00:00:05
+$ vandaag ==f$cvtime("","comparison","date") - "-" - "-"
+$ nu ==f$cvtime("","absolute","time")
+$! set ver
+$ file_bl=f$file_attributes("sys$login:disc.tmp","eof")
+$ if file_bl .eq. 0 then goto einde
+$ if f$search ("user_pers_log:stop_disconn_proc.''vandaag'") .nes. ""
+$ then
+$ open/append log user_pers_log:stop_disconn_proc.'vandaag'
+$ else
+$ open/write log user_pers_log:stop_disconn_proc.'vandaag'
+$ endif
+$ open/read ifi sys$login:disc.tmp
+$read:
+$ read/end=einde ifi line
+$ if line .eqs. "" then goto read
+$ user=f$extract(1,8,line)
+$ pid=f$extract(39,8,line)
+$ on error then goto read
+$ stop/id='pid'
+$ set noon
+$ write log -
+"Disconnected Process Id = ''pid' gebruiker ''user' removed at ''nu'"
+$ goto read
+$einde:
+$reset_privileges:
+$not_privileged:
+$ if f$trnlnm ("ifi","lnm$process") .nes. "" then close ifi
+$ if f$trnlnm ("log","lnm$process") .nes. "" then close log
+$ if f$search("sys$login:disc.tmp") .nes. ""
+$ then
+$ delete/noconfirm/nolog sys$login:disc.tmp;*
+$ endif
+$exit
+
+
diff --git a/spacev2-dcl b/spacev2-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_c3BhY2V2Mi1kY2w=
--- /dev/null
+++ b/spacev2-dcl
@@ -0,0 +1,170 @@
+space.com v2
+Jan van den Ende, Thursday May 27 2004 @ 07:27AM EDT
+$ ! File: MONITOR_HS.COM
+$!
+$! DISCLAMER:
+$!
+$! NO RESPONIBILITY WHATSOVER WILL BE ACCEPTED FOR ANY MALFUNCTION; NOR
+$! FOR ANY DAMAGE, DIRECT OR INDIRECT, THAT MAY RESULT FROM USE OF THIS
+$! SOFTWARE.
+$ !+
+$ ! Author: the late Phil "Philber" Lemette
+$ ! Bowhouse data
+$
+$ ! Adaptations: J.P. van den Ende ! 20040123: Now merged into:
+$ ! Bowhouse Data PinkRoccade Industry
+$ ! Savannahweg 17 De Brand 16
+$ ! 3542 AW Utrecht Amersfoort
+$ ! Netherlands
+$!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+$!
+$! The texts above form an integral part of this software.
+$! Modify as needed, but leave us our credits.
+$!
+$!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+$!
+$! some initial:
+$ esc[0,7]=27
+$ veel="''esc'[7m"
+$ erg ="''esc'[1m"
+$ oeps="''esc'[5m"
+$ norm="''esc'[0m"
+$ space=" "
+$
+$ pct_veel = 80 !
+$ pct_erg = 90 ! > signalling levels
+$ pct_oeps = 95 !/
+$
+$ say = "write sys$output "
+$
+$ if f$mode() .eqs. "BATCH"
+$ then
+$ veel="''esc'[4m"
+$ dd=f$cvtim("","comparison","day")
+$ mm=f$cvtim("","comparison","month")
+$ yy=f$cvtim("","comparison","year")
+$ say " "
+$ say " Disk usage dd: ''dd'-''mm'-''yy'"
+$ say " ==============================================
+$ say " "
+$ say " (''pct_veel'% of Maximum is considered Useable,"
+$ say " ''pct_erg'% full gives considerable performance degadation,"
+$ say " ''pct_oeps'% indicates potential user program trouble.)"
+$ say " "
+$ endif
+$ type sys$input
+Name Disk Type Free Used Maximum Useable %Full
+=========================================================================
+$ mag_t = 0
+$ fre_t = 0
+$ use_t = 0
+$ tot_t = 0
+$
+$loop:
+$ disk = f$device("*","disk") - "_"
+$ if disk .eqs. "" then goto final
+$ gosub subspace
+$ goto loop
+$ !
+$final:
+$
+$ PERCFULL = ( USE_t/(tot_t/100) ) + 1 ! if USE_t * 100 grows > 2 G blocks
+$ ! the result evaluates negative
+$ if percfull .ge. 100
+$ then
+$ eind ="!!!"+norm
+$ else
+$ eind =norm+" "
+$ endif
+$ if percfull .ge. pct_oeps
+$ then
+$ gaatut=" " + oeps
+$ else
+$ gaatut=" " + norm
+$ endif
+$ if percfull .ge. pct_erg
+$ then
+$ gaatut=gaatut+erg
+$ else
+$ gaatut=gaatut+norm
+$ endif
+$ if percfull .ge. pct_veel
+$ then
+$ gaatut=gaatut+veel
+$ else
+$ gaatut=gaatut+norm
+$ endif
+$ unt="Blocks:"
+$ if f$mode() .eqs. "BATCH" then say " "
+$ say -
+" ------- ------- -------- -------"
+$ TEXT= F$FAO -
+("!28AS!7AS!9SL!9SL!10SL!9SL!13AS!3SL!8AS",-
+space,unt,FRE_t,USE_t,tot_t,mag_t,gaatut,PERCFULL,eind)
+$ say TEXT
+$ fre_t = fre_t / 2048
+$ mag_t = mag_t / 2048
+$ use_t = use_t / 2048
+$ tot_t = tot_t / 2048
+$ unt="Mbytes:"
+$ TEXT= F$FAO -
+("!28AS!7AS!9SL!9SL!10SL!9SL",-
+space,unt,FRE_t,USE_t,tot_t,mag_t)
+$ say TEXT
+$ exit
+$!----------------------------------------
+$subspace:
+$ ! subroutine level 1 of space.com
+$ if .not. f$getdvi(disk,"mnt") then return
+$ if f$getdvi(disk,"swl") then return
+$ if f$getdvi(disk,"shdw_member") then return
+$ if f$getdvi(disk,"devtype") .gt. 128 .and. -
+f$getdvi(disk,"devtype") .lt. 140 then return ! "Foreign disk"; eg NFS
+$ name = f$getdvi(disk,"volnam")
+$ max = f$getdvi(disk,"maxblock")
+$! hw = f$getdvi(disk,"media_name")
+$ hw = f$getdvi(disk,"device_type_name") - "DEC "
+$ disk = disk - ":"
+$ freeblocks = f$getdvi(disk,"freeblocks")
+$ usedblocks = max - freeblocks
+$ mag = (max/100)*80 - usedblocks
+$ fre_t = fre_t + freeblocks
+$ mag_t = mag_t + mag
+$ tot_t = tot_t + max
+$ use_t = use_t + usedblocks
+$
+$ percfull =(usedblocks/(max/100)) + 1 ! if USED * 100 grows > 2 G blocks
+$ ! the result evaluates negative
+$ if percfull .ge. 100
+$ then
+$ eind ="!!!"+norm
+$ else
+$ eind =norm+" "
+$ endif
+$ if percfull .ge. pct_oeps
+$ then
+$ gaatut=" " + oeps
+$ else
+$ gaatut=" " + norm
+$ endif
+$ if percfull .ge. pct_erg
+$ then
+$ gaatut=gaatut+erg
+$ else
+$ gaatut=gaatut+norm
+$ endif
+$ if percfull .ge. pct_veel
+$ then
+$ gaatut=gaatut+veel
+$ else
+$ gaatut=gaatut+norm
+$ endif
+$ text= f$fao -
+("!5AS!13AS!11AS!6AS!9SL!9SL!10SL!9SL!13AS!3SL!8AS",-
+space,name,disk,hw,freeblocks,usedblocks,max,mag,gaatut,percfull,eind)
+$ if f$mode() .eqs. "BATCH" then say " "
+$ say text
+$ return
+
+
+
diff --git a/springfor-dcl b/springfor-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_c3ByaW5nZm9yLWRjbA==
--- /dev/null
+++ b/springfor-dcl
@@ -0,0 +1,177 @@
+SPRINGFOR.COM
+David B Sneddon, Monday November 01 2004 @ 06:27AM EST
+
+$ ! Procedure: SPRINGFOR.COM
+$ __vfy = "VFY_''f$parse(f$environment("procedure"),,,"name")'"
+$ if (f$type('__vfy') .eqs. "") then __vfy = 0
+$ __vfy_saved = f$verify(&__vfy)
+$ procedure = f$element(0,";",f$environment("PROCEDURE"))
+$ procedure_name = f$parse(procedure,,,"NAME")
+$ facility = procedure_name
+$ location = f$parse(procedure,,,"DEVICE","NO_CONCEAL") -
++ f$parse(procedure,,,"DIRECTORY","NO_CONCEAL") - "]["
+$ set noon
+$ on control_y then goto bail_out
+$ _arch_type = f$getsyi("ARCH_TYPE")
+$!$ _arch_name = f$getsyi("ARCH_NAME") ! "OTHER,VAX,Alpha,IA-64"
+$ _arch_name = f$element(_arch_type,",","OTHER,VAX,ALPHA,IPF") - ","
+$ _vax = (_arch_type .eq. 1)
+$ _axp = (_arch_type .eq. 2)
+$ _ipf = (_arch_type .eq. 3)
+$ _other = (.not. (_vax .or. _axp .or. _ipf))
+$ scsnode = f$edit(f$getsyi("SCSNODE"),"COLLAPSE,UPCASE")
+$ special_nodes = "/NODE1/NODE2/" !*** these nodes have a tick length of 8333
+$ say = "write sys$output"
+$ set default sys$manager
+$ if (_vax)
+$ then call do_vax
+$ linkit = "link"
+$ else
+$ if (_axp)
+$ then call do_axp
+$ linkit = "link/sysexe"
+$ else
+$ if (_ipf)
+$ then call do_ipf
+$ linkit = "link/sysexe"
+$ endif
+$ endif
+$ endif
+$ macroo/nolist springfor
+$ linkit/notrace/nomap springfor
+$ deletee/nolog springfor.obj;*
+$ deletee/nolog springfor.mar;*
+$ run springfor
+$ wait 05:00:00.00
+$ set time = "''f$time()'"
+$ set time
+$ deletee/nolog sys$manager:springfor.exe;*
+$bail_out:
+$ !'f$verify(__vfy_saved)'
+$ exitt 1
+$
+$do_axp: subroutine
+$ if (f$locate("/''scsnode'/",special_nodes) .ne. f$length(special_nodes))
+$ then
+$ call do_axp_special
+$ else
+$ call do_axp_standard
+$ endif
+$ exitt 1
+$ endsubroutine
+$
+$do_axp_standard: subroutine
+$ set noon
+$ ! ticklength is 9765
+$ copyy sys$input springfor.mar
+.title springfor, adjust VMS clock to run 25% fast for four hours
+.library "SYS$LIBRARY:LIB.MLB"
+.entry springfor, ^m<>
+$cmkrnl_s routin=fixit
+movl #1, r0
+ret
+.entry fixit, ^m<>
+lock hwclk
+movl #14745600, g^exe$gl_timeadjust ; 4*60*60*1024 = four hours
+; 1024 = 10000000/9765
+movl #12206, g^exe$gl_ticklength ; that's 9765*125/100
+unlock hwclk
+movl #1, r0
+ret
+.end springfor
+$ exitt 1
+$ endsubroutine
+$
+$do_axp_special: subroutine
+$ set noon
+$ ! ticklength is 8333
+$ copyy sys$input springfor.mar
+.title springfor, adjust VMS clock to run 25% fast for four hours
+.library "SYS$LIBRARY:LIB.MLB"
+.entry springfor, ^m<>
+$cmkrnl_s routin=fixit
+movl #1, r0
+ret
+.entry fixit, ^m<>
+lock hwclk
+movl #17280000, g^exe$gl_timeadjust ; 4*60*60*1200 = four hours
+; 1200 = 10000000/8333
+movl #10416, g^exe$gl_ticklength ; that's 8333*125/100
+unlock hwclk
+movl #1, r0
+ret
+.end springfor
+$ exitt 1
+$ endsubroutine
+$
+$do_ipf: subroutine
+$ set noon
+$ ! ticklength is 10000
+$ copyy sys$input springfor.mar
+.title springfor, adjust VMS clock to run 25% fast for four hours
+.library "SYS$LIBRARY:LIB.MLB"
+.entry springfor, ^m<>
+$cmkrnl_s routin=fixit
+movl #1, r0
+ret
+.entry fixit, ^m<>
+lock hwclk
+movl #14400000, g^exe$gl_timeadjust ; 4*60*60*1000 = four hours
+; 1000 = 10000000/10000
+movl #12500, g^exe$gl_ticklength ; that's 10000*125/100
+unlock hwclk
+movl #1, r0
+ret
+.end springfor
+$ exitt 1
+$ endsubroutine
+$
+$do_vax: subroutine
+$ set noon
+$ copyy sys$input springfor.mar
+.title springfor, adjust VMS clock to run 25% fast for four hours
+.library "SYS$LIBRARY:LIB.MLB"
+.link "SYS$SYSTEM:SYS.STB" /selective_search
+.entry springfor, ^m<>
+$cmkrnl_s routin=fixit
+movl #1, r0
+ret
+.entry fixit, ^m<>
+lock hwclk
+movl #1440000, g^exe$gl_timeadjust ; 4*60*60*100 = four hours
+movl #125000, g^exe$gl_ticklength ; that's 100000*125/100
+unlock hwclk
+movl #1, r0
+ret
+.end springfor
+$ exitt 1
+$ endsubroutine
+$ !+==========================================================================
+$ !
+$ ! Procedure: SPRINGFOR.COM
+$ !
+$ ! Purpose: This procedure will set the VMS clock to run 25% fast for four
+$ ! hours resulting in a one hour gradual advancement in time.
+$ ! The gradual change has advantages for things like database
+$ ! timestamps and the like.
+$ !
+$ ! PLEASE read the above procedure and understand what it does before
+$ ! using it -- pay particular attention to the special_nodes symbol.
+$ ! That symbol should contain a list of Alpha nodes that have a tick
+$ ! length of 8333 as opposed to the more common 9765.
+$ ! In SDA, use EXAMINE EXE$GL_TICKLENGTH.
+$ !
+$ ! Parameters:
+$ !
+$ ! History:
+$ ! 18-Jan-1999, DBS; Version X1-001
+$ ! 001 - Original version (in this format).
+$ ! 14-Mar-1999, DBS; Version X1-002
+$ ! 002 - Fixup link /SYSEXE qualifier to be alpha only.
+$ ! 02-Aug-1999, DBS; Version X1-003
+$ ! 003 - Now use a list of node names to determine which code to
+$ ! generate - should really use something else, but...
+$ ! 31-Oct-2004, DBS; Version X1-004
+$ ! 004 - Update the architecture checking stuff to handle Itanium and
+$ ! added code for Itanium.
+$ !-==========================================================================
\ No newline at end of file
diff --git a/stat-dcl b/stat-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_c3RhdC1kY2w=
--- /dev/null
+++ b/stat-dcl
@@ -0,0 +1,49 @@
+STAT$STARTUP
+Sebastiano Salvati, Sunday March 14 2010 @ 12:13PM EDT
+$!------------------------------------------------------------------------------
+$!
+$! STAT$STARTUP.COM
+$!
+$!------------------------------------------------------------------------------
+$!
+$! Procedure to activate, as a detached process, of the system statistic data
+$! collector STAT$COLLECTOR.COM
+$!
+$! Version 07 Release date: 24 May 1996
+$!------------------------------------------------------------------------------
+$!
+$ if f$getjpi("","prcnam") .eqs. "STAT$RESTART" then wait 00:00:10
+$!
+$ define/system/executive/nolog STAT$ARCHIVE D1:[MON$ARCHIVE]
+$ define/system/executive/nolog STAT$CENTRAL_SITE 3078::STAT$CENTRAL_RECEIVE:
+$!
+$ ctx = ""
+$ temp = f$context("process",ctx,"prcnam","STAT$COLLECTOR","eql")
+$ pid = f$pid(ctx)
+$ if pid .nes. ""
+$ then
+$ stop/id='pid'
+$ else
+$ continue
+$ endif
+$!
+$ if f$search("SYS$SPECIFIC:[SYSMGR]STAT$COLLECTOR.LOG") .nes. "" -
+then set protection=(world:r) SYS$SPECIFIC:[SYSMGR]STAT$COLLECTOR.LOG;*
+$!
+$ if f$search("SYS$SPECIFIC:[SYSMGR]STAT$COLLECTOR.LOG-2") .nes. "" -
+then purge/noconfirm/nolog/keep=2 -
+SYS$SPECIFIC:[SYSMGR]STAT$COLLECTOR.LOG
+$!
+$ write sys$output "creating now the STAT$COLLECTOR process."
+$ run SYS$SYSTEM:LOGINOUT.EXE -
+/detached -
+/input=SYS$COMMON:[SYSMGR]STAT$COLLECTOR.COM -
+/output=SYS$SPECIFIC:[SYSMGR]STAT$COLLECTOR.LOG -
+/error=SYS$SPECIFIC:[SYSMGR]STAT$COLLECTOR.LOG -
+/process_name="STAT$COLLECTOR" -
+/working_set=8192 -
+/maximum_working_set=16384 -
+/extent=32768 -
+/noswap
+$!
+$ exit
diff --git a/status-dcl b/status-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_c3RhdHVzLWRjbA==
--- /dev/null
+++ b/status-dcl
@@ -0,0 +1,1004 @@
+STATUS.COM
+Karl Rohwedder, Thursday December 18 2003 @ 05:38AM EST
+$vfy='f$veri(0)'
+$!. Display some information on a user.
+$!.
+$!. Parameter:
+$!.
+$!. P1 pid, if empty, take callers process
+$!.
+$!. Pn options
+$!. /Interval=N update interval, defaults to 1 second
+$!. /PID P1 is a PID (default)
+$!. /Username P1 is a username (1st userprocess is taken)
+$!. /Mode=N specifies mode (Valid for /Username and /process
+)
+$!. /Process P1 is a processname (default, if P1 not valid PI
+D)
+$!. /Node=N just this node (out of a cluster)
+$!. /Cluster all cluster nodes (/Node=*)
+$!. /Output=File one shot -> file (SYS$LOGIN:STATUS.LIS)
+$!. /Wide set screen to 132 rows (default: 80)
+$!. /Remaining 132er screen with remaining quotas
+$!. /State=N only processes in N state
+$!. /Image=name running image containing NAME or
+$!. /Image=-name running image not containing NAME
+$!.
+$!. STATUS uses the following logical names to get some general information:
+$!. CNC_CUSTOMER name of customer,firm...
+$!. CNC_LOCATION location
+$!. CNC_UNIT customer unit
+$!.
+$!. The nodename is derived from:
+$!. - system parameter SCSNODE, if empty ->
+$!. - logical SYS$NODE, if empty ->
+$!. - logical CNC_NODE_NAME
+$!.
+$set on
+$on error then $goto exit
+$on control_y then $goto control_y
+$if "''dcl_debug'" then $set verify
+$if "''status_debug'" then $set verify
+$if "''cnctools_statistics'".nes."" then $cnc_write_fstat status
+$ws="write sys$output "
+$wss="write sys$output "
+$version="V4.4-1"
+$esc[0,8]=27
+$cr[0,8]=13
+$ctrlz[0,8]=26
+$bell[0,8]=7
+$bon="''ESC'[1m"
+$vof="''ESC'[0m"
+$uon="''esc'[4m"
+$clr_scr="''WSS' ""''ESC'[1;1H''ESC'[2J"""
+$cursor_home="''ESC'[1;1H"
+$cs_dht="''ESC'#3"
+$cs_dhb="''ESC'#4"
+$pos_cursor="''ESC'[5;1H"
+$clr_rest="''Esc'[1B''Esc'[J''Esc'[1A"
+$clr_rol="''ESC'[K"
+$con="''ESC'[?25h"
+$coff="''ESC'[?25l"
+$vbar="''Esc'(0x''Esc'(B"
+$vend="''Esc'(0v''Esc'(B"
+$vbegin="''Esc'(0w''Esc'(B"
+$vpointer="''Bon'>''Vof'"
+$ask="READ/END=CONTROL_Z/ERROR=EXECUTION_ERROR SYS$COMMAND /PROMPT="
+$retry="F"
+$nottold="T"
+$maxprocess=80
+$displaycnt=f$getd("Sys$Command","TT_PAGE")-9
+$tmp=displaycnt+5
+$cursor_bottom="''Esc'[''Tmp';1H"
+$selectjump=displaycnt*2/3
+$displaybegin=1
+$displayend=displaycnt
+$iselect=1
+$storenum=""
+$if "''Anykey'".eqs.""
+$then
+$fanykey="F"
+$else
+$fanykey="T"
+$endif
+$isinteractive="F"
+$wild="F"
+$pars=p1+" "+p2+" "+p3+" "+p4+" "+p5+" "+p6+" "+p7+" "+p8
+$if f$loca("*",pars).ne.f$leng(pars) then $wild="T"
+$vonvorne:
+$parsh=f$edit(pars,"Upcase,Collapse,UnComment,Trim")
+$if(f$loca("?",parsh).ne.f$leng(parsh)).or.(f$loca("-H",parsh).ne.f$leng(parsh))
+.or.(f$loca("/H",parsh).ne.f$leng(parsh))
+$then
+$clr_scr
+$ws " ''uon'S T A T U S - Prozessanzeige''VOF' ''Version'"
+$ws " "
+$ws " ''bon'STATUS''vof' ist ein sich aktualisierendes Display eines"
+$ws " Prozesses, bei dem Prozessparameter angezeigt werden."
+$ws " Prozesse können nach unterschiedlichen Kriterien ausgewählt werden."
+$ws " "
+$ws " ''uon'Aufruf:''vof' $ STATUS [KRIT] [Qualifier]"
+$ws " "
+$ws " ''uon'Krit:''vof' "
+$ws " Kriterium, wenn leer -> Anzeige eigener Prozeß"
+$ws " "
+$ws " ''uon'Qualifier:''vof'"
+$ws " /Cluster clusterweite Anzeige"
+$ws " /Image=Name Programmname muss NAME enthalten"
+$ws " /Image=-Name Programmname darf NAME NICHT enthalten"
+$ws " /Interval=N Updateinterval, default 1 Sekunde"
+$ws " /Mode=N nur Prozesse im Mode N (default:I)"
+$ws " /Node=N nur Prozesse auf dem Knoten N"
+$ws " /Node nur Prozesse auf dem eigenen Knoten (default)"
+$ws " /Output=File Ausgabe in Datei (default: SYS$LOGIN:STATUS.LIS)"
+$ws " /PID KRIT ist eine Prozeß-ID (default) "
+$ws " /Process KRIT ist ein Prozeßname (default, falls P1 keine PID)"
+$ws " /State=N nur Pozesse im State N (default:*)"
+$ws " /Username KRIT ist ein Benutzername (default)"
+$ws " /Wide die Prozessliste wird 132spaltig dargestellt"
+$ws " /Remaining analog zu /WIDE, es werden verbleibende Quoten dargestell
+t"
+$ws " "
+$ws " Wird mehr als ein Prozeß gefunden, kann ausgewählt werden."
+$ws " ''bon'STATUS''vof' endet durch F6 oder F10."
+$if.not.isinteractive
+$then $goto exit2
+$else
+$ws " "
+$first="/"
+$goto ask_kommando
+$endif
+$endif
+$savepriv=f$setp("GROUP,WORLD")
+$set broadcast=none
+$tmps=f$edit(pars,"Upcase,Compress,UnComment,Trim")
+$sel_interval=1
+$sel_mode="INTERACTIVE"
+$sel_what="USERNAME"
+$if tmps.eqs.""
+$then
+$sel_what="PID"
+$else
+$if f$inte("%X''Tmps'").gt.0
+$then
+$sel_what="PID"
+$else
+$sel_what="PRCNAM"
+$sel_mode="*"
+$endif
+$endif
+$sel_node="*"
+$sel_output_tt="T"
+$sel_width="F"
+$sel_state="*"
+$sel_image="*"
+$oldwidth=f$getd("Sys$Command","DevBufSiz")
+$node=f$gets("SCSNODE")-"_"-"::"
+$if node.eqs."" then $node=f$trnl("SYS$NODE")-"_"-"::"
+$if node.eqs."" then $node=f$trnl("CNC_NODE_NAME")-"_"-"::"
+$node=f$edit(node,"Trim,Upcase,Collapse,UnComment")
+$lookfor=f$getj("","PID")
+$pars=""
+$ic=-1
+$ploop1:
+$ic=ic+1
+$if ic.le.f$leng(tmps)-1
+$then
+$nx=f$extr(ic,1,tmps)
+$if nx.eqs."/"
+$then
+$pars=pars+" /"
+$else
+$pars=pars+nx
+$endif
+$goto ploop1
+$endif
+$rflag="F"
+$pars=f$edit(pars,"Upcase,Compress,UnComment,Trim")
+$ic=-1
+$ploop2:
+$ic=ic+1
+$nx=f$elem(ic," ",pars)
+$if nx.eqs."".or.nx.eqs." " then $goto end_ploop
+$if f$extr(0,1,nx).nes."/"
+$then
+$lookfor=nx
+$goto ploop2
+$endif
+$nx2=f$extr(0,2,nx)
+$nx3=f$extr(0,3,nx)
+$if nx2.eqs."/W"
+$then
+$sel_width="T"
+$goto ploop2
+$endif
+$if nx2.eqs."/R"
+$then
+$sel_width="T"
+$rflag="T"
+$goto ploop2
+$endif
+$if nx2.eqs."/U"
+$then
+$sel_what="USERNAME"
+$goto ploop2
+$endif
+$if nx3.eqs."/PR"
+$then
+$sel_what="PRCNAM"
+$sel_mode="*"
+$goto ploop2
+$endif
+$if nx3.eqs."/PI"
+$then
+$sel_what="PID"
+$sel_mode="*"
+$goto ploop2
+$endif
+$if nx3.eqs."/IM"
+$then
+$tmp=f$elem(1,"=",nx)
+$if tmp.nes."".and.tmp.nes."="
+$then
+$sel_image=f$edit(tmp,"Trim,Upcase,Collapse,UnComment")
+$endif
+$goto ploop2
+$endif
+$if nx3.eqs."/IN"
+$then
+$tmp=f$elem(1,"=",nx)
+$if tmp.nes."".and.tmp.nes."="
+$then
+$sel_interval=f$inte(tmp)
+$if sel_interval.lt.0 then $sel_interval=1
+$endif
+$goto ploop2
+$endif
+$if nx2.eqs."/O"
+$then
+$sel_output_tt="F"
+$tmp=f$elem(1,"=",nx)
+$if tmp.nes."".and.tmp.nes."="
+$then
+$sel_output=tmp
+$else
+$sel_output="SYS$LOGIN:STATUS.LIS"
+$endif
+$goto ploop2
+$endif
+$if nx2.eqs."/M"
+$then
+$tmp=f$elem(1,"=",nx)
+$if tmp.nes."".and.tmp.nes."="
+$then
+$sel_mode="SHIT"
+$tmp1=f$extr(0,1,tmp)
+$if tmp1.eqs."I" then $sel_mode="INTERACTIVE"
+$if tmp1.eqs."O" then $sel_mode="OTHER"
+$if tmp1.eqs."N" then $sel_mode="NETWORK"
+$if tmp1.eqs."B" then $sel_mode="BATCH"
+$if tmp1.eqs."*" then $sel_mode="*"
+$if sel_mode.eqs."SHIT"
+$then
+$ws "?STATUS, illegal keyword: ''TMP'"
+$wait 00:00:02
+$goto exit
+$endif
+$endif
+$goto ploop2
+$endif
+$if nx2.eqs."/S"
+$then
+$tmp=f$elem(1,"=",nx)
+$if tmp.nes."".and.tmp.nes."="
+$then
+$sel_state=f$edit(tmp,"Trim,Upcase,Collapse,UnComment")
+$endif
+$goto ploop2
+$endif
+$if nx2.eqs."/C"
+$then
+
+$sel_node="*"
+$goto ploop2
+$endif
+$if nx2.eqs."/N"
+$then
+$tmp=f$elem(1,"=",nx)
+$if tmp.nes."".and.tmp.nes."="
+$then
+$sel_node="''tmp'"
+$if(.not. f$gets("cluster_member",sel_node)).and.(tmp.nes."*")
+$then
+$ws "?STATUS, no clustermember: ''tmp'"
+$wait 00:00:02
+$goto exit
+$endif
+$else
+$sel_node=node
+$endif
+$goto ploop2
+$endif
+$ws "?STATUS , illegal qualifier: ''nx'"
+$wait 00:00:02
+$goto ploop2
+$end_ploop:
+$again="F"
+$if(sel_what.eqs."PID")
+$then
+$if f$inte("%X''Lookfor'").le.0
+$then
+$sel_what="PRCNAM"
+$sel_mode="*"
+$endif
+$endif
+$check01:
+$ctx=""
+$tmp=f$cont("PROCESS",ctx,"NODENAME","''sel_node'","EQL")
+$if sel_what.eqs."USERNAME"
+$then
+$tmp=f$cont("PROCESS",ctx,"USERNAME","''LOOKFOR'","EQL")
+$endif
+$if sel_what.eqs."PRCNAM"
+$then
+$tmp=f$cont("PROCESS",ctx,"PRCNAM","''LOOKFOR'","EQL")
+$endif
+$if sel_mode.nes."*" then $tmp=f$cont("PROCESS",ctx,"MODE","''sel_mode'","EQL")
+$if sel_state.nes."*" then $tmp=f$cont("PROCESS",ctx,"STATE","''sel_state'","EQL
+")
+$if(sel_what.eqs."PID")
+$then
+$pid=lookfor
+$pc=1
+$pid1=pid
+$scanagain="F"
+$pcmax=1
+$goto end_check
+$endif
+$scanagain="T"
+$pc=0
+$check:
+$pc=pc+1
+$if scanagain
+$then
+$pid'pc'=f$pid(ctx)
+$else
+$if pc.gt.pcmax
+$then
+$pid'pc'=""
+$endif
+$endif
+$if(pid'pc'.nes."")
+$then
+$if(sel_width.and.pc.gt.maxprocess).or.(.not. sel_width.and.pc.gt.2*maxprocess)
+$then
+$if nottold
+$then
+$ws "?Status, too many processes, aborting SCAN..."
+
+
+$wait 00:00:02
+$nottold="F"
+$endif
+$goto endcheckloop
+$endif
+$user'pc'=f$getj(pid'pc',"USERNAME")
+$prc'pc'=f$getj(pid'pc',"PRCNAM")
+$imag'pc'=f$pars(f$getj(pid'pc',"IMAGNAME"),,,"name")
+$if imag'pc'.eqs."" then $imag'pc'="DCL"
+$imag'pc'=f$edit(imag'pc',"Trim,Upcase,Collapse")
+$if sel_image.nes."*"
+$then
+$if f$extr(0,1,sel_image).eqs."-"
+$then
+$if f$loca(f$extr(1,999,sel_image),imag'pc').ne.f$leng(imag'pc')
+$then
+$pc=pc - 1
+$goto check
+$endif
+$else
+$if f$loca(sel_image,imag'pc').eq.f$leng(imag'pc')
+$then
+$pc=pc - 1
+$goto check
+$endif
+$endif
+$endif
+$nod'pc'=f$getj(pid'pc',"NODENAME")-"_"-"::"
+$if.not.sel_width then $goto check
+$if(.not. rflag)
+$then
+$term'pc'=f$getj(pid'pc',"Terminal")-"_"-":"
+$cputim=f$getj(pid'pc',"CPUTIM")
+$hundreds=cputim -(cputim/100)*100
+$if hundreds.lt.10 then $hundreds="0''Hundreds'"
+$cputim=cputim/100
+$h=f$inte(cputim/3600)
+$if h.lt.10 then h="0''h'"
+$cputim=cputim-(h*3600)
+$m=f$inte(cputim/60)
+$if m.lt.10 then m="0''M'"
+$if m.gt.10.and.f$leng(m).eq.1 then m="''M'0"
+$cputim=cputim -(m*60)
+$s=f$inte(cputim)
+$if s.lt.10 then s="0''S'"
+$if s.gt.10.and.f$leng(s).eq.1 then s="''S'0"
+$cputim="''H':''M':''S'.''Hundreds'"
+$cpu'pc'=cputim
+$prib'pc'=f$getj(pid'pc',"PRIB")
+$state'pc'=f$getj(pid'pc',"STATE")
+$faults'pc'=f$getj(pid'pc',"PAGEFLTS")
+$bufio'pc'=f$getj(pid'pc',"BUFIO")
+$dirio'pc'=f$getj(pid'pc',"DIRIO")
+$mode'pc'=f$extr(0,1,f$getj(pid'pc',"MODE"))
+$wssize'pc'=f$getj(pid'pc',"WSSIZE")
+$else
+$mode'pc'=f$extr(0,1,f$getj(pid'pc',"MODE"))
+$prib'pc'=f$getj(pid'pc',"PRIB")
+$state'pc'=f$getj(pid'pc',"STATE")
+$pagfil'pc'=f$getj(pid'pc',"PAGFILCNT")
+$astcnt'pc'=f$getj(pid'pc',"ASTCNT")
+$bytcnt'pc'=f$getj(pid'pc',"BYTCNT")
+$biocnt'pc'=f$getj(pid'pc',"BIOCNT")
+$diocnt'pc'=f$getj(pid'pc',"DIOCNT")
+$enqcnt'pc'=f$getj(pid'pc',"ENQCNT")
+$filcnt'pc'=f$getj(pid'pc',"FILCNT")
+$prccnt'pc'=f$getj(pid'pc',"PRCLM") - f$getj(pid'pc',"PRCCNT")
+$tqcnt'pc'=f$getj(pid'pc',"TQCNT")
+$endif
+$goto check
+$endif
+$endcheckloop:
+$pc=pc - 1
+$pcmax=pc
+$if pc.le.0.and..not. wild then $goto never
+$if(pc.eq.1).and.((.not.scanagain.and..not.wild).or.(sel_what.eqs."PRCNAM"))
+$then
+$pid=pid1
+$goto end_check
+$endif
+$scanagain="F"
+$check0:
+$repaint:
+$if(sel_what.eqs."PID").or.(sel_what.eqs."PRCNAM".and.pc.eq.1)
+$then
+$clr_scr
+$goto end_check
+$endif
+$if again
+$then
+$ws cursor_home
+$else
+$again="T"
+$if sel_width
+$then
+$set terminal/width=132/nowrap
+$else
+$set terminal/width='oldwidth/wrap
+$endif
+$ws cursor_home
+$endif
+$if sel_width
+$then
+$time=f$extr(0,20,f$time())
+$ws f$fao("!AS!_ !ASProzessinformation !AS''Vof'",cs_dht,bon,time)
+$ws f$fao("!AS!_ ''uon'!ASProzessinformation !AS''vof' !/",cs_dhb,bon,time)
+$if(.not.rflag)
+$then
+$ws " ''Coff'''uon'''Bon'Nr. Pid Username Process Node State BP M
+Term. CPU WsSize Pflts DirIo BufIo Imagename''vof'"
+$else
+$ws " ''Coff'''uon'''Bon'Nr. Pid Username Process Node State BP M
+PagFilCnt AstCnt BioCnt DioCnt BytCnt EnqCnt TqCnt FilCnt PrcCnt''vof'"
+$endif
+$else
+$time=f$extr(0,20,f$time())
+$ws f$fao("!AS!ASProzessinformation !AS''Vof'",cs_dht,bon,time)
+$ws f$fao("!AS''uon'!ASProzessinformation !AS''vof' !/",cs_dhb,bon,time)
+$ws " ''Coff'''uon'''Bon'Nr. Pid Username Processname Node Imagen
+ame''vof'"
+$endif
+$pc=displaybegin-1
+$displayend=pc+displaycnt+1
+$if displayend.gt.pcmax then $displayend=pcmax
+$check1:
+$pc=pc+1
+$if pc.le.displayend
+$then
+$text0=vbar
+$if pc.eq.1 then $text0=vbegin
+$if pc.eq.displaybegin.and.pc.ne.1 then $text0="^"
+$if pc.eq.pcmax then $text0=vend
+$if pc.eq.displayend.and.pc.ne.pcmax then $text0="v"
+$pcvon=""
+$pcvoff=""
+$flagbold="F"
+$if pc.eq.iselect.and.fanykey
+$then
+$pcvon=bon
+$pcvoff=vof
+$flagbold="T"
+$text0=vpointer
+$endif
+$pcc=pc
+$if sel_width
+$then
+$statevon=""
+$statevoff=""
+$if.not.flagbold.and.(state'pcc'.eqs."COM".or.state'pcc'.eqs."CUR".or.state'pcc'
+.eqs."COMO")
+$then
+$statevon=bon
+$statevoff=vof
+$endif
+$pribvon=""
+$pribvoff=""
+$if.not.flagbold.and.prib'pcc'.gt.4
+$then
+$pribvon=bon
+$pribvoff=vof
+$endif
+$if(.not.rflag)
+$then
+$text1=f$fao("!AS!3SL !8AS !12AS !10AS !6AS !AS!5AS!AS !AS!2SL!AS !1AS !7AS ",pc
+von,pc,pid'pcc',user'pcc',prc'pcc',nod'pcc',statevon,state'pcc',statevoff,pribvo
+n,prib'pcc',pribvoff,mode'pcc',term'pcc')
+$text2=f$fao("!10AS !6SL !7SL !8SL !8SL !18AS!AS",cpu'pcc',wssize'pc',faults'pc
+c',dirio'pcc',bufio'pcc',imag'pcc',pcvoff)
+$else
+$text1=f$fao("!AS!3SL !8AS !12AS !10AS !6AS !AS!5AS!AS !AS!2SL!AS !1AS",pcvon,pc
+,pid'pcc',user'pcc',prc'pcc',nod'pcc',statevon,state'pcc',statevoff,pribvon,prib
+'pcc',pribvoff,mode'pcc')
+$text2=f$fao("!10SL !6SL !7SL !7SL !8SL !6SL !5SL !6SL !6SL !AS",pagfil'pcc',ast
+cnt'pcc',biocnt'pcc',diocnt'pcc',bytcnt'pcc',enqcnt'pcc',tqcnt'pcc',filcnt'pcc',
+prccnt'pcc',pcvoff)
+$endif
+$ws text0+text1+text2
+$else
+$ws text0+f$fao("!AS!3SL !8AS !12AS !15AS !6AS !30AS!AS",pcvon,pc,pid'pcc',user'
+pcc',prc'pcc',nod'pcc',imag'pcc',pcvoff)
+$endif
+$goto check1
+$endif
+$ws clr_rest
+$interval=sel_interval
+$addtext=""
+$if displaybegin.ne.1 then $addtext="T,U"
+$if pcmax.gt.displaybegin+displaycnt then $addtext=addtext+",B,D"
+$if(addtext.nes."").and.(f$extr(0,1,addtext).nes.",") then $addtext=",''AddText'
+"
+$if fanykey
+$then
+$anykey "''Con'* Nummer [,?''AddText']:''Clr_Rol'" $$input 'interval'
+$$input=f$edit($$input,"Trim,Upcase,Collapse")
+$if $input.eqs."UP" then $$input="^"
+$if $input.eqs."DOWN" then $$input="V"
+$if $input.eqs."LEFT" then $$input="<"
+$if $input.eqs."RIGHT" then $$input=">"
+$if $input.eqs."E4" then $$input="S"
+$if $input.eqs."E5" then $$input="JU"
+$if $input.eqs."E6" then $$input="JD"
+$if $input.eqs."F15" then $$input="?"
+$if $input.eqs."W" then $$input="W"
+$if $input.eqs."R" then $$input="R"
+$if $input.eqs."F16" then $$input="/"
+$if $input.eqs.cr then $$input=""
+$if $input.eqs."F10" then $goto control_z
+$if $input.eqs."F6" then $goto control_z
+$if $input.eqs.ctrlz then $goto control_z
+$if $input.eqs."Q" then $goto control_z
+$if $input.eqs."E" then $goto control_z
+$if $input.eqs."Z" then $goto control_z
+$if $input.eqs.""
+$then
+$if storenum.eqs.""
+$then
+$goto check01
+$else
+$pid=f$inte(storenum)
+$storenum=""
+$if pid.gt.pcmax.or.pid.le.0
+$then
+$gosub gibtesnicht
+$goto check01
+$endif
+$pid=pid'pid'
+$goto end_check
+$endif
+$endif
+$else
+$read/time='interval'/error=check01/prompt="''Con'* Nummer [,?''AddText'
+]:''Clr_Rol' "/end=control_z sys$command $input
+$endif
+$if $input.eqs.""
+$then
+$clr_scr
+$goto check01
+$endif
+$if f$loca("?",$input).ne.f$leng($input)
+$then
+$clr_scr
+$ws " "
+$ws " ''Uon'Folgende Eingaben sind moeglich:''Vof'"
+$ws " Nummer der betreffende Prozess wird angezeigt"
+$ws " U,< eine Seite rueckwaertsblaettern"
+$ws " D,> eine Seite vorwaertsblaettern"
+$ws " T erste Seite"
+$ws " B letzte Seite"
+$ws " W Umschaltung 80/132 Mode"
+$ws " R Umschaltung 'remaining Quota' Mode"
+$ws " / Eingabe neuer Kommandozeile"
+$ws " "
+$ws " das Bild wird neu aufgebaut"
+$ws " ? diese Seite"
+$ws " "
+$ws " CTRL/Z Ende"
+$ws " F10 Ende"
+$ws " E,Q,Z Ende"
+$ws " "
+$if.not.fanykey
+$then
+$ask "''Bon'Weiter mit -Taste...''Vof'" $input
+$else
+$ws " ''Uon'Bedienung durch Tasten:''Vof'"
+$ws " Pfeil rechts eine Seite vorwaertsblaettern"
+$ws " Pfeil links eine Seite rueckwaertsblaettern"
+$ws " Pfeil rauf/runter Prozess selektieren (Einerschritte)"
+$ws " Select selektierten Prozess anzeigen"
+$ws " Bild rauf/Runter Prozess selektieren (Seitenschritte)"
+$ws " "
+$anykey
+$endif
+$clr_scr
+$goto check0
+$endif
+$first=f$extr(0,2,f$edit($input,"Trim,Upcase,Collapse,UnComment"))
+$ask_kommando:
+$if first.eqs."/"
+$then
+$ws " "
+$ask "* Neues Kommando [''Pars']: " $input
+$$input=f$edit($input,"Trim,Upcase,Compress,UnComment")
+$clr_scr
+$if $input.eqs."" then $goto check01
+$nottold="T"
+$maxprocess=80
+$displaycnt=f$getd("Sys$Command","TT_PAGE") - 9
+$selectjump=displaycnt*2/3
+$displaybegin=1
+$displayend=displaycnt
+$iselect=1
+$storenum=""
+$pars=$input
+$isinteractive="T"
+$goto vonvorne
+$endif
+$if first.eqs."Q".or.first.eqs."Z".or.first.eqs."E"
+$then
+$goto control_z
+$endif
+$if first.eqs."W"
+$then
+$if sel_width
+$then sel_width="F"
+$else sel_width="T"
+$endif
+$if(sel_width) then $rflag="F"
+$again = "F"
+$goto check01
+$endif
+$if first.eqs."R"
+$then
+$sel_width="T"
+$rflag="T"
+$again = "F"
+$goto check01
+$endif
+$if first.eqs."^"
+$then
+$if iselect.gt.1 then $iselect=iselect - 1
+$if iselect.lt.displaybegin
+$then
+$first="U"
+$else
+$goto check0
+$endif
+$endif
+$if first.eqs."V"
+$then
+$if iselect.lt.pcmax then $iselect=iselect+1
+$if iselect.gt.displayend
+$then
+$first="D"
+$else
+$goto check0
+$endif
+$endif
+$if first.eqs."JU"
+$then
+$if iselect.gt.1 then $iselect=iselect - selectjump
+$if iselect.lt.1 then $iselect=1
+$if iselect.lt.displaybegin
+$then
+$first="U"
+$else
+$goto check0
+$endif
+$endif
+$if first.eqs."JD"
+$then
+$if iselect.lt.pcmax then $iselect=iselect+selectjump
+$if iselect.gt.pcmax then $iselect=pcmax
+$if iselect.gt.displayend
+$then
+$first="D"
+$else
+$goto check0
+$endif
+$endif
+$if first.eqs."D".or.first.eqs.">"
+$then
+$if displayend.lt.pcmax
+$then
+$displaybegin=displaybegin+displaycnt
+$if displaybegin+displaycnt.gt.pcmax then $displaybegin=pcmax - displaycnt
+$endif
+$if iselect.lt.displaybegin then $iselect=displaybegin
+$goto check0
+$endif
+$if first.eqs."U".or.first.eqs."<"
+$then
+$if displaybegin.gt.1
+$then
+$displaybegin=displaybegin - displaycnt
+$if displaybegin.lt.1 then $displaybegin=1
+$endif
+$if iselect.gt.displaybegin+displaycnt then $iselect=displaybegin
+$goto check0
+$endif
+$if first.eqs."T"
+$then
+$displaybegin=1
+$if iselect.gt.displaybegin+displaycnt then $iselect=1
+$goto check0
+$endif
+$if first.eqs."B"
+$then
+$displaybegin=pcmax - displaycnt
+$if displaybegin.lt.1 then $displaybegin=1
+$if iselect.lt.displaybegin then $iselect=displaybegin
+$goto check0
+$endif
+$if first.eqs."S"
+$then
+$pid=pid'iselect'
+$goto end_check
+$endif
+$sel=f$inte($input)
+$if fanykey
+$then
+$if sel.ge.0.and.sel.le.9
+$then
+$if storenum.eqs.""
+$then
+$storenum=sel
+$goto check0
+$else
+$storenum="''StoreNum'''Sel'"
+$goto check0
+$endif
+$endif
+$else
+$storenum=""
+$if sel.gt.0.and.sel.le.pcmax
+$then
+$pid=pid'sel'
+$goto end_check
+$else
+$goto check0
+$endif
+$endif
+$end_check:
+$if pid.eqs."" then $goto never
+$if.not.f$getd("sys$output:","tt_deccrt").and.sel_output_tt
+$then
+$ws "You MUST use a VT100 compatible terminal."
+$wait 00:00:02
+$goto exit
+$endif
+$if sel_output_tt
+$then
+$clr_scr
+$else
+$vof=""
+$uon=""
+$cs_dht=""
+$cs_dhb=""
+$pos_cursor=""
+$wss="Write Outlun"
+$close/nolog/error=label$1 outlun
+$label$1: open/write/error=error$1 outlun 'sel_output'
+$ws " "
+$ws "?STATUS, Ausgabedatei ''Sel_Output'"
+$endif
+$wss f$fao("!AS!_ Prozessinformation ",cs_dht)
+$wss f$fao("!AS!_ ''uon'Prozessinformation''vof' !/",cs_dhb)
+$prcnam="XXXXXXXXXXXXXXXXXXXXXX"
+$prcnam=f$getj(pid,"PRCNAM")
+$if prcnam.eqs."XXXXXXXXXXXXXXXXXXXXXX" then goto noproc
+$retry="F"
+$uic=f$getj(pid,"UIC")
+$usenam=f$edit(f$getj(pid,"USERNAME"),"TRIM")
+$if usenam.eqs."" then usenam=" "
+$cust=f$trnl("CNC_CUSTOMER")
+$if cust.eqs."" then $cust=" "
+$loc=f$trnl("CNC_LOCATION")
+$if loc.eqs."" then $loc=" "
+$unit=f$trnl("CNC_UNIT")
+$if unit.eqs."" then $unit=" "
+$logintim=f$extr(0,17,f$getj(pid,"LOGINTIM"))
+$on error then $goto noproc
+$pnode=f$getj(pid,"NODENAME")
+$astlm=f$getj(pid,"ASTLM")
+$bytlm=f$getj(pid,"BYTLM")
+$mode=f$getj(pid,"MODE")
+$biolm=f$getj(pid,"BIOLM")
+$diolm=f$getj(pid,"DIOLM")
+$enqlm=f$getj(pid,"ENQLM")
+$fillm=f$getj(pid,"FILLM")
+$tqlm=f$getj(pid,"TQLM")
+$prclm=f$getj(pid,"PRCLM")
+$pgflquo=f$getj(pid,"PGFLQUOTA")
+$term=" "
+$serv=" "
+$if mode.eqs."INTERACTIVE"
+$then
+$term=f$getj(pid,"TERMINAL")
+$if term.eqs.""
+$then
+$term=f$getj(f$getj(pid,"MASTER_PID"),"TERMINAL")
+$endif
+$if term.nes.""
+$then
+$if f$extr(0,2,term).eqs."LT".or. f$extr(0,2,term).eqs."TN"
+$then
+$serv="nicht ermittelbar"
+$if f$getd("''term'","exists")
+$then
+SERV = "(''F$GETDVI(TERM,"TT_ACCPORNAM")')"
+$endif
+$endif
+$endif
+$endif
+$wsauth=f$getj(pid,"WSAUTH")
+$wsauthext=f$getj(pid,"WSAUTHEXT")
+$wsquota=f$getj(pid,"WSQUOTA")
+$cpulim=f$getj(pid,"CPULIM")/100
+$h=f$inte(cpulim/3600)
+$cpulim=cpulim-(h*3600)
+$m=f$inte(cpulim/60)
+$if m.lt.10 then m="0''M'"
+$if m.gt.10.and.f$leng(m).eq.1 then m="''M'0"
+$cpulim=cpulim -(m*60)
+$s=f$inte(cpulim)
+$if s.lt.10 then s="0''S'"
+$if s.gt.10.and.f$leng(s).eq.1 then s="''S'0"
+$cpulim="''H':''M':''S'"
+$cpulim=f$extr(0,10-f$leng(cpulim)," ")+cpulim
+$restart:
+$time=f$extr(0,20,f$time())
+$prcnam="XXXXXXXXXXXXXXXXXXXXXX"
+$prcnam=f$getj(pid,"PRCNAM")
+$if prcnam.eqs."XXXXXXXXXXXXXXXXXXXXXX" then goto noproc
+$astlm=f$getj(pid,"ASTLM")
+$bytlm=f$getj(pid,"BYTLM")
+$mode=f$getj(pid,"MODE")
+$biolm=f$getj(pid,"BIOLM")
+$diolm=f$getj(pid,"DIOLM")
+$enqlm=f$getj(pid,"ENQLM")
+$fillm=f$getj(pid,"FILLM")
+$tqlm=f$getj(pid,"TQLM")
+$prclm=f$getj(pid,"PRCLM")
+$pgflquo=f$getj(pid,"PGFLQUOTA")
+$prib=f$getj(pid,"PRIB")
+$state=f$getj(pid,"STATE")
+$astcnt=f$getj(pid,"ASTCNT")
+$bytcnt=f$getj(pid,"BYTCNT")
+$biocnt=f$getj(pid,"BIOCNT")
+$diocnt=f$getj(pid,"DIOCNT")
+$enqcnt=f$getj(pid,"ENQCNT")
+$filcnt=f$getj(pid,"FILCNT")
+$prccnt=f$getj(pid,"PRCCNT")
+$tqcnt=f$getj(pid,"TQCNT")
+$pagfil=f$getj(pid,"PAGFILCNT")
+$faults=f$getj(pid,"PAGEFLTS")
+$imacnt=f$getj(pid,"IMAGECOUNT")
+$image=f$getj(pid,"IMAGNAME")
+$bufio=f$getj(pid,"BUFIO")
+$dirio=f$getj(pid,"DIRIO")
+$wssize=f$getj(pid,"WSSIZE")
+$wsext=f$getj(pid,"WSEXTENT")
+$wspeak=f$getj(pid,"WSPEAK")
+$vpeak=f$getj(pid,"VIRTPEAK")
+$cputim=f$getj(pid,"CPUTIM")
+$hundreds=cputim -(cputim/100)*100
+$if hundreds.lt.10 then $hundreds="0''Hundreds'"
+$cputim=cputim/100
+$h=f$inte(cputim/3600)
+$cputim=cputim-(h*3600)
+$m=f$inte(cputim/60)
+$if m.lt.10 then m="0''M'"
+$if m.gt.10.and.f$leng(m).eq.1 then m="''M'0"
+$cputim=cputim -(m*60)
+$s=f$inte(cputim)
+$if s.lt.10 then s="0''S'"
+$if s.gt.10.and.f$leng(s).eq.1 then s="''S'0"
+$cputim="''H':''M':''S'.''hundreds'"
+$wss f$fao("!AS!AS!AS !AS !_!AS !/!/!AS !AS !AS !AS",coff,pos_cursor,"Ort:
+''uon'''CUST'-''LOC'''vof'", -
+"Abt.: ''uon'''UNIT' ''PNODE'''vof'","Zeit: ''uon'''TIME'''vof'","User: ''uon'''
+USENAM'''vof'", -
+"Prozess: ''uon'''PRCNAM'''vof'","PID: ''uon'''pid'''vof'","UIC: ''uon'''UIC'''v
+of'")
+$wss f$fao("!AS!AS!AS !AS!12AS!AS !AS!2SL!AS !AS!AS!AS","Login: ''uon'",loginti
+m,vof,"Mode: ''uon'",mode,vof, -
+"B.Prio: ''uon'",prib,vof,"State: ''uon'","''STATE' ",vof)
+$if term.nes." "
+$then
+$wss f$fao("!AS !AS !AS!/","On Node: ''uon'''PNODE'''vof'","Terminal: ''uon'''
+TERM'''vof'","Server: ''uon'''SERV'''vof'")
+$else
+$wss ""
+$endif
+$wss f$fao(" !10AS !10SL / !10SL | !10AS !10SL / !10SL"," AST:",astcnt,astlm
+," BYTLM:",bytcnt,bytlm)
+$wss f$fao(" !10AS !10SL / !10SL | !10AS !10SL / !10SL!/ !10AS !10AS / !10AS | !
+10AS !10SL / !10SL", -
+" BIOCNT:",biocnt,biolm," DIOCNT:",diocnt,diolm," CPU:",cputim,cpulim," EN
+QUE:",enqcnt,enqlm)
+$wss f$fao(" !10AS !10SL / !10SL | !10AS !10SL / !10SL!/ !10AS !10SL / !10SL | !
+10AS !10SL / !10SL", -
+" FIL:",filcnt,fillm," PRC:",prccnt,prclm,"Pagefile:",pagfil,pgflquo," T
+imer:",tqcnt,tqlm)
+$wss f$fao(" !10AS !10SL / !10SL | !AS !10SL"," BIO/DIO:",bufio,dirio," Images:
+",imacnt)
+$wss f$fao(" !10AS !10SL | !10AS !10SL"," Faults:",faults,"Virtual
+: ",vpeak)
+$wss f$fao("!74AS!AS"," Image: ''uon'''IMAGE'","''vof'")
+$wss f$fao(" !AS !8SL !AS !8SL !AS !8SL!/ !AS !8SL !AS !8SL !AS !8SL!/", -
+" WSquota: ",wsquota," WSauth: ",wsauth,"WSauthext: ",wsauthext," WSsize: ",ws
+size," WSpeak: ",wspeak," WSextent: ",wsext)
+$if.not.sel_output_tt then $goto exit
+$if sel_interval.eq.0
+$then
+$txt=f$fao("!AS[22;1H !AS",esc," Ende: ")
+$ws txt
+$else
+$txt=f$fao("!AS[22;1H !AS",esc," Ende: , oder ")
+$ws txt
+$txt=f$fao("!AS[23;1H !AS!AS[21;3H",esc," Neustart: ",esc)
+$ws txt
+$endif
+$if sel_interval.eq.0
+$then
+$goto restart
+$else
+$read/time='sel_interval'/error=restart/prompt=" "/end=exit sys$command tmp
+$endif
+$clr_scr
+$goto repaint
+$noproc:
+$never:
+$ws ""
+$ws "Process ''bon'''lookfor'''vof' existiert nicht mehr!"
+$exit:
+$execution_error:
+$control_z:
+$control_y:
+$if "''OldWidth'".nes.""
+$then
+$if(oldwidth.nes."132") then $set terminal/width='oldwidth'/wrap
+$endif
+$ws "''Con'''Vof'"
+$exit1:
+$if f$type(ctx).eqs."PROCESS_CONTEXT" then $tmp=f$cont("PROCESS",ctx,"CANCEL")
+$savepriv=f$setp("''savepriv'")
+$set terminal/broadcast
+$set broadcast=all
+$exit2:
+$close/nolog/error=exit3 outlun
+$exit3:
+$if "''vfy'" then $exit 1+f$veri(1)*0
+$exit 1
+$error$1:
+$ws "?STATUS, Error creating snapshotfile."
+$wait 00:00:02
+$goto exit
+$gibtesnicht:
+$ws " "
+$ws " ''Bell'''Bon'Dieser Prozess existiert nicht (Nummer ''Pid').''Vof'"
+$ws " "
+$wait 00:00:02
+$clr_scr
+$return 1
+
diff --git a/stop-disconnect-dcl b/stop-disconnect-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_c3RvcC1kaXNjb25uZWN0LWRjbA==
--- /dev/null
+++ b/stop-disconnect-dcl
@@ -0,0 +1,102 @@
+STOP_DISCONNECT
+Jan van den Ende, Friday January 23 2004 @ 10:07AM EST
+Finds, kills, and reports disconnected processes ( submitted after a request at the ITRC forum )
+$!
+$! DISCLAMER:
+$!
+$! NO RESPONIBILITY WHATSOVER WILL BE ACCEPTED FOR ANY MALFUNCTION; NOR
+$! FOR ANY DAMAGE, DIRECT OR INDIRECT, THAT MAY RESULT FROM USE OF THIS
+$! SOFTWARE.
+$!
+$! The texts above form an integral part of this software.
+$!
+$! Filename : Stop_disconnect.com
+$! Author : Frank Wagenaar
+$! Date : november 2000
+$! 021129 jpe: Logfile, to find WHY the job disappears
+$! 010928 jpe: Move to MONITOR_SPU, Auto resubmit
+$! 001127 JHA: Adapt for batch processing, add logging.
+$!
+$!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+$!
+$! The texts above form an integral part of this software.
+$
+$!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+$
+$! For all kind of privilege-requiring general jobs, we have a special user
+$! account, with NO interactive access. ( SPU means Special Privileged User )
+$
+$!---------------
+$
+$! USER_PERS_LOG is the logical name of a directory that receives logging.
+$! Make sure to have some cleanup of it as well!
+$
+$!-----------------------------------------------------------------------------
+$
+$ reqpriv=("sysprv,world")
+$!
+$ if f$getjpi("","mode") .nes. "BATCH"
+$ then
+$ reqpriv = reqpriv + ",cmkrnl"
+$ sub_user = "/user=monitor_spu"
+$ endif
+$
+$ savepriv=f$setprv(reqpriv)
+$ if .not. f$privilege(reqpriv) then goto not_privileged
+$
+$ vandaag = f$cvtime("today","comparison","date") - "-" - "-"
+$ thisproc=f$environment("procedure")
+$
+$ submit -
+'sub_user' -
+/after="+0:10" -
+/nolog -
+/noprint -
+/queue=axp_batch -
+/restart -
+'f$parse(";0",thisproc)
+$
+$ if f$getjpi("","mode") .eqs. "INTERACTIVE" then goto reset_privileges
+$
+$ if f$search("user_pers_log:stop_disconn_proc.*") .nes. ""
+$ then
+$ deletee user_pers_log:stop_disconn_proc.*.* /before="today-35-"
+$ endif
+$
+$ pipe show user/full |search sys$input disconnected/output=sys$login:disc.tmp
+$ wait 00:00:05
+$ vandaag ==f$cvtime("","comparison","date") - "-" - "-"
+$ nu ==f$cvtime("","absolute","time")
+$! set ver
+$ file_bl=f$file_attributes("sys$login:disc.tmp","eof")
+$ if file_bl .eq. 0 then goto einde
+$ if f$search ("user_pers_log:stop_disconn_proc.''vandaag'") .nes. ""
+$ then
+$ open/append log user_pers_log:stop_disconn_proc.'vandaag'
+$ else
+$ open/write log user_pers_log:stop_disconn_proc.'vandaag'
+$ endif
+$ open/read ifi sys$login:disc.tmp
+$read:
+$ read/end=einde ifi line
+$ if line .eqs. "" then goto read
+$ user=f$extract(1,8,line)
+$ pid=f$extract(39,8,line)
+$ on error then goto read
+$ stop/id='pid'
+$ set noon
+$ write log -
+"Disconnected Process Id = ''pid' gebruiker ''user' removed at ''nu'"
+$ goto read
+$einde:
+$reset_privileges:
+$not_privileged:
+$ if f$trnlnm ("ifi","lnm$process") .nes. "" then close ifi
+$ if f$trnlnm ("log","lnm$process") .nes. "" then close log
+$ if f$search("sys$login:disc.tmp") .nes. ""
+$ then
+$ delete/noconfirm/nolog sys$login:disc.tmp;*
+$ endif
+$exit
+
+
diff --git a/substitute-dcl b/substitute-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_c3Vic3RpdHV0ZS1kY2w=
--- /dev/null
+++ b/substitute-dcl
@@ -0,0 +1,310 @@
+SUBSTITUTE.COM
+Neil Sakac, Friday February 18 2005 @ 09:58AM EST
+$ oldverify = F$VERIFY(0)
+$ !**********************************************************************
+$ ! *
+$ ! Author: Neil Sakac Date: 31-10-1988 *
+$ ! *
+$ ! Application: Substitute Module: Substitute.com *
+$ ! *
+$ ! Description: To substitute one string for another. *
+$ ! *
+$ ! Usage: *
+$ ! $ @COMMS$DIR:substitute.com [Parameters] *
+$ ! *
+$ ! %I = Input file. *
+$ ! %O = Output file. *
+$ ! %1 = The string to Search file for. *
+$ ! %2 = The Replacement String. *
+$ ! %C = Confirm each file to search. *
+$ ! *
+$ !**********************************************************************
+$ !
+$ ON control_y THEN GOTO EXIT
+$
+$ MAIN:
+$ GOSUB Initialize
+$!
+$ GOSUB Get_PARAMETERS
+$ GOSUB Search_Wildcards
+$ Process_LOOP:
+$ IF confirm_FLAG .EQ. TRUE
+$ THEN IN answer "SUBSTITUTE ''read_file' ? [Y]: "
+$ IF f$edit(f$extract(0,1,answer),"UPCASE") .EQS. "A"
+$ THEN confirm_FLAG = TRUE
+$ ENDIF
+$ IF f$edit(f$extract(0,1,answer),"UPCASE") .EQS. "Q"
+$ THEN more_files_FLAG = FALSE
+$ ENDIF
+$ IF f$edit(f$extract(0,1,answer),"UPCASE") .EQS. "Y" .OR. -
+f$edit(f$extract(0,1,answer),"UPCASE") .EQS. NULL
+$ THEN GOSUB Read_Write_To_File
+$ GOSUB Close_FILES
+$ GOSUB Search_Wildcards
+$ ENDIF
+$ IF f$edit(f$extract(0,1,answer),"UPCASE") .EQS. "N"
+$ THEN GOSUB Search_Wildcards
+$ ENDIF
+$ ELSE GOSUB Read_Write_To_File
+$ GOSUB Close_FILES
+$ GOSUB Search_Wildcards
+$ ENDIF
+$ IF more_files_FLAG .EQ. TRUE THEN GOTO Process_LOOP
+$ GOTO EXIT
+$!
+$! ROUTINE to Initialize all variables needed for Procedure
+$!
+$ Initialize:
+$
+$ BITS = 7 !Number of Bits for Chars.
+$ esc[0,BITS] = 27 !Escape character
+$ bell[0,BITS] = 7 !Bell character
+$ quote[0,BITS] = 34 !Double Quote character
+$ csi = esc+"[" !Control Sequence Introducer
+$ cls = csi+"2J"+csi+"H" !Clear Screen Sequence
+$ wide = esc+"#6" !Single width/Double Height
+$ narrow = esc+"#5" !Normal Size characters
+$ bo = csi+"1m" !Bold characters
+$ blink = csi+"5m" !Blinking characters
+$ r = csi+"7m" !Reverse video characters
+$ o = csi+"0m" !Reset character attributes
+$ no = esc+"(B" !DEC Special Graphic set OFF
+$ gr = esc+"(0" !DEC Special Graphic set ON
+$ d = esc+"(0x"+esc+"(B" !Vertical Bar character
+$ tl = esc+"(0l" !Top Left corner character
+$ tr = "k"+esc+"(B" !Top Right corner character
+$ bl = esc+"(0m" !Bottom Left corner character
+$ br = "j"+esc+"(B" !Bottom Right corner character
+$ ml = esc+"(0t" !Middle Left character
+$ mr = "u"+esc+"(B" !Middle Right character
+$ m = "n" !Middle character
+$ md = "w" !Middle Down character
+$ mu = "v" !Middle Up character
+$ el = csi+"0K" !Erase to End of Line
+$ ed = csi+"0J" !Erase to End of Screen
+$ space = " "
+$ NULL = ""
+$ q = "qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq"+-
+"qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq"
+$ IN = "INQUIRE/NOPUNCTUATION"
+$ WS = "WRITE SYS$OUTPUT"
+$ fac = "%SUB"
+$ FALSE = 0
+$ TRUE = 1
+$ position = 4
+$ line_count = 0
+$ P3_count = 0
+$ more_files_FLAG = 0
+$ confirm_FLAG = 0
+$ input_file = NULL
+$ output_file = NULL
+$ def_input_file = "SUBSTITUTE.LIS"
+$ def_output_file = "SUBSTITUTE.LIS"
+$
+$ RETURN
+$!
+$! ROUTINE to for Wildcard files specifications.
+$!
+$ Search_Wildcards:
+$ IF f$extract(f$locate("*",input_file),1,input_file) .EQS. "*" .OR. -
+f$extract(f$locate("%",input_file),1,input_file) .EQS. "%"
+$ THEN
+$ more_files_FLAG = TRUE
+$ read_file = f$search(input_file,1)
+$ extension = f$integer(f$extract(f$locate(";",read_file)+1, -
+f$length(read_file), -
+read_file))
+$ write_file = f$extract(0,f$locate(";",read_file),read_file)+-
+";"+f$str(extension+1)
+$ IF read_file .EQS. NULL THEN more_files_FLAG = FALSE
+$ ELSE
+$ read_file = f$parse(input_file)
+$ write_file = output_file
+$ ENDIF
+$ RETURN
+$!
+$! ROUTINE to Read and Write To Selected File.
+$!
+$ Read_Write_To_File:
+$
+$ OPEN/READ/SHARE/ERROR=ABORT_Error INPUT_FILE 'read_file'
+$ CREATE 'write_file'
+$ OPEN/APPEND/ERROR=ABORT_Error OUTPUT_FILE 'write_file'
+$
+$ ON control_y THEN GOTO ABORT_Control_Y
+$ ON error THEN GOTO ABORT_Error
+$ WS "****************************************"
+$ WS read_file
+$ WS NULL
+$
+$ READ_LOOP:
+$ READ/END_OF_FILE=END_INPUT_FILE INPUT_FILE line
+$ line_count = line_count + 1
+$ IF f$extract(f$locate(s_str,line),f$length(s_str),line) .EQS. s_str
+$ THEN GOSUB Substitute_P3_with_P4
+$ WS dsp_line
+$ WRITE/ERROR=ABORT_error OUTPUT_FILE new_line
+$ ELSE new_line = line
+$ WRITE/ERROR=ABORT_error OUTPUT_FILE new_line
+$ ENDIF
+$ GOTO READ_LOOP
+$
+$ END_INPUT_FILE:
+$ RETURN
+$!
+$! ROUTINE to SUBSTITUTE all occurences of P3 with P4
+$!
+$ Substitute_P3_with_P4:
+$
+$ new_line = NULL
+$ dsp_line = NULL
+$
+$ Substitute_LOOP:
+$
+$ P3_count = P3_count + 1
+$ find_sub_str = f$locate(s_str,line)
+$ new_line = new_line + f$extract(0,find_sub_str,line) + r_str
+$ dsp_line = dsp_line + f$extract(0,find_sub_str,line) + bo+r_str+o
+$ line = f$extract(find_sub_str+f$length(s_str),f$length(line),line)
+$
+$ IF f$extract(f$locate(s_str,line),f$length(s_str),line) .EQS. s_str -
+THEN GOTO Substitute_LOOP
+$
+$ new_line = new_line + line
+$ dsp_line = dsp_line + line
+$
+$ RETURN
+$!
+$! ROUTINE to CLOSE files and write totals to screen.
+$!
+$ Close_FILES:
+$
+$ CLOSE/ERROR=ABORT_Message INPUT_FILE
+$ CLOSE/ERROR=ABORT_Message OUTPUT_FILE
+$ WS NULL
+$ dsp_line = " Occurences of "+quote+s_str+quote+" replaced with "+ -
+quote+r_str+quote
+$ IF P3_count .GT. 0
+$ THEN WS f$str(P3_count) + dsp_line + " written to "+write_file
+$ WS NULL
+$ ELSE IF f$extract(f$locate(";",write_file),1,write_file) .NES. ";"
+$ THEN write_file = write_file + ";"
+$ ENDIF
+$ DELETE/NOLOG/NOCONFIRM 'write_file'
+$ WS "0 Occurences of "+quote+s_str+quote+" found."
+$ WS NULL
+$ ENDIF
+$ P3_count = 0
+$
+$ RETURN
+$!
+$! ROUTINE to GET PARAMETERS and do checks.
+$!
+$ Get_PARAMETERS:
+$ PAR_count = 1
+$ IF p1 .EQS. NULL
+$ THEN
+$ WS "usage: substitute %i [%o] [%1]"
+$ WS " [%2] [%c]"
+$ WS NULL
+$ GOTO EXIT
+$ ENDIF
+$ PAR_Loop:
+$ IF p'PAR_count' .NES. NULL
+$ THEN
+$ IF f$extract(0,2,p'PAR_count') .EQS. "%I"
+$ THEN
+$ input_file = f$extract(2,f$length(p'PAR_count'),p'PAR_count')
+$ IF input_file .EQS. NULL THEN input_file = def_input_file
+$ IF f$extract(f$locate(".",input_file),1,input_file) .NES. "."
+$ THEN
+$ input_file = input_file + ".LIS"
+$ ENDIF
+$ IF f$search(f$parse(input_file)) .EQS. NULL
+$ THEN
+$ msg_txt = "INERR, INPUT File "+input_file+" NOT FOUND"
+$ GOTO ABORT_message
+$ ENDIF
+$ ENDIF
+$
+$ IF f$extract(0,2,p'PAR_count') .EQS. "%O"
+$ THEN
+$ output_file = f$extract(2,f$length(p'PAR_count'),p'PAR_count')
+$ IF output_file .EQS. NULL THEN output_file = def_output_file
+$ ENDIF
+$
+$ IF f$extract(0,2,p'PAR_count') .EQS. "%1"
+$ THEN s_str = p'PAR_count' - "%1"
+$ IF s_str .EQS. NULL
+$ THEN IN s_str "_Search_string: "
+$ ENDIF
+$! s_str = s_str-""""-""""
+$ ENDIF
+$
+$ IF f$extract(0,2,p'PAR_count') .EQS. "%2"
+$ THEN r_str = p'PAR_count' - "%2"
+$ IF r_str .EQS. NULL
+$ THEN IN r_str "_Substitute_string: "
+$ ENDIF
+$! r_str = r_str-""""-""""
+$ ENDIF
+$ IF f$extract(0,2,p'PAR_count') .EQS. "%C" THEN confirm_FLAG = TRUE
+$ ENDIF
+$ PAR_count = PAR_count + 1
+$ IF PAR_count .LT. 9 THEN GOTO PAR_Loop
+$ IF input_file .EQS. NULL
+$ THEN
+$ WS "usage: substitute %i [%o] [%1]"
+$ WS " [%2] [%c]"
+$ WS NULL
+$ GOTO EXIT
+$ ENDIF
+$ IF output_file .EQS. NULL THEN output_file = input_file
+$ RETURN
+$!
+$! ROUTINE to ABORT with an error message.
+$!
+$ ABORT_Message:
+$ WS fac+"-S-"+msg_txt
+$ WS NULL
+$ GOTO EXIT
+$!
+$! ROUTINE to ABORT when ERROR encountered and show error message.
+$!
+$ ABORT_Error:
+$ WS f$message($STATUS)+bell
+$ WS NULL
+$ CLOSE/ERROR=EXIT INPUT_FILE
+$ CLOSE/ERROR=EXIT OUTPUT_FILE
+$ GOTO EXIT
+$!
+$! ROUTINE to ABORT via CONTROL_Y and reset queues.
+$!
+$ ABORT_Control_Y:
+$ msg_txt = "ABORTING Procedure"
+$ WS fac+"-S-Control_Y, "+msg_txt
+$ GOSUB Close_FILES
+$!
+$! ROUTINE to EXIT from procedure and RESET screen.
+$!
+$ EXIT:
+$ oldverify = F$VERIFY(oldverify)
+$ EXIT
+$ !
+$ !**********************************************************************
+$ ! *
+$ ! Modification History *
+$ ! *
+$ !---------------------------------------------------------------------*
+$ ! Date Name Reason (in full) *
+$ !---------------------------------------------------------------------*
+$ ! *
+$ ! 31_Oct_1988 Neil Sakac Create *
+$ ! 08_Mar_1990 Neil Sakac Updated to conform to VMS V5.1 *
+$ ! 16_May_1990 Neil Sakac Updated to accept Wildcards in Input *
+$ ! file specification. *
+$ ! 14_Aug_1990 Neil Sakac Added CONFIRM command to ask before *
+$ ! processing each file. *
+$ ! 13_Sep_1990 Neil Sakac Changed "" for NULL. *
+$ ! *
+$ !**********************************************************************
\ No newline at end of file
diff --git a/tape-handler-dcl b/tape-handler-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_dGFwZS1oYW5kbGVyLWRjbA==
--- /dev/null
+++ b/tape-handler-dcl
@@ -0,0 +1,369 @@
+tape_handler.com
+Ira Carmel, Friday January 16 2004 @ 03:25PM EST
+This program handles MSL5026 tape libraries from a device standpoint. You supply a MGA device, and this program associates the robot that goes with it, and allows you to show library status, and handle backups.
+Sample output:
+
+
+$ thand $2$mga0: print
+Updating the tape status.
+%X10000001
+Printing the tape library status.
+"MRU_ROBOT" = "$2$GGA0:" (LNM$PROCESS_TABLE)
+
+
+$2$MGA0: pulls from slot 16
+$2$MGA0: is library drive 1
+-UNUSED-NT- -FILLED-VMS-
+SLOT0 Full SLOT12 Full
+SLOT1 Full SLOT13 Empty
+SLOT2 Full SLOT14 Empty
+SLOT3 Full SLOT15 Empty
+-UNUSED-VMS-
+SLOT4 Empty SLOT16 Empty
+SLOT5 Full SLOT17 Empty
+SLOT6 Full SLOT18 Empty
+SLOT7 Full SLOT19 Empty
+-UNUSED-VMS- -FILLED-VMS-
+SLOT8 Full SLOT20 Full
+SLOT9 Empty SLOT21 Empty
+SLOT10 Empty SLOT22 Empty
+SLOT11 Empty SLOT23 Empty
+-FILLED-VMS- -EXTRA------
+SLOT12 Full SLOT24 RESERVED
+--DRIVES------
+DRIVE0 Empty
+DRIVE1 Full
+$
+
+$! June 02 2003, Changed program so that it doesn't check for Full but for not empty.
+$! Ira Carmel
+$! This program is designed to handle backup tapes that are in a pair MSL5026 Tape librarys. You select a library by
+$! choosing a $2$MGA device that you wish to talk to. The program is coded with which robot device is associated with that
+$! library. This is something you may have to configure when using this program.
+$! It is currently set to use robots $2$GGA0 and $2$GGA1, and tape drives $2$MGA0 through $2$MGA3
+$! There is a setup section of the program that associates the robot with the drive number and vms device number.
+$! This program has several commands:
+$! Check: determines if there are tapes in the library to complete a nightly backup. (Site dependant.)
+$! Startup: tries to load a tape for a certain drive.
+$! Print: shows the current status of the library and sets up the robot logical so subsequent robot commands at the $
+$! reference the library of the drive you were querying.
+$! Next: puts the current tape in a drive into it's storage slot, and gets the next.
+$! Done: puts the last tape of a set into it's storage slot.
+$!
+$! This program associates a drive/vms device with a slot. In our setup we pull tapes from slots 8-11 and return to 12-15
+$! and pull from 16-19 and return to 21-23. Slot 24 is reserved in our library for the cleaning tape. (I advise you setup
+$! something similar.
+$! We don't use the 1-7 slots in this library. They are reserved for other OS usage.
+$! When this program does a start, if it finds a tape in the drive, it will try and home it, or return it to a 1-7 slot number.
+$! The SETUP: label does the tape to drive to vms device and slot offset associations.
+$! This program also tries to update status from the tape drive whenever it runs. It will also retry talking to the
+$! robot (to do a show) several times because sometimes it takes a couple of tries to establish a connection.
+$!
+$! Warning this code also probably uses a couple of temp directories like batch$log: or batch$dir:
+$! USAGE: @TAPE_HANDLER
+$ wait 00:00:01
+$!
+$!
+$!
+$ tab[0,7] = 9
+$ tried = 0
+$ vfy = f$verify(0)
+$ set proc/priv=all
+$ gosub setup
+$ gosub update_tape_status
+$!
+$ set noon
+$ if p2 .eqs. "STARTUP"
+$ then deassign/system 'tape'_last_used_tape
+$ gosub check_drive
+$ gosub load_vms_tape
+$ gosub print_tape_status
+$ revfy = f$verify('vfy')
+$ exit
+$ endif
+$!
+$ if p2 .eqs. "DONE"
+$ then gosub unload_last_tape
+$ gosub print_tape_status
+$ revfy = f$verify('vfy')
+$ exit
+$ endif
+$!
+$ if p2 .eqs. "PRINT"
+$ then
+$ gosub print_tape_status
+$ revfy = f$verify('vfy')
+$ exit
+$ endif
+$!
+$ if p2 .eqs. "NEXT"
+$ then
+$ gosub print_tape_status
+$ gosub load_vms_tape
+$ gosub print_tape_status
+$ revfy = f$verify('vfy')
+$ exit
+$ endif
+$!
+$ if p2 .eqs. "CHECK"
+$ then
+$ gosub print_tape_status
+$ gosub check_tapes
+$ revfy = f$verify('vfy')
+$ exit
+$ endif
+$
+$!
+$ Write sys$output "No command given."
+$ Write sys$output "USAGE: @TAPE_HANDLER "
+$!
+$!
+$!
+$!
+$!
+$!
+$ revfy = f$verify('vfy')
+$ exit
+$!
+$ check_drive:
+$ if DRIVE'drivenum' .nes. "Empty"
+$ then gosub unload_NT_tape
+$ gosub update_tape_status
+$ !gosub load_vms_tape ! Done in the main line of the program.
+$ endif
+$!
+$ return
+$!
+$ load_vms_tape:
+$ write sys$output "Trying to load a VMS tape to drive ''drivenum'"
+$ if DRIVE'drivenum' .nes. "Empty"
+$ then write sys$output "The drive is full unloading first."
+$ gosub unload_vms_tape
+$ endif
+$ last_used_tape = f$trnlnm("''tape'_last_used_tape")
+$ if last_used_tape .eqs. "" then last_used_tape = slot_offset-1
+$ next_tape = last_used_tape + 1
+$ if next_tape .gt. (slot_offset+3)
+$ then write sys$output "No more tapes available."
+$ mail nl: /subject="No more tapes available. Please add more tapes and redefine ''tape'_last_used_tape"
+$ return
+$ exit 4
+$ endif
+$ if slot'next_tape' .nes. "Empty"
+$ then write sys$output "Trying to move slot ''next_tape' to drive ''drivenum'"
+$ robot move slot 'next_tape' drive 'drivenum'
+$ else define/nolog/system 'tape'_last_used_tape "''next_tape'"
+$ goto load_vms_tape
+$ !mail nl: /subject="No tape available, please insert a tape into slot ''next_tape' of ''tape'." smtp%"carmeli@sutterhealth.org"
+$ ! write sys$output "No tape found to load."
+$ endif
+$ gosub update_tape_status
+$ define/nolog/system 'tape'_last_used_tape "''next_tape'"
+$ return
+$!
+$ unload_last_tape:
+$ write sys$output "Trying to unload the last VMS tape from drive ''drivenum'"
+$ if f$getdvi("''tape'","MNT") .eqs. "TRUE" then dismount/abort 'tape'
+$ return_slot = f$integer(f$trnlnm("''tape'_LAST_USED_TAPE")) + 4
+$ return_again:
+$ write sys$output "Trying to move drive ''drivenum' to slot ''return_slot'"
+$ if DRIVE'drivenum' .nes. "Empty" then robot move drive 'drivenum' slot 'return_slot'
+$ wait 00:00:01
+$ status = $status
+$ if status .nes. "%X00000001"
+$ then return_slot = return_slot + 1
+$ if return_slot .gt. (slot_offset + 7)
+$ then mail nl: /subject="Failed to unload last VMS tape. No unload slots available." smtp%"carmeli@sutterhealth.org"
+$ gosub update_tape_status
+$ exit 4
+$ else
+$ goto return_again
+$ endif
+$ endif
+$ gosub update_tape_status
+$ deassign/system 'tape'_last_used_tape
+$ return
+$!
+$ unload_NT_tape:
+$ write sys$output "Trying to unload (home) an NT tape from drive ''drivenum'"
+$ robot home drive 'drivenum'
+$ status = $status
+$ if status .nes. "%X00000001"
+$ then mail nl: /subject="Juans backups are in the way!" smtp%"carmeli@sutterhealth.org"
+$ gosub update_tape_status
+$ unslot = -1
+$ smalloop:
+$ unslot = unslot +1
+$ if SLOT'unslot' .nes. "Empty" then goto smalloop
+$ robot unload drive 'drivenum' slot 'unslot'
+$ exit
+$! exit 4
+$ endif
+$ return
+$!
+$ unload_VMS_tape:
+$ write sys$output "Trying to unload (home) a VMS tape from drive ''drivenum'"
+$ return_slot = f$integer(f$trnlnm("''tape'_LAST_USED_TAPE")) + 4
+$ write sys$output "Trying to move drive ''drivenum' to slot ''return_slot'"
+$ robot move drive 'drivenum' slot 'return_slot'
+$ status = $status
+$ if status .nes. "%X00000001"
+$ then mail nl: /subject="Failed to unload a VMS tape." smtp%"carmeli@sutterhealth.org"
+$ gosub update_tape_status
+$ exit 4
+$ endif
+$ return
+$
+$ parse_tape_request:
+$ if p1 .eqs. "" then return
+$ if f$search(p1) .eqs. ""
+$ then
+$ tape = p1
+$ return
+$ endif
+$ open/read infile1 'p1'
+$ loop_find_tape:
+$ read/error=finish_find_tape infile1 aline
+$ trequest = f$element(1," ",f$extract(f$locate("Request",aline),f$length(aline),aline))
+$ if trequest .nes. "" then request = trequest
+$ ttape = f$element(0," ",f$extract(f$locate("$2$MGA",aline),f$length(aline),aline))
+$ if ttape .nes. "" then tape = ttape
+$ finish_find_tape:
+$ close infile1
+$ return
+$!
+$ SETUP:
+$!
+$!
+$ NODE = F$GETSYI("NODENAME")
+$ tape = "Parse the tape name out of the trace request."
+$ tape = "NOTAPE"
+$ emailname = ""
+$ emailname = p3
+$ gosub parse_tape_request
+$!
+$ if tape .eqs. "$2$MGA0:"
+$ then slot_offset = 16
+$ drivenum = 1
+$ endif
+$ if tape .eqs. "$2$MGA1:"
+$ then slot_offset = 8
+$ drivenum = 0
+$ endif
+$ if tape .eqs. "$2$MGA2:"
+$ then slot_offset = 16
+$ drivenum = 1
+$ endif
+$ if tape .eqs. "$2$MGA3:"
+$ then slot_offset = 8
+$ drivenum = 0
+$ endif
+$ if tape .eqs. "NOTAPE"
+$ then write sys$output "NO TAPE OF THAT NAME FOUND! EXITING!"
+$ write sys$output "USAGE: @TAPE_HANDLER "
+$ exit 4
+$ endif
+$!
+$ last_used_tape = f$trnlnm("''tape'_last_used_tape")
+$ if last_used_tape .eqs. "" then last_used_tape = slot_offset-1
+$!
+$!!!!!!!!!!!!************** This is where we associate a robot with an MGA device.
+$!
+$ if tape .eqs. "$2$MGA0:" .OR. tape .eqs. "$2$MGA1:" then robot_name = "$2$GGA0:"
+$ if tape .eqs. "$2$MGA2:" .OR. tape .eqs. "$2$MGA3:" then robot_name = "$2$GGA1:"
+$ define/nolog MRU_ROBOT 'robot_name'
+$ return
+$!
+$ update_tape_status:
+$ write sys$output "Updating the tape status."
+$ wait 00:00:01
+$ on error then goto handler
+$ tape_key = tape - ":" - "$" - "$"
+$ if f$search("batch$log:robot_*.log") .nes. "" then delete/nolog batch$log:robot_*.log;
+$ pipe robot show slot 0-23 > batch$log:robot_slot_status_'tape_key'.log
+$ pipe robot show drive 0-1 > batch$log:robot_drive_status_'tape_key'.log
+$ pipe type batch$log:robot_*_status_'tape_key'.log > batch$log:robot_status_'tape_key'.log
+$ handler:
+$ status = $status
+$ write sys$output "''status'"
+$ if status .nes. "%X10000001"
+$ then wait 00:00:15
+$ tried = tried + 1
+$ if tried .gt. 10 then exit 4
+$ goto update_tape_status
+$ endif
+$!
+$ open/read infile batch$log:robot_status_'tape_key'.log
+$ loop: ! get robot status from file
+$ read/error=end_loop infile aline
+$ aline = f$edit(aline,"compress,trim")
+$! write sys$output "''aline'"
+$ item = f$element(0," ",aline) - ":"
+$! write sys$output "''item'"
+$ if item .nes. "SLOT" .AND. item .nes. "DRIVE" then goto loop
+$ contents = f$element(2," ",aline)
+$ num = f$element(1," ",aline)
+$! write sys$output "''item''num'"
+$ 'item''num' = "''contents'"
+$ goto loop
+$ end_loop:
+$ close infile
+$ SLOT24 = "RESERVED"
+$ return
+$!
+$!
+$ CHECK_TAPES:
+$! This routine will do a pre-backup ckeck to determine
+$ tapes_required = f$integer(f$trnlnm("REQUIRED_TAPE"))
+$ message = "Tapes are available for ''node' backups using ''tape'. Required tapes = ''tapes_required'"
+$ ok_to_go = "TRUE"
+$ i = 0
+$ index = -1
+$ chk_tape_loop:
+$ i = i + 1
+$ index = index + 1
+$ slot = slot_offset + index
+$ if i .gt. tapes_required then goto chk_tape_finish
+$ if slot'slot' .nes. "Empty" then goto chk_tape_loop
+$ message = "Slot ''slot' for ''tape' is empty, and it should be Full for a successfull backup."
+$ if emailname .nes. "" then mail nl:/subject="Slot ''slot' for ''tape' is emtpy. To do tonights's backup. A total of ''tapes_required' are needed." -
+smtp%"''emailname'"
+$ ok_to_go = "FALSE"
+$ write sys$output "''message'"
+$ goto chk_tape_loop
+$ chk_tape_finish:
+$ if ok_to_go .eqs. "FALSE" then exit 4
+$ write sys$output "''message'"
+$!
+$ return
+$!
+$ print_tape_status:
+$ write sys$output "Printing the tape library status."
+$ show log mru_robot
+$ write sys$output f$trnlnm("''tape'_last_used_tape")
+$ write sys$output "''tape' pulls from slot ''slot_offset'"
+$ write sys$output "''tape' is library drive ''drivenum'"
+$ i = 0
+$ loop2:
+$ j =12+i
+$ if i .eq. 0 then write sys$output "-UNUSED-NT-''tab'''tab'''tab'''tab'-FILLED-VMS-"
+$ if i .eq. 4 then write sys$output "''tab'''tab'''tab'''tab'''tab'-UNUSED-VMS-"
+$ if i .eq. 8 then write sys$output "-UNUSED-VMS-''tab'''tab'''tab'''tab'-FILLED-VMS-"
+$ if i .eq. 12 then write sys$output "-FILLED-VMS-''tab'''tab'''tab'''tab'-EXTRA------"
+$ write sys$output "SLOT''i' ",SLOT'i',"''tab'''tab'''tab'''tab'SLOT''j' ",SLOT'j'
+$ if i .eq. 12 then goto end_loop2
+$ i = i + 1
+$ goto loop2
+$ end_loop2:
+$ if i .eq. 12 then write sys$output "--DRIVES------"
+$!
+$!
+$ i = 0
+$ loop3:
+$ write sys$output "DRIVE''i' ",DRIVE'i'
+$ if i .eq. 1 then goto end_loop3
+$ i = i + 1
+$ goto loop3
+$ end_loop3:
+$ return
+$!
diff --git a/test_socket-dcl b/test_socket-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_dGVzdF9zb2NrZXQtZGNs
--- /dev/null
+++ b/test_socket-dcl
@@ -0,0 +1,27 @@
+test_socket
+Labadie, Tuesday September 23 2003 @ 10:12AM EDT
+$ set noon
+$ pid = f$getjpi("","pid")
+$ fntmp = "sys$scratch:te"+pid+".tmp"
+$ if f$trnlnm("WAIT_XCOMIP","LNM$SYSTEM_TABLE","EXECUTIVE",,).eqs."" -
+then define/syst/exec wait_xcomip "00:20:00"
+$ BC:
+$ WAIT 'F$TRNLNM("WAIT_XCOMIP","LNM$SYSTEM_TABLE","EXECUTIVE",,)
+$ def/user sys$output 'fntmp
+$ telnet/creat ibm 8044
+$ if $severity.ne.1
+$ then
+$ write sys$output "Xcom IP on IBM unavailable at ''f$time()'"
+$ ! mail or any ...
+$ goto bc
+$ else
+$ ! cleaning
+$ open log 'fntmp
+$ read log line
+$ tnanum = f$extract(3,3,f$elem(4," ",line))
+$ telnet/delete 'tnanum
+$ close log
+$ delete/nolog/noconf 'fntmp;
+$ goto bc
+$ endif
+$ exit
\ No newline at end of file
diff --git a/textpdf-dcl b/textpdf-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_dGV4dHBkZi1kY2w=
--- /dev/null
+++ b/textpdf-dcl
@@ -0,0 +1,374 @@
+Procedure converts text to pdf when using sendmail.com
+Jerry Alan Braga, Friday December 11 2009 @ 05:43PM EST
+/* txt2pdf.com
+Converts text to pdf
+*/
+$ proc = f$enviornment("PROCEDURE")
+$!
+$ txt2pdf = f$edit("$" + f$parse(proc,,,"DEVICE") + f$parse(proc,,,"DIRECTORY") + f$parse(proc,,,"NAME") + ".EXE","LOWERCASE")
+$!
+$ ifil = f$search("''p1'")
+$ if (ifil .eqs. "") then exit
+$!
+$ idev = f$edit(f$parse(ifil,,,"DEVICE"),"LOWERCASE")
+$ idir = f$edit(f$parse(ifil,,,"DIRECTORY"),"LOWERCASE")
+$ inam = f$edit(f$parse(ifil,,,"NAME"),"LOWERCASE")
+$!
+$ ofil = "''p2'"
+$ if (ofil .eqs. "")
+$ then
+$ ofil = f$edit(idev + idir + inam + ".pdf","LOWERCASE")
+$ else
+$ ofil = f$edit(ofil,"COLLAPSE,LOWERCASE")
+$ odev = f$edit(f$parse(ofil,,,"DEVICE"),"LOWERCASE")
+$ odir = f$edit(f$parse(ofil,,,"DIRECTORY"),"LOWERCASE")
+$ onam = f$edit(f$parse(ofil,,,"NAME"),"LOWERCASE")
+$!
+$ if (f$parse(ofil,,,"NAME") .eqs. "")
+$ then
+$ if (odev .nes. "")
+$ then
+$ ofil = odev + odir + inam + ".pdf"
+$ else
+$ ofil = idev + idir + inam + ".pdf"
+$ endif
+$ endif
+$ if (f$parse(ofil,,,"TYPE") .eqs. ".") then ofil = ofil - "." + ".pdf"
+$ endif
+$!
+$ type = "''p3'"
+$ if (type .eqs. "")
+$ then
+$ ilrl = f$file_attributes(ifil,"LRL")
+$ type = "0"
+$ if (ilrl .gt. 80) then type = "1"
+$ if (ilrl .gt. 100) then type = "2"
+$ endif
+$!
+$ txt2pdf "''ifil'" "''ofil'" "''type'"
+$!
+$ purgeit = "''p4'"
+$ if (purgeit .nes. "")
+$ then
+$ purge/nolog 'ofil'
+$ rename/nolog 'ofil' 'ofil'
+$ endif
+$!
+$ exit
+$!
+$!!!!!!!! C Code Follows !!!!!!
+$!
+/*
+Copyright 1998
+P. G. Womack, Diss, Norfolk, UK.
+"BugBear"
+Do what you like, but don't claim you wrote it.
+*/
+
+#include "stdio.h"
+#include "string.h"
+#include "stdlib.h"
+#include "stdarg.h"
+
+
+FILE *fpi;
+FILE *fpo;
+
+
+float page_width = 0.0;
+float page_depth = 0.0;
+float margin = 0.0;
+float font_size = 0.0;
+float lead_size = 0.0;
+
+
+/* Default for portrait 80x66 */
+float p80_page_width = 612.0;
+float p80_page_depth = 792.0;
+float p80_margin = 15.0;
+float p80_font_size = 12.0;
+float p80_lead_size = 11.5;
+
+
+/* Default for landscape 100x66 */
+float l100_page_depth = 612.0;
+float l100_page_width = 792.0;
+float l100_margin = 5.0;
+float l100_font_size = 13.0;
+float l100_lead_size = 10.5;
+
+
+/* Default for landscape 132x66 */
+float l132_page_depth = 612.0;
+float l132_page_width = 792.0;
+float l132_margin = 5.0;
+float l132_font_size = 9.85;
+float l132_lead_size = 9.0;
+
+
+int object_id = 1;
+int page_tree_id;
+
+
+typedef struct _PageList {
+struct _PageList *next;
+int page_id;
+} PageList;
+
+
+int num_pages = 0;
+PageList *pages = NULL;
+PageList **insert_page = &pages;
+store_page(int id)
+{
+PageList *n = (PageList *)malloc(sizeof(*n));
+if(n == NULL)
+{
+fprintf(stderr,
+"Unable to allocate array for page %d.", num_pages + 1);
+exit(4);
+}
+n->next = NULL;
+n->page_id = id;
+*insert_page = n;
+insert_page = &n-;>next;
+num_pages++;
+}
+
+
+int num_xrefs = 0;
+long *xrefs = NULL;
+
+
+start_object(int id)
+{
+if(id >= num_xrefs)
+{
+long *new_xrefs;
+int delta, new_num_xrefs;
+delta = num_xrefs / 5;
+if(delta < 1000)
+delta += 1000;
+new_num_xrefs = num_xrefs + delta;
+new_xrefs = (long *)malloc(new_num_xrefs * sizeof(*new_xrefs));
+if(new_xrefs == NULL)
+{
+fprintf(stderr,
+"Unable to allocate array for object %d.", id);
+exit(4);
+}
+memcpy(new_xrefs, xrefs, num_xrefs * sizeof(*xrefs));
+free(xrefs);
+xrefs = new_xrefs;
+num_xrefs = new_num_xrefs;
+}
+xrefs[id] = ftell(fpo);
+fprintf(fpo,"%d 0 objn", id);
+}
+
+
+int stream_id, stream_len_id;
+long stream_start;
+float ypos;
+start_page()
+{
+stream_id = object_id++;
+stream_len_id = object_id++;
+start_object(stream_id);
+fprintf(fpo,"<< /Length %d 0 R >>n", stream_len_id);
+fprintf(fpo,"streamn");
+stream_start = ftell(fpo);
+fprintf(fpo,"BTn/F0 %g Tfn", font_size);
+ypos = page_depth - margin;
+fprintf(fpo,"%g %g Tdn", margin, ypos);
+fprintf(fpo,"%g TLn", lead_size);
+}
+
+
+end_page()
+{
+long stream_len;
+int page_id = object_id++;
+store_page(page_id);
+fprintf(fpo,"ETn");
+stream_len = ftell(fpo) - stream_start;
+fprintf(fpo,"endstreamnendobjn");
+start_object(stream_len_id);
+fprintf(fpo,"%ldnendobjn", stream_len);
+start_object(page_id);
+fprintf(fpo,"<>nendobjn", page_tree_id, stream_id);
+}
+
+
+do_text()
+{
+char buffer[8192];
+start_page();
+while(fgets(buffer,8192,fpi) != NULL)
+{
+if(ypos < margin)
+{
+end_page();
+start_page();
+}
+
+
+if(strlen(buffer) == 0)
+fprintf(fpo,"T*n");
+else
+{
+if(buffer[0] == 'f')
+{
+end_page();
+start_page();
+}
+else
+{
+int chok = 1;
+char c, *s = buffer;
+fputc('(',fpo);
+while((c = *s++) != '�')
+{
+chok = 1;
+switch(c)
+{
+case 'r':
+case 'n':
+chok = 0;
+break;
+case '(':
+case ')':
+case '':
+fputc('',fpo);
+}
+if (chok) fputc(c,fpo);
+}
+fprintf(fpo,")'n");
+}
+}
+ypos -= lead_size;
+}
+end_page();
+}
+
+
+
+
+int main(argc, argv)
+int argc;
+char **argv;
+{
+int i, catalog_id, font_id, pdf_type;
+long start_xref;
+int debug = 5;
+
+
+char ifile[80] = "";
+char ofile[80] = "";
+
+
+if (argc < 4)
+{
+printf("Usage: input_file output_file type [0=p80x66,1=l100x51,2=l132x66]");
+exit(0);
+}
+
+
+if (argc == debug) printf("Arguments %dn", argc);
+for (i = 1; i < argc; i++)
+{
+if (argc == debug) printf("argument %d: %sn", i, argv);
+if (i == 1) strcpy(ifile,argv);
+if (i == 2) strcpy(ofile,argv);
+};
+if (argc == debug)
+{
+printf("IFile: %sn", ifile);
+printf("OFile: %sn", ofile);
+}
+
+
+switch (argv[3][0]) {
+case '0':
+page_width = p80_page_width;
+page_depth = p80_page_depth;
+margin = p80_margin;
+font_size = p80_font_size;
+lead_size = p80_lead_size;
+if (argc == debug) printf("p80n");
+break;
+case '1':
+page_width = l100_page_width;
+page_depth = l100_page_depth;
+margin = l100_margin;
+font_size = l100_font_size;
+lead_size = l100_lead_size;
+if (argc == debug) printf("l100n");
+break;
+case '2':
+page_width = l132_page_width;
+page_depth = l132_page_depth;
+margin = l132_margin;
+font_size = l132_font_size;
+lead_size = l132_lead_size;
+if (argc == debug) printf("p132n");
+break;
+default:
+if (argc == debug) printf("nonen");
+printf("Usage: input_file output_file type [0,1,2]");
+exit(0);
+break;
+}
+
+
+fpi = fopen(ifile, "r");
+if (fpi == NULL) exit(1);
+
+
+fpo = fopen(ofile, "w");
+if (fpo == NULL) exit(1);
+
+
+fprintf(fpo,"%%PDF-1.0n");
+page_tree_id = object_id++;
+do_text();
+font_id = object_id++;
+start_object(font_id);
+fprintf(fpo,"<>nendobjn");
+start_object(page_tree_id);
+fprintf(fpo,"<page_id);
+ptr = ptr->next;
+}
+fprintf(fpo,"]n");
+}
+fprintf(fpo,"/Resources<> >>n", font_id);
+fprintf(fpo,"/MediaBox [ 0 0 %g %g ]n", page_width, page_depth);
+fprintf(fpo,">>nendobjn");
+catalog_id = object_id++;
+start_object(catalog_id);
+fprintf(fpo,"<>nendobjn", page_tree_id);
+start_xref = ftell(fpo);
+fprintf(fpo,"xrefn");
+fprintf(fpo,"0 %dn", object_id);
+fprintf(fpo,"0000000000 65535 f n");
+for(i = 1; i < object_id; i++)
+fprintf(fpo,"%010ld 00000 n n", xrefs);
+fprintf(fpo,"trailern<>n", object_id, catalog_id);
+fprintf(fpo,"startxrefn%ldn%%%%EOFn", start_xref);
+
+
+fclose(fpi);
+fclose(fpo);
+
+
+if (argc == debug)
+{
+printf("After Open/Close IFile: %sn", ifile);
+printf("After Open/Close OFile: %sn", ofile);
+}
+
+
+exit(0);
+return 0;
+}
+
diff --git a/typlog-dcl b/typlog-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_dHlwbG9nLWRjbA==
--- /dev/null
+++ b/typlog-dcl
@@ -0,0 +1,19 @@
+typlog
+labadie, Thursday December 04 2008 @ 12:38PM EST
+It needs two files
+1) typlog.com
+
+$ awk :== $ SYS$COMMON:[SYSHLP.EXAMPLES.TCPIP.SNMP]GAWK.EXE
+$ ! test if the pid exists
+$ set mess/nofac/nosev/noide/notext
+$ show proc/ide='p1 /out=nla0:
+$ if .not.$status then exit
+$ set mess/fac/sev/ide/text
+$ pipe wr sys$output "sh proc/id=''P1'/chan" | ana/sys | awk/input=sys$login:g.awk sys$pipe
+$ exit
+2) g.awk
+
+$NF ~ /.LOG;[0-9]+$/ {print $NF ;
+system ("type/tail " $NF ) }
+
+
diff --git a/uic-dcl b/uic-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_dWljLWRjbA==
--- /dev/null
+++ b/uic-dcl
@@ -0,0 +1,36 @@
+UIC.COM
+Brian Tillman, Monday August 25 2003 @ 11:24AM EDT
+$ verify = 'f$verify( 0 )
+$ say = "write sys$output"
+$!
+$ getp1:
+$ if p1 .nes. "" then goto gotp1
+$ read/prompt = "_Username: " sys$command p1
+$ goto getp1
+$!
+$ gotp1:
+$ p1 := 'p1
+$ x = p1 - "[" - "]"
+$ if f$type( x ) .eqs. "INTEGER" then goto gotidval
+$ group = f$element( 0, ",", x )
+$ if group .nes. x then goto gotuic
+$ x = f$identifier( x, "name_to_number" )
+$ if x .ge. 0 then goto uicform
+$ x = f$fao( "%X!XL", x )
+$ goto showit
+$!
+$ uicform:
+$ x = f$fao( "!%U", x )
+$ goto showit
+$!
+$ gotuic:
+$ oval = %o'group'
+$ group = oval * 65536
+$ x = group + %o'f$element( 1, ",", x )'
+$!
+$ gotidval:
+$ x = f$identifier( 'x', "number_to_name" )
+$ x = f$fao( "!AS", x )
+$!
+$ showit:
+$ say "%UIC-I-VALUE, ", p1, " = ", x
diff --git a/unix-to-vms-dcl b/unix-to-vms-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_dW5peC10by12bXMtZGNs
--- /dev/null
+++ b/unix-to-vms-dcl
@@ -0,0 +1,38 @@
+UNIX_to_VMS.com
+Aaron, Wednesday July 07 2004 @ 07:53AM EDT
+$!UNIX_TO_VMS.COM - convert a unix file specification into a VMS one
+$! P1 = unix file spec
+$!
+$ on warning then exit $status
+$ on control_y then exit %x2c
+$!
+$ if P1 .eqs. "" then $exit %x114
+$ dev = ""
+$ dir = ""
+$ fn = ""
+$ c = 0
+$LOOP:
+$ t'c' = f$element(c, "/", P1)
+$ if t'c' .nes. "/"
+$ then dir = dir + "." + t'c'
+$ fn = t'c'
+$ c = c + 1
+$ goto LOOP
+$ endif
+$ dir = (dir + "#") - ("." + fn + "#")
+$ if (t0 .eqs. "")
+$ then if fn .eqs. t1
+$ then dir = ""
+$ else dev = t1 + ":"
+$ dir = (dir - (".." + t1)) - "."
+$ endif
+$ if dir .eqs. "" then $dir = "000000"
+$ endif
+$ if dir .nes. "" then $dir = "[" + dir + "]"
+$ tmp = f$element(2, ".", fn)
+$ if (tmp .nes. ".") .and. (f$type(tmp) .eqs. "INTEGER") -
+.and. (f$element(3, ".", fn) .eqs. ".") -
+then $fn = (fn + "#") - ("." + tmp + "#") + ";" + tmp
+$!
+$ UNIX_TO_VMS_FILESPEC == dev + dir + fn
+$ exit
diff --git a/vms-to-unix-dcl b/vms-to-unix-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_dm1zLXRvLXVuaXgtZGNs
--- /dev/null
+++ b/vms-to-unix-dcl
@@ -0,0 +1,39 @@
+VMS_to_UNIX.com
+Aaron, Saturday March 12 2005 @ 06:38PM EST
+$! VMS to U*X
+$! by ACSakovich, 12-Mar-2005
+$! Translates a directory spec in VMS format to an equivalent U*X path.
+$! Takes one parameter, the directory spec. For example,
+$! @VMS_to_Unix Disk$User0:[Aaron]Mozilla.dir
+$! Returns
+$! /DISK$USER0/AARON/MOZILLA
+$! Additionally, using the EachLine program also on dcl.openvms.org, you can
+$! do fun things like:
+$! pipe dir [...]*.dir/nohead | search sys$pipe ":[" | eachline in "vms_to_unix 'in'"
+$! to see your entire directory tree.
+$!
+$ if p1 .eqs. ""
+$ then
+$ write sys$output "/"
+$ exit
+$ endif
+$ p1 = f$elem(0,";",p1)
+$ p1 = p1 - ".DIR"
+$ p1 = p1 - ":"
+$ uxdir = "/"
+$ uxdir = uxdir + f$elem(0,"[",p1)
+$ p1 = p1 - f$elem(0,"[",p1) - "["
+$ lastdir = f$elem(1,"]",p1)
+$ p1 = p1 - lastdir - "]"
+$ cnt = 0
+$ loop:
+$ if f$elem(cnt,".",p1) .nes. "."
+$ then
+$ uxdir = uxdir + "/" + f$elem(cnt,".",p1)
+$ cnt = cnt + 1
+$ goto loop
+$ endif
+$ uxdir = uxdir + "/" + lastdir - "000000/"
+$ write sys$output uxdir
+
+
diff --git a/warnings-dcl b/warnings-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_d2FybmluZ3MtZGNs
--- /dev/null
+++ b/warnings-dcl
@@ -0,0 +1,6 @@
+Warnings.com
+Aaron, Tuesday June 24 2003 @ 11:03PM EDT
+$ define /user sys$output ts.txt
+$ lynx -dump http://iwin.nws.noaa.gov/iwin/us/thunderstorm.html
+$ search ts.txt "madison county",alabama/match=and /window=(1,10)
+$ delete ts.txt;*
diff --git a/workset-dcl b/workset-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_d29ya3NldC1kY2w=
--- /dev/null
+++ b/workset-dcl
@@ -0,0 +1,38 @@
+WORKSET.COM
+Henry G. Juengst, Wednesday October 27 2004 @ 01:31PM EDT
+$OLDP=F$SETPRV("GROUP,WORLD")
+$WRITE SYS$OUTPUT " WORKING SET INFORMATION"
+$WRITE SYS$OUTPUT ""
+$WRITE SYS$OUTPUT " WS WS WS WS Pages Page"
+$WRITE SYS$OUTPUT "Username Processname State Extnt Quota Deflt Size in WS faults Image"
+$WRITE SYS$OUTPUT ""
+$CONTEXT=""
+$PID=""
+$IF P1.NES."" THEN PID=P1
+$START:
+$IF P1.EQS."" THEN PID=F$PID(CONTEXT)
+$IF PID.EQS."" THEN GOTO EXIT
+$USERNAME=F$GETJPI(PID,"USERNAME")
+$IF USERNAME.EQS."" THEN GOTO START
+$PROCESSNAME=F$GETJPI(PID,"PRCNAM")
+$IMAGENAME=F$GETJPI(PID,"IMAGNAME")
+$IMAGENAME=F$PARSE(IMAGENAME,,,"NAME")
+$STATE=F$GETJPI(PID,"STATE")
+$WSDEFAULT=F$GETJPI(PID,"DFWSCNT")
+$WSQUOTA=F$GETJPI(PID,"WSQUOTA")
+$WSEXTENT=F$GETJPI(PID,"WSEXTENT")
+$WSSIZE=F$GETJPI(PID,"WSSIZE")
+$GLOBALPAGES=F$GETJPI(PID,"GPGCNT")
+$PROCESSPAGES=F$GETJPI(PID,"PPGCNT")
+$PAGEFAULTS=F$GETJPI(PID,"PAGEFLTS")
+$PAGES=GLOBALPAGES+PROCESSPAGES
+$TEXT=F$FAO("!AS!15AS!5AS!5(6SL)!7SL!AS",-
+USERNAME,PROCESSNAME,STATE,WSEXTENT,WSQUOTA,WSDEFAULT,WSSIZE,PAGES,-
+PAGEFAULTS," "+IMAGENAME)
+$WRITE SYS$OUTPUT TEXT
+$IF P1.NES."" THEN GOTO EXIT
+$GOTO START
+$EXIT:
+$OLDP=F$SETPRV("''OLDP'")
+(IIRC I inherited this procedure from Wolfgang Schneider - hi:-).
+
diff --git a/x_tcp-dcl b/x_tcp-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_eF90Y3AtZGNs
--- /dev/null
+++ b/x_tcp-dcl
@@ -0,0 +1,186 @@
+X_TCP.COM
+Martin Vorlaender, Thursday September 25 2003 @ 03:15AM EDT
+$! X_TCP.COM
+$! Start an application with X display redirection via TCP/IP
+$! Assumes to be residing in SYS$LOGIN: (see 'login_dir')
+$!
+$! P1: X display, Format: (nodename|IPaddress)[:server[.screen]]
+$! (optional, if DECW$DISPLAY is defined;
+$! Defaults: server=0, screen=0)
+$! P2: Application (.COM or .EXE - including the extension!)
+$! (optional; Default 'default_app' (see below))
+$!
+$! Author: Martin Vorlaender <mv@pdv-systeme.de>
+$
+$ SaveVerify = 'f$verify(f$integer(f$trnlnm("DCL_VERIFY")))
+$
+$ ! default_app is assumed to be some kind of a session manager,
+$ ! which includes initializing the workstation and starting MWM
+$ default_app = "sys$manager:decw$startsm.com"
+$ ! default_app = "cde$system_common:[bin]xsession.com"
+$
+$ display = ""
+$ if p1 .nes. "" then display = p1
+$ app = default_app
+$ if p2 .nes. "" then app = p2
+$
+$ type = f$parse(app,,,"type")
+$ if f$type(type) .eqs. ""
+$ then
+$ write sys$output """''app'"" doesn't have a type"
+$ status = 4042 ! %SYSTEM-F-INVARG
+$ goto fin
+$ endif
+$
+$ self = f$environment("procedure")
+$ login_dir = f$parse(self,,,"device")+f$parse(self,,,"directory")
+$ transport = "TCPIP"
+$
+$ if display .eqs. "" .and. f$trnlnm("DECW$DISPLAY") .eqs. ""
+$ then
+$ write sys$output "No display defined"
+$ status = 44 ! %SYSTEM-F-ABORT
+$ goto fin
+$ endif
+$
+$ if display .nes. ""
+$ then
+$ p = f$locate(":", display) + 1
+$ l = f$length(display)
+$ IF p .gt. l
+$ then
+$ node = display
+$ server = 0
+$ screen = 0
+$ else
+$ node = f$extract(0, p-1, display)
+$ server = f$extract(p, l-p, display)
+$ p = f$locate(".", server) + 1
+$ l = f$length(server)
+$ if p .gt. l
+$ then
+$ screen = 0
+$ else
+$ screen = f$extract(p, l-p, display)
+$ server = f$extract(0, p-1, display)
+$ endif
+$ endif
+$ else ! f$trnlnm("DECW$DISPLAY") .nes. ""
+$ show display /symbol ! undocumented !
+$ node = decw$display_node
+$ server = decw$display_server
+$ screen = decw$display_screen
+$ endif
+$
+$ write sys$output "Starting '",app,"' on ",node,":",server,".",screen
+$
+$ if f$trnlnm("sys$login") .eqs. "" then -
+define/process sys$login 'login_dir'
+$ if f$trnlnm("sys$scratch") .eqs. "" then -
+define/process sys$scratch sys$login:
+$ if f$trnlnm("decw$user_defaults") .eqs. "" then -
+define/process decw$user_defaults sys$login:
+$
+$ goto do_'f$mode()'
+$
+$ do_NETWORK:
+$ do_OTHER:
+$ do_BATCH:
+$
+$ set display -
+/create -
+/transport='transport' -
+/node='node' -
+/server='server' -
+/screen='screen'
+$
+$ if f$parse(app,,,"NAME") .nes. f$parse(default_app,,,"NAME")
+$ then
+$ ! Start MWM and workstation initialization
+$ spawn/nowait/input=nla0:/output='f$trnlnm("DECW$DISPLAY")' -
+run sys$system:decw$mwm
+$ spawn /wait/input=nla0:/output='f$trnlnm("DECW$DISPLAY")' -
+run sys$system:decw$wsinit
+$ endif
+$
+$ if type .eqs. ".COM" then @'app'
+$ if type .eqs. ".EXE" then run 'app'
+$ status = $status
+$
+$ set display /delete
+$ goto fin
+$
+$ do_INTERACTIVE:
+$
+$! posted to comp.os.vms by Larry D Bohan, Jr <LBohan@dbc.com> on 24-Sep-1999
+$! modified by Martin Vorlaender <mv@pdv-systeme.de>
+$!
+$ save_ws = ""
+$ dummy = f$device( "*NL*" ) ! clear device search context
+$ gosub find_unused_ws
+$ if save_ws .eqs. ""
+$ then
+$ set display -
+/create /executive -
+/node='node' -
+/transport='transport' -
+/server='server' -
+/screen='screen'
+$ gosub find_unused_ws
+$ if save_ws .eqs. ""
+$ then
+$ write sys$error "No Free WSAn: devices available"
+$ status = 8396 ! %DCL-W-IVCHAR
+$ goto fin
+$ endif
+$ endif
+$!
+$! make a tmp file, in lieu of a way to pass the right WSAn: device to
+$! the detached process ...
+$ create/nolog sys$scratch:do_x_tcp.com;0
+$ open/append ofp sys$scratch:do_x_tcp.com;0
+$ write ofp "$set noon"
+$ write ofp "$define/process decw$display ",save_ws
+$ write ofp "$define/job decw$display ",save_ws
+$ write ofp "$spawn/nowait/input=nla0:/output=",save_ws," run sys$system:decw$mwm"
+$ write ofp "$spawn /wait/input=nla0:/output=",save_ws," run sys$system:decw$wsinit"
+$ if type .eqs. ".COM" then write ofp "$@",app
+$ if type .eqs. ".EXE" then write ofp "$run ",app
+$ write ofp "$set display ",save_ws,"/delete"
+$ write ofp "$exit $status"
+$ close/nolog ofp
+$ run /detached -
+/input = sys$scratch:do_x_tcp.com;0 -
+/output = sys$scratch:do_x_tcp.log -
+/error = sys$scratch:do_x_tcp.err -
+/authorize - ! needs DETACH privilege
+/privileges=(same) -
+sys$system:loginout.exe
+$ purge/nolog sys$scratch:do_x_tcp.*
+$ status = $status
+$
+$ fin:
+$ exit status+0*f$verify(SaveVerify)
+$
+$find_unused_ws:
+$ save_ws = ""
+$loop_ws:
+$ ws = f$device( "*WS*" )
+$ if ws .nes. ""
+$ then
+$ if f$getdvi( "''ws'", "EXISTS" )
+$ then
+$ sts = f$getdvi( "''ws'", "STS" )
+$ if sts .eq. 16 ! online
+$ then
+$ refcnt = f$getdvi( "''ws'", "REFCNT" )
+$ if refcnt .eq. 0 ! not in use
+$ then
+$ save_ws = ws
+$ return
+$ endif
+$ endif
+$ endif
+$ goto loop_ws
+$ endif
+$ return
diff --git a/xmail-dcl b/xmail-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_eG1haWwtZGNs
--- /dev/null
+++ b/xmail-dcl
@@ -0,0 +1,78 @@
+XMAIL.COM
+John Moore, Thursday April 26 2007 @ 01:47PM EDT
+$ set noon
+$ on control_y then goto abort
+$ read sys$command/end=abort node /prompt="What node should we send to: "
+$ read sys$command/end=abort who /prompt="Who do you want to be: "
+$ if node .eqs. "" then node=f$logical("sys$node")
+$ nul=" "
+$ nul[0,8]=0
+$ open/append/error=abort mailcom 'node'"27="
+$ write mailcom who
+$ c=1
+$ d=0
+$ to:=""
+$doloop:
+$ a=f$element(c,",",to)
+$ if a .eqs. "," then read sys$command/end=outloop to /prompt="Where should it go: "
+$ if a .eqs. "," then if to .eqs. "" then goto outloop
+$ if a .eqs. "," then c=0
+$ if a .eqs. "," then goto doloop
+$ write mailcom a
+$ c=c+1
+$ gosub get_stat
+$ if stat .and. 1 then d=d+1
+$ goto doloop
+$outloop:
+$ if d .eq. 0 then goto done
+$ write mailcom nul
+$ read sys$command/end=done too /prompt="Where should it say it goes: "
+$ write mailcom too
+$ read sys$command/end=abort subj /prompt="Subject: "
+$ write mailcom subj
+$check_edit:
+$ read sys$command/end=abort mail_edit /prompt="Use editor? "
+$ if .not. mail_edit then goto get_what
+$ edit_cmd = "@" + f$trnlnm("MAIL$EDIT")
+$ if edit_cmd .eqs. "@" then edit_cmd = "@SYS$SYSTEM:MAILEDIT"
+$ tmpname := 'f$getjpi("","PID")'tm.tmp
+$ 'edit_cmd' "" sys$scratch:'tmpname'
+$ what = "sys$scratch:" + tmpname
+$ goto message_text
+$get_what:
+$ read sys$command/end=abort what /prompt="What goes: [TT] "
+$ if what .eqs. "" then what:=sys$command
+$message_text:
+$ open/error=get_what file 'what'
+$file_loop:
+$ read/end=end_file_loop/error=end_file_loop file x
+$ write/error=end_file_loop mailcom x
+$ goto file_loop
+$end_file_loop:
+$ write/error=do_stat mailcom nul
+$do_stat:
+$ if d .eq. 0 then goto done
+$stat_loop:
+$ gosub get_stat
+$ d=d-1
+$ if d .ne. 0 then goto stat_loop
+$file_done:
+$ close file
+$done:
+$ close mailcom
+$abort:
+$ if "''tmpname'" .nes. "" .and. f$search("sys$scratch:''tmpname'") .nes. "" -
+then delete/nolog sys$scratch:'tmpname';*
+$ exit
+$get_stat:
+$ read mailcom x
+$ stat=f$cvui(0,32,x)
+$ if stat .and. 1 then return
+$loop_for_stat:
+$ read mailcom x
+$ tip=f$cvui(0,8,x)
+$ if tip .ne. 0 then write sys$output x
+$ if tip .ne. 0 then goto loop_for_stat
+$ return
+
+
diff --git a/ziplogfile-dcl b/ziplogfile-dcl
new file mode 100644
index 0000000000000000000000000000000000000000..b39f900192266a70a4ffed1e909ca1ef02e85d34_emlwbG9nZmlsZS1kY2w=
--- /dev/null
+++ b/ziplogfile-dcl
@@ -0,0 +1,36 @@
+ZipLogFile
+Aaron, Friday January 30 2009 @ 05:40PM EST
+$! ZipLogFile
+$! by ACSakovich, 30-Jan-2009
+$! Take all prior versions of the file spec'd by P1 and move them into
+$! a ZIP archive.
+$
+$ IniVersion = 0
+$ Version = 0
+$ Count = 0
+$ File = ""
+$ Extn = ""
+$
+$ File = f$parse(f$search(p1),,,"Name")
+$ if File .nes. ""
+$ then
+$ Extn = f$parse(f$search(p1),,,"Type") - "."
+$ IniVersion = f$parse(f$search("''File'.''Extn'"),,,"Version") - ";"
+$ Version = IniVersion
+$ Loop:
+$ Version = Version - 1
+$ if Version .gt. 0 -
+then if f$search("''File'.''Extn';''Version'") .nes. "" then goto Loop
+$ ZipLoop:
+$ Version = Version + 1
+$ if Version .lt. IniVersion
+$ then
+$ zip "-mVw" 'File'.zip 'File'.'Extn';'Version'
+$ Count = Count + 1
+$ goto ZipLoop
+$ endif
+$ write sys$output f$fao("Finished zipping up !UL version!%S of !AS.", -
+Count,P1)
+$ else
+$ write sys$output f$fao("No such file as ""!AS"", aborting.",P1)
+$ endif