blob: c7f601eb1a8b6a007be91ed8b15c677df5c3ff32 [file] [log] [blame]
Michael Walsh768c1302018-02-15 17:17:55 -06001#!/usr/bin/wish
2
3# This file provides many valuable validation procedures such as valid_value,
4# valid_integer, etc.
5
6my_source [list print.tcl call_stack.tcl]
7
8
9proc valid_value { var_name { invalid_values {}} { valid_values {}} } {
10
11 # If the value of the variable named in var_name is not valid, print an
12 # error message and exit the program with a non-zero return code.
13
14 # Description of arguments:
15 # var_name The name of the variable whose value is to
16 # be validated.
17 # invalid_values A list of invalid values. If the variable
18 # value is equal to any value in the
19 # invalid_values list, it is deemed to be
20 # invalid. Note that if you specify
21 # anything for invalid_values (below), the
22 # valid_values list is not even processed.
23 # In other words, specify either
24 # invalid_values or valid_values but not
25 # both. If no value is specified for either
26 # invalid_values or valid_values,
27 # invalid_values will default to a list with
28 # one blank entry. This is useful if you
29 # simply want to ensure that your variable
30 # is non blank.
31 # valid_values A list of invalid values. The variable
32 # value must be equal to one of the values
33 # in this list to be considered valid.
34
35 # Call get_stack_var_level to relieve the caller of the need for declaring
36 # the variable as global.
37 set stack_level [get_stack_var_level $var_name]
38 # Access the variable value.
39 upvar $stack_level $var_name var_value
40
41 set len_invalid_values [llength $invalid_values]
42 set len_valid_values [llength $valid_values]
43
44 if { $len_valid_values > 0 && $len_invalid_values > 0 } {
45 append error_message "Programmer error - You must provide either an"
46 append error_message " invalid_values list or a valid_values"
47 append error_message " list but NOT both.\n"
48 append error_message [sprint_list invalid_values "" "" 1]
49 append error_message [sprint_list valid_values "" "" 1]
50 print_error_report $error_message
51 exit 1
52 }
53
54 if { $len_valid_values > 0 } {
55 # Processing the valid_values list.
56 if { [lsearch -exact $valid_values "${var_value}"] != -1 } { return }
57 append error_message "The following variable has an invalid value:\n"
58 append error_message [sprint_varx $var_name $var_value "" "" 1]
59 append error_message "\nIt must be one of the following values:\n"
60 append error_message [sprint_list valid_values "" "" 1]
61 print_error_report $error_message
62 exit 1
63 }
64
65 if { $len_invalid_values == 0 } {
66 # Assign default value.
67 set invalid_values [list ""]
68 }
69
70 # Assertion: We have an invalid_values list. Processing it now.
71 if { [lsearch -exact $invalid_values "${var_value}"] == -1 } { return }
72
73 if { [lsearch -exact $valid_values "${var_value}"] != -1 } { return }
74 append error_message "The following variable has an invalid value:\n"
75 append error_message [sprint_varx $var_name $var_value "" "" 1]
76 append error_message "\nIt must NOT be one of the following values:\n"
77 append error_message [sprint_list invalid_values "" "" 1]
78 print_error_report $error_message
79 exit 1
80
81}
82
83
84proc valid_integer { var_name } {
85
86 # If the value of the variable named in var_name is not a valid integer,
87 # print an error message and exit the program with a non-zero return code.
88
89 # Description of arguments:
90 # var_name The name of the variable whose value is to
91 # be validated.
92
93 # Call get_stack_var_level to relieve the caller of the need for declaring
94 # the variable as global.
95 set stack_level [get_stack_var_level $var_name]
96 # Access the variable value.
97 upvar $stack_level $var_name var_value
98
99 if { [catch {format "0x%08x" "$var_value"} result] } {
100 append error_message "Invalid integer value:\n"
101 append error_message [sprint_varx $var_name $var_value]
102 print_error_report $error_message
103 exit 1
104 }
105
106}
107
108
109proc valid_dir_path { var_name { add_slash 1 } } {
110
111 # If the value of the variable named in var_name is not a valid directory
112 # path, print an error message and exit the program with a non-zero return
113 # code.
114
115 # Description of arguments:
116 # var_name The name of the variable whose value is to
117 # be validated.
118 # add_slash If set to 1, this procedure will add a
119 # trailing slash to the directory path value.
120
121 # Call get_stack_var_level to relieve the caller of the need for declaring
122 # the variable as global.
123 set stack_level [get_stack_var_level $var_name]
124 # Access the variable value.
125 upvar $stack_level $var_name var_value
126
127 expand_shell_string var_value
128
129 if { ![file isdirectory $var_value] } {
130 append error_message "The following directory does not exist:\n"
131 append error_message [sprint_varx $var_name $var_value "" "" 1]
132 print_error_report $error_message
133 exit 1
134 }
135
136 if { $add_slash } { add_trailing_string var_value / }
137
138}
139
140
141proc valid_file_path { var_name } {
142
143 # If the value of the variable named in var_name is not a valid file path,
144 # print an error message and exit the program with a non-zero return code.
145
146 # Description of arguments:
147 # var_name The name of the variable whose value is to
148 # be validated.
149
150 # Call get_stack_var_level to relieve the caller of the need for declaring
151 # the variable as global.
152 set stack_level [get_stack_var_level $var_name]
153 # Access the variable value.
154 upvar $stack_level $var_name var_value
155
156 expand_shell_string var_value
157
158 if { ![file isfile $var_value] } {
159 append error_message "The following file does not exist:\n"
160 append error_message [sprint_varx $var_name $var_value "" "" 1]
161 print_error_report $error_message
162 exit 1
163 }
164
165}