blob: e6324c000c755bc951e93dc8acde1c7958d647ab [file] [log] [blame]
#!/usr/bin/wish
# This file provides many valuable data processing procedures like lappend_unique, get_var, etc.
proc lappend_unique { args } {
# Add the each entry to a list if and only if they do not already exist in the list.
# Description of argument(s):
# args The first argument should be the list name. All other arguments are
# items to be added to the list.
set list_name [lindex $args 0]
# Remove first entry from args list.
set args [lreplace $args 0 0]
upvar 1 $list_name list
if { ! [info exists list] } { set list {} }
foreach arg $args {
if { [lsearch -exact $list "${arg}"] != -1 } { continue }
lappend list $arg
}
}
proc lsubtract {main_list_name removal_list} {
upvar $main_list_name ref_main_list
# Remove any entry from the main list that is contained in removal list.
# Description of argument(s):
# main_list_name The name of your master list.
# removal_list The list of items to be removed from master list.
# For each element in the removal list, find the corresponding entry in the master list and remove it.
for {set removal_ix 0} {$removal_ix < [llength $removal_list ]}\
{incr removal_ix} {
set value [lindex $removal_list $removal_ix]
set master_ix [lsearch $ref_main_list $value]
set ref_main_list [lreplace $ref_main_list $master_ix $master_ix]
}
}
proc list_map { list expression } {
# Create and return a new list where each element of the new list is a result of running the given
# expression on the corresponding entry from the original list.
# Description of argument(s):
# list A list to be operated on.
# expression A command expression to be run on each element in the list (e.g. '[string
# range $x 1 end]').
foreach x $list {
set cmd_buf "lappend new_list ${expression}"
eval $cmd_buf
}
return $new_list
}
proc list_filter { list expression } {
# Create and return a new list consisting of all elements of the original list that do NOT pass the
# expression.
# Description of argument(s):
# list A list to be operated on.
# expression A command expression to be run on each element in the list (e.g. 'regexp
# -expanded {^[[:blank:]]*\#|^[[:blank:]]*$} $x', 'string equal $x ""',
# etc.).
set new_list {}
foreach x $list {
set cmd_buf "set result \[${expression}\]"
eval $cmd_buf
if { ! $result } { lappend new_list $x }
}
return $new_list
}
proc list_filter_comments { list } {
# Filter comments from list and return new_list as a result.
# Description of argument(s):
# list A list to be operated on.
set comment_regexp {^[[:blank:]]*\#|^[[:blank:]]*$}
set new_list [list_filter $list "regexp -expanded {$comment_regexp} \$x"]
return $new_list
}
proc get_var { var_var { default ""} } {
upvar 1 $var_var var_ref
# Return the value of the variable expression or the value of default if the variable is not defined.
# Example use:
# set PATH [get_var ::env(PATH) "/usr/bin"]
# Description of argument(s):
# var_var The name of a variable (e.g. "::env(NANOSECOND)" or "var1").
# default The default value to return if the variable named in var_var does not
# exist.
expr { [info exists var_ref] ? [return $var_ref] : [return $default] }
}
proc set_var_default { var_name { default ""} } {
upvar 1 $var_name var_ref
# If the variable named in var_name is either blank or non-existent, set its value to the default.
# Example use:
# set_var_default indent 0
# Description of argument(s):
# var_name The name of a variable.
# default The default value to assign to the variable if the variable named in
# var_name is blank or non-existent.
if { ! ([info exists var_ref] && $var_ref != "") } {
set var_ref $default
}
}
proc split_path {path dir_path base_name} {
upvar $dir_path ref_dir_path
upvar $base_name ref_base_name
# Split a path into it's dir_path and base_name. The dir_path variable will include a trailing slash.
# Description of argument(s):
# path The directory or file path.
# dir_path The variable to contain the resulting directory path which will include a
# trailing slash.
# base_name The variable to contain the resulting base directory or file name.
set ref_dir_path "[file dirname ${path}]/"
set ref_base_name "[file tail $path]"
}
proc read_properties_file {parm_file_path} {
# Read properties files and return key/value pairs as a list.
# Description of argument(s):
# parm_file_path The path to the properties file.
# The properties file must have the following format:
# var_name=var_value
# Comment lines (those beginning with a "#") and blank lines are allowed and will be ignored. Leading and
# trailing single or double quotes will be stripped from the value. E.g.
# var1="This one"
# Quotes are stripped so the resulting value for var1 is:
# This one
# Suggestion: The caller can then process the result as an array or a dictionary.
# Example usage:
# array set properties [read_properties_file $file_path]
# print_var properties
# With the following result...
# properties:
# properties(command): string
# Or...
# set properties [read_properties_file $file_path]
# print_dict properties
# With the following result...
# properties:
# properties[command]: string
# Initialize properties array.
set properties [list]
# Read the entire file into a list, filtering comments out.
set file_descriptor [open $parm_file_path r]
set file_data [list_filter_comments [split [read $file_descriptor] "\n"]]
close $file_descriptor
foreach line $file_data {
# Split <var_name>=<var_value> into component parts.
set pair [split $line =]
lappend properties [lindex ${pair} 0]
lappend properties [string trim [lindex ${pair} 1] {"}]
}
return $properties
}
proc convert_array_key {key {convert_commands} {prefix ""} } {
# Convert the key according to the caller's convert_commands and return the result.
# This is designed as a helper procedure to be called by convert_array_keys.
# See convert_array_keys for description of arguments.
set new_key $key
foreach command $convert_commands {
if { $command == "prefix" } {
regsub -all "^$prefix" $new_key {} new_key
set new_key "$prefix$new_key"
} elseif { $command == "rm_prefix" } {
regsub -all "^$prefix" $new_key {} new_key
set new_key "$new_key"
}
if { $command == "upper" } {
set new_key [string toupper $new_key]
} elseif { $command == "lower" } {
set new_key [string tolower $new_key]
}
}
return $new_key
}
proc convert_array_keys {source_arr target_arr {convert_commands}\
{prefix ""} } {
upvar $source_arr source_arr_ref
upvar $target_arr target_arr_ref
# Convert the keys of source_arr according to the caller's convert_commands and put the resulting array in
# target_arr. If this procedure fails for any reason, it will return non-zero.
# Note that despite the name of this procedure, it will also work on a dictionary. In other words, if
# source_arr is NOT an array, it will be processed as a dictionary and target_arr will be created as a
# dictionary as well.
# Description of argument(s):
# source_arr The source array that is to be converted.
# target_arr The target array that results from the conversion.
# convert_commands A list of custom commands that indicate the type of conversion(s) the
# caller wishes to see. Currently the accepted values are as follows:
# upper Convert key value to uppercase.
# lower Convert key value to lowercase.
# prefix Prepend prefix to the key, provided that it does not already exist. If
# upper or lower is included in convert_commands list, the prefix will be
# converted to the specified case as well.
# rm_prefix Remove a prefix that is prepended, provided that it exists.
# prefix The prefix to be used for "prefix" and "rm_prefix" commands (see
# convert_commands text above).
# Validate arguments.
if { [lsearch $convert_commands lower] != -1 } {
if { [lsearch $convert_commands upper] != -1 } {
return -code error "Cannot convert to both upper and lower cases."
}
}
if { [lsearch $convert_commands rm_prefix] != -1} {
if { [lsearch $convert_commands prefix] != -1} {
return -code error "Cannot add and remove a prefix."
}
}
if { [lsearch $convert_commands prefix] != -1 ||\
[lsearch $convert_commands rm_prefix] != -1 } {
if { [lsearch $convert_commands upper] != -1 } {
set prefix [string toupper $prefix]
} elseif { [lsearch $convert_commands lower] != -1 } {
set prefix [string tolower $prefix]
}
}
if { [array exists source_arr_ref] } {
# Initialize targ array.
array set target_arr_ref {}
# Walk the source array doing the conversion specified in convert_commands.
set search_token [array startsearch source_arr_ref]
while {[array anymore source_arr_ref $search_token]} {
set key [array nextelement source_arr_ref $search_token]
set value $source_arr_ref($key)
set new_key [convert_array_key $key $convert_commands $prefix]
set cmd_buf "set target_arr_ref($new_key) $value"
eval $cmd_buf
}
array donesearch source_arr_ref $search_token
} else {
# Initialize targ dictionary.
set target_arr_ref [list]
# Walk the source dictionary doing the conversion specified in convert_commands.
foreach {key value} $source_arr_ref {
set new_key [convert_array_key $key $convert_commands $prefix]
set cmd_buf "dict append target_arr_ref $new_key \$value"
eval $cmd_buf
}
}
}
proc expand_shell_string {buffer} {
upvar $buffer ref_buffer
# Call upon the shell to expand the string in "buffer", i.e. the shell will make substitutions for
# environment variables and glob expressions.
# Description of argument(s):
# buffer The buffer to be expanded.
# This is done to keep echo from interpreting all of the double quotes away.
regsub -all {\"} $ref_buffer "\\\"" ref_buffer
# Bash will compress extra space delimiters if you don't quote the string. So, we quote the argument to
# echo.
if {[catch {set ref_buffer [exec bash -c "echo \"$ref_buffer\""]} result]} {
puts stderr $result
exit 1
}
}
proc add_trailing_string { buffer { add_string "/" } } {
upvar $buffer ref_buffer
# Add the add string to the end of the buffer if and only if it doesn't already end with the add_string.
# Description of argument(s):
# buffer The buffer to be modified.
# add_string The string to conditionally append to the buffer.
regsub -all "${add_string}$" $ref_buffer {} ref_buffer
set ref_buffer "${ref_buffer}${add_string}"
}