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 <miyag...@bulknews.net>
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
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