[carton] 401/472: Beta: install fatpacked carton in vendor/bin Fix #109

[Lucas Kanashiro]

This is an automated email from the git hooks/post-receive script.

kanashiro-guest pushed a commit to branch master
in repository carton.

commit 3928a832e632e7c2b7c4427da83d4adcba2bd440
Author: Tatsuhiko Miyagawa <miyagawa at bulknews.net>
Date:   Fri Aug 9 18:13:43 2013 -0700

    Beta: install fatpacked carton in vendor/bin Fix #109
    
    It also fatpackes cpanm's fatscript, and runs that by saving it to a
    temp file with Module::Reader from fatpack.
    
    Meta-Fatpacking!
---
 cpanfile                  |  5 ++++-
 lib/Carton/Builder.pm     | 26 ++++++++++++++++++++++----
 lib/Carton/CLI.pm         |  3 +++
 lib/Carton/Environment.pm |  5 +++++
 lib/Carton/Packer.pm      | 46 ++++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 80 insertions(+), 5 deletions(-)

diff --git a/cpanfile b/cpanfile
index fcee8a4..4d89b23 100644
--- a/cpanfile
+++ b/cpanfile
@@ -24,9 +24,12 @@ requires 'CPAN::Meta', 2.120921;
 requires 'CPAN::Meta::Requirements', 2.121;
 requires 'Module::CoreList';
 
+requires 'App::FatPacker', 0.009018;
+requires 'File::pushd';
+requires 'Module::Reader', 0.002;
+
 on develop => sub {
     requires 'Test::More', 0.90;
     requires 'Test::Requires';
     requires 'Capture::Tiny';
-    requires 'File::pushd';
 };
diff --git a/lib/Carton/Builder.pm b/lib/Carton/Builder.pm
index 19cfb0a..9b89b34 100644
--- a/lib/Carton/Builder.pm
+++ b/lib/Carton/Builder.pm
@@ -1,13 +1,14 @@
 package Carton::Builder;
 use strict;
-use Module::Metadata;
 use Moo;
+no warnings 'once';
 
 has mirror  => (is => 'rw');
 has index   => (is => 'rw');
 has cascade => (is => 'rw', default => sub { 1 });
 has without => (is => 'rw', default => sub { [] });
 has cpanfile => (is => 'rw');
+has fatscript => (is => 'lazy');
 
 sub effective_mirrors {
     my $self = shift;
@@ -85,12 +86,29 @@ sub update {
     ) or die "Updating modules failed\n";
 }
 
+sub _build_fatscript {
+    my $self = shift;
+
+    my $fatscript;
+    if ($Carton::Fatpacked) {
+        require Module::Reader;
+        my $content = Module::Reader::module_content('App::cpanminus::fatscript')
+            or die "Can't locate App::cpanminus::fatscript";
+        $fatscript = Path::Tiny->tempfile;
+        $fatscript->spew($content);
+    } else {
+        require Module::Metadata;
+        $fatscript = Module::Metadata->find_module_by_name("App::cpanminus::fatscript")
+            or die "Can't locate App::cpanminus::fatscript.";
+    }
+
+    return $fatscript;
+}
+
 sub run_cpanm {
     my($self, @args) = @_;
     local $ENV{PERL_CPANM_OPT};
-    my $path = Module::Metadata->find_module_by_name("App::cpanminus::fatscript")
-        or die "Can't locate App::cpanminus::fatscript.";
-    !system $^X, $path, "--quiet", "--notest", @args;
+    !system $^X, $self->fatscript, "--quiet", "--notest", @args;
 }
 
 1;
diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm
index 652c0d4..8679ec4 100644
--- a/lib/Carton/CLI.pm
+++ b/lib/Carton/CLI.pm
@@ -157,6 +157,9 @@ sub cmd_bundle {
     );
     $builder->bundle($env->install_path, $env->vendor_cache, $env->snapshot);
 
+    require Carton::Packer;
+    Carton::Packer->new->fatpack_carton($env->vendor_bin);
+
     $self->printf("Complete! Modules were bundled into %s\n", $env->vendor_cache, SUCCESS);
 }
 
diff --git a/lib/Carton/Environment.pm b/lib/Carton/Environment.pm
index 3253b8b..a1464e2 100644
--- a/lib/Carton/Environment.pm
+++ b/lib/Carton/Environment.pm
@@ -38,6 +38,11 @@ sub _build_tree {
     Carton::Tree->new(cpanfile => $self->cpanfile, snapshot => $self->snapshot);
 }
 
+sub vendor_bin {
+    my $self = shift;
+    $self->vendor_cache->parent->child('bin');
+}
+
 sub build_with {
     my($class, $cpanfile) = @_;
 
diff --git a/lib/Carton/Packer.pm b/lib/Carton/Packer.pm
new file mode 100644
index 0000000..c1554cd
--- /dev/null
+++ b/lib/Carton/Packer.pm
@@ -0,0 +1,46 @@
+package Carton::Packer;
+use strict;
+use App::FatPacker;
+use File::pushd ();
+use Path::Tiny ();
+
+use Moo;
+
+sub fatpack_carton {
+    my($self, $dir) = @_;
+
+    my $temp = Path::Tiny->tempdir;
+    my $pushd = File::pushd::pushd $temp;
+
+    my $file = $temp->child('carton.pre.pl');
+
+    $file->spew(<<'EOF');
+#!/usr/bin/env perl
+use strict;
+use 5.008001;
+use Carton::CLI;
+$Carton::Fatpacked = 1;
+exit Carton::CLI->new->run(@ARGV);
+EOF
+
+    my $packer = App::FatPacker->new;
+
+    my @modules = split /\r?\n/, $packer->trace(args => [$file], use => ['App::cpanminus']);
+
+    my @packlists = $packer->packlists_containing(\@modules);
+    $packer->packlists_to_tree(Path::Tiny->new('fatlib')->absolute, \@packlists);
+
+    my $fatpacked = do {
+        local $SIG{__WARN__} = sub {};
+        $packer->fatpack_file($file);
+    };
+
+    my $executable = $dir->child('carton');
+    warn "Bundling $executable\n";
+
+    $dir->mkpath;
+    $executable->spew($fatpacked);
+    chmod 0755, $executable;
+}
+
+1;

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/carton.git