[carton] 339/472: Support --cpanfile option for carton install, as well as PERL_CARTON_CPANFILE

Lucas Kanashiro kanashiro-guest at moszumanska.debian.org
Fri Jul 24 00:39:22 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 d2d11bbfbb22d16e27f018a34a3a33d7c3e0518a
Author: Tatsuhiko Miyagawa <miyagawa at bulknews.net>
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



More information about the Pkg-perl-cvs-commits mailing list