+
package MooseX::Getopt::Basic;
use Moose::Role;
use MooseX::Getopt::Meta::Attribute::NoGetopt;
use Carp ();
-use Getopt::Long (); # GLD uses it anyway, doesn't hurt
-
-our $VERSION = '0.20';
-our $AUTHORITY = 'cpan:STEVAN';
+use Getopt::Long ();
has ARGV => (is => 'rw', isa => 'ArrayRef', metaclass => "NoGetopt");
has extra_argv => (is => 'rw', isa => 'ArrayRef', metaclass => "NoGetopt");
-# _getopt_spec() and _getoptions() are overrided by MooseX::Getopt::GLD.
-
-sub _getopt_spec {
- my ($class, %params) = @_;
- return $class->_traditional_spec(%params)
-}
-
-sub _get_options {
- my ($class, undef, $opt_spec) = @_;
- my %options;
- Getopt::Long::GetOptions(\%options, @$opt_spec);
- return ( \%options, undef );
+sub _get_configfile_from_cli {
+ my $class = shift;
+ my $configfile;
+ my $opt_parser = Getopt::Long::Parser->new( config => [ qw( pass_through ) ] );
+ $opt_parser->getoptions( "configfile=s" => \$configfile );
+ return $configfile;
}
sub new_with_options {
my ($class, @params) = @_;
- my $config_from_file;
+ my $constructor_params = ( @params == 1 ? $params[0] : {@params} );
+
+ my ($config_from_file, $configfile);
if($class->meta->does_role('MooseX::ConfigFromFile')) {
local @ARGV = @ARGV;
- my $configfile;
- my $opt_parser = Getopt::Long::Parser->new( config => [ qw( pass_through ) ] );
- $opt_parser->getoptions( "configfile=s" => \$configfile );
+ $configfile = $class->_get_configfile_from_cli;
+ if(!defined $configfile) {
+ $configfile = $constructor_params->{configfile};
+ }
if(!defined $configfile) {
my $cfmeta = $class->meta->find_attribute_by_name('configfile');
$configfile = $cfmeta->default if $cfmeta->has_default;
- }
-
- if (defined $configfile) {
- $config_from_file = eval {
- $class->get_config_from_file($configfile);
- };
- if ($@) {
- die $@ unless $@ =~ /Specified configfile '\Q$configfile\E' does not exist/;
+ if (ref $configfile eq 'CODE') {
+ # not sure theres a lot you can do with the class and may break some assumptions
+ # warn?
+ $configfile = &$configfile($class);
+ }
+ if (defined $configfile) {
+ $config_from_file = eval {
+ $class->get_config_from_file($configfile);
+ };
+ if ($@) {
+ die $@ unless $@ =~ /Specified configfile '\Q$configfile\E' does not exist/;
+ }
}
}
+ else {
+ $config_from_file = $class->get_config_from_file($configfile);
+ }
}
- my $constructor_params = ( @params == 1 ? $params[0] : {@params} );
-
Carp::croak("Single parameters to new_with_options() must be a HASH ref")
unless ref($constructor_params) eq 'HASH';
params => $constructor_params,
);
- my $params = $config_from_file ? { %$config_from_file, %{$processed{params}} } : $processed{params};
+ my $params = $config_from_file ? { configfile => $configfile, %$config_from_file, %{$processed{params}} } : $processed{params};
# did the user request usage information?
if ( $processed{usage} && ($params->{'?'} or $params->{help} or $params->{usage}) )
{
- $processed{usage}->die();
+ $class->_getopt_full_usage($processed{usage});
}
$class->new(
);
}
+sub _getopt_spec { shift->_traditional_spec(@_); }
+
sub _parse_argv {
my ( $class, %params ) = @_;
# Get a clean copy of the original @ARGV
my $argv_copy = [ @ARGV ];
- my @err;
-
+ my @warnings;
my ( $parsed_options, $usage ) = eval {
- local $SIG{__WARN__} = sub { push @err, @_ };
+ local $SIG{__WARN__} = sub { push @warnings, @_ };
- return $class->_get_options(\%params, $opt_spec);
+ return $class->_getopt_get_options(\%params, $opt_spec);
};
- die join "", grep { defined } @err, $@ if @err or $@;
+ $class->_getopt_spec_warnings(@warnings) if @warnings;
+ $class->_getopt_spec_exception(\@warnings, $@) if $@;
# Get a copy of the Getopt::Long-mangled @ARGV
my $argv_mangled = [ @ARGV ];
);
}
+sub _getopt_get_options {
+ my ($class, $params, $opt_spec) = @_;
+ my %options;
+ Getopt::Long::GetOptions(\%options, @$opt_spec);
+ return ( \%options, undef );
+}
+
+sub _getopt_spec_warnings { }
+
+sub _getopt_spec_exception {
+ my ($self, $warnings, $exception) = @_;
+ die @$warnings, $exception;
+}
+
+sub _getopt_full_usage {
+ my ($self, $usage) = @_;
+ $usage->die;
+}
+
sub _usage_format {
return "usage: %c %o";
}
no Moose::Role; 1;
-1;
+__END__
=pod
=head1 NAME
-MooseX::Getopt::Basic - role to implement the basic functionality of
-L<MooseX::Getopt> without GLD.
+MooseX::Getopt::Basic - role to implement the Getopt::Long functionality
=head1 SYNOPSIS
=head1 METHODS
-=over 4
-
-=item B<new_with_options>
-
-See L<MooseX::Getopt> .
-
-=item B<meta>
-
-This returns the role meta object.
-
-=back
-
-=head1 BUGS
-
-All complex software has bugs lurking in it, and this module is no
-exception. If you find a bug please either email me, or add the bug
-to cpan-RT.
-
-=head1 AUTHOR
-
-Stevan Little E<lt>stevan@iinteractive.comE<gt>
-
-Brandon L. Black, E<lt>blblack@gmail.comE<gt>
-
-Yuval Kogman, E<lt>nothingmuch@woobling.orgE<gt>
-
-=head1 CONTRIBUTORS
-
-Ryan D Johnson, E<lt>ryan@innerfence.comE<gt>
-
-Drew Taylor, E<lt>drew@drewtaylor.comE<gt>
+=head2 new_with_options
-Shlomi Fish E<lt>shlomif@cpan.orgE<gt>
+See L<MooseX::Getopt/new_with_options>.
=head1 COPYRIGHT AND LICENSE