Mercurial > repos > vandelj > giant_limma_analysis

comparison src/getopt.R @ 0:f274c8d45613 draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
"planemo upload for repository https://github.com/juliechevalier/GIANT/tree/master commit cb276a594444c8f32e9819fefde3a21f121d35df"
author vandelj
date Fri, 26 Jun 2020 09:43:41 -0400
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:f274c8d45613
1 # Copyright (c) 2008-2010 Allen Day
2 # Copyright (c) 2011-2013 Trevor L. Davis <trevor.l.davis@stanford.edu>
3 #
4 # Modified by J.Vandel 2017 to consider situation of multiple identical flag
5 # and concatenate as a vector the set of parameter for the same flag instead of
6 # keeping only the last value as done by the previous version.
7 #
8 # This file is free software: you may copy, redistribute and/or modify it
9 # under the terms of the GNU General Public License as published by the
10 # Free Software Foundation, either version 2 of the License, or (at your
11 # option) any later version.
12 #
13 # This file is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 # General Public License for more details.
17 #
18 # You should have received a copy of the GNU General Public License
19 # along with this program. If not, see <http://www.gnu.org/licenses/>.
20
21 #' C-like getopt behavior
22 #'
23 #' getopt is primarily intended to be used with ``\link{Rscript}''. It
24 #' facilitates writing ``\#!'' shebang scripts that accept short and long
25 #' flags/options. It can also be used from ``R'' directly, but is probably less
26 #' useful in this context.
27 #'
28 #' getopt() returns a \link{list} data structure containing \link{names} of the
29 #' flags that were present in the \link{character} \link{vector} passed in under
30 #' the \emph{opt} argument. Each value of the \link{list} is coerced to the
31 #' data type specified according to the value of the \emph{spec} argument. See
32 #' below for details.
33 #'
34 #' Notes on naming convention:
35 #'
36 #' 1. An \emph{option} is one of the shell-split input strings.
37 #'
38 #' 2. A \emph{flag} is a type of \emph{option}. a \emph{flag} can be defined as
39 #' having no \emph{argument} (defined below), a required \emph{argument}, or an
40 #' optional \emph{argument}.
41 #'
42 #' 3. An \emph{argument} is a type of \emph{option}, and is the value associated
43 #' with a flag.
44 #'
45 #' 4. A \emph{long flag} is a type of \emph{flag}, and begins with the string
46 #' ``--''. If the \emph{long flag} has an associated \emph{argument}, it may be
47 #' delimited from the \emph{long flag} by either a trailing \emph{=}, or may be
48 #' the subsequent \emph{option}.
49 #'
50 #' 5. A \emph{short flag} is a type of \emph{flag}, and begins with the string
51 #' ``-''. If a \emph{short flag} has an associated \emph{argument}, it is the
52 #' subsequent \emph{option}. \emph{short flags} may be bundled together,
53 #' sharing a single leading ``-'', but only the final \emph{short flag} is able
54 #' to have a corresponding \emph{argument}.
55 #'
56 #' Many users wonder whether they should use the getopt package, optparse package,
57 #' or argparse package.
58 #' Here is some of the major differences:
59 #'
60 #' Features available in \code{getopt} unavailable in \code{optparse}
61 #'
62 #' 1. As well as allowing one to specify options that take either
63 #' no argument or a required argument like \code{optparse},
64 #' \code{getopt} also allows one to specify option with an optional argument.
65 #'
66 #' Some features implemented in \code{optparse} package unavailable in \code{getopt}
67 #'
68 #' 1. Limited support for capturing positional arguments after the optional arguments
69 #' when \code{positional_arguments} set to TRUE in \code{parse_args}
70 #'
71 #' 2. Automatic generation of an help option and printing of help text when encounters an "-h"
72 #'
73 #' 3. Option to specify default arguments for options as well the
74 #' variable name to store option values
75 #'
76 #' There is also new package \code{argparse} introduced in 2012 which contains
77 #' all the features of both getopt and optparse but which has a dependency on
78 #' Python 2.7 or 3.2+ and has not been used in production since 2008 or 2009
79 #' like the getopt and optparse packages.
80 #'
81 #' Some Features unlikely to be implemented in \code{getopt}:
82 #'
83 #' 1. Support for multiple, identical flags, e.g. for "-m 3 -v 5 -v", the
84 #' trailing "-v" overrides the preceding "-v 5", result is v=TRUE (or equivalent
85 #' typecast).
86 #'
87 #' 2. Support for multi-valued flags, e.g. "--libpath=/usr/local/lib
88 #' --libpath=/tmp/foo".
89 #'
90 #' 3. Support for lists, e.g. "--define os=linux --define os=redhat" would
91 #' set result$os$linux=TRUE and result$os$redhat=TRUE.
92 #'
93 #' 4. Support for incremental, argument-less flags, e.g. "/path/to/script
94 #' -vvv" should set v=3.
95 #'
96 #' 5. Support partial-but-unique string match on options, e.g. "--verb" and
97 #' "--verbose" both match long flag "--verbose".
98 #'
99 #' 6. No support for mixing in positional arguments or extra arguments that
100 #' don't match any options. For example, you can't do "my.R --arg1 1 foo bar
101 #' baz" and recover "foo", "bar", "baz" as a list. Likewise for "my.R foo
102 #' --arg1 1 bar baz".
103 #'
104 #' @aliases getopt getopt-package
105 #' @param spec The getopt specification, or spec of what options are considered
106 #' valid. The specification must be either a 4-5 column \link{matrix}, or a
107 #' \link{character} \link{vector} coercible into a 4 column \link{matrix} using
108 #' \link{matrix}(x,ncol=4,byrow=TRUE) command. The \link{matrix}/\link{vector}
109 #' contains:
110 #'
111 #' Column 1: the \emph{long flag} name. A multi-\link{character} string.
112 #'
113 #' Column 2: \emph{short flag} alias of Column 1. A single-\link{character}
114 #' string.
115 #'
116 #' Column 3: \emph{Argument} mask of the \emph{flag}. An \link{integer}.
117 #' Possible values: 0=no argument, 1=required argument, 2=optional argument.
118 #'
119 #' Column 4: Data type to which the \emph{flag}'s argument shall be cast using
120 #' \link{storage.mode}. A multi-\link{character} string. This only considered
121 #' for same-row Column 3 values of 1,2. Possible values: \link{logical},
122 #' \link{integer}, \link{double}, \link{complex}, \link{character}.
123 #' If \link{numeric} is encountered then it will be converted to double.
124 #'
125 #' Column 5 (optional): A brief description of the purpose of the option.
126 #'
127 #' The terms \emph{option}, \emph{flag}, \emph{long flag}, \emph{short flag},
128 #' and \emph{argument} have very specific meanings in the context of this
129 #' document. Read the ``Description'' section for definitions.
130 #' @param opt This defaults to the return value of \link{commandArgs}(TRUE).
131 #'
132 #' If R was invoked directly via the ``R'' command, this corresponds to all
133 #' arguments passed to R after the ``--args'' flag.
134 #'
135 #' If R was invoked via the ``\link{Rscript}'' command, this corresponds to all
136 #' arguments after the name of the R script file.
137 #'
138 #' Read about \link{commandArgs} and \link{Rscript} to learn more.
139 #' @param command The string to use in the usage message as the name of the
140 #' script. See argument \emph{usage}.
141 #' @param usage If TRUE, argument \emph{opt} will be ignored and a usage
142 #' statement (character string) will be generated and returned from \emph{spec}.
143 #' @param debug This is used internally to debug the getopt() function itself.
144 #' @author Allen Day
145 #' @seealso \code{\link{getopt}}
146 #' @keywords data
147 #' @export
148 #' @examples
149 #'
150 #' #!/path/to/Rscript
151 #' library('getopt');
152 #' #get options, using the spec as defined by the enclosed list.
153 #' #we read the options from the default: commandArgs(TRUE).
154 #' spec = matrix(c(
155 #' 'verbose', 'v', 2, "integer",
156 #' 'help' , 'h', 0, "logical",
157 #' 'count' , 'c', 1, "integer",
158 #' 'mean' , 'm', 1, "double",
159 #' 'sd' , 's', 1, "double"
160 #' ), byrow=TRUE, ncol=4);
161 #' opt = getopt(spec);
162 #'
163 #' # if help was asked for print a friendly message
164 #' # and exit with a non-zero error code
165 #' if ( !is.null(opt$help) ) {
166 #' cat(getopt(spec, usage=TRUE));
167 #' q(status=1);
168 #' }
169 #'
170 #' #set some reasonable defaults for the options that are needed,
171 #' #but were not specified.
172 #' if ( is.null(opt$mean ) ) { opt$mean = 0 }
173 #' if ( is.null(opt$sd ) ) { opt$sd = 1 }
174 #' if ( is.null(opt$count ) ) { opt$count = 10 }
175 #' if ( is.null(opt$verbose ) ) { opt$verbose = FALSE }
176 #'
177 #' #print some progress messages to stderr, if requested.
178 #' if ( opt$verbose ) { write("writing...",stderr()); }
179 #'
180 #' #do some operation based on user input.
181 #' cat(paste(rnorm(opt$count,mean=opt$mean,sd=opt$sd),collapse="\n"));
182 #' cat("\n");
183 #'
184 #' #signal success and exit.
185 #' #q(status=0);
186 getopt = function (spec=NULL,opt=commandArgs(TRUE),command=get_Rscript_filename(),usage=FALSE,debug=FALSE) {
187
188 # littler compatibility - map argv vector to opt
189 if (exists("argv", where = .GlobalEnv, inherits = FALSE)) {
190 opt = get("argv", envir = .GlobalEnv);
191 }
192
193 ncol=4;
194 maxcol=6;
195 col.long.name = 1;
196 col.short.name = 2;
197 col.has.argument = 3;
198 col.mode = 4;
199 col.description = 5;
200
201 flag.no.argument = 0;
202 flag.required.argument = 1;
203 flag.optional.argument = 2;
204
205 result = list();
206 result$ARGS = vector(mode="character");
207
208 #no spec. fail.
209 if ( is.null(spec) ) {
210 stop('argument "spec" must be non-null.');
211
212 #spec is not a matrix. attempt to coerce, if possible. issue a warning.
213 } else if ( !is.matrix(spec) ) {
214 if ( length(spec)/4 == as.integer(length(spec)/4) ) {
215 warning('argument "spec" was coerced to a 4-column (row-major) matrix. use a matrix to prevent the coercion');
216 spec = matrix( spec, ncol=ncol, byrow=TRUE );
217 } else {
218 stop('argument "spec" must be a matrix, or a character vector with length divisible by 4, rtfm.');
219 }
220
221 #spec is a matrix, but it has too few columns.
222 } else if ( dim(spec)[2] < ncol ) {
223 stop(paste('"spec" should have at least ",ncol," columns.',sep=''));
224
225 #spec is a matrix, but it has too many columns.
226 } else if ( dim(spec)[2] > maxcol ) {
227 stop(paste('"spec" should have no more than ",maxcol," columns.',sep=''));
228
229 #spec is a matrix, and it has some optional columns.
230 } else if ( dim(spec)[2] != ncol ) {
231 ncol = dim(spec)[2];
232 }
233
234 #sanity check. make sure long names are unique, and short names are unique.
235 if ( length(unique(spec[,col.long.name])) != length(spec[,col.long.name]) ) {
236 stop(paste('redundant long names for flags (column ',col.long.name,').',sep=''));
237 }
238 if ( length(na.omit(unique(spec[,col.short.name]))) != length(na.omit(spec[,col.short.name])) ) {
239 stop(paste('redundant short names for flags (column ',col.short.name,').',sep=''));
240 }
241 # convert numeric type to double type
242 spec[,4] <- gsub("numeric", "double", spec[,4])
243
244 # if usage=TRUE, don't process opt, but generate a usage string from the data in spec
245 if ( usage ) {
246 ret = '';
247 ret = paste(ret,"Usage: ",command,sep='');
248 for ( j in 1:(dim(spec))[1] ) {
249 ret = paste(ret,' [-[-',spec[j,col.long.name],'|',spec[j,col.short.name],']',sep='');
250 if (spec[j,col.has.argument] == flag.no.argument) {
251 ret = paste(ret,']',sep='');
252 } else if (spec[j,col.has.argument] == flag.required.argument) {
253 ret = paste(ret,' <',spec[j,col.mode],'>]',sep='');
254 } else if (spec[j,col.has.argument] == flag.optional.argument) {
255 ret = paste(ret,' [<',spec[j,col.mode],'>]]',sep='');
256 }
257 }
258 # include usage strings
259 if ( ncol >= 5 ) {
260 max.long = max(apply(cbind(spec[,col.long.name]),1,function(x)length(strsplit(x,'')[[1]])));
261 ret = paste(ret,"\n",sep='');
262 for (j in 1:(dim(spec))[1] ) {
263 ret = paste(ret,sprintf(paste(" -%s|--%-",max.long,"s %s\n",sep=''),
264 spec[j,col.short.name],spec[j,col.long.name],spec[j,col.description]
265 ),sep='');
266 }
267 }
268 else {
269 ret = paste(ret,"\n",sep='');
270 }
271 return(ret);
272 }
273
274 #XXX check spec validity here. e.g. column three should be convertible to integer
275
276 i = 1;
277
278 while ( i <= length(opt) ) {
279 if ( debug ) print(paste("processing",opt[i]));
280
281 current.flag = 0; #XXX use NA
282 optstring = opt[i];
283
284
285 #long flag
286 if ( substr(optstring, 1, 2) == '--' ) {
287 if ( debug ) print(paste(" long option:",opt[i]));
288
289 optstring = substring(optstring,3);
290
291 this.flag = NA;
292 this.argument = NA;
293 kv = strsplit(optstring, '=')[[1]];
294 if ( !is.na(kv[2]) ) {
295 this.flag = kv[1];
296 this.argument = paste(kv[-1], collapse="=");
297 } else {
298 this.flag = optstring;
299 }
300
301 rowmatch = grep( this.flag, spec[,col.long.name],fixed=TRUE );
302
303 #long flag is invalid, matches no options
304 if ( length(rowmatch) == 0 ) {
305 stop(paste('long flag "', this.flag, '" is invalid', sep=''));
306
307 #long flag is ambiguous, matches too many options
308 } else if ( length(rowmatch) > 1 ) {
309 # check if there is an exact match and use that
310 rowmatch = which(this.flag == spec[,col.long.name])
311 if(length(rowmatch) == 0) {
312 stop(paste('long flag "', this.flag, '" is ambiguous', sep=''));
313 }
314 }
315
316 #if we have an argument
317 if ( !is.na(this.argument) ) {
318 #if we can't accept the argument, bail out
319 if ( spec[rowmatch, col.has.argument] == flag.no.argument ) {
320 stop(paste('long flag "', this.flag, '" accepts no arguments', sep=''));
321
322 #otherwise assign the argument to the flag
323 } else {
324 storage.mode(this.argument) = spec[rowmatch, col.mode];
325 #don't need here to remove the last value of the vector as argument is in the same string as
326 #the flag name "--flag=argument" so no spurious TRUE was added
327 result[[spec[rowmatch, col.long.name]]] = c(result[[spec[rowmatch, col.long.name]]],this.argument);
328 i = i + 1;
329 next;
330 }
331
332 #otherwise, we don't have an argument
333 } else {
334 #if we require an argument, bail out
335 ###if ( spec[rowmatch, col.has.argument] == flag.required.argument ) {
336 ### stop(paste('long flag "', this.flag, '" requires an argument', sep=''));
337
338 #long flag has no attached argument. set flag as present. set current.flag so we can peek ahead later and consume the argument if it's there
339 ###} else {
340 result[[spec[rowmatch, col.long.name]]] = c(result[[spec[rowmatch, col.long.name]]],TRUE);
341 current.flag = rowmatch;
342 ###}
343 }
344
345 #short flag(s)
346 } else if ( substr(optstring, 1, 1) == '-' ) {
347 if ( debug ) print(paste(" short option:",opt[i]));
348
349 these.flags = strsplit(optstring,'')[[1]];
350
351 done = FALSE;
352 for ( j in 2:length(these.flags) ) {
353 this.flag = these.flags[j];
354 rowmatch = grep( this.flag, spec[,col.short.name],fixed=TRUE );
355
356 #short flag is invalid, matches no options
357 if ( length(rowmatch) == 0 ) {
358 stop(paste('short flag "', this.flag, '" is invalid', sep=''));
359
360 #short flag is ambiguous, matches too many options
361 } else if ( length(rowmatch) > 1 ) {
362 stop(paste('short flag "', this.flag, '" is ambiguous', sep=''));
363
364 #short flag has an argument, but is not the last in a compound flag string
365 } else if ( j < length(these.flags) & spec[rowmatch,col.has.argument] == flag.required.argument ) {
366 stop(paste('short flag "', this.flag, '" requires an argument, but has none', sep=''));
367
368 #short flag has no argument, flag it as present
369 } else if ( spec[rowmatch,col.has.argument] == flag.no.argument ) {
370 result[[spec[rowmatch, col.long.name]]] = c(result[[spec[rowmatch, col.long.name]]],TRUE);
371 done = TRUE;
372
373 #can't definitively process this flag yet, need to see if next option is an argument or not
374 } else {
375 result[[spec[rowmatch, col.long.name]]] = c(result[[spec[rowmatch, col.long.name]]],TRUE);
376 current.flag = rowmatch;
377 done = FALSE;
378 }
379 }
380 if ( done ) {
381 i = i + 1;
382 next;
383 }
384 }
385
386 #invalid opt
387 if ( current.flag == 0 ) {
388 stop(paste('"', optstring, '" is not a valid option, or does not support an argument', sep=''));
389 #TBD support for positional args
390 #if ( debug ) print(paste('"', optstring, '" not a valid option. It is appended to getopt(...)$ARGS', sep=''));
391 #result$ARGS = append(result$ARGS, optstring);
392
393 # some dangling flag, handle it
394 } else if ( current.flag > 0 ) {
395 if ( debug ) print(' dangling flag');
396 if ( length(opt) > i ) {
397 peek.optstring = opt[i + 1];
398 if ( debug ) print(paste(' peeking ahead at: "',peek.optstring,'"',sep=''));
399
400 #got an argument. attach it, increment the index, and move on to the next option. we don't allow arguments beginning with '-' UNLESS
401 #specfile indicates the value is an "integer" or "double", in which case we allow a leading dash (and verify trailing digits/decimals).
402 if ( substr(peek.optstring, 1, 1) != '-' |
403 #match negative double
404 ( substr(peek.optstring, 1, 1) == '-'
405 & regexpr('^-[0123456789]*\\.?[0123456789]+$',peek.optstring) > 0
406 & spec[current.flag, col.mode]== 'double'
407 ) |
408 #match negative integer
409 ( substr(peek.optstring, 1, 1) == '-'
410 & regexpr('^-[0123456789]+$',peek.optstring) > 0
411 & spec[current.flag, col.mode]== 'integer'
412 )
413 ) {
414 if ( debug ) print(paste(' consuming argument *',peek.optstring,'*',sep=''));
415 storage.mode(peek.optstring) = spec[current.flag, col.mode];
416 #remove the last argument put in result for current.flag that should be a TRUE and concatenate argument with previous ones
417 result[[spec[current.flag, col.long.name]]] = c(result[[spec[current.flag, col.long.name]]][-length(result[[spec[current.flag, col.long.name]]])],peek.optstring);
418 i = i + 1;
419
420 #a lone dash
421 } else if ( substr(peek.optstring, 1, 1) == '-' & length(strsplit(peek.optstring,'')[[1]]) == 1 ) {
422 if ( debug ) print(' consuming "lone dash" argument');
423 storage.mode(peek.optstring) = spec[current.flag, col.mode];
424 #remove the last argument put in result for current.flag that should be a TRUE and concatenate argument with previous ones
425 result[[spec[current.flag, col.long.name]]] =c(result[[spec[current.flag, col.long.name]]][-length(result[[spec[current.flag, col.long.name]]])],peek.optstring);
426 i = i + 1;
427
428 #no argument
429 } else {
430 if ( debug ) print(' no argument!');
431
432 #if we require an argument, bail out
433 if ( spec[current.flag, col.has.argument] == flag.required.argument ) {
434 stop(paste('flag "', this.flag, '" requires an argument', sep=''));
435
436 #otherwise set flag as present.
437 } else if (
438 spec[current.flag, col.has.argument] == flag.optional.argument |
439 spec[current.flag, col.has.argument] == flag.no.argument
440 ) {
441 x = TRUE;
442 storage.mode(x) = spec[current.flag, col.mode];
443 result[[spec[current.flag, col.long.name]]] = c(result[[spec[current.flag, col.long.name]]],x);
444 } else {
445 stop(paste("This should never happen.",
446 "Is your spec argument correct? Maybe you forgot to set",
447 "ncol=4, byrow=TRUE in your matrix call?"));
448 }
449 }
450 #trailing flag without required argument
451 } else if ( spec[current.flag, col.has.argument] == flag.required.argument ) {
452 stop(paste('flag "', this.flag, '" requires an argument', sep=''));
453
454 #trailing flag without optional argument
455 } else if ( spec[current.flag, col.has.argument] == flag.optional.argument ) {
456 x = TRUE;
457 storage.mode(x) = spec[current.flag, col.mode];
458 result[[spec[current.flag, col.long.name]]] = c(result[[spec[current.flag, col.long.name]]],x);
459
460 #trailing flag without argument
461 } else if ( spec[current.flag, col.has.argument] == flag.no.argument ) {
462 x = TRUE;
463 storage.mode(x) = spec[current.flag, col.mode];
464 result[[spec[current.flag, col.long.name]]] = c(result[[spec[current.flag, col.long.name]]],x);
465 } else {
466 stop("this should never happen (2). please inform the author.");
467 }
468 #no dangling flag, nothing to do.
469 } else {
470 }
471
472 i = i+1;
473 }
474 return(result);
475 }
476
477
478
479 #########################
480 #set a modified version using only long named parameters
481
482 getoptLong = function (spec=NULL,opt=commandArgs(TRUE),command=get_Rscript_filename(),usage=FALSE,debug=FALSE) {
483
484 # littler compatibility - map argv vector to opt
485 if (exists("argv", where = .GlobalEnv, inherits = FALSE)) {
486 opt = get("argv", envir = .GlobalEnv);
487 }
488
489 ncol=4;
490 maxcol=6;
491 col.long.name = 1;
492 #col.short.name = 2;
493 col.has.argument = 3;
494 col.mode = 4;
495 col.description = 5;
496
497 flag.no.argument = 0;
498 flag.required.argument = 1;
499 flag.optional.argument = 2;
500
501 result = list();
502 result$ARGS = vector(mode="character");
503
504 #no spec. fail.
505 if ( is.null(spec) ) {
506 stop('argument "spec" must be non-null.');
507
508 #spec is not a matrix. attempt to coerce, if possible. issue a warning.
509 } else if ( !is.matrix(spec) ) {
510 if ( length(spec)/4 == as.integer(length(spec)/4) ) {
511 warning('argument "spec" was coerced to a 4-column (row-major) matrix. use a matrix to prevent the coercion');
512 spec = matrix( spec, ncol=ncol, byrow=TRUE );
513 } else {
514 stop('argument "spec" must be a matrix, or a character vector with length divisible by 4, rtfm.');
515 }
516
517 #spec is a matrix, but it has too few columns.
518 } else if ( dim(spec)[2] < ncol ) {
519 stop(paste('"spec" should have at least ",ncol," columns.',sep=''));
520
521 #spec is a matrix, but it has too many columns.
522 } else if ( dim(spec)[2] > maxcol ) {
523 stop(paste('"spec" should have no more than ",maxcol," columns.',sep=''));
524
525 #spec is a matrix, and it has some optional columns.
526 } else if ( dim(spec)[2] != ncol ) {
527 ncol = dim(spec)[2];
528 }
529
530 #sanity check. make sure long names are unique, and short names are unique.
531 if ( length(unique(spec[,col.long.name])) != length(spec[,col.long.name]) ) {
532 stop(paste('redundant long names for flags (column ',col.long.name,').',sep=''));
533 }
534 # if ( length(na.omit(unique(spec[,col.short.name]))) != length(na.omit(spec[,col.short.name])) ) {
535 # stop(paste('redundant short names for flags (column ',col.short.name,').',sep=''));
536 # }
537 # convert numeric type to double type
538 spec[,4] <- gsub("numeric", "double", spec[,4])
539
540 # if usage=TRUE, don't process opt, but generate a usage string from the data in spec
541 if ( usage ) {
542 ret = '';
543 ret = paste(ret,"Usage: ",command,sep='');
544 for ( j in 1:(dim(spec))[1] ) {
545 ret = paste(ret,' [-[-',spec[j,col.long.name],']',sep='');
546 if (spec[j,col.has.argument] == flag.no.argument) {
547 ret = paste(ret,']',sep='');
548 } else if (spec[j,col.has.argument] == flag.required.argument) {
549 ret = paste(ret,' <',spec[j,col.mode],'>]',sep='');
550 } else if (spec[j,col.has.argument] == flag.optional.argument) {
551 ret = paste(ret,' [<',spec[j,col.mode],'>]]',sep='');
552 }
553 }
554 # include usage strings
555 if ( ncol >= 5 ) {
556 max.long = max(apply(cbind(spec[,col.long.name]),1,function(x)length(strsplit(x,'')[[1]])));
557 ret = paste(ret,"\n",sep='');
558 for (j in 1:(dim(spec))[1] ) {
559 ret = paste(ret,sprintf(paste("--%-",max.long,"s %s\n",sep='')
560 ,spec[j,col.long.name],spec[j,col.description]
561 ),sep='');
562 }
563 }
564 else {
565 ret = paste(ret,"\n",sep='');
566 }
567 return(ret);
568 }
569
570 #XXX check spec validity here. e.g. column three should be convertible to integer
571
572 i = 1;
573
574 while ( i <= length(opt) ) {
575 if ( debug ) print(paste("processing",opt[i]));
576
577 current.flag = 0; #XXX use NA
578 optstring = opt[i];
579
580
581 #long flag
582 if ( substr(optstring, 1, 2) == '--' ) {
583 if ( debug ) print(paste(" long option:",opt[i]));
584
585 optstring = substring(optstring,3);
586
587 this.flag = NA;
588 this.argument = NA;
589 kv = strsplit(optstring, '=')[[1]];
590 if ( !is.na(kv[2]) ) {
591 this.flag = kv[1];
592 this.argument = paste(kv[-1], collapse="=");
593 } else {
594 this.flag = optstring;
595 }
596
597 rowmatch = grep( this.flag, spec[,col.long.name],fixed=TRUE );
598
599 #long flag is invalid, matches no options
600 if ( length(rowmatch) == 0 ) {
601 stop(paste('long flag "', this.flag, '" is invalid', sep=''));
602
603 #long flag is ambiguous, matches too many options
604 } else if ( length(rowmatch) > 1 ) {
605 # check if there is an exact match and use that
606 rowmatch = which(this.flag == spec[,col.long.name])
607 if(length(rowmatch) == 0) {
608 stop(paste('long flag "', this.flag, '" is ambiguous', sep=''));
609 }
610 }
611
612 #if we have an argument
613 if ( !is.na(this.argument) ) {
614 #if we can't accept the argument, bail out
615 if ( spec[rowmatch, col.has.argument] == flag.no.argument ) {
616 stop(paste('long flag "', this.flag, '" accepts no arguments', sep=''));
617
618 #otherwise assign the argument to the flag
619 } else {
620 storage.mode(this.argument) = spec[rowmatch, col.mode];
621 #don't need here to remove the last value of the vector as argument is in the same string as
622 #the flag name "--flag=argument" so no spurious TRUE was added
623 result[[spec[rowmatch, col.long.name]]] = c(result[[spec[rowmatch, col.long.name]]],this.argument);
624 i = i + 1;
625 next;
626 }
627
628 #otherwise, we don't have an argument
629 } else {
630 #if we require an argument, bail out
631 ###if ( spec[rowmatch, col.has.argument] == flag.required.argument ) {
632 ### stop(paste('long flag "', this.flag, '" requires an argument', sep=''));
633
634 #long flag has no attached argument. set flag as present. set current.flag so we can peek ahead later and consume the argument if it's there
635 ###} else {
636 result[[spec[rowmatch, col.long.name]]] = c(result[[spec[rowmatch, col.long.name]]],TRUE);
637 current.flag = rowmatch;
638 ###}
639 }
640
641 #short flag(s)
642 }
643 #else if ( substr(optstring, 1, 1) == '-' ) {
644 # if ( debug ) print(paste(" short option:",opt[i]));
645 #
646 # these.flags = strsplit(optstring,'')[[1]];
647 #
648 # done = FALSE;
649 # for ( j in 2:length(these.flags) ) {
650 # this.flag = these.flags[j];
651 # rowmatch = grep( this.flag, spec[,col.short.name],fixed=TRUE );
652 #
653 # #short flag is invalid, matches no options
654 # if ( length(rowmatch) == 0 ) {
655 # stop(paste('short flag "', this.flag, '" is invalid', sep=''));
656 #
657 # #short flag is ambiguous, matches too many options
658 # } else if ( length(rowmatch) > 1 ) {
659 # stop(paste('short flag "', this.flag, '" is ambiguous', sep=''));
660 #
661 # #short flag has an argument, but is not the last in a compound flag string
662 # } else if ( j < length(these.flags) & spec[rowmatch,col.has.argument] == flag.required.argument ) {
663 # stop(paste('short flag "', this.flag, '" requires an argument, but has none', sep=''));
664 #
665 # #short flag has no argument, flag it as present
666 # } else if ( spec[rowmatch,col.has.argument] == flag.no.argument ) {
667 # result[[spec[rowmatch, col.long.name]]] = c(result[[spec[rowmatch, col.long.name]]],TRUE);
668 # done = TRUE;
669 #
670 # #can't definitively process this flag yet, need to see if next option is an argument or not
671 # } else {
672 # result[[spec[rowmatch, col.long.name]]] = c(result[[spec[rowmatch, col.long.name]]],TRUE);
673 # current.flag = rowmatch;
674 # done = FALSE;
675 # }
676 # }
677 # if ( done ) {
678 # i = i + 1;
679 # next;
680 # }
681 # }
682
683 #invalid opt
684 if ( current.flag == 0 ) {
685 stop(paste('"', optstring, '" is not a valid option, or does not support an argument', sep=''));
686 #TBD support for positional args
687 #if ( debug ) print(paste('"', optstring, '" not a valid option. It is appended to getopt(...)$ARGS', sep=''));
688 #result$ARGS = append(result$ARGS, optstring);
689
690 # some dangling flag, handle it
691 } else if ( current.flag > 0 ) {
692 if ( debug ) print(' dangling flag');
693 if ( length(opt) > i ) {
694 peek.optstring = opt[i + 1];
695 if ( debug ) print(paste(' peeking ahead at: "',peek.optstring,'"',sep=''));
696
697 #got an argument. attach it, increment the index, and move on to the next option. we don't allow arguments beginning with '-' UNLESS
698 #specfile indicates the value is an "integer" or "double", in which case we allow a leading dash (and verify trailing digits/decimals).
699 if ( substr(peek.optstring, 1, 1) != '-' |
700 #match negative double
701 ( substr(peek.optstring, 1, 1) == '-'
702 & regexpr('^-[0123456789]*\\.?[0123456789]+$',peek.optstring) > 0
703 & spec[current.flag, col.mode]== 'double'
704 ) |
705 #match negative integer
706 ( substr(peek.optstring, 1, 1) == '-'
707 & regexpr('^-[0123456789]+$',peek.optstring) > 0
708 & spec[current.flag, col.mode]== 'integer'
709 )
710 ) {
711 if ( debug ) print(paste(' consuming argument *',peek.optstring,'*',sep=''));
712 storage.mode(peek.optstring) = spec[current.flag, col.mode];
713 #remove the last argument put in result for current.flag that should be a TRUE and concatenate argument with previous ones
714 result[[spec[current.flag, col.long.name]]] = c(result[[spec[current.flag, col.long.name]]][-length(result[[spec[current.flag, col.long.name]]])],peek.optstring);
715 i = i + 1;
716
717 #a lone dash
718 } else if ( substr(peek.optstring, 1, 1) == '-' & length(strsplit(peek.optstring,'')[[1]]) == 1 ) {
719 if ( debug ) print(' consuming "lone dash" argument');
720 storage.mode(peek.optstring) = spec[current.flag, col.mode];
721 #remove the last argument put in result for current.flag that should be a TRUE and concatenate argument with previous ones
722 result[[spec[current.flag, col.long.name]]] =c(result[[spec[current.flag, col.long.name]]][-length(result[[spec[current.flag, col.long.name]]])],peek.optstring);
723 i = i + 1;
724
725 #no argument
726 } else {
727 if ( debug ) print(' no argument!');
728
729 #if we require an argument, bail out
730 if ( spec[current.flag, col.has.argument] == flag.required.argument ) {
731 stop(paste('flag "', this.flag, '" requires an argument', sep=''));
732
733 #otherwise set flag as present.
734 } else if (
735 spec[current.flag, col.has.argument] == flag.optional.argument |
736 spec[current.flag, col.has.argument] == flag.no.argument
737 ) {
738 x = TRUE;
739 storage.mode(x) = spec[current.flag, col.mode];
740 result[[spec[current.flag, col.long.name]]] = c(result[[spec[current.flag, col.long.name]]],x);
741 } else {
742 stop(paste("This should never happen.",
743 "Is your spec argument correct? Maybe you forgot to set",
744 "ncol=4, byrow=TRUE in your matrix call?"));
745 }
746 }
747 #trailing flag without required argument
748 } else if ( spec[current.flag, col.has.argument] == flag.required.argument ) {
749 stop(paste('flag "', this.flag, '" requires an argument', sep=''));
750
751 #trailing flag without optional argument
752 } else if ( spec[current.flag, col.has.argument] == flag.optional.argument ) {
753 x = TRUE;
754 storage.mode(x) = spec[current.flag, col.mode];
755 result[[spec[current.flag, col.long.name]]] = c(result[[spec[current.flag, col.long.name]]],x);
756
757 #trailing flag without argument
758 } else if ( spec[current.flag, col.has.argument] == flag.no.argument ) {
759 x = TRUE;
760 storage.mode(x) = spec[current.flag, col.mode];
761 result[[spec[current.flag, col.long.name]]] = c(result[[spec[current.flag, col.long.name]]],x);
762 } else {
763 stop("this should never happen (2). please inform the author.");
764 }
765 #no dangling flag, nothing to do.
766 } else {
767 }
768
769 i = i+1;
770 }
771 return(result);
772 }
773