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

diff --git a/lib/App/FatPacker.pm b/lib/App/FatPacker.pm
index 3a0bf06..207141f 100644
--- a/lib/App/FatPacker.pm
+++ b/lib/App/FatPacker.pm
@@ -2,6 +2,7 @@ package App::FatPacker;
 
 use strict;
 use warnings FATAL => 'all';
+use 5.008001;
 use Getopt::Long;
 use Cwd qw(cwd);
 use File::Find qw(find);
@@ -13,7 +14,7 @@ use File::Copy qw(copy);
 use File::Path qw(mkpath rmtree);
 use B qw(perlstring);
 
-our $VERSION = '0.009012'; # 0.9.012
+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) = @_;
 
@@ -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;
@@ -185,13 +194,18 @@ 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;
+      !/\.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); <>
       };
@@ -212,7 +226,7 @@ sub script_command_file {
         if ($] < 5.008) {
           return sub {
             return 0 unless length $fat;
-            $text =~ s/^([^\n]*\n?)//;
+            $fat =~ s/^([^\n]*\n?)//;
             $_ = $1;
             return 1;
           };
@@ -233,7 +247,19 @@ 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
@@ -244,16 +270,24 @@ 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