blob: 364282b78e840a3418aaf59cc0537598564a4cf6 [file] [log] [blame]
#!/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]
}