This is an automated email from the git hooks/post-receive script.

kanashiro-guest pushed a commit to branch master
in repository carton.

commit ba2c6f809a92c9b23b5f6a291225fd374708a980
Author: Tatsuhiko Miyagawa <miyag...@bulknews.net>
Date:   Tue Jun 28 09:44:18 2011 -0400

    Support local CPAN mirror #12
---
 lib/Carton.pm        | 14 ++++++++------
 lib/Carton/CLI.pm    | 48 ++++++++++++++++++++++++++++++------------------
 lib/Carton/Config.pm | 14 ++++++++++----
 xt/CLI.pm            |  6 +++++-
 4 files changed, 53 insertions(+), 29 deletions(-)

diff --git a/lib/Carton.pm b/lib/Carton.pm
index fea01c1..e981ff3 100644
--- a/lib/Carton.pm
+++ b/lib/Carton.pm
@@ -96,7 +96,7 @@ sub install_conservative {
 
     $self->run_cpanm(
         "--skip-satisfied",
-        "--mirror", "http://cpan.cpantesters.org/";, # fastest
+        "--mirror", $self->config->get('mirror') || 
'http://cpan.cpantesters.org/',
         "--mirror", "http://backpan.perl.org/";,     # fallback
         ( $self->lock ? ("--mirror-index", $self->{mirror_file}) : () ),
         ( $cascade ? "--cascade-search" : () ),
@@ -254,14 +254,16 @@ sub run_cpanm_output {
         return <$kid>;
     } else {
         local $ENV{PERL_CPANM_OPT};
-        exec $self->{cpanm}, "--quiet", "-L", $self->{path}, @args;
+        my $cpanm = $self->config->get('cpanm');
+        exec $cpanm, "--quiet", "-L", $self->config->get('path'), @args;
     }
 }
 
 sub run_cpanm {
     my($self, @args) = @_;
     local $ENV{PERL_CPANM_OPT};
-    !system $self->{cpanm}, "--quiet", "-L", $self->{path}, "--notest", @args;
+    my $cpanm = $self->config->get('cpanm');
+    !system $cpanm, "--quiet", "-L", $self->config->get('path'), "--notest", 
@args;
 }
 
 sub update_lock_file {
@@ -293,7 +295,7 @@ sub find_locals {
 
     require File::Find;
 
-    my $libdir = "$self->{path}/lib/perl5/auto/meta";
+    my $libdir = $self->config->get('path') . "/lib/perl5/auto/meta";
     return unless -e $libdir;
 
     my @locals;
@@ -364,7 +366,7 @@ sub uninstall {
     my $meta = $lock->{modules}{$module};
     (my $path_name = $meta->{name}) =~ s!::!/!g;
 
-    my $path = Cwd::realpath($self->{path});
+    my $path = Cwd::realpath($self->config->get('path'));
     my $packlist = 
"$path/lib/perl5/$Config{archname}/auto/$path_name/.packlist";
 
     open my $fh, "<", $packlist or die "Couldn't locate .packlist for 
$meta->{name}";
@@ -377,7 +379,7 @@ sub uninstall {
 
     unlink $packlist;
     if ($meta->{dist}) { # safety guard not to rm -r auto/meta
-        File::Path::rmtree("$self->{path}/lib/perl5/auto/meta/$meta->{dist}");
+        File::Path::rmtree($self->config->get('path') . 
"/lib/perl5/auto/meta/$meta->{dist}");
     }
 }
 
diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm
index 2c9aeda..af44916 100644
--- a/lib/Carton/CLI.pm
+++ b/lib/Carton/CLI.pm
@@ -26,10 +26,8 @@ our $Colors = {
 sub new {
     my $class = shift;
     bless {
-        path  => 'local',
         color => 1,
         verbose => 0,
-        carton => Carton->new,
     }, $class;
 }
 
@@ -38,7 +36,10 @@ sub config {
     $self->{config} ||= Carton::Config->load;
 }
 
-sub carton { $_[0]->{carton} }
+sub carton {
+    my $self = shift;
+    $self->{carton} ||= Carton->new(config => $self->{config});
+}
 
 sub work_file {
     my($self, $file) = @_;
@@ -68,7 +69,7 @@ sub run {
     my $cmd = shift @commands || 'usage';
     my $call = $self->can("cmd_$cmd");
 
-    $self->config; # load Carton::Config
+    $self->set_config_defaults;
 
     if ($call) {
         $self->$call(@commands);
@@ -77,6 +78,17 @@ sub run {
     }
 }
 
+sub set_config_defaults {
+    my $self = shift;
+
+    my $config = $self->config;
+    $config->set_defaults(
+        'path' => 'local',
+        'cpanm'  => 'cpanm',
+        'mirror' => 'http://cpan.cpantesters.org',
+    );
+}
+
 sub commands {
     my $self = shift;
 
@@ -102,6 +114,13 @@ sub parse_options {
     Getopt::Long::GetOptionsFromArray($args, @spec);
 }
 
+sub printf {
+    my $self = shift;
+    my $type = pop;
+    my($temp, @args) = @_;
+    $self->print(sprintf($temp, @args), $type);
+}
+
 sub print {
     my($self, $msg, $type) = @_;
     $msg = colored $msg, $Colors->{$type} if defined $type && $self->{color};
@@ -128,12 +147,11 @@ sub cmd_version {
 sub cmd_install {
     my($self, @args) = @_;
 
-    $self->parse_options(\@args, "p|path=s", \$self->{path}, "deployment!" => 
\$self->{deployment});
+    $self->parse_options(\@args, "p|path=s", sub { $self->config->set(path => 
$_[1]) }, "deployment!" => \$self->{deployment});
 
     my $lock = $self->find_lock;
 
     $self->carton->configure(
-        path => $self->{path},
         lock => $lock,
         mirror_file => $self->mirror_file, # $lock object?
     );
@@ -155,16 +173,13 @@ sub cmd_install {
         $self->error("Can't locate build file or carton.lock\n");
     }
 
-    $self->print("Complete! Modules were installed into $self->{path}\n", 
SUCCESS);
+    $self->printf("Complete! Modules were installed into %s\n", 
$self->config->get('path'), SUCCESS);
 }
 
 sub cmd_uninstall {
     my($self, @args) = @_;
 
-    $self->parse_options(\@args, "p|path=s", \$self->{path});
-    $self->carton->configure(
-        path => $self->{path},
-    );
+    $self->parse_options(\@args, "p|path=s", sub { $self->config->set(path => 
$_[1]) });
 
     my $lock = $self->find_lock
         or $self->error("Can't find carton.lock: Run `carton install`");
@@ -203,7 +218,7 @@ sub cmd_uninstall {
     }
 
     $self->carton->update_lock_file($self->lock_file);
-    $self->print("Complete! Modules and its dependencies were uninstalled from 
$self->{path}\n", SUCCESS);
+    $self->printf("Complete! Modules and its dependencies were uninstalled 
from %s\n", $self->config->get('path'), SUCCESS);
 }
 
 sub cmd_config {
@@ -291,10 +306,7 @@ sub cmd_check {
     my $file = $self->has_build_file
         or $self->error("Can't find a build file: nothing to check.\n");
 
-    $self->parse_options(\@args, "p|path=s", \$self->{path});
-    $self->carton->configure(
-        path => $self->{path},
-    );
+    $self->parse_options(\@args, "p|path=s", sub { $self->config->set(path => 
$_[1]) });
 
     my $lock = $self->carton->build_lock;
     my @deps = $self->carton->list_dependencies;
@@ -311,7 +323,7 @@ sub cmd_check {
     }
 
     if ($res->{superflous}) {
-        $self->print("Following modules are found in $self->{path} but 
couldn't be tracked from your $file\n", WARN);
+        $self->printf("Following modules are found in %s but couldn't be 
tracked from your $file\n", $self->config->get('path'), WARN);
         $self->carton->walk_down_tree($res->{superflous}, sub {
             my($module, $depth) = @_;
             my $line = "  " x $depth . "$module->{dist}\n";
@@ -321,7 +333,7 @@ sub cmd_check {
     }
 
     if ($ok) {
-        $self->print("Dependencies specified in your $file are satisfied and 
matches with modules in $self->{path}.\n", SUCCESS);
+        $self->printf("Dependencies specified in your $file are satisfied and 
matches with modules in %s.\n", $self->config->get('path'), SUCCESS);
     }
 }
 
diff --git a/lib/Carton/Config.pm b/lib/Carton/Config.pm
index b498853..5bdfdf2 100644
--- a/lib/Carton/Config.pm
+++ b/lib/Carton/Config.pm
@@ -8,13 +8,19 @@ use JSON;
 
 sub new {
     my $class = shift;
-    bless { global => undef, values => {} }, $class;
+    bless { global => undef, values => {}, defaults => {} }, $class;
+}
+
+sub set_defaults {
+    my($self, %values) = @_;
+    $self->{defaults} = \%values;
 }
 
 sub get {
-    my($self, $key, $default) = @_;
-    return exists $self->{values}{$key} ?
-        $self->{values}{$key} : $default;
+    my($self, $key) = @_;
+    return exists $self->{values}{$key}   ? $self->{values}{$key}
+         : exists $self->{defaults}{$key} ? $self->{defaults}{$key}
+         : undef;
 }
 
 sub set {
diff --git a/xt/CLI.pm b/xt/CLI.pm
index 1e0ea11..f1cd674 100644
--- a/xt/CLI.pm
+++ b/xt/CLI.pm
@@ -8,7 +8,11 @@ use Test::Requires qw( Directory::Scratch );
 sub cli {
     my $dir = Directory::Scratch->new();
     chdir $dir;
-    return Carton::CLI::Tested->new(dir => $dir);
+
+    my $app = Carton::CLI::Tested->new(dir => $dir);
+    $app->config->set("mirror" => "$ENV{HOME}/minicpan");
+
+    return $app;
 }
 
 sub run {

-- 
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
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits

Reply via email to