X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FGetopt%2FGLD.pm;h=fde79a8bdc8267ff4a8194364e085399209212d8;hb=a9e27700692fd9cd3c6b83deb3718d199c1646d0;hp=806d738592ff079d5f107f904d6f79d7daeab1da;hpb=a20996695460dc338556f0435299555074c76c34;p=gitmo%2FMooseX-Getopt.git

diff --git a/lib/MooseX/Getopt/GLD.pm b/lib/MooseX/Getopt/GLD.pm
index 806d738..fde79a8 100644
--- a/lib/MooseX/Getopt/GLD.pm
+++ b/lib/MooseX/Getopt/GLD.pm
@@ -1,107 +1,120 @@
 package MooseX::Getopt::GLD;
+# ABSTRACT: A Moose role for processing command line options with Getopt::Long::Descriptive
 
-use Moose::Role;
+use MooseX::Role::Parameterized;
 
-around '_getopt_spec' => sub {
-    my $orig = shift;
-    my $self = shift;
+use Getopt::Long::Descriptive 0.081;
 
-    return $self->_gld_spec(@_);
-    # Ignore $orig, code for _gld_spec here
-};
-
-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
-    );
-};
+with 'MooseX::Getopt::Basic';
 
+parameter getopt_conf => (
+    isa => 'ArrayRef[Str]',
+    default => sub { [] },
+);
 
-sub _gld_spec {
-    my ( $class, %params ) = @_;
+role {
 
-    my ( @options, %name_to_init_arg );
+    my $p = shift;
+    my $getopt_conf = $p->getopt_conf;
 
-    my $constructor_params = $params{params};
-
-    foreach my $opt ( @{ $params{options} } ) {
-        push @options, [
-            $opt->{opt_string},
-            $opt->{doc} || ' ', # FIXME new GLD shouldn't need this hack
-            {
-                ( ( $opt->{required} && !exists($constructor_params->{$opt->{init_arg}}) ) ? (required => $opt->{required}) : () ),
-                # NOTE:
-                # remove this 'feature' because it didn't work 
-                # all the time, and so is better to not bother
-                # since Moose will handle the defaults just 
-                # fine anyway.
-                # - SL
-                #( exists $opt->{default}  ? (default  => $opt->{default})  : () ),
-            },
-        ];
+    has usage => (
+        is => 'rw', isa => 'Getopt::Long::Descriptive::Usage',
+        traits => ['NoGetopt'],
+    );
 
-        my $identifier = $opt->{name};
-        $identifier =~ s/\W/_/g; # Getopt::Long does this to all option names
+    # captures the options: --help --usage --?
+    has help_flag => (
+        is => 'ro', isa => 'Bool',
+        traits => ['Getopt'],
+        cmd_flag => 'help',
+        cmd_aliases => [ qw(usage ?) ],
+        documentation => 'Prints this usage information.',
+    );
 
-        $name_to_init_arg{$identifier} = $opt->{init_arg};
+    around _getopt_spec => sub {
+        shift;
+        shift->_gld_spec(@_);
+    };
+
+    around _getopt_get_options => sub {
+        shift;
+        my ($class, $params, $opt_spec) = @_;
+        # Check if a special args hash were already passed, or create a new one
+        my $args = ref($opt_spec->[-1]) eq 'HASH' ? pop @$opt_spec : {};
+        unshift @{$args->{getopt_conf}}, @$getopt_conf;
+        push @$opt_spec, $args;
+        return Getopt::Long::Descriptive::describe_options($class->_usage_format(%$params), @$opt_spec);
+    };
+
+    method _gld_spec => sub {
+        my ( $class, %params ) = @_;
+
+        my ( @options, %name_to_init_arg );
+
+        my $constructor_params = $params{params};
+
+        foreach my $opt ( @{ $params{options} } ) {
+            push @options, [
+                $opt->{opt_string},
+                $opt->{doc} || ' ', # FIXME new GLD shouldn't need this hack
+                {
+                    ( ( $opt->{required} && !exists($constructor_params->{$opt->{init_arg}}) ) ? (required => $opt->{required}) : () ),
+                    # NOTE:
+                    # remove this 'feature' because it didn't work
+                    # all the time, and so is better to not bother
+                    # since Moose will handle the defaults just
+                    # fine anyway.
+                    # - SL
+                    #( exists $opt->{default}  ? (default  => $opt->{default})  : () ),
+                },
+            ];
+
+            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};
+        }
+
+        return ( \@options, \%name_to_init_arg );
     }
+};
 
-    return ( \@options, \%name_to_init_arg );
-}
 
 1;
 
-__END__
-
-=pod
-
-=head1 NAME
-
-MooseX::Getopt::GLD - role to implement specific functionality for 
-L<Getopt::Long::Descriptive>
-
 =head1 SYNOPSIS
-    
-For internal use.
-
-=head1 DESCRIPTION
-
-This is a role for C<MooseX::Getopt>.
-
-=head1 METHODS
-
-=over 4
 
-=item meta
+  ## In your class
+  package My::App;
+  use Moose;
 
-=back
+  with 'MooseX::Getopt::GLD';
 
-=head1 BUGS
+  # or
 
-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.
+  with 'MooseX::Getopt::GLD' => { getopt_conf => [ 'pass_through', ... ] };
 
-=head1 AUTHOR
+  has 'out' => (is => 'rw', isa => 'Str', required => 1);
+  has 'in'  => (is => 'rw', isa => 'Str', required => 1);
 
-Dagfinn Ilmari MannsE<aring>ker E<lt>ilmari@ilmari.orgE<gt>
+  # ... rest of the class here
 
-Stevan Little E<lt>stevan@iinteractive.comE<gt>
+  ## in your script
+  #!/usr/bin/perl
 
-Yuval Kogman  C<< <nuffin@cpan.org> >>
+  use My::App;
 
-=head1 COPYRIGHT AND LICENSE
+  my $app = My::App->new_with_options();
+  # ... rest of the script here
 
-Copyright 2007-2008 by Infinity Interactive, Inc.
+  ## on the command line
+  % perl my_app_script.pl -in file.input -out file.dump
 
-L<http://www.iinteractive.com>
+=head1 OPTIONS
 
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
+This role is a parameterized role. It accepts a HashRef of parameters. For now
+there is only one configuration parameter, C<getopt_conf>. This parameter is an
+ArrayRef of strings, which are L<Getopt::Long> configuraion options (see
+"Configuring Getopt::Long" in L<Getopt::Long>). See L<SYNOPSIS> for an example.
 
 =cut
-=head1