r11241 - in /branches/upstream/libmoosex-getopt-perl/current: ./ lib/MooseX/ lib/MooseX/Getopt/ lib/MooseX/Getopt/Meta/ lib/MooseX/Getopt/Meta/Attribute/ t/
gregoa-guest at users.alioth.debian.org
gregoa-guest at users.alioth.debian.org
Sun Dec 16 19:46:02 UTC 2007
Author: gregoa-guest
Date: Sun Dec 16 19:46:01 2007
New Revision: 11241
URL: http://svn.debian.org/wsvn/?sc=1&rev=11241
Log:
[svn-upgrade] Integrating new upstream version, libmoosex-getopt-perl (0.07)
Added:
branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/Meta/Attribute/
branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/Meta/Attribute/NoGetopt.pm
branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/Strict.pm
branches/upstream/libmoosex-getopt-perl/current/t/004_nogetop.t
branches/upstream/libmoosex-getopt-perl/current/t/005_strict.t
Modified:
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/META.yml
branches/upstream/libmoosex-getopt-perl/current/Makefile.PL
branches/upstream/libmoosex-getopt-perl/current/README
branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt.pm
branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/Meta/Attribute.pm
branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/OptionTypeMap.pm
Modified: branches/upstream/libmoosex-getopt-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/Build.PL?rev=11241&op=diff
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/Build.PL (original)
+++ branches/upstream/libmoosex-getopt-perl/current/Build.PL Sun Dec 16 19:46:01 2007
@@ -7,7 +7,7 @@
license => 'perl',
requires => {
'Moose' => '0.19',
- 'Getopt::Long' => '2.35',
+ 'Getopt::Long' => '2.34',
},
optional => {
},
Modified: branches/upstream/libmoosex-getopt-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/ChangeLog?rev=11241&op=diff
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/ChangeLog (original)
+++ branches/upstream/libmoosex-getopt-perl/current/ChangeLog Sun Dec 16 19:46:01 2007
@@ -1,4 +1,26 @@
Revision history for Perl extension MooseX-Getopt
+
+0.07 Tues. Dec. 4, 2007
+ * MooseX::Getopt::Meta::Attribute::NoGetopt
+ - fixed miscapitalization of NoGetopt in the docs
+
+0.06 Fri. Nov. 23, 2007
+ * MooseX::Getopt
+ - refactored &new_with_option some so that
+ this will work better with other Getopt
+ modules (nuffin)
+
+ + MooseX::Getopt::Strict
+ - version of MooseX::Getopt which requires
+ you to specify which attributes you want
+ processed explicity
+ - added tests for this
+
+ + MooseX::Getopt::Meta::Attribute::NoGetopt
+ - a custom meta-attribute which can be
+ used to specify that an attribute should
+ not be processed
+ - added tests for this
0.05 Tues. July 3, 2007
* MooseX::Getopt::OptionTypeMap
Modified: branches/upstream/libmoosex-getopt-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/MANIFEST?rev=11241&op=diff
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/MANIFEST (original)
+++ branches/upstream/libmoosex-getopt-perl/current/MANIFEST Sun Dec 16 19:46:01 2007
@@ -7,10 +7,14 @@
README
lib/MooseX/Getopt.pm
lib/MooseX/Getopt/OptionTypeMap.pm
+lib/MooseX/Getopt/Strict.pm
lib/MooseX/Getopt/Meta/Attribute.pm
+lib/MooseX/Getopt/Meta/Attribute/NoGetopt.pm
t/000_load.t
t/001_basic.t
t/002_custom_option_type.t
t/003_inferred_option_type.t
+t/004_nogetop.t
+t/005_strict.t
t/pod.t
t/pod_coverage.t
Modified: branches/upstream/libmoosex-getopt-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/META.yml?rev=11241&op=diff
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/META.yml (original)
+++ branches/upstream/libmoosex-getopt-perl/current/META.yml Sun Dec 16 19:46:01 2007
@@ -1,6 +1,6 @@
---
name: MooseX-Getopt
-version: 0.05
+version: 0.07
author:
- 'Stevan Little E<lt>stevan at iinteractive.comE<gt>'
- 'Brandon L. Black, E<lt>blblack at gmail.comE<gt>'
@@ -9,24 +9,27 @@
resources:
license: http://dev.perl.org/licenses/
requires:
- Getopt::Long: 2.35
+ Getopt::Long: 2.34
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
+ version: 0.07
MooseX::Getopt::Meta::Attribute:
file: lib/MooseX/Getopt/Meta/Attribute.pm
- version: 0.03
+ version: 0.04
+ MooseX::Getopt::Meta::Attribute::NoGetopt:
+ file: lib/MooseX/Getopt/Meta/Attribute/NoGetopt.pm
+ version: 0.01
MooseX::Getopt::OptionTypeMap:
file: lib/MooseX/Getopt/OptionTypeMap.pm
version: 0.03
-generated_by: Module::Build version 0.2805
+ MooseX::Getopt::Strict:
+ file: lib/MooseX/Getopt/Strict.pm
+generated_by: Module::Build version 0.2808
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.2.html
version: 1.2
Modified: branches/upstream/libmoosex-getopt-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/Makefile.PL?rev=11241&op=diff
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/Makefile.PL (original)
+++ branches/upstream/libmoosex-getopt-perl/current/Makefile.PL Sun Dec 16 19:46:01 2007
@@ -2,16 +2,16 @@
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',
+ 'Getopt::Long' => '2.34',
+ 'Moose' => '0.19',
'Test::Exception' => '0.21',
- 'Moose' => '0.19'
- }
+ 'Test::More' => '0.62'
+ },
+ 'INSTALLDIRS' => 'site',
+ 'EXE_FILES' => [],
+ 'PL_FILES' => {}
)
;
Modified: branches/upstream/libmoosex-getopt-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/README?rev=11241&op=diff
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/README (original)
+++ branches/upstream/libmoosex-getopt-perl/current/README Sun Dec 16 19:46:01 2007
@@ -1,4 +1,4 @@
-MooseX::Getopt version 0.05
+MooseX::Getopt version 0.07
===========================
See the individual module documentation for more information
Modified: 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=11241&op=diff
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt.pm (original)
+++ branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt.pm Sun Dec 16 19:46:01 2007
@@ -6,18 +6,82 @@
use MooseX::Getopt::OptionTypeMap;
use MooseX::Getopt::Meta::Attribute;
-
-our $VERSION = '0.05';
+use MooseX::Getopt::Meta::Attribute::NoGetopt;
+
+our $VERSION = '0.07';
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 ($class, @params) = @_;
+
+ my %processed = $class->_parse_argv(
+ options => [
+ $class->_attrs_to_options( @params )
+ ]
+ );
+
+ $class->new(
+ ARGV => $processed{argv_copy},
+ extra_argv => $processed{argv},
+ @params, # explicit params to ->new
+ %{ $processed{params} }, # params from CLI
+ );
+}
+
+sub _parse_argv {
+ my ( $class, %params ) = @_;
+
+ local @ARGV = @{ $params{argv} || \@ARGV };
+
+ my ( @options, %name_to_init_arg, %options );
+
+ foreach my $opt ( @{ $params{options} } ) {
+ push @options, $opt->{opt_string};
+ $name_to_init_arg{ $opt->{name} } = $opt->{init_arg};
+ }
+
+ # 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 ];
+
+ return (
+ argv_copy => $argv_copy,
+ argv => $argv_mangled,
+ params => {
+ map {
+ $name_to_init_arg{$_} => $options{$_}
+ } keys %options,
+ }
+ );
+}
+
+sub _compute_getopt_attrs {
+ my $class = shift;
+ grep {
+ $_->isa("MooseX::Getopt::Meta::Attribute")
+ or
+ $_->name !~ /^_/
+ &&
+ !$_->isa('MooseX::Getopt::Meta::Attribute::NoGetopt')
+ } $class->meta->compute_all_applicable_attributes
+}
+
+sub _attrs_to_options {
+ my $class = shift;
+
+ my @options;
+
+ foreach my $attr ($class->_compute_getopt_attrs) {
my $name = $attr->name;
my $aliases;
@@ -26,12 +90,7 @@
$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;
@@ -42,39 +101,17 @@
$opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type_name);
}
}
-
- push @options => $opt_string;
+
+ push @options, {
+ name => $name,
+ init_arg => $attr->init_arg,
+ opt_string => $opt_string,
+ required => $attr->is_required,
+ ( $attr->has_documentation ? ( doc => $attr->documentation ) : () ),
+ }
}
- 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,
- );
+ return @options;
}
no Moose::Role; 1;
@@ -125,6 +162,9 @@
You can use the attribute metaclass L<MooseX::Getopt::Meta::Attribute>
to get non-default commandline option names and aliases.
+You can use the attribute metaclass L<MooseX::Getopt::Meta::Attribute::NoGetOpt>
+to have C<MooseX::Getopt> ignore your attribute in the commandline options.
+
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
Modified: 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=11241&op=diff
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/Meta/Attribute.pm (original)
+++ branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/Meta/Attribute.pm Sun Dec 16 19:46:01 2007
@@ -3,7 +3,7 @@
use Moose;
use Moose::Util::TypeConstraints;
-our $VERSION = '0.03';
+our $VERSION = '0.04';
our $AUTHORITY = 'cpan:STEVAN';
extends 'Moose::Meta::Attribute'; # << Moose extending Moose :)
@@ -16,9 +16,7 @@
# This subtype is to support scalar -> arrayref coercion
# without polluting the built-in types
-subtype '_MooseX_Getopt_CmdAliases'
- => as 'ArrayRef'
- => where { 1 };
+subtype '_MooseX_Getopt_CmdAliases' => as 'ArrayRef';
coerce '_MooseX_Getopt_CmdAliases'
=> from 'Str'
@@ -34,7 +32,8 @@
no Moose;
# register this as a metaclass alias ...
-package Moose::Meta::Attribute::Custom::Getopt;
+package # stop confusing PAUSE
+ Moose::Meta::Attribute::Custom::Getopt;
sub register_implementation { 'MooseX::Getopt::Meta::Attribute' }
1;
Added: branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/Meta/Attribute/NoGetopt.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/Meta/Attribute/NoGetopt.pm?rev=11241&op=file
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/Meta/Attribute/NoGetopt.pm (added)
+++ branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/Meta/Attribute/NoGetopt.pm Sun Dec 16 19:46:01 2007
@@ -1,0 +1,79 @@
+
+package MooseX::Getopt::Meta::Attribute::NoGetopt;
+use Moose;
+
+our $VERSION = '0.01';
+our $AUTHORITY = 'cpan:STEVAN';
+
+extends 'Moose::Meta::Attribute'; # << Moose extending Moose :)
+
+no Moose;
+
+# register this as a metaclass alias ...
+package # stop confusing PAUSE
+ Moose::Meta::Attribute::Custom::NoGetopt;
+sub register_implementation { 'MooseX::Getopt::Meta::Attribute::NoGetopt' }
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::Getopt::Meta::Attribute::NoGetopt - Optional meta attribute for ignoring params
+
+=head1 SYNOPSIS
+
+ package App;
+ use Moose;
+
+ with 'MooseX::Getopt';
+
+ has 'data' => (
+ metaclass => 'NoGetopt', # do not attempt to capture this param
+ is => 'ro',
+ isa => 'Str',
+ default => 'file.dat',
+ );
+
+=head1 DESCRIPTION
+
+This is a custom attribute metaclass which can be used to specify
+that a specific attribute should B<not> be processed by
+C<MooseX::Getopt>. All you need to do is specify the C<NoGetopt>
+metaclass.
+
+ has 'foo' => (metaclass => 'NoGetopt', ... );
+
+=head1 METHODS
+
+=over 4
+
+=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>
+
+Chris Prather C<< <perigrin at cpan.org> >>
+
+=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
Modified: 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=11241&op=diff
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/OptionTypeMap.pm (original)
+++ branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/OptionTypeMap.pm Sun Dec 16 19:46:01 2007
@@ -90,6 +90,8 @@
=item B<add_option_type_to_map ($type_name, $option_spec)>
+=item B<meta>
+
=back
=head1 BUGS
Added: branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/Strict.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/Strict.pm?rev=11241&op=file
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/Strict.pm (added)
+++ branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/Strict.pm Sun Dec 16 19:46:01 2007
@@ -1,0 +1,60 @@
+
+package MooseX::Getopt::Strict;
+use Moose::Role;
+
+with 'MooseX::Getopt';
+
+around '_compute_getopt_attrs' => sub {
+ my $next = shift;
+ my ( $class, @args ) = @_;
+ grep {
+ $_->isa("MooseX::Getopt::Meta::Attribute")
+ } $class->$next(@args);
+};
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::Getopt::Strict - only make options for attrs with the Getopt metaclass
+
+=head1 DESCRIPTION
+
+This is an stricter version of C<MooseX::Getopt> which only processes the
+attributes if they explicitly set as C<Getopt> attributes. All other attributes
+are ignored by the command line handler.
+
+=head1 METHODS
+
+=over 4
+
+=item 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>
+
+Yuval Kogman C<< <nuffin at cpan.org> >>
+
+=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
Added: branches/upstream/libmoosex-getopt-perl/current/t/004_nogetop.t
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/t/004_nogetop.t?rev=11241&op=file
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/t/004_nogetop.t (added)
+++ branches/upstream/libmoosex-getopt-perl/current/t/004_nogetop.t Sun Dec 16 19:46:01 2007
@@ -1,0 +1,102 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 9;
+use Test::Exception;
+
+BEGIN {
+ use_ok('MooseX::Getopt');
+}
+
+{
+ package App;
+ use Moose;
+
+ with 'MooseX::Getopt';
+
+ has 'data' => (
+ metaclass => 'Getopt',
+ 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 => 'Getopt',
+ 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' => (
+ metaclass => 'NoGetopt',
+ is => 'ro',
+ isa => 'Int',
+ default => 713
+ );
+
+ has '_private_stuff_cmdline' => (
+ metaclass => 'Getopt',
+ 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' );
+ is($app->private_stuff, 713, '... private stuff is 713 as expected');
+}
+
+{
+ local @ARGV = (qw/--private_stuff 317/);
+
+ throws_ok { App->new_with_options } qr/Unknown option: private_stuff/;
+}
Added: branches/upstream/libmoosex-getopt-perl/current/t/005_strict.t
URL: http://svn.debian.org/wsvn/branches/upstream/libmoosex-getopt-perl/current/t/005_strict.t?rev=11241&op=file
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/t/005_strict.t (added)
+++ branches/upstream/libmoosex-getopt-perl/current/t/005_strict.t Sun Dec 16 19:46:01 2007
@@ -1,0 +1,108 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 10;
+use Test::Exception;
+
+BEGIN {
+ use_ok('MooseX::Getopt');
+}
+
+{
+
+ package App;
+ use Moose;
+
+ with 'MooseX::Getopt::Strict';
+
+ has 'data' => (
+ metaclass => 'Getopt',
+ 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 => 'Getopt',
+ 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' => (
+ 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' );
+ is($app->private_stuff, 713, '... private stuff is 713 as expected');
+}
+
+{
+ local @ARGV = (qw/--private_stuff 317/);
+
+ throws_ok { App->new_with_options } qr/Unknown option: private_stuff/;
+}
+
+{
+ local @ARGV = (qw/--length 100/);
+
+ throws_ok { App->new_with_options } qr/Unknown option: length/;
+}
+
More information about the Pkg-perl-cvs-commits
mailing list