6 # (c) 1996 Mark Wooding
9 #----- Notices --------------------------------------------------------------
11 # This program comes with no warranty, not even of any kind, unless
12 # someone other than the author offers to provide one. It may be used
13 # and distributed under the terms of the GNU General Public Licence, in
14 # the interests of promoting freely available software for Linux.
23 #----- The code -------------------------------------------------------------
27 # Arguments: (scalar) shortopts == short options description
28 # (see below) longopts == long options description
29 # (array ref) arguments == pointer to argument list
30 # (array ref) flags == a number of flags you can set
32 # Returns: A `MdwOpt' object, which can be used to extract options from
33 # an array of argument strings.
35 # Use: Creates a `MdwOpt' object which contains all the information
36 # needed to parse a command line. The arguments are a bit
37 # complicated, so I'll explain them below. This implementation
38 # provides a similar level of flexibility to the C `mdwopt'
39 # routine, although the interface is rather different, since it
40 # takes advantage of some of Perl's object-oriented features.
43 # How options parsing appears to users
45 # A command line consists of a number of `words' (which may
46 # contain spaces, according to various shell quoting
47 # conventions). A word may be an option, an argument to an
48 # option, or a non-option. An option begins with a special
49 # character, usually `-', although `+' is also used sometimes.
50 # As special exceptions, the word containing only a `-' is
51 # considered to be a non-option, since it usually represents
52 # standard input or output as a filename, and the word
53 # containing a double-dash `--' is used to mark all following
54 # words as being non-options regardless of their initial
57 # Traditionally, all words after the first non-option have been
58 # considered to be non-options automatically, so that options
59 # must be specified before filenames. However, this
60 # implementation can extract all the options from the command
61 # line regardless of their position. This can usually be
62 # disabled by setting one of the environment variables
63 # `POSIXLY_CORRECT' or `_POSIX_OPTION_ORDER'.
65 # There are two different styles of options: `short' and
68 # Short options are the sort which Unix has known for ages: an
69 # option is a single letter, preceded by a `-'. Short options
70 # can be joined together to save space (and possibly to make
71 # silly words): e.g., instead of giving options `-x -y', a user
72 # could write `-xy'. Some short options can have arguments,
73 # which appear after the option letter, either immediately
74 # following, or in the next `word' (so an option with an
75 # argument could be written as `-o foo' or as `-ofoo'). Note
76 # that options with optional arguments must be written in the
79 # When a short option controls a flag setting, it is sometimes
80 # possible to explicitly turn the flag off, as well as turning
81 # it on, (usually to override default options). This is
82 # usually done by using a `+' instead of a `-' to introduce the
85 # Long options, as popularised by the GNU utilities, are given
86 # long-ish memorable names, preceded by a double-dash `--'.
87 # Since their names are more than a single character, long
88 # options can't be combined in the same way as short options.
89 # Arguments to long options may be given either in the same
90 # `word', separated from the option name by an equals sign,
91 # or in the following `word'.
93 # Long option names can be abbreviated if necessary, as long
94 # as the abbreviation is unique. This means that options can
95 # have sensible and memorable names but still not require much
96 # typing from an experienced user.
98 # Like short options, long options can control flag settings.
99 # The options to manipulate these settings come in pairs: an
100 # option of the form `--set-flag' might set the flag, while an
101 # option of the form `--no-set-flag' might clear it.
103 # It is usual for applications to provide both short and long
104 # options with identical behaviour. Some applications with
105 # lots of options may only provide long options (although they
106 # will often be only two or three characters long). In this
107 # case, long options can be preceded with a single `-'
108 # character, and negated by a `+' character.
110 # Finally, some (older) programs accept arguments of the form
111 # `-<number>', to set some numerical parameter, typically a
112 # line count of some kind.
115 # How programs parse options
117 # The difficult bit is all in the setting up at the beginning.
118 # I've used some funny data structures to try and pack all the
119 # important information away.
121 # The first `shortopts' argument specifies the allowable short
122 # options, followed by various switch characters which control
123 # option-specific features. Allowable characters are as
126 # : option takes a required argument
127 # :: option takes an optional argument
128 # + option may be negated
130 # Note that the `+' must appear /before/ the `:' characters.
132 # The `longopts' argument is a reference to a hash, containing
133 # various pieces of information. (Using a reference here means
134 # that we can pass other aggregate values around. It also
135 # might save a little memory.) The hash contains an item for
136 # each long option string you want to support: the option's
137 # name is the key; the value is another hash reference
138 # containing information about the option. This sub-hash
139 # should contain a number of the following items:
144 # return Value to return when this option is found.
145 # May be any sort of non-false scalar value.
147 # arg Information about the argument for this
148 # option. May be one of the strings `none',
149 # `opt' and `req'. (Actually `none' is the
150 # same as a false value, and `req' is the same
151 # as any other true value.)
153 # negate If true, allow the option to be negated.
155 # The `flags' argument is a reference to a array containing
156 # items from the following table.
161 # nolong Don't support any long options
162 # noshort Don't support any short options
163 # numeric Support numeric options
164 # negate Support negated options
165 # env Read options from environment variable
166 # permute Force permuting of the argument list
167 # inorder Read options in order
168 # posix Force use of POSIX option semantics
169 # quiet Don't report errors when they happen
174 my $self=bless {}; # Make an empty reference for me
175 my ($short,$long,$argv,$flags)=@_; # Read the caller's arguments
176 my ($x); # Temporaries for copying
177 my ($prog); # Program name read from argv[0]
179 # --- Set up the simple parts of the structure ---
181 @
{$self->{argv
}}=@
$argv; # Copy the arguments list
183 $self->{flags
}={}; # Clear the flags hash out
184 foreach $x (@
$flags) { $self->{flags
}{$x}=1; }
186 $self->{short
}=$short; # Copy the short options string
187 $self->{long
}=$long; # Take a reference to the long opts
189 # --- Get the arguments list sorted out ---
191 $prog=$0; # Read the program name
192 $prog =~ s
|^.*/||; # Strip leading gubbins from it
193 $self->{prog
}=$prog; # This as the program name
195 # --- Play with the ordering settings ---
197 unless ($self->{flags
}{permute
} ||
198 $self->{flags
}{inorder
} ||
199 $self->{flags
}{posix
})
201 if (defined($ENV{'POSIXLY_CORRECT'}) ||
202 defined($ENV{'_POSIX_OPTION_ORDER'}))
203 { $self->{flags
}{posix
}=1; }
205 { $self->{flags
}{permute
}=1; }
208 # --- Set up the environment variable, if we're reading that ---
210 # List concatenation is so easy ;-) This is actually better than the C
211 # version, although much less efficient, since it works `properly' with
212 # non-options in the options string.
214 @
{$self->{argv
}}=(split(' ',$ENV{uc($self->{prog
})}),@
{$self->{argv
}})
215 if ($self->{flags
}{env
});
217 # --- Initialise persistent state bits ---
219 $self->{rest
}=[]; # No non-options found yet
220 $self->{this
}=''; # We're not in a shortopt group
222 # --- That's it, so we're done now ---
229 # Arguments: (scalar) error == a string to return
231 # Returns: A suitable error message from mo->read.
233 # Use: Contructs an error return and maybe displays the message to
240 print STDERR
"$self->{prog}: $msg\n"
241 unless $self->{flags
}{quiet
};
249 # Returns: A list containing interesting things about the option
251 # Use: Returns information about the next option read. The list
252 # contains, in order:
254 # * The `value' of the option, with a suffix `+' if negated
255 # * The argument passed to the option
257 # Non-options are reported by passing a `value' of an empty
258 # string. The end of the options is reported by returning
259 # `undef' as the value. An error is returned my setting
260 # `value' to `?' and putting the error message in the argument
265 my ($self)=@_; # Read the arguments list
266 my ($opt,$arg,$prefix);
268 if ($self->{this
} eq '') # Have we any shortopts left?
270 $self->{flags
}{_neg
}=0; # This option isn't negated yet
272 # --- Find the next option to handle ---
276 $opt=shift(@
{$self->{argv
}}); # Shift out the next option
278 unless (defined($opt));
280 if ($opt =~ /^-/ || ($opt =~ /^\+/ && $self->{flags
}{negate
}))
282 if ($opt eq '--') # If no more options at all
284 push(@
{$self->{rest
}},@
{$self->{argv
}});
285 return (undef,undef); # Return two undefined values
287 elsif (length($opt)!=1)
288 { last arg
; } # Otherwise we've found an option
292 push(@
{$self->{rest
}},$opt,@
{$self->{argv
}}),
293 return (undef,undef) # And return two undefined values
294 if $self->{flags
}{posix
};
296 return ('',$opt) # Return this non-option
297 if $self->{flags
}{inorder
};
299 push(@
{$self->{rest
}},$opt) # Add to the `rest' list
304 # --- Check for a numeric option ---
306 return ('#',substr($opt,1))
307 if $self->{flags
}{numeric
} && $opt =~ /^-[+-]?[0-9]/;
309 # --- Handle long options ---
311 # This is where things start getting hairy.
313 if (($opt =~ /^--/ || $self->{flags
}{noshort
}) &&
314 !$self->{flags
}{nolong
})
316 my ($match,$key,$real);
318 # --- Extract the prefix, option name and argument ---
320 # This is rather easier than the C version.
322 ($self->{flags
}{negate
}) ?
323 (($prefix,$opt) = $opt =~ /^(\+|--no-|--|-)(.*)/) :
324 (($prefix,$opt) = $opt =~ /^(\+|--)(.*)/);
325 $self->{flags
}{_neg
}=1 if ($prefix eq '+' || $prefix eq '--no-');
327 ($opt,$arg)=($`,$') if $opt =~ /=/;
329 # --- Now try and find an entry in the hash table ---
331 longopt: foreach $key (keys(%{$self->{long}}))
334 if $self->{flags}{_neg} && !$self->{long}{$key}{negate};
336 ($match,$real)=($self->{long}{$key},$key),
341 if length($key)<length($opt) ||
342 $opt ne substr($key,0,length($opt));
348 ($match,$real)=($self->{long}{$key},$key)
352 return ('?',$self->err("unrecognised option `$prefix$opt'"))
353 unless defined($match);
355 if ($match->{arg} eq 'none
' || !$match->{arg})
358 $self->err("option `$prefix$real' does
not accept " .
362 elsif ($match->{arg} ne 'opt')
364 $arg=shift(@{$self->{argv}})
366 return ('?',$self->err("option
`$prefix$real' requires an argument"))
367 unless defined($arg);
370 $opt=($match->{"return"} || $real);
371 $opt .= '+' if ($self->{flags}{_neg});
375 # --- Right, it must be a short option ---
377 $self->{flags}{_neg}=1 if ($opt =~ /^\+/);
378 $self->{this}=substr($opt,1);
381 # --- Handle the next short option ---
383 ($opt,$self->{this})=(substr($self->{this},0,1),substr($self->{this},1));
384 $prefix=($self->{flags}{_neg} ? '+' : '-');
386 if ($self->{short} =~ /\Q$opt/ &&
387 (!$self->{flags}{_neg} || substr($',0,1) eq '+'))
389 my ($rest,$arg)=($',undef);
391 # --- Found an option, so handle the argument ---
393 $rest =~ /^\+?(:{0,2})/;
398 if ($1 eq ':' && !$arg)
400 $arg=shift(@{$self->{argv}});
401 return ('?',$self->err("option `$prefix$opt' requires an argument"))
402 unless defined($arg);
406 $opt.='+' if $self->{flags}{_neg};
409 return ('?
',$self->err("unrecognised option `$prefix$opt'"));
416 # Returns: A list containing the remaining command line items in order.
418 # Use: Returns all the unprocessed command line arguments.
423 return (@{$self->{rest}});
430 # Returns: The program name, read from $0.
432 # Use: Returns the name of the program, with leading path elements
433 # snipped off. You can call this either as a class method or
434 # by passing a MdwOpt object.
436 sub prog { $0 =~ m|^.*/| ? $' : $0 }