* Add current $VERSION to all files.
[gitmo/MooseX-Getopt.git] / lib / MooseX / Getopt.pm
index a915d5a..49ac048 100644 (file)
@@ -1,5 +1,9 @@
 
 package MooseX::Getopt;
+
+our $VERSION   = '0.150001';
+our $AUTHORITY = 'cpan:STEVAN';
+
 use Moose::Role;
 
 use Moose::Util::TypeConstraints;
@@ -12,53 +16,82 @@ use MooseX::Getopt::Meta::Attribute;
 use MooseX::Getopt::Meta::Attribute::NoGetopt;
 
 
-our $VERSION   = '0.15';
-our $AUTHORITY = 'cpan:STEVAN';
+use Getopt::Long ();
 
 
 use constant _default_getopt_session => 'MooseX::Getopt::Session';
 
 
-has ARGV => (
-    is => 'rw',
-    isa => 'ArrayRef',
-    metaclass => 'NoGetopt',
-);
-
-has extra_argv => (
-    is => 'rw',
-    isa => 'ArrayRef',
-    metaclass => 'NoGetopt',
-);
-
 has getopt => (
-    is => 'rw',
-    isa => 'MooseX::Getopt::Session',
+    is        => 'rw',
+    isa       => 'MooseX::Getopt::Session',
     metaclass => 'NoGetopt',
+    handles   => [ 'ARGV', 'extra_argv' ],
 );
 
 
 sub new_with_options {
     my $class = shift;
 
-    Moose->throw_error("Single parameters to new_with_options() must be a HASH ref")
-        if ref $_[0] and ref $_ ne 'HASH';
+    return $class->new( $class->get_options_from_argv(@_) );
+};
+
+
+sub get_options_from_argv {
+    my $class = shift;
+
+    Moose->throw_error(
+        "Single parameters to get_options_from_argv() must be a HASH ref"
+    ) if ref $_[0] and ref $_ ne 'HASH';
 
-    my %params = ( @_ == 1 ? %{ $_[0] } : @_ );
+    my $options = {
+        %{ $class->get_options_from_configfile },
+        @_ == 1 ? %{ $_[0] } : @_
+    };
 
-    my $getopt = defined $params{getopt}
-                 ? $params{getopt}
-                 : $class->_default_getopt_session->new;
+    my $getopt = defined $options->{getopt}
+               ? $options->{getopt}
+               : $class->_default_getopt_session->new(
+                     classes_filter => sub { $_ eq $class },
+                     options => $options,
+               );
 
-    my %options = $getopt->options;
+    # Call Getopt parser only once.
+    $getopt->build_options if not $getopt->has_status;
 
-    $class->new(
-        ARGV       => [ $getopt->argv ],        # backward compatibility
-        extra_argv => [ $getopt->extra_argv ],  # backward compatibility
-        getopt     => $getopt,
-        %params,      # explicit params to ->new
-        %options,     # params from CLI
-    );
+    my $new_options = {
+        %$options,                # explicit options to ->new
+        %{ $getopt->options },    # options from CLI
+        getopt => $getopt,
+    };
+
+    return $new_options;
+};
+
+
+sub get_options_from_configfile {
+    my $class = shift;
+
+    my $options = {};
+
+    if ( $class->meta->does_role('MooseX::ConfigFromFile') ) {
+        local @ARGV = @ARGV;
+
+        my $configfile;
+        my $opt_parser = Getopt::Long::Parser->new( config => ['pass_through'] );
+        $opt_parser->getoptions( "configfile=s" => \$configfile );
+
+        if ( not defined $configfile ) {
+            my $cfmeta = $class->meta->find_attribute_by_name('configfile');
+            $configfile = $cfmeta->default if $cfmeta->has_default;
+        };
+
+        if ( defined $configfile ) {
+            $options = $class->get_config_from_file($configfile);
+        };
+    };
+
+    return $options;
 };
 
 
@@ -67,8 +100,7 @@ sub _compute_getopt_attrs {
 
     return grep {
         $_->does('MooseX::Getopt::Meta::Attribute::Trait')
-            or
-        $_->name !~ /^_/
+        or $_->name !~ /^_/
     } grep {
         !$_->does('MooseX::Getopt::Meta::Attribute::Trait::NoGetopt')
     } $class->meta->compute_all_applicable_attributes;
@@ -77,6 +109,7 @@ sub _compute_getopt_attrs {
 
 no Moose::Role; 1;
 
+
 __END__
 
 =pod
@@ -174,6 +207,11 @@ which would enable the following command line options:
 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<Defined|Int>, I<Defined|Float>, I<Defined|Str>
+
+These type constaints 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
@@ -258,6 +296,42 @@ 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@>).
 
+=head2 Session
+
+L<MooseX::Getopt> can handle more than one class which contain
+attributes filled from CLI.  In this case, you need to use explicite
+L<MooseX::Getopt::Session> object and then the Getopt attributes will be
+searched in any class which does L<MooseX::Getopt>.
+
+  package My::App;
+  use Moose;
+  with 'MooseX::Getopt';
+  has 'send' => (is => 'rw', predicate => 'has_send');
+
+  package My::App::Send;
+  use Moose;
+  with 'MooseX::Getopt';
+  has 'to' => (is => 'rw', isa => 'Str', default => 'localhost');
+  sub send { my $self = shift; warn "Sending mail to ", $self->to; }
+
+  # ... rest of the class here
+
+  ## in your script
+  #!/usr/bin/perl
+
+  my $getopt = MooseX::Getopt::Session->new;
+
+  my $app = My::App->new_with_options( getopt => $getopt );
+  if ($app->has_send) {
+      # Use the same command line
+      my $sender = My::App::Send->new_with_options( getopt => $getopt );
+      $sender->send;
+  }
+  # ... rest of the script here
+
+  ## on the command line
+  % perl my_app_script.pl --send --to server.example.net
+
 =head1 METHODS
 
 =over 4
@@ -274,10 +348,22 @@ C<new_with_options> will throw an exception.
 If you have L<Getopt::Long::Descriptive> a the C<usage> param is also passed to
 C<new>.
 
+=item B<get_options_from_argv (%params)>
+
+This method returns the list of parameters collected from command line
+without creating the new object.
+
+=item B<get_options_from_configfile>
+
+This method returns the list of parameters collected with
+L<MooseX::ConfigFromFile> mechanism.
+
 =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>.
+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>.
+
+The C<ARGV> is delegated from L<MooseX::Getopt::Session> object.
 
 =item B<extra_argv>
 
@@ -285,12 +371,32 @@ 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.
 
+The C<extra_argv> is delegated from L<MooseX::Getopt::Session> object.
+
+=item B<getopt>
+
+This accessor contains a L<MooseX::Getopt::Session> object.  This object can
+be shared between more than one class which does L<MooseX::Getopt>.  The new
+object is created by default.
+
 =item B<meta>
 
 This returns the role meta object.
 
 =back
 
+=head1 SEE ALSO
+
+=over 4
+
+=item L<MooseX::Getopt::Strict>
+
+=item L<MooseX::Getopt::Session>
+
+=item L<MooseX::Getopt::Parser>
+
+=back
+
 =head1 BUGS
 
 All complex software has bugs lurking in it, and this module is no
@@ -305,6 +411,8 @@ Brandon L. Black, E<lt>blblack@gmail.comE<gt>
 
 Yuval Kogman, E<lt>nothingmuch@woobling.orgE<gt>
 
+Piotr Roszatycki, E<lt>dexter@cpan.orgE<gt>
+
 =head1 CONTRIBUTORS
 
 Ryan D Johnson, E<lt>ryan@innerfence.comE<gt>