[carton] 132/472: merged from 'support-bundle'

Lucas Kanashiro kanashiro-guest at moszumanska.debian.org
Fri Jul 24 00:38:40 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 898130001ca658dfd5724ba5619772fe4df518d2
Author: NAKAGAWA Masaki <masaki.nakagawa at gmail.com>
Date:   Sun Jan 1 04:52:06 2012 +0900

    merged from 'support-bundle'
    
    commit c5346e8b54ce8ba51e435f0a4763ee9923166ee5
    Author: NAKAGAWA Masaki <masaki.nakagawa at gmail.com>
    Date:   Sun Jan 1 03:30:28 2012 +0900
    
        support gzip
    
    commit d98f183a5ad843c412c4d507ec7bbb400e144f53
    Author: NAKAGAWA Masaki <masaki.nakagawa at gmail.com>
    Date:   Sun Jan 1 03:07:14 2012 +0900
    
        install --cached
    
    commit bb83b459e881e9e519bf7f049a034d6743086956
    Author: NAKAGAWA Masaki <masaki.nakagawa at gmail.com>
    Date:   Sun Jan 1 02:00:10 2012 +0900
    
        create bundle darkpan index
    
    commit 2a19db9ffdeb76d01aa37601e8969204c422491e
    Author: NAKAGAWA Masaki <masaki.nakagawa at gmail.com>
    Date:   Sat Dec 31 17:58:58 2011 +0900
    
        rename
    
    commit 00279d5c3996454138067a7400556832bea52ac5
    Author: NAKAGAWA Masaki <masaki.nakagawa at gmail.com>
    Date:   Sat Dec 31 17:07:10 2011 +0900
    
        comment
    
    commit 77d85bc27f0d297914fe8309193616ee13cecbb2
    Author: NAKAGAWA Masaki <masaki.nakagawa at gmail.com>
    Date:   Sat Dec 31 16:31:35 2011 +0900
    
        inverse options
    
    commit ef871ac74543be31842d73cbe7217c673f92e294
    Author: NAKAGAWA Masaki <masaki.nakagawa at gmail.com>
    Date:   Sat Dec 31 16:31:26 2011 +0900
    
        dependency
    
    commit 1e7478e95ab82037155f493cb09228bddf76a454
    Author: NAKAGAWA Masaki <masaki.nakagawa at gmail.com>
    Date:   Sat Dec 31 15:35:30 2011 +0900
    
        refactor
    
    commit 899c770ca073cbbafc3144ea7eac5d1872f9376f
    Author: NAKAGAWA Masaki <masaki.nakagawa at gmail.com>
    Date:   Sat Dec 31 14:46:32 2011 +0900
    
        comment
    
    commit 23581ecf50362def5c0697e96162525cb2ee9024
    Author: NAKAGAWA Masaki <masaki.nakagawa at gmail.com>
    Date:   Sat Dec 31 14:44:52 2011 +0900
    
        lazy load
    
    commit 925427fc6a42fe573c6cc53d2fc696eb051acb48
    Author: NAKAGAWA Masaki <masaki.nakagawa at gmail.com>
    Date:   Sat Dec 31 02:30:10 2011 +0900
    
        'carton bundle'
---
 Makefile.PL       |  3 +++
 lib/Carton.pm     | 79 +++++++++++++++++++++++++++++++++++++++++++++++++++++--
 lib/Carton/CLI.pm | 23 +++++++++++++++-
 3 files changed, 102 insertions(+), 3 deletions(-)

diff --git a/Makefile.PL b/Makefile.PL
index 3c6801a..014e713 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -16,6 +16,9 @@ requires 'parent', 0.223;
 requires 'local::lib', 1.008;
 requires 'Exception::Class', 1.32;
 requires 'Capture::Tiny';
+requires 'File::Find';
+requires 'File::Temp';
+requires 'IO::Compress::Gzip';
 
 # MYMETA support
 requires 'App::cpanminus', 1.5000;
diff --git a/lib/Carton.pm b/lib/Carton.pm
index 15a2cdc..d83101b 100644
--- a/lib/Carton.pm
+++ b/lib/Carton.pm
@@ -9,7 +9,9 @@ use Cwd;
 use Config qw(%Config);
 use Carton::Util;
 use CPAN::Meta;
-use File::Path;
+use File::Path ();
+use File::Basename ();
+use File::Spec ();
 use Capture::Tiny 'capture';
 
 use constant CARTON_LOCK_VERSION => '0.9';
@@ -30,6 +32,25 @@ sub configure {
 
 sub lock { $_[0]->{lock} }
 
+sub bundle_dir { File::Spec->rel2abs("$_[0]->{path}/cache") }
+
+sub bundle_from_build_file {
+    my($self, $file) = @_;
+
+    my $bundle_dir = $self->bundle_dir;
+
+    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)
+        or die "Bundling modules failed\n";
+}
+
 sub install_from_build_file {
     my($self, $file) = @_;
 
@@ -85,6 +106,30 @@ sub dedupe_modules {
     return [ reverse @result ];
 }
 
+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;
+
+    $self->run_cpanm(
+        "--mirror", $mirror,
+        "--mirror", "http://backpan.perl.org/", # fallback
+        "--no-skip-satisfied",
+        ( $mirror ne $DefaultMirror ? "--mirror-only" : () ),
+        ( $cascade ? "--cascade-search" : () ),
+        "--scandeps",
+        "--format", "dists",
+        "--save-dists", $dir,
+        @$modules,
+    );
+}
+
 sub install_conservative {
     my($self, $modules, $cascade) = @_;
 
@@ -113,7 +158,13 @@ sub build_mirror_file {
 
     my @packages = $self->build_packages($index);
 
-    open my $fh, ">", $file or die $!;
+    my $fh;
+    if ($file =~ /\.gz$/i) {
+        require IO::Compress::Gzip;
+        $fh = IO::Compress::Gzip->new($file) or die $IO::Compress::Gzip::GzipError;
+    } else {
+        open $fh, ">", $file or die $!;
+    }
 
     print $fh <<EOF;
 File:         02packages.details.txt
@@ -170,6 +221,30 @@ sub build_index {
     return $index;
 }
 
+sub build_index_from_darkpan {
+    my($self, $base_dir) = @_;
+
+    require Dist::Metadata;
+
+    my $index = {};
+    my $author_dir = "$base_dir/authors/id";
+
+    for my $file (<$author_dir/*/*/*/*>) {
+        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 },
+            };
+        }
+    };
+
+    return $index;
+}
+
 sub is_core {
     my($self, $module, $want_ver, $perl_version) = @_;
     $perl_version ||= $];
diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm
index b8069df..989babd 100644
--- a/lib/Carton/CLI.pm
+++ b/lib/Carton/CLI.pm
@@ -131,16 +131,37 @@ sub cmd_version {
     $self->print("carton $Carton::VERSION\n");
 }
 
+sub cmd_bundle {
+    my($self, @args) = @_;
+
+    $self->parse_options(\@args, "p|path=s", sub { $self->carton->{path} = $_[1] });
+
+    if (my $build_file = $self->has_build_file) {
+        $self->print("Bundling modules using $build_file\n");
+        $self->carton->bundle_from_build_file($build_file);
+    } else {
+        $self->error("Can't locate build file\n");
+    }
+
+    $self->printf("Complete! Modules were bundled into %s (DarkPAN)\n", $self->carton->bundle_dir, SUCCESS);
+}
+
 sub cmd_install {
     my($self, @args) = @_;
 
-    $self->parse_options(\@args, "p|path=s", sub { $self->carton->{path} = $_[1] }, "deployment!" => \$self->{deployment});
+    $self->parse_options(
+        \@args,
+        "p|path=s"    => sub { $self->carton->{path} = $_[1] },
+        "deployment!" => \$self->{deployment},
+        "cached!"     => \$self->{use_local_cache},
+    );
 
     my $lock = $self->find_lock;
 
     $self->carton->configure(
         lock => $lock,
         mirror_file => $self->mirror_file, # $lock object?
+        ( $self->{use_local_cache} ? (mirror => $self->carton->bundle_dir) : () ),
     );
 
     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