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