1 package App::FatPacker;
4 use warnings FATAL => 'all';
8 use File::Find qw(find);
9 use File::Spec::Functions qw(
10 catdir catfile splitpath splitdir catpath rel2abs abs2rel
13 use File::Copy qw(copy);
14 use File::Path qw(mkpath rmtree);
17 our $VERSION = '0.009018'; # 0.009.017
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} = '-MApp::FatPacker::Trace='.$trace_opts;
122 my @args = @{$opts{args}||[]};
125 # user specified output target, JFDI
129 # no output target specified, slurp
130 open my $out_fh, "$^X @args |";
131 return do { local $/; <$out_fh> };
135 sub script_command_packlists_for {
136 my ($self, $args) = @_;
137 foreach my $pl ($self->packlists_containing($args)) {
142 sub packlists_containing {
143 my ($self, $targets) = @_;
144 my @targets = @$targets;
145 foreach my $t (@targets) {
148 my @search = grep -d $_, map catdir($_, 'auto'), @INC;
153 return unless /[\\\/]\.packlist$/ && -f $_;
154 $pack_rev{$_} = $File::Find::name for lines_of $File::Find::name;
157 my %found; @found{map +($pack_rev{Cwd::abs_path($INC{$_})}||()), @targets} = ();
161 sub script_command_tree {
162 my ($self, $args) = @_;
163 my $base = catdir(cwd,'fatlib');
164 $self->packlists_to_tree($base, $args);
167 sub packlists_to_tree {
168 my ($self, $where, $packlists) = @_;
171 # Build a copy of @INC with dir separator added after each path
175 foreach my $pl (@$packlists) {
176 foreach my $source (lines_of $pl) {
178 foreach my $inc_base (@inc) {
179 # XXX Not case-proof (for case ignorant filesystems)
180 if (substr($source,0,length $inc_base) eq $inc_base) {
186 die "Couldn't figure out \@INC path of ${source}" if substr($source, -3) eq '.pm';
190 # there is presumably a better way to do "is this under this base?"
191 # but if so, it's not obvious to me in File::Spec
192 my $target = rel2abs( abs2rel($source, $base), $where );
193 my $target_dir = catpath((splitpath $target)[0,1]);
195 copy $source => $target;
200 sub script_command_file {
201 my ($self, $args) = @_;
202 my $file = shift @$args;
203 print $self->fatpack_file($file);
207 my ($self, $file) = @_;
209 my @dirs = grep -d, map rel2abs($_, $cwd), ('lib','fatlib');
211 foreach my $dir (@dirs) {
214 !/\.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;
215 $files{File::Spec::Unix->abs2rel($File::Find::name,$dir)} = do {
216 local (@ARGV, $/) = ($File::Find::name); <>
221 my $start = stripspace <<' END_START';
222 # This chunk of stuff was generated by App::FatPacker. To find the original
223 # file's code, look for the end of this BEGIN block or the string 'FATPACK'
227 my $end = stripspace <<' END_END';
228 s/^ //mg for values %fatpacked;
231 if (my $fat = $fatpacked{$_[1]}) {
234 return 0 unless length $fat;
235 $fat =~ s/^([^\n]*\n?)//;
240 open my $fh, '<', \$fat
241 or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
247 } # END OF FATPACK CODE
250 (my $stub = $_) =~ s/\.pm$//;
251 my $name = uc join '_', split '/', $stub;
252 my $data = $files{$_}; $data =~ s/^/ /mg; $data =~ s/(?<!\n)\z/\n/;
253 '$fatpacked{'.perlstring($_).qq!} = <<'${name}';\n!
254 .qq!${data}${name}\n!;
258 if ( defined $file and -r $file ) {
259 open my $fh, "<", $file or die("Can't read $file: $!");
261 $script = join "", <$fh>;
263 unless ( index($shebang, '#!') == 0 ) {
264 $script = $shebang . $script;
268 return join "\n", $shebang, $start, @segments, $end, $script;
275 App::FatPacker - pack your dependencies onto your script file
279 $ fatpack pack myscript.pl >myscript.packed.pl
281 Or, with more step-by-step control:
283 $ fatpack trace myscript.pl
284 $ fatpack packlists-for `cat fatpacker.trace` >packlists
285 $ fatpack tree `cat packlists`
286 $ fatpack file myscript.pl >myscript.packed.pl
288 See the documentation for the L<fatpack> script itself for more information.
290 The programmatic API for this code is not yet fully decided, hence the 0.9
291 release version. Expect that to be cleaned up for 1.0.
295 L<article for Perl Advent 2012|http://www.perladvent.org/2012/2012-12-14.html>
299 Your current best avenue is to come annoy annoy mst on #toolchain on
300 irc.perl.org. There should be a non-IRC means of support by 1.0.
304 Matt S. Trout (mst) <mst@shadowcat.co.uk>
308 miyagawa - Tatsuhiko Miyagawa (cpan:MIYAGAWA) <miyagawa@bulknews.net>
310 tokuhirom - MATSUNO★Tokuhiro (cpan:TOKUHIROM) <tokuhirom@gmail.com>
312 dg - David Leadbeater (cpan:DGL) <dgl@dgl.cx>
314 gugod - 劉康民 (cpan:GUGOD) <gugod@cpan.org>
316 t0m - Tomas Doran (cpan:BOBTFISH) <bobtfish@bobtfish.net>
318 sawyer - Sawyer X (cpan:XSAWYERX) <xsawyerx@cpan.org>
320 ether - Karen Etheridge (cpan:ETHER) <ether@cpan.org>
322 Mithaldu - Christian Walde (cpan:MITHALDU) <walde.christian@googlemail.com>
324 Many more people are probably owed thanks for ideas. Yet
325 another doc nit to fix.
329 Copyright (c) 2010 the App::FatPacker L</AUTHOR> and L</CONTRIBUTORS>
334 This library is free software and may be distributed under the same terms