[carton] 233/472: Unimplement carton check. Also simplified carton show logic to use Lock directly

[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 5c4d41fc765d6027bc17cd510b4f7f39b374ed77
Author: Tatsuhiko Miyagawa <miyagawa at bulknews.net>
Date:   Fri May 31 14:33:51 2013 +0900

    Unimplement carton check. Also simplified carton show logic to use Lock directly
---
 lib/Carton.pm      | 71 ------------------------------------------------------
 lib/Carton/CLI.pm  | 29 +++-------------------
 lib/Carton/Lock.pm |  5 ++++
 xt/cli/check.t     |  2 ++
 4 files changed, 11 insertions(+), 96 deletions(-)

diff --git a/lib/Carton.pm b/lib/Carton.pm
index 11eabb7..bbc5ebc 100644
--- a/lib/Carton.pm
+++ b/lib/Carton.pm
@@ -99,20 +99,6 @@ sub install {
     ) or die "Installing modules failed\n";
 }
 
-sub build_index {
-    my($self, $lock) = @_;
-
-    my $index;
-
-    while (my($name, $metadata) = each %{$lock->{modules}}) {
-        for my $mod (keys %{$metadata->{provides}}) {
-            $index->{$mod} = { %{$metadata->{provides}{$mod}}, meta => $metadata };
-        }
-    }
-
-    return $index;
-}
-
 sub is_core {
     my($self, $module, $want_ver, $perl_version) = @_;
     $perl_version ||= $];
@@ -126,17 +112,6 @@ sub is_core {
     return version->new($core_ver) >= version->new($want_ver);
 };
 
-sub merge_prereqs {
-    my($self, $prereqs) = @_;
-
-    my %requires;
-    for my $phase (qw( configure build test runtime )) {
-        %requires = (%requires, %{$prereqs->{$phase}{requires} || {}});
-    }
-
-    return \%requires;
-}
-
 sub run_cpanm {
     my($self, @args) = @_;
     local $ENV{PERL_CPANM_OPT};
@@ -185,52 +160,6 @@ sub find_installs {
         ($module->{name} => { %$module, mymeta => $mymeta }) } @installs;
 }
 
-sub check_satisfies {
-    my($self, $lock, $deps) = @_;
-
-    my @unsatisfied;
-    my $index = $self->build_index($lock);
-    my %pool = %{$lock->{modules}}; # copy
-
-    my @root = map { [ split /~/, $_, 2 ] } @$deps;
-
-    for my $dep (@root) {
-        $self->_check_satisfies($dep, \@unsatisfied, $index, \%pool);
-    }
-
-    return {
-        unsatisfied => \@unsatisfied,
-    };
-}
-
-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 $requires = $self->merge_prereqs($found->{meta}{mymeta}{prereqs});
-    for my $module (keys %$requires) {
-        next if $module eq 'perl';
-        $self->_check_satisfies([ $module, $requires->{$module} ], $unsatisfied, $index, $pool);
-    }
-}
-
 1;
 __END__
 
diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm
index 2288686..e89f67b 100644
--- a/lib/Carton/CLI.pm
+++ b/lib/Carton/CLI.pm
@@ -205,10 +205,9 @@ sub cmd_show {
 
     my $lock = $self->find_lock
         or $self->error("Can't find carton.lock: Run `carton install`\n");
-    my $index = $self->carton->build_index($lock);
 
     for my $module (@args) {
-        my $meta = $index->{$module}{meta}
+        my $meta = $lock->find($module)
             or $self->error("Couldn't locate $module in carton.lock\n");
         $self->print( Carton::Util::to_json($meta) );
     }
@@ -227,29 +226,9 @@ sub cmd_list {
 
 sub cmd_check {
     my($self, @args) = @_;
-
-    my $file = $self->find_cpanfile;
-
-    $self->parse_options(\@args, "p|path=s", sub { $self->carton->{path} = $_[1] });
-
-    my $lock = $self->carton->build_lock;
-    my @deps = $self->carton->list_dependencies;
-
-    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 (@{$res->{unsatisfied}}) {
-            $self->print("$dep->{module} " . ($dep->{version} ? "($dep->{version})" : "") . "\n");
-        }
-        $ok = 0;
-    }
-
-    if ($ok) {
-        $self->printf("Dependencies specified in your $file are satisfied and matches with modules in %s.\n",
-                      $self->carton->{path}, SUCCESS);
-    }
+    die <<EOF;
+carton check is not implemented yet.
+EOF
 }
 
 sub cmd_update {
diff --git a/lib/Carton/Lock.pm b/lib/Carton/Lock.pm
index 4eacf95..2be664a 100644
--- a/lib/Carton/Lock.pm
+++ b/lib/Carton/Lock.pm
@@ -25,6 +25,11 @@ sub modules {
     values %{$_[0]->{modules} || {}};
 }
 
+sub find {
+    my($self, $module) = @_;
+    $self->{modules}{$module};
+}
+
 sub index {
     my $self = shift;
 
diff --git a/xt/cli/check.t b/xt/cli/check.t
index 0d07dde..e3601e7 100644
--- a/xt/cli/check.t
+++ b/xt/cli/check.t
@@ -2,6 +2,8 @@ use strict;
 use Test::More;
 use xt::CLI;
 
+plan skip_all => "check is unimplemented";
+
 {
     my $app = cli();
 

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