This is an automated email from the git hooks/post-receive script. kanashiro-guest pushed a commit to branch master in repository carton.
commit e646f7af55c3482f008a9fda4d3cb7e6ab6a3763 Author: Tatsuhiko Miyagawa <miyag...@bulknews.net> Date: Fri Jul 1 13:45:14 2011 -0700 Use Config::GitLike for config management --- Makefile.PL | 7 +-- lib/Carton.pm | 16 +++---- lib/Carton/CLI.pm | 81 +++++++++++++++++----------------- lib/Carton/Config.pm | 121 +++++++++++---------------------------------------- xt/CLI.pm | 2 +- xt/cli/config.t | 29 ++++++------ xt/cli/mirror.t | 2 +- 7 files changed, 97 insertions(+), 161 deletions(-) diff --git a/Makefile.PL b/Makefile.PL index b88e1d2..8875846 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -7,12 +7,13 @@ readme_from('lib/Carton.pod'); configure_requires 'version', 0.77; -requires 'JSON'; +requires 'JSON', 2.53; requires 'App::cpanminus', 1.4900; requires 'Term::ANSIColor', 1.12; requires 'Module::Metadata', 1.000003; -requires 'Try::Tiny'; -requires 'parent'; +requires 'Try::Tiny', 0.09; +requires 'parent', 0.223; +requires 'Config::GitLike', 1.05; install_script 'bin/carton'; diff --git a/lib/Carton.pm b/lib/Carton.pm index 65597ad..375e9e9 100644 --- a/lib/Carton.pm +++ b/lib/Carton.pm @@ -97,7 +97,7 @@ sub install_conservative { $self->build_mirror_file($index, $self->{mirror_file}); } - my $mirror = $self->config->get('mirror') || $DefaultMirror; + my $mirror = $self->config->get(key => 'cpanm.mirror') || $DefaultMirror; $self->run_cpanm( "--skip-satisfied", @@ -262,16 +262,16 @@ sub run_cpanm_output { return <$kid>; } else { local $ENV{PERL_CPANM_OPT}; - my $cpanm = $self->config->get('cpanm'); - exec $cpanm, "--quiet", "-L", $self->config->get('path'), @args; + my $cpanm = $self->config->get(key => 'cpanm.path'); + exec $cpanm, "--quiet", "-L", $self->config->get(key => 'environment.path'), @args; } } sub run_cpanm { my($self, @args) = @_; local $ENV{PERL_CPANM_OPT}; - my $cpanm = $self->config->get('cpanm'); - !system $cpanm, "--quiet", "-L", $self->config->get('path'), "--notest", @args; + my $cpanm = $self->config->get(key => 'cpanm.path'); + !system $cpanm, "--quiet", "-L", $self->config->get(key => 'environment.path'), "--notest", @args; } sub update_lock_file { @@ -299,7 +299,7 @@ sub find_locals { require File::Find; - my $libdir = $self->config->get('path') . "/lib/perl5/auto/meta"; + my $libdir = $self->config->get(key => 'environment.path') . "/lib/perl5/auto/meta"; return unless -e $libdir; my @locals; @@ -370,7 +370,7 @@ sub uninstall { my $meta = $lock->{modules}{$module}; (my $path_name = $meta->{name}) =~ s!::!/!g; - my $path = Cwd::realpath($self->config->get('path')); + my $path = Cwd::realpath($self->config->get(key => 'environment.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}"; @@ -383,7 +383,7 @@ sub uninstall { unlink $packlist; if ($meta->{dist}) { # safety guard not to rm -r auto/meta - File::Path::rmtree($self->config->get('path') . "/lib/perl5/auto/meta/$meta->{dist}"); + File::Path::rmtree($self->config->get(key => 'environment.path') . "/lib/perl5/auto/meta/$meta->{dist}"); } } diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm index 0a43762..ab1b2a0 100644 --- a/lib/Carton/CLI.pm +++ b/lib/Carton/CLI.pm @@ -14,13 +14,13 @@ use Carton::Config; use Carton::Tree; use Try::Tiny; -use constant { SUCCESS => 0, WARN => 1, INFO => 2, ERROR => 3 }; +use constant { SUCCESS => 0, INFO => 1, WARN => 2, ERROR => 3 }; our $Colors = { - SUCCESS() => 'green', - WARN() => 'yellow', - INFO() => 'cyan', - ERROR() => 'red', + SUCCESS, => 'green', + WARN, => 'yellow', + INFO, => 'cyan', + ERROR, => 'red', }; sub new { @@ -33,12 +33,17 @@ sub new { sub config { my $self = shift; - $self->{config} ||= Carton::Config->load; + $self->{config} ||= do { + my $config = Carton::Config->new(confname => "carton/config"); + $config->load; + $config->load_defaults; + $config; + }; } sub carton { my $self = shift; - $self->{carton} ||= Carton->new(config => $self->{config}); + $self->{carton} ||= Carton->new(config => $self->config); } sub work_file { @@ -69,8 +74,6 @@ sub run { my $cmd = shift @commands || 'usage'; my $call = $self->can("cmd_$cmd"); - $self->set_config_defaults; - if ($call) { $self->$call(@commands); } else { @@ -78,17 +81,6 @@ 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; @@ -124,13 +116,13 @@ sub printf { sub print { my($self, $msg, $type) = @_; $msg = colored $msg, $Colors->{$type} if defined $type && $self->{color}; - print $msg; + my $fh = $type && $type >= WARN ? *STDERR : *STDOUT; + print {$fh} $msg; } sub error { my($self, $msg) = @_; $self->print($msg, ERROR); - exit(1); } sub cmd_help { @@ -173,7 +165,7 @@ sub cmd_install { $self->error("Can't locate build file or carton.lock\n"); } - $self->printf("Complete! Modules were installed into %s\n", $self->config->get('path'), SUCCESS); + $self->printf("Complete! Modules were installed into %s\n", $self->config->get(key => 'environment.path'), SUCCESS); } sub cmd_uninstall { @@ -230,7 +222,7 @@ sub cmd_uninstall { if (@missing) { $self->printf("Complete! Modules and its dependencies were uninstalled from %s\n", - $self->config->get('path'), SUCCESS); + $self->config->get(key => 'environment.path'), SUCCESS); } } @@ -241,30 +233,37 @@ sub cmd_config { $self->parse_options(\@args, "global" => \$global, "local" => \$local, "unset" => \$unset); # don't use $self->config - my $config = Carton::Config->new; + my $config = Carton::Config->new(confname => "carton/config"); + my $filename; if ($global) { - $config->load_global; - $config->global(1); + $filename = $config->user_file; + $config->load_file($filename) if -f $filename; } elsif ($local) { - $config->load_local; + $filename = $config->dir_file; + $config->load_file($filename) if -f $filename; } else { - $config->load_global; - $config->load_local; + $filename = $config->dir_file; + $config->load; } + $config->load_defaults; + my($key, $value) = @args; + if (defined $key && $key !~ /\./) { + $self->error("key does not contain a section: $key\n"); + return; + } + if (!@args) { - $self->print($config->dump); + $self->print(my $dump = $config->dump); } elsif ($unset) { - $config->remove($key); - $config->save; + $config->set(key => $key, filename => $filename); } elsif (defined $value) { - $config->set($key, $value); - $config->save; - } else { - my $val = $config->get($key); + $config->set(key => $key, value => $value, filename => $filename); + } elsif (defined $key) { + my $val = $config->get(key => $key); if (defined $val) { $self->print($val . "\n") } @@ -350,7 +349,8 @@ sub cmd_check { } if ($res->{superflous}) { - $self->printf("Following modules are found in %s but couldn't be tracked from your $file\n", $self->config->get('path'), WARN); + $self->printf("Following modules are found in %s but couldn't be tracked from your $file\n", + $self->config->get(key => 'environment.path'), WARN); $self->carton->walk_down_tree($res->{superflous}, sub { my($module, $depth) = @_; my $line = " " x $depth . "$module->{dist}\n"; @@ -360,7 +360,8 @@ sub cmd_check { } if ($ok) { - $self->printf("Dependencies specified in your $file are satisfied and matches with modules in %s.\n", $self->config->get('path'), SUCCESS); + $self->printf("Dependencies specified in your $file are satisfied and matches with modules in %s.\n", + $self->config->get(key => 'environment.path'), SUCCESS); } } @@ -382,7 +383,7 @@ sub cmd_exec { my $include = join ",", @include, "."; - my $path = $self->config->get('path'); + my $path = $self->config->get(key => 'environment.path'); local $ENV{PERL5OPT} = "-MCarton::lib=$include -Mlib=$path/lib/perl5"; local $ENV{PATH} = "$path/bin:$ENV{PATH}"; diff --git a/lib/Carton/Config.pm b/lib/Carton/Config.pm index 5bdfdf2..816958b 100644 --- a/lib/Carton/Config.pm +++ b/lib/Carton/Config.pm @@ -2,114 +2,45 @@ package Carton::Config; use strict; use warnings; -use Carton::Util; -use Cwd; -use JSON; +use Any::Moose; +extends 'Config::GitLike'; -sub new { - my $class = shift; - bless { global => undef, values => {}, defaults => {} }, $class; -} - -sub set_defaults { - my($self, %values) = @_; - $self->{defaults} = \%values; -} - -sub get { - my($self, $key) = @_; - return exists $self->{values}{$key} ? $self->{values}{$key} - : exists $self->{defaults}{$key} ? $self->{defaults}{$key} - : undef; -} - -sub set { - my($self, $key, $value) = @_; - $self->{values}{$key} = $value; -} - -sub remove { - my($self, $key) = @_; - delete $self->{values}{$key}; -} +use File::Basename (); +use File::Path (); -sub load { - my $class = shift; - my $self = $class->new; +has 'loaded_defaults' => (is => 'rw', isa => 'Bool'); - $self->load_global; - $self->load_local; - - return $self; -} - -sub global { +sub load_defaults { my $self = shift; - $self->{global} = shift if @_; - $self->{global}; -} -sub global_dir { - "$ENV{HOME}/.carton"; -} + return if $self->loaded_defaults; -sub global_file { - my $self = shift; - return $self->global_dir . "/config"; -} + $self->data({}) unless $self->is_loaded; -sub local_dir { - my $self = shift; - Cwd::cwd . "/.carton"; -} + my @defaults = ( + [ 'environment', 'path' => 'local' ], + [ 'cpanm', 'path' => 'cpanm' ], + [ 'cpanm', 'mirror' => 'http://cpan.cpantesters.org' ], + ); -sub local_file { - my $self = shift; - return $self->local_dir . "/config"; -} - -sub load_global { - my $self = shift; - $self->load_file($self->global_file); -} - -sub load_local { - my $self = shift; - $self->load_file($self->local_file); -} - -sub load_file { - my($self, $file) = @_; + for my $default (@defaults) { + my($section, $name, $value) = @$default; + $self->define(section => $section, name => $name, value => $value, origin => 'module'); + } - my $values = -e $file ? Carton::Util::load_json($file) : {}; - @{$self->{values}}{keys %$values} = values %$values; + $self->loaded_defaults(1); } -sub save { - my $self = shift; - $self->global ? $self->save_global : $self->save_local; -} - -sub save_global { - my $self = shift; - $self->save_file($self->global_file, $self->global_dir); -} - -sub save_local { - my $self = shift; - mkdir Cwd::cwd . "/.carton", 0777; - $self->save_file($self->local_file, $self->local_dir); -} +sub set { + my($self, %args) = @_; -sub save_file { - my($self, $file, $dir) = @_; - mkdir $dir, 0777 unless -e $dir; - Carton::Util::dump_json($self->{values}, $file); -} + if ($args{filename}) { + my $dir = File::Basename::dirname($args{filename}); + File::Path::mkpath([ $dir ], 0, 0777); + } -sub dump { - my($self, $file) = @_; - Carton::Util::to_json($self->{values}); + $self->SUPER::set(%args); } 1; + diff --git a/xt/CLI.pm b/xt/CLI.pm index 0007dc2..fe43a65 100644 --- a/xt/CLI.pm +++ b/xt/CLI.pm @@ -10,7 +10,7 @@ sub cli { chdir $dir; my $app = Carton::CLI::Tested->new(dir => $dir); - $app->config->set("mirror" => "$ENV{HOME}/minicpan"); + $app->config->define(section => "cpanm", name => "mirror", value => "$ENV{HOME}/minicpan", origin => 'test'); return $app; } diff --git a/xt/cli/config.t b/xt/cli/config.t index 6c6a94b..7010550 100644 --- a/xt/cli/config.t +++ b/xt/cli/config.t @@ -7,25 +7,28 @@ use xt::CLI; my $app = cli(); $app->run("config", "foo"); - is $app->output, ''; + like $app->output, qr/key does not contain a section: foo/; - $app->run("config", "foo", "bar"); - $app->run("config", "foo"); - is $app->output, "bar\n"; + $app->run("config", "foo.bar"); + is $app->output, ''; - $app->run("config", "--global", "foo", "baz"); - $app->run("config", "--global", "foo"); + $app->run("config", "foo.bar", "baz"); + $app->run("config", "foo.bar"); is $app->output, "baz\n"; - $app->run("config", "foo"); - is $app->output, "bar\n"; + $app->run("config", "--global", "foo.bar", "quux"); + $app->run("config", "--global", "foo.bar"); + is $app->output, "quux\n"; - $app->run("config", "--unset", "foo"); - $app->run("config", "foo"); - is $app->output, "baz\n", "global config"; + $app->run("config", "foo.bar"); + is $app->output, "baz\n"; - $app->run("config", "--unset", "--global", "foo"); - $app->run("config", "foo"); + $app->run("config", "--unset", "foo.bar"); + $app->run("config", "foo.bar"); + is $app->output, "quux\n", "global config"; + + $app->run("config", "--unset", "--global", "foo.bar"); + $app->run("config", "foo.bar"); is $app->output, ""; } diff --git a/xt/cli/mirror.t b/xt/cli/mirror.t index d371773..f1e9c72 100644 --- a/xt/cli/mirror.t +++ b/xt/cli/mirror.t @@ -8,7 +8,7 @@ my $cwd = Cwd::cwd(); { my $app = cli(); - $app->config->set("mirror", "$cwd/xt/mirror"); + $app->config->define(section => "cpanm", name => "mirror", value => "$cwd/xt/mirror", origin => __FILE__); $app->run("install", "Hash::MultiValue"); $app->run("list"); -- 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