Mercurial > repos > vandelj > giant_factor_generator
comparison src/getopt.R @ 0:4764dc6a1019 draft
"planemo upload for repository https://github.com/juliechevalier/GIANT/tree/master commit cb276a594444c8f32e9819fefde3a21f121d35df"
| author | vandelj |
|---|---|
| date | Fri, 26 Jun 2020 09:51:15 -0400 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:4764dc6a1019 |
|---|---|
| 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 |