r6810 - in /branches/upstream/libmoosex-getopt-perl: ./ current/ current/lib/ current/lib/MooseX/ current/lib/MooseX/Getopt/ current/lib/MooseX/Getopt/Meta/ current/t/
dmn at users.alioth.debian.org
dmn at users.alioth.debian.org
Fri Aug 17 12:59:53 UTC 2007
Author: dmn
Date: Fri Aug 17 12:59:53 2007
New Revision: 6810
URL: http://svn.debian.org/wsvn/?sc=1&rev=6810
Log:
[svn-inject] Installing original source of libmoosex-getopt-perl
Added:
branches/upstream/libmoosex-getopt-perl/
branches/upstream/libmoosex-getopt-perl/current/
branches/upstream/libmoosex-getopt-perl/current/Build.PL
branches/upstream/libmoosex-getopt-perl/current/ChangeLog
branches/upstream/libmoosex-getopt-perl/current/MANIFEST
branches/upstream/libmoosex-getopt-perl/current/MANIFEST.SKIP
branches/upstream/libmoosex-getopt-perl/current/META.yml
branches/upstream/libmoosex-getopt-perl/current/Makefile.PL
branches/upstream/libmoosex-getopt-perl/current/README
branches/upstream/libmoosex-getopt-perl/current/lib/
branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/
branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/
branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt.pm (with props)
branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/Meta/
branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/Meta/Attribute.pm (with props)
branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/OptionTypeMap.pm (with props)
branches/upstream/libmoosex-getopt-perl/current/t/
branches/upstream/libmoosex-getopt-perl/current/t/000_load.t
branches/upstream/libmoosex-getopt-perl/current/t/001_basic.t
branches/upstream/libmoosex-getopt-perl/current/t/002_custom_option_type.t
branches/upstream/libmoosex-getopt-perl/current/t/003_inferred_option_type.t
branches/upstream/libmoosex-getopt-perl/current/t/pod.t
branches/upstream/libmoosex-getopt-perl/current/t/pod_coverage.t
Added: branches/upstream/libmoosex-getopt-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/Build.PL?rev=6810&op=file
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/Build.PL (added)
+++ branches/upstream/libmoosex-getopt-perl/current/Build.PL Fri Aug 17 12:59:53 2007
@@ -1,0 +1,26 @@
+use Module::Build;
+
+use strict;
+
+my $build = Module::Build->new(
+ module_name => 'MooseX::Getopt',
+ license => 'perl',
+ requires => {
+ 'Moose' => '0.19',
+ 'Getopt::Long' => '2.35',
+ },
+ optional => {
+ },
+ build_requires => {
+ 'Test::More' => '0.62',
+ 'Test::Exception' => '0.21',
+ },
+ create_makefile_pl => 'traditional',
+ recursive_test_files => 1,
+ add_to_cleanup => [
+ 'META.yml', '*.bak', '*.gz', 'Makefile.PL',
+ ],
+);
+
+$build->create_build_script;
+
Added: branches/upstream/libmoosex-getopt-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/ChangeLog?rev=6810&op=file
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/ChangeLog (added)
+++ branches/upstream/libmoosex-getopt-perl/current/ChangeLog Fri Aug 17 12:59:53 2007
@@ -1,0 +1,49 @@
+Revision history for Perl extension MooseX-Getopt
+
+0.05 Tues. July 3, 2007
+ * MooseX::Getopt::OptionTypeMap
+ - added some checks to make sure that the type
+ constraints are found properly and to give
+ better diagnostics
+
+0.04 Tues. June 26, 2007
+ * MooseX::Getopt::OptionTypeMap
+ - Added support for subtype constraint inference
+ from parent types
+ - added tests and docs for this
+ * MooseX::Getopt
+ - Added extra_argv attribute
+ - added tests and docs for this
+ - We now unmangle the Getopt::Long-mangled @ARGV
+ - added tests and docs for this
+ - We now throw an exception from new_with_options
+ if Getopt fails due to bad arguments.
+ - added tests and docs for this
+
+0.03 Wed. May 2nd, 2007
+ ~ downgraded the Getopt version requirement
+ to 2.35 as per RT #26844
+ ~ adding blblack to the authors list
+
+ * MooseX::Getopt
+ - doc update to show simple way to of excluding
+ an attribute, but not having accessors with
+ underscores (thanks to Zaba on #moose for this)
+ * MooseX::Getopt::Meta::Attribute
+ - tightening up the type constraint in the
+ cmd_alias coercion to only accept strings
+
+0.02 Friday, April 6, 2007
+ * MooseX::Getopt
+ - added the ARGV attribute (thanks to blblack)
+ - added tests and docs for this
+
+ * MooseX::Getopt::Meta::Attribute
+ - added the cmd_aliases attribute (thanks to blblack)
+ - added tests and docs for this
+ - added support for Moose 0.19's custom
+ attribute metaclass alias registry.
+ - added tests and docs for this
+
+0.01 Friday, March 9, 2007
+ - module released to CPAN
Added: branches/upstream/libmoosex-getopt-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/MANIFEST?rev=6810&op=file
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/MANIFEST (added)
+++ branches/upstream/libmoosex-getopt-perl/current/MANIFEST Fri Aug 17 12:59:53 2007
@@ -1,0 +1,16 @@
+Build.PL
+ChangeLog
+META.yml
+Makefile.PL
+MANIFEST
+MANIFEST.SKIP
+README
+lib/MooseX/Getopt.pm
+lib/MooseX/Getopt/OptionTypeMap.pm
+lib/MooseX/Getopt/Meta/Attribute.pm
+t/000_load.t
+t/001_basic.t
+t/002_custom_option_type.t
+t/003_inferred_option_type.t
+t/pod.t
+t/pod_coverage.t
Added: branches/upstream/libmoosex-getopt-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/MANIFEST.SKIP?rev=6810&op=file
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/MANIFEST.SKIP (added)
+++ branches/upstream/libmoosex-getopt-perl/current/MANIFEST.SKIP Fri Aug 17 12:59:53 2007
@@ -1,0 +1,19 @@
+^_build
+^Build$
+^blib
+~$
+\.bak$
+^MANIFEST\.SKIP$
+CVS
+\.svn
+\.DS_Store
+cover_db
+\..*\.sw.?$
+^Makefile$
+^pm_to_blib$
+^MakeMaker-\d
+^blibdirs$
+\.old$
+^#.*#$
+^\.#
+^TODO$
Added: branches/upstream/libmoosex-getopt-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/META.yml?rev=6810&op=file
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/META.yml (added)
+++ branches/upstream/libmoosex-getopt-perl/current/META.yml Fri Aug 17 12:59:53 2007
@@ -1,0 +1,32 @@
+---
+name: MooseX-Getopt
+version: 0.05
+author:
+ - 'Stevan Little E<lt>stevan at iinteractive.comE<gt>'
+ - 'Brandon L. Black, E<lt>blblack at gmail.comE<gt>'
+abstract: A Moose role for processing command line options
+license: perl
+resources:
+ license: http://dev.perl.org/licenses/
+requires:
+ Getopt::Long: 2.35
+ Moose: 0.19
+build_requires:
+ Test::Exception: 0.21
+ Test::More: 0.62
+provides:
+ Moose::Meta::Attribute::Custom::Getopt:
+ file: lib/MooseX/Getopt/Meta/Attribute.pm
+ MooseX::Getopt:
+ file: lib/MooseX/Getopt.pm
+ version: 0.05
+ MooseX::Getopt::Meta::Attribute:
+ file: lib/MooseX/Getopt/Meta/Attribute.pm
+ version: 0.03
+ MooseX::Getopt::OptionTypeMap:
+ file: lib/MooseX/Getopt/OptionTypeMap.pm
+ version: 0.03
+generated_by: Module::Build version 0.2805
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
Added: branches/upstream/libmoosex-getopt-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/Makefile.PL?rev=6810&op=file
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/Makefile.PL (added)
+++ branches/upstream/libmoosex-getopt-perl/current/Makefile.PL Fri Aug 17 12:59:53 2007
@@ -1,0 +1,17 @@
+# Note: this file was auto-generated by Module::Build::Compat version 0.03
+use ExtUtils::MakeMaker;
+WriteMakefile
+(
+ 'PL_FILES' => {},
+ 'INSTALLDIRS' => 'site',
+ 'NAME' => 'MooseX::Getopt',
+ 'EXE_FILES' => [],
+ 'VERSION_FROM' => 'lib/MooseX/Getopt.pm',
+ 'PREREQ_PM' => {
+ 'Test::More' => '0.62',
+ 'Getopt::Long' => '2.35',
+ 'Test::Exception' => '0.21',
+ 'Moose' => '0.19'
+ }
+ )
+;
Added: branches/upstream/libmoosex-getopt-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/README?rev=6810&op=file
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/README (added)
+++ branches/upstream/libmoosex-getopt-perl/current/README Fri Aug 17 12:59:53 2007
@@ -1,0 +1,30 @@
+MooseX::Getopt version 0.05
+===========================
+
+See the individual module documentation for more information
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ Moose
+ Getopt::Long
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2007 Infinity Interactive, Inc.
+
+http://www.iinteractive.com
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
Added: branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt.pm?rev=6810&op=file
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt.pm (added)
+++ branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt.pm Fri Aug 17 12:59:53 2007
@@ -1,0 +1,299 @@
+
+package MooseX::Getopt;
+use Moose::Role;
+
+use Getopt::Long ();
+
+use MooseX::Getopt::OptionTypeMap;
+use MooseX::Getopt::Meta::Attribute;
+
+our $VERSION = '0.05';
+our $AUTHORITY = 'cpan:STEVAN';
+
+has ARGV => (is => 'rw', isa => 'ArrayRef');
+has extra_argv => (is => 'rw', isa => 'ArrayRef');
+
+sub new_with_options {
+ my ($class, %params) = @_;
+
+ my (@options, %name_to_init_arg);
+ foreach my $attr ($class->meta->compute_all_applicable_attributes) {
+ my $name = $attr->name;
+
+ my $aliases;
+
+ if ($attr->isa('MooseX::Getopt::Meta::Attribute')) {
+ $name = $attr->cmd_flag if $attr->has_cmd_flag;
+ $aliases = $attr->cmd_aliases if $attr->has_cmd_aliases;
+ }
+ else {
+ next if $name =~ /^_/;
+ }
+
+ $name_to_init_arg{$name} = $attr->init_arg;
+
+ my $opt_string = $aliases
+ ? join(q{|}, $name, @$aliases)
+ : $name;
+
+ if ($attr->has_type_constraint) {
+ my $type_name = $attr->type_constraint->name;
+ if (MooseX::Getopt::OptionTypeMap->has_option_type($type_name)) {
+ $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type_name);
+ }
+ }
+
+ push @options => $opt_string;
+ }
+
+ my %options;
+
+ # Get a clean copy of the original @ARGV
+ my $argv_copy = [ @ARGV ];
+
+ {
+ local $SIG{__WARN__} = sub { die $_[0] };
+ Getopt::Long::GetOptions(\%options, @options);
+ }
+
+ # Get a copy of the Getopt::Long-mangled @ARGV
+ my $argv_mangled = [ @ARGV ];
+
+ # Restore the original @ARGV;
+ @ARGV = @$argv_copy;
+
+ #use Data::Dumper;
+ #warn Dumper \@options;
+ #warn Dumper \%name_to_init_arg;
+ #warn Dumper \%options;
+
+ $class->new(
+ ARGV => $argv_copy,
+ extra_argv => $argv_mangled,
+ %params,
+ map {
+ $name_to_init_arg{$_} => $options{$_}
+ } keys %options,
+ );
+}
+
+no Moose::Role; 1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::Getopt - A Moose role for processing command line options
+
+=head1 SYNOPSIS
+
+ ## In your class
+ package My::App;
+ use Moose;
+
+ with 'MooseX::Getopt';
+
+ has 'out' => (is => 'rw', isa => 'Str', required => 1);
+ has 'in' => (is => 'rw', isa => 'Str', required => 1);
+
+ # ... rest of the class here
+
+ ## in your script
+ #!/usr/bin/perl
+
+ use My::App;
+
+ my $app = My::App->new_with_options();
+ # ... rest of the script here
+
+ ## on the command line
+ % perl my_app_script.pl -in file.input -out file.dump
+
+=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.
+
+You can use the attribute metaclass L<MooseX::Getopt::Meta::Attribute>
+to get non-default commandline option names and aliases.
+
+By default, attributes which start with an underscore are not given
+commandline argument support, unless the attribute's metaclass is set
+to L<MooseX::Getopt::Meta::Attribute>. If you don't want you accessors
+to have the leading underscore in thier name, you can do this:
+
+ # for read/write attributes
+ has '_foo' => (accessor => 'foo', ...);
+
+ # or for read-only attributes
+ has '_bar' => (reader => 'bar', ...);
+
+This will mean that Getopt will not handle a --foo param, but your
+code can still call the C<foo> method.
+
+=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 :)
+
+=head2 Inferred Type Constraints
+
+If you define a custom subtype which is a subtype of one of the
+standard L</Supported Type Constraints> above, and do not explicitly
+provide custom support as in L</Custom Type Constraints> above,
+MooseX::Getopt will treat it like the parent type for Getopt
+purposes.
+
+For example, if you had the same custom C<ArrayOfInts> subtype
+from the examples above, but did not add a new custom option
+type for it to the C<OptionTypeMap>, it would be treated just
+like a normal C<ArrayRef> type for Getopt purposes (that is,
+C<=s@>).
+
+=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.
+
+If L<Getopt::Long/GetOptions> fails (due to invalid arguments),
+C<new_with_options> will throw an exception.
+
+=item B<ARGV>
+
+This accessor contains a reference to a copy of the C<@ARGV> array
+as it originally existed at the time of C<new_with_options>.
+
+=item B<extra_argv>
+
+This accessor contains an arrayref of leftover C<@ARGV> elements that
+L<Getopt::Long> did not parse. Note that the real C<@ARGV> is left
+un-mangled.
+
+=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 at iinteractive.comE<gt>
+
+Brandon L. Black, E<lt>blblack at gmail.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
Propchange: branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt.pm
------------------------------------------------------------------------------
svn:keywords = Id
Added: branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/Meta/Attribute.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/Meta/Attribute.pm?rev=6810&op=file
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/Meta/Attribute.pm (added)
+++ branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/Meta/Attribute.pm Fri Aug 17 12:59:53 2007
@@ -1,0 +1,140 @@
+
+package MooseX::Getopt::Meta::Attribute;
+use Moose;
+use Moose::Util::TypeConstraints;
+
+our $VERSION = '0.03';
+our $AUTHORITY = 'cpan:STEVAN';
+
+extends 'Moose::Meta::Attribute'; # << Moose extending Moose :)
+
+has 'cmd_flag' => (
+ is => 'rw',
+ isa => 'Str',
+ predicate => 'has_cmd_flag',
+);
+
+# This subtype is to support scalar -> arrayref coercion
+# without polluting the built-in types
+subtype '_MooseX_Getopt_CmdAliases'
+ => as 'ArrayRef'
+ => where { 1 };
+
+coerce '_MooseX_Getopt_CmdAliases'
+ => from 'Str'
+ => via { [$_] };
+
+has 'cmd_aliases' => (
+ is => 'rw',
+ isa => '_MooseX_Getopt_CmdAliases',
+ predicate => 'has_cmd_aliases',
+ coerce => 1,
+);
+
+no Moose;
+
+# register this as a metaclass alias ...
+package Moose::Meta::Attribute::Custom::Getopt;
+sub register_implementation { 'MooseX::Getopt::Meta::Attribute' }
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+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 --somedata as the
+ # command line flag instead of the normal
+ # autogenerated one (--data)
+ cmd_flag => 'somedata',
+
+ # tells MooseX::Getopt to also allow --moosedata,
+ # -m, and -d as aliases for this same option on
+ # the commandline.
+ cmd_aliases => [qw/ moosedata m d /],
+
+ # Or, you can use a plain scalar for a single alias:
+ cmd_aliases => 'm',
+ );
+
+=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.
+
+=head2 Custom Metaclass alias
+
+This now takes advantage of the Moose 0.19 feature to support
+custom attribute metaclass aliases. This means you can also
+use this as the B<Getopt> alias, like so:
+
+ has 'foo' => (metaclass => 'Getopt', cmd_flag => 'f');
+
+=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>
+
+Changes the commandline flag to be this value, instead of the default,
+which is the same as the attribute name.
+
+=item B<cmd_aliases>
+
+Adds more aliases for this commandline flag, useful for short options
+and such.
+
+=item B<has_cmd_flag>
+
+=item B<has_cmd_aliases>
+
+=item B<meta>
+
+=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 at iinteractive.comE<gt>
+
+Brandon L. Black, E<lt>blblack at gmail.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
Propchange: branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/Meta/Attribute.pm
------------------------------------------------------------------------------
svn:keywords = Id
Added: branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/OptionTypeMap.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/OptionTypeMap.pm?rev=6810&op=file
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/OptionTypeMap.pm (added)
+++ branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/OptionTypeMap.pm Fri Aug 17 12:59:53 2007
@@ -1,0 +1,114 @@
+
+package MooseX::Getopt::OptionTypeMap;
+
+use Moose 'confess';
+use Moose::Util::TypeConstraints 'find_type_constraint';
+
+our $VERSION = '0.03';
+our $AUTHORITY = 'cpan:STEVAN';
+
+my %option_type_map = (
+ 'Bool' => '!',
+ 'Str' => '=s',
+ 'Int' => '=i',
+ 'Float' => '=f',
+ 'ArrayRef' => '=s@',
+ 'HashRef' => '=s%',
+);
+
+sub has_option_type {
+ my (undef, $type_name) = @_;
+ return 1 if exists $option_type_map{$type_name};
+
+ my $current = find_type_constraint($type_name);
+
+ (defined $current)
+ || confess "Could not find the type constraint for '$type_name'";
+
+ while (my $parent = $current->parent) {
+ return 1 if exists $option_type_map{$parent->name};
+ $current = $parent;
+ }
+
+ return 0;
+}
+
+sub get_option_type {
+ my (undef, $type_name) = @_;
+
+ return $option_type_map{$type_name}
+ if exists $option_type_map{$type_name};
+
+ my $current = find_type_constraint($type_name);
+
+ (defined $current)
+ || confess "Could not find the type constraint for '$type_name'";
+
+ while (my $parent = $current->parent) {
+ return $option_type_map{$parent->name}
+ if exists $option_type_map{$parent->name};
+ $current = $parent;
+ }
+
+ return;
+}
+
+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 at 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
Propchange: branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/OptionTypeMap.pm
------------------------------------------------------------------------------
svn:keywords = Id
Added: branches/upstream/libmoosex-getopt-perl/current/t/000_load.t
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/t/000_load.t?rev=6810&op=file
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/t/000_load.t (added)
+++ branches/upstream/libmoosex-getopt-perl/current/t/000_load.t Fri Aug 17 12:59:53 2007
@@ -1,0 +1,10 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok('MooseX::Getopt');
+}
Added: branches/upstream/libmoosex-getopt-perl/current/t/001_basic.t
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/t/001_basic.t?rev=6810&op=file
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/t/001_basic.t (added)
+++ branches/upstream/libmoosex-getopt-perl/current/t/001_basic.t Fri Aug 17 12:59:53 2007
@@ -1,0 +1,216 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 53;
+
+BEGIN {
+ use_ok('MooseX::Getopt');
+}
+
+{
+ package App;
+ use Moose;
+
+ with 'MooseX::Getopt';
+
+ has 'data' => (
+ metaclass => 'MooseX::Getopt::Meta::Attribute',
+ is => 'ro',
+ isa => 'Str',
+ default => 'file.dat',
+ cmd_flag => 'f',
+ );
+
+ has 'cow' => (
+ metaclass => 'Getopt',
+ is => 'ro',
+ isa => 'Str',
+ default => 'moo',
+ cmd_aliases => [qw/ moocow m c /],
+ );
+
+ has 'horse' => (
+ metaclass => 'MooseX::Getopt::Meta::Attribute',
+ is => 'ro',
+ isa => 'Str',
+ default => 'bray',
+ cmd_flag => 'horsey',
+ cmd_aliases => 'x',
+ );
+
+ has 'length' => (
+ is => 'ro',
+ isa => 'Int',
+ default => 24
+ );
+
+ has 'verbose' => (
+ is => 'ro',
+ isa => 'Bool',
+ );
+
+ has 'libs' => (
+ is => 'ro',
+ isa => 'ArrayRef',
+ default => sub { [] },
+ );
+
+ has 'details' => (
+ is => 'ro',
+ isa => 'HashRef',
+ default => sub { {} },
+ );
+
+ has '_private_stuff' => (
+ is => 'ro',
+ isa => 'Int',
+ default => 713
+ );
+
+ has '_private_stuff_cmdline' => (
+ metaclass => 'MooseX::Getopt::Meta::Attribute',
+ is => 'ro',
+ isa => 'Int',
+ default => 832,
+ cmd_flag => 'p',
+ );
+
+}
+
+{
+ local @ARGV = ();
+
+ my $app = App->new_with_options;
+ isa_ok($app, 'App');
+
+ 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);
+
+ 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_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', '--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, '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');
+}
+
+{
+ # 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_deeply($app->libs, [], '... libs is [] as expected');
+ is_deeply($app->details, {}, '... details is {} as expected');
+}
+
+# Test cmd_alias without cmd_flag
+{
+ local @ARGV = ('--cow', '42');
+ my $app = App->new_with_options;
+ isa_ok($app, 'App');
+ is($app->cow, 42, 'cmd_alias, but not using it');
+}
+{
+ local @ARGV = ('--moocow', '88');
+ my $app = App->new_with_options;
+ isa_ok($app, 'App');
+ is($app->cow, 88, 'cmd_alias, using long one');
+}
+{
+ local @ARGV = ('-c', '99');
+ my $app = App->new_with_options;
+ isa_ok($app, 'App');
+ is($app->cow, 99, 'cmd_alias, using short one');
+}
+
+# Test cmd_alias + cmd_flag
+{
+ local @ARGV = ('--horsey', '123');
+ my $app = App->new_with_options;
+ isa_ok($app, 'App');
+ is($app->horse, 123, 'cmd_alias+cmd_flag, using flag');
+}
+{
+ local @ARGV = ('-x', '321');
+ my $app = App->new_with_options;
+ isa_ok($app, 'App');
+ is($app->horse, 321, 'cmd_alias+cmd_flag, using alias');
+}
+
+# Test _foo + cmd_flag
+{
+ local @ARGV = ('-p', '666');
+ my $app = App->new_with_options;
+ isa_ok($app, 'App');
+ is($app->_private_stuff_cmdline, 666, '_foo + cmd_flag');
+}
+
+# Test ARGV support
+{
+ my @args = ('-p', 12345, '-c', 99, '-');
+ local @ARGV = @args;
+ my $app = App->new_with_options;
+ isa_ok($app, 'App');
+ is_deeply($app->ARGV, \@args, 'ARGV accessor');
+ is_deeply(\@ARGV, \@args, '@ARGV unmangled');
+ is_deeply($app->extra_argv, ['-'], 'extra_argv accessor');
+}
Added: branches/upstream/libmoosex-getopt-perl/current/t/002_custom_option_type.t
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/t/002_custom_option_type.t?rev=6810&op=file
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/t/002_custom_option_type.t (added)
+++ branches/upstream/libmoosex-getopt-perl/current/t/002_custom_option_type.t Fri Aug 17 12:59:53 2007
@@ -1,0 +1,63 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 6;
+
+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');
+}
+
+# Make sure it really used our =i@, instead of falling back
+# to =s@ via the type system, and test that exceptions work
+# while we're at it.
+eval {
+ local @ARGV = ('--nums', 3, '--nums', 'foo');
+
+ my $app = App->new_with_options;
+};
+like($@, qr/Value "foo" invalid/, 'Numeric constraint enforced');
Added: branches/upstream/libmoosex-getopt-perl/current/t/003_inferred_option_type.t
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/t/003_inferred_option_type.t?rev=6810&op=file
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/t/003_inferred_option_type.t (added)
+++ branches/upstream/libmoosex-getopt-perl/current/t/003_inferred_option_type.t Fri Aug 17 12:59:53 2007
@@ -1,0 +1,50 @@
+#!/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($_) } @$_) };
+
+ 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');
+}
+
Added: branches/upstream/libmoosex-getopt-perl/current/t/pod.t
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/t/pod.t?rev=6810&op=file
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/t/pod.t (added)
+++ branches/upstream/libmoosex-getopt-perl/current/t/pod.t Fri Aug 17 12:59:53 2007
@@ -1,0 +1,11 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+
+all_pod_files_ok();
Added: branches/upstream/libmoosex-getopt-perl/current/t/pod_coverage.t
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/t/pod_coverage.t?rev=6810&op=file
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/t/pod_coverage.t (added)
+++ branches/upstream/libmoosex-getopt-perl/current/t/pod_coverage.t Fri Aug 17 12:59:53 2007
@@ -1,0 +1,11 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+
+all_pod_coverage_ok();
More information about the Pkg-perl-cvs-commits
mailing list