This is an automated email from the git hooks/post-receive script. kanashiro-guest pushed a commit to branch master in repository carton.
commit 4c484eae0e9be869a25fa56684654a56545b9299 Author: Tatsuhiko Miyagawa <[email protected]> Date: Tue Jun 28 09:25:55 2011 -0400 Implmeneted carton config #2 --- lib/Carton.pm | 11 ++++-- lib/Carton/CLI.pm | 47 +++++++++++++++++++++- lib/Carton/Config.pm | 109 +++++++++++++++++++++++++++++++++++++++++++++++++++ lib/Carton/Util.pm | 21 ++++++++-- xt/cli/config.t | 33 ++++++++++++++++ 5 files changed, 214 insertions(+), 7 deletions(-) diff --git a/lib/Carton.pm b/lib/Carton.pm index fdcf74b..fea01c1 100644 --- a/lib/Carton.pm +++ b/lib/Carton.pm @@ -7,16 +7,21 @@ use version; our $VERSION = qv('v0.1_0'); use Cwd; use Config qw(%Config); +use Carton::Config; use Carton::Util; use File::Path; sub new { - my $class = shift; + my($class, %args) = @_; bless { - cpanm => $ENV{PERL_CARTON_CPANM} || 'cpanm', + config => $args{config}, }, $class; } +sub config { + $_[0]->{config}; +} + sub configure { my($self, %args) = @_; %{$self} = (%$self, %args); @@ -299,7 +304,7 @@ sub find_locals { }; File::Find::find($wanted, $libdir); - return map { my $module = Carton::Util::parse_json($_); ($module->{name} => $module) } @locals; + return map { my $module = Carton::Util::load_json($_); ($module->{name} => $module) } @locals; } sub check_satisfies { diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm index 902c141..2c9aeda 100644 --- a/lib/Carton/CLI.pm +++ b/lib/Carton/CLI.pm @@ -10,6 +10,7 @@ use Config; use Getopt::Long; use Term::ANSIColor qw(colored); +use Carton::Config; use Carton::Tree; use Try::Tiny; @@ -32,6 +33,11 @@ sub new { }, $class; } +sub config { + my $self = shift; + $self->{config} ||= Carton::Config->load; +} + sub carton { $_[0]->{carton} } sub work_file { @@ -62,6 +68,8 @@ sub run { my $cmd = shift @commands || 'usage'; my $call = $self->can("cmd_$cmd"); + $self->config; # load Carton::Config + if ($call) { $self->$call(@commands); } else { @@ -198,6 +206,43 @@ sub cmd_uninstall { $self->print("Complete! Modules and its dependencies were uninstalled from $self->{path}\n", SUCCESS); } +sub cmd_config { + my($self, @args) = @_; + + my($global, $local, $unset); + $self->parse_options(\@args, "global" => \$global, "local" => \$local, "unset" => \$unset); + + # don't use $self->config + my $config = Carton::Config->new; + + if ($global) { + $config->load_global; + $config->global(1); + } elsif ($local) { + $config->load_local; + } else { + $config->load_global; + $config->load_local; + } + + my($key, $value) = @args; + + if (!@args) { + $self->print($config->dump); + } elsif ($unset) { + $config->remove($key); + $config->save; + } elsif (defined $value) { + $config->set($key, $value); + $config->save; + } else { + my $val = $config->get($key); + if (defined $val) { + $self->print($val . "\n") + } + } +} + sub mirror_file { my $self = shift; return $self->work_file("02packages.details.txt"); @@ -304,7 +349,7 @@ sub lock_data { my $lock; try { - $lock = Carton::Util::parse_json($self->lock_file); + $lock = Carton::Util::load_json($self->lock_file); } catch { if (/No such file/) { $self->error("Can't locate carton.lock\n"); diff --git a/lib/Carton/Config.pm b/lib/Carton/Config.pm new file mode 100644 index 0000000..b498853 --- /dev/null +++ b/lib/Carton/Config.pm @@ -0,0 +1,109 @@ +package Carton::Config; +use strict; +use warnings; + +use Carton::Util; +use Cwd; +use JSON; + +sub new { + my $class = shift; + bless { global => undef, values => {} }, $class; +} + +sub get { + my($self, $key, $default) = @_; + return exists $self->{values}{$key} ? + $self->{values}{$key} : $default; +} + +sub set { + my($self, $key, $value) = @_; + $self->{values}{$key} = $value; +} + +sub remove { + my($self, $key) = @_; + delete $self->{values}{$key}; +} + +sub load { + my $class = shift; + my $self = $class->new; + + $self->load_global; + $self->load_local; + + return $self; +} + +sub global { + my $self = shift; + $self->{global} = shift if @_; + $self->{global}; +} + +sub global_dir { + "$ENV{HOME}/.carton"; +} + +sub global_file { + my $self = shift; + return $self->global_dir . "/config"; +} + +sub local_dir { + my $self = shift; + Cwd::cwd . "/.carton"; +} + +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) = @_; + + my $values = -e $file ? Carton::Util::load_json($file) : {}; + @{$self->{values}}{keys %$values} = values %$values; +} + +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 save_file { + my($self, $file, $dir) = @_; + mkdir $dir, 0777 unless -e $dir; + Carton::Util::dump_json($self->{values}, $file); +} + +sub dump { + my($self, $file) = @_; + Carton::Util::to_json($self->{values}); +} + +1; diff --git a/lib/Carton/Util.pm b/lib/Carton/Util.pm index 519feb5..68353c0 100644 --- a/lib/Carton/Util.pm +++ b/lib/Carton/Util.pm @@ -2,14 +2,29 @@ package Carton::Util; use strict; use warnings; -sub parse_json { +sub load_json { my $file = shift; open my $fh, "<", $file or die "$file: $!"; + from_json(join '', <$fh>); +} + +sub dump_json { + my($data, $file) = @_; + + open my $fh, ">", $file or die "$file: $!"; + print $fh to_json($data); +} +sub from_json { require JSON; - JSON::decode_json(join '', <$fh>); + JSON::decode_json(@_); } -1; +sub to_json { + my($data) = @_; + require JSON; + JSON->new->pretty->encode($data); +} +1; diff --git a/xt/cli/config.t b/xt/cli/config.t new file mode 100644 index 0000000..6c6a94b --- /dev/null +++ b/xt/cli/config.t @@ -0,0 +1,33 @@ +use strict; +use warnings; +use Test::More; +use xt::CLI; + +{ + my $app = cli(); + + $app->run("config", "foo"); + is $app->output, ''; + + $app->run("config", "foo", "bar"); + $app->run("config", "foo"); + is $app->output, "bar\n"; + + $app->run("config", "--global", "foo", "baz"); + $app->run("config", "--global", "foo"); + is $app->output, "baz\n"; + + $app->run("config", "foo"); + is $app->output, "bar\n"; + + $app->run("config", "--unset", "foo"); + $app->run("config", "foo"); + is $app->output, "baz\n", "global config"; + + $app->run("config", "--unset", "--global", "foo"); + $app->run("config", "foo"); + is $app->output, ""; +} + +done_testing; + -- 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
