[carton] 67/472: Support local CPAN mirror #12
Lucas Kanashiro
kanashiro-guest at moszumanska.debian.org
Fri Jul 24 00:38:33 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 ba2c6f809a92c9b23b5f6a291225fd374708a980
Author: Tatsuhiko Miyagawa <miyagawa at 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
More information about the Pkg-perl-cvs-commits
mailing list