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 <miyag...@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 _______________________________________________ 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