New opt.tcl file
Change-Id: I216dba59962093b448740f3c5be0b659952ca263
Signed-off-by: Michael Walsh <micwalsh@us.ibm.com>
diff --git a/lib/opt.tcl b/lib/opt.tcl
new file mode 100755
index 0000000..364282b
--- /dev/null
+++ b/lib/opt.tcl
@@ -0,0 +1,514 @@
+#!/usr/bin/wish
+
+# This file provides many valuable parm and argument processing procedures
+# such as longoptions, pos_parms, gen_get_options, etc.
+
+my_source [list escape.tcl data_proc.tcl print.tcl]
+
+
+proc get_arg_req { opt_name } {
+
+ # Determine whether the given opt_name is "optional", "required" or
+ # "not_allowed" and return that result.
+
+ # Note: This procedure assumes that global list longoptions has been
+ # initialized via a call to the longoptions procedure.
+
+ # Description of argument(s):
+ # opt_name The name of the option including its
+ # requirement indicator as accepted by the
+ # bash getopt longoptions parameter: No
+ # colon means the option takes no argument,
+ # one colon means the option requires an
+ # argument and two colons indicate that an
+ # argument is optional (the value of the
+ # option will be 1 if no argument is
+ # specified.
+
+ global longoptions
+
+ if { [lsearch -exact $longoptions "${opt_name}::"] != -1 } {
+ return optional
+ }
+ if { [lsearch -exact $longoptions "${opt_name}:"] != -1 } {
+ return required
+ }
+ return not_allowed
+
+}
+
+
+proc longoptions { args } {
+
+ # Populate the global longoptions list and set global option variable
+ # defaults.
+
+ # Description of argument(s):
+ # args Each arg is comprised of 1) the name of
+ # the option 2) zero, one or 2 colons to
+ # indicate whether the corresponding
+ # argument value is a) not required, b)
+ # required or c) optional 3) Optionally, an
+ # equal sign followed by a default value for
+ # the parameter.
+
+ # Example usage:
+ # longoptions parm1 parm2: parm3:: test_mode:=0 quiet:=0
+
+ global longoptions
+
+ set debug 0
+ foreach arg $args {
+ # Create an option record which is a 2-element list consisting of the
+ # option specification and a possible default value. Example:;
+ # opt_rec:
+ # opt_rec[0]: test_mode:
+ # opt_rec[1]: 0
+ set opt_rec [split $arg =]
+ # opt_spec will include any colons that may have been specified.
+ set opt_spec [lindex $opt_rec 0]
+ # Add the option spec to the global longoptions list.
+ lappend_unique longoptions $opt_spec
+ # Strip the colons to get the option name.
+ set opt_name [string trimright $opt_spec ":"]
+ # Get the option's default value, if any.
+ set opt_default_value [lindex $opt_rec 1]
+ set arg_req [get_arg_req $opt_name]
+ if { $arg_req == "not_allowed" && $opt_default_value == "" } {
+ # If this parm takes no arg and no default was specified by the user,
+ # we will set the default to 0.
+ set opt_default_value 0
+ }
+ # Set a global variable whose name is identical to the option name. Set
+ # the default value if there is one.
+ set cmd_buf "global ${opt_name} ; set ${opt_name} {${opt_default_value}}"
+ dpissuing
+ eval $cmd_buf
+ }
+
+}
+
+
+proc pos_parms { args } {
+
+ # Populate the global pos_parms list and set global option variable defaults.
+
+ # Description of argument(s):
+ # args Each arg is comprised of the name of a
+ # positional parm and a possible initial
+ # value.
+
+ # Example usage:
+ # pos_parms user_name=mike
+
+ global pos_parms
+
+ set pos_parms [list]
+ set debug 0
+ foreach arg $args {
+ dprint_var arg
+ # Create an option record which is a 2-element list consisting of the
+ # option specification and a possible default value. Example:;
+ # opt_rec:
+ # opt_rec[0]: test_mode:
+ # opt_rec[1]: 0
+ set parm_rec [split $arg =]
+ dprint_list parm_rec
+ # parm_spec will include any colons that may have been specified.
+ set parm_name [lindex $parm_rec 0]
+ dprint_var parm_name
+ # Add the option spec to the global pos_parms list.
+ lappend pos_parms $parm_name
+ # Get the option's default value, if any.
+ set parm_default_value [lindex $parm_rec 1]
+ dprint_var parm_default_value
+ # Set a global variable whose name is identical to the option name. Set
+ # the default value if there is one.
+ set cmd_buf "global ${parm_name} ; set ${parm_name}"
+ append cmd_buf " {${parm_default_value}}"
+ dpissuing
+ eval $cmd_buf
+ }
+
+}
+
+
+proc gen_get_options { argv } {
+
+ # Get the command line options/arguments and use them to set the
+ # corresponding global option variable names.
+
+ # Note: This procedure assumes that global list longoptions has been
+ # initialized via a call to the longoptions procedure and that global
+ # pos_parms has been initialized via a call to the pos_parms procdure.
+ # These data structures indicates what options and arguments are supported
+ # by the calling program.
+
+ # Note: If the last var_name in pos_parms ends in "_list", then the caller
+ # can specify as many parms as they desire and they will all be appended to
+ # the variable in question.
+
+ # Description of argument(s):
+ # argv The argv array that is set for this
+ # program.
+
+ # Example call:
+ # gen_get_options $argv
+
+ global longoptions
+ global pos_parms
+ global program_name
+
+ set debug 0
+
+ set len_pos_parms [llength $pos_parms]
+
+ dprint_list longoptions
+ dprint_list pos_parms
+ dprint_var len_pos_parms
+
+ # Rather than write the algorithm from scratch, we will call upon the bash
+ # getopt program to help us. This program has several advantages:
+ # - It will reject illegal options
+ # - It supports different posix input styles (e.g. -option <arg> vs
+ # --option=<arg>).
+ # - It allows the program's caller to abbreviate option names provided that
+ # there is no ambiguity.
+
+ # Convert curly braces to single quotes. This includes escaping existing
+ # quotes in the argv string. This will allow us to use the result in a bash
+ # command string. Example: {--parm3=Kathy's cat} will become
+ # '--parm3=Kathy'\''s cat'.
+ dprint_var argv
+ set bash_args [curly_braces_to_quotes $argv]
+ set cmd_buf "getopt --name=${program_name} -a --longoptions=\"help"
+ append cmd_buf " ${longoptions}\" --options=\"-h\" -- ${bash_args}"
+ dpissuing
+ if { [ catch {set OPT_LIST [eval exec bash -c {$cmd_buf}]} result ] } {
+ puts stderr $result
+ exit 1
+ }
+
+ set OPT_LIST [quotes_to_curly_braces $OPT_LIST]
+ set cmd_buf "set opt_list \[list $OPT_LIST\]"
+ dpissuing
+ eval $cmd_buf
+
+ dprint_list opt_list
+
+ set longopt_regex {\-[-]?[^- ]+}
+ global help
+ global h
+ set help 0
+ set h 0
+ dprintn ; dprint_timen "Processing opt_list."
+ set pos_parm_ix 0
+ set current_longopt {}
+ foreach opt_list_entry $opt_list {
+ dprint_var opt_list_entry
+ if { $opt_list_entry == "--" } { break; }
+ if { $current_longopt != "" } {
+ dprint_var current_longopt
+ set cmd_buf "global ${current_longopt} ; set ${current_longopt}"
+ append cmd_buf " {${opt_list_entry}}"
+ dpissuing
+ eval $cmd_buf
+ set current_longopt {}
+ dprintn
+ continue
+ }
+ set is_option [regexp -expanded $longopt_regex ${opt_list_entry}]
+ dprint_var is_option
+ if { $is_option } {
+ regsub -all {^\-[-]?} $opt_list_entry {} opt_name
+ dprint_var opt_name
+ set arg_req [get_arg_req $opt_name]
+ dprint_var arg_req
+ if { $arg_req == "not_allowed" } {
+ set cmd_buf "global ${opt_name} ; set ${opt_name} 1"
+ dpissuing
+ eval $cmd_buf
+ } else {
+ set current_longopt [string trimleft $opt_list_entry "-"]
+ }
+ } else {
+ # Must be a positional parm.
+ if { $pos_parm_ix >= $len_pos_parms } {
+ set is_list [regexp -expanded "_list$" ${pos_parm_name}]
+ dprint_var is_list
+ if { $is_list } {
+ set cmd_buf "lappend ${pos_parm_name} {${opt_list_entry}}"
+ dpissuing
+ eval $cmd_buf
+ continue
+ }
+ append message "The caller has specified more positional parms than"
+ append message " are allowed by the program.\n"
+ append message [sprint_varx parm_value ${opt_list_entry} 2]
+ append message [sprint_list pos_parms 2]
+ print_error_report $message
+ exit 1
+ }
+ set pos_parm_name [lindex $pos_parms $pos_parm_ix]
+ set cmd_buf "global ${pos_parm_name} ; set ${pos_parm_name}"
+ append cmd_buf " {${opt_list_entry}}"
+ dpissuing
+ eval $cmd_buf
+ incr pos_parm_ix
+ }
+ dprintn
+ }
+
+ if { $h || $help } {
+ if { [info proc help] != "" } {
+ help
+ } else {
+ puts "No help text defined for this program."
+ }
+ exit 0
+ }
+
+}
+
+
+proc print_usage {} {
+
+ # Print usage help text line.
+
+ # Example:
+ # usage: demo.tcl [OPTIONS] [USERID] [FILE_LIST]
+
+ global program_name
+ global longoptions
+ global pos_parms
+
+ append buffer "usage: $program_name"
+
+ if { $longoptions != "" } {
+ append buffer " \[OPTIONS\]"
+ }
+
+ foreach parm $pos_parms {
+ set upper_parm [string toupper $parm]
+ append buffer " \[$upper_parm\]"
+ }
+
+ puts $buffer
+
+}
+
+
+proc print_option_help { option help_text { data_desc {} } { print_default {}}\
+ { width 30 } } {
+
+ # Print help text for the given option.
+
+ # Description of argument(s):
+ # option The option for which help text should be
+ # printed. This value should include a
+ # leading "--" to indicate that this is an
+ # optional rather than a positional parm.
+ # data_desc A description of the data (e.g. "dir
+ # path", "1,0", etc.)0
+ # print_default Indicates whether the current value of the
+ # global variable representing the option is
+ # to be printed as a default value. For
+ # example, if the option value is "--parm1",
+ # global value parm1 is "no" and
+ # print_default is set, the following phrase
+ # will be appended to the help text: The
+ # default value is "no".
+ # width The width of the arguments column.
+
+ set indent 2
+
+ # Get the actual opt_name by stripping leading dashes and trailing colons.
+ regsub -all {^\-[-]?} $option {} opt_name
+ regsub -all {:[:]?$} $opt_name {} opt_name
+
+ # Set defaults for args to this procedure.
+ set longopt_regex {\-[-]?[^- ]+}
+ set is_option [regexp -expanded $longopt_regex ${option}]
+ if { $is_option } {
+ # It is an option (vs positional parm).
+ # Does it take an argument?
+ set arg_req [get_arg_req $opt_name]
+ if { $arg_req == "not_allowed" } {
+ set data_desc_default ""
+ } else {
+ set data_desc_default "{$opt_name}"
+ }
+ } else {
+ # It's a positional parm.
+ set opt_name [string tolower $opt_name]
+ set data_desc_default ""
+ }
+
+ set_var_default data_desc $data_desc_default
+ set_var_default print_default 1
+
+ if { $print_default } {
+ # Access the global variable that represents the value of the option.
+ eval global $opt_name
+ set cmd_buf "set opt_value \${${opt_name}}"
+ eval $cmd_buf
+ set default_string " The default value is \"${opt_value}\"."
+ } else {
+ set default_string ""
+ }
+
+ if { $data_desc != "" } {
+ # Remove any curly braces and put them back on.
+ set data_desc "{[string trim $data_desc {{}}]}"
+ }
+
+ print_arg_desc "$option $data_desc" "${help_text}${default_string}" 2 $width
+
+}
+
+
+# Create help text variables for stock parms like quiet, debug and test_mode.
+set test_mode_help_text "This means that ${program_name} should go through"
+append test_mode_help_text " all the motions but not actually do anything"
+append test_mode_help_text " substantial. This is mainly to be used by the"
+append test_mode_help_text " developer of ${program_name}."
+set quiet_help_text "If this parameter is set to \"1\", ${program_name} will"
+append quiet_help_text " print only essential information, i.e. it will not"
+append quiet_help_text " echo parameters, echo commands, print the total run"
+append quiet_help_text " time, etc."
+set debug_help_text "If this parameter is set to \"1\", ${program_name} will"
+append debug_help_text " print additional debug information. This is mainly to"
+append debug_help_text " be used by the developer of ${program_name}."
+
+proc gen_print_help { { width 30 } } {
+
+ # Print general help text based on user's pos_parms and longoptions.
+
+ # Note: To use this procedure, the user must create a global help_dict
+ # containing entries for each of their options and one for the program as a
+ # whole. The keys of this dictionary are the option names and the values
+ # are lists whose values map to arguments from the print_option_help
+ # procedure:
+ # - help_text
+ # - data_desc (optional)
+ # - print_default (1 or 0 - default is 1)
+
+ # Example:
+ # set help_dict [dict create\
+ # ${program_name} [list "${program_name} will demonstrate..."]\
+ # userid [list "The userid of the caller."]\
+ # file_list [list "A list of files to be processed."]\
+ # flag [list "A flag to indicate that..."]\
+ # dir_path [list "The path to the directory containing the files."]\
+ # release [list "The code release."]\
+ # ]
+
+ global program_name
+ global longoptions
+ global pos_parms
+
+ global help_dict
+ global test_mode_help_text
+ global quiet_help_text
+ global debug_help_text
+
+ # Add help text for stock options to global help_dict.
+ dict set help_dict test_mode [list $test_mode_help_text "1,0"]
+ dict set help_dict quiet [list $quiet_help_text "1,0"]
+ dict set help_dict debug [list $debug_help_text "1,0"]
+
+ puts ""
+ print_usage
+
+ # Retrieve the general program help text from the help_dict and print it.
+ set help_entry [dict get $help_dict ${program_name}]
+ puts ""
+ puts [lindex $help_entry 0]
+
+ if { $pos_parms != "" } {
+ puts ""
+ puts "positional arguments:"
+ foreach option $pos_parms {
+ # Retrieve the print_option_help parm values from the help_dict and
+ # call print_option_help.
+ set help_entry [dict get $help_dict ${option}]
+ set help_text [lindex $help_entry 0]
+ set data_desc [lindex $help_entry 1]
+ set print_default [lindex $help_entry 2]
+ print_option_help [string toupper $option] $help_text $data_desc\
+ $print_default $width
+ }
+ }
+
+ if { $longoptions != "" } {
+ puts ""
+ puts "optional arguments:"
+ foreach option $longoptions {
+ set option [string trim $option ":"]
+ # Retrieve the print_option_help parm values from the help_dict and
+ # call print_option_help.
+ set help_entry [dict get $help_dict ${option}]
+ set help_text [lindex $help_entry 0]
+ set data_desc [lindex $help_entry 1]
+ set print_default [lindex $help_entry 2]
+ print_option_help "--${option}" $help_text $data_desc $print_default\
+ $width
+ }
+ }
+ puts ""
+
+}
+
+
+proc return_program_options {} {
+
+ # Return all the names of the global program options as a composite list.
+
+ global longoptions pos_parms
+
+ regsub -all {:} $longoptions {} program_options
+ eval lappend program_options $pos_parms
+
+ return $program_options
+
+}
+
+
+proc global_program_options {} {
+
+ # Make all program option global variables available to the calling function.
+ set program_options [return_program_options]
+ uplevel eval global $program_options
+
+}
+
+
+proc gen_pre_validation {} {
+
+ # Do generic post-validation processing. By "post", we mean that this is
+ # to be called from a validation function after the caller has done any
+ # validation desired. If the calling program passes exit_function and
+ # signal_handler parms, this function will register them. In other words,
+ # it will make the signal_handler functions get called for SIGINT and
+ # SIGTERM and will make the exit_function function run prior to the
+ # termination of the program.
+
+ # Make all program option global variables available to the calling function.
+ uplevel global_program_options
+
+}
+
+
+proc gen_post_validation {} {
+
+ # Do generic post-validation processing. By "post", we mean that this is
+ # to be called from a validation function after the caller has done any
+ # validation desired. If the calling program passes exit_function and
+ # signal_handler parms, this function will register them. In other words,
+ # it will make the signal_handler functions get called for SIGINT and
+ # SIGTERM and will make the exit_function function run prior to the
+ # termination of the program.
+
+ trap { exit_proc } [list SIGTERM SIGINT]
+
+}