[carton] 55/472: check now checks if you miss some dependencies in your build file

[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 491f32779253a977c2f2dc801b4db44844e27395
Author: Tatsuhiko Miyagawa <miyagawa at bulknews.net>
Date:   Sun Jun 26 17:06:50 2011 -0700

    check now checks if you miss some dependencies in your build file
---
 lib/Carton.pm     | 71 ++++++++++++++++++++++++++++++++++++++++++-------------
 lib/Carton/CLI.pm | 27 ++++++++++++++-------
 2 files changed, 74 insertions(+), 24 deletions(-)

diff --git a/lib/Carton.pm b/lib/Carton.pm
index 9ee47a1..7d89b7a 100644
--- a/lib/Carton.pm
+++ b/lib/Carton.pm
@@ -160,10 +160,18 @@ sub build_index {
     return $index;
 }
 
-sub walk_down_tree {
-    my($self, $lock, $cb) = @_;
+sub is_core {
+    my($self, $module, $want_ver, $perl_version) = @_;
+    $perl_version ||= $];
 
     require Module::CoreList;
+    my $core_ver = $Module::CoreList::version{$perl_version + 0}{$module};
+
+    return $core_ver && version->new($core_ver) >= version->new($want_ver);
+};
+
+sub walk_down_tree {
+    my($self, $lock, $cb) = @_;
 
     my %seen;
     my $tree = $self->build_tree($lock->{modules});
@@ -173,7 +181,7 @@ sub walk_down_tree {
 
         if ($node->metadata->{dist}) {
             $cb->($node->metadata, $depth);
-        } elsif (!$Module::CoreList::version{$]+0}{$node->key}) {
+        } elsif ($self->is_core($node->key, 0)) {
             warn "Couldn't find ", $node->key, "\n";
         }
     });
@@ -291,22 +299,53 @@ sub find_locals {
 sub check_satisfies {
     my($self, $lock, $deps) = @_;
 
-    my @missing;
+    # TODO recurse dep tree to see all your dependencies are satisfied
+    # TODO then check if something is remaining in $lock, which is not specified in the build file
+
+    my @unsatisfied;
     my $index = $self->build_index($lock->{modules});
-    for my $dep (@$deps) {
-        # TODO recurse to see all your dependencies are satisfied?
-        my($mod, $ver) = split /~/, $dep;
-        my $found = $index->{$mod};
-        unless ($found && (!$ver or version->new($found->{version}) >= version->new($ver))) {
-            push @missing, {
-                module => $mod,
-                version => $ver,
-                found => $found ? $found->{version} : undef,
-            };
-        }
+    my %pool = %{$lock->{modules}}; # copy
+
+    my @root = map { [ split /~/, $_, 2 ] } @$deps;
+
+    for my $dep (@root) {
+        $self->_check_satisfies($dep, \@unsatisfied, $index, \%pool);
     }
 
-    return @missing;
+    return {
+        unsatisfied => \@unsatisfied,
+        superflous  => [ values %pool ],
+    };
+}
+
+sub _check_satisfies {
+    my($self, $dep, $unsatisfied, $index, $pool) = @_;
+
+    my($mod, $ver) = @$dep;
+
+    my $found = $index->{$mod};
+    if ($found) {
+        delete $pool->{$found->{meta}{name}};
+    } elsif ($self->is_core($mod, $ver)) {
+        return;
+    }
+
+    unless ($found and (!$ver or version->new($found->{version}) >= version->new($ver))) {
+        push @$unsatisfied, {
+            module => $mod,
+            version => $ver,
+            found => $found ? $found->{version} : undef,
+        };
+        return;
+    }
+
+    my $meta = $found->{meta};
+    for my $requires (values %{$meta->{requires}}) {
+        for my $module (keys %$requires) {
+            next if $module eq 'perl';
+            $self->_check_satisfies([ $module, $requires->{$module} ], $unsatisfied, $index, $pool);
+        }
+    }
 }
 
 
diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm
index 30ba653..7e93421 100644
--- a/lib/Carton/CLI.pm
+++ b/lib/Carton/CLI.pm
@@ -201,16 +201,27 @@ sub cmd_check {
     my $lock = $self->carton->build_lock;
     my @deps = $self->carton->list_dependencies;
 
-    my @unsatisfied = $self->carton->check_satisfies($lock, \@deps);
-    if (@unsatisfied) {
+    my $res = $self->carton->check_satisfies($lock, \@deps);
+
+    my $ok = 1;
+    if (@{$res->{unsatisfied}}) {
         $self->print("Following dependencies are not satisfied. Run `carton install` to install them.\n", WARN);
-        for my $dep (@unsatisfied) {
-            $self->print("$dep->{module} " .
-                         ($dep->{version} ? "($dep->{version}" . ($dep->{found} ? " > $dep->{found})" : ")") : "") .
-                         "\n");
+        for my $dep (@{$res->{unsatisfied}}) {
+            $self->print("  $dep->{module} " . ($dep->{version} ? "($dep->{version})" : "") . "\n");
         }
-    } else {
-        $self->print("Dependencies specified in your $file are satisfied.\n", SUCCESS);
+        $ok = 0;
+    }
+
+    if (@{$res->{superflous}}) {
+        $self->print("Following modules are found in $self->{path} but couldn't be tracked from your $file\n", WARN);
+        for my $dep (@{$res->{superflous}}) {
+            $self->print("  $dep->{module} " . ($dep->{version} ? "($dep->{version})" : "") . "\n");
+        }
+        $ok = 0;
+    }
+
+    if ($ok) {
+        $self->print("Dependencies specified in your $file are satisfied and completely match with modules in $self->{path}.\n", SUCCESS);
     }
 }
 

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