[carton] 54/472: basic check command

[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 66b8167191edd727c8e682bfe939a51a29e726ac
Author: Tatsuhiko Miyagawa <miyagawa at bulknews.net>
Date:   Sun Jun 26 16:20:23 2011 -0700

    basic check command
---
 lib/Carton.pm     | 27 ++++++++++++++++++++++++---
 lib/Carton/CLI.pm | 41 +++++++++++++++++++++++++++++++++--------
 2 files changed, 57 insertions(+), 11 deletions(-)

diff --git a/lib/Carton.pm b/lib/Carton.pm
index f3056f6..9ee47a1 100644
--- a/lib/Carton.pm
+++ b/lib/Carton.pm
@@ -30,12 +30,12 @@ sub install_from_build_file {
         push @modules, map $_->spec, $tree->children;
     }
 
-    push @modules, $self->show_deps();
+    push @modules, $self->list_dependencies;
     $self->install_conservative(\@modules, 1)
         or die "Installing modules failed\n";
 }
 
-sub show_deps {
+sub list_dependencies {
     my $self = shift;
 
     my @deps = $self->run_cpanm_output("--showdeps", ".");
@@ -288,5 +288,26 @@ sub find_locals {
     return map { my $module = Carton::Util::parse_json($_); ($module->{name} => $module) } @locals;
 }
 
-1;
+sub check_satisfies {
+    my($self, $lock, $deps) = @_;
+
+    my @missing;
+    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,
+            };
+        }
+    }
 
+    return @missing;
+}
+
+
+1;
diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm
index 70945e4..30ba653 100644
--- a/lib/Carton/CLI.pm
+++ b/lib/Carton/CLI.pm
@@ -13,10 +13,13 @@ use Term::ANSIColor qw(colored);
 use Carton::Tree;
 use Try::Tiny;
 
+use constant { SUCCESS => 0, WARN => 1, INFO => 2, ERROR => 3 };
+
 our $Colors = {
-    SUCCESS => 'green',
-    INFO    => 'cyan',
-    ERROR   => 'red',
+    SUCCESS() => 'green',
+    WARN()    => 'yellow',
+    INFO()    => 'cyan',
+    ERROR()   => 'red',
 };
 
 sub new {
@@ -93,13 +96,13 @@ sub parse_options {
 
 sub print {
     my($self, $msg, $type) = @_;
-    $msg = colored $msg, $Colors->{$type} if $type && $self->{color};
+    $msg = colored $msg, $Colors->{$type} if defined $type && $self->{color};
     print $msg;
 }
 
 sub error {
     my($self, $msg) = @_;
-    $self->print($msg, "ERROR");
+    $self->print($msg, ERROR);
     exit(1);
 }
 
@@ -143,7 +146,7 @@ sub cmd_install {
         $self->error("Can't locate build file or carton.lock\n");
     }
 
-    $self->print("Complete! Modules were installed into $self->{path}\n", "SUCCESS");
+    $self->print("Complete! Modules were installed into $self->{path}\n", SUCCESS);
 }
 
 sub mirror_file {
@@ -185,8 +188,30 @@ sub cmd_show {
 }
 
 sub cmd_check {
-    my $self = shift;
-    # check if local directory has all the carton rquirements
+    my($self, @args) = @_;
+
+    my $file = $self->has_build_file
+        or $self->error("Can't find a build file: nothing to check.\n");
+
+    $self->parse_options(\@args, "p|path=s", \$self->{path});
+    $self->carton->configure(
+        path => $self->{path},
+    );
+
+    my $lock = $self->carton->build_lock;
+    my @deps = $self->carton->list_dependencies;
+
+    my @unsatisfied = $self->carton->check_satisfies($lock, \@deps);
+    if (@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");
+        }
+    } else {
+        $self->print("Dependencies specified in your $file are satisfied.\n", SUCCESS);
+    }
 }
 
 sub cmd_update {

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