From 4e40539f6e4dd38b10eca90d03e8ea2b546dc8b9 Mon Sep 17 00:00:00 2001 From: Tatsuhiko Miyagawa Date: Mon, 22 Jul 2013 12:12:09 -0700 Subject: introduce Carton::Environment object use Exception::Class more for error messaging --- lib/Carton/CLI.pm | 47 +++++++++++++++------------------ lib/Carton/Environment.pm | 66 +++++++++++++++++++++++++++++++++++++++++++++++ lib/Carton/Error.pm | 6 +++-- xt/cli/exec.t | 8 ++++++ 4 files changed, 99 insertions(+), 28 deletions(-) create mode 100644 lib/Carton/Environment.pm 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; -- cgit v1.2.1