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 <[email protected]> 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 [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
