Support for pulling prerequisites described in a cpanfile.

lib/App/Pinto/Command.pm

@@ -45,7 +45,7 @@ sub validate_args {
     my ( $self, $opts, $args ) = @_;
 
     $self->usage_error("Arguments are not allowed")
-        if @{$args} and not $self->args_attribute;
+        if @{$args} and not $self->args_attribute($opts, $args);
 
     return 1;
 }
@@ -55,20 +55,20 @@ sub validate_args {
 sub execute {
     my ( $self, $opts, $args ) = @_;
 
-    my %args = $self->process_args($args);
-    my $result = $self->pinto->run( $self->action_name, %{$opts}, %args );
+    my %processed_args = $self->process_args($opts, $args);
+    my $result = $self->pinto->run( $self->action_name, %{$opts}, %processed_args );
 
     return $result->exit_status;
 }
 
 #-----------------------------------------------------------------------------
 
 sub process_args {
-    my ( $self, $args ) = @_;
+    my ( $self, $opts, $args ) = @_;
 
-    my $attr_name = $self->args_attribute or return;
+    my $attr_name = $self->args_attribute($opts, $args) or return;
 
-    if ( !@{$args} && $self->args_from_stdin ) {
+    if ( !@{$args} && $self->args_from_stdin($opts, $args) ) {
         return ( $attr_name => [ _args_from_fh( \*STDIN ) ] );
     }
 

lib/App/Pinto/Command/pull.pm

@@ -31,16 +31,25 @@ sub opt_spec {
         [ 'stack|s=s'                         => 'Put packages into this stack' ],
         [ 'use-default-message|M'             => 'Use the generated message' ],
         [ 'with-development-prerequisites|wd' => 'Also pull prereqs for development' ],
+        [ 'cpanfile=s'                        => 'Name of cpanfile for pull-ees' ],
     );
 }
 
 #------------------------------------------------------------------------------
 
-sub args_attribute { return 'targets' }
+sub args_attribute {
+    my ($self, $opts, $args) = @_;
+    return if $opts->{cpanfile}; # expect no args if a cpanfile is supplied
+    return 'targets';
+}
 
 #------------------------------------------------------------------------------
 
-sub args_from_stdin { return 1 }
+sub args_from_stdin {
+    my ($self, $opts, $args) = @_;
+    return 0 if $opts->{cpanfile}; # nothing from stdin if cpanfile supplied
+    return 1;
+}
 
 #------------------------------------------------------------------------------
 

lib/Pinto/Action/Pull.pm

@@ -10,7 +10,10 @@ use MooseX::MarkAsMethods ( autoclean => 1 );
 use Try::Tiny;
 
 use Pinto::Util qw(throw);
-use Pinto::Types qw(TargetList);
+use Pinto::Types qw(File TargetList);
+
+use Module::CPANfile;
+use Pinto::Target::Package;
 
 #------------------------------------------------------------------------------
 
@@ -23,11 +26,20 @@ extends qw( Pinto::Action );
 #------------------------------------------------------------------------------
 
 has targets => (
-    isa      => TargetList,
-    traits   => [qw(Array)],
-    handles  => { targets => 'elements' },
-    required => 1,
-    coerce   => 1,
+    isa     => TargetList,
+    traits  => [qw(Array)],
+    handles => {
+        add_targets => 'push',
+        targets     => 'elements'
+    },
+    coerce  => 1,
+    default => sub { [] },
+);
+
+has cpanfile => (
+    is     => 'ro',
+    isa    => File,
+    coerce => 1,
 );
 
 has no_fail => (
@@ -45,6 +57,12 @@ with qw( Pinto::Role::Committable Pinto::Role::Puller );
 sub BUILD {
     my ($self) = @_;
 
+    if ( $self->cpanfile ) {
+        $self->_add_cpanfile_targets();
+    }
+
+    $self->targets || die "Attribute \(targets\) is required";
+
     $self->stack->assert_not_locked;
 
     return $self;
@@ -87,6 +105,38 @@ sub execute {
 
 #------------------------------------------------------------------------------
 
+sub _add_cpanfile_targets {
+    my ($self) = @_;
+
+    my $cpanfile = $self->cpanfile()->absolute;
+
+    # https://metacpan.org/pod/CPAN::Meta::Spec#PREREQUISITES
+    my @phases = qw(configure build test runtime develop);
+    my @types  = qw(requires recommends suggests);           # exclude "conflicts"
+
+    my $args;
+    try {
+        my $file = Module::CPANfile->load($cpanfile);
+        my $prereqs = $file->prereqs->merged_requirements( \@phases, \@types );
+        $args = $prereqs->as_string_hash;
+    }
+    catch {
+        die "Unable to load requirements from $cpanfile: $_";
+    };
+
+    for my $name ( keys %{$args} ) {
+        my $ptp = Pinto::Target::Package->new(
+            {   name    => $name,
+                version => $args->{$name}
+            }
+        );
+        $self->add_targets($ptp);
+    }
+
+}
+
+#------------------------------------------------------------------------------
+
 __PACKAGE__->meta->make_immutable;
 
 #------------------------------------------------------------------------------

t/02-bowels/21-pull-with-cpanfile.t

@@ -0,0 +1,96 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use lib 't/lib';
+use Pinto::Util qw(tempdir);
+use Pinto::Tester;
+use Pinto::Tester::Util qw(make_dist_archive);
+
+#------------------------------------------------------------------------------
+
+my $source = Pinto::Tester->new;
+$source->populate('JOHN/Baz-1.2 = Baz~1.2');
+$source->populate('PAUL/Nuts-2.3 = Nuts~2.3');
+$source->populate('RINGO/Foo-0.6 = Foo~0.6');
+$source->populate('RINGO/Loop-3.14 = Loop~3.14');
+$source->populate('GEORGE/Zap-1.0 = Zap~1.0');
+$source->populate('GEORGE/Noodle-1.008 = Noodle~1.008');
+$source->populate('GEORGE/Rose-1.8 = Rose~1.8');
+
+#------------------------------------------------------------------------------
+{
+    # Non-recursive pull
+    my $local = Pinto::Tester->new( init_args => { sources => $source->stack_url } );
+    my $cpanfile = $local->build_cpanfile(<<"EOCPANFILE");
+requires 'Nuts', '>= 2.0, < 2.33';
+EOCPANFILE
+
+    $local->run_ok( 'Pull', { cpanfile => $cpanfile } );
+    $local->registration_ok('PAUL/Nuts-2.3/Nuts~2.3');
+    $local->registration_not_ok('JOHN/Baz-1.2/Baz~1.2');
+}
+
+{
+    # Non-recursive pull
+    my $local = Pinto::Tester->new( init_args => { sources => $source->stack_url } );
+    my $cpanfile = $local->build_cpanfile(<<"EOCPANFILE");
+requires 'Nuts', '< 2.00';
+EOCPANFILE
+
+    $local->run_throws_ok(
+        'Pull',
+        { cpanfile => $cpanfile },
+        qr/Cannot find Nuts< 2.00 anywhere/,
+        '... and returned expected failure message'
+    );
+}
+
+{
+    # Non-recursive pull
+    my $local = Pinto::Tester->new( init_args => { sources => $source->stack_url } );
+    my $cpanfile = $local->build_cpanfile(<<"EOCPANFILE");
+requires 'Nuts', '> 2.00';
+recommends 'Baz', '< 2.00';
+on 'develop' => sub {
+    requires 'Loop', '> 3';
+    recommends 'Noodle', '> 1';
+};
+on 'test' => sub {
+    requires 'Zap', '>= 1.0';
+    recommends 'Foo', '> 0.5';
+};
+# conflicts not currently processed
+conflicts 'Rose', '< 1.0';
+EOCPANFILE
+
+    $local->run_ok( 'Pull', { cpanfile => $cpanfile } );
+    $local->registration_ok('JOHN/Baz-1.2/Baz~1.2');
+    $local->registration_ok('PAUL/Nuts-2.3/Nuts~2.3');
+    $local->registration_ok('RINGO/Foo-0.6/Foo~0.6');
+    $local->registration_ok('RINGO/Loop-3.14/Loop~3.14');
+    $local->registration_ok('GEORGE/Zap-1.0/Zap~1.0');
+    $local->registration_ok('GEORGE/Noodle-1.008/Noodle~1.008');
+    $local->registration_not_ok('GEORGE/Rose-1.8/Rose~1.8');
+}
+
+{
+    # Bogus cpanfile
+    my $local = Pinto::Tester->new( init_args => { sources => $source->stack_url } );
+    my $cpanfile = $local->build_cpanfile(<<"EOCPANFILE");
+# typo!
+reuires 'Nuts', '> 2.00';
+EOCPANFILE
+
+    $local->run_throws_ok(
+        'Pull',
+        { cpanfile => $cpanfile },
+        qr/Unable to load.*cpanfile/,
+        'Correctly handles bogus cpanfile'
+    );
+}
+
+done_testing;

t/02-bowels/21-pull.t

@@ -15,6 +15,14 @@ my $source = Pinto::Tester->new;
 $source->populate('JOHN/Baz-1.2 = Baz~1.2 & Nuts-2.3');
 $source->populate('PAUL/Nuts-2.3 = Nuts~2.3');
 
+#------------------------------------------------------------------------------
+{
+
+    # Should fail with no targets
+    my $local = Pinto::Tester->new( init_args => { sources => $source->stack_url } );
+    $local->run_throws_ok( 'Pull' => {}, qr/.*Attribute \(targets\) is required/ );
+}
+
 #------------------------------------------------------------------------------
 {
 

t/lib/Pinto/Tester.pm

@@ -578,6 +578,16 @@ sub to_string {
 }
 
 #------------------------------------------------------------------------------
-1;
 
+sub build_cpanfile {
+    my ( $self, $contents ) = @_;
+
+    my $dir  = tempdir();
+    my $file = $dir->file('cpanfile');
+    $file->spew($contents);
+    return ($file);
+}
+
+#------------------------------------------------------------------------------1;
+1;
 __END__