# -*- Perl -*-
#
# File:  PTools/Options.pm
# Desc:  A generic class to parse command-line options
# Date:  Wed Aug  5 15:31:56 1998
# Mods:  Thu Aug 11 14:24:13 2005
# Lang:  Perl
# Stat:  Production
#
# Note:  Synopsis and examples located after the end of this module.
#

package PTools::Options;
use strict;

my $PACK = __PACKAGE__;
use vars qw( $VERSION @ISA $AUTOLOAD );
$VERSION = '0.15';
@ISA     = qw( );

use Getopt::Long 2.17;                          # use 2.17 or later for -vvv
BEGIN { Getopt::Long::Configure("bundling") }   # enable "bundling" for -vvv

# Note: Can add any "Getopt::Long::Configure" options after
# using this module. For example
#
#   use PTools::Options;
#   Getopt::Long::Configure qw( no_ignore_case no_bundling );

my($ErrorStr, $PriorSigWarn) = ("","");

sub reset  { delete $_[0]->{$_[1]} if ($_[1] and defined $_[0]->{$_[1]}) }
sub set    { $_[0]->{$_[1]}=$_[2]        }    # Note that the 'param' method
sub get    { return($_[0]->{$_[1]})      }    #    combines 'set' and 'get'
sub param  { $_[2] ?$_[0]->{$_[1]}=$_[2] : return( $_[0]->{$_[1]})       }
sub setErr { return($_[0]->{_STATUS}=$_[1]||0, $_[0]->{_ERROR}=$_[2]||"" ) }
sub status { return($_[0]->{_STATUS}||0, $_[0]->{_ERROR}||"" )             }
sub stat   { ( wantarray ? ($_[0]->{_ERROR}||"") : ($_[0]->{_STATUS} ||0) ) }
sub err    { return($_[0]->{_ERROR}   ||"") }
sub usage  { return($_[0]->{_USAGE}  ||"") }  # $usage   passed to 'new'
sub optArgs{ return($_[0]->{_OPTARGS}||"") }  # @optArgs passed to 'new'
sub opts   { return($_[0]->{_OPTS}   ||"") }  # options entered on cmd-line

sub args       # _ARGV contains any remaining @ARGV parameters after parsing
{
    return( $_[0]->{_ARGV} ||[] ) unless (wantarray);    # return reference
    return( @{ ($_[0]->{_ARGV} ||[]) } );                # return a list
}

*configure    = \&config;
*getGetoptErr = \&parseErr;
*resetArgs    = \&setArgs;

sub config   { shift; Getopt::Long::Configure( @_ ) }
sub setUsage { $_[0]->{_USAGE} = ($_[1] ||"")       }
sub parseErr { $ErrorStr .= $_[0]                   }  # sig handler callback
sub setArgs  { $_[0]->{_ARGV}  =  $_[1]             }  # reset parsed arg list

sub new {
    my($class,$usage,@optArgs) = @_;

    bless my $self = {}, ref($class)||$class;

    $self->parse( $usage, @optArgs )  if ($usage and @optArgs);

    return( $self ) unless wantarray;
    return( $self, $self->{'_STATUS'}, $self->{'_ERROR'} );
}

sub parse
{   my($self,$usage,@optArgs) = @_;

    #________________________________________
    # Parse options (see the Getopt::Long man page)
    #
    my(@opts);

    $PriorSigWarn  = $SIG{__WARN__};
    $SIG{__WARN__} = \&getGetoptErr;           # When invalid options detected

    if ( GetOptions($self, @optArgs) ) {       # Parse command-line arguments
	(@opts) = sort keys %$self;            # (collect before call to setErr)
	$self->setErr(0,"");
    } else {                                   # Oops: errors detected
	(@opts) = sort keys %$self;            # (collect before call to setErr)
	$self->setErr(-1, $ErrorStr);
    }
    $SIG{__WARN__} = $PriorSigWarn;            # Reset to prior value

    $self->set('_USAGE',   $usage    );           # passed in to this method
    $self->set('_OPTARGS', \@optArgs );           # passed in to this method
    $self->set('_OPTS',    \@opts    );           # passed on cmd-line
    $self->set('_ARGV',    \@ARGV    ) if @ARGV;  # remaining cmd-line args,
						  #  if any, after GetOptions
    return;
}

*abortWithHelp = \&abortWithUsage;
*exitWithHelp  = \&exitWithUsage;

sub abortWithUsage { $_[0]->exitWithUsage($_[1],$_[2],($_[3] ||1) ) }

sub exitWithUsage
{   my($self,$usage,$fd,$exit) = @_;

    $usage ||= $self->formatUsage;
    $fd    ||= *STDERR;
    $exit  ||= 0;

    print $fd $usage if defined $usage;

    exit($exit);
}

sub abortOnError
{   my($self,$message,$fd) = @_;

    my($stat,$err) = $self->status;

    return unless $stat;

    $fd ||= *STDERR;

    # If this seems cumbersome, it's because we want to give
    # the user control over what gets printed in the abort,
    # AND provide a good default when no message is provided.
    #
    # If no $message was passed then we 1) format a message string
    # based on the original usage string passed to the 'new' method,
    # and 2) print the $err string which is either a) the text
    # collected via the "getGetoptErr" callback, OR b) it might be 
    # user-defined via the "setErr" method.
    #
    # See the Synopsis section, below, for some examples.

    if (! defined $message) {

	$message = $self->formatUsage;

	# Here, by DEFAULT, the "$err" string will be the parsing 
	# error(s), if any, generated by the GetOptions function
	# (defined in the Getopt::Long class).
	#
	# However, if the invoking script/module called the "setErr" 
	# method with a message string AFTER calling the 'new' method 
	# but BEFORE calling this method, we get that message instead.
	#
	# Either way, if this method called with a non-null "message"
	# skip printing the "$err" string and ONLY print the "message"
	# EVEN if the message param was an empty string.

	print $fd $err if $err;    # Note: if ($err and ! defined $usage)
    }
    print $fd $message if defined $message;

    # We generally don't want to print line number or stack trace
    # information here as this is a standard "usage error" abort.
    # Terminate the currently running script with a non-zero exit.

    exit($stat);
}

sub formatUsage
{   my($self,$usage) = @_;

    # Add a little formatting to the original usage text
    # UNLESS it already appears formatted.

    $usage ||= $self->usage;

    return( undef         )  unless defined $usage;
    return( $usage        )  if ($usage =~ "\n");
    return("\n $usage\n\n"); 
}

#-----------------------------------------------------------------------
# Here we create a "method factory" so this class can automatically
# and dynamically create accessor methods for any arbitrary attribute 
# name. Using this, the following two methods are equivalent.
#
#   $opts->get('verbose') and print "The 'verbose' option was used\n";
#
#   $opts->verbose()      and print "The 'verbose' option was used\n";
#
# Upon first call to the "verbose" method, which does not yet exist,
# the AUTOLOAD method will create the "verbose" method. Subsequent
# calls to the "verbose" method will invoke the method directly.
#
# In addition to the above usage, we can define the "method factory" 
# in such a way that a parameter passed to an "automatic accessor" 
# method will be used as the initial value for the named attribute. 
# This is a bit obscure at first glance, but it is an interesting 
# feature of the AUTOLOADER. Consider, for example, the following.
#
#   $opts->verbose("true");
#
# If a "verbose" method does NOT yet exist:
# .  the new method is created
# .  the new attribute is created
# .  the new attribute is set to the given value
#
# If a "verbose" method DOES already exist:
# .  the named attribute is set to the given value
# 
# A strange but interesting set of events that works very nicely.

sub DESTROY { }    # prevent AUTOLOAD from creating DESTROY method.

sub AUTOLOAD
{   my($self,$initValue) = @_;

    my $sub = $AUTOLOAD;
    my($attribute) = $sub =~ m/.*::(.*)/;

    # If an "$initValue" was passed to the as-yet undefined
    # method, the method is created in this next block. And
    # then, in the "goto &$sub" step, the "$initValue" is
    # passed on to the newly created method as "$value".
    # Rather obscure, but Perl-ishly cool.

    { no strict "refs";
      *$sub = sub { my($self,$value) = @_;
		    return $self->{$attribute} = $value
			if (defined($value));
		    $value = $self->{$attribute};
		    return undef  unless defined $value;
		    return 0      if (length($value) and ! $value);
		    return $value;
		  };
    }
    goto &$sub;
}
#-----------------------------------------------------------------------

#sub dump
#{   my($self,$verbose) = @_;
#
#    my($text)= "DEBUG: ($PACK) self='$self'\n";
#    my($pack,$file,$line)=caller();
#    $text .= "CALLER $pack at line $line\n($file)\n";
#    foreach (sort keys %$self) {
#	if ( $_ =~ /_USAGE|_ARGV|_OPTS/ ) {
#	    next unless $verbose;
#	}
#	$text .= " $_ = $self->{$_}\n";
#    }
#    $text .= "____________\n";
#    return($text);
#}
#-----------------------------------------------------------------------

my $defaultMaxDepth = 5;

sub dump
{   my($self,$expandRefs,$maxDepth,$curDepth) = @_;
    $expandRefs ||= "";
    $maxDepth   ||= $defaultMaxDepth;
    $curDepth   ||= 0;

    my $notExpandedNote = "--No expansion: max depth of $maxDepth exceeded--\n";
    my $text = "";

    $text .= "-" x 25 ."\n";
    $text .= "DEBUG: ($PACK\:\:dump)\n  self='$self'\n";

    if ($curDepth == 0) {
	my($pack,$file,$line)=caller();
	$text .= "CALLER $pack at line $line\n($file)\n";
    } elsif ($curDepth > $maxDepth) {
	$text .= $notExpandedNote;
	return $text;
    }

    foreach my $param (sort keys %$self) {
	next unless defined $self->{$param};

	if ( $param =~ /^(_USAGE|_OPTS|_OPTARGS)$/ ) {
	    next unless ($expandRefs =~ /all/i);
	}
	$text .= " $param = $self->{$param}\n";

	# Optional reference expansion
	#
	if ( ref($self->{$param}) and ($expandRefs =~ /expand/i) ) { 
	    my $val = $self->{$param};

	    ref($val) and $text .= 
		$self->_expandRef($val,$expandRefs,$maxDepth,$curDepth +1);
	}
    }
    $text .= "-" x 25 ."\n";

    return($text);
}

sub _expandRef
{   my($self,$ref,$expandRefs,$maxDepth,$curDepth) = @_;
    $expandRefs ||= "";
    $maxDepth   ||= $defaultMaxDepth;
    $curDepth   ||= 0;

    #
    # NOTE the funky recursion here ... sometimes we call this
    # subroutine from below and sometimes we call "dump" which
    # may well end up right back here again. When making mods,
    # be sure to retain "$maxDepth" and "$curDepth" correctly.
    #

    my $notExpandedNote = "--No expansion: max depth of $maxDepth exceeded--\n";
    my $val     = "";
    my $subText = "";

    # prevent infinite recursion ...
    return $notExpandedNote if $curDepth > $maxDepth;

    if (ref($ref) eq "ARRAY") {
	foreach ( 0..$#{ $ref } ) { 
	    $subText .= "  [$_] ${$ref}[$_]\n"; 
	    $val   = ${$ref}[$_]; 
	    ref($val) and 
		$subText .= 
		    $self->_expandRef($val,$expandRefs,$maxDepth,$curDepth +1);
	}

    } elsif (ref($ref) eq "HASH") {
	foreach (sort keys %$ref) {
	    $subText .= "  {$_} => $ref->{$_}\n"; 
	    $val   = $ref->{$_}; 
	    ref($val) and 
		$subText .= 
		    $self->_expandRef($val,$expandRefs,$maxDepth,$curDepth +1);
	}

    } elsif (ref($ref) eq "CODE") {
	$subText .= "--No expansion: code reference ignored--\n";

    } elsif (ref($ref) eq "SCALAR") {
	$subText .= "  = $$ref\n";     # Dreference the scalar

    # Optional sub-object expansion. Don't just ass*u*me that
    # it's an object that inherits from this base class ...
    #
    } elsif ($expandRefs eq "objects" and $ref->can("dump")) {

 	if ($ref->isa($PACK)) {        # USE CUR DEPTH HERE:
 	    $subText .= $ref->dump($expandRefs,$maxDepth,$curDepth );  ## +1);
 	} else {
 	    $subText .= $ref->dump;    # WARN: this could add a lot of text.
 	}
    }

    if ($subText) {
	return( "\n--EXPAND: Depth $curDepth -- $ref --\n"
	      . $subText 
	      . "--RETURN: Depth $curDepth -- $ref --\n\n" );

    } else {
	return "";
    }
}
#_________________________
1; # Required by require()

__END__

=head1 NAME

PTools::Options - A simple OO interface to Getopt::Long

=head1 VERSION

This document describes version 0.15, released August, 2005.

=head1 SYNOPSIS

 use PTools::Options;

 $usage   = "Usage: $0 [-h] [-v[v...]]";   # define usage "help text"
 @optArgs = qw( help|h verbose|v+ );       # define valid options

 $opts = new PTools::Options( $usage, @optArgs );  # parse @ARGV list
 $opts = new PTools::Options();                    # delay parsing @ARGV

 $opts->configure( @getopt_configs );      # configure Getopt::Long 
 $opts->config   ( @getopt_configs );      # configure Getopt::Long 

 $opts->parse( $usage, @optArgs );         # parse @ARGV after 'configure'

 $opts->set('attribute', $newValue);       # set attribute to a new value
 $opts->attribute($newValue);              # "automatic accessor" method

 $value = $opts->get('attribute');         # get current value for attribute
 $value = $opts->attribute;                # "automatic accessor" method

 $opts->reset('attribute');                # remove/undefine the attribute

 $usage   = $opts->usage;                  # get value passed to 'new' method
 $optArgs = $opts->optArgs;                # get args passed to 'new' method

 $optRef  = $opts->opts;                   # get user entered cmd-line options 

 $argRef  = $opts->args;                   # get user entered cmd-line arguments
 (@args)  = $opts->args;                   # 'ref' or list, depending on context
 $arg0    = $opts->args->[0];              # 0th command line argument
 $arg1    = $opts->args->[1];              # 1st command line argument, etc...

 $opts->resetArgs( $argRef );              # reset list of user entered args
 $opts->resetArgs( \@args  );              # reset list of user entered args

 $opts->abortOnError;                      # abort with "$usage" if parse err(s)

 $opts->abortWithHelp   if ( ... );        # abort with "$usage" if (whatever)
 $opts->abortWithUsage  if ( ... );        # abort with "$usage" if (whatever)

 $opts->exitWithHelp    if $opts->help;    # exit gracefully w/ '-h' (--help)
 $opts->exitWithUsage   if $opts->help;    # exit gracefully w/ '-h' (--help)

 print $opts->dump;                        # useful when testing/debugging


=head1 DESCRIPTION

This is a generic class that can be used by any application module or
script to define and then validate command-line options. It is a simple
wrapper for Perl's B<Getopt::Long> class (the B<GetOptions> function).

Judging from the above Synopsis it may not seem that this is a I<simple>
interface to the Getopt::Long class. However, the following complete 
example is pretty simple.

 use PTools::Options;

 $usage = "Usage: $0 [-h] [-D [n]] [-v[...]] filename";

 @optArgs = qw( Debug|D:i help|h verbose|v+ );

 $opts = new PTools::Options( $usage, @optArgs );

 $opts->abortOnError;
 $opts->exitWithUsage  if $opts->help;

 $filename = $opts->args->[0];

 $opts->abortWithUsage  unless $filename;


=head2 Constructor

=over 4

=item new ( [ Usage, OptArgs ] )

The B<new> method is used to both define and validate user entered
command line options. 

=over 4

=item Usage

A text string describing the usage of a given module or script.

=item OptArgs

A list of B<Getopt::Long> options that is used to validate
any command line options entered by a user.

See the L<Synopsis|"SYNOPSIS"> and L<Description|"DESCRIPTION"> sections,
above, and the L<Examples|"EXAMPLES"> section, below, for examples. 
See L<Getopt::Long> for a complete description of the option definitions 
that can be passed in the B<OptArgs> list.

=back

To delay option parsing, for example when configuration is needed prior 
to invoking the parse, pass an empty parameter list.

=back


=head2 Methods

=over 4

=item config ( Arg [, Arg ... ] )

=item configure ( Arg [, Arg ... ] )

The configure (or B<config>) method is used to configure the
underlying B<Getopt::Long> class prior to actually parsing 
command-line options.

See the L<Examples|"EXAMPLES"> section, below, for an example. 
See L<Getopt::Long> for a full discussion of the available 
configuration directives.


=item parse ( Usage, OptArgs )

The B<parse> method is available when configuration is needed
prior to actually parsing command line optoins. Arguments for
this method are the same as for the 'L<new|new>' method, above

See the L<Examples|"EXAMPLES"> section, below, for an example.


=item resetArgs ( ListRef )

=item setArgs ( ListRef )

It is sometimes handy, within a script, to turn 'arguments' into 'options',
which will simplify access to the data later in the script. In these cases, 
this method is provided to reset the argument list after removing any 
extraneous values. 

See the L<Examples|"EXAMPLES"> section, below, for an example.


=item reset ( Attribute )

Remove (undefine) an attribute contained in an object of this class.


=item get ( Attribute )

=item set ( Attribute, NewValue )

B<Fetch> or B<set> an attribute value in an object of this class. 

=over 4

=item Attribute

Specify the attribute name to access within the B<$opts> object.

=item Value

Used with the B<set> method, set the named B<attribute> to a B<NewValue>.

=back

Examples:

 $currentValue = $opts->get( 'attribute' );

 $opts->set( 'attribute', "new value" );

Also see the L<Automatic Accessor Methods|"Automatic Accessor Methods">
section, below, to obtain the value of an attribute using the atribute's
name as an accessor method.


=item usage

The B<usage> method returns the same B<Usage> string
passed to the L<new|new> method as described above.

=item optArgs

The B<optArgs> method returns a reference to the list of B<OptArgs> 
passed to the L<new|new> method as described above.

=item opts

The B<opts> method returns a reference to a list of any option flags 
and/or values entered on the command line by the user.

=item args

The B<args> method returns a reference to a list of any additional 
command-line arguments entered on the command line by the user. The
return value with be either a 'list' or a 'list reference' depending
upon the calling context.

 $argRef    = $opts->args;       # returns a 'list ref'
 (@argList) = $opts->args;       # returns a 'list'

 $arg0 = $argRef->[0];
 $arg1 = $argRef->[1];

For ensuring required arguments are entered, see the L<abortWithUsage>
method, below.

=item status

=item stat

=item err

Collect the status code and/or error string returned by the 'GetOptions'
function of the Getopt::Long class. Also see the L<setErr> method.

 ($stat,$err) = $opts->status;

 $stat  = $opts->stat;       # status number returned in scalar context 
 ($err) = $opts->stat;       # error message returned in array context 

 ($err) = $opts->err;

 $stat and die "$err\n\n". $opts->usage ."\n\n";


=item setErr ( Status [, Text ] )

This method can be used to override the values returned by the 'GetOptions'
function of the Getopt::Long class. This is useful when crafting a custom
error message for use by the L<abortOnError|abortOnError> method.

=over 4

=item Status

This parameter is expected to be a non-zero integer value.

=item Text

This parameter is expected to be a text string.

=back


=item exitWithUsage ( [ Usage ] [, FD ] [, ExitStatus ] )

=item abortWithUsage ( [ Usage ] [, FD ] [, ExitStatus ] )

Since exiting with a B<Usage> message is such a common occurrance,
these methods are provided to simplify the process. 

=over 4

=item Usage

If no B<Usage> string is passed, the default is to use the original
value passed to the L<new|new> method. If the original value does
not already contain I<newline> characters, a little formatting is done 
to the original value, adding some I<newline> characters. However, no
additional formatting is done if a B<Usage> string is passed.

If a null value is passed (that is not I<undef>), no usage text will 
be printed and the currently running script will terminate with an
exit value of zero.

=item FD

If no B<FileDescriptor> is passed, the default of B<*STDERR> is used.

=item ExitStatus

For a simple exit the default B<ExitStatus> is B<0>, and for an abort
the default is B<1>.

=back

Exit example (this example assumes usage as shown in the L<Synopsis|"SYNOPSIS">
section, above). This terminates a script with a value of B<zero> by default.

 $opts->exitWithUsage  if $opts->help;

Abort example, when two command-line arguments are required in a calling
script. This terminates a script with a value of B<one> by default.

 ($arg0, $arg1) = ( $opts->args->[0],  $opts->args->[1] );

 $opts->abortWithUsage unless ($arg0 and $arg1);


=item abortOnError ( [ Message ] [, FD ] )

As an alternative to the exit/abort examples, shown just above, the
B<abortOnError> method provides several possible ways to generate an
abort message.

B<Note>: this method will return without taking any action unless
the current value of the B<status> attribute is non-zero.

The simplest way to use this method is with no arguments. A reasonably
good default message is printed on STDERR, and this module terminates
the currently running script with an exit value equal to the current
value of the B<status> value (which is -1 by default).

Objects of this class will trap any B<warning> messages emitted
during the parsing by I<GetOptions> (normally, these are warnings are
displayed on STDERR by the B<Getopt::Long> class). If command-line
parsing error(s) occur, the result(s) will be available via the 
L<stat|stat> or L<status|status> methods.

The B<warning> text generated by the I<GetOptions> parsing will only be
displayed by this B<abortOnError> method when the B<Usage> argument is 
B<undefined>. Otherwise, it is assumed that the user of this module 
wants to display a custom error messgae (which may or may not include 
any I<GetOptions> warning text).

This method will call B<exit> using the current value of the
B<status> attribute. This will be B<-1> unless the L<setErr|setErr>
method was used to define an alternate value.

=over 4

=item Message

If no B<Message> string is passed, the default is to use the original
value passed to the L<new|new> method. If the original value does
not already contain I<newline> characters, a little formatting is done 
to the original value, adding some I<newline> characters. However, no
additional formatting is done if a B<Message> string is passed.

If a null value is passed (that is not I<undef>), no error text will 
be printed and the currently running script will terminate with the
current value of the B<status> attribute.

=item FD

If no B<FileDescriptor> is passed, the default of B<*STDERR> is used.

=back

Examples:

 $opts = new PTools::Options( $usage, @optArgs );

 $opts->abortOnError;
 $opts->abortOnError("");
 $opts->abortOnError("\n A custom error message\n\n");

 $opts->setErr(-2, "\n Another custom error message\n\n");
 $opts->abortOnError;


Calling the L<setErr|setErr> method can be used to override the 
default B<error> attribute.

B<Note>: A I<null> message string will I<suppress> printing the
current value of the B<error> attribute which, by default, will
contain any B<warning> messages emitted during the call to the
I<GetOptions> function (used internally to parse the command-line
arguments).


=item dump ( [ Mode ] )

Display contents of the current object. This is useful when debugging, 
as the result is functional but not in a 'pretty' format. 

By default, a few of the attributes used internally are not 'dumped'
(these include the 'usage' text, list of 'opts' selected  and 'optArgs'
which are often fairly long and not very useful during debugging). 
If the optional B<Mode> contains the string 'B<all>', all attributes 
are included in the dump output.

In addition, by default, attribute values that are references are
simply shown as the type of reference. If the optional B<Mode> 
contains the string 'B<expand>', reference attributes are expanded 
in the dump output. Note that I<object> references are not expanded.

When used, a B<Mode> of 'expand' can be interesting, but a B<Mode> 
that includes 'all' can quickly become tedious.

Examples:

 die $opts->dump;

 die $opts->dump("all");
 die $opts->dump("expand");
 die $opts->dump("all/expand");

=back


=head2 Automatic Accessor Methods

This class implements Perl's AUTOLOAD feature to allow any calling
module to request an attribute value using any arbitrary attribute
name as a method.

Using the above L<Synopsis|"SYNOPSIS"> as an example, if the module
that invoked this class wishes to determine if the '-h' (--help)
option was used, it could do so as follows.

 if ($opts->help) { ... }

Just remember to use the I<primary> attribute name, as defined by the 
B<Getopt::Long> class, and not an I<alias> name.

In addition, the module or script that invokes this class can use the
L<set> method, described above, to create additional attributes in 
objects of this class. After storing new attribte values into the
object, the attribute name may then be used as a method to return the
attribute's current value. 

The 'automatic accessor' mechanism described here may also be used to set
a value for the named attribute. The following examples are equivalent, 
and both create the new attribute and give it an initial value. These same 
methods can be used at any later point to redefine the value of the named 
attribute.

 $opts->set("Debug", "true");
 $opts->Debug("true");

The value can then be retrieved using the newly created method instead
of using the L<get> method. The following examples are equivalent, 
and both fetch the current value for the named attribute.

 $value = $opts->get("Debug");
 $value = $opts->Debug();

B<Troubleshooting>: If an 'automatic accessor' method does not return a 
value it is either because no attribute with that name currently exists, or
because the attribute does not currently contain a value. If the results 
are not as expected, use the L<dump> method, explained above, to 
see a complete list of the currently defined attributes and their values.

B<Usage Note>: Occasionally attribute names may happen to clash with
existing methods defined in this module. In this case, obviously, the
automatic accessor mechanism will not work with those attributes.
Currently, methods defined in this class include the following and,
when accessing attributes with these names, the L<set> and L<get>
methods must be used.

  abortOnError    exitWithHelp   param      setUsage
  abortWithHelp   exitWithUsage  parse      stat
  abortWithUsage  formatUsage    parseErr   status
  args            get            reset      usage
  config          getGetoptErr   resetArgs  _expandRef
  configure       new            set        AUTOLOAD
  dump            optArgs        setArgs    DESTROY
  err             opts           setErr

B<Performance Note>: Upon first call to an 'automatic accessor' method
this module will create a method of the same name. Subsequent calls
to the accessor method will invoke the method directly, and not through
Perl's AUTOLOAD mechanism.


=head1 EXAMPLES

=head2 Error Handling

As an alternative to the simple abort example shown in the 
L<Synopsis|"SYNOPSIS"> section, the L<abortOnError|abortOnError> method 
provides several possible ways to generate an abort message.

 $opts = new PTools::Options( $usage, @optArgs );

 $opts->abortOnError;
 $opts->abortOnError("");
 $opts->abortOnError("\n Custom error string\n\n");

 $opts->setErr(-2, "\n Another custom error string\n\n");
 $opts->abortOnError;


=head2 Configuring Getopt::Long

By default, this module configures B<Getopt::Long> for the 'B<bundling>'
of options. To disable this, or add any other desired configuration
specifications for the B<Getopt::Long> module, use the following syntax.
Instantiating the object wth an empty argument list will delay parsing
the command line until after the configuration can be accomplished.

 $usage = "Usage: $0 [-h] [-v[...]] filename";       # define usage help

 @optArgs = qw( help|h verbose|v+ );                 # specify valid opts

 $opts = new PTools::Options();                      # delay parsing @ARGV

 $opts->config( "no_bundling", "no_ignore_case" );   # configure the parser

 $opts->parse( $usage, @optArgs );                   # parse the @ARGV list

Specify 'B<no_ignore_case>' if you wish to differentiate upper and lower case 
options for a single character (e.g., '-d <directory>' and '-D [<level>]').
Specify 'B<no_bundling>' if you must still support long options that require
a single dash (e.g., '-help'). This prevents bundling, such as using '-vvv' 
syntax with options that use the '+' specification (e.g, 'verbose|v+').

(As an alternative, specify 'B<bundling_override>' which allows both option
bundling and the use of long options with a single dash. But, before doing
this, read the caveat in L<Getopt::Long> regarding unexpected results when 
bundling options I<especially> when mixed with long options.)

As an alternative mechanism, the 'Getopt::Long::Configure' method may
be called directly. B<Note> that module designers wishing to subclass this 
module can use this syntax to override the default behavior of this class.

 use PTools::Options;
 Getopt::Long::Configure qw( no_permute  no_bundling );

Depending on the application, it may be a good idea to put this in a
BEGIN block.

 use PTools::Options;
 BEGIN { Getopt::Long::Configure( "no_permute", "no_bundling" ) }

See L<Getopt::Long> for additional configuration settings and use with
various environment variables.


=head2 Using With 'PTools::Debug' Class

This module works well with the B<PTools::Debug> module, when used in a manner 
similar to the following example. See L<Debug|Debug> for further details.

 use PTools::Debug;
 use PTools::Options;

 @optArgs = qw( help|h Debug|D:i );

 $usage = "Usage: $basename [-h] [-D [n]]";

 $opts  = new PTools::Options( $usage, @optArgs );

 $opts->abortOnError;
 $opts->exitWithUsage  if $opts->help;

 $debug = new PTools::Debug( $opts->Debug );

 $debug->warn( 0, "Debug output is enabled" );
 $debug->warn( 3, "Debug output at level 3" );


=head2 Using With 'PTools::Verbose' Class

This module works well with the B<PTools::Verbose> module, when used in a 
manner similar to the following example. See L<Verbose> for further details.

 use PTools::Verbose;
 use PTools::Options;

 @optArgs = qw( help|h verbose|v+ );

 $usage = "Usage: $basename [-h] [-v[...]]";

 $opts  = new PTools::Options( $usage, @optArgs );

 $opts->abortOnError;
 $opts->exitWithUsage  if $opts->help;

 $verbose = new PTools::Verbose( $opts->Verbose );

 $verbose->print( 1, "Verbose output is enabled" );
 $verbose->print( 3, "Verbose output at level 3" );


=head2 Flexible Argument Parsing

Sometimes it is handy within a script to turn 'arguments' into 'options' 
which simplifies access to the data later in the script. In these cases, 
flexibility is provided to alter how Getopt::Long parses arguments and to
reset the argument list after removing any extraneous values. 

Consider a situation where we want to collect options and arguments valid 
for an optional arbitrary B<command> that are I<not> valid arguments to 
the script for which we I<are> parsing options. In this example, the lone 
dash ('-') will terminate parsing of the command line. For this to work, 
the 'L<config|config>' method must be used to disable 'I<permuted>' options, 
and the 'L<parse|parse>' method is used to perform the command line parsing.
The following demonstrates command line parsing within a script named 'B<nway>'.

 use PTools::Options;

 $usage = "nway [<options>] filename [ - command [ -arg [...]]]";

 @optArgs = qw( concurrent|c=i  Debug|D:i  help|h  preview|p:i );

 $opts = new PTools::Options();        # create an options parser
 $opts->config( "no_permute" );        # disable 'permuted' options
 $opts->parse( $usage, @optArgs );     # parse the @ARGV list

 $opts->abortOnError;                  # abort if parsing errors occurred
 $opts->exitWithUsage if $opts->help;  # exit gracefully if '-h' was used

 (@args) = $opts->args();              # get all cmd-line args
 $file   = shift @args;                # collect "filename" arg   (required)
 shift @args;                          # strip lone "-" character (if any)
 $cmd    = shift @args;                # collect "command" name   (if any)

 $file  or $opts->abortWithUsage;      # verify the required argument

Okay, at this point, any remaining B<@args> belong to the B<[ -arg [...]]>
argument list that will be passed to the named "command". In this case, we
want to turn the two arguments B<filename> and B<command> into I<options>,
and then reset the B<$opts> argument list.

 $opts->set('filename', $file);        # then access as  $opts->filename
 $opts->set('command',  $cmd);         # then access as  $opts->command

 $opts->resetArgs( \@args );           # then access as  $opts->args

Yes, this is a long way to go for a small example, and it gets a little 
obscure, but it does provide a demonstration of the flexibility available
when using this module.

See L<Getopt::Long> for further details.


=head1 WARNINGS

By default, this module configures B<Getopt::Long> for the 'B<bundling>'
of options. See the L<Configuring Getopt::Long|"Configuring Getopt::Long">
section, above.

This module briefly changes the value of B<$SIG{__WARN__}> (to collect
any error output from the B<GetOptions> method in the B<Getopt::Long> 
class) and then resets this variable to back it's original value.

Also, one problem with auto generating accessor methods is that it's easy 
to make typos in the accessor name (or not notice when the '@optArgs' 
passed by the caller happens to change). In these cases it can be 
helpful to use the L<dump|dump> method, described above, to determine
why no value is returned to the caller for an option that 'obviously' 
should be set.


=head1 DEPENDENCIES

This class depends upon the following class:

 Getopt::Long  version 2.17 or later

=head1 INHERITANCE

None currently.


=head1 SEE ALSO

See L<Getopt::Long> (B<GetOptions> method) for a complete description of
the option definitions that can be passed in the B<OptArgs> list to the 
L<new|new> method of this class. 

See L<Debug> and L<Verbose> for details of a simple implementation of 
'debug' and 'verbose'  output levels that works well in conjunction with 
this class. These classes are useful during the development and maintenance 
of other modules.


=head1 AUTHOR

Chris Cobb [no dot spam at ccobb dot net]

=head1 COPYRIGHT

Copyright (c) 1998-2007 by Chris Cobb. All rights reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut