* MooseX::Getopt::OptionTypeMap: Added new types: Bool|Int, Bool|Float, Bool|Str.
MooseX::Getopt::Session->parser->usage rather than passed via
new_with_options( usage => $usage ) constructor. (dexter)
+ * MooseX::Getopt::OptionTypeMap
+ - Added new types: Bool|Int, Bool|Float, Bool|Str. (dexter)
+
0.15 Sat. July 26 2008
* MooseX::Getopt::OptionTypeMap
- Accept type constraint objects in the type mapping, not just names
has getopt => (
- is => 'rw',
- isa => 'MooseX::Getopt::Session',
+ is => 'rw',
+ isa => 'MooseX::Getopt::Session',
metaclass => 'NoGetopt',
- handles => [ 'ARGV', 'extra_argv' ],
+ handles => [ 'ARGV', 'extra_argv' ],
);
sub get_options_from_argv {
my $class = shift;
- Moose->throw_error("Single parameters to get_options_from_argv() must be a HASH ref")
- if ref $_[0] and ref $_ ne 'HASH';
+ Moose->throw_error(
+ "Single parameters to get_options_from_argv() must be a HASH ref"
+ ) if ref $_[0] and ref $_ ne 'HASH';
- my $options = { %{ $class->get_options_from_configfile }, @_ == 1 ? %{ $_[0] } : @_ };
+ my $options = {
+ %{ $class->get_options_from_configfile },
+ @_ == 1 ? %{ $_[0] } : @_
+ };
my $getopt = defined $options->{getopt}
- ? $options->{getopt}
- : $class->_default_getopt_session->new(
- classes_filter => sub { $_ eq $class },
- options => $options,
- );
+ ? $options->{getopt}
+ : $class->_default_getopt_session->new(
+ classes_filter => sub { $_ eq $class },
+ options => $options,
+ );
# Call Getopt parser only once.
$getopt->build_options if not $getopt->has_status;
my $new_options = {
- %{ $options }, # explicit options to ->new
- %{ $getopt->options }, # options from CLI
+ %$options, # explicit options to ->new
+ %{ $getopt->options }, # options from CLI
getopt => $getopt,
};
my $options = {};
- if ($class->meta->does_role('MooseX::ConfigFromFile')) {
+ if ( $class->meta->does_role('MooseX::ConfigFromFile') ) {
local @ARGV = @ARGV;
my $configfile;
- my $opt_parser = Getopt::Long::Parser->new( config => [ 'pass_through' ] );
+ my $opt_parser = Getopt::Long::Parser->new( config => ['pass_through'] );
$opt_parser->getoptions( "configfile=s" => \$configfile );
- if (not defined $configfile) {
+ if ( not defined $configfile ) {
my $cfmeta = $class->meta->find_attribute_by_name('configfile');
$configfile = $cfmeta->default if $cfmeta->has_default;
};
- if (defined $configfile) {
+ if ( defined $configfile ) {
$options = $class->get_config_from_file($configfile);
};
};
return grep {
$_->does('MooseX::Getopt::Meta::Attribute::Trait')
- or
- $_->name !~ /^_/
+ or $_->name !~ /^_/
} grep {
!$_->does('MooseX::Getopt::Meta::Attribute::Trait::NoGetopt')
} $class->meta->compute_all_applicable_attributes;
no Moose::Role; 1;
+
__END__
=pod
These type constraints are set up as properly typed options with
Getopt::Long, using the C<=i>, C<=f> and C<=s> modifiers as appropriate.
+=item I<Bool|Int>, I<Bool|Float>, I<Bool|Str>
+
+These type constaints are set up as properly typed options with
+Getopt::Long, using the C<:i>, C<:f> and C<:s> modifiers as appropriate.
+
=item I<ArrayRef>
An I<ArrayRef> type constraint is set up as a multiple value option
Yuval Kogman, E<lt>nothingmuch@woobling.orgE<gt>
+Piotr Roszatycki, E<lt>dexter@cpan.orgE<gt>
+
=head1 CONTRIBUTORS
Ryan D Johnson, E<lt>ryan@innerfence.comE<gt>
-Piotr Roszatycki, E<lt>dexter@cpan.orgE<gt>
-
=head1 COPYRIGHT AND LICENSE
Copyright 2007-2008 by Infinity Interactive, Inc.
our $VERSION = '0.04';
our $AUTHORITY = 'cpan:STEVAN';
+
my %option_type_map = (
- 'Bool' => '!',
- 'Str' => '=s',
- 'Int' => '=i',
- 'Num' => '=f',
- 'ArrayRef' => '=s@',
- 'HashRef' => '=s%',
+ 'Bool' => '!',
+ 'Str' => '=s',
+ 'Int' => '=i',
+ 'Num' => '=f',
+ 'ArrayRef' => '=s@',
+ 'HashRef' => '=s%',
+ 'Bool|Str' => ':s',
+ 'Bool|Int' => ':i',
+ 'Bool|Num' => ':f',
+ 'Str|Bool' => ':s',
+ 'Int|Bool' => ':i',
+ 'Num|Bool' => ':f',
);
+
sub has_option_type {
my (undef, $type_or_name) = @_;
- return 1 if exists $option_type_map{blessed($type_or_name) ? $type_or_name->name : $type_or_name};
+ return 1 if exists $option_type_map{ blessed $type_or_name
+ ? $type_or_name->name
+ : $type_or_name };
- my $current = blessed($type_or_name) ? $type_or_name : find_type_constraint($type_or_name);
+ my $current = blessed $type_or_name
+ ? $type_or_name
+ : find_type_constraint($type_or_name);
- (defined $current)
- || Moose->throw_error("Could not find the type constraint for '$type_or_name'");
+ Moose->throw_error("Could not find the type constraint for '$type_or_name'")
+ unless defined $current;
- while (my $parent = $current->parent) {
- return 1 if exists $option_type_map{$parent->name};
+ while ( my $parent = $current->parent ) {
+ return 1 if exists $option_type_map{ $parent->name };
$current = $parent;
- }
+ };
+
+ return '';
+};
- return 0;
-}
sub get_option_type {
my (undef, $type_or_name) = @_;
- my $name = blessed($type_or_name) ? $type_or_name->name : $type_or_name;
+ my $name = blessed $type_or_name ? $type_or_name->name : $type_or_name;
return $option_type_map{$name} if exists $option_type_map{$name};
- my $current = ref $type_or_name ? $type_or_name : find_type_constraint($type_or_name);
+ my $current = ref $type_or_name
+ ? $type_or_name
+ : find_type_constraint($type_or_name);
- (defined $current)
- || Moose->throw_error("Could not find the type constraint for '$type_or_name'");
+ Moose->throw_error("Could not find the type constraint for '$type_or_name'")
+ unless defined $current;
while ( $current = $current->parent ) {
- return $option_type_map{$current->name}
- if exists $option_type_map{$current->name};
- }
+ return $option_type_map{ $current->name }
+ if exists $option_type_map{ $current->name };
+ };
return;
-}
+};
+
sub add_option_type_to_map {
my (undef, $type_name, $option_string) = @_;
- (defined $type_name && defined $option_string)
- || Moose->throw_error("You must supply both a type name and an option string");
- if ( blessed($type_name) ) {
+ Moose->throw_error("You must supply both a type name and an option string")
+ unless defined $type_name && defined $option_string;
+
+ if (blessed $type_name) {
$type_name = $type_name->name;
- } else {
- (find_type_constraint($type_name))
- || Moose->throw_error("The type constraint '$type_name' does not exist");
}
+ else {
+ Moose->throw_error("The type constraint '$type_name' does not exist")
+ unless find_type_constraint($type_name);
+ };
$option_type_map{$type_name} = $option_string;
-}
+};
+
no Moose; no Moose::Util::TypeConstraints; 1;
-__END__
+__END__
=pod
use Moose::Role;
requires 'build_options';
+
1;
+
__END__
=pod
sub new {
my $class = shift;
return maybe::HAVE_MOOSEX_GETOPT_PARSER_DESCRIPTIVE
- ? MooseX::Getopt::Parser::Descriptive->new(@_)
- : MooseX::Getopt::Parser::Long->new(@_);
+ ? MooseX::Getopt::Parser::Descriptive->new(@_)
+ : MooseX::Getopt::Parser::Long->new(@_);
};
1;
+
__END__
=pod
# Special configuration for parser
has config => (
- is => 'rw',
- isa => 'ArrayRef[Str]',
- default => sub { [ 'default' ] },
+ is => 'rw',
+ isa => 'ArrayRef[Str]',
+ default => sub { ['default'] },
);
# Format for usage description
has format => (
- is => 'rw',
- isa => 'Str',
+ is => 'rw',
+ isa => 'Str',
default => 'usage: %c %o',
);
# Usage object
has usage => (
- is => 'rw',
- isa => 'Maybe[Getopt::Long::Descriptive::Usage]',
+ is => 'rw',
+ isa => 'Maybe[Getopt::Long::Descriptive::Usage]',
predicate => 'has_usage',
);
sub build_options {
my $self = shift;
- my ($getopt, @attrs) = @_;
+ my ( $getopt, @attrs ) = @_;
- Moose->throw_error('First argument is not a MooseX::Getopt::Session')
+ Moose->throw_error("First argument is not a MooseX::Getopt::Session")
unless $getopt->isa('MooseX::Getopt::Session');
- my $options = $getopt->options;
+ my $options = $getopt->options;
my $new_options = {};
my $usage;
- my (@opts, %cmd_flags_to_names);
+ my ( @opts, %cmd_flags_to_names );
foreach my $attr (@attrs) {
my $name = $attr->name;
- my ($flag, @aliases) = $getopt->_get_cmd_flags_for_attr($attr);
+ my ( $flag, @aliases ) = $getopt->_get_cmd_flags_for_attr($attr);
my $type = $getopt->_get_cmd_type_for_attr($attr);
my $opt_string = join '|', $flag, @aliases;
- $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type) if $type;
+ $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type)
+ if $type;
- # opt_string is unmangled; parsed options key is mangled
+ # opt_string is unmangled; parsed options keys are mangled
$flag =~ tr/-/_/;
$cmd_flags_to_names{$flag} = $name;
};
eval {
- ($new_options, $usage) = Getopt::Long::Descriptive::describe_options(
- $self->format, @opts, { getopt_conf => $self->config }
- );
+ ( $new_options, $usage ) =
+ Getopt::Long::Descriptive::describe_options(
+ $self->format,
+ @opts,
+ { getopt_conf => $self->config }
+ );
};
- my $e = $@;
- $warnings .= $e if $e;
+ $warnings .= $@ if $@;
my $extra_argv = \@ARGV;
- $getopt->extra_argv( $extra_argv );
+ $getopt->extra_argv($extra_argv);
};
# Store usage object
$self->usage( $usage );
# Convert cmd_flags back to names in options hashref
- $new_options = { map { $cmd_flags_to_names{$_} => $new_options->{$_} } keys %$new_options };
+ $new_options = {
+ map { $cmd_flags_to_names{$_} => $new_options->{$_} }
+ keys %$new_options
+ };
# Include old options
$new_options = { %$options, %$new_options };
1;
+
__END__
=pod
# Special configuration for parser
has config => (
- is => 'rw',
- isa => 'ArrayRef[Str]',
+ is => 'rw',
+ isa => 'ArrayRef[Str]',
auto_deref => 1,
- default => sub { [ 'default' ] },
+ default => sub { ['default'] },
);
sub build_options {
my $self = shift;
- my ($getopt, @attrs) = @_;
+ my ( $getopt, @attrs ) = @_;
- Moose->throw_error('First argument is not a MooseX::Getopt::Session')
+ Moose->throw_error("First argument is not a MooseX::Getopt::Session")
unless $getopt->isa('MooseX::Getopt::Session');
- my $options = $getopt->options;
+ my $options = $getopt->options;
my $new_options = { %$options };
my @opts;
foreach my $attr (@attrs) {
my $name = $attr->name;
- my ($flag, @aliases) = $getopt->_get_cmd_flags_for_attr($attr);
+ my ( $flag, @aliases ) = $getopt->_get_cmd_flags_for_attr($attr);
my $type = $getopt->_get_cmd_type_for_attr($attr);
my $opt_string = join '|', $flag, @aliases;
- $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type) if $type;
+ $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type)
+ if $type;
$new_options->{$name} = undef;
push @opts, $opt_string => \$new_options->{$name};
};
# Filter not defined values in new_options hashref
- $new_options = { map { $_ => $new_options->{$_} } grep { defined $new_options->{$_} } keys %$new_options };
+ $new_options = {
+ map { $_ => $new_options->{$_} }
+ grep { defined $new_options->{$_} } keys %$new_options
+ };
$getopt->status( ! $warnings );
$getopt->options( $new_options );
1;
+
__END__
=pod
# Pluggined MooseX::Getopt::Parser parser
has parser => (
- is => 'rw',
- does => 'MooseX::Getopt::Parser',
+ is => 'rw',
+ does => 'MooseX::Getopt::Parser',
default => sub { $_[0]->_default_getopt_parser->new },
);
# Filter for classes which are searched for getopt trait
has classes_filter => (
- is => 'rw',
- isa => 'CodeRef',
- default => sub { sub { 1 } },
+ is => 'rw',
+ isa => 'CodeRef',
+ default => sub { sub { 1; } },
);
# Original @ARGV values
has ARGV => (
- is => 'rw',
- isa => 'ArrayRef[Str]',
- default => sub { [ @ARGV ] },
+ is => 'rw',
+ isa => 'ArrayRef[Str]',
+ default => sub { [@ARGV] },
);
# Unrecognized @ARGV values
has extra_argv => (
- is => 'rw',
- isa => 'ArrayRef[Str]',
+ is => 'rw',
+ isa => 'ArrayRef[Str]',
default => sub { [] },
);
# Hash with options parsed from argv
has options => (
- is => 'rw',
- isa => 'HashRef',
+ is => 'rw',
+ isa => 'HashRef',
default => sub { {} },
);
# Status returned by Getopt parser
has status => (
- is => 'rw',
- isa => 'Bool',
+ is => 'rw',
+ isa => 'Bool',
predicate => 'has_status',
);
my @attrs = map { $_->_compute_getopt_attrs } $self->_compute_getopt_classes;
return $self->parser->build_options( $self, @attrs );
-}
+};
sub _compute_getopt_classes {
sub _get_cmd_flags_for_attr {
- my ($self, $attr) = @_;
+ my ( $self, $attr ) = @_;
my $flag = $attr->name;
my @aliases;
- if ($attr->does('MooseX::Getopt::Meta::Attribute::Trait')) {
- $flag = $attr->cmd_flag if $attr->has_cmd_flag;
+ if ( $attr->does('MooseX::Getopt::Meta::Attribute::Trait') ) {
+ $flag = $attr->cmd_flag if $attr->has_cmd_flag;
@aliases = @{ $attr->cmd_aliases } if $attr->has_cmd_aliases;
};
- return ($flag, @aliases);
+ return ( $flag, @aliases );
};
sub _get_cmd_type_for_attr {
- my ($self, $attr) = @_;
+ my ( $self, $attr ) = @_;
my $type;
$type = $attr->type_constraint if $attr->has_type_constraint;
- if ($attr->does('MooseX::Getopt::Meta::Attribute::Trait')) {
+ if ( $attr->does('MooseX::Getopt::Meta::Attribute::Trait') ) {
$type = $attr->cmd_type if $attr->has_cmd_type;
};
1;
+
__END__
=pod
Yuval Kogman, E<lt>nothingmuch@woobling.orgE<gt>
+Piotr Roszatycki, E<lt>dexter@cpan.orgE<gt>
+
=head1 CONTRIBUTORS
Ryan D Johnson, E<lt>ryan@innerfence.comE<gt>
-Piotr Roszatycki, E<lt>dexter@cpan.orgE<gt>
-
=head1 COPYRIGHT AND LICENSE
Copyright 2007-2008 by Infinity Interactive, Inc.
} $class->$next(@args);
};
+
1;
+
__END__
=pod
projects / gitmo/MooseX-Getopt.git / commitdiff