introduce Carton::Environment object

use Exception::Class more for error messaging

4 files changed, 99 insertions, 28 deletions

diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm
index 062c6f6..c9ecf29 100644
--- a/lib/Carton/CLI.pm
+++ b/lib/Carton/CLI.pm
@@ -9,12 +9,14 @@ use Path::Tiny;
 use Try::Tiny;
 use Moo;
 use Module::CoreList;
+use Scalar::Util qw(blessed);
 
 use Carton;
 use Carton::Builder;
 use Carton::Mirror;
 use Carton::Lock;
 use Carton::Util;
+use Carton::Environment;
 use Carton::Error;
 use Carton::Requirements;
 
@@ -26,14 +28,16 @@ has verbose => (is => 'rw');
 has carton  => (is => 'lazy');
 has mirror  => (is => 'rw', builder => 1,
                 coerce => sub { Carton::Mirror->new($_[0]) });
+has environment => (is => 'lazy',
+                    handles => [ qw( cpanfile lockfile install_path vendor_cache )]);
 
 sub _build_mirror {
     my $self = shift;
     $ENV{PERL_CARTON_MIRROR} || $Carton::Mirror::DefaultMirror;
 }
 
-sub install_path {
-    Path::Tiny->new($ENV{PERL_CARTON_PATH} || 'local')->absolute;
+sub _build_environment {
+    Carton::Environment->build;
 }
 
 sub work_file {
@@ -43,10 +47,6 @@ sub work_file {
     $wf;
 }
 
-sub vendor_cache {
-    Path::Tiny->new("vendor/cache")->absolute;
-}
-
 sub run {
     my($self, @args) = @_;
 
@@ -64,16 +64,21 @@ sub run {
     push @commands, @args;
 
     my $cmd = shift @commands || 'install';
-    my $call = $self->can("cmd_$cmd");
 
     my $code = try {
-        $self->error("Could not find command '$cmd'\n")
-            unless $call;
+        my $call = $self->can("cmd_$cmd")
+          or Carton::Error::CommandNotFound->throw(error => "Could not find command '$cmd'");
         $self->$call(@commands);
         return 0;
     } catch {
-        ref =~ /Carton::Error::CommandExit/ and return 255;
-        die $_;
+        die $_ unless blessed $_ && $_->can('rethrow');
+
+        if ($_->isa('Carton::Error::CommandExit')) {
+            return $_->code || 255;
+        } elsif ($_->isa('Carton::Error')) {
+            warn $_->error;
+            return 255;
+        }
     };
 
     return $code;
@@ -220,7 +225,7 @@ sub cmd_install {
 
     unless ($deployment) {
         my $prereqs = Module::CPANfile->load($cpanfile)->prereqs;
-        Carton::Lock->build_from_local($path, $prereqs)->write($self->lock_file);
+        Carton::Lock->build_from_local($path, $prereqs)->write($self->lockfile);
     }
 
     $self->print("Complete! Modules were installed into $path\n", SUCCESS);
@@ -348,7 +353,7 @@ sub cmd_update {
     );
     $builder->update($self->install_path, @modules);
 
-    Carton::Lock->build_from_local($self->install_path, $prereqs)->write($self->lock_file);
+    Carton::Lock->build_from_local($self->install_path, $prereqs)->write($self->lockfile);
 }
 
 sub cmd_exec {
@@ -385,21 +390,16 @@ sub cmd_exec {
 
 sub find_cpanfile {
     my $self = shift;
-
-    if (-e 'cpanfile') {
-        return 'cpanfile';
-    } else {
-        $self->error("Can't locate cpanfile\n");
-    }
+    $self->cpanfile;
 }
 
 sub find_lock {
     my $self = shift;
 
-    if (-e $self->lock_file) {
+    if (-e $self->lockfile) {
         my $lock;
         try {
-            $lock = Carton::Lock->from_file($self->lock_file);
+            $lock = Carton::Lock->from_file($self->lockfile);
         } catch {
             $self->error("Can't parse carton.lock: $_\n");
         };
@@ -410,11 +410,6 @@ sub find_lock {
     return;
 }
 
-sub lock_file {
-    my $self = shift;
-    return 'carton.lock';
-}
-
 sub index_file {
     my $self = shift;
     $self->work_file("cache/modules/02packages.details.txt");
diff --git a/lib/Carton/Environment.pm b/lib/Carton/Environment.pm
new file mode 100644
index 0000000..af39f4d
--- /dev/null
+++ b/lib/Carton/Environment.pm
@@ -0,0 +1,66 @@
+package Carton::Environment;
+use strict;
+use Moo;
+
+use Carton::Error;
+use Path::Tiny;
+
+has cpanfile => (is => 'rw');
+has lockfile => (is => 'lazy');
+has install_path => (is => 'lazy');
+has vendor_cache  => (is => 'lazy');
+
+sub _build_lockfile {
+    my $self = shift;
+    Path::Tiny->new($self->cpanfile->dirname . "/carton.lock");
+}
+
+sub _build_install_path {
+    my $self = shift;
+    if ($ENV{PERL_CARTON_PATH}) {
+        return Path::Tiny->new($ENV{PERL_CARTON_PATH})->absolute;
+    } else {
+        return Path::Tiny->new($self->cpanfile->dirname . "/local");
+    }
+}
+
+sub _build_vendor_cache {
+    my $self = shift;
+    Path::Tiny->new($self->install_path->dirname . "/vendor/cache");
+}
+
+sub build {
+    my $class = shift;
+
+    my $self = $class->new;
+
+    if (my $cpanfile = $self->locate_cpanfile) {
+        $self->cpanfile($cpanfile);
+    } else {
+        Carton::Error::CPANfileNotFound->throw(error => "Can't locate cpanfile");
+    }
+
+    $self;
+}
+
+sub locate_cpanfile {
+    my $self = shift;
+
+    my $current  = Path::Tiny->cwd;
+    my $previous = '';
+
+    until ($current eq '/' or $current eq $previous) {
+        # TODO support PERL_CARTON_CPANFILE
+        my $try = $current->child('cpanfile');
+        if ($try->exists) {
+            return $try->absolute;
+        }
+
+        ($previous, $current) = ($current, $current->parent);
+    }
+
+    return;
+}
+
+1;
+
diff --git a/lib/Carton/Error.pm b/lib/Carton/Error.pm
index 30b9882..24af647 100644
--- a/lib/Carton/Error.pm
+++ b/lib/Carton/Error.pm
@@ -1,8 +1,10 @@
 package Carton::Error;
 use strict;
 use Exception::Class (
-    'Carton::Error::CommandExit',
+    'Carton::Error',
+    'Carton::Error::CommandNotFound' => { isa => 'Carton::Error' },
+    'Carton::Error::CommandExit' => { isa => 'Carton::Error', fields => [ 'code' ] },
+    'Carton::Error::CPANfileNotFound' => { isa => 'Carton::Error' },
 );
 
-
 1;
diff --git a/xt/cli/exec.t b/xt/cli/exec.t
index 40b1055..72fe864 100644
--- a/xt/cli/exec.t
+++ b/xt/cli/exec.t
@@ -11,8 +11,16 @@ subtest 'carton exec without a command', sub {
     is $app->exit_code, 255;
 };
 
+subtest 'exec without cpanfile', sub {
+    my $app = cli();
+    $app->run("exec", "perl", "-e", 1);
+    like $app->stderr, qr/Can't locate cpanfile/;
+    is $app->exit_code, 255;
+};
+
 subtest 'exec without a lock', sub {
     my $app = cli();
+    $app->write_cpanfile();
     $app->run("exec", "perl", "-e", 1);
     like $app->stderr, qr/carton\.lock/;
     is $app->exit_code, 255;