[carton] 135/472: cleanup

Lucas Kanashiro kanashiro-guest at moszumanska.debian.org
Fri Jul 24 00:38:41 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 80c55a79a45141cca906ec49cc4374d0e89abce9
Author: NAKAGAWA Masaki <masaki.nakagawa at gmail.com>
Date:   Sun Jan 1 22:35:12 2012 +0900

    cleanup
---
 Makefile.PL       |  1 +
 lib/Carton.pm     | 56 +++++++++++++++++++++++++++----------------------------
 lib/Carton/CLI.pm | 14 +++++++++-----
 3 files changed, 37 insertions(+), 34 deletions(-)

diff --git a/Makefile.PL b/Makefile.PL
index ff240c3..052bc55 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -24,6 +24,7 @@ requires 'Module::Build', 0.38;
 requires 'CPAN::Meta', 2.112;
 
 # bundle DarkPAN support
+requires 'File::chdir';
 requires 'Dist::Metadata';
 requires 'IO::Compress::Gzip';
 
diff --git a/lib/Carton.pm b/lib/Carton.pm
index f714220..d7ce806 100644
--- a/lib/Carton.pm
+++ b/lib/Carton.pm
@@ -12,6 +12,7 @@ use CPAN::Meta;
 use File::Path ();
 use File::Basename ();
 use File::Spec ();
+use File::Temp ();
 use Capture::Tiny 'capture';
 
 use constant CARTON_LOCK_VERSION => '0.9';
@@ -32,22 +33,13 @@ sub configure {
 
 sub lock { $_[0]->{lock} }
 
-sub bundle_dir { File::Spec->rel2abs("$_[0]->{path}/cache") }
+sub local_mirror { File::Spec->rel2abs("$_[0]->{path}/cache") }
 
-sub bundle_from_build_file {
-    my($self, $file) = @_;
-
-    my $bundle_dir = $self->bundle_dir;
+sub download_from_build_file {
+    my($self, $build_file, $local_mirror) = @_;
 
     my @modules = $self->list_dependencies;
-    $self->download_conservative(\@modules, $bundle_dir, 1)
-        or die "Bundling modules failed\n";
-
-    my $index = $self->build_index_from_darkpan($bundle_dir);
-
-    my $index_file = "$bundle_dir/modules/02packages.details.txt.gz";
-    File::Path::mkpath(File::Basename::dirname($index_file));
-    $self->build_mirror_file($index, $index_file)
+    $self->download_conservative(\@modules, $local_mirror, 1)
         or die "Bundling modules failed\n";
 }
 
@@ -109,14 +101,11 @@ sub dedupe_modules {
 sub download_conservative {
     my($self, $modules, $dir, $cascade) = @_;
 
-    require File::Temp;
-
     $modules = $self->dedupe_modules($modules);
 
-    local $self->{path} = File::Temp::tempdir(CLEANUP => 1); # ignore installed
-
     my $mirror = $self->{mirror} || $DefaultMirror;
 
+    local $self->{path} = File::Temp::tempdir(CLEANUP => 1); # ignore installed
     $self->run_cpanm(
         "--mirror", $mirror,
         "--mirror", "http://backpan.perl.org/", # fallback
@@ -221,24 +210,22 @@ sub build_index {
     return $index;
 }
 
-sub build_index_from_darkpan {
-    my($self, $base_dir) = @_;
+sub build_mirror_index {
+    my($self, $local_mirror) = @_;
 
+    require File::chdir;
     require Dist::Metadata;
 
     my $index = {};
-    my $author_dir = "$base_dir/authors/id";
 
-    for my $file (<$author_dir/*/*/*/*>) {
+    local $File::chdir::CWD = "$local_mirror/authors/id";
+
+    for my $file (<*/*/*/*>) { # D/DU/DUMMY/Foo-Bar-0.01.tar.gz
         my $dist = Dist::Metadata->new(file => $file);
-        (my $normalized_path = $file) =~ s!$author_dir/!!;
-
-        my $provides = $dist->provides;
-        while (my($package, $meta) = each %$provides) {
-            $index->{$package} = +{
-                version => $meta->{version},
-                meta    => { pathname => $normalized_path },
-            };
+
+        my $provides = $dist->package_versions;
+        while (my($package, $version) = each %$provides) {
+            $index->{$package} = { version => $version, meta => { pathname => $file } };
         }
     };
 
@@ -354,6 +341,17 @@ sub run_cpanm {
     !system "cpanm", "--quiet", "-L", $self->{path}, "--notest", @args;
 }
 
+sub update_mirror_index {
+    my($self, $local_mirror) = @_;
+
+    my $index = $self->build_mirror_index($local_mirror);
+
+    my $file = "$local_mirror/modules/02packages.details.txt.gz";
+    File::Path::mkpath(File::Basename::dirname($file));
+    $self->build_mirror_file($index, $file)
+        or die "Bundling modules failed\n";
+}
+
 sub update_lock_file {
     my($self, $file) = @_;
 
diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm
index 989babd..20b5917 100644
--- a/lib/Carton/CLI.pm
+++ b/lib/Carton/CLI.pm
@@ -134,16 +134,19 @@ sub cmd_version {
 sub cmd_bundle {
     my($self, @args) = @_;
 
-    $self->parse_options(\@args, "p|path=s", sub { $self->carton->{path} = $_[1] });
+    $self->parse_options(\@args, "p|path=s" => sub { $self->carton->{path} = $_[1] });
+
+    my $local_mirror = $self->carton->local_mirror;
 
     if (my $build_file = $self->has_build_file) {
         $self->print("Bundling modules using $build_file\n");
-        $self->carton->bundle_from_build_file($build_file);
+        $self->carton->download_from_build_file($build_file, $local_mirror);
+        $self->carton->update_mirror_index($local_mirror);
     } else {
         $self->error("Can't locate build file\n");
     }
 
-    $self->printf("Complete! Modules were bundled into %s (DarkPAN)\n", $self->carton->bundle_dir, SUCCESS);
+    $self->printf("Complete! Modules were bundled into %s (DarkPAN)\n", $local_mirror, SUCCESS);
 }
 
 sub cmd_install {
@@ -153,15 +156,16 @@ sub cmd_install {
         \@args,
         "p|path=s"    => sub { $self->carton->{path} = $_[1] },
         "deployment!" => \$self->{deployment},
-        "cached!"     => \$self->{use_local_cache},
+        "cached!"     => \$self->{use_local_mirror},
     );
 
     my $lock = $self->find_lock;
+    my $local_mirror = $self->carton->local_mirror;
 
     $self->carton->configure(
         lock => $lock,
         mirror_file => $self->mirror_file, # $lock object?
-        ( $self->{use_local_cache} ? (mirror => $self->carton->bundle_dir) : () ),
+        ( $self->{use_local_mirror} && -d $local_mirror ? (mirror => $local_mirror) : () ),
     );
 
     my $build_file = $self->has_build_file;

-- 
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