#!/usr/bin/perl -T
# IBM_PROLOG_BEGIN_TAG 
# This is an automatically generated prolog. 
#  
# bos720 src/perl/libext/Getopts/Getopts.pm 1.8 
#  
# Licensed Materials - Property of IBM 
#  
# COPYRIGHT International Business Machines Corp. 2006,2008 
# All Rights Reserved 
#  
# US Government Users Restricted Rights - Use, duplication or 
# disclosure restricted by GSA ADP Schedule Contract with IBM Corp. 
#  
# IBM_PROLOG_END_TAG 
# @(#)14      1.8  src/perl/libext/Getopts/Getopts.pm, perl_libaix, bos720 3/19/08 20:39:31

package LibExt::Getopts;

# code starts after '=cut'

=head1 NAME

LibExt::Getopts - Extended command line option parsing

=head1 SYNOPSIS

use LibExt::Getopts;

  my $optcfg = {
    # Global option:
    _list_delim => ',',
      # Delimiter for values when value_style is VS_DELIMLIST.
      # Value: A regex or string (will be converted to a regex) which will be
      # used to split the values apart.  Defaults to whitespace, but see
      # getopts() for important caveats.
    # Global option:
    _attrval_delim => '=',
      # Delimiter between attribute and value in an attribute/value pair.  Used
      # with VS_ATTRVAL.
      # Value: A string or regex (will be converted to a regex) which will be
      # passed to split().  Note that only the first instance will be used to
      # split an attribute/value pair.  Thus the value (but never the key) may
      # contain the delimiter.  Defaults to '='.  Beware of using whitespace
      # here, as this may cause conflicts with VS_DELIMLIST and/or list_delim.
    # Global option:
    _attrval_key_callback => sub { ... },
      # Subroutine to be called to post-process each key in an attribute/value
      # pair.  The sub accepts the key as its single parameter and should return
      # the key in its processed form.  If the subroutine returns undef, that
      # attribute/value pair will not be inserted in the return structure, and
      # option collection will terminate at that point.
    # Global option:
    _attrval_value_callback => sub { ... },
      # Subroutine to be called to post-process each value in an attribute/value
      # pair.  The sub accepts the value as its single parameter and should
      # return the value in its processed form.  If the subroutine returns
      # undef, that attribute/value pair will not be inserted in the return
      # structure, and option collection will terminate at that point.
    # One single-letter key per supported option.  Don't use prefixes (i.e. 'a',
    # not '-a'.)
    a => {
      allow_multiple => 1,
        # Are multiple instances of this flag supported?
        # Values: Perl-style boolean.  Default is 0 (only one instance allowed).
      value_style => VS_ATTRVAL,
        # What do 'optargs' look like?
        # Value is a bitmap ORed from:
        #         VS_ONOFF: No argument.  You get +1 for each instance of the
        #         switch found.
        #         VS_SINGLEVAL: Single argument.
        #         VS_DELIMLIST: A list of arguments, delimited.  Specify the
        #         delimiter in the '_list_delim' field.
        #         VS_ATTRVAL:  One or more attribute=value pairs per
        #         instance of this flag.  E.g. -a attr1=value1 attr2=value2.
        #         Whitespace is required between PAIRS; specify the
        #         attribute/value separator in _attrval_delim (default '=').
    },
  };

  my $opts = LibExt::Getopts->getopts($optcfg);

  $opts->exists('a') or die "The -a flag is required.\n";

  my @uniqueflags = $opts->flagList();

  unless($opts->initIterator('a')) {
    die("The -a flag is required.\n");
  }
  print("The -a flag was found " . $opts->next() . " times without arguments.\n");
  while(defined($items = $opts->next())) {
    if(ref($items) eq 'HASH') {
      # This flag instance matched VS_ATTRVAL - the hash reference contains the
      # key/value pairs for this instance.
      while(my($key, $value) = each(%$items)) { ... }
    }
    elsif(ref($items) eq 'ARRAY') {
      # This flag instance matched VS_SINGLEVAL or VS_DELIMLIST - the list
      # reference contains the values (possibly only one) in order.
      for my $value (@$items) { ... }
    }
  }

  my $vs = $opts->value_styles('a');
  unless($vs & VS_SINGLEVAL) {
    die("The -a flag must be specified with an argument at least once.\n");
  }

  # The one value when value_style => VS_SINGLEVAL and allow_multiple => 0.
  my $val = $opts->singleval('a');

=head1 DESCRIPTION

An object-oriented module ("perldoc perltoot") for command line option parsing.
Supports the following features:

=over 4

=item *

Option clustering: -abc == -a -b -c

=item *

A single flag argument: -a foo

=item *

Abbreviation (whitespace omission): -afoo

=item *

A list of flag arguments: -a foo,bar,baz

=item *

Customizable list delimiters: -a foo|bar|baz

=item *

One or more key/value-type flag arguments: -a foo=one bar=baz

=item *

Customizable key/value separators: -a foo+=one bar-=baz

=item *

Multiple instances of the same flag: -a foo -a bar (NOT the same as -a foo bar)

=item *

Special "end of options" flag '--' (double-minus).

=back

=head2 And Coming Soon

=over 4

=item *

Long-style flags: --flag

=item *

Customizable prefixes: +a

=item *

Customizable delimiter between attr/value pairs: -a foo=one,bar=two

=back

=cut

use strict;
use warnings;

use constant {
  _VS_MIN      => 1,
  VS_ONOFF     => 1,
  VS_SINGLEVAL => 2,
  VS_DELIMLIST => 4,
  VS_ATTRVAL   => 8,
  # The sum of all the VS_* values, for error checking.
  # KEEP THIS UP-TO-DATE.
  _VS_MAX      => 15,
};

require Exporter;
our @ISA = qw/Exporter/;
# Export constants; and getopts(), which can be called as a function or as a
# class method.  The rest should be accessed OO-wise.
our @EXPORT = qw/VS_ONOFF VS_SINGLEVAL VS_DELIMLIST VS_ATTRVAL getopts/;

use Errno qw/:POSIX/;

=head1 CONSTANTS

These constants may be assigned to the C<value_style> attribute of each flag in
the structure passed to the C<getopts()> constructor.  Multiple values may be
bitwise-ORed to allow flags to be specified in different ways on the same
command line; however, this capability should be used with caution as ambiguity
may lead to undefined results.

=over 4

=item VS_ONOFF

This flag takes no argument.  Its corresponding value will be incremented by one
for each argument-less instance found on the command line.

=item VS_SINGLEVAL

This flag takes a single argument.  When used in conjunction with VS_DELIMLIST,
VS_DELIMLIST will be tried first.  For example, given this input structure:

  { a => { value_style => VS_SINGLEVAL | VS_DELIMLIST },
    _list_delim => '\w+',
  }

...and this command line:

  -a 'one two three'

...the result will contain:

  { a => ['one', 'two', 'three'] }

=item VS_DELIMLIST

This flag takes a delimited list of arguments.  Specify the delimiter in the
'_list_delim' field (see _list_delim under getopts() below).  When a flag may
take one or more arguments, there is no need to specify VS_SINGLEVAL as well.

=item VS_ATTRVAL

This flag takes one or more attribute=value pairs per flag instance.  E.g. -a
attr1=value1 attr2=value2.  Whitespace is required between PAIRS; specify the
attribute/value separator in _attrval_delim (default '=').

=back

=head1 METHODS

=over 4

=item $opts = getopts(SPEC)

Constructor.  Consumes @ARGV by shifting, leaving any unparsed arguments on
@ARGV if successful.  (Encountering an unknown flag is NOT success.)  The SPEC
argument is a hash reference whose keys may be:

=over 4

=item C<_list_delim>

This attribute's value is a string or regex (will be converted to a regex)
representing the delimiter(s) allowed between values in a list when VS_DELIMLIST
is used as an option's value_style.  The default is whitespace.  However,
specifying a pattern matching whitespace will have a different effect than
leaving this value undefined.  If undefined, a VS_DELIMLIST-type flag will
consume arguments until another flag is encountered.  If defined, only ONE
argument will be consumed, split on the provided regular expression.  For
example:

 _list_delim    @ARGV                   Result                  @ARGV
 ========================================================================
 undef          'one two' three         ['one two', 'three']    ()
 '\w+'          'one two' three         ['one', 'two']          ('three')

There is no escape mechanism for including a delimiter character/sequence within
a value.

=item C<_attrval_delim>

This attribute's value is a string or regex (will be converted to a regex)
representing the delimiter(s) allowed between the key and the value in a
key/value pair when VS_ATTRVAL is used as an option's value_style.  The default
is '='.  Note that only the first instance is matched; therefore a value (but
never a key) may contain the delimiter.

=item C<_attrval_key_callback>

=item C<_attrval_value_callback>

Subroutine references allowing preprocessing of the key and value in each
attribute/value pair encountered.  The subroutine is passed the key or value as
its first parameter, and should return the processed key or value.  A return of
undef will cause the attribute/value pair to be ignored (not inserted into the
return structure), and option collection will terminate at that point.

=item A single letter representing an option

For example, to accept '-a' on the command line, you must include a key 'a' in
the SPEC structure.  The attribute's value is a hash reference whose keys may
be:

=over 4

=item allow_multiple

A boolean indicating whether multiple instances of this option are permitted on
the command line.  The default is false (only one instance allowed).

=item value_style

A C<VS_*> constant (or more than one, bitwise-ORed together) indicating what
kind of value may be specified with this option.  Possible values are
C<VS_ONOFF>, C<VS_SINGLEVAL>, C<VS_DELIMLIST>, and C<VS_ATTRVAL>.  See the
CONSTANTS section for details.  The default is C<VS_ONOFF>.

=back

If this attribute's value is C<undef>, the default is:

  { allow_multiple => 0, value_style => VS_ONOFF }

=back

The getopts() constructor will terminate parsing if it sees '--' (double-minus)
as a single command-line argument.  The '--' argument is left in @ARGV (as the
first element) when the constructor returns.  (Note that '--' is not supported
as a valid flag - see RESTRICTIONS/LIMITATIONS/CAVEATS.)

The getopts() constructor returns an object on which the other methods in this
package operate.

On (non-fatal) failure, an error message is displayed and undef is returned.  In
this case, no guarantee is made as to the contents of @ARGV.  Notably, the
offending argument(s) may or may not still be there.

=begin comment

The returned object is of the form:

 {
   # Iteration arrays - one instance of the following for each unique switch:
   <flagletter> => [
     <n>,   # Bitmask of all the value_styles matched for this flag.
     <n>,   # The number of times the flag appeared arg-less
     <ref>, # The remaining elements are either list or hash references, in
     ...,   # command-line order, representing the arg'd instances of this flag
     ...,   # found on the command line.
   ],
   ...,
   # A hash where all the list-type instances for a particular flag are stored.
   LIST => {
     <flagletter> => [
       [aref],
       ...
     ],
     ...
   },
   # A hash for all the attr/val-type instances for a particular flag.
   ATTRVAL => {
     <flagletter> => [
       {href},
       ...
     ],
   },
   _current => <ref>, # A bookmark to keep track of the (current instance of a)
                      # flag we're setting/examining.
   _iterator => <n>,  # An index into a flag's iteration array for next().
 }

=end comment

=cut

# FIXME - customizable?
my $optprefix = '-';

sub getopts {
  my $spec = shift;
  # In case we were called as a class method
  $spec = shift if $spec eq __PACKAGE__;
  # See pod comment above for this object's format.
  my $ret = bless {
    LIST    => {},
    ATTRVAL => {},
    _current => undef,
    _iterator => 0,
  }, __PACKAGE__; # FIXME - NOT inheritable!
  # If _list_delim isn't there, 'undef' gives the default behavior
  my $re_ldelim = $spec->{_list_delim};
  my $re_avdelim = defined($spec->{_attrval_delim})?$spec->{_attrval_delim}:'=';
  my $re_cluster = qr/^$optprefix(\S+)$/o;
  # Spin through the spec, collecting all permitted switches.  We use these to
  # initialize the returned object, which needs ALL of these so we can later
  # tell the difference between permitted-but-not-found vs. not-permitted.
  { # localize no bytes
    no bytes;
    for my $flag (grep(length($_) == 1, keys(%$spec))) {
      # Pre-perform these tests here - we want invalid spec data to be fatal at
      # development time.
      my $vs;
      unless(defined($vs = $spec->{$flag}->{value_style})) {
        $vs = VS_ONOFF;
      }
      if(($vs < _VS_MIN) || ($vs > _VS_MAX)) {
        _fatal("Invalid value_style '$vs' for flag '$flag'.");
      }
      $ret->_init_flag($flag);
    }
  }
  CLUSTER: while(@ARGV && ($ARGV[0] =~ $re_cluster)) {
    last CLUSTER if $1 eq '-';
    shift @ARGV;
    my $cluster = reverse $1; # So we can chop() and get 'em in order
    CLUSTERCHAR: while((my $flag = chop($cluster)) ne '') {
      # Explicitly disallow '-'
      if($flag eq '-') {
        _err(EINVAL, 'The "--" option must be specified alone on the command line.');
        return undef;
      }
      unless(exists($spec->{$flag})) {
        _err(EINVAL, 'Invalid option: %1$s', "$optprefix$flag");
        return undef;
      }
      # undef (false) as default is good:
      my $mult = $spec->{$flag}->{allow_multiple};
      my $vs;
      unless(defined($vs = $spec->{$flag}->{value_style})) {
        $vs = VS_ONOFF;
      }
      if(!$mult && $ret->exists($flag)) {
        _err(EEXIST, 'The %1$s option may only be specified once.', "$optprefix$flag");
        return undef;
      }
      # Short-circuit any boolean flags up to (but not including) the last of a
      # cluster
      if($cluster ne '') {
        if($vs & VS_ONOFF) {
          $ret->_add_ONOFF($flag);
          next CLUSTERCHAR;
        }
        else {
          # VS_ONOFF is OFF.  Spoof the rest of the cluster as an arg.
          unshift(@ARGV, scalar(reverse($cluster)));
          # And drop through.  The next condition is guaranteed to be false, but
          # we can live with that.
        }
      }
      ## At this point, we're on the last option of a cluster
      # First do a comprehensive check for boolean value style
      if(($vs == VS_ONOFF) ||                  # boolean only OR
         (   ($vs & VS_ONOFF)                  #   boolean possible and EITHER
          && (   !@ARGV                        #     no args left OR
              || ($ARGV[0] =~ $re_cluster))  ) #     next arg is a switch
        ) {
        $ret->_add_ONOFF($flag);
        next CLUSTER;
      }
      ## At this point, the flag requires an argument
      # Unset the _current pointer to enforce the use of the _new_*() methods
      # before the _add_*() methods.
      undef $ret->{_current};
      if(!@ARGV || ($ARGV[0] =~ $re_cluster)) {
        _err(EINVAL, 'The %1$s option requires an argument.', "$optprefix$flag");
        return undef;
      }
      # If attr/val is possible, try it first.
      # This loop is twisted inside-out because we only want it to be
      # "successful" (i.e. add data to the object and jump to the next option
      # cluster) if the *first* argument matches an attr/value pair.
      if($vs & VS_ATTRVAL) {
        my($k, $v) = split(/$re_avdelim/, $ARGV[0], 2);
        if(defined($k) && ($k ne '') && defined($v)) {
          $ret->_new_HASH($flag);
          do {
            $ret->_add_ATTRVAL($k, $v, $spec) or return undef; # _add_ATTRVAL prints error
            shift @ARGV;
            last unless @ARGV;
            ($k, $v) = split(/$re_avdelim/, $ARGV[0], 2);
          } while(   @ARGV                      # More arguments
                  && ($ARGV[0] !~ $re_cluster)  # AND the next argument isn't a new flag
                  && defined($k)                # AND the regular expression matched
                  && ($k ne '')                 #     (i.e. the key is non-empty AND
                  && defined($v));              #      the value is defined (empty OK)
          next CLUSTER;
        }
      }
      # If ONLY a single argument is expected, grab it and spin.  We know
      # there's a (valid, non-switch) argument because of the check a couple of
      # conditions up.
      if(($vs & VS_SINGLEVAL) && !($vs & VS_DELIMLIST)) {
        $ret->_new_LIST($flag, VS_SINGLEVAL);
        $ret->_add_LISTVAL(shift @ARGV) or return undef;
        next CLUSTER;
      }
      ## At this point, we know we want to grab a delimited list of values (if anything).
      unless($vs & VS_DELIMLIST) {
        _err(EINVAL, 'The %1$s option requires an argument.', "$optprefix$flag");
        return undef;
      }
      # Don't commit to a value_style yet.  We know the mask *contains*
      # VS_DELIMLIST, but it may also contain VS_SINGLEVAL.  If so, we want to
      # use the latter if only one value is grabbed.
      $ret->_new_LIST($flag);
      my $count = 0; # To determine the final value_style
      # See _list_delim perldoc.
      if(defined($re_ldelim)) {
        # _list_delim was defined - we want to parse exactly one argument with
        # whatever 'regex' was provided.
        # Would have liked to take advantage of Text::ParseWords to handle
        # quoted or escaped delimiters within the string, but it always treats
        # embedded quotes specially.
        my @vallist = split(/$re_ldelim/, shift(@ARGV), -1);
        $count = scalar(@vallist);
        for(@vallist) {
          $ret->_add_LISTVAL($_) or return undef; # _add_LISTVAL prints error
        }
      }
      else {
        # _list_delim was undef - grab arguments intact until no more, or until
        # we hit another flag.
        # We know there's at least one (valid, non-switch) argument because of
        # the check a few conditions up.
        while(@ARGV && ($ARGV[0] !~ $re_cluster)) {
          $ret->_add_LISTVAL(shift @ARGV) or return undef; # _add_LISTVAL prints error
          $count++;
        }
      }
      # Now we can determine value_style based on a) whether we grabbed more
      # than one value, and b) what value_style(s) were in the spec.
      if($count > 1) {
        $ret->_add_value_style($flag, VS_DELIMLIST);
      }
      else {
        # Only VS_SINGLEVAL if that's in the mask
        $ret->_add_value_style($flag, ($vs & VS_SINGLEVAL)?VS_SINGLEVAL:VS_DELIMLIST);
      }
      next CLUSTER; # redundant, for now
    } # CLUSTERCHAR
  } # CLUSTER
  # Enforce a call to initIterator() before the first next().
  undef $ret->{_current};
  return $ret;
} # getopts()

=item $opts->exists(FLAG)

Boolean method returning true if FLAG was found on the command line.  If the
flag was in the specification passed to getopts, but not found on the command
line, zero is returned.  If the flag was NOT in the specification (or if a
non-fatal internal error occurs), undef is returned.

=cut

# This implementation happens to be identical to value_styles() - we take
# advantage of the fact that a positive value_styles means this flag was seen.
# Since it's a two-liner, I'm inlining it here rather than suffering another
# call stack.
sub exists {
  my($self, $flag) = @_;
  # Note that this may autovivify $self->{$flag} for non-specified flags.  I
  # don't think that's a problem unless we start relying on the exists()
  # builtin.
  return $self->{$flag}->[0];
} # exists()

=item @list = $opts->flagList()

Returns a (possibly empty) list of all unique flag *letters* (i.e. no prefixes)
found on the command line, in no particular order.

=cut

sub flagList {
  my $self = shift;
  no bytes; # Ensure we're getting one-CHARACTER entries
  return grep((length($_) == 1) && $self->exists($_), keys(%$self));
} # flagList()

=item $opts->initIterator(FLAG)

Initializes the internal iterator to point to the first instance of FLAG.  Use
before iterating with next() - see that method for usage examples.  Returns
true if FLAG was found on the command line, false otherwise: If FLAG was in the
specification passed to getopts(), but not found on the command line, zero is
returned.  If FLAG was NOT in the specification, undef is returned.

=cut

sub initIterator {
  my($self, $flag) = @_;
  unless(my $tmp = $self->exists($flag)) {
    return $tmp; # undef or zero
  }
  $self->{_current} = $self->{$flag};
  $self->{_iterator} = 1; # Point to the number of argless instances first
  return 1;
} # initIterator()

=item $items = $opts->next()

Returns the next value of the flag provided to the previous successful
initIterator() call.  The first value returned is ALWAYS an integer - possibly
zero - representing the number of argument-less instances of this flag that were
supplied on the command line, regardless of whether the input specification for
that flag included a value_style of VS_ONOFF.  Thereafter, instances are
returned in command-line order, irrespective of value_style.  The value_style of
the item returned can be determined with the aid of the ref() builtin (see
example below).  When no more instances exist, undef is returned.  Example:

  unless($opts->initIterator('a')) {
    die("The -a flag is required.\n");
  }
  $items = $opts->next();
  print("The -a flag was found $items times without arguments.\n");
  while(defined($items = $opts->next())) {
    if(ref($items) eq 'HASH') {
      # This flag instance matched VS_ATTRVAL - the hash reference contains the
      # key/value pairs for this instance.
      while(my($key, $value) = each(%$items)) { ... }
    }
    elsif(ref($items) eq 'ARRAY') {
      # This flag instance matched VS_SINGLEVAL or VS_DELIMLIST - the list
      # reference contains the values (possibly only one) in order.
      for my $value (@$items) { ... }
    }
  }

Note that VS_SINGLEVAL and VS_DELIMLIST are treated the same, both returning an
array reference.  VS_SINGLEVAL simply assures that the referenced array will
contain only one value.

=cut

sub next {
  my $self = shift;
  # _iterator will always be positive, since the first 'value' is the second
  # array entry
  unless(defined($self->{_current}) && $self->{_iterator}) {
    return undef;
    # This may be a little harsh:
    # _fatal('next() called without initIterator()');
  }
  # Don't bother checking for (or stopping at) the end case - we'll keep happily
  # returning undef if they keep calling next().
  return $self->{_current}->[$self->{_iterator}++];
} # next()

=item $opts->singleval(FLAG)

Convenience method for retrieving the single argument to flags specified as:

  {
    value_style => VS_SINGLEVAL,
    allow_multiple => 0
  }

Returns undef if no such argument exists in the object for the given flag.  If
the flag was not in the specification object, a message is also printed.
Otherwise, returns the single, scalar argument specified to the given flag.

=cut

sub singleval {
  my($self, $flag) = @_;
  unless(my $tmp = $self->exists($flag)) {
    unless(defined($tmp)) {
      _err(EINVAL, "Option -$flag not in the getopts() specification.");
    }
    return undef;
  }
  # This works whether VS_SINGLEVAL wasn't in the spec, or the flag simply
  # wasn't used that way on the command line.
  return undef unless $self->value_styles($flag) == VS_SINGLEVAL;
  # Note that the following does not guarantee that allow_multiple was 0.  We
  # actually have no way of doing that, since we didn't store that aspect of the
  # spec data.
  return undef unless scalar(@{$self->{$flag}} == 3);
  return $self->{$flag}->[2]->[0];
} # singleval()

=item $mask = $opts->value_styles(FLAG)

Returns an integer containing all the value_style bits matched for the given
FLAG.  This is guaranteed to be a subset of the value_style specified to the
getopts() constructor for that flag.  Returns undef if FLAG was not specified to
the getopts() constructor.

=cut

sub value_styles {
  my($self, $flag) = @_;
  # The value_style mask is the first item in the iteration array.  We want to
  # return undef for flags we weren't expecting, but zero for flags we could
  # have gotten but didn't.  If the flag's entry doesn't exist, this will return
  # undef.  If it was initialized, but the flag was never found, it will be
  # zero.  Otherwise, it will be a mask of all the value_styles encountered for
  # that flag.
  # Note that this may autovivify $self->{$flag} for non-specified flags.  I
  # don't think that's a problem unless we start relying on the exists()
  # builtin.
  return $self->{$flag}->[0];
} # value_styles()

=back

=cut

##############################
##############################
#### PRIVATE METHODS/SUBS ####
##############################
##############################

#######################
# METHOD _add_ATTRVAL #
#######################
#
# USAGE
# $obj->_add_ATTRVAL(KEY, VALUE, SPEC)
#
# Adds a key/value pair to the currently-bookmarked HASH.  Note the absence of a
# flag in the call - the internal _current pointer MUST have been set up by a
# call to the _new_HASH() method; otherwise this method will die().
#
# RETURN: If the specified key already exists, emits a warning and returns
# false.  Otherwise, returns true.
##################################
sub _add_ATTRVAL {
  my($self, $key, $val, $spec) = @_;
  unless(defined($self->{_current})) {
    _fatal("Internal error - _add_ATTRVAL() called without _new_HASH().");
  }
  unless(ref($self->{_current}) eq 'HASH') {
    _fatal("Internal error - _add_ATTRVAL() called with a bad _current.");
  }
  if(exists($self->{_current}->{$key})) {
    _err(EEXIST, 'Only one %1$s attribute may be specified per option.', $key);
    return undef;
  }
  if(exists($spec->{_attrval_key_callback})) {
    defined($key = $spec->{_attrval_key_callback}->($key)) or return undef;
  }
  if(exists($spec->{_attrval_value_callback})) {
    defined($val = $spec->{_attrval_value_callback}->($val)) or return undef;
  }
  $self->{_current}->{$key} = $val;
  return 1;
}

#######################
# METHOD _add_LISTVAL #
#######################
#
# USAGE
# $obj->_add_LISTVAL(VALUE)
#
# Adds a value to the currently-bookmarked LIST.  Note the absence of a flag in
# the call - the internal _current pointer MUST have been set up by a call to
# the _new_LIST() method; otherwise this method will die().
#
# RETURN: On non-fatal failure, emits a warning and returns false.  Otherwise,
# returns true.  (Currently no non-fatal error conditions.)
##################################
sub _add_LISTVAL {
  my($self, $val) = @_;
  unless(defined($self->{_current})) {
    _fatal("Internal error - _add_LISTVAL() called without _new_LIST().");
  }
  unless(ref($self->{_current}) eq 'ARRAY') {
    _fatal("Internal error - _add_LISTVAL() called with a bad _current.");
  }
  push(@{$self->{_current}}, $val);
  return 1;
}

#####################
# METHOD _add_ONOFF #
#####################
#
# USAGE
# $obj->_add_ONOFF(FLAG)
#
# Adds a boolean instance of FLAG to the object.  Does no checking.
#
# RETURN: The new value (i.e. total number of boolean instances) for this flag
# (which is guaranteed to evaluate to true).  On failure, emits a warning and
# returns false.  (Currently no failure conditions.)
##################################
sub _add_ONOFF {
  my($self, $flag) = @_;
  # The value_style mask is the first item in the iteration array.
  $self->{$flag}->[0] |= VS_ONOFF;
  # The ONOFF count is the second item in the iteration array.
  return ++$self->{$flag}->[1];
}

###########################
# METHOD _add_value_style #
###########################
#
# USAGE
# $obj->_add_value_style(FLAG, VS)
#
# Masks VS onto FLAG's value_styles record.
#
# No return value.
##################################
sub _add_value_style {
  my($self, $flag, $vs) = @_;
  # The value_style mask is the first item in the iteration array.
  $self->{$flag}->[0] |= $vs;
}

#################
# FUNCTION _err #
#################
#
# USAGE
# _err(errno, msgformat [, arg ...])
#
# Prints the error message specified by the msgformat parameter and any trailing
# arguments (in printf() style) to stderr.  Sets $! to errno.
#
# No return value.
#
# FIXME: Internationalize based on the message string.  Or come up with a
# macro'd system.
##################################
sub _err {
  $! = shift;
  my $fmt = shift;
  # Ensure exactly one newline at the end.
  # FIXME: More control via $/ and/or $\ ?
  1 while chomp $fmt;
  $fmt .= "\n";
  printf(STDERR $fmt, @_);
}

###################
# FUNCTION _fatal #
###################
#
# USAGE
# _fatal(MSG)
#
# Prints the error message specified by the MSG to stderr with a stack trace,
# and then dies.
#
# This function does not return.
##################################
sub _fatal {
  require Carp;
  Carp::confess(shift);
  # Not reached
}

#######################
# METHOD _init_flag   #
#######################
#
# USAGE
# $obj->_init_flag(FLAG)
#
# Initializes the internal data structure for FLAG, if it's not already
# initialized.
#
# No return.
##################################
sub _init_flag {
  my($self, $flag) = @_;
  # Initialize the iteration structure
  unless(exists($self->{$flag}) && (ref($self->{$flag}) eq 'ARRAY')) {
    $self->{$flag} = [0, 0];
  }
}

#######################
# METHOD _new_current #
#######################
#
# USAGE
# $obj->_new_current(KEY, FLAG, REF)
#
# Creates a new REF-type entry in the KEY slot for FLAG.  (Helper method for
# _new_HASH and _new_LIST methods.)
#
# No return.
##################################
sub _new_current {
  my($self, $type, $flag, $ref) = @_;
  $self->{_current} = $ref;
  # Add it to the iteration structure
  push(@{$self->{$flag}}, $self->{_current});
  # Initialize the by-type structure
  unless(exists($self->{$type}->{$flag})) {
    $self->{$type}->{$flag} = [];
  }
  # Add it to the by-type structure
  push(@{$self->{$type}->{$flag}}, $self->{_current});
}

####################
# METHOD _new_HASH #
####################
#
# USAGE
# $obj->_new_HASH(FLAG)
#
# Creates a new, empty hash-type entry for FLAG and sets the internal _current
# pointer to it.  You must use this method to initialize a hash-type entry
# before values may be added to it via the _add_ATTRVAL() method.
#
# Also registers VS_ATTRVAL in this flag's value_styles.
#
# No return value.
#
# $obj: {
#   ...
#   ATTRVAL => { FLAG => [ {...},
#                          {}  # The new entry, to which _current will point
#                        ]
#           }
#   ...
# }
##################################
sub _new_HASH {
  my($self, $flag) = @_;
  $self->_new_current('ATTRVAL', $flag, {});
  $self->_add_value_style($flag, VS_ATTRVAL);
}

####################
# METHOD _new_LIST #
####################
#
# USAGE
# $obj->_new_LIST(FLAG [, VS])
#
# Creates a new, empty list-type entry for FLAG and sets the internal _current
# pointer to it.  You must use this method to initialize a list-type entry
# before values may be added to it via the _add_LISTVAL() method.  The LIST type
# should be used to record VS_SINGLEVAL *and* VS_DELIMLIST value_styles; you may
# optionally pass that value_style in as the second argument to register it with
# this flag's value_style mask.
#
# No return value.
#
# $obj: {
#   ...
#   LIST => { FLAG => [ [...],
#                       []  # The new entry, to which _current will point
#                     ]
#           }
#   ...
# }
##################################
sub _new_LIST {
  my($self, $flag, $vs) = @_;
  $self->_new_current('LIST', $flag, []);
  if($vs) {
    $self->_add_value_style($flag, $vs);
  }
}

=head1 RESTRICTIONS/LIMITATIONS/CAVEATS

=over 4

=item *

Only flag letters from the printable range (except the space character) of the
default (C) collating sequence are officially supported.  These are '!' (0x21)
through '~' (0x7E).  The '-' (minus) flag is only supported as the special
"end-of-options" separator '--'.  Other flag letters may work, but attempt at
your own risk.

=item *

You may specify multiple possibilities for the argument style of a flag.
However, if a flag is listed as boolean (no-arg) in combination with any other
style, a flag cluster may be interpreted as a flag with an argument, even if the
style of that argument is not one of those listed.  For example, if -a has
value_style VS_ONOFF|VS_ATTRVAL and getopts() sees '-abc' on the command line,
it MAY be seen the same as '-a bc', which would cause a failure.

The best practice is to avoid syntaxes where a flag can be either boolean or
not.  Failing that, it may be necessary to require whitespace between such flags
and their arguments.  In any case, thorough testing of how your particular
program accepts clustered flags and/or conjoined flag arguments is strongly
recommended.

=item *

Command-line order is preserved in the following two fashions ONLY:

=over 4

=item *

When multiple instances of the SAME flag are specified.  For example:

  -a foo -a bar

...is distinguishable from:

  -a bar -a foo

=item *

WITHIN a list of values.  For example:

  -a foo,bar,baz

...is distinguishable from:

  -a bar,baz,foo

=back

Notably, order is NOT preserved in the following cases:

=over 4

=item *

-a -b is indistinguishable from -b -a

=item *

-a foo=one bar=two is indistinguishable from -a bar=two foo=one

=back

=item *

Quoting/escaping is supported BY YOUR SHELL to preserve whitespace within values
(assuming the _list_delim doesn't also match whitespace).  For example:

=over 4

=item *

-a val1,'value with spaces',val3

=item *

-a foo=value\ with\ spaces

=back

=item *

Beware when using whitespace as the list delimiter.  Avoid ambiguity between a
flag with a single value versus a flag with a quoted list of values (e.g. -a
'one two three').

=item *

There is no way to escape or quote a list delimiter within a list value.
Notably, this kind of thing doesn't work:

  -a foo,bar\,stool,baz

This will give:

  ['foo', 'bar\', 'stool', 'baz']

and NOT:

  ['foo', 'bar,stool', 'baz']

=item *

Beware when extra non-option arguments on the command line may contain the
key/value delimiter.  For example:

  -a key1=val2 arg1=val3

arg1=val3 will always be parsed as a key/value pair belonging to -a

=back

=cut

1;