This is an automated email from the git hooks/post-receive script. kanashiro-guest pushed a commit to branch master in repository carton.
commit d2d11bbfbb22d16e27f018a34a3a33d7c3e0518a Author: Tatsuhiko Miyagawa <[email protected]> Date: Tue Jul 23 01:48:34 2013 -0700 Support --cpanfile option for carton install, as well as PERL_CARTON_CPANFILE Refactored the way to build environment. For now, use carton.{cpanfile-name}.lock for alternate cpanfile lock --- lib/Carton/Builder.pm | 1 + lib/Carton/CLI.pm | 19 +++++++++++-------- lib/Carton/Environment.pm | 40 +++++++++++++++++++++++++++++++--------- lib/Carton/Lockfile.pm | 4 ++-- xt/CLI.pm | 7 ++++++- xt/cli/cpanfile.t | 44 ++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 95 insertions(+), 20 deletions(-) diff --git a/lib/Carton/Builder.pm b/lib/Carton/Builder.pm index c57fd46..634f9d2 100644 --- a/lib/Carton/Builder.pm +++ b/lib/Carton/Builder.pm @@ -54,6 +54,7 @@ sub install { ( $self->custom_mirror ? "--mirror-only" : () ), "--save-dists", "$path/cache", $self->groups, + "--cpanfile", $self->cpanfile, "--installdeps", $self->cpanfile->dirname, ) or die "Installing modules failed\n"; } diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm index 1dbad55..34e8c36 100644 --- a/lib/Carton/CLI.pm +++ b/lib/Carton/CLI.pm @@ -28,7 +28,7 @@ has verbose => (is => 'rw'); has carton => (is => 'lazy'); has mirror => (is => 'rw', builder => 1, coerce => sub { Carton::Mirror->new($_[0]) }); -has environment => (is => 'lazy', +has environment => (is => 'rw', builder => 1, lazy => 1, handles => [ qw( cpanfile lockfile install_path vendor_cache )]); sub _build_mirror { @@ -174,17 +174,20 @@ sub cmd_bundle { sub cmd_install { my($self, @args) = @_; - my $path = $self->install_path; - my @without; + my($install_path, $cpanfile_path, @without); $self->parse_options( \@args, - "p|path=s" => \$path, - "without=s" => sub { push @without, split /,/, $_[1] }, + "p|path=s" => \$install_path, + "cpanfile=s" => \$cpanfile_path, + "without=s" => sub { push @without, split /,/, $_[1] }, "deployment!" => \my $deployment, "cached!" => \my $cached, ); + my $environment = Carton::Environment->build($cpanfile_path, $install_path); + $self->environment($environment); + my $lock = $self->lockfile->load_if_exists; if ($deployment && !$lock) { @@ -219,14 +222,14 @@ sub cmd_install { $builder->mirror(Carton::Mirror->new($self->vendor_cache)); } - $builder->install($path); + $builder->install($self->install_path); unless ($deployment) { my $prereqs = Module::CPANfile->load($cpanfile)->prereqs; - Carton::Lock->build_from_local($path, $prereqs)->write($self->lockfile); + Carton::Lock->build_from_local($self->install_path, $prereqs)->write($self->lockfile); } - $self->print("Complete! Modules were installed into $path\n", SUCCESS); + $self->print("Complete! Modules were installed into @{[$self->install_path]}\n", SUCCESS); } sub cmd_show { diff --git a/lib/Carton/Environment.pm b/lib/Carton/Environment.pm index 79aed97..a7efc41 100644 --- a/lib/Carton/Environment.pm +++ b/lib/Carton/Environment.pm @@ -8,20 +8,22 @@ use Path::Tiny; has cpanfile => (is => 'rw'); has lockfile => (is => 'lazy'); -has install_path => (is => 'lazy'); +has install_path => (is => 'rw', lazy => 1, builder => 1, coerce => sub { Path::Tiny->new($_[0])->absolute }); has vendor_cache => (is => 'lazy'); sub _build_lockfile { my $self = shift; - Carton::Lockfile->new($self->cpanfile->dirname . "/carton.lock"); + my $base = $self->cpanfile->basename eq 'cpanfile' + ? 'carton.lock' : ("carton." . $self->cpanfile->basename . ".lock"); + Carton::Lockfile->new($self->cpanfile->dirname . "/$base"); } sub _build_install_path { my $self = shift; if ($ENV{PERL_CARTON_PATH}) { - return Path::Tiny->new($ENV{PERL_CARTON_PATH})->absolute; + return $ENV{PERL_CARTON_PATH}; } else { - return Path::Tiny->new($self->cpanfile->dirname . "/local"); + return $self->cpanfile->dirname . "/local"; } } @@ -30,22 +32,42 @@ sub _build_vendor_cache { Path::Tiny->new($self->install_path->dirname . "/vendor/cache"); } +sub build_with { + my($class, $cpanfile) = @_; + + $cpanfile = Path::Tiny->new($cpanfile)->absolute; + if ($cpanfile->is_file) { + return $class->new(cpanfile => $cpanfile); + } else { + Carton::Error::CPANfileNotFound->throw(error => "Can't locate cpanfile: $cpanfile"); + } +} + sub build { - my $class = shift; + my($class, $cpanfile_path, $install_path) = @_; my $self = $class->new; - if (my $cpanfile = $self->locate_cpanfile) { + $cpanfile_path &&= Path::Tiny->new($cpanfile_path)->absolute; + + my $cpanfile = $self->locate_cpanfile($cpanfile_path || $ENV{PERL_CARTON_CPANFILE}); + if ($cpanfile && $cpanfile->is_file) { $self->cpanfile($cpanfile); } else { - Carton::Error::CPANfileNotFound->throw(error => "Can't locate cpanfile"); + Carton::Error::CPANfileNotFound->throw(error => "Can't locate cpanfile: (@{[ $cpanfile_path || 'cpanfile' ]})"); } + $self->install_path($install_path) if $install_path; + $self; } sub locate_cpanfile { - my $self = shift; + my($self, $path) = @_; + + if ($path) { + return Path::Tiny->new($path)->absolute; + } my $current = Path::Tiny->cwd; my $previous = ''; @@ -53,7 +75,7 @@ sub locate_cpanfile { until ($current eq '/' or $current eq $previous) { # TODO support PERL_CARTON_CPANFILE my $try = $current->child('cpanfile'); - if ($try->exists) { + if ($try->is_file) { return $try->absolute; } diff --git a/lib/Carton/Lockfile.pm b/lib/Carton/Lockfile.pm index f4ea3be..2e9bf5e 100644 --- a/lib/Carton/Lockfile.pm +++ b/lib/Carton/Lockfile.pm @@ -10,13 +10,13 @@ sub new { sub load_if_exists { my $self = shift; - Carton::Lock->from_file($self) if $self->exists; + Carton::Lock->from_file($self) if $self->is_file; } sub load { my $self = shift; - if ($self->exists) { + if ($self->is_file) { Carton::Lock->from_file($self); } else { Carton::Error::LockfileNotFound->throw( diff --git a/xt/CLI.pm b/xt/CLI.pm index f2b6f3d..59bcefa 100644 --- a/xt/CLI.pm +++ b/xt/CLI.pm @@ -26,9 +26,14 @@ has stdout => (is => 'rw'); has stderr => (is => 'rw'); has exit_code => (is => 'rw'); +sub write_file { + my($self, $file, @args) = @_; + $self->dir->child($file)->spew(@args); +} + sub write_cpanfile { my($self, @args) = @_; - $self->dir->child('cpanfile')->spew(@args); + $self->write_file(cpanfile => @args); } sub run_in_dir { diff --git a/xt/cli/cpanfile.t b/xt/cli/cpanfile.t new file mode 100644 index 0000000..e454d1a --- /dev/null +++ b/xt/cli/cpanfile.t @@ -0,0 +1,44 @@ +use strict; +use Test::More; +use xt::CLI; + +subtest 'carton install --cpanfile' => sub { + my $app = cli(); + $app->write_file('cpanfile.foo', <<EOF); +requires 'Try::Tiny', '== 0.11'; +EOF + $app->run("install", "--cpanfile", "cpanfile.foo"); + $app->run("check", "--cpanfile", "cpanfile.foo"); + +# ok !$app->dir->child('cpanfile.lock')->exists; +# ok $app->dir->child('cpanfile.foo.lock')->exists; + + like $app->stdout, qr/are satisfied/; + + local $ENV{PERL_CARTON_CPANFILE} = $app->dir->child('cpanfile.foo')->absolute; + + $app->run("list"); + like $app->stdout, qr/Try-Tiny-0\.11/; + + $app->run("exec", "perl", "-e", "use Try::Tiny\ 1"); + like $app->stderr, qr/Try::Tiny .* 0\.11/; +}; + +subtest 'PERL_CARTON_CPANFILE' => sub { + my $app = cli(); + + local $ENV{PERL_CARTON_CPANFILE} = $app->dir->child('cpanfile.foo')->absolute; + + $app->write_file('cpanfile.foo', <<EOF); +requires 'Try::Tiny', '== 0.11'; +EOF + + $app->run("install"); + $app->run("list"); + + like $app->stdout, qr/Try-Tiny-0\.11/; +# ok $app->dir->child('cpanfile.foo.lock')->exists; +}; + +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
