mtimeout.1: Use correct dash for number ranges.

[misc] / MdwOpt.pm

#
# MdwOpt.pm
#
# Options parsing
#
# (c) 1996 Mark Wooding
#

#----- Notices --------------------------------------------------------------
#
# This program comes with no warranty, not even of any kind, unless
# someone other than the author offers to provide one.  It may be used
# and distributed under the terms of the GNU General Public Licence, in
# the interests of promoting freely available software for Linux.

package MdwOpt;
require 5.00;
require Exporter;

@ISA=qw(Exporter);
@EXPORT=qw( );

#----- The code -------------------------------------------------------------

# --- MdwOpt::new ---
#
# Arguments:    (scalar) shortopts == short options description
#               (see below) longopts == long options description
#               (array ref) arguments == pointer to argument list
#               (array ref) flags == a number of flags you can set
#
# Returns:      A `MdwOpt' object, which can be used to extract options from
#               an array of argument strings.
#
# Use:          Creates a `MdwOpt' object which contains all the information
#               needed to parse a command line.  The arguments are a bit
#               complicated, so I'll explain them below.  This implementation
#               provides a similar level of flexibility to the C `mdwopt'
#               routine, although the interface is rather different, since it
#               takes advantage of some of Perl's object-oriented features.
#
#
#           How options parsing appears to users
#
#               A command line consists of a number of `words' (which may
#               contain spaces, according to various shell quoting
#               conventions).  A word may be an option, an argument to an
#               option, or a non-option.  An option begins with a special
#               character, usually `-', although `+' is also used sometimes.
#               As special exceptions, the word containing only a `-' is
#               considered to be a non-option, since it usually represents
#               standard input or output as a filename, and the word
#               containing a double-dash `--' is used to mark all following
#               words as being non-options regardless of their initial
#               character.
#
#               Traditionally, all words after the first non-option have been
#               considered to be non-options automatically, so that options
#               must be specified before filenames.  However, this
#               implementation can extract all the options from the command
#               line regardless of their position.  This can usually be
#               disabled by setting one of the environment variables
#               `POSIXLY_CORRECT' or `_POSIX_OPTION_ORDER'.
#
#               There are two different styles of options: `short' and
#               `long'.
#
#               Short options are the sort which Unix has known for ages: an
#               option is a single letter, preceded by a `-'.  Short options
#               can be joined together to save space (and possibly to make
#               silly words): e.g., instead of giving options `-x -y', a user
#               could write `-xy'.  Some short options can have arguments,
#               which appear after the option letter, either immediately
#               following, or in the next `word' (so an option with an
#               argument could be written as `-o foo' or as `-ofoo').  Note
#               that options with optional arguments must be written in the
#               second style.
#
#               When a short option controls a flag setting, it is sometimes
#               possible to explicitly turn the flag off, as well as turning
#               it on, (usually to override default options).  This is
#               usually done by using a `+' instead of a `-' to introduce the
#               option.
#
#               Long options, as popularised by the GNU utilities, are given
#               long-ish memorable names, preceded by a double-dash `--'.
#               Since their names are more than a single character, long
#               options can't be combined in the same way as short options.
#               Arguments to long options may be given either in the same
#               `word', separated from the option name by an equals sign,
#               or in the following `word'.
#
#               Long option names can be abbreviated if necessary, as long
#               as the abbreviation is unique.  This means that options can
#               have sensible and memorable names but still not require much
#               typing from an experienced user.
#
#               Like short options, long options can control flag settings.
#               The options to manipulate these settings come in pairs: an
#               option of the form `--set-flag' might set the flag, while an
#               option of the form `--no-set-flag' might clear it.
#
#               It is usual for applications to provide both short and long
#               options with identical behaviour.  Some applications with
#               lots of options may only provide long options (although they
#               will often be only two or three characters long).  In this
#               case, long options can be preceded with a single `-'
#               character, and negated by a `+' character.
#
#               Finally, some (older) programs accept arguments of the form
#               `-<number>', to set some numerical parameter, typically a
#               line count of some kind.
#
#
#           How programs parse options
#
#               The difficult bit is all in the setting up at the beginning.
#               I've used some funny data structures to try and pack all the
#               important information away.
#
#               The first `shortopts' argument specifies the allowable short
#               options, followed by various switch characters which control
#               option-specific features.  Allowable characters are as
#               follows:
#
#                 :     option takes a required argument
#                 ::    option takes an optional argument
#                 +     option may be negated
#
#               Note that the `+' must appear /before/ the `:' characters.
#
#               The `longopts' argument is a reference to a hash, containing
#               various pieces of information.  (Using a reference here means
#               that we can pass other aggregate values around.  It also
#               might save a little memory.)  The hash contains an item for
#               each long option string you want to support: the option's
#               name is the key; the value is another hash reference
#               containing information about the option.  This sub-hash
#               should contain a number of the following items:
#
#               Key             Use
#               ~~~             ~~~
#
#               return          Value to return when this option is found.
#                               May be any sort of non-false scalar value.
#
#               arg             Information about the argument for this
#                               option.  May be one of the strings `none',
#                               `opt' and `req'.  (Actually `none' is the
#                               same as a false value, and `req' is the same
#                               as any other true value.)
#
#               negate          If true, allow the option to be negated.
#
#               The `flags' argument is a reference to a array containing
#               items from the following table.
#
#               Flag            Use
#               ~~~~            ~~~
#
#               nolong          Don't support any long options
#               noshort         Don't support any short options
#               numeric         Support numeric options
#               negate          Support negated options
#               env             Read options from environment variable
#               permute         Force permuting of the argument list
#               inorder         Read options in order
#               posix           Force use of POSIX option semantics
#               quiet           Don't report errors when they happen

sub new
{
  my $class=shift;
  my $self=bless {};                    # Make an empty reference for me
  my ($short,$long,$argv,$flags)=@_;    # Read the caller's arguments
  my ($x);                              # Temporaries for copying
  my ($prog);                           # Program name read from argv[0]

  # --- Set up the simple parts of the structure ---

  @{$self->{argv}}=@$argv;              # Copy the arguments list

  $self->{flags}={};                    # Clear the flags hash out
  foreach $x (@$flags) { $self->{flags}{$x}=1; }

  $self->{short}=$short;                # Copy the short options string
  $self->{long}=$long;                  # Take a reference to the long opts

  # --- Get the arguments list sorted out ---

  $prog=$0;                             # Read the program name
  $prog =~ s|^.*/||;                    # Strip leading gubbins from it
  $self->{prog}=$prog;                  # This as the program name

  # --- Play with the ordering settings ---

  unless ($self->{flags}{permute} ||
          $self->{flags}{inorder} ||
          $self->{flags}{posix})
  {
    if (defined($ENV{'POSIXLY_CORRECT'}) ||
        defined($ENV{'_POSIX_OPTION_ORDER'}))
    { $self->{flags}{posix}=1; }
    else
    { $self->{flags}{permute}=1; }
  }

  # --- Set up the environment variable, if we're reading that ---
  #
  # List concatenation is so easy ;-)  This is actually better than the C
  # version, although much less efficient, since it works `properly' with
  # non-options in the options string.

  @{$self->{argv}}=(split(' ',$ENV{uc($self->{prog})}),@{$self->{argv}})
    if ($self->{flags}{env});

  # --- Initialise persistent state bits ---

  $self->{rest}=[];                     # No non-options found yet
  $self->{this}='';                     # We're not in a shortopt group

  # --- That's it, so we're done now ---

  return ($self);
}

# --- mo->err ---
#
# Arguments:    (scalar) error == a string to return
#
# Returns:      A suitable error message from mo->read.
#
# Use:          Contructs an error return and maybe displays the message to
#               the user.

sub err
{
  my ($self,$msg)=@_;

  print STDERR "$self->{prog}: $msg\n"
    unless $self->{flags}{quiet};
  return ($msg);
}

# --- mo->read ---
#
# Arguments:    --
#
# Returns:      A list containing interesting things about the option
#
# Use:          Returns information about the next option read.  The list
#               contains, in order:
#
#                 * The `value' of the option, with a suffix `+' if negated
#                 * The argument passed to the option
#
#               Non-options are reported by passing a `value' of an empty
#               string.  The end of the options is reported by returning
#               `undef' as the value.  An error is returned my setting
#               `value' to `?' and putting the error message in the argument
#               field.

sub read
{
  my ($self)=@_;                        # Read the arguments list
  my ($opt,$arg,$prefix);

  if ($self->{this} eq '')              # Have we any shortopts left?
  {
    $self->{flags}{_neg}=0;             # This option isn't negated yet

    # --- Find the next option to handle ---

    arg: for (;;)
    {
      $opt=shift(@{$self->{argv}});     # Shift out the next option
      return (undef,undef)
        unless (defined($opt));

      if ($opt =~ /^-/ || ($opt =~ /^\+/ && $self->{flags}{negate}))
      {
        if ($opt eq '--')               # If no more options at all
        {
          push(@{$self->{rest}},@{$self->{argv}});
          return (undef,undef);         # Return two undefined values
        }
        elsif (length($opt)!=1)
        { last arg; }                   # Otherwise we've found an option
      }

      switch: {
        push(@{$self->{rest}},$opt,@{$self->{argv}}),
        return (undef,undef)            # And return two undefined values
          if $self->{flags}{posix};

        return ('',$opt)                # Return this non-option
          if $self->{flags}{inorder};

        push(@{$self->{rest}},$opt)     # Add to the `rest' list
          ;
      }
    }

    # --- Check for a numeric option ---

    return ('#',substr($opt,1))
      if $self->{flags}{numeric} && $opt =~ /^-[+-]?[0-9]/;

    # --- Handle long options ---
    #
    # This is where things start getting hairy.

    if (($opt =~ /^--/ || $self->{flags}{noshort}) &&
        !$self->{flags}{nolong})
    {
      my ($match,$key,$real);

      # --- Extract the prefix, option name and argument ---
      #
      # This is rather easier than the C version.

      ($self->{flags}{negate}) ?
        (($prefix,$opt) = $opt =~ /^(\+|--no-|--|-)(.*)/) :
        (($prefix,$opt) = $opt =~ /^(\+|--)(.*)/);
      $self->{flags}{_neg}=1 if ($prefix eq '+' || $prefix eq '--no-');

      ($opt,$arg)=($`,$') if $opt =~ /=/;

      # --- Now try and find an entry in the hash table ---

      longopt: foreach $key (keys(%{$self->{long}}))
      {
        next longopt
          if $self->{flags}{_neg} && !$self->{long}{$key}{negate};

        ($match,$real)=($self->{long}{$key},$key),
        last longopt
          if $key eq $opt;

        next longopt
          if length($key)<length($opt) ||
             $opt ne substr($key,0,length($opt));

        $match=undef,
        last longopt
          if defined($match);

        ($match,$real)=($self->{long}{$key},$key)
          ;
      }

      return ('?',$self->err("unrecognised option `$prefix$opt'"))
        unless defined($match);

      if ($match->{arg} eq 'none' || !$match->{arg})
      {
        return ('?',
                $self->err("option `$prefix$real' does not accept " .
                           "arguments"))
          if $arg;
      }
      elsif ($match->{arg} ne 'opt')
      {
        $arg=shift(@{$self->{argv}})
          unless $arg;
        return ('?',$self->err("option `$prefix$real' requires an argument"))
          unless defined($arg);
      }

      $opt=($match->{"return"} || $real);
      $opt .= '+' if ($self->{flags}{_neg});
      return ($opt,$arg);
    }

    # --- Right, it must be a short option ---

    $self->{flags}{_neg}=1 if ($opt =~ /^\+/);
    $self->{this}=substr($opt,1);
  }

  # --- Handle the next short option ---

  ($opt,$self->{this})=(substr($self->{this},0,1),substr($self->{this},1));
  $prefix=($self->{flags}{_neg} ? '+' : '-');

  if ($self->{short} =~ /\Q$opt/ &&
      (!$self->{flags}{_neg} || substr($',0,1) eq '+'))
  {
    my ($rest,$arg)=($',undef);

    # --- Found an option, so handle the argument ---

    $rest =~ /^\+?(:{0,2})/;
    if ($1)
    {
      $arg=$self->{this};
      $self->{this}='';
      if ($1 eq ':' && !$arg)
      {
        $arg=shift(@{$self->{argv}});
        return ('?',$self->err("option `$prefix$opt' requires an argument"))
          unless defined($arg);
      }
    }

    $opt.='+' if $self->{flags}{_neg};
    return ($opt,$arg);
  }
  return ('?',$self->err("unrecognised option `$prefix$opt'"));
}

# --- mo->rest ---
#
# Arguments:    --
#
# Returns:      A list containing the remaining command line items in order.
#
# Use:          Returns all the unprocessed command line arguments.

sub rest
{
  my ($self)=@_;
  return (@{$self->{rest}});
}

# --- prog ---
#
# Arguments:    --
#
# Returns:      The program name, read from $0.
#
# Use:          Returns the name of the program, with leading path elements
#               snipped off.  You can call this either as a class method or
#               by passing a MdwOpt object.

sub prog { $0 =~ m|^.*/| ? $' : $0 }

1;