Line data Source code
1 : % Copyright (C) 2012-2021,2022 John E. Davis
2 : %
3 : % This file is part of the S-Lang Library and may be distributed under the
4 : % terms of the GNU General Public License. See the file COPYING for
5 : % more information.
6 : %---------------------------------------------------------------------------
7 : % Command-line option parsing.
8 : %
9 : % Examples:
10 : % (a,b,c values)
11 : % -i -ja3 -b 4 ==> -i -j -a 3 -b 4
12 : % -q 3 -sli --foo=3
13 : %
14 1 : private variable CMDOPT_REQ_VALUE = 0x1; % value required
15 1 : private variable CMDOPT_OPT_VALUE = 0x2; % value optional
16 1 : private variable CMDOPT_INC_VALUE = 0x4; % increment value by 1
17 1 : private variable CMDOPT_APPEND_VALUE = 0x8; % append to list
18 1 : private variable CMDOPT_BOR_VALUE = 0x10; % bitwise-or
19 1 : private variable CMDOPT_BAND_VALUE = 0x20; % bitwise-and
20 :
21 1 : private variable CmdOpt_Type = struct
22 : {
23 : names, flags, convert_method, valuep, bor_value, band_value, default_value, callback_args
24 : };
25 :
26 : private define usage_error (opts, name, str)
27 : {
28 1 : variable msg = sprintf ("Option %s: %s", name, str);
29 1 : if (opts.usage_error != NULL)
30 0 : (@opts.usage_error) (msg);
31 1 : throw UsageError, msg;
32 : }
33 :
34 : private define convert_to_string (opts, opt, name, value)
35 : {
36 2 : return value;
37 : }
38 :
39 : private define convert_to_int (opts, opt, name, value)
40 : {
41 : try
42 : {
43 10 : if (1 != __is_datatype_numeric (_slang_guess_type (value)))
44 0 : throw SyntaxError;
45 :
46 10 : return integer (value);
47 : }
48 0 : catch SyntaxError: usage_error (opts, name, "error parsing '$value' as an integer"$);
49 : }
50 :
51 : private define convert_to_double (opts, opt, name, value)
52 : {
53 : try
54 : {
55 4 : if (0 == __is_datatype_numeric (_slang_guess_type (value)))
56 0 : throw SyntaxError;
57 :
58 4 : return atof (value);
59 : }
60 0 : catch SyntaxError: usage_error (opts, name, "error parsing value '$value' as a number"$);
61 : }
62 :
63 : define cmdopt_add ()
64 : {
65 : variable opts, name, valuep;
66 13 : variable s = @CmdOpt_Type;
67 13 : s.callback_args = __pop_args (_NARGS-3);
68 13 : (opts, name, valuep) = ();
69 :
70 13 : s.flags = 0;
71 14 : if (qualifier_exists ("append")) s.flags |= CMDOPT_APPEND_VALUE;
72 15 : if (qualifier_exists ("inc")) s.flags |= CMDOPT_INC_VALUE;
73 :
74 13 : variable type = qualifier ("type");
75 13 : switch (type)
76 : {
77 13 : case "string" or case "str":
78 2 : s.convert_method = &convert_to_string;
79 : }
80 : {
81 11 : case "int":
82 4 : s.convert_method = &convert_to_int;
83 : }
84 : {
85 7 : case "float" or case "double":
86 1 : s.convert_method = &convert_to_double;
87 : }
88 : {
89 6 : case NULL:
90 6 : s.convert_method = &convert_to_string;
91 : }
92 : {
93 0 : throw InvalidParmError, sprintf ("type=%s is not supported", type);
94 : }
95 :
96 13 : variable default_value = 1;
97 13 : if (qualifier_exists ("optional"))
98 : {
99 4 : if (type == NULL)
100 0 : throw InvalidParmError, sprintf ("option %s requires the 'type' qualifier", name);
101 :
102 4 : s.flags |= CMDOPT_OPT_VALUE;
103 4 : default_value = qualifier ("optional");
104 : }
105 9 : else if (type != NULL)
106 3 : s.flags |= CMDOPT_REQ_VALUE;
107 :
108 13 : if (qualifier_exists ("bor"))
109 : {
110 3 : s.bor_value = qualifier ("bor");
111 3 : s.flags |= CMDOPT_BOR_VALUE;
112 : }
113 13 : if (qualifier_exists ("band"))
114 : {
115 1 : s.band_value = qualifier ("band");
116 1 : s.flags |= CMDOPT_BAND_VALUE;
117 : }
118 :
119 13 : s.names = strchop (name, '|', 0);
120 13 : s.valuep = valuep;
121 13 : s.default_value = qualifier ("default", default_value);
122 :
123 13 : list_append (opts.opt_list, s);
124 : }
125 :
126 : private define set_opt_value (opt, value)
127 : {
128 : variable opt_value;
129 30 : ifnot (opt.flags & CMDOPT_APPEND_VALUE)
130 : {
131 27 : @opt.valuep = value;
132 : return;
133 : }
134 3 : if ((0 == __is_initialized (opt.valuep))
135 : || (@opt.valuep == NULL))
136 1 : @opt.valuep = {};
137 :
138 3 : if (typeof (@opt.valuep) != List_Type)
139 : {
140 0 : @opt.valuep = {@opt.valuep};
141 : }
142 3 : list_append (@opt.valuep, value);
143 : }
144 :
145 : private define process_value (opts, opt, name, value)
146 : {
147 14 : set_opt_value (opt, (@opt.convert_method) (opts, opt, name, value));
148 : }
149 :
150 : private define process_option (opts, opt, name, value)
151 : {
152 55 : if (opt.flags & CMDOPT_REQ_VALUE)
153 : {
154 12 : if (value == NULL)
155 0 : usage_error (opts, name, "value required");
156 :
157 12 : if (__is_callable (opt.valuep))
158 : {
159 1 : value = (@opt.convert_method) (opts, opt, name, value);
160 1 : (@opt.valuep)(value, __push_args(opt.callback_args));
161 : return;
162 : }
163 11 : process_value (opts, opt, name, value);
164 : return;
165 : }
166 :
167 43 : if (opt.flags & CMDOPT_OPT_VALUE)
168 : {
169 14 : if (__is_callable (opt.valuep))
170 : {
171 2 : if (value != NULL)
172 1 : value = (@opt.convert_method) (opts, opt, name, value);
173 : else
174 1 : value = opt.default_value;
175 :
176 2 : (@opt.valuep)(value, __push_args(opt.callback_args));
177 : return;
178 : }
179 12 : if (value != NULL)
180 : {
181 3 : process_value (opts, opt, name, value);
182 : return;
183 : }
184 9 : set_opt_value (opt, opt.default_value);
185 : return;
186 : }
187 :
188 29 : if (value != NULL)
189 0 : usage_error (opts, name, "value not supported");
190 :
191 29 : if (__is_callable (opt.valuep))
192 : {
193 1 : (@opt.valuep)(__push_args(opt.callback_args));
194 : return;
195 : }
196 :
197 28 : if (opt.flags & CMDOPT_INC_VALUE)
198 : {
199 18 : @opt.valuep += 1;
200 : return;
201 : }
202 :
203 10 : ifnot (opt.flags & (CMDOPT_BAND_VALUE|CMDOPT_BOR_VALUE))
204 : {
205 7 : set_opt_value (opt, opt.default_value);
206 : return;
207 : }
208 :
209 3 : if (opt.flags & CMDOPT_BAND_VALUE)
210 1 : @opt.valuep &= opt.band_value;
211 :
212 3 : if (opt.flags & CMDOPT_BOR_VALUE)
213 3 : @opt.valuep |= opt.bor_value;
214 :
215 : }
216 :
217 : private define find_opt (opts, name)
218 : {
219 56 : foreach (opts.opt_list)
220 : {
221 193 : variable opt = ();
222 193 : if (any (opt.names == name))
223 55 : return opt;
224 : }
225 1 : usage_error (opts, name, "not supported/unknown");
226 : }
227 :
228 : private define find_short_opt (opts, name)
229 : {
230 43 : return find_opt (opts, name);
231 : }
232 :
233 : private define find_long_opt (opts, name)
234 : {
235 13 : return find_opt (opts, name);
236 : }
237 :
238 : private define parse_arg (arg)
239 : {
240 13 : variable pos = is_substr (arg, "=");
241 13 : if (pos == 0)
242 8 : return (arg, NULL);
243 5 : variable value = substr (arg, pos+1, -1);
244 5 : arg = substr (arg, 1, pos-1);
245 :
246 5 : return arg, value;
247 : }
248 :
249 : define cmdopt_process (opts, argv, istart)
250 : {
251 12 : variable iend = length (argv);
252 12 : variable i = istart;
253 52 : while (i < iend)
254 : {
255 46 : variable arg = argv[i];
256 : variable opt, value;
257 :
258 46 : if (arg == "--")
259 1 : return i+1;
260 :
261 45 : if (arg[0] != '-')
262 3 : return i;
263 :
264 42 : if (arg == "-")
265 1 : return i;
266 :
267 41 : if (arg[1] == '-')
268 : {
269 : % --long-opt
270 13 : (arg, value) = parse_arg (arg);
271 13 : arg = substr(arg, 3, -1);
272 13 : opt = find_long_opt (opts, arg);
273 : }
274 : else
275 : {
276 : % short arg: -a -ab -abc value
277 : % -abc value is equiv to -ab -c value
278 28 : arg = substr (arg, 2, -1);
279 28 : value = NULL;
280 56 : variable j = 0, n = strlen(arg);
281 64 : while (j < n)
282 : {
283 43 : j++;
284 43 : variable name = substr (arg, j, 1);
285 43 : opt = find_short_opt (opts, name);
286 43 : if (opt.flags & CMDOPT_REQ_VALUE)
287 : {
288 6 : if (j < n)
289 5 : value = substr (arg, j+1, n);
290 6 : arg = name;
291 6 : break;
292 : }
293 : % -aVALUE
294 37 : if ((j < n) && (opt.flags & CMDOPT_OPT_VALUE))
295 : {
296 1 : value = substr (arg, j+1, n);
297 1 : arg = name;
298 1 : break;
299 : }
300 36 : process_option (opts, opt, name, NULL);
301 : }
302 : then
303 : {
304 21 : i++;
305 21 : continue;
306 : }
307 : }
308 :
309 19 : if (opt == NULL)
310 0 : return -1;
311 :
312 19 : if ((opt.flags & CMDOPT_REQ_VALUE) && (value == NULL))
313 : {
314 6 : i++;
315 6 : if (i == iend)
316 0 : usage_error (opts, arg, "value expected");
317 6 : value = argv[i];
318 : }
319 :
320 19 : process_option (opts, opt, arg, value);
321 19 : i++;
322 : }
323 :
324 6 : return i;
325 : }
326 :
327 : define cmdopt_new ()
328 : {
329 3 : variable error_routine = NULL;
330 3 : if (_NARGS == 1)
331 3 : error_routine = ();
332 :
333 3 : variable s = struct
334 : {
335 3 : usage_error = error_routine,
336 3 : opt_list = {},
337 3 : add = &cmdopt_add,
338 3 : process = &cmdopt_process
339 : };
340 3 : return s;
341 : }
|
