--- /dev/null
+use Module::Build;
+
+use strict;
+
+my $build = Module::Build->new(
+ module_name => 'MooseX::Getopt',
+ license => 'perl',
+ requires => {
+ 'Moose' => '0.17',
+ 'Getopt::Long' => '0',
+ },
+ 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;
+
--- /dev/null
+Revision history for Perl extension MooseX-Getopt
+
+0.01
+ - module created
\ No newline at end of file
--- /dev/null
+^_build
+^Build$
+^blib
+~$
+\.bak$
+^MANIFEST\.SKIP$
+CVS
+\.svn
+\.DS_Store
+cover_db
+\..*\.sw.?$
+^Makefile$
+^pm_to_blib$
+^MakeMaker-\d
+^blibdirs$
+\.old$
+^#.*#$
+^\.#
+^TODO$
\ No newline at end of file
--- /dev/null
+MooseX::Getopt version 0.01
+===========================
+
+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.
+
--- /dev/null
+
+package MooseX::Getopt;
+use Moose::Role;
+
+use Getopt::Long;
+
+use MooseX::Getopt::OptionTypes;
+use MooseX::Getopt::Meta::Attribute;
+
+sub new_with_options {
+ my ($class, %params) = @_;
+
+ my (%options, %constructor_options);
+ 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} = '';
+
+ 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);
+ }
+ }
+
+ $options{$name} = \($constructor_options{$init_arg});
+ }
+
+ GetOptions(%options);
+
+ # filter out options which
+ # were not passed at all
+ %constructor_options = map {
+ $constructor_options{$_} ne ''
+ ? ($_ => $constructor_options{$_})
+ : ()
+ } keys %constructor_options;
+
+ $class->new(%params, %constructor_options);
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::Getopt -
+
+=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
+
+=head1 METHODS
+
+=over 4
+
+=item B<new_with_options (%params)>
+
+=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@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
--- /dev/null
+
+package MooseX::Getopt::Meta::Attribute;
+use Moose;
+
+extends 'Moose::Meta::Attribute';
+
+has 'cmd_flag' => (
+ is => 'rw',
+ isa => 'Str',
+ predicate => 'has_cmd_flag',
+);
+
+1;
+
+__END__
+
+
+=pod
+
+=head1 NAME
+
+MooseX::Getopt::Meta::Attribute -
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=over 4
+
+=item B<cmd_flag>
+
+=item B<has_cmd_flag>
+
+=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@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
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok('MooseX::Getopt');
+}
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More no_plan => 1;
+
+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 'length' => (
+ is => 'ro',
+ isa => 'Int',
+ default => 24
+ );
+
+ has 'verbose' => (
+ is => 'ro',
+ isa => 'Bool',
+ );
+
+}
+
+{
+ 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');
+}
+
+{
+ 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');
+}
+
+{
+ 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');
+}
+
+{
+ 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');
+}
+
+
+
--- /dev/null
+#!/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();
--- /dev/null
+#!/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();
projects / gitmo/MooseX-Getopt.git / commitdiff