[carton] 290/472: Ignore installations that doesn't match cpanfile in check (and update later)

[Lucas Kanashiro]

This is an automated email from the git hooks/post-receive script.

kanashiro-guest pushed a commit to branch master
in repository carton.

commit 3909aefe0b221ed7b2f230bb7721dbf6a1d5bd9a
Author: Tatsuhiko Miyagawa <miyagawa at bulknews.net>
Date:   Wed Jun 5 17:45:17 2013 +0900

    Ignore installations that doesn't match cpanfile in check (and update later)
    
    There's a lot of duplicate logics that we need to clear out
---
 lib/Carton/CLI.pm  |  3 ++-
 lib/Carton/Lock.pm | 29 +++++++++++++++++++++--------
 2 files changed, 23 insertions(+), 9 deletions(-)

diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm
index f3a5641..393c4ce 100644
--- a/lib/Carton/CLI.pm
+++ b/lib/Carton/CLI.pm
@@ -214,7 +214,8 @@ sub cmd_install {
     $builder->install($path);
 
     unless ($deployment) {
-        Carton::Lock->build_from_local($path)->write($self->lock_file);
+        my $prereqs = Module::CPANfile->load($cpanfile)->prereqs;
+        Carton::Lock->build_from_local($path, $prereqs)->write($self->lock_file);
     }
 
     $self->print("Complete! Modules were installed into $path\n", SUCCESS);
diff --git a/lib/Carton/Lock.pm b/lib/Carton/Lock.pm
index c100e6f..ced0f6c 100644
--- a/lib/Carton/Lock.pm
+++ b/lib/Carton/Lock.pm
@@ -7,6 +7,7 @@ use Carton::Package;
 use Carton::Index;
 use Carton::Util;
 use CPAN::Meta;
+use CPAN::Meta::Requirements;
 use File::Find ();
 use Module::CoreList;
 use Moo;
@@ -93,22 +94,26 @@ sub write_index {
 }
 
 sub build_from_local {
-    my($class, $path) = @_;
+    my($class, $path, $prereqs) = @_;
 
-    my %installs = $class->find_installs($path);
+    my $installs = $class->find_installs($path, $prereqs);
 
     return $class->new(
-        modules => \%installs,
+        modules => $installs,
         version => CARTON_LOCK_VERSION,
     );
 }
 
 sub find_installs {
-    my($class, $path) = @_;
+    my($class, $path, $prereqs) = @_;
 
     my $libdir = "$path/lib/perl5/$Config{archname}/.meta";
     return unless -e $libdir;
 
+    my $reqs = CPAN::Meta::Requirements->new;
+    $reqs->add_requirements($prereqs->requirements_for($_, 'requires'))
+      for qw( configure build runtime test );
+
     my @installs;
     my $wanted = sub {
         if ($_ eq 'install.json') {
@@ -117,10 +122,18 @@ sub find_installs {
     };
     File::Find::find($wanted, $libdir);
 
-    return map {
-        my $module = Carton::Util::load_json($_->[0]);
-        my $mymeta = -f $_->[1] ? CPAN::Meta->load_file($_->[1])->as_struct({ version => "2" }) : {};
-        ($module->{name} => { %$module, mymeta => $mymeta }) } @installs;
+    my %installs;
+    for my $file (@installs) {
+        my $module = Carton::Util::load_json($file->[0]);
+        my $mymeta = -f $file->[1] ? CPAN::Meta->load_file($file->[1])->as_struct({ version => "2" }) : {};
+        if ($reqs->accepts_module($module->{name}, $module->{provides}{$module->{name}}{version})) {
+            $installs{ $module->{name} } = { %$module, mymeta => $mymeta };
+        } else {
+            # Ignore installs because cpanfile doesn't accept it
+        }
+    }
+
+    return \%installs;
 }
 
 1;

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/carton.git