[carton] 296/472: Implemented carton update

[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 75affd3150e3745d9ff325de23bcade90da98bce
Author: Tatsuhiko Miyagawa <miyagawa at bulknews.net>
Date:   Wed Jun 5 18:58:48 2013 +0900

    Implemented carton update
---
 lib/Carton/Builder.pm | 13 ++++++++++++-
 lib/Carton/CLI.pm     | 33 ++++++++++++++++++++++++---------
 xt/cli/update.t       | 41 +++++++++++++++++++++++++++++++++++++++++
 3 files changed, 77 insertions(+), 10 deletions(-)

diff --git a/lib/Carton/Builder.pm b/lib/Carton/Builder.pm
index 0157da1..e71c557 100644
--- a/lib/Carton/Builder.pm
+++ b/lib/Carton/Builder.pm
@@ -47,7 +47,6 @@ sub install {
     $self->run_cpanm(
         "-L", $path,
         (map { ("--mirror", $_->url) } $self->effective_mirrors),
-        "--skip-satisfied",
         ( $self->index ? ("--mirror-index", $self->index) : () ),
         ( $self->cascade ? "--cascade-search" : () ),
         ( $self->custom_mirror ? "--mirror-only" : () ),
@@ -57,6 +56,18 @@ sub install {
     ) or die "Installing modules failed\n";
 }
 
+sub update {
+    my($self, $path, @modules) = @_;
+
+    $self->run_cpanm(
+        "-L", $path,
+        (map { ("--mirror", $_->url) } $self->effective_mirrors),
+        ( $self->custom_mirror ? "--mirror-only" : () ),
+        "--save-dists", "$path/cache",
+        @modules
+    ) or die "Updating modules failed\n";
+}
+
 sub run_cpanm {
     my($self, @args) = @_;
     local $ENV{PERL_CPANM_OPT};
diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm
index cf3d147..e91aec4 100644
--- a/lib/Carton/CLI.pm
+++ b/lib/Carton/CLI.pm
@@ -316,19 +316,34 @@ sub cmd_check {
 }
 
 sub cmd_update {
-    # "cleanly" update distributions in extlib
-    die <<EOF;
-carton update is not implemented yet.
+    my($self, @args) = @_;
+
+    my $cpanfile = Module::CPANfile->load($self->find_cpanfile);
+    my $prereqs = $cpanfile->prereqs;
 
-The command is supposed to update all the dependencies to the latest
-version as if you don't have the current local environment doesn't
-exist.
+    my $reqs = CPAN::Meta::Requirements->new;
+    $reqs->add_requirements($prereqs->requirements_for($_, 'requires'))
+      for qw( configure build runtime test develop );
+
+    @args = grep { $_ ne 'perl' } $reqs->required_modules unless @args;
+
+    my $lock = $self->find_lock
+        or $self->error("Can't find carton.lock: Run `carton install` to build the lock file.\n");
 
-For now, you can remove the local environment and re-run carton install
-to get the similar functionality.
+    my @modules;
+    for my $module (@args) {
+        my $dist = $lock->find_or_core($module)
+            or $self->error("Could not find module $module.\n");
+        next if $dist->is_core;
+        push @modules, "$module~" . $reqs->requirements_for_module($module);
+    }
 
-EOF
+    my $builder = Carton::Builder->new(
+        mirror => $self->mirror,
+    );
+    $builder->update($self->install_path, @modules);
 
+    Carton::Lock->build_from_local($self->install_path, $prereqs)->write($self->lock_file);
 }
 
 sub cmd_exec {
diff --git a/xt/cli/update.t b/xt/cli/update.t
new file mode 100644
index 0000000..60617d9
--- /dev/null
+++ b/xt/cli/update.t
@@ -0,0 +1,41 @@
+use strict;
+use Test::More;
+use xt::CLI;
+
+{
+    my $app = cli();
+
+    $app->dir->child("cpanfile")->spew(<<EOF);
+requires 'Try::Tiny', '== 0.09';
+EOF
+
+    $app->run("install");
+    $app->run("list");
+    like $app->stdout, qr/Try-Tiny-0\.09/;
+
+    $app->dir->child("cpanfile")->spew(<<EOF);
+requires 'Try::Tiny', '>= 0.09, <= 0.12';
+EOF
+
+    $app->run("install");
+    $app->run("check");
+    like $app->stdout, qr/are satisfied/;
+
+    $app->run("list");
+    like $app->stdout, qr/Try-Tiny-0\.09/;
+
+    $app->run("update", "XYZ");
+    like $app->stderr, qr/Could not find module XYZ/;
+
+    $app->run("update", "Try::Tiny");
+    like $app->stderr, qr/installed Try-Tiny-0\.12.*upgraded from 0\.09/;
+
+    $app->run("check");
+    like $app->stdout, qr/are satisfied/;
+
+    $app->run("list");
+    like $app->stdout, qr/Try-Tiny-0\.12/;
+}
+
+done_testing;
+

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