[carton] 66/472: Implmeneted carton config #2
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 4c484eae0e9be869a25fa56684654a56545b9299
Author: Tatsuhiko Miyagawa <miyagawa at 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
More information about the Pkg-perl-cvs-commits
mailing list