X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FGetopt%2FGLD.pm;fp=lib%2FMooseX%2FGetopt%2FGLD.pm;h=819455da3f48a1c1240e643246891612190c11dc;hb=33edcaa4819f23f5c92f2f4db8b0163866156d22;hp=806d738592ff079d5f107f904d6f79d7daeab1da;hpb=07d7ec054e914c2687455ff823410104605689c1;p=gitmo%2FMooseX-Getopt.git diff --git a/lib/MooseX/Getopt/GLD.pm b/lib/MooseX/Getopt/GLD.pm index 806d738..819455d 100644 --- a/lib/MooseX/Getopt/GLD.pm +++ b/lib/MooseX/Getopt/GLD.pm @@ -1,25 +1,21 @@ -package MooseX::Getopt::GLD; +package MooseX::Getopt::GLD; use Moose::Role; -around '_getopt_spec' => sub { - my $orig = shift; - my $self = shift; +use Getopt::Long::Descriptive; - return $self->_gld_spec(@_); - # Ignore $orig, code for _gld_spec here -}; +with 'MooseX::Getopt::Basic'; -around '_get_options' => sub { - my $orig = shift; - my $class = shift; - - my ($params, $opt_spec) = @_; - return Getopt::Long::Descriptive::describe_options( - $class->_usage_format(%$params), @$opt_spec - ); +around _getopt_spec => sub { + shift; + shift->_gld_spec(@_); }; +around _getopt_get_options => sub { + shift; + my ($class, $params, $opt_spec) = @_; + return Getopt::Long::Descriptive::describe_options($class->_usage_format(%$params), @$opt_spec); +}; sub _gld_spec { my ( $class, %params ) = @_; @@ -44,7 +40,7 @@ sub _gld_spec { }, ]; - my $identifier = $opt->{name}; + my $identifier = lc($opt->{name}); $identifier =~ s/\W/_/g; # Getopt::Long does this to all option names $name_to_init_arg{$identifier} = $opt->{init_arg}; @@ -53,7 +49,7 @@ sub _gld_spec { return ( \@options, \%name_to_init_arg ); } -1; +no Moose::Role; 1; __END__ @@ -61,42 +57,37 @@ __END__ =head1 NAME -MooseX::Getopt::GLD - role to implement specific functionality for -L +MooseX::Getopt::GLD - A Moose role for processing command line options with Getopt::Long::Descriptive =head1 SYNOPSIS - -For internal use. -=head1 DESCRIPTION - -This is a role for C. - -=head1 METHODS + ## In your class + package My::App; + use Moose; -=over 4 + with 'MooseX::Getopt::GLD'; -=item meta + has 'out' => (is => 'rw', isa => 'Str', required => 1); + has 'in' => (is => 'rw', isa => 'Str', required => 1); -=back + # ... rest of the class here -=head1 BUGS + ## in your script + #!/usr/bin/perl -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. + use My::App; -=head1 AUTHOR + my $app = My::App->new_with_options(); + # ... rest of the script here -Dagfinn Ilmari MannsEker Eilmari@ilmari.orgE + ## on the command line + % perl my_app_script.pl -in file.input -out file.dump -Stevan Little Estevan@iinteractive.comE - -Yuval Kogman C<< >> +=head1 DESCRIPTION =head1 COPYRIGHT AND LICENSE -Copyright 2007-2008 by Infinity Interactive, Inc. +Copyright 2007-2009 by Infinity Interactive, Inc. L @@ -104,4 +95,3 @@ This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut -=head1