Permalink
Browse files

Remove global STRICT in favor of object parameter

  • Loading branch information...
1 parent f8d47fb commit 0a9c934ac5b434115b4e5137784cb217d0f679bb @xdg xdg committed Nov 6, 2010
Showing with 40 additions and 22 deletions.
  1. +3 −0 Changes
  2. +0 −1 Todo
  3. +35 −17 lib/Getopt/Lucid.pm
  4. +2 −4 t/08-strict-names.t
View
@@ -2,6 +2,9 @@ Revision history for Perl module Getopt::Lucid
{{$NEXT}}
+ - new() takes optional hashref of parameters
+ - Remove global $STRICT and replace with 'strict' object parameter
+
0.19 2010-11-05 17:07:26 EST5EDT
- Added valid() modifier and deprecated old way of validating options
View
1 Todo
@@ -36,7 +36,6 @@ TODO list for Perl module Getopt::Lucid
# Bugfixes/technical/other
#--------------------------------------------------------------------------#
-- make STRICT an object parameter, not a global
- test how negation is handled under $STRICT
- write cookbook
- refactor ugly code (module and tests)
View
@@ -26,10 +26,6 @@ my $NEGATIVE = qr/(?:--)?no-/;
my @valid_keys = qw( name type required default nocase valid needs canon );
my @valid_types = qw( switch counter parameter list keypair);
-use vars qw( $STRICT );
-$STRICT = 0;
-
-
sub Switch {
return bless { name => shift, type => 'switch' },
"Getopt::Lucid::Spec";
@@ -102,17 +98,23 @@ package Getopt::Lucid;
# new()
#--------------------------------------------------------------------------#
+my @params = qw/strict target/;
+
sub new {
my ($class, $spec, $target) = @_;
+ my $args = ref($_[-1]) eq 'HASH' ? pop(@_) : {};
+ $args->{target} = ref($target) eq 'ARRAY' ? $target : \@ARGV;
+ my $self = {};
+ $self->{$_} = $args->{$_} for @params;
+ $self->{raw_spec} = $spec;
+ bless ($self, ref($class) ? ref($class) : $class);
throw_usage("Getopt::Lucid->new() requires an option specification array reference")
- unless ref($spec) eq 'ARRAY';
- my $self = bless ({}, ref($class) ? ref($class) : $class);
- _parse_spec($self, $spec);
+ unless ref($self->{raw_spec}) eq 'ARRAY';
+ _parse_spec($self);
_set_defaults($self);
$self->{options} = {};
$self->{parsed} = [];
$self->{seen}{$_} = 0 for keys %{$self->{spec}};
- $self->{target} = $target || \@ARGV;
return $self;
}
@@ -184,7 +186,7 @@ sub getopt {
if ( $self eq 'Getopt::Lucid' ) {
throw_usage("Getopt::Lucid->getopt() requires an option specification array reference")
unless ref($spec) eq 'ARRAY';
- $self = new($self,$spec,$target)
+ $self = new(@_)
}
my (@passthrough);
while (@{$self->{target}}) {
@@ -389,7 +391,7 @@ sub _counter {
sub _find_arg {
my ($self, $arg) = @_;
- $arg =~ s/^-*// unless $STRICT;
+ $arg =~ s/^-*// unless $self->{strict};
return $self->{alias_hr}{$arg} if exists $self->{alias_hr}{$arg};
for ( keys %{$self->{alias_nocase}} ) {
@@ -469,13 +471,14 @@ sub _parameter {
#--------------------------------------------------------------------------#
sub _parse_spec {
- my ($self,$spec) = @_;
+ my ($self) = @_;
+ my $spec = $self->{raw_spec};
for my $opt ( @$spec ) {
my $name = $opt->{name};
my @names = split( /\|/, $name );
$opt->{canon} = $names[0];
_validate_spec($self,\@names,$opt);
- @names = map { s/^-*//; $_ } @names unless $STRICT; ## no critic
+ @names = map { s/^-*//; $_ } @names unless $self->{strict}; ## no critic
for (@names) {
$self->{alias_hr}{$_} = $names[0];
$self->{alias_nocase}{$_} = $names[0] if $opt->{nocase};
@@ -661,7 +664,7 @@ sub _validate_spec {
my ($self,$names,$details) = @_;
for my $name ( @$names ) {
my $alt_name = $name;
- $alt_name =~ s/^-*// unless $STRICT;
+ $alt_name =~ s/^-*// unless $self->{strict};
throw_spec(
"'$name' is not a valid option name/alias"
) unless $name =~ /^$VALID_NAME$/;
@@ -861,7 +864,7 @@ In practice, this means that the specification need not use dashes, but if
used on the command line, they will be treated appropriately.
Alternatively, Getopt::Lucid can operate in "strict" mode by setting
-{$Getopt::Lucid::STRICT} to a true value. In strict mode, option names
+the C<strict> parameter to a true value. In strict mode, option names
and aliases may still be specified in any of the three styles, but they
will only be parsed from the command line if they are used in exactly
the same style. E.g., given the name and alias "--help|-h", only "--help"
@@ -1228,15 +1231,21 @@ accessor code. Avoid identical names with mixed dash and underscore styles.
== new()
$opt = Getopt::Lucid->new( \@option_spec );
+ $opt = Getopt::Lucid->new( \@option_spec, \%parameters );
$opt = Getopt::Lucid->new( \@option_spec, \@option_array );
+ $opt = Getopt::Lucid->new( \@option_spec, \@option_array, \%parameters );
Creates a new Getopt::Lucid object. An array reference to an option spec is
required as an argument. (See [/USAGE] for a description of the object spec).
By default, objects will be set to read @ARGV for command line options. An
optional second argument with a reference to an array will use that array for
-option processing instead. For typical cases, users will likely prefer
-to call {getopt} instead, which creates a new object and parses the command
-line with a single function call.
+option processing instead. The final argument may be a hashref of parameters.
+The only valid parameter currently is:
+
+* strict -- enables strict mode when true
+
+For typical cases, users will likely prefer to call {getopt} instead, which
+creates a new object and parses the command line with a single function call.
== append_defaults()
@@ -1324,6 +1333,15 @@ specification, recalculates the result of processing the command line with the
restored defaults, and returns a hash with the resulting options. This
undoes the effect of a {merge_defaults} or {add_defaults} call.
+= API CHANGES
+
+In 1.00, the following API changes have been made:
+
+* {new()} now takes an optional hashref of parameters as the last
+argument
+* The global {$STRICT} variable has been replaced with a per-object
+parameter {strict}
+
= SEE ALSO
* [Config::Tiny]
View
@@ -10,8 +10,6 @@ use Getopt::Lucid ':all';
use Getopt::Lucid::Exception;
use t::ErrorMessages;
-$Getopt::Lucid::STRICT = 1;
-
sub why {
my %vars = @_;
$Data::Dumper::Sortkeys = 1;
@@ -111,7 +109,7 @@ plan tests => $num_tests;
my ($trial, @cmd_line);
while ( $trial = shift @good_specs ) {
- try eval { Getopt::Lucid->new($trial->{spec}, \@cmd_line) };
+ try eval { Getopt::Lucid->new($trial->{spec}, \@cmd_line, {strict => 1}) };
catch my $err;
is( $err, undef, "$trial->{label}: spec should validate" );
SKIP: {
@@ -120,7 +118,7 @@ while ( $trial = shift @good_specs ) {
skip "because $trial->{label} spec did not validate", $num_tests;
}
for my $case ( @{$trial->{cases}} ) {
- my $gl = Getopt::Lucid->new($trial->{spec}, \@cmd_line);
+ my $gl = Getopt::Lucid->new($trial->{spec}, \@cmd_line, {strict => 1});
@cmd_line = @{$case->{argv}};
my %opts;
try eval { %opts = $gl->getopt->options };

0 comments on commit 0a9c934

Please sign in to comment.