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

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

commit 1ec0d83d1e45b247d97e868371f18998afd2057d
Author: Tatsuhiko Miyagawa <miyag...@bulknews.net>
Date:   Sun Jun 2 11:26:54 2013 +0900

    move all Carton.pm God class into CLI and Lock/Builder modules
---
 lib/Carton.pm         | 95 ---------------------------------------------------
 lib/Carton/Builder.pm |  9 ++---
 lib/Carton/CLI.pm     | 90 ++++++++++++++++++++++++++++++++++--------------
 lib/Carton/Lock.pm    | 36 +++++++++++++++++++
 xt/cli/deployment.t   | 26 ++++++++++++++
 xt/cli/mirror.t       | 16 ++++++++-
 xt/cli/mirror_multi.t | 39 ---------------------
 7 files changed, 147 insertions(+), 164 deletions(-)

diff --git a/lib/Carton.pm b/lib/Carton.pm
index 43cc04e..2717545 100644
--- a/lib/Carton.pm
+++ b/lib/Carton.pm
@@ -1,103 +1,8 @@
 package Carton;
-
 use strict;
-use warnings;
 use 5.008_005;
 use version; our $VERSION = version->declare("v0.9.53");
 
-use Config qw(%Config);
-use Carton::Builder;
-use Carton::Mirror;
-use Carton::Util;
-use CPAN::Meta;
-use File::Spec ();
-
-use constant CARTON_LOCK_VERSION => '0.9';
-
-sub new {
-    my($class, %args) = @_;
-    bless {
-        path => $ENV{PERL_CARTON_PATH} || 'local',
-        mirror => $ENV{PERL_CARTON_MIRROR} || $Carton::Mirror::DefaultMirror,
-    }, $class;
-}
-
-sub local_cache {
-    File::Spec->rel2abs("vendor/cache");
-}
-
-sub bundle {
-    my($self, $cpanfile, $lock) = @_;
-
-    $lock->write_index($self->{mirror_file});
-
-    my $builder = Carton::Builder->new(
-        mirror => Carton::Mirror->new($self->{mirror}),
-        index  => $self->{mirror_file},
-    );
-
-    $builder->bundle($self->local_cache);
-}
-
-sub install {
-    my($self, $file, $lock, $cascade, $cached) = @_;
-
-    # TODO merge CPANfile git to mirror even if lock doesn't exist
-    if ($lock) {
-        $lock->write_index($self->{mirror_file});
-    }
-
-    my $mirror  = Carton::Mirror->new($cached ? $self->local_cache : 
$self->{mirror});
-    my $builder = Carton::Builder->new(
-        mirror => $mirror,
-        index  => $lock ? $self->{mirror_file} : undef,
-    );
-
-    $builder->install($self->{path}, $cascade);
-}
-
-sub update_lock_file {
-    my($self, $file) = @_;
-
-    my $lock = $self->build_lock;
-    Carton::Lock->new($lock)->write($file);
-
-    return 1;
-}
-
-sub build_lock {
-    my $self = shift;
-
-    my %installs = $self->find_installs;
-
-    return {
-        modules => \%installs,
-        version => CARTON_LOCK_VERSION,
-    };
-}
-
-sub find_installs {
-    my $self = shift;
-
-    require File::Find;
-
-    my $libdir = "$self->{path}/lib/perl5/$Config{archname}/.meta";
-    return unless -e $libdir;
-
-    my @installs;
-    my $wanted = sub {
-        if ($_ eq 'install.json') {
-            push @installs, [ $File::Find::name, 
"$File::Find::dir/MYMETA.json" ];
-        }
-    };
-    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;
-}
-
 1;
 __END__
 
diff --git a/lib/Carton/Builder.pm b/lib/Carton/Builder.pm
index dbd791e..e34d995 100644
--- a/lib/Carton/Builder.pm
+++ b/lib/Carton/Builder.pm
@@ -3,8 +3,9 @@ use strict;
 use File::Temp;
 use Moo;
 
-has mirror  => (is => 'ro');
-has index   => (is => 'ro');
+has mirror  => (is => 'rw');
+has index   => (is => 'rw');
+has cascade => (is => 'rw', default => sub { 1 });
 
 sub effective_mirrors {
     my $self = shift;
@@ -40,14 +41,14 @@ sub bundle {
 }
 
 sub install {
-    my($self, $path, $cascade) = @_;
+    my($self, $path) = @_;
 
     $self->run_cpanm(
         "-L", $path,
         (map { ("--mirror", $_->url) } $self->effective_mirrors),
         "--skip-satisfied",
         ( $self->index ? ("--mirror-index", $self->index) : () ),
-        ( $cascade ? "--cascade-search" : () ),
+        ( $self->cascade ? "--cascade-search" : () ),
         ( $self->use_darkpan ? "--mirror-only" : () ),
         "--installdeps", ".",
     ) or die "Installing modules failed\n";
diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm
index 5bbc096..0b225d4 100644
--- a/lib/Carton/CLI.pm
+++ b/lib/Carton/CLI.pm
@@ -7,9 +7,12 @@ use Config;
 use Getopt::Long;
 
 use Carton;
+use Carton::Builder;
+use Carton::Mirror;
 use Carton::Lock;
 use Carton::Util;
 use Carton::Error;
+use Scalar::Util;
 use Try::Tiny;
 use Moo;
 
@@ -20,19 +23,25 @@ our $UseSystem = 0; # 1 for unit testing
 has verbose => (is => 'rw');
 has carton  => (is => 'lazy');
 has workdir => (is => 'lazy');
+has mirror  => (is => 'rw', builder => 1,
+                coerce => sub { Carton::Mirror->new($_[0]) });
 
-sub _build_carton {
-    Carton->new;
+sub _build_workdir {
+    my $self = shift;
+    $ENV{PERL_CARTON_HOME} || (Cwd::cwd() . "/.carton");
 }
 
-sub work_file {
-    my($self, $file) = @_;
-    return join "/", $self->workdir, $file;
+sub _build_mirror {
+    my $self = shift;
+    $ENV{PERL_CARTON_MIRROR} || $Carton::Mirror::DefaultMirror;
 }
 
-sub _build_workdir {
-    my $self = shift;
-    $ENV{PERL_CARTON_HOME} || (Cwd::cwd() . "/.carton");
+sub install_path {
+    $ENV{PERL_CARTON_PATH} || File::Spec->rel2abs('local');
+}
+
+sub vendor_cache {
+    File::Spec->rel2abs("vendor/cache");
 }
 
 sub run {
@@ -142,52 +151,74 @@ sub cmd_version {
 sub cmd_bundle {
     my($self, @args) = @_;
 
-    $self->parse_options(\@args, "p|path=s" => sub { $self->carton->{path} = 
$_[1] });
-    $self->carton->{mirror_file} = $self->mirror_file;
-
     my $lock = $self->find_lock;
     my $cpanfile = $self->find_cpanfile;
 
     if ($lock) {
         $self->print("Bundling modules using $cpanfile\n");
-        $self->carton->bundle($cpanfile, $lock);
+
+        my $index = $self->index_file;
+        $lock->write_index($index);
+
+        my $builder = Carton::Builder->new(
+            mirror => $self->mirror,
+            index  => $index,
+        );
+        $builder->bundle($self->vendor_cache);
     } else {
         $self->error("Can't locate carton.lock file. Run carton install 
first\n");
     }
 
-    $self->printf("Complete! Modules were bundled into %s\n", 
$self->carton->local_cache, SUCCESS);
+    $self->printf("Complete! Modules were bundled into %s\n", 
$self->vendor_cache, SUCCESS);
 }
 
 sub cmd_install {
     my($self, @args) = @_;
 
+    my $path = $self->install_path;
+
     $self->parse_options(
         \@args,
-        "p|path=s"    => sub { $self->carton->{path} = $_[1] },
+        "p|path=s"    => \$path,
         "deployment!" => \my $deployment,
         "cached!"     => \my $cached,
     );
 
-    $self->carton->{mirror_file} = $self->mirror_file;
-
     my $lock = $self->find_lock;
     my $cpanfile = $self->find_cpanfile;
 
+    my $builder = Carton::Builder->new(
+        cascade => 1,
+        mirror => $self->mirror,
+    );
+
     if ($deployment) {
+        unless ($lock) {
+            $self->error("--deployment requires carton.lock: Run `carton 
install` and make sure carton.lock is checked into your version control.\n"); # 
TODO test
+        }
         $self->print("Installing modules using $cpanfile (deployment mode)\n");
-        $self->carton->install($cpanfile, $lock, 0, $cached);
+        $builder->cascade(0);
     } else {
         $self->print("Installing modules using $cpanfile\n");
-        $self->carton->install($cpanfile, $lock, 1, $cached);
-        $self->carton->update_lock_file($self->lock_file);
     }
 
-    $self->printf("Complete! Modules were installed into %s\n", 
$self->carton->{path}, SUCCESS);
-}
+    # TODO merge CPANfile git to mirror even if lock doesn't exist
+    if ($lock) {
+        $lock->write_index($self->index_file);
+        $builder->index($self->index_file);
+    }
 
-sub mirror_file {
-    my $self = shift;
-    return $self->work_file("02packages.details.txt");
+    if ($cached) {
+        $builder->mirror(Carton::Mirror->new($self->vendor_cache));
+    }
+
+    $builder->install($path);
+
+    unless ($deployment) {
+        Carton::Lock->build_from_local($path)->write($self->lock_file);
+    }
+
+    $self->print("Complete! Modules were installed into $path\n", SUCCESS);
 }
 
 sub cmd_show {
@@ -249,7 +280,7 @@ sub cmd_exec {
     my @include;
     $self->parse_options_pass_through(\@args, 'I=s@', \@include);
 
-    my $path = $self->carton->{path};
+    my $path = $self->install_path;
     my $lib  = join ",", @include, "$path/lib/perl5", ".";
 
     local $ENV{PERL5OPT} = "-Mlib::core::only -Mlib=$lib";
@@ -290,5 +321,14 @@ sub lock_file {
     return 'carton.lock';
 }
 
+sub work_file {
+    my($self, $file) = @_;
+    return join "/", $self->workdir, $file;
+}
+
+sub index_file {
+    my $self = shift;
+    $self->work_file("02packages.details.txt");
+}
 
 1;
diff --git a/lib/Carton/Lock.pm b/lib/Carton/Lock.pm
index 3b367b6..c9ce2b9 100644
--- a/lib/Carton/Lock.pm
+++ b/lib/Carton/Lock.pm
@@ -1,14 +1,19 @@
 package Carton::Lock;
 use strict;
+use Config;
 use Carton::Dependency;
 use Carton::Package;
 use Carton::Index;
 use Carton::Util;
+use CPAN::Meta;
+use File::Find ();
 use Moo;
 
 has version => (is => 'ro');
 has modules => (is => 'ro', default => sub { +{} });
 
+use constant CARTON_LOCK_VERSION => '0.9';
+
 sub from_file {
     my($class, $file) = @_;
 
@@ -63,4 +68,35 @@ sub write_index {
     $self->index->write($fh);
 }
 
+sub build_from_local {
+    my($class, $path) = @_;
+
+    my %installs = $class->find_installs($path);
+
+    return $class->new(
+        modules => \%installs,
+        version => CARTON_LOCK_VERSION,
+    );
+}
+
+sub find_installs {
+    my($class, $path) = @_;
+
+    my $libdir = "$path/lib/perl5/$Config{archname}/.meta";
+    return unless -e $libdir;
+
+    my @installs;
+    my $wanted = sub {
+        if ($_ eq 'install.json') {
+            push @installs, [ $File::Find::name, 
"$File::Find::dir/MYMETA.json" ];
+        }
+    };
+    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;
+}
+
 1;
diff --git a/xt/cli/deployment.t b/xt/cli/deployment.t
new file mode 100644
index 0000000..c047d6e
--- /dev/null
+++ b/xt/cli/deployment.t
@@ -0,0 +1,26 @@
+use strict;
+use Test::More;
+use xt::CLI;
+
+{
+    my $app = cli();
+    $app->dir->touch("cpanfile", <<EOF);
+requires 'Try::Tiny', '== 0.11';
+EOF
+
+    $app->run("install", "--deployment");
+    like $app->output, qr/deployment requires carton\.lock/;
+
+    $app->run("install");
+    $app->clean_local;
+
+    $app->run("install", "--deployment");
+    $app->run("list");
+    like $app->output, qr/Try-Tiny-0\.11/;
+
+    $app->run("exec", "perl", "-e", "use Try::Tiny 2;");
+    like $app->system_error, qr/Try::Tiny.* version 0\.11/;
+}
+
+done_testing;
+
diff --git a/xt/cli/mirror.t b/xt/cli/mirror.t
index 4092197..55921d5 100644
--- a/xt/cli/mirror.t
+++ b/xt/cli/mirror.t
@@ -12,13 +12,27 @@ my $cwd = Cwd::cwd();
 requires 'Hash::MultiValue';
 EOF
 
-    $app->carton->{mirror} = "$cwd/xt/mirror";
+    $app->mirror("$cwd/xt/mirror");
     $app->run("install");
 
     $app->run("list");
     is $app->output, "Hash-MultiValue-0.08\n";
 }
 
+{
+    # fallback to CPAN
+    my $app = cli();
+    $app->dir->touch("cpanfile", <<EOF);
+requires 'PSGI';
+EOF
+
+    $app->mirror("$cwd/xt/mirror");
+    $app->run("install");
+
+    $app->run("list");
+    like $app->output, qr/^PSGI-/;
+}
+
 done_testing;
 
 
diff --git a/xt/cli/mirror_multi.t b/xt/cli/mirror_multi.t
deleted file mode 100644
index 6706d5b..0000000
--- a/xt/cli/mirror_multi.t
+++ /dev/null
@@ -1,39 +0,0 @@
-use strict;
-use Test::More;
-use xt::CLI;
-use Cwd;
-
-my $cwd = Cwd::cwd();
-
-{
-    # split string
-    my $app = cli();
-    $app->dir->touch("cpanfile", <<EOF);
-requires 'PSGI';
-EOF
-
-    $app->carton->{mirror} = "$cwd/xt/mirror,http://cpan.metacpan.org/";;
-    $app->run("install");
-
-    $app->run("list");
-    like $app->output, qr/^PSGI-/;
-}
-
-{
-    # ARRAY ref
-    my $app = cli();
-    $app->dir->touch("cpanfile", <<EOF);
-requires 'PSGI';
-EOF
-
-    $app->carton->{mirror} = ["$cwd/xt/mirror", "http://cpan.metacpan.org/";];
-    $app->run("install");
-    $app->run("list");
-    like $app->output, qr/^PSGI-/;
-}
-
-
-done_testing;
-
-
-

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

_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits

Reply via email to