[carton] 256/472: move all Carton.pm God class into CLI and Lock/Builder modules
Lucas Kanashiro
kanashiro-guest at moszumanska.debian.org
Fri Jul 24 00:38:52 UTC 2015
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 <miyagawa at 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
More information about the Pkg-perl-cvs-commits
mailing list