blob: 0034c7764ae864bf04c8a73a80336185de04604f [file] [log] [blame]
Michael Walsh9d41d462018-02-15 16:34:32 -06001#!/usr/bin/wish
2
3# This file provides many valuable data processing functions like
4# lappend_unique, get_var, etc.
5
6
7proc lappend_unique { args } {
8
9 # Add the each entry to a list if and only if they do not already exist in
10 # the list.
11
12 # Description of argument(s):
13 # args The first argument should be the list
14 # name. All other arguments are items to be
15 # added to the list.
16
17 set list_name [lindex $args 0]
18 # Remove first entry from args list.
19 set args [lreplace $args 0 0]
20
21 upvar 1 $list_name list
22
23 if { ! [info exists list] } { set list {} }
24
25 foreach arg $args {
26 if { [lsearch -exact $list "${arg}"] != -1 } { continue }
27 lappend list $arg
28 }
29
30}
31
32
33proc lsubtract {main_list_name removal_list} {
34 upvar $main_list_name ref_main_list
35
36 # Remove any entry from the main list that is contained in removal list.
37
38 # Description of argument(s):
39 # main_list_name The name of your master list.
40 # removal_list The list of items to be removed from
41 # master list.
42
43 # For each element in the removal list, find the corresponding entry in the
44 # master list and remove it.
45 for {set removal_ix 0} {$removal_ix < [llength $removal_list ]}\
46 {incr removal_ix} {
47 set value [lindex $removal_list $removal_ix]
48 set master_ix [lsearch $ref_main_list $value]
49 set ref_main_list [lreplace $ref_main_list $master_ix $master_ix]
50 }
51
52}
53
54
55proc list_map { list expression } {
56
57 # Create and return a new list where each element of the new list is a
58 # result of running the given expression on the corresponding entry from the
59 # original list.
60
61 # Description of argument(s):
62 # list A list to be operated on.
63 # expression A command expression to be run on each
64 # element in the list (e.g. '[string range
65 # $x 1 end]').
66
67 foreach x $list {
68 set cmd_buf "lappend new_list ${expression}"
69 eval $cmd_buf
70 }
71
72 return $new_list
73
74}
75
76
77proc list_filter { list expression } {
78
79 # Create and return a new list consisting of all elements of the original
80 # list that do NOT pass the expression.
81
82 # Description of argument(s):
83 # list A list to be operated on.
84 # expression A command expression to be run on each
85 # element in the list (e.g. 'regexp
86 # -expanded {^[[:blank:]]*\#|^[[:blank:]]*$}
87 # $x', 'string equal $x ""', etc.).
88
89 set new_list {}
90
91 foreach x $list {
92 set cmd_buf "set result \[${expression}\]"
93 eval $cmd_buf
94 if { ! $result } { lappend new_list $x }
95 }
96
97 return $new_list
98
99}
100
101
102proc list_filter_comments { list } {
103
104 # Filter comments from list and return new_list as a result.
105
106 # Description of argument(s):
107 # list A list to be operated on.
108
109 set comment_regexp {^[[:blank:]]*\#|^[[:blank:]]*$}
110
111 set new_list [list_filter $list "regexp -expanded {$comment_regexp} \$x"]
112
113 return $new_list
114
115}
116
117
118proc get_var { var_var { default ""} } {
119 upvar 1 $var_var var_ref
120
121 # Return the value of the variable expression or the value of default if
122 # the variable is not defined.
123
124 # Example use:
125 # set PATH [get_var ::env(PATH) "/usr/bin"]
126
127 # Description of argument(s):
128 # var_var The name of a variable (e.g.
129 # "::env(NANOSECOND)" or "var1").
130 # default The default value to return if the
131 # variable named in var_var does not exist.
132
133 expr { [info exists var_ref] ? [return $var_ref] : [return $default] }
134
135}
136
137
138proc set_var_default { var_name { default ""} } {
139 upvar 1 $var_name var_ref
140
141 # If the variable named in var_name is either blank or non-existent, set
142 # its value to the default.
143
144 # Example use:
145 # set_var_default indent 0
146
147 # Description of argument(s):
148 # var_name The name of a variable.
149 # default The default value to assign to the
150 # variable if the variable named in var_name
151 # is blank or non-existent.
152
153 if { ! ([info exists var_ref] && $var_ref != "") } {
154 set var_ref $default
155 }
156
157}
158
159
160proc split_path {path dir_path base_name} {
161 upvar $dir_path ref_dir_path
162 upvar $base_name ref_base_name
163
164 # Split a path into it's dir_path and base_name. The dir_path variable
165 # will include a trailing slash.
166
167 # Description of argument(s):
168 # path The directory or file path.
169 # dir_path The variable to contain the resulting
170 # directory path which will include a
171 # trailing slash.
172 # base_name The variable to contain the resulting base
173 # directory or file name.
174
175 set ref_dir_path "[file dirname ${path}]/"
176 set ref_base_name "[file tail $path]"
177
178}
179
180
181proc read_properties_file {parm_file_path} {
182
183 # Read properties files and return key/value pairs as a list.
184
185 # Description of arguement(s):
186 # parm_file_path The path to the properties file.
187
188 # The properties file must have the following format:
189 # var_name=var_value
190 # Comment lines (those beginning with a "#") and blank lines are allowed
191 # and will be ignored. Leading and trailing single or double quotes will be
192 # stripped from the value. E.g.
193 # var1="This one"
194 # Quotes are stripped so the resulting value for var1 is:
195 # This one
196
197 # Suggestion: The caller can then process the result as an array or a
198 # dictionary.
199
200 # Example usage:
201
202 # array set properties [read_properties_file $file_path]
203 # print_var properties
204
205 # With the following result...
206
207 # properties:
208 # properties(command): string
209
210 # Or...
211
212 # set properties [read_properties_file $file_path]
213 # print_dict properties
214
215 # With the following result...
216
217 # properties:
218 # properties[command]: string
219
220 # Initialize properties array.
221
222 set properties [list]
223
224 # Read the entire file into a list, filtering comments out.
225 set file_descriptor [open $parm_file_path r]
226 set file_data [list_filter_comments [split [read $file_descriptor] "\n"]]
227 close $file_descriptor
228
229 foreach line $file_data {
230 # Split <var_name>=<var_value> into component parts.
231 set pair [split $line =]
232 lappend properties [lindex ${pair} 0]
233 lappend properties [string trim [lindex ${pair} 1] {"}]
234 }
235
236 return $properties
237
238}
239
240
241proc convert_array_keys {source_arr target_arr {convert_commands}\
242 {prefix ""} } {
243 upvar $source_arr source_arr_ref
244 upvar $target_arr target_arr_ref
245
246 # Convert the keys of source_arr according to the caller's convert_commands
247 # and put the resulting array in target_arr. If this function fails for any
248 # reason, it will return non-zero
249
250 # Description of arguement(s):
251 # source_arr The source array that is to be converted.
252 # target_arr The target array that results from the
253 # conversion.
254 # convert_commands A list of custom commands that indicate
255 # the type of conversion(s) the caller
256 # wishes to see. Currently the accepted
257 # values are as follows:
258 # - upper Convert key value to uppercase.
259 # - lower Convert key value to lowercase.
260 # - prefix Prepend prefix to the key, provided that it does not
261 # already exist. If upper or lower is included in convert_commands list, the
262 # prefix will be converted to the specified case as well.
263 # - rm_prefix Remove a prefix that is prepended, provided that it exists.
264 # prefix The prefix to be used for "prefix" and
265 # "rm_prefix" commands (see convert_commands
266 # text above).
267
268 # Validate arguments.
269 if { [lsearch $convert_commands lower] != -1 } {
270 if { [lsearch $convert_commands upper] != -1 } {
271 return -code error "Cannot convert to both upper and lower cases."
272 }
273 }
274
275 if { [lsearch $convert_commands rm_prefix] != -1} {
276 if { [lsearch $convert_commands prefix] != -1} {
277 return -code error "Cannot add and remove a prefix."
278 }
279 }
280
281 if { [lsearch $convert_commands prefix] != -1 ||\
282 [lsearch $convert_commands rm_prefix] != -1 } {
283 if { [lsearch $convert_commands upper] != -1 } {
284 set prefix [string toupper $prefix]
285 } elseif { [lsearch $convert_commands lower] != -1 } {
286 set prefix [string tolower $prefix]
287 }
288 }
289
290 # Initialize targ array.
291 array set target_arr_ref {}
292
293 # Walk the source array doing the conversion specified in convert_commands.
294 set search_token [array startsearch source_arr_ref]
295 while {[array anymore source_arr_ref $search_token]} {
296 set key [array nextelement source_arr_ref $search_token]
297 set arr_value $source_arr_ref($key)
298 set new_key "$key"
299
300 foreach command $convert_commands {
301 if { $command == "prefix" } {
302 regsub -all "^$prefix" $new_key {} new_key
303 set new_key "$prefix$new_key"
304 } elseif { $command == "rm_prefix" } {
305 regsub -all "^$prefix" $new_key {} new_key
306 set new_key "$new_key"
307 }
308 if { $command == "upper" } {
309 set new_key [string toupper $new_key]
310 } elseif { $command == "lower" } {
311 set new_key [string tolower $new_key]
312 }
313 }
314 set cmd_buf "set target_arr_ref($new_key) $arr_value"
315 eval $cmd_buf
316 }
317 array donesearch source_arr_ref $search_token
318
319}
320
321
322proc expand_shell_string {buffer} {
323 upvar $buffer ref_buffer
324
325 # Call upon the shell to expand the string in "buffer", i.e. the shell will
326 # make substitutions for environment variables and glob expressions.
327
328 # Description of arguement(s):
329 # buffer The buffer to be expanded.
330
331 # This is done to keep echo from interpreting all of the double quotes away.
332 regsub -all {\"} $ref_buffer "\\\"" ref_buffer
333
334 # Bash will compress extra space delimiters if you don't quote the string.
335 # So, we quote the argument to echo.
336 if {[catch {set ref_buffer [exec bash -c "echo \"$ref_buffer\""]} result]} {
337 puts stderr $result
338 exit 1
339 }
340
341}
342
343
344proc add_trailing_string { buffer { add_string "/" } } {
345 upvar $buffer ref_buffer
346
347 # Add the add string to the end of the buffer if and only if it doesn't
348 # already end with the add_string.
349
350 # Description of arguement(s):
351 # buffer The buffer to be modified.
352 # add_string The string to conditionally append to the
353 # buffer.
354
355 regsub -all "${add_string}$" $ref_buffer {} ref_buffer
356 set ref_buffer "${ref_buffer}${add_string}"
357
358}
359
360