From 700d669be200e1a506bac52b88c50dfe610c4ae2 Mon Sep 17 00:00:00 2001 From: George Hartzell Date: Sat, 22 Feb 2014 15:39:03 -0800 Subject: [PATCH 1/3] Pull requires targets. Add a test for being called w/out any. Pull requires targets. Add a test for being called w/out any and check the exception that gets thrown. --- t/02-bowels/21-pull.t | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/t/02-bowels/21-pull.t b/t/02-bowels/21-pull.t index 2ecd7bd2..29cf1119 100644 --- a/t/02-bowels/21-pull.t +++ b/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/ ); +} + #------------------------------------------------------------------------------ { From fd12a9baebe57248ec3d9ce8bd266fef3ae7af71 Mon Sep 17 00:00:00 2001 From: George Hartzell Date: Sun, 23 Feb 2014 11:18:05 -0800 Subject: [PATCH 2/3] First cut at adding support for pulling packages from cpanfile. Add an optional argument to the Pull action that names a cpanfile. 1. loads the file using Module::CPANfile, 2. merges prerequisites from the phases = qw(configure build test runtime develop) and the types = qw(requires recommends suggests) 3. and uses the resulting requirements to add packages to the set of targets to be pulled. Targets are no longer required (in the Moose attribute sense) so add a test to make sure that we still correctly handle not having any. --- lib/Pinto/Action/Pull.pm | 62 +++++++++++++++++-- t/02-bowels/21-pull-with-cpanfile.t | 96 +++++++++++++++++++++++++++++ t/lib/Pinto/Tester.pm | 12 +++- 3 files changed, 163 insertions(+), 7 deletions(-) create mode 100644 t/02-bowels/21-pull-with-cpanfile.t diff --git a/lib/Pinto/Action/Pull.pm b/lib/Pinto/Action/Pull.pm index ac84d4cc..2477511d 100644 --- a/lib/Pinto/Action/Pull.pm +++ b/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; #------------------------------------------------------------------------------ diff --git a/t/02-bowels/21-pull-with-cpanfile.t b/t/02-bowels/21-pull-with-cpanfile.t new file mode 100644 index 00000000..2dc06c94 --- /dev/null +++ b/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; diff --git a/t/lib/Pinto/Tester.pm b/t/lib/Pinto/Tester.pm index 41cdc897..38fec310 100644 --- a/t/lib/Pinto/Tester.pm +++ b/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__ From 5538b3a96465e94be5d19526ecaf0d9e2fd79fd2 Mon Sep 17 00:00:00 2001 From: George Hartzell Date: Tue, 11 Mar 2014 12:59:09 -0700 Subject: [PATCH 3/3] Add a --cpanfile opt to the pull command. Add a --cpanfile option to the pull command. Option currently requires a value. TODO supply a default value of 'cpanfile'. I had to "enhance" the way that arg_attribute and args_from_stdin work. Prior to this change they had no information about the context in which they were running and just returned constants. Now they are passed the $opts and $args from above and can decide whether the Action should collect stuff from stdin or not. In this case, if a cpanfile is specified then there should be no additional args, either on the command line or on stdin. --- lib/App/Pinto/Command.pm | 12 ++++++------ lib/App/Pinto/Command/pull.pm | 13 +++++++++++-- 2 files changed, 17 insertions(+), 8 deletions(-) diff --git a/lib/App/Pinto/Command.pm b/lib/App/Pinto/Command.pm index 8caff4ce..91569402 100644 --- a/lib/App/Pinto/Command.pm +++ b/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,8 +55,8 @@ 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; } @@ -64,11 +64,11 @@ sub execute { #----------------------------------------------------------------------------- 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 ) ] ); } diff --git a/lib/App/Pinto/Command/pull.pm b/lib/App/Pinto/Command/pull.pm index 773fa34e..520707d2 100644 --- a/lib/App/Pinto/Command/pull.pm +++ b/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; +} #------------------------------------------------------------------------------