X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FApp%2FFatPacker.pm;h=207141faf653d9ee47a6a0fefa5d66caaba2ce80;hb=1f8ac8bda7fdeba9e9a8a4559de66635046c38ed;hp=433cc0f80592c678e3638876b78462b8bb917872;hpb=878b80daf5eac90cbd019cd0e38b35ee7a0b7492;p=p5sagit%2FApp-FatPacker.git

diff --git a/lib/App/FatPacker.pm b/lib/App/FatPacker.pm
index 433cc0f..207141f 100644
--- a/lib/App/FatPacker.pm
+++ b/lib/App/FatPacker.pm
@@ -9,11 +9,12 @@ use File::Find qw(find);
 use File::Spec::Functions qw(
   catdir splitpath splitdir catpath rel2abs abs2rel
 );
+use File::Spec::Unix;
 use File::Copy qw(copy);
 use File::Path qw(mkpath rmtree);
 use B qw(perlstring);
 
-our $VERSION = '0.009007'; # 0.9.7
+our $VERSION = '0.009016'; # 0.009.016
 
 $VERSION = eval $VERSION;
 
@@ -66,6 +67,19 @@ sub script_command_help {
   print "Try `perldoc fatpack` for how to use me\n";
 }
 
+sub script_command_pack {
+  my ($self, $args) = @_;
+
+  my @modules = split /\r?\n/, $self->trace(args => $args);
+  my @packlists = $self->packlists_containing(\@modules);
+
+  my $base = catdir(cwd, 'fatlib');
+  $self->packlists_to_tree($base, \@packlists);
+
+  my $file = shift @$args;
+  print $self->fatpack_file($file);
+}
+
 sub script_command_trace {
   my ($self, $args) = @_;
 
@@ -84,7 +98,7 @@ sub script_command_trace {
   }
   my $arg = do {
     if ($to_stderr) {
-      "=&STDERR"
+      ">&STDERR"
     } elsif ($file) {
       ">>${file}"
     }
@@ -100,12 +114,7 @@ sub script_command_trace {
 sub trace {
   my ($self, %opts) = @_;
 
-  my $capture;
-
-  my $output = $opts{output} || do {
-    $capture++; '>&STDOUT'
-  };
-
+  my $output = $opts{output};
   my $trace_opts = join ',', $output||'>&STDOUT', @{$opts{use}||[]};
 
   local $ENV{PERL5OPT} = '-MApp::FatPacker::Trace='.$trace_opts;
@@ -133,7 +142,9 @@ sub script_command_packlists_for {
 sub packlists_containing {
   my ($self, $targets) = @_;
   my @targets = @$targets;
-  require $_ for @targets;
+  foreach my $t (@targets) {
+    require $t;
+  }
   my @search = grep -d $_, map catdir($_, 'auto'), @INC;
   my %pack_rev;
   my $cwd = cwd;
@@ -183,16 +194,22 @@ sub packlists_to_tree {
 sub script_command_file {
   my ($self, $args) = @_;
   my $file = shift @$args;
+  print $self->fatpack_file($file);
+}
+
+sub fatpack_file {
+  my ($self, $file) = @_;
   my $cwd = cwd;
-  my @dirs = map rel2abs($_, $cwd), ('lib','fatlib');
+  my @dirs = grep -d, map rel2abs($_, $cwd), ('lib','fatlib');
   my %files;
   foreach my $dir (@dirs) {
     find(sub {
       return unless -f $_;
-      !/\.pm$/ and warn "File ${File::Find::name} isn't a .pm file - can't pack this and if you hoped we were going to things may not be what you expected later\n" and return;
-      $files{abs2rel($File::Find::name,$dir)} = do {
+      !/\.pm$/ and warn "File ${File::Find::name} isn't a .pm file - can't pack this -- if you hoped we were going to, things may not be what you expected later\n" and return;
+      $files{File::Spec::Unix->abs2rel($File::Find::name,$dir)} = do {
         local (@ARGV, $/) = ($File::Find::name); <>
       };
+      close ARGV;
     }, $dir);
   }
   my $start = stripspace <<'  END_START';
@@ -206,6 +223,14 @@ sub script_command_file {
 
     unshift @INC, sub {
       if (my $fat = $fatpacked{$_[1]}) {
+        if ($] < 5.008) {
+          return sub {
+            return 0 unless length $fat;
+            $fat =~ s/^([^\n]*\n?)//;
+            $_ = $1;
+            return 1;
+          };
+        }
         open my $fh, '<', \$fat
           or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
         return $fh;
@@ -222,25 +247,47 @@ sub script_command_file {
     '$fatpacked{'.perlstring($_).qq!} = <<'${name}';\n!
     .qq!${data}${name}\n!;
   } sort keys %files;
-  print join "\n", $start, @segments, $end;
+  my $shebang = "";
+  my $script = "";
+  if ( defined $file and -r $file ) {
+    open my $fh, "<", $file or die("Can't read $file: $!");
+    $shebang = <$fh>;
+    $script = join "", <$fh>;
+    close $fh;
+    unless ( index($shebang, '#!') == 0 ) {
+      $script = $shebang . $script;
+      $shebang = "";
+    }
+  }
+  return join "\n", $shebang, $start, @segments, $end, $script;
 }
 
+=encoding UTF-8
+
 =head1 NAME
 
 App::FatPacker - pack your dependencies onto your script file
 
 =head1 SYNOPSIS
 
+  $ fatpack pack myscript.pl >myscript.packed.pl
+
+Or, with more step-by-step control:
+
   $ fatpack trace myscript.pl
   $ fatpack packlists-for `cat fatpacker.trace` >packlists
   $ fatpack tree `cat packlists`
-  $ (fatpack file; cat myscript.pl) >myscript.packed.pl
+  $ fatpack file myscript.pl >myscript.packed.pl
 
 See the documentation for the L<fatpack> script itself for more information.
 
 The programmatic API for this code is not yet fully decided, hence the 0.9
 release version. Expect that to be cleaned up for 1.0.
 
+=head1 SEE ALSO
+
+L<article for Perl Advent 2012|http://www.perladvent.org/2012/2012-12-14.html>
+
 =head1 SUPPORT
 
 Your current best avenue is to come annoy annoy mst on #toolchain on
@@ -252,7 +299,23 @@ Matt S. Trout (mst) <mst@shadowcat.co.uk>
 
 =head2 CONTRIBUTORS
 
-None as yet, though I probably owe lots of people thanks for ideas. Yet
+miyagawa - Tatsuhiko Miyagawa (cpan:MIYAGAWA) <miyagawa@bulknews.net>
+
+tokuhirom - MATSUNO★Tokuhiro (cpan:TOKUHIROM) <tokuhirom@gmail.com>
+
+dg - David Leadbeater (cpan:DGL) <dgl@dgl.cx>
+
+gugod - 劉康民 (cpan:GUGOD) <gugod@cpan.org>
+
+t0m - Tomas Doran (cpan:BOBTFISH) <bobtfish@bobtfish.net>
+
+sawyer - Sawyer X (cpan:XSAWYERX) <xsawyerx@cpan.org>
+
+ether - Karen Etheridge (cpan:ETHER) <ether@cpan.org>
+
+Mithaldu - Christian Walde (cpan:MITHALDU) <walde.christian@googlemail.com>
+
+Many more people are probably owed thanks for ideas. Yet
 another doc nit to fix.
 
 =head1 COPYRIGHT