summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Makefile.PL7
-rw-r--r--lib/Carton.pm16
-rw-r--r--lib/Carton/CLI.pm81
-rw-r--r--lib/Carton/Config.pm121
-rw-r--r--xt/CLI.pm2
-rw-r--r--xt/cli/config.t29
-rw-r--r--xt/cli/mirror.t2
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");
View Lorry Controller Status