| Subject: | RFC: Handling "short-circuit" options |
I'm migrating from Getopt::Long to G::L::D and have come across an
incongruity which seems to bedevil most of the higher level option
parsing packages, namely how to handle options like --help/--usage/--man
if required options are present.
For example, if I specify that option "--input" be required, then
prog --help
causes GLD to die with an error indicating that "--input" wasn't
specified, rather than returning an options object with help set. True,
the short help message is output as well, but that's a byproduct of the
error message. I have traditionally provided a "--manpage" option which
outputs the entire documentation, but, as far as I can tell, there's no
way of indicating to G::L::D that such an option should take precedence
over any other options' constraints.
I would like to suggest creating a new attribute for "short-circuit"
options which would cause GLD to return (rather than die) with a valid
options object with only that option set, without performing a
constraint check on the other options. (Another means of handling these
would be to have G::L::D throw a particular type of exception to signal
the presence of the short-circuit option, but this seems like too much a
deviation from the present exception-on-error-only behavior).
I've attached a patch against version 0.089 which implements and tests a
"shortcircuit" attribute. The implementation still calls Getopt::Long
for the command line; it simply doesn't call _validate_with if
shortcircuit options are present.
Diab
| Subject: | GLD-0.089.patch |
# This is a patch for Getopt-Long-Descriptive-0.089.orig to update it to Getopt-Long-Descriptive-0.089
#
# To apply this patch:
# STEP 1: Chdir to the source directory.
# STEP 2: Run the 'applypatch' program with this patch file as input.
#
# If you do not have 'applypatch', it is part of the 'makepatch' package
# that you can fetch from the Comprehensive Perl Archive Network:
# http://www.perl.com/CPAN/authors/Johan_Vromans/makepatch-x.y.tar.gz
# In the above URL, 'x' should be 2 or higher.
#
# To apply this patch without the use of 'applypatch':
# STEP 1: Chdir to the source directory.
# If you have a decent Bourne-type shell:
# STEP 2: Run the shell with this file as input.
# If you don't have such a shell, you may need to manually create
# the files as shown below.
# STEP 3: Run the 'patch' program with this file as input.
#
# These are the commands needed to create/delete files/directories:
#
touch 't/shortcircuit.t'
chmod 0644 't/shortcircuit.t'
#
# This command terminates the shell and need not be executed manually.
exit
#
#### End of Preamble ####
#### Patch data follows ####
diff -c 'Getopt-Long-Descriptive-0.089.orig/lib/Getopt/Long/Descriptive.pm' 'Getopt-Long-Descriptive-0.089/lib/Getopt/Long/Descriptive.pm'
Index: ./lib/Getopt/Long/Descriptive.pm
*** ./lib/Getopt/Long/Descriptive.pm Thu Jan 13 07:22:17 2011
--- ./lib/Getopt/Long/Descriptive.pm Tue Mar 8 10:44:20 2011
***************
*** 212,217 ****
--- 212,226 ----
[ mode => \@option_specs, \%constraints ]
+
+ =item shortcircuit
+
+ shortcircuit => 1
+
+ If this option is present no other options will be returned. Other
+ options present will be checked for proper types, but I<not> for
+ constraints. This provides a way of specifying C<--help> style options.
+
=item Params::Validate
In addition, any constraint understood by Params::Validate may be used.
***************
*** 351,357 ****
--- 360,372 ----
push @opts, $one_opt;
}
}
+ if ( $opt->{constraint}{shortcircuit} &&
+ exists $opt->{constraint}{default}
+ ) {
+ carp( 'option "', $opt->{name}, q[": 'default' does not make sense for shortcircuit options] );
+ }
push @opts, $opt;
+
}
my @go_conf = @{ $arg->{getopt_conf} || $arg->{getopt} || [] };
***************
*** 407,414 ****
$return{$newopt} = delete $return{$opt};
}
! for my $copt (grep { $_->{constraint} } @opts) {
delete $copt->{constraint}->{hidden};
my $name = $copt->{name};
my $new = _validate_with(
name => $name,
--- 422,435 ----
$return{$newopt} = delete $return{$opt};
}
! # ensure that shortcircuit options are handled first
! for my $copt (sort { ($b->{constraint}{shortcircuit} || 0)
! <=> ($a->{constraint}{shortcircuit} || 0)
! }
! grep { $_->{constraint} } @opts
! ) {
delete $copt->{constraint}->{hidden};
+ my $is_shortcircuit = delete $copt->{constraint}{shortcircuit};
my $name = $copt->{name};
my $new = _validate_with(
name => $name,
***************
*** 419,424 ****
--- 440,450 ----
);
next unless (defined($new) || exists($return{$name}));
$return{$name} = $new;
+ if ( $is_shortcircuit )
+ {
+ %return = ( $name => $return{$name} );
+ last;
+ }
}
my $opt_obj = Getopt::Long::Descriptive::Opts->___new_opt_obj({
diff -c /dev/null 'Getopt-Long-Descriptive-0.089/t/shortcircuit.t'
Index: ./t/shortcircuit.t
*** ./t/shortcircuit.t Wed Dec 31 19:00:00 1969
--- ./t/shortcircuit.t Tue Mar 8 10:38:11 2011
***************
*** 0 ****
--- 1,78 ----
+ #!perl
+ use strict;
+ use warnings;
+
+ use Test::More tests => 11;
+
+ use_ok("Getopt::Long::Descriptive");
+
+
+ my $nreq = 6;
+ my @reqs = map { "--req$_" } 1..$nreq;
+
+ sub test {
+
+ my $opts = shift;
+ local @ARGV = @_;
+
+ my ( $opt, $usage) =
+ eval {
+ # catch carp's so we can test 'em
+ local $SIG{__WARN__} = sub {die @_ };
+
+ describe_options (
+ "test %o",
+ # load with extra required to make sure
+ # sorting on shortcircuit attribute works;
+ ( map { [ "req$_", 'required' , { required => 1 } ]
+ } 1..$nreq ),
+ [ 'help', 'help', { shortcircuit => 1, %$opts } ],
+ );
+ };
+ my $error = $@;
+ return $opt, $usage, $error;
+ }
+
+ {
+ my ( $opt, $usage, $error ) = test({} );
+
+ like( $error, qr/required/, 'no req: error' );
+ }
+
+ SKIP:
+ {
+ my ( $opt, $usage, $error ) = test( { default => 1 }, @reqs );
+
+ like( $error, qr/'default' does not make sense for shortcircuit/, 'shortcircuit + default' );
+ }
+
+
+ SKIP:
+ {
+ my ( $opt, $usage, $error ) = test( {}, @reqs );
+
+ my $ok = is( $error, '', 'req: no error' );
+ skip 'no object due to failure', 1, unless $ok;
+ ok( defined $opt->req1 && $opt->req1 == 1, 'req: req1 specified' );
+ }
+
+ SKIP:
+ {
+ my ( $opt, $usage, $error ) = test( {}, qw[ --help ] );
+
+ my $ok = is( $error, '', 'help: no error' );
+
+ skip 'no object due to failure', 2, unless $ok;
+ ok( $opt->help == 1, 'help: help flag' );
+ ok( keys %{$opt} == 1, 'help: only help' );
+ }
+
+ SKIP:
+ {
+ my ( $opt, $usage, $error ) = test( {}, @reqs, '--help' );
+
+ my $ok = is( $error, '', 'help + req: no error' );
+ skip 'no object due to failure', 2, unless $ok;
+ ok( $opt->help == 1, 'help + req: help flag' );
+ ok( keys %{$opt} == 1, 'help + req: only help' );
+ }
#### End of Patch data ####
#### ApplyPatch data follows ####
# Data version : 1.0
# Date generated : Tue Mar 8 10:44:39 2011
# Generated by : makepatch 2.04
# Recurse directories : Yes
# Excluded files : (\A|/).*\~\Z
# (\A|/).*\.a\Z
# (\A|/).*\.bak\Z
# (\A|/).*\.BAK\Z
# (\A|/).*\.elc\Z
# (\A|/).*\.exe\Z
# (\A|/).*\.gz\Z
# (\A|/).*\.ln\Z
# (\A|/).*\.o\Z
# (\A|/).*\.obj\Z
# (\A|/).*\.olb\Z
# (\A|/).*\.old\Z
# (\A|/).*\.orig\Z
# (\A|/).*\.rej\Z
# (\A|/).*\.so\Z
# (\A|/).*\.Z\Z
# (\A|/)\.del\-.*\Z
# (\A|/)\.make\.state\Z
# (\A|/)\.nse_depinfo\Z
# (\A|/)core\Z
# (\A|/)tags\Z
# (\A|/)TAGS\Z
# (\A|/)Makefile\Z
# (\A|/)pm_to_blib\Z
# (\A|/)blib\/.*\Z
# (\A|/)\.hg\/.*\Z
# p 'lib/Getopt/Long/Descriptive.pm' 16682 1299599060 0100644
# c 't/shortcircuit.t' 0 1299598691 0100644
#### End of ApplyPatch data ####
#### End of Patch kit [created: Tue Mar 8 10:44:39 2011] ####
#### Patch checksum: 201 5997 19171 ####
#### Checksum: 231 7112 48158 ####