license => 'perl',
requires => {
'Moose' => '0.17',
- 'Getopt::Long' => '0',
+ 'Getopt::Long' => '2.36',
},
optional => {
},
use Getopt::Long;
-use MooseX::Getopt::OptionTypes;
+use MooseX::Getopt::OptionTypeMap;
use MooseX::Getopt::Meta::Attribute;
+our $VERSION = '0.01';
+our $AUTHORITY = 'cpan:STEVAN';
+
sub new_with_options {
my ($class, %params) = @_;
- my (%options, %constructor_options);
+ my (@options, %name_to_init_arg);
foreach my $attr ($class->meta->compute_all_applicable_attributes) {
my $name = $attr->name;
if ($attr->isa('MooseX::Getopt::Meta::Attribute') && $attr->has_cmd_flag) {
$name = $attr->cmd_flag;
- }
-
- my $init_arg = $attr->init_arg;
+ }
- # create a suitable default value
- $constructor_options{$init_arg} = '';
+ $name_to_init_arg{$name} = $attr->init_arg;
if ($attr->has_type_constraint) {
my $type_name = $attr->type_constraint->name;
- if (MooseX::Getopt::OptionTypes->has_option_type($type_name)) {
- $name .= MooseX::Getopt::OptionTypes->get_option_type($type_name);
+ if (MooseX::Getopt::OptionTypeMap->has_option_type($type_name)) {
+ $name .= MooseX::Getopt::OptionTypeMap->get_option_type($type_name);
}
}
- $options{$name} = \($constructor_options{$init_arg});
+ push @options => $name;
}
- GetOptions(%options);
+ my %options;
- # filter out options which
- # were not passed at all
- %constructor_options = map {
- $constructor_options{$_} ne ''
- ? ($_ => $constructor_options{$_})
- : ()
- } keys %constructor_options;
+ GetOptions(\%options, @options);
- $class->new(%params, %constructor_options);
+ #use Data::Dumper;
+ #warn Dumper \@options;
+ #warn Dumper \%name_to_init_arg;
+ #warn Dumper \%options;
+
+ $class->new(
+ %params,
+ map {
+ $name_to_init_arg{$_} => $options{$_}
+ } keys %options
+ );
}
-1;
+no Moose::Role; 1;
__END__
=head1 NAME
-MooseX::Getopt -
+MooseX::Getopt - A Moose role for processing command line options
=head1 SYNOPSIS
=head1 DESCRIPTION
+This is a role which provides an alternate constructor for creating
+objects using parameters passed in from the command line.
+
+This module attempts to DWIM as much as possible with the command line
+params by introspecting your class's attributes. It will use the name
+of your attribute as the command line option, and if there is a type
+constraint defined, it will configure Getopt::Long to handle the option
+accordingly.
+
+=head2 Supported Type Constraints
+
+=over 4
+
+=item I<Bool>
+
+A I<Bool> type constraint is set up as a boolean option with
+Getopt::Long. So that this attribute description:
+
+ has 'verbose' => (is => 'rw', isa => 'Bool');
+
+would translate into C<verbose!> as a Getopt::Long option descriptor,
+which would enable the following command line options:
+
+ % my_script.pl --verbose
+ % my_script.pl --noverbose
+
+=item I<Int>, I<Float>, I<Str>
+
+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<ArrayRef>
+
+An I<ArrayRef> type constraint is set up as a multiple value option
+in Getopt::Long. So that this attribute description:
+
+ has 'include' => (
+ is => 'rw',
+ isa => 'ArrayRef',
+ default => sub { [] }
+ );
+
+would translate into C<includes=s@> as a Getopt::Long option descriptor,
+which would enable the following command line options:
+
+ % my_script.pl --include /usr/lib --include /usr/local/lib
+
+=item I<HashRef>
+
+A I<HashRef> type constraint is set up as a hash value option
+in Getopt::Long. So that this attribute description:
+
+ has 'define' => (
+ is => 'rw',
+ isa => 'HashRef',
+ default => sub { {} }
+ );
+
+would translate into C<define=s%> as a Getopt::Long option descriptor,
+which would enable the following command line options:
+
+ % my_script.pl --define os=linux --define vendor=debian
+
+=back
+
+=head2 Custom Type Constraints
+
+It is possible to create custom type constraint to option spec
+mappings if you need them. The process is fairly simple (but a
+little verbose maybe). First you create a custom subtype, like
+so:
+
+ subtype 'ArrayOfInts'
+ => as 'ArrayRef'
+ => where { scalar (grep { looks_like_number($_) } @$_) };
+
+Then you register the mapping, like so:
+
+ MooseX::Getopt::OptionTypeMap->add_option_type_to_map(
+ 'ArrayOfInts' => '=i@'
+ );
+
+Now any attribute declarations using this type constraint will
+get the custom option spec. So that, this:
+
+ has 'nums' => (
+ is => 'ro',
+ isa => 'ArrayOfInts',
+ default => sub { [0] }
+ );
+
+Will translate to the following on the command line:
+
+ % my_script.pl --nums 5 --nums 88 --nums 199
+
+This example is fairly trivial, but more complex validations are
+easily possible with a little creativity. The trick is balancing
+the type constraint validations with the Getopt::Long validations.
+
+Better examples are certainly welcome :)
+
=head1 METHODS
=over 4
=item B<new_with_options (%params)>
+This method will take a set of default C<%params> and then collect
+params from the command line (possibly overriding those in C<%params>)
+and then return a newly constructed object.
+
=item B<meta>
+This returns the role meta object.
+
=back
=head1 BUGS
package MooseX::Getopt::Meta::Attribute;
use Moose;
-extends 'Moose::Meta::Attribute';
+our $VERSION = '0.01';
+our $AUTHORITY = 'cpan:STEVAN';
+
+extends 'Moose::Meta::Attribute'; # << Moose extending Moose :)
has 'cmd_flag' => (
is => 'rw',
predicate => 'has_cmd_flag',
);
-1;
+no Moose; 1;
__END__
=head1 NAME
-MooseX::Getopt::Meta::Attribute -
+MooseX::Getopt::Meta::Attribute - Optional meta attribute for custom option names
=head1 SYNOPSIS
+ package App;
+ use Moose;
+
+ with 'MooseX::Getopt';
+
+ has 'data' => (
+ metaclass => 'MooseX::Getopt::Meta::Attribute',
+ is => 'ro',
+ isa => 'Str',
+ default => 'file.dat',
+ # tells MooseX::Getopt to use -f as the
+ # command line flag instead of the normal
+ # autogenerated one (--data)
+ cmd_flag => 'f',
+ );
+
=head1 DESCRIPTION
+This is a custom attribute metaclass which can be used to specify a
+the specific command line flag to use instead of the default one
+which L<MooseX::Getopt> will create for you.
+
+This is certainly not the prettiest way to go about this, but for
+now it works for those who might need such a feature.
+
=head1 METHODS
+These methods are of little use to most users, they are used interally
+within L<MooseX::Getopt>.
+
=over 4
=item B<cmd_flag>
--- /dev/null
+
+package MooseX::Getopt::OptionTypeMap;
+
+use Moose 'confess';
+use Moose::Util::TypeConstraints 'find_type_constraint';
+
+our $VERSION = '0.01';
+our $AUTHORITY = 'cpan:STEVAN';
+
+my %option_type_map = (
+ 'Bool' => '!',
+ 'Str' => '=s',
+ 'Int' => '=i',
+ 'Float' => '=f',
+ 'ArrayRef' => '=s@',
+ 'HashRef' => '=s%',
+);
+
+sub has_option_type { exists $option_type_map{$_[1]} }
+sub get_option_type { $option_type_map{$_[1]} }
+sub add_option_type_to_map {
+ my (undef, $type_name, $option_string) = @_;
+ (defined $type_name && defined $option_string)
+ || confess "You must supply both a type name and an option string";
+ (find_type_constraint($type_name))
+ || confess "The type constraint '$type_name' does not exist";
+ $option_type_map{$type_name} = $option_string;
+}
+
+no Moose; no Moose::Util::TypeConstraints; 1;
+
+__END__
+
+
+=pod
+
+=head1 NAME
+
+MooseX::Getopt::OptionTypeMap - Storage for the option to type mappings
+
+=head1 DESCRIPTION
+
+See the I<Custom Type Constraints> section in the L<MooseX::Getopt> docs
+for more info about how to use this module.
+
+=head1 METHODS
+
+These are all class methods and should be called as such.
+
+=over 4
+
+=item B<has_option_type ($type_name)>
+
+=item B<get_option_type ($type_name)>
+
+=item B<add_option_type_to_map ($type_name, $option_spec)>
+
+=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>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
\ No newline at end of file
+++ /dev/null
-
-package MooseX::Getopt::OptionTypes;
-# this maps option types to Moose types
-
-my %option_types = (
- 'Bool' => '!',
- 'Str' => '=s',
- 'Int' => '=i',
- 'Float' => '=f',
- 'ArrayRef' => '=s@',
-);
-
-sub has_option_type { exists $option_types{$_[1]} }
-sub get_option_type { $option_types{$_[1]} }
-
-1;
-
-__END__
-
-
-=pod
-
-=head1 NAME
-
-MooseX::Getopt::OptionTypes -
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-=head1 METHODS
-
-=over 4
-
-=item B<has_option_type>
-
-=item B<get_option_type>
-
-=item B<add_option_type>
-
-=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>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2007 by Infinity Interactive, Inc.
-
-L<http://www.iinteractive.com>
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
\ No newline at end of file
use strict;
use warnings;
-use Test::More no_plan => 1;
+use Test::More tests => 37;
BEGIN {
use_ok('MooseX::Getopt');
has 'verbose' => (
is => 'ro',
isa => 'Bool',
+ );
+
+ has 'libs' => (
+ is => 'ro',
+ isa => 'ArrayRef',
+ default => sub { [] },
);
+
+ has 'details' => (
+ is => 'ro',
+ isa => 'HashRef',
+ default => sub { {} },
+ );
}
ok(!$app->verbose, '... verbosity is off as expected');
is($app->length, 24, '... length is 24 as expected');
is($app->data, 'file.dat', '... data is file.dat as expected');
+ is_deeply($app->libs, [], '... libs is [] as expected');
+ is_deeply($app->details, {}, '... details is {} as expected');
}
{
- local @ARGV = ('-verbose', '-length', 50);
+ local @ARGV = ('--verbose', '--length', 50);
my $app = App->new_with_options;
isa_ok($app, 'App');
ok($app->verbose, '... verbosity is turned on as expected');
is($app->length, 50, '... length is 50 as expected');
- is($app->data, 'file.dat', '... data is file.dat as expected');
+ is($app->data, 'file.dat', '... data is file.dat as expected');
+ is_deeply($app->libs, [], '... libs is [] as expected');
+ is_deeply($app->details, {}, '... details is {} as expected');
+}
+
+{
+ local @ARGV = ('--verbose', '-f', 'foo.txt');
+
+ my $app = App->new_with_options;
+ isa_ok($app, 'App');
+
+ ok($app->verbose, '... verbosity is turned on as expected');
+ is($app->length, 24, '... length is 24 as expected');
+ is($app->data, 'foo.txt', '... data is foo.txt as expected');
+ is_deeply($app->libs, [], '... libs is [] as expected');
+ is_deeply($app->details, {}, '... details is {} as expected');
}
{
- local @ARGV = ('-verbose', '-f', 'foo.txt');
+ local @ARGV = ('--verbose', '--libs', 'libs/', '--libs', 'includes/lib');
my $app = App->new_with_options;
isa_ok($app, 'App');
ok($app->verbose, '... verbosity is turned on as expected');
is($app->length, 24, '... length is 24 as expected');
- is($app->data, 'foo.txt', '... data is foo.txt as expected');
+ is($app->data, 'file.dat', '... data is foo.txt as expected');
+ is_deeply($app->libs,
+ ['libs/', 'includes/lib'],
+ '... libs is [libs/, includes/lib] as expected');
+ is_deeply($app->details, {}, '... details is {} as expected');
+}
+
+{
+ local @ARGV = ('--details', 'os=mac', '--details', 'name=foo');
+
+ my $app = App->new_with_options;
+ isa_ok($app, 'App');
+
+ ok(!$app->verbose, '... verbosity is turned on as expected');
+ is($app->length, 24, '... length is 24 as expected');
+ is($app->data, 'file.dat', '... data is foo.txt as expected');
+ is_deeply($app->libs, [], '... libs is [] as expected');
+ is_deeply($app->details,
+ { os => 'mac', name => 'foo' },
+ '... details is { os => mac, name => foo } as expected');
}
{
- local @ARGV = ('-noverbose');
+ # Test negation on booleans too ...
+ local @ARGV = ('--noverbose');
my $app = App->new_with_options;
isa_ok($app, 'App');
ok(!$app->verbose, '... verbosity is turned off as expected');
is($app->length, 24, '... length is 24 as expected');
- is($app->data, 'file.dat', '... file is file.dat as expected');
+ is($app->data, 'file.dat', '... file is file.dat as expected');
+ is_deeply($app->libs, [], '... libs is [] as expected');
+ is_deeply($app->details, {}, '... details is {} as expected');
}
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+
+BEGIN {
+ use_ok('MooseX::Getopt');
+}
+
+{
+ package App;
+ use Moose;
+ use Moose::Util::TypeConstraints;
+
+ use Scalar::Util 'looks_like_number';
+
+ with 'MooseX::Getopt';
+
+ subtype 'ArrayOfInts'
+ => as 'ArrayRef'
+ => where { scalar (grep { looks_like_number($_) } @$_) };
+
+ MooseX::Getopt::OptionTypeMap->add_option_type_to_map(
+ 'ArrayOfInts' => '=i@'
+ );
+
+ has 'nums' => (
+ is => 'ro',
+ isa => 'ArrayOfInts',
+ default => sub { [0] }
+ );
+
+}
+
+{
+ local @ARGV = ();
+
+ my $app = App->new_with_options;
+ isa_ok($app, 'App');
+
+ is_deeply($app->nums, [0], '... nums is [0] as expected');
+}
+
+{
+ local @ARGV = ('--nums', 3, '--nums', 5);
+
+ my $app = App->new_with_options;
+ isa_ok($app, 'App');
+
+ is_deeply($app->nums, [3, 5], '... nums is [3, 5] as expected');
+}
+
projects / gitmo/MooseX-Getopt.git / commitdiff