[carton] 38/472: Changed the way it uses lock file.
Lucas Kanashiro
kanashiro-guest at moszumanska.debian.org
Fri Jul 24 00:38:30 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 9d5a33297ddab916e48085ab1352e488a97f0749
Author: Tatsuhiko Miyagawa <miyagawa at bulknews.net>
Date: Sun Jun 26 04:06:08 2011 -0700
Changed the way it uses lock file.
Now, like bundler, whenever you run `carton install` without
--deployment flag, it always scans deps from a build file, then merge
with the carton.lock root modules, and then conservatively install the
dependencies.
Now it uses the new --cascade-search option in cpanm.
---
lib/Carton.pm | 61 +++++++++++++++++++++++++++++++++++-----------
lib/Carton/CLI.pm | 51 +++++++++++++++++++++-----------------
lib/Carton/Doc/Install.pod | 31 ++++++++++++++---------
lib/Carton/Tree.pm | 7 ++++++
4 files changed, 102 insertions(+), 48 deletions(-)
diff --git a/lib/Carton.pm b/lib/Carton.pm
index 7268d53..5fbf474 100644
--- a/lib/Carton.pm
+++ b/lib/Carton.pm
@@ -14,16 +14,24 @@ sub new {
}, $class;
}
-sub configure_cpanm {
+sub configure {
my($self, %args) = @_;
- $self->{path} = $args{path};
+ %{$self} = (%$self, %args);
}
+sub lock { $_[0]->{lock} }
+
sub install_from_build_file {
my($self, $file) = @_;
- my @modules = $self->show_deps();
- $self->run_cpanm("--skip-satisfied", @modules)
+ my @modules;
+ if ($self->lock) {
+ my $tree = $self->build_tree($self->lock->{modules});
+ push @modules, map $_->spec, $tree->children;
+ }
+
+ push @modules, $self->show_deps();
+ $self->install_conservative(\@modules, 1)
or die "Installing modules failed\n";
}
@@ -40,24 +48,49 @@ sub show_deps {
sub install_modules {
my($self, $modules) = @_;
- $self->run_cpanm("--skip-satisfied", @$modules)
+ $self->install_conservative($modules, 1)
or die "Installing modules failed\n";
}
sub install_from_lock {
- my($self, $lock, $mirror_file) = @_;
+ my($self) = @_;
- my $index = $self->build_index($lock->{modules});
- $self->build_mirror_file($index, $mirror_file);
+ my $tree = $self->build_tree($self->lock->{modules});
+ my @root = map $_->spec, $tree->children;
- my $tree = $self->build_tree($lock->{modules});
- my @root = map $_->key, $tree->children;
+ $self->install_conservative(\@root, 0)
+ or die "Installing modules failed\n";
+}
+
+sub dedupe_modules {
+ my($self, $modules) = @_;
+
+ my %seen;
+ my @result;
+ for my $spec (reverse @$modules) {
+ my($mod, $ver) = split /@/, $spec;
+ next if $seen{$mod}++;
+ push @result, $spec;
+ }
+
+ return [ reverse @result ];
+}
+
+sub install_conservative {
+ my($self, $modules, $cascade) = @_;
+
+ $modules = $self->dedupe_modules($modules);
+
+ my $index = $self->build_index($self->lock->{modules});
+ $self->build_mirror_file($index, $self->{mirror_file});
$self->run_cpanm(
"--skip-satisfied",
- "--mirror", "http://backpan.perl.org/",
- "--mirror", "http://cpan.cpantesters.org/",
- "--index", $mirror_file, @root,
+ "--mirror", "http://cpan.cpantesters.org/", # fastest
+ "--mirror", "http://backpan.perl.org/", # fallback
+ "--mirror-index", $self->{mirror_file},
+ ( $cascade ? "--cascade-search" : () ),
+ @$modules,
);
}
@@ -213,7 +246,7 @@ sub run_cpanm {
!system $self->{cpanm}, "--quiet", "-L", $self->{path}, "--notest", @args;
}
-sub update_packages {
+sub update_lock_file {
my($self, $file) = @_;
my %locals = $self->find_locals;
diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm
index 1fb2ed6..149894f 100644
--- a/lib/Carton/CLI.pm
+++ b/lib/Carton/CLI.pm
@@ -123,19 +123,28 @@ sub cmd_install {
my($self, @args) = @_;
$self->parse_options(\@args, "p|path=s", \$self->{path}, "deployment!" => \$self->{deployment});
- $self->carton->configure_cpanm(path => $self->{path});
+
+ my $lock = $self->find_lock;
+
+ $self->carton->configure(
+ path => $self->{path},
+ lock => $lock,
+ mirror_file => $self->mirror_file, # $lock object?
+ );
+
+ my $build_file = $self->has_build_file;
if (@args) {
$self->print("Installing modules from the command line\n");
$self->carton->install_modules(\@args);
- $self->carton->update_packages($self->lock_file);
- } elsif (my $file = $self->has_build_file) {
- $self->print("Installing modules using $file\n");
- $self->carton->install_from_build_file($file);
- $self->carton->update_packages($self->lock_file);
- } elsif (-e $self->lock_file) {
- $self->print("Installing modules using carton.lock\n");
- $self->carton->install_from_lock($self->lock_data, $self->mirror_file);
+ $self->carton->update_lock_file($self->lock_file);
+ } elsif ($self->{deployment} or not $build_file) {
+ $self->print("Installing modules using carton.lock (deployment mode)\n");
+ $self->carton->install_from_lock;
+ } elsif ($build_file) {
+ $self->print("Installing modules using $build_file\n");
+ $self->carton->install_from_build_file($build_file);
+ $self->carton->update_lock_file($self->lock_file);
} else {
$self->error("Can't locate build file or carton.lock\n");
}
@@ -151,22 +160,10 @@ sub mirror_file {
sub has_build_file {
my $self = shift;
- # deployment mode ignores build files and only uses carton.lock
- return if $self->{deployment};
-
my $file = (grep -e, qw( Build.PL Makefile.PL ))[0]
or return;
- if ($self->mtime($file) > $self->mtime($self->lock_file)) {
- return $file;
- }
-
- return;
-}
-
-sub mtime {
- my($self, $file) = @_;
- return (stat($file))[9] || 0;
+ return $file;
}
*cmd_list = \&cmd_show;
@@ -219,6 +216,16 @@ sub cmd_exec {
# setup lib::core::only, -L env, put extlib/bin into PATH and exec script
}
+sub find_lock {
+ my $self = shift;
+
+ if (-e $self->lock_file) {
+ return $self->lock_data; # TODO object
+ }
+
+ return;
+}
+
sub lock_data {
my $self = shift;
diff --git a/lib/Carton/Doc/Install.pod b/lib/Carton/Doc/Install.pod
index 358cda6..1f5f8bc 100644
--- a/lib/Carton/Doc/Install.pod
+++ b/lib/Carton/Doc/Install.pod
@@ -22,24 +22,31 @@ install the modules given as arguments.
=item carton install (no arguments)
-If you run C<carton install> for the first itme, or your build file
-(C<Makefile.PL> or C<Build.PL>) is updated (i.e. its modification time
-is newer than C<carton.lock> file), carton will fetch all the
-dependencies specified in your build file, resolve dependencies and
-install all required modules.
+If you run C<carton install> without any arguments and if a build file
+(C<Makefile.PL> or C<Build.PL>) exists, carton will scan dependencies
+from the build file and install the modules.
=back
-In the development mode, carton will analyze all the dependencies and
-their version information, and it is saved into C<carton.lock>
-file. It is important to add C<carton.lock> file into a version
-controlled repository and commit the changes as you update your
-dependencies.
+In either way, if you run C<carton install> for the first time
+(i.e. C<carton.lock> does not exist), carton will fetch all the
+modules specified, resolve dependencies and install all required
+modules from CPAN.
+
+If C<carton.lock> file does exist, carton will still try to install
+modules specified or updated in the build file, but uses
+C<carton.lock> for the dependency resolution, and then cascades to
+CPAN.
+
+carton will analyze all the dependencies and their version
+information, and it is saved into C<carton.lock> file. It is important
+to add C<carton.lock> file into a version controlled repository and
+commit the changes as you update your dependencies.
=head2 DEPLOYMENT MODE
-If you specify the C<--deployment> command line option or your
-C<carton.lock> exists and is newer than your build file, carton will
+If you specify the C<--deployment> command line option or the
+C<carton.lock> exists and your build file does not exist, carton will
fetch all remote modules and use the dependencies specified in the
C<carton.lock> instead of resolving dependencies.
diff --git a/lib/Carton/Tree.pm b/lib/Carton/Tree.pm
index dd3ae5d..3047eec 100644
--- a/lib/Carton/Tree.pm
+++ b/lib/Carton/Tree.pm
@@ -59,6 +59,13 @@ sub abort {
sub key { $_[0]->[0] }
sub metadata { $_[0]->[1] }
+sub spec {
+ my $self = shift;
+
+ my $meta = $self->metadata;
+ $meta->{name} . ($meta->{version} ? '@' . $meta->{version} : '');
+}
+
sub children { @{$_[0]->[2]} }
sub add_child {
--
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