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;