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.010008'; # v0.10.8
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 $text =~ /^(\s+)/ && $text =~ s/^$1//mg;
42 $_[1] && $_[1] eq '-run_script'
43 and return shift->new->run_script;
48 option_parser => Getopt::Long::Parser->new(
49 config => [ qw(require_order pass_through bundling no_auto_abbrev) ]
55 my ($self, $args) = @_;
56 my @args = $args ? @$args : @ARGV;
57 (my $cmd = shift @args || 'help') =~ s/-/_/g;
59 if (my $meth = $self->can("script_command_${cmd}")) {
62 die "No such command ${cmd}";
66 sub script_command_help {
67 print "Try `perldoc fatpack` for how to use me\n";
70 sub script_command_pack {
71 my ($self, $args) = @_;
73 my @modules = split /\r?\n/, $self->trace(args => $args);
74 my @packlists = $self->packlists_containing(\@modules);
76 my $base = catdir(cwd, 'fatlib');
77 $self->packlists_to_tree($base, \@packlists);
79 my $file = shift @$args;
80 print $self->fatpack_file($file);
83 sub script_command_trace {
84 my ($self, $args) = @_;
86 $args = $self->call_parser($args => [
88 'to-stderr' => \my $to_stderr,
89 'use=s' => \my @additional_use
92 die "Can't use to and to-stderr on same call" if $file && $to_stderr;
94 $file ||= 'fatpacker.trace';
96 if (!$to_stderr and -e $file) {
97 unlink $file or die "Couldn't remove old trace file: $!";
108 use => \@additional_use,
115 my ($self, %opts) = @_;
117 my $output = $opts{output};
118 my $trace_opts = join ',', $output||'>&STDOUT', @{$opts{use}||[]};
120 local $ENV{PERL5OPT} = join ' ',
121 ($ENV{PERL5OPT}||()), '-MApp::FatPacker::Trace='.$trace_opts;
123 my @args = @{$opts{args}||[]};
126 # user specified output target, JFDI
130 # no output target specified, slurp
131 open my $out_fh, "$^X @args |";
132 return do { local $/; <$out_fh> };
136 sub script_command_packlists_for {
137 my ($self, $args) = @_;
138 foreach my $pl ($self->packlists_containing($args)) {
143 sub packlists_containing {
144 my ($self, $targets) = @_;
147 local @INC = ('lib', @INC);
148 foreach my $t (@$targets) {
149 unless (eval { require $t; 1}) {
150 warn "Failed to load ${t}: $@\n"
151 ."Make sure you're not missing a packlist as a result\n";
157 my @search = grep -d $_, map catdir($_, 'auto'), @INC;
162 return unless /[\\\/]\.packlist$/ && -f $_;
163 $pack_rev{$_} = $File::Find::name for lines_of $File::Find::name;
166 my %found; @found{map +($pack_rev{Cwd::abs_path($INC{$_})}||()), @targets} = ();
170 sub script_command_tree {
171 my ($self, $args) = @_;
172 my $base = catdir(cwd,'fatlib');
173 $self->packlists_to_tree($base, $args);
176 sub packlists_to_tree {
177 my ($self, $where, $packlists) = @_;
180 foreach my $pl (@$packlists) {
181 my ($vol, $dirs, $file) = splitpath $pl;
182 my @dir_parts = splitdir $dirs;
184 PART: foreach my $p (0 .. $#dir_parts) {
185 if ($dir_parts[$p] eq 'auto') {
186 # $p-2 normally since it's <wanted path>/$Config{archname}/auto but
187 # if the last bit is a number it's $Config{archname}/$version/auto
188 # so use $p-3 in that case
189 my $version_lib = 0+!!($dir_parts[$p-1] =~ /^[0-9.]+$/);
190 $pack_base = catpath $vol, catdir @dir_parts[0..$p-(2+$version_lib)];
194 die "Couldn't figure out base path of packlist ${pl}" unless $pack_base;
195 foreach my $source (lines_of $pl) {
196 # there is presumably a better way to do "is this under this base?"
197 # but if so, it's not obvious to me in File::Spec
198 next unless substr($source,0,length $pack_base) eq $pack_base;
199 my $target = rel2abs( abs2rel($source, $pack_base), $where );
200 my $target_dir = catpath((splitpath $target)[0,1]);
202 copy $source => $target;
207 sub script_command_file {
208 my ($self, $args) = @_;
209 my $file = shift @$args;
210 print $self->fatpack_file($file);
214 my ($self, $file) = @_;
218 if ( defined $file and -r $file ) {
219 ($shebang, $script) = $self->load_main_script($file);
222 my @dirs = $self->collect_dirs();
224 $self->collect_files($_, \%files) for @dirs;
226 return join "\n", $shebang, $self->fatpack_code(\%files), $script;
229 # This method can be overload in sub classes
230 # For example to skip POD
232 my ($self, $file) = @_;
234 local (@ARGV, $/) = ($file);
244 return grep -d, map rel2abs($_, $cwd), ('lib','fatlib');
248 my ($self, $dir, $files) = @_;
251 !/\.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;
252 $files->{File::Spec::Unix->abs2rel($File::Find::name,$dir)} =
253 $self->load_file($File::Find::name);
257 sub load_main_script {
258 my ($self, $file) = @_;
259 open my $fh, "<", $file or die("Can't read $file: $!");
261 my $script = join "", <$fh>;
263 unless ( index($shebang, '#!') == 0 ) {
264 $script = $shebang . $script;
267 return ($shebang, $script);
271 return stripspace <<' END_START';
272 # This chunk of stuff was generated by App::FatPacker. To find the original
273 # file's code, look for the end of this BEGIN block or the string 'FATPACK'
280 return stripspace <<' END_END';
281 s/^ //mg for values %fatpacked;
283 my $class = 'FatPacked::'.(0+\%fatpacked);
285 *{"${class}::files"} = sub { keys %{$_[0]} };
288 *{"${class}::INC"} = sub {
289 if (my $fat = $_[0]{$_[1]}) {
291 my $last = length $fat;
293 return 0 if $pos == $last;
294 my $next = (1 + index $fat, "\n", $pos) || $last;
295 $_ .= substr $fat, $pos, $next - $pos;
304 *{"${class}::INC"} = sub {
305 if (my $fat = $_[0]{$_[1]}) {
306 open my $fh, '<', \$fat
307 or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
314 unshift @INC, bless \%fatpacked, $class;
315 } # END OF FATPACK CODE
320 my ($self, $files) = @_;
322 (my $stub = $_) =~ s/\.pm$//;
323 my $name = uc join '_', split '/', $stub;
324 my $data = $files->{$_}; $data =~ s/^/ /mg; $data =~ s/(?<!\n)\z/\n/;
325 '$fatpacked{'.perlstring($_).qq!} = '#line '.(1+__LINE__).' "'.__FILE__."\\"\\n".<<'${name}';\n!
326 .qq!${data}${name}\n!;
329 return join "\n", $self->fatpack_start, @segments, $self->fatpack_end;
336 App::FatPacker - pack your dependencies onto your script file
340 $ fatpack pack myscript.pl >myscript.packed.pl
342 Or, with more step-by-step control:
344 $ fatpack trace myscript.pl
345 $ fatpack packlists-for `cat fatpacker.trace` >packlists
346 $ fatpack tree `cat packlists`
347 $ fatpack file myscript.pl >myscript.packed.pl
349 Each command is designed to be simple and self-contained so that you can modify
350 the input/output of each step as needed. See the documentation for the
351 L<fatpack> script itself for more information.
353 The programmatic API for this code is not yet fully decided, hence the 0.x
354 release version. Expect that to be cleaned up for 1.0.
358 As dependency module code is copied into the resulting file as text, only
359 pure-perl dependencies can be packed, not compiled XS code.
361 The currently-installed dependencies to pack are found via F<.packlist> files,
362 which are generally only included in non-core distributions that were installed
363 by a CPAN installer. This is a feature; see L<fatpack/packlists-for> for
364 details. (a notable exception to this is FreeBSD, which, since its packaging
365 system is designed to work equivalently to a source install, does preserve
370 L<article for Perl Advent 2012|http://www.perladvent.org/2012/2012-12-14.html>
372 L<pp> - PAR Packager, a much more complex architecture-dependent packer that
373 can pack compiled code and even a Perl interpreter
377 Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=App-FatPacker>
378 (or L<bug-App-FatPacker@rt.cpan.org|mailto:bug-App-FatPacker@rt.cpan.org>).
380 You can normally also obtain assistance on irc, in #toolchain on irc.perl.org.
384 Matt S. Trout (mst) <mst@shadowcat.co.uk>
388 miyagawa - Tatsuhiko Miyagawa (cpan:MIYAGAWA) <miyagawa@bulknews.net>
390 tokuhirom - MATSUNO★Tokuhiro (cpan:TOKUHIROM) <tokuhirom@gmail.com>
392 dg - David Leadbeater (cpan:DGL) <dgl@dgl.cx>
394 gugod - 劉康民 (cpan:GUGOD) <gugod@cpan.org>
396 t0m - Tomas Doran (cpan:BOBTFISH) <bobtfish@bobtfish.net>
398 sawyer - Sawyer X (cpan:XSAWYERX) <xsawyerx@cpan.org>
400 ether - Karen Etheridge (cpan:ETHER) <ether@cpan.org>
402 Mithaldu - Christian Walde (cpan:MITHALDU) <walde.christian@googlemail.com>
404 dolmen - Olivier Mengué (cpan:DOLMEN) <dolmen@cpan.org>
406 djerius - Diab Jerius (cpan:DJERIUS) <djerius@cpan.org>
408 haarg - Graham Knop (cpan:HAARG) <haarg@haarg.org>
410 grinnz - Dan Book (cpan:DBOOK) <dbook@cpan.org>
412 Many more people are probably owed thanks for ideas. Yet
413 another doc nit to fix.
417 Copyright (c) 2010 the App::FatPacker L</AUTHOR> and L</CONTRIBUTORS>
422 This library is free software and may be distributed under the same terms