1 package App::FatPacker;
4 use warnings FATAL => 'all';
8 use File::Find qw(find);
9 use File::Spec::Functions qw(
10 catdir splitpath splitdir catpath rel2abs abs2rel
13 use File::Copy qw(copy);
14 use File::Path qw(mkpath rmtree);
17 our $VERSION = '0.009014'; # 0.009.014
19 $VERSION = eval $VERSION;
23 my ($args, $options) = @_;
25 local *ARGV = [ @{$args} ];
26 $self->{option_parser}->getoptions(@$options);
32 map +(chomp,$_)[1], do { local @ARGV = ($_[0]); <> };
37 open my $in, "<", $file or die "$file: $!";
39 if ($head =~ m/^#\!/) {
40 ($head, do { local $/; <$in> });
42 ('', do { local $/; $head . <$in> });
48 $text =~ /^(\s+)/ && $text =~ s/^$1//mg;
53 $_[1] && $_[1] eq '-run_script'
54 and return shift->new->run_script;
59 option_parser => Getopt::Long::Parser->new(
60 config => [ qw(require_order pass_through bundling no_auto_abbrev) ]
66 my ($self, $args) = @_;
67 my @args = $args ? @$args : @ARGV;
68 (my $cmd = shift @args || 'help') =~ s/-/_/g;
70 if (my $meth = $self->can("script_command_${cmd}")) {
73 die "No such command ${cmd}";
77 sub script_command_help {
78 print "Try `perldoc fatpack` for how to use me\n";
81 sub script_command_pack {
82 my ($self, $args) = @_;
84 my @modules = split /\r?\n/, $self->trace(args => $args);
85 my @packlists = $self->packlists_containing(\@modules);
87 my $base = catdir(cwd, 'fatlib');
88 $self->packlists_to_tree($base, \@packlists);
90 my $file = shift @$args;
91 my($head, $body) = maybe_shebang($file);
92 print $head, $self->fatpack_file($file), $body;
95 sub script_command_trace {
96 my ($self, $args) = @_;
98 $args = $self->call_parser($args => [
100 'to-stderr' => \my $to_stderr,
101 'use=s' => \my @additional_use
104 die "Can't use to and to-stderr on same call" if $file && $to_stderr;
106 $file ||= 'fatpacker.trace';
108 if (!$to_stderr and -e $file) {
109 unlink $file or die "Couldn't remove old trace file: $!";
120 use => \@additional_use,
127 my ($self, %opts) = @_;
129 my $output = $opts{output};
130 my $trace_opts = join ',', $output||'>&STDOUT', @{$opts{use}||[]};
132 local $ENV{PERL5OPT} = '-MApp::FatPacker::Trace='.$trace_opts;
134 my @args = @{$opts{args}||[]};
137 # user specified output target, JFDI
141 # no output target specified, slurp
142 open my $out_fh, '-|', $^X, @args;
143 return do { local $/; <$out_fh> };
147 sub script_command_packlists_for {
148 my ($self, $args) = @_;
149 foreach my $pl ($self->packlists_containing($args)) {
154 sub packlists_containing {
155 my ($self, $targets) = @_;
156 my @targets = @$targets;
157 foreach my $t (@targets) {
160 my @search = grep -d $_, map catdir($_, 'auto'), @INC;
164 return unless $_ eq '.packlist' && -f $_;
165 $pack_rev{$_} = $File::Find::name for lines_of $File::Find::name;
167 chdir($cwd) or die "Couldn't chdir back to ${cwd} after find: $!";
168 my %found; @found{map +($pack_rev{$INC{$_}}||()), @targets} = ();
172 sub script_command_tree {
173 my ($self, $args) = @_;
174 my $base = catdir(cwd,'fatlib');
175 $self->packlists_to_tree($base, $args);
178 sub packlists_to_tree {
179 my ($self, $where, $packlists) = @_;
182 foreach my $pl (@$packlists) {
183 my ($vol, $dirs, $file) = splitpath $pl;
184 my @dir_parts = splitdir $dirs;
186 PART: foreach my $p (0 .. $#dir_parts) {
187 if ($dir_parts[$p] eq 'auto') {
188 # $p-2 since it's <wanted path>/$Config{archname}/auto
189 $pack_base = catpath $vol, catdir @dir_parts[0..$p-2];
193 die "Couldn't figure out base path of packlist ${pl}" unless $pack_base;
194 foreach my $source (lines_of $pl) {
195 # there is presumably a better way to do "is this under this base?"
196 # but if so, it's not obvious to me in File::Spec
197 next unless substr($source,0,length $pack_base) eq $pack_base;
198 my $target = rel2abs( abs2rel($source, $pack_base), $where );
199 my $target_dir = catpath((splitpath $target)[0,1]);
201 copy $source => $target;
206 sub script_command_file {
207 my ($self, $args) = @_;
208 my $file = shift @$args;
209 print $self->fatpack_file($file);
213 my ($self, $file) = @_;
215 my @dirs = grep -d, map rel2abs($_, $cwd), ('lib','fatlib');
217 foreach my $dir (@dirs) {
220 !/\.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;
221 $files{File::Spec::Unix->abs2rel($File::Find::name,$dir)} = do {
222 local (@ARGV, $/) = ($File::Find::name); <>
227 my $start = stripspace <<' END_START';
228 # This chunk of stuff was generated by App::FatPacker. To find the original
229 # file's code, look for the end of this BEGIN block or the string 'FATPACK'
233 my $end = stripspace <<' END_END';
234 s/^ //mg for values %fatpacked;
237 if (my $fat = $fatpacked{$_[1]}) {
240 return 0 unless length $fat;
241 $fat =~ s/^([^\n]*\n?)//;
246 open my $fh, '<', \$fat
247 or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
253 } # END OF FATPACK CODE
256 (my $stub = $_) =~ s/\.pm$//;
257 my $name = uc join '_', split '/', $stub;
258 my $data = $files{$_}; $data =~ s/^/ /mg; $data =~ s/(?<!\n)\z/\n/;
259 '$fatpacked{'.perlstring($_).qq!} = <<'${name}';\n!
260 .qq!${data}${name}\n!;
262 return join "\n", $start, @segments, $end;
269 App::FatPacker - pack your dependencies onto your script file
273 $ fatpack trace myscript.pl
274 $ fatpack packlists-for `cat fatpacker.trace` >packlists
275 $ fatpack tree `cat packlists`
276 $ (head -n1 myscript.pl |grep '^#!'; fatpack file; cat myscript.pl) >myscript.packed.pl
278 The C<head -n1 myscript.pl |grep '^#!'> code pulls out the Unix shebang
279 line, if there is one, and injects it at the start of the packed script.
281 See the documentation for the L<fatpack> script itself for more information.
283 The programmatic API for this code is not yet fully decided, hence the 0.9
284 release version. Expect that to be cleaned up for 1.0.
288 L<article for Perl Advent 2012|http://www.perladvent.org/2012/2012-12-14.html>
292 Your current best avenue is to come annoy annoy mst on #toolchain on
293 irc.perl.org. There should be a non-IRC means of support by 1.0.
297 Matt S. Trout (mst) <mst@shadowcat.co.uk>
301 miyagawa - Tatsuhiko Miyagawa (cpan:MIYAGAWA) <miyagawa@bulknews.net>
303 tokuhirom - MATSUNO★Tokuhiro (cpan:TOKUHIROM) <tokuhirom@gmail.com>
305 dg - David Leadbeater (cpan:DGL) <dgl@dgl.cx>
307 gugod - 劉康民 (cpan:GUGOD) <gugod@cpan.org>
309 t0m - Tomas Doran (cpan:BOBTFISH) <bobtfish@bobtfish.net>
311 sawyer - Sawyer X (cpan:XSAWYERX) <xsawyerx@cpan.org>
313 ether - Karen Etheridge (cpan:ETHER) <ether@cpan.org>
315 Mithaldu - Christian Walde (cpan:MITHALDU) <walde.christian@googlemail.com>
317 Many more people are probably owed thanks for ideas. Yet
318 another doc nit to fix.
322 Copyright (c) 2010 the App::FatPacker L</AUTHOR> and L</CONTRIBUTORS>
327 This library is free software and may be distributed under the same terms