19d41d461SMichael Walsh#!/usr/bin/wish 29d41d461SMichael Walsh 3*410b1787SMichael Walsh# This file provides many valuable data processing procedures like lappend_unique, get_var, etc. 49d41d461SMichael Walsh 59d41d461SMichael Walsh 69d41d461SMichael Walshproc lappend_unique { args } { 79d41d461SMichael Walsh 8*410b1787SMichael Walsh # Add the each entry to a list if and only if they do not already exist in the list. 99d41d461SMichael Walsh 109d41d461SMichael Walsh # Description of argument(s): 11*410b1787SMichael Walsh # args The first argument should be the list name. All other arguments are 12*410b1787SMichael Walsh # items to be added to the list. 139d41d461SMichael Walsh 149d41d461SMichael Walsh set list_name [lindex $args 0] 159d41d461SMichael Walsh # Remove first entry from args list. 169d41d461SMichael Walsh set args [lreplace $args 0 0] 179d41d461SMichael Walsh 189d41d461SMichael Walsh upvar 1 $list_name list 199d41d461SMichael Walsh 209d41d461SMichael Walsh if { ! [info exists list] } { set list {} } 219d41d461SMichael Walsh 229d41d461SMichael Walsh foreach arg $args { 239d41d461SMichael Walsh if { [lsearch -exact $list "${arg}"] != -1 } { continue } 249d41d461SMichael Walsh lappend list $arg 259d41d461SMichael Walsh } 269d41d461SMichael Walsh 279d41d461SMichael Walsh} 289d41d461SMichael Walsh 299d41d461SMichael Walsh 309d41d461SMichael Walshproc lsubtract {main_list_name removal_list} { 319d41d461SMichael Walsh upvar $main_list_name ref_main_list 329d41d461SMichael Walsh 339d41d461SMichael Walsh # Remove any entry from the main list that is contained in removal list. 349d41d461SMichael Walsh 359d41d461SMichael Walsh # Description of argument(s): 369d41d461SMichael Walsh # main_list_name The name of your master list. 37*410b1787SMichael Walsh # removal_list The list of items to be removed from master list. 389d41d461SMichael Walsh 39*410b1787SMichael Walsh # For each element in the removal list, find the corresponding entry in the master list and remove it. 409d41d461SMichael Walsh for {set removal_ix 0} {$removal_ix < [llength $removal_list ]}\ 419d41d461SMichael Walsh {incr removal_ix} { 429d41d461SMichael Walsh set value [lindex $removal_list $removal_ix] 439d41d461SMichael Walsh set master_ix [lsearch $ref_main_list $value] 449d41d461SMichael Walsh set ref_main_list [lreplace $ref_main_list $master_ix $master_ix] 459d41d461SMichael Walsh } 469d41d461SMichael Walsh 479d41d461SMichael Walsh} 489d41d461SMichael Walsh 499d41d461SMichael Walsh 509d41d461SMichael Walshproc list_map { list expression } { 519d41d461SMichael Walsh 52*410b1787SMichael Walsh # Create and return a new list where each element of the new list is a result of running the given 53*410b1787SMichael Walsh # expression on the corresponding entry from the original list. 549d41d461SMichael Walsh 559d41d461SMichael Walsh # Description of argument(s): 569d41d461SMichael Walsh # list A list to be operated on. 57*410b1787SMichael Walsh # expression A command expression to be run on each element in the list (e.g. '[string 58*410b1787SMichael Walsh # range $x 1 end]'). 599d41d461SMichael Walsh 609d41d461SMichael Walsh foreach x $list { 619d41d461SMichael Walsh set cmd_buf "lappend new_list ${expression}" 629d41d461SMichael Walsh eval $cmd_buf 639d41d461SMichael Walsh } 649d41d461SMichael Walsh 659d41d461SMichael Walsh return $new_list 669d41d461SMichael Walsh 679d41d461SMichael Walsh} 689d41d461SMichael Walsh 699d41d461SMichael Walsh 709d41d461SMichael Walshproc list_filter { list expression } { 719d41d461SMichael Walsh 72*410b1787SMichael Walsh # Create and return a new list consisting of all elements of the original list that do NOT pass the 73*410b1787SMichael Walsh # expression. 749d41d461SMichael Walsh 759d41d461SMichael Walsh # Description of argument(s): 769d41d461SMichael Walsh # list A list to be operated on. 77*410b1787SMichael Walsh # expression A command expression to be run on each element in the list (e.g. 'regexp 78*410b1787SMichael Walsh # -expanded {^[[:blank:]]*\#|^[[:blank:]]*$} $x', 'string equal $x ""', 79*410b1787SMichael Walsh # etc.). 809d41d461SMichael Walsh 819d41d461SMichael Walsh set new_list {} 829d41d461SMichael Walsh 839d41d461SMichael Walsh foreach x $list { 849d41d461SMichael Walsh set cmd_buf "set result \[${expression}\]" 859d41d461SMichael Walsh eval $cmd_buf 869d41d461SMichael Walsh if { ! $result } { lappend new_list $x } 879d41d461SMichael Walsh } 889d41d461SMichael Walsh 899d41d461SMichael Walsh return $new_list 909d41d461SMichael Walsh 919d41d461SMichael Walsh} 929d41d461SMichael Walsh 939d41d461SMichael Walsh 949d41d461SMichael Walshproc list_filter_comments { list } { 959d41d461SMichael Walsh 969d41d461SMichael Walsh # Filter comments from list and return new_list as a result. 979d41d461SMichael Walsh 989d41d461SMichael Walsh # Description of argument(s): 999d41d461SMichael Walsh # list A list to be operated on. 1009d41d461SMichael Walsh 1019d41d461SMichael Walsh set comment_regexp {^[[:blank:]]*\#|^[[:blank:]]*$} 1029d41d461SMichael Walsh 1039d41d461SMichael Walsh set new_list [list_filter $list "regexp -expanded {$comment_regexp} \$x"] 1049d41d461SMichael Walsh 1059d41d461SMichael Walsh return $new_list 1069d41d461SMichael Walsh 1079d41d461SMichael Walsh} 1089d41d461SMichael Walsh 1099d41d461SMichael Walsh 1109d41d461SMichael Walshproc get_var { var_var { default ""} } { 1119d41d461SMichael Walsh upvar 1 $var_var var_ref 1129d41d461SMichael Walsh 113*410b1787SMichael Walsh # Return the value of the variable expression or the value of default if the variable is not defined. 1149d41d461SMichael Walsh 1159d41d461SMichael Walsh # Example use: 1169d41d461SMichael Walsh # set PATH [get_var ::env(PATH) "/usr/bin"] 1179d41d461SMichael Walsh 1189d41d461SMichael Walsh # Description of argument(s): 119*410b1787SMichael Walsh # var_var The name of a variable (e.g. "::env(NANOSECOND)" or "var1"). 120*410b1787SMichael Walsh # default The default value to return if the variable named in var_var does not 121*410b1787SMichael Walsh # exist. 1229d41d461SMichael Walsh 1239d41d461SMichael Walsh expr { [info exists var_ref] ? [return $var_ref] : [return $default] } 1249d41d461SMichael Walsh 1259d41d461SMichael Walsh} 1269d41d461SMichael Walsh 1279d41d461SMichael Walsh 1289d41d461SMichael Walshproc set_var_default { var_name { default ""} } { 1299d41d461SMichael Walsh upvar 1 $var_name var_ref 1309d41d461SMichael Walsh 131*410b1787SMichael Walsh # If the variable named in var_name is either blank or non-existent, set its value to the default. 1329d41d461SMichael Walsh 1339d41d461SMichael Walsh # Example use: 1349d41d461SMichael Walsh # set_var_default indent 0 1359d41d461SMichael Walsh 1369d41d461SMichael Walsh # Description of argument(s): 1379d41d461SMichael Walsh # var_name The name of a variable. 138*410b1787SMichael Walsh # default The default value to assign to the variable if the variable named in 139*410b1787SMichael Walsh # var_name is blank or non-existent. 1409d41d461SMichael Walsh 1419d41d461SMichael Walsh if { ! ([info exists var_ref] && $var_ref != "") } { 1429d41d461SMichael Walsh set var_ref $default 1439d41d461SMichael Walsh } 1449d41d461SMichael Walsh 1459d41d461SMichael Walsh} 1469d41d461SMichael Walsh 1479d41d461SMichael Walsh 1489d41d461SMichael Walshproc split_path {path dir_path base_name} { 1499d41d461SMichael Walsh upvar $dir_path ref_dir_path 1509d41d461SMichael Walsh upvar $base_name ref_base_name 1519d41d461SMichael Walsh 152*410b1787SMichael Walsh # Split a path into it's dir_path and base_name. The dir_path variable will include a trailing slash. 1539d41d461SMichael Walsh 1549d41d461SMichael Walsh # Description of argument(s): 1559d41d461SMichael Walsh # path The directory or file path. 156*410b1787SMichael Walsh # dir_path The variable to contain the resulting directory path which will include a 1579d41d461SMichael Walsh # trailing slash. 158*410b1787SMichael Walsh # base_name The variable to contain the resulting base directory or file name. 1599d41d461SMichael Walsh 1609d41d461SMichael Walsh set ref_dir_path "[file dirname ${path}]/" 1619d41d461SMichael Walsh set ref_base_name "[file tail $path]" 1629d41d461SMichael Walsh 1639d41d461SMichael Walsh} 1649d41d461SMichael Walsh 1659d41d461SMichael Walsh 1669d41d461SMichael Walshproc read_properties_file {parm_file_path} { 1679d41d461SMichael Walsh 1689d41d461SMichael Walsh # Read properties files and return key/value pairs as a list. 1699d41d461SMichael Walsh 170948e2e28SGunnar Mills # Description of argument(s): 1719d41d461SMichael Walsh # parm_file_path The path to the properties file. 1729d41d461SMichael Walsh 1739d41d461SMichael Walsh # The properties file must have the following format: 1749d41d461SMichael Walsh # var_name=var_value 175*410b1787SMichael Walsh # Comment lines (those beginning with a "#") and blank lines are allowed and will be ignored. Leading and 176*410b1787SMichael Walsh # trailing single or double quotes will be stripped from the value. E.g. 1779d41d461SMichael Walsh # var1="This one" 1789d41d461SMichael Walsh # Quotes are stripped so the resulting value for var1 is: 1799d41d461SMichael Walsh # This one 1809d41d461SMichael Walsh 181*410b1787SMichael Walsh # Suggestion: The caller can then process the result as an array or a dictionary. 1829d41d461SMichael Walsh 1839d41d461SMichael Walsh # Example usage: 1849d41d461SMichael Walsh 1859d41d461SMichael Walsh # array set properties [read_properties_file $file_path] 1869d41d461SMichael Walsh # print_var properties 1879d41d461SMichael Walsh 1889d41d461SMichael Walsh # With the following result... 1899d41d461SMichael Walsh 1909d41d461SMichael Walsh # properties: 1919d41d461SMichael Walsh # properties(command): string 1929d41d461SMichael Walsh 1939d41d461SMichael Walsh # Or... 1949d41d461SMichael Walsh 1959d41d461SMichael Walsh # set properties [read_properties_file $file_path] 1969d41d461SMichael Walsh # print_dict properties 1979d41d461SMichael Walsh 1989d41d461SMichael Walsh # With the following result... 1999d41d461SMichael Walsh 2009d41d461SMichael Walsh # properties: 2019d41d461SMichael Walsh # properties[command]: string 2029d41d461SMichael Walsh 2039d41d461SMichael Walsh # Initialize properties array. 2049d41d461SMichael Walsh 2059d41d461SMichael Walsh set properties [list] 2069d41d461SMichael Walsh 2079d41d461SMichael Walsh # Read the entire file into a list, filtering comments out. 2089d41d461SMichael Walsh set file_descriptor [open $parm_file_path r] 2099d41d461SMichael Walsh set file_data [list_filter_comments [split [read $file_descriptor] "\n"]] 2109d41d461SMichael Walsh close $file_descriptor 2119d41d461SMichael Walsh 2129d41d461SMichael Walsh foreach line $file_data { 2139d41d461SMichael Walsh # Split <var_name>=<var_value> into component parts. 2149d41d461SMichael Walsh set pair [split $line =] 2159d41d461SMichael Walsh lappend properties [lindex ${pair} 0] 2169d41d461SMichael Walsh lappend properties [string trim [lindex ${pair} 1] {"}] 2179d41d461SMichael Walsh } 2189d41d461SMichael Walsh 2199d41d461SMichael Walsh return $properties 2209d41d461SMichael Walsh 2219d41d461SMichael Walsh} 2229d41d461SMichael Walsh 2239d41d461SMichael Walsh 22458f9a515SMichael Walshproc convert_array_key {key {convert_commands} {prefix ""} } { 22558f9a515SMichael Walsh 226*410b1787SMichael Walsh # Convert the key according to the caller's convert_commands and return the result. 22758f9a515SMichael Walsh 22858f9a515SMichael Walsh # This is designed as a helper procedure to be called by convert_array_keys. 22958f9a515SMichael Walsh 23058f9a515SMichael Walsh # See convert_array_keys for description of arguments. 23158f9a515SMichael Walsh 23258f9a515SMichael Walsh set new_key $key 23358f9a515SMichael Walsh foreach command $convert_commands { 23458f9a515SMichael Walsh if { $command == "prefix" } { 23558f9a515SMichael Walsh regsub -all "^$prefix" $new_key {} new_key 23658f9a515SMichael Walsh set new_key "$prefix$new_key" 23758f9a515SMichael Walsh } elseif { $command == "rm_prefix" } { 23858f9a515SMichael Walsh regsub -all "^$prefix" $new_key {} new_key 23958f9a515SMichael Walsh set new_key "$new_key" 24058f9a515SMichael Walsh } 24158f9a515SMichael Walsh if { $command == "upper" } { 24258f9a515SMichael Walsh set new_key [string toupper $new_key] 24358f9a515SMichael Walsh } elseif { $command == "lower" } { 24458f9a515SMichael Walsh set new_key [string tolower $new_key] 24558f9a515SMichael Walsh } 24658f9a515SMichael Walsh } 24758f9a515SMichael Walsh 24858f9a515SMichael Walsh return $new_key 24958f9a515SMichael Walsh 25058f9a515SMichael Walsh} 25158f9a515SMichael Walsh 25258f9a515SMichael Walsh 2539d41d461SMichael Walshproc convert_array_keys {source_arr target_arr {convert_commands}\ 2549d41d461SMichael Walsh {prefix ""} } { 2559d41d461SMichael Walsh upvar $source_arr source_arr_ref 2569d41d461SMichael Walsh upvar $target_arr target_arr_ref 2579d41d461SMichael Walsh 258*410b1787SMichael Walsh # Convert the keys of source_arr according to the caller's convert_commands and put the resulting array in 259*410b1787SMichael Walsh # target_arr. If this procedure fails for any reason, it will return non-zero. 26058f9a515SMichael Walsh 261*410b1787SMichael Walsh # Note that despite the name of this procedure, it will also work on a dictionary. In other words, if 262*410b1787SMichael Walsh # source_arr is NOT an array, it will be processed as a dictionary and target_arr will be created as a 263*410b1787SMichael Walsh # dictionary as well. 2649d41d461SMichael Walsh 265948e2e28SGunnar Mills # Description of argument(s): 2669d41d461SMichael Walsh # source_arr The source array that is to be converted. 267*410b1787SMichael Walsh # target_arr The target array that results from the conversion. 268*410b1787SMichael Walsh # convert_commands A list of custom commands that indicate the type of conversion(s) the 269*410b1787SMichael Walsh # caller wishes to see. Currently the accepted values are as follows: 27058f9a515SMichael Walsh # upper Convert key value to uppercase. 27158f9a515SMichael Walsh # lower Convert key value to lowercase. 272*410b1787SMichael Walsh # prefix Prepend prefix to the key, provided that it does not already exist. If 273*410b1787SMichael Walsh # upper or lower is included in convert_commands list, the prefix will be 274*410b1787SMichael Walsh # converted to the specified case as well. 275*410b1787SMichael Walsh # rm_prefix Remove a prefix that is prepended, provided that it exists. 276*410b1787SMichael Walsh # prefix The prefix to be used for "prefix" and "rm_prefix" commands (see 277*410b1787SMichael Walsh # convert_commands text above). 2789d41d461SMichael Walsh 2799d41d461SMichael Walsh # Validate arguments. 2809d41d461SMichael Walsh if { [lsearch $convert_commands lower] != -1 } { 2819d41d461SMichael Walsh if { [lsearch $convert_commands upper] != -1 } { 2829d41d461SMichael Walsh return -code error "Cannot convert to both upper and lower cases." 2839d41d461SMichael Walsh } 2849d41d461SMichael Walsh } 2859d41d461SMichael Walsh 2869d41d461SMichael Walsh if { [lsearch $convert_commands rm_prefix] != -1} { 2879d41d461SMichael Walsh if { [lsearch $convert_commands prefix] != -1} { 2889d41d461SMichael Walsh return -code error "Cannot add and remove a prefix." 2899d41d461SMichael Walsh } 2909d41d461SMichael Walsh } 2919d41d461SMichael Walsh 2929d41d461SMichael Walsh if { [lsearch $convert_commands prefix] != -1 ||\ 2939d41d461SMichael Walsh [lsearch $convert_commands rm_prefix] != -1 } { 2949d41d461SMichael Walsh if { [lsearch $convert_commands upper] != -1 } { 2959d41d461SMichael Walsh set prefix [string toupper $prefix] 2969d41d461SMichael Walsh } elseif { [lsearch $convert_commands lower] != -1 } { 2979d41d461SMichael Walsh set prefix [string tolower $prefix] 2989d41d461SMichael Walsh } 2999d41d461SMichael Walsh } 3009d41d461SMichael Walsh 30158f9a515SMichael Walsh if { [array exists source_arr_ref] } { 3029d41d461SMichael Walsh # Initialize targ array. 3039d41d461SMichael Walsh array set target_arr_ref {} 3049d41d461SMichael Walsh # Walk the source array doing the conversion specified in convert_commands. 3059d41d461SMichael Walsh set search_token [array startsearch source_arr_ref] 3069d41d461SMichael Walsh while {[array anymore source_arr_ref $search_token]} { 3079d41d461SMichael Walsh set key [array nextelement source_arr_ref $search_token] 30858f9a515SMichael Walsh set value $source_arr_ref($key) 3099d41d461SMichael Walsh 31058f9a515SMichael Walsh set new_key [convert_array_key $key $convert_commands $prefix] 31158f9a515SMichael Walsh set cmd_buf "set target_arr_ref($new_key) $value" 3129d41d461SMichael Walsh eval $cmd_buf 3139d41d461SMichael Walsh } 3149d41d461SMichael Walsh array donesearch source_arr_ref $search_token 3159d41d461SMichael Walsh 31658f9a515SMichael Walsh } else { 31758f9a515SMichael Walsh # Initialize targ dictionary. 31858f9a515SMichael Walsh set target_arr_ref [list] 319*410b1787SMichael Walsh # Walk the source dictionary doing the conversion specified in convert_commands. 32058f9a515SMichael Walsh foreach {key value} $source_arr_ref { 32158f9a515SMichael Walsh set new_key [convert_array_key $key $convert_commands $prefix] 32258f9a515SMichael Walsh set cmd_buf "dict append target_arr_ref $new_key \$value" 32358f9a515SMichael Walsh eval $cmd_buf 32458f9a515SMichael Walsh } 32558f9a515SMichael Walsh } 32658f9a515SMichael Walsh 3279d41d461SMichael Walsh} 3289d41d461SMichael Walsh 3299d41d461SMichael Walsh 3309d41d461SMichael Walshproc expand_shell_string {buffer} { 3319d41d461SMichael Walsh upvar $buffer ref_buffer 3329d41d461SMichael Walsh 333*410b1787SMichael Walsh # Call upon the shell to expand the string in "buffer", i.e. the shell will make substitutions for 334*410b1787SMichael Walsh # environment variables and glob expressions. 3359d41d461SMichael Walsh 336948e2e28SGunnar Mills # Description of argument(s): 3379d41d461SMichael Walsh # buffer The buffer to be expanded. 3389d41d461SMichael Walsh 3399d41d461SMichael Walsh # This is done to keep echo from interpreting all of the double quotes away. 3409d41d461SMichael Walsh regsub -all {\"} $ref_buffer "\\\"" ref_buffer 3419d41d461SMichael Walsh 342*410b1787SMichael Walsh # Bash will compress extra space delimiters if you don't quote the string. So, we quote the argument to 343*410b1787SMichael Walsh # echo. 3449d41d461SMichael Walsh if {[catch {set ref_buffer [exec bash -c "echo \"$ref_buffer\""]} result]} { 3459d41d461SMichael Walsh puts stderr $result 3469d41d461SMichael Walsh exit 1 3479d41d461SMichael Walsh } 3489d41d461SMichael Walsh 3499d41d461SMichael Walsh} 3509d41d461SMichael Walsh 3519d41d461SMichael Walsh 3529d41d461SMichael Walshproc add_trailing_string { buffer { add_string "/" } } { 3539d41d461SMichael Walsh upvar $buffer ref_buffer 3549d41d461SMichael Walsh 355*410b1787SMichael Walsh # Add the add string to the end of the buffer if and only if it doesn't already end with the add_string. 3569d41d461SMichael Walsh 357948e2e28SGunnar Mills # Description of argument(s): 3589d41d461SMichael Walsh # buffer The buffer to be modified. 359*410b1787SMichael Walsh # add_string The string to conditionally append to the buffer. 3609d41d461SMichael Walsh 3619d41d461SMichael Walsh regsub -all "${add_string}$" $ref_buffer {} ref_buffer 3629d41d461SMichael Walsh set ref_buffer "${ref_buffer}${add_string}" 3639d41d461SMichael Walsh 3649d41d461SMichael Walsh} 3659d41d461SMichael Walsh 3669d41d461SMichael Walsh 367