108a66766SMichael Walsh#!/usr/bin/wish 208a66766SMichael Walsh 3*410b1787SMichael Walsh# This file provides many valuable parm and argument processing procedures such as longoptions, pos_parms, 4*410b1787SMichael Walsh# gen_get_options, etc. 508a66766SMichael Walsh 608a66766SMichael Walshmy_source [list escape.tcl data_proc.tcl print.tcl] 708a66766SMichael Walsh 808a66766SMichael Walsh 908a66766SMichael Walshproc get_arg_req { opt_name } { 1008a66766SMichael Walsh 11*410b1787SMichael Walsh # Determine whether the given opt_name is "optional", "required" or "not_allowed" and return that result. 1208a66766SMichael Walsh 13*410b1787SMichael Walsh # Note: This procedure assumes that global list longoptions has been initialized via a call to the 14*410b1787SMichael Walsh # longoptions procedure. 1508a66766SMichael Walsh 1608a66766SMichael Walsh # Description of argument(s): 17*410b1787SMichael Walsh # opt_name The name of the option including its requirement indicator as accepted by 18*410b1787SMichael Walsh # the bash getopt longoptions parameter: No colon means the option takes no 19*410b1787SMichael Walsh # argument, one colon means the option requires an argument and two colons 20*410b1787SMichael Walsh # indicate that an argument is optional (the value of the option will be 1 21*410b1787SMichael Walsh # if no argument is specified. 2208a66766SMichael Walsh 2308a66766SMichael Walsh global longoptions 2408a66766SMichael Walsh 2508a66766SMichael Walsh if { [lsearch -exact $longoptions "${opt_name}::"] != -1 } { 2608a66766SMichael Walsh return optional 2708a66766SMichael Walsh } 2808a66766SMichael Walsh if { [lsearch -exact $longoptions "${opt_name}:"] != -1 } { 2908a66766SMichael Walsh return required 3008a66766SMichael Walsh } 3108a66766SMichael Walsh return not_allowed 3208a66766SMichael Walsh 3308a66766SMichael Walsh} 3408a66766SMichael Walsh 3508a66766SMichael Walsh 3608a66766SMichael Walshproc longoptions { args } { 3708a66766SMichael Walsh 38*410b1787SMichael Walsh # Populate the global longoptions list and set global option variable defaults. 3908a66766SMichael Walsh 4008a66766SMichael Walsh # Description of argument(s): 41*410b1787SMichael Walsh # args Each arg is comprised of 1) the name of the option 2) zero, one or 2 42*410b1787SMichael Walsh # colons to indicate whether the corresponding argument value is a) not 43*410b1787SMichael Walsh # required, b) required or c) optional 3) Optionally, an equal sign 44*410b1787SMichael Walsh # followed by a default value for the parameter. 4508a66766SMichael Walsh 4608a66766SMichael Walsh # Example usage: 4708a66766SMichael Walsh # longoptions parm1 parm2: parm3:: test_mode:=0 quiet:=0 4808a66766SMichael Walsh 4908a66766SMichael Walsh global longoptions 5008a66766SMichael Walsh 51*410b1787SMichael Walsh # Note: Because this procedure manipulates global variables, we use the "_opt_<varname>_" format to 52*410b1787SMichael Walsh # minimize the possibility of naming collisions. 532b55f645SMichael Walsh set _opt_debug_ 0 542b55f645SMichael Walsh foreach _opt_arg_ $args { 55*410b1787SMichael Walsh # Create an option record which is a 2-element list consisting of the option specification and a 56*410b1787SMichael Walsh # possible default value. Example:; 5708a66766SMichael Walsh # opt_rec: 5808a66766SMichael Walsh # opt_rec[0]: test_mode: 5908a66766SMichael Walsh # opt_rec[1]: 0 602b55f645SMichael Walsh set _opt_rec_ [split $_opt_arg_ =] 6108a66766SMichael Walsh # opt_spec will include any colons that may have been specified. 622b55f645SMichael Walsh set _opt_spec_ [lindex $_opt_rec_ 0] 6308a66766SMichael Walsh # Add the option spec to the global longoptions list. 642b55f645SMichael Walsh lappend_unique longoptions $_opt_spec_ 6508a66766SMichael Walsh # Strip the colons to get the option name. 662b55f645SMichael Walsh set _opt_name_ [string trimright $_opt_spec_ ":"] 6708a66766SMichael Walsh # Get the option's default value, if any. 682b55f645SMichael Walsh set _opt_default_value_ [lindex $_opt_rec_ 1] 692b55f645SMichael Walsh set _opt_arg_req_ [get_arg_req $_opt_name_] 702b55f645SMichael Walsh if { $_opt_arg_req_ == "not_allowed" && $_opt_default_value_ == "" } { 71*410b1787SMichael Walsh # If this parm takes no arg and no default was specified by the user, we will set the default to 0. 722b55f645SMichael Walsh set _opt_default_value_ 0 7308a66766SMichael Walsh } 74*410b1787SMichael Walsh # Set a global variable whose name is identical to the option name. Set the default value if there is 75*410b1787SMichael Walsh # one. 762b55f645SMichael Walsh set _opt_cmd_buf_ "global ${_opt_name_}" 772b55f645SMichael Walsh if { $_opt_debug_ } { print_issuing $_opt_cmd_buf_ } 782b55f645SMichael Walsh eval $_opt_cmd_buf_ 792b55f645SMichael Walsh set _opt_cmd_buf_ "set ${_opt_name_} {${_opt_default_value_}}" 802b55f645SMichael Walsh if { $_opt_debug_ } { print_issuing $_opt_cmd_buf_ } 812b55f645SMichael Walsh eval $_opt_cmd_buf_ 8208a66766SMichael Walsh } 8308a66766SMichael Walsh 8408a66766SMichael Walsh} 8508a66766SMichael Walsh 8608a66766SMichael Walsh 8708a66766SMichael Walshproc pos_parms { args } { 8808a66766SMichael Walsh 8908a66766SMichael Walsh # Populate the global pos_parms list and set global option variable defaults. 9008a66766SMichael Walsh 9108a66766SMichael Walsh # Description of argument(s): 92*410b1787SMichael Walsh # args Each arg is comprised of the name of a positional parm and a possible 93*410b1787SMichael Walsh # initial value. 9408a66766SMichael Walsh 9508a66766SMichael Walsh # Example usage: 9608a66766SMichael Walsh # pos_parms user_name=mike 9708a66766SMichael Walsh 9808a66766SMichael Walsh global pos_parms 9908a66766SMichael Walsh 10008a66766SMichael Walsh set pos_parms [list] 101*410b1787SMichael Walsh # Note: Because this procedure manipulates global variables, we use the "_opt_<varname>_" format to 102*410b1787SMichael Walsh # minimize the possibility of naming collisions. 1032b55f645SMichael Walsh set _opt_debug_ 0 1042b55f645SMichael Walsh foreach _opt_arg_ $args { 1052b55f645SMichael Walsh if { $_opt_debug_ } { print_var _opt_arg_ } 106*410b1787SMichael Walsh # Create an option record which is a 2-element list consisting of the option specification and a 107*410b1787SMichael Walsh # possible default value. Example:; 10808a66766SMichael Walsh # opt_rec: 10908a66766SMichael Walsh # opt_rec[0]: test_mode: 11008a66766SMichael Walsh # opt_rec[1]: 0 1112b55f645SMichael Walsh set _opt_parm_rec_ [split $_opt_arg_ =] 1122b55f645SMichael Walsh if { $_opt_debug_ } { print_list _opt_parm_rec_ } 11308a66766SMichael Walsh # parm_spec will include any colons that may have been specified. 1142b55f645SMichael Walsh set _opt_parm_name_ [lindex $_opt_parm_rec_ 0] 1152b55f645SMichael Walsh if { $_opt_debug_ } { print_var _opt_parm_name_ } 11608a66766SMichael Walsh # Add the option spec to the global pos_parms list. 1172b55f645SMichael Walsh lappend pos_parms $_opt_parm_name_ 11808a66766SMichael Walsh # Get the option's default value, if any. 1192b55f645SMichael Walsh set _opt_parm_default_value_ [lindex $_opt_parm_rec_ 1] 1202b55f645SMichael Walsh if { $_opt_debug_ } { print_var _opt_parm_default_value_ } 121*410b1787SMichael Walsh # Set a global variable whose name is identical to the option name. Set the default value if there is 122*410b1787SMichael Walsh # one. 1232b55f645SMichael Walsh set _opt_cmd_buf_ "global ${_opt_parm_name_} ; set ${_opt_parm_name_}" 1242b55f645SMichael Walsh append _opt_cmd_buf_ " {${_opt_parm_default_value_}}" 1252b55f645SMichael Walsh if { $_opt_debug_ } { pissuing $_opt_cmd_buf_ } 1262b55f645SMichael Walsh eval $_opt_cmd_buf_ 12708a66766SMichael Walsh } 12808a66766SMichael Walsh 12908a66766SMichael Walsh} 13008a66766SMichael Walsh 13108a66766SMichael Walsh 13208a66766SMichael Walshproc gen_get_options { argv } { 13308a66766SMichael Walsh 134*410b1787SMichael Walsh # Get the command line options/arguments and use them to set the corresponding global option variable names. 13508a66766SMichael Walsh 136*410b1787SMichael Walsh # Note: This procedure assumes that global list longoptions has been initialized via a call to the 137*410b1787SMichael Walsh # longoptions procedure and that global pos_parms has been initialized via a call to the pos_parms 138*410b1787SMichael Walsh # procdure. These data structures indicates what options and arguments are supported by the calling 139*410b1787SMichael Walsh # program. 14008a66766SMichael Walsh 141*410b1787SMichael Walsh # Note: If the last var_name in pos_parms ends in "_list", then the caller can specify as many parms as 142*410b1787SMichael Walsh # they desire and they will all be appended to the variable in question. 14308a66766SMichael Walsh 14408a66766SMichael Walsh # Description of argument(s): 145*410b1787SMichael Walsh # argv The argv array that is set for this program. 14608a66766SMichael Walsh 14708a66766SMichael Walsh # Example call: 14808a66766SMichael Walsh # gen_get_options $argv 14908a66766SMichael Walsh 15008a66766SMichael Walsh global longoptions 15108a66766SMichael Walsh global pos_parms 15208a66766SMichael Walsh global program_name 15308a66766SMichael Walsh 154*410b1787SMichael Walsh # Note: Because this procedure manipulates global variables, we use the "_opt_<varname>_" format to 155*410b1787SMichael Walsh # minimize the possibility of naming collisions. 1562b55f645SMichael Walsh set _opt_debug_ 0 15708a66766SMichael Walsh 1582b55f645SMichael Walsh set _opt_len_pos_parms_ [llength $pos_parms] 15908a66766SMichael Walsh 1602b55f645SMichael Walsh if { $_opt_debug_ } { 1612b55f645SMichael Walsh print_list longoptions 1622b55f645SMichael Walsh print_list pos_parms 1632b55f645SMichael Walsh print_var _opt_len_pos_parms_ 1642b55f645SMichael Walsh } 16508a66766SMichael Walsh 166*410b1787SMichael Walsh # Rather than write the algorithm from scratch, we will call upon the bash getopt program to help us. 167*410b1787SMichael Walsh # This program has several advantages: 16808a66766SMichael Walsh # - It will reject illegal options 169*410b1787SMichael Walsh # - It supports different posix input styles (e.g. -option <arg> vs --option=<arg>). 170*410b1787SMichael Walsh # - It allows the program's caller to abbreviate option names provided that there is no ambiguity. 17108a66766SMichael Walsh 172*410b1787SMichael Walsh # Convert curly braces to single quotes. This includes escaping existing quotes in the argv string. This 173*410b1787SMichael Walsh # will allow us to use the result in a bash command string. Example: {--parm3=Kathy's cat} will become 17408a66766SMichael Walsh # '--parm3=Kathy'\''s cat'. 1752b55f645SMichael Walsh if { $_opt_debug_ } { print_var argv } 1762b55f645SMichael Walsh set _opt_bash_args_ [curly_braces_to_quotes $argv] 1772b55f645SMichael Walsh set _opt_cmd_buf_ "getopt --name=${program_name} -a --longoptions=\"help" 1782b55f645SMichael Walsh append _opt_cmd_buf_ " ${longoptions}\" --options=\"-h\" --" 1792b55f645SMichael Walsh append _opt_cmd_buf_ " ${_opt_bash_args_}" 1802b55f645SMichael Walsh if { $_opt_debug_ } { pissuing $_opt_cmd_buf_ } 1812b55f645SMichael Walsh if { [ catch {set OPT_LIST [eval exec bash -c {$_opt_cmd_buf_}]} result ] } { 18208a66766SMichael Walsh puts stderr $result 18308a66766SMichael Walsh exit 1 18408a66766SMichael Walsh } 18508a66766SMichael Walsh 18608a66766SMichael Walsh set OPT_LIST [quotes_to_curly_braces $OPT_LIST] 1872b55f645SMichael Walsh set _opt_cmd_buf_ "set opt_list \[list $OPT_LIST\]" 1882b55f645SMichael Walsh if { $_opt_debug_ } { pissuing $_opt_cmd_buf_ } 1892b55f645SMichael Walsh eval $_opt_cmd_buf_ 19008a66766SMichael Walsh 1912b55f645SMichael Walsh if { $_opt_debug_ } { print_list opt_list } 19208a66766SMichael Walsh 1932b55f645SMichael Walsh set _opt_longopt_regex_ {\-[-]?[^- ]+} 19408a66766SMichael Walsh global help 19508a66766SMichael Walsh global h 19608a66766SMichael Walsh set help 0 19708a66766SMichael Walsh set h 0 1982b55f645SMichael Walsh if { $_opt_debug_ } { printn ; print_timen "Processing opt_list." } 1992b55f645SMichael Walsh set _opt_pos_parm_ix_ 0 2002b55f645SMichael Walsh set _opt_current_longopt_ {} 20108a66766SMichael Walsh foreach opt_list_entry $opt_list { 2022b55f645SMichael Walsh if { $_opt_debug_ } { print_var opt_list_entry } 20308a66766SMichael Walsh if { $opt_list_entry == "--" } { break; } 2042b55f645SMichael Walsh if { $_opt_current_longopt_ != "" } { 2052b55f645SMichael Walsh if { $_opt_debug_ } { print_var _opt_current_longopt_ } 2062b55f645SMichael Walsh set _opt_cmd_buf_ "global ${_opt_current_longopt_} ; set" 2072b55f645SMichael Walsh append _opt_cmd_buf_ " ${_opt_current_longopt_} {${opt_list_entry}}" 2082b55f645SMichael Walsh if { $_opt_debug_ } { pissuing $_opt_cmd_buf_ } 2092b55f645SMichael Walsh eval $_opt_cmd_buf_ 2102b55f645SMichael Walsh set _opt_current_longopt_ {} 2112b55f645SMichael Walsh if { $_opt_debug_ } { printn } 21208a66766SMichael Walsh continue 21308a66766SMichael Walsh } 2142b55f645SMichael Walsh set _opt_is_option_ [regexp -expanded $_opt_longopt_regex_\ 2152b55f645SMichael Walsh ${opt_list_entry}] 2162b55f645SMichael Walsh if { $_opt_debug_ } { print_var _opt_is_option_ } 2172b55f645SMichael Walsh if { $_opt_is_option_ } { 21808a66766SMichael Walsh regsub -all {^\-[-]?} $opt_list_entry {} opt_name 2192b55f645SMichael Walsh if { $_opt_debug_ } { print_var opt_name } 2202b55f645SMichael Walsh set _opt_arg_req_ [get_arg_req $opt_name] 2212b55f645SMichael Walsh if { $_opt_debug_ } { print_var _opt_arg_req_ } 2222b55f645SMichael Walsh if { $_opt_arg_req_ == "not_allowed" } { 2232b55f645SMichael Walsh set _opt_cmd_buf_ "global ${opt_name} ; set ${opt_name} 1" 2242b55f645SMichael Walsh if { $_opt_debug_ } { pissuing $_opt_cmd_buf_ } 2252b55f645SMichael Walsh eval $_opt_cmd_buf_ 22608a66766SMichael Walsh } else { 2272b55f645SMichael Walsh set _opt_current_longopt_ [string trimleft $opt_list_entry "-"] 22808a66766SMichael Walsh } 22908a66766SMichael Walsh } else { 23008a66766SMichael Walsh # Must be a positional parm. 2312b55f645SMichael Walsh if { $_opt_pos_parm_ix_ >= $_opt_len_pos_parms_ } { 2322b55f645SMichael Walsh set _opt_is_list_ [regexp -expanded "_list$" ${pos_parm_name}] 2332b55f645SMichael Walsh if { $_opt_debug_ } { print_var _opt_is_list_ } 2342b55f645SMichael Walsh if { $_opt_is_list_ } { 2352b55f645SMichael Walsh set _opt_cmd_buf_ "lappend ${pos_parm_name} {${opt_list_entry}}" 2362b55f645SMichael Walsh if { $_opt_debug_ } { pissuing $_opt_cmd_buf_ } 2372b55f645SMichael Walsh eval $_opt_cmd_buf_ 23808a66766SMichael Walsh continue 23908a66766SMichael Walsh } 24008a66766SMichael Walsh append message "The caller has specified more positional parms than" 24108a66766SMichael Walsh append message " are allowed by the program.\n" 24208a66766SMichael Walsh append message [sprint_varx parm_value ${opt_list_entry} 2] 24308a66766SMichael Walsh append message [sprint_list pos_parms 2] 24408a66766SMichael Walsh print_error_report $message 24508a66766SMichael Walsh exit 1 24608a66766SMichael Walsh } 2472b55f645SMichael Walsh set _opt_pos_parm_name_ [lindex $pos_parms $_opt_pos_parm_ix_] 2482b55f645SMichael Walsh set _opt_cmd_buf_ "global ${_opt_pos_parm_name_} ; set" 2492b55f645SMichael Walsh append _opt_cmd_buf_ " ${_opt_pos_parm_name_} {${opt_list_entry}}" 2502b55f645SMichael Walsh if { $_opt_debug_ } { pissuing $_opt_cmd_buf_ } 2512b55f645SMichael Walsh eval $_opt_cmd_buf_ 2522b55f645SMichael Walsh incr _opt_pos_parm_ix_ 25308a66766SMichael Walsh } 2542b55f645SMichael Walsh if { $_opt_debug_ } { printn } 25508a66766SMichael Walsh } 25608a66766SMichael Walsh 2579a800b7fSMichael Walsh # Automatically register any parameter whose name ends in "_password" to 2589a800b7fSMichael Walsh # prevent printing of password. 2599a800b7fSMichael Walsh regsub -all ":" "${longoptions} ${pos_parms}" {} parm_names 2609a800b7fSMichael Walsh foreach parm_name $parm_names { 2619a800b7fSMichael Walsh if { [string match *password $parm_name] } { 2629a800b7fSMichael Walsh global $parm_name 2639a800b7fSMichael Walsh register_passwords [set $parm_name] 2649a800b7fSMichael Walsh } 2659a800b7fSMichael Walsh } 2669a800b7fSMichael Walsh 26708a66766SMichael Walsh if { $h || $help } { 26808a66766SMichael Walsh if { [info proc help] != "" } { 26908a66766SMichael Walsh help 27008a66766SMichael Walsh } else { 27108a66766SMichael Walsh puts "No help text defined for this program." 27208a66766SMichael Walsh } 27308a66766SMichael Walsh exit 0 27408a66766SMichael Walsh } 27508a66766SMichael Walsh 27608a66766SMichael Walsh} 27708a66766SMichael Walsh 27808a66766SMichael Walsh 27908a66766SMichael Walshproc print_usage {} { 28008a66766SMichael Walsh 28108a66766SMichael Walsh # Print usage help text line. 28208a66766SMichael Walsh 28308a66766SMichael Walsh # Example: 28408a66766SMichael Walsh # usage: demo.tcl [OPTIONS] [USERID] [FILE_LIST] 28508a66766SMichael Walsh 28608a66766SMichael Walsh global program_name 28708a66766SMichael Walsh global longoptions 28808a66766SMichael Walsh global pos_parms 28908a66766SMichael Walsh 29008a66766SMichael Walsh append buffer "usage: $program_name" 29108a66766SMichael Walsh 29208a66766SMichael Walsh if { $longoptions != "" } { 29308a66766SMichael Walsh append buffer " \[OPTIONS\]" 29408a66766SMichael Walsh } 29508a66766SMichael Walsh 29608a66766SMichael Walsh foreach parm $pos_parms { 29708a66766SMichael Walsh set upper_parm [string toupper $parm] 29808a66766SMichael Walsh append buffer " \[$upper_parm\]" 29908a66766SMichael Walsh } 30008a66766SMichael Walsh 30108a66766SMichael Walsh puts $buffer 30208a66766SMichael Walsh 30308a66766SMichael Walsh} 30408a66766SMichael Walsh 30508a66766SMichael Walsh 30608a66766SMichael Walshproc print_option_help { option help_text { data_desc {} } { print_default {}}\ 30708a66766SMichael Walsh { width 30 } } { 30808a66766SMichael Walsh 30908a66766SMichael Walsh # Print help text for the given option. 31008a66766SMichael Walsh 31108a66766SMichael Walsh # Description of argument(s): 312*410b1787SMichael Walsh # option The option for which help text should be printed. This value should 313*410b1787SMichael Walsh # include a leading "--" to indicate that this is an optional rather than a 314*410b1787SMichael Walsh # positional parm. 315*410b1787SMichael Walsh # data_desc A description of the data (e.g. "dir path", "1,0", etc.)0 316*410b1787SMichael Walsh # print_default Indicates whether the current value of the global variable representing 317*410b1787SMichael Walsh # the option is to be printed as a default value. For example, if the 318*410b1787SMichael Walsh # option value is "--parm1", global value parm1 is "no" and print_default 319*410b1787SMichael Walsh # is set, the following phrase will be appended to the help text: The 32008a66766SMichael Walsh # default value is "no". 32108a66766SMichael Walsh # width The width of the arguments column. 32208a66766SMichael Walsh 32308a66766SMichael Walsh set indent 2 32408a66766SMichael Walsh 32508a66766SMichael Walsh # Get the actual opt_name by stripping leading dashes and trailing colons. 32608a66766SMichael Walsh regsub -all {^\-[-]?} $option {} opt_name 32708a66766SMichael Walsh regsub -all {:[:]?$} $opt_name {} opt_name 32808a66766SMichael Walsh 32908a66766SMichael Walsh # Set defaults for args to this procedure. 33008a66766SMichael Walsh set longopt_regex {\-[-]?[^- ]+} 33108a66766SMichael Walsh set is_option [regexp -expanded $longopt_regex ${option}] 33208a66766SMichael Walsh if { $is_option } { 33308a66766SMichael Walsh # It is an option (vs positional parm). 33408a66766SMichael Walsh # Does it take an argument? 33508a66766SMichael Walsh set arg_req [get_arg_req $opt_name] 33608a66766SMichael Walsh if { $arg_req == "not_allowed" } { 33708a66766SMichael Walsh set data_desc_default "" 33808a66766SMichael Walsh } else { 33908a66766SMichael Walsh set data_desc_default "{$opt_name}" 34008a66766SMichael Walsh } 34108a66766SMichael Walsh } else { 34208a66766SMichael Walsh # It's a positional parm. 34308a66766SMichael Walsh set opt_name [string tolower $opt_name] 34408a66766SMichael Walsh set data_desc_default "" 34508a66766SMichael Walsh } 34608a66766SMichael Walsh 34708a66766SMichael Walsh set_var_default data_desc $data_desc_default 34808a66766SMichael Walsh set_var_default print_default 1 34908a66766SMichael Walsh 35008a66766SMichael Walsh if { $print_default } { 35108a66766SMichael Walsh # Access the global variable that represents the value of the option. 35208a66766SMichael Walsh eval global $opt_name 35308a66766SMichael Walsh set cmd_buf "set opt_value \${${opt_name}}" 35408a66766SMichael Walsh eval $cmd_buf 35508a66766SMichael Walsh set default_string " The default value is \"${opt_value}\"." 35608a66766SMichael Walsh } else { 35708a66766SMichael Walsh set default_string "" 35808a66766SMichael Walsh } 35908a66766SMichael Walsh 36008a66766SMichael Walsh if { $data_desc != "" } { 36108a66766SMichael Walsh # Remove any curly braces and put them back on. 36208a66766SMichael Walsh set data_desc "{[string trim $data_desc {{}}]}" 36308a66766SMichael Walsh } 36408a66766SMichael Walsh 36508a66766SMichael Walsh print_arg_desc "$option $data_desc" "${help_text}${default_string}" 2 $width 36608a66766SMichael Walsh 36708a66766SMichael Walsh} 36808a66766SMichael Walsh 36908a66766SMichael Walsh 37008a66766SMichael Walsh# Create help text variables for stock parms like quiet, debug and test_mode. 37108a66766SMichael Walshset test_mode_help_text "This means that ${program_name} should go through" 37208a66766SMichael Walshappend test_mode_help_text " all the motions but not actually do anything" 37308a66766SMichael Walshappend test_mode_help_text " substantial. This is mainly to be used by the" 37408a66766SMichael Walshappend test_mode_help_text " developer of ${program_name}." 37508a66766SMichael Walshset quiet_help_text "If this parameter is set to \"1\", ${program_name} will" 37608a66766SMichael Walshappend quiet_help_text " print only essential information, i.e. it will not" 37708a66766SMichael Walshappend quiet_help_text " echo parameters, echo commands, print the total run" 37808a66766SMichael Walshappend quiet_help_text " time, etc." 37908a66766SMichael Walshset debug_help_text "If this parameter is set to \"1\", ${program_name} will" 38008a66766SMichael Walshappend debug_help_text " print additional debug information. This is mainly to" 38108a66766SMichael Walshappend debug_help_text " be used by the developer of ${program_name}." 38208a66766SMichael Walsh 38308a66766SMichael Walshproc gen_print_help { { width 30 } } { 38408a66766SMichael Walsh 38508a66766SMichael Walsh # Print general help text based on user's pos_parms and longoptions. 38608a66766SMichael Walsh 387*410b1787SMichael Walsh # Note: To use this procedure, the user must create a global help_dict containing entries for each of 388*410b1787SMichael Walsh # their options and one for the program as a whole. The keys of this dictionary are the option names and 389*410b1787SMichael Walsh # the values are lists whose values map to arguments from the print_option_help procedure: 39008a66766SMichael Walsh # - help_text 39108a66766SMichael Walsh # - data_desc (optional) 39208a66766SMichael Walsh # - print_default (1 or 0 - default is 1) 39308a66766SMichael Walsh 39408a66766SMichael Walsh # Example: 39508a66766SMichael Walsh # set help_dict [dict create\ 39608a66766SMichael Walsh # ${program_name} [list "${program_name} will demonstrate..."]\ 39708a66766SMichael Walsh # userid [list "The userid of the caller."]\ 39808a66766SMichael Walsh # file_list [list "A list of files to be processed."]\ 39908a66766SMichael Walsh # flag [list "A flag to indicate that..."]\ 40008a66766SMichael Walsh # dir_path [list "The path to the directory containing the files."]\ 40108a66766SMichael Walsh # release [list "The code release."]\ 40208a66766SMichael Walsh # ] 40308a66766SMichael Walsh 40408a66766SMichael Walsh global program_name 40508a66766SMichael Walsh global longoptions 40608a66766SMichael Walsh global pos_parms 40708a66766SMichael Walsh 40808a66766SMichael Walsh global help_dict 40908a66766SMichael Walsh global test_mode_help_text 41008a66766SMichael Walsh global quiet_help_text 41108a66766SMichael Walsh global debug_help_text 41208a66766SMichael Walsh 41308a66766SMichael Walsh # Add help text for stock options to global help_dict. 41408a66766SMichael Walsh dict set help_dict test_mode [list $test_mode_help_text "1,0"] 41508a66766SMichael Walsh dict set help_dict quiet [list $quiet_help_text "1,0"] 41608a66766SMichael Walsh dict set help_dict debug [list $debug_help_text "1,0"] 41708a66766SMichael Walsh 41808a66766SMichael Walsh puts "" 41908a66766SMichael Walsh print_usage 42008a66766SMichael Walsh 42108a66766SMichael Walsh # Retrieve the general program help text from the help_dict and print it. 42208a66766SMichael Walsh set help_entry [dict get $help_dict ${program_name}] 42308a66766SMichael Walsh puts "" 4248cfe9df7SMichael Walsh 4258cfe9df7SMichael Walsh append cmd_buf "echo '[escape_bash_quotes [lindex $help_entry 0]]' | fold" 4268cfe9df7SMichael Walsh append cmd_buf " --spaces --width=80" 4278cfe9df7SMichael Walsh set out_buf [eval exec bash -c {$cmd_buf}] 4288cfe9df7SMichael Walsh 4298cfe9df7SMichael Walsh puts "$out_buf" 43008a66766SMichael Walsh 43108a66766SMichael Walsh if { $pos_parms != "" } { 43208a66766SMichael Walsh puts "" 43308a66766SMichael Walsh puts "positional arguments:" 43408a66766SMichael Walsh foreach option $pos_parms { 435*410b1787SMichael Walsh # Retrieve the print_option_help parm values from the help_dict and call print_option_help. 43608a66766SMichael Walsh set help_entry [dict get $help_dict ${option}] 43708a66766SMichael Walsh set help_text [lindex $help_entry 0] 43808a66766SMichael Walsh set data_desc [lindex $help_entry 1] 43908a66766SMichael Walsh set print_default [lindex $help_entry 2] 44008a66766SMichael Walsh print_option_help [string toupper $option] $help_text $data_desc\ 44108a66766SMichael Walsh $print_default $width 44208a66766SMichael Walsh } 44308a66766SMichael Walsh } 44408a66766SMichael Walsh 44508a66766SMichael Walsh if { $longoptions != "" } { 44608a66766SMichael Walsh puts "" 44708a66766SMichael Walsh puts "optional arguments:" 44808a66766SMichael Walsh foreach option $longoptions { 44908a66766SMichael Walsh set option [string trim $option ":"] 450*410b1787SMichael Walsh # Retrieve the print_option_help parm values from the help_dict and call print_option_help. 45108a66766SMichael Walsh set help_entry [dict get $help_dict ${option}] 45208a66766SMichael Walsh set help_text [lindex $help_entry 0] 45308a66766SMichael Walsh set data_desc [lindex $help_entry 1] 45408a66766SMichael Walsh set print_default [lindex $help_entry 2] 45508a66766SMichael Walsh print_option_help "--${option}" $help_text $data_desc $print_default\ 45608a66766SMichael Walsh $width 45708a66766SMichael Walsh } 45808a66766SMichael Walsh } 45908a66766SMichael Walsh puts "" 46008a66766SMichael Walsh 46108a66766SMichael Walsh} 46208a66766SMichael Walsh 46308a66766SMichael Walsh 46408a66766SMichael Walshproc return_program_options {} { 46508a66766SMichael Walsh 46608a66766SMichael Walsh # Return all the names of the global program options as a composite list. 46708a66766SMichael Walsh 46808a66766SMichael Walsh global longoptions pos_parms 46908a66766SMichael Walsh 47008a66766SMichael Walsh regsub -all {:} $longoptions {} program_options 47108a66766SMichael Walsh eval lappend program_options $pos_parms 47208a66766SMichael Walsh 47308a66766SMichael Walsh return $program_options 47408a66766SMichael Walsh 47508a66766SMichael Walsh} 47608a66766SMichael Walsh 47708a66766SMichael Walsh 47808a66766SMichael Walshproc global_program_options {} { 47908a66766SMichael Walsh 48008a66766SMichael Walsh # Make all program option global variables available to the calling function. 48108a66766SMichael Walsh set program_options [return_program_options] 48208a66766SMichael Walsh uplevel eval global $program_options 48308a66766SMichael Walsh 48408a66766SMichael Walsh} 48508a66766SMichael Walsh 48608a66766SMichael Walsh 48708a66766SMichael Walshproc gen_pre_validation {} { 48808a66766SMichael Walsh 489*410b1787SMichael Walsh # Do generic post-validation processing. By "post", we mean that this is to be called from a validation 490*410b1787SMichael Walsh # function after the caller has done any validation desired. If the calling program passes exit_function 491*410b1787SMichael Walsh # and signal_handler parms, this function will register them. In other words, it will make the 492*410b1787SMichael Walsh # signal_handler functions get called for SIGINT and SIGTERM and will make the exit_function function run 493*410b1787SMichael Walsh # prior to the termination of the program. 49408a66766SMichael Walsh 49508a66766SMichael Walsh # Make all program option global variables available to the calling function. 49608a66766SMichael Walsh uplevel global_program_options 49708a66766SMichael Walsh 49808a66766SMichael Walsh} 49908a66766SMichael Walsh 50008a66766SMichael Walsh 50108a66766SMichael Walshproc gen_post_validation {} { 50208a66766SMichael Walsh 503*410b1787SMichael Walsh # Do generic post-validation processing. By "post", we mean that this is to be called from a validation 504*410b1787SMichael Walsh # function after the caller has done any validation desired. If the calling program passes exit_function 505*410b1787SMichael Walsh # and signal_handler parms, this function will register them. In other words, it will make the 506*410b1787SMichael Walsh # signal_handler functions get called for SIGINT and SIGTERM and will make the exit_function function run 507*410b1787SMichael Walsh # prior to the termination of the program. 50808a66766SMichael Walsh 50908a66766SMichael Walsh trap { exit_proc } [list SIGTERM SIGINT] 51008a66766SMichael Walsh 51108a66766SMichael Walsh} 5129d3ff32cSMichael Walsh 5139d3ff32cSMichael Walsh 5149d3ff32cSMichael Walshproc gen_exit_proc { {ret_code 0} } { 5159d3ff32cSMichael Walsh 5169d3ff32cSMichael Walsh # Call exit_proc if it is defined. Otherwise, just call exit. 5179d3ff32cSMichael Walsh 5189d3ff32cSMichael Walsh if { [info procs "exit_proc"] != "" } { 5199d3ff32cSMichael Walsh exit_proc $ret_code 5209d3ff32cSMichael Walsh } else { 5219d3ff32cSMichael Walsh exit $ret_code 5229d3ff32cSMichael Walsh } 5239d3ff32cSMichael Walsh 5249d3ff32cSMichael Walsh} 525