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.009013'; # 0.9.013
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_trace {
71 my ($self, $args) = @_;
73 $args = $self->call_parser($args => [
75 'to-stderr' => \my $to_stderr,
76 'use=s' => \my @additional_use
79 die "Can't use to and to-stderr on same call" if $file && $to_stderr;
81 $file ||= 'fatpacker.trace';
83 if (!$to_stderr and -e $file) {
84 unlink $file or die "Couldn't remove old trace file: $!";
95 use => \@additional_use,
102 my ($self, %opts) = @_;
106 my $output = $opts{output} || do {
107 $capture++; '>&STDOUT'
110 my $trace_opts = join ',', $output||'>&STDOUT', @{$opts{use}||[]};
112 local $ENV{PERL5OPT} = '-MApp::FatPacker::Trace='.$trace_opts;
114 my @args = @{$opts{args}||[]};
117 # user specified output target, JFDI
121 # no output target specified, slurp
122 open my $out_fh, '-|', $^X, @args;
123 return do { local $/; <$out_fh> };
127 sub script_command_packlists_for {
128 my ($self, $args) = @_;
129 foreach my $pl ($self->packlists_containing($args)) {
134 sub packlists_containing {
135 my ($self, $targets) = @_;
136 my @targets = @$targets;
137 foreach my $t (@targets) {
140 my @search = grep -d $_, map catdir($_, 'auto'), @INC;
144 return unless $_ eq '.packlist' && -f $_;
145 $pack_rev{$_} = $File::Find::name for lines_of $File::Find::name;
147 chdir($cwd) or die "Couldn't chdir back to ${cwd} after find: $!";
148 my %found; @found{map +($pack_rev{$INC{$_}}||()), @targets} = ();
152 sub script_command_tree {
153 my ($self, $args) = @_;
154 my $base = catdir(cwd,'fatlib');
155 $self->packlists_to_tree($base, $args);
158 sub packlists_to_tree {
159 my ($self, $where, $packlists) = @_;
162 foreach my $pl (@$packlists) {
163 my ($vol, $dirs, $file) = splitpath $pl;
164 my @dir_parts = splitdir $dirs;
166 PART: foreach my $p (0 .. $#dir_parts) {
167 if ($dir_parts[$p] eq 'auto') {
168 # $p-2 since it's <wanted path>/$Config{archname}/auto
169 $pack_base = catpath $vol, catdir @dir_parts[0..$p-2];
173 die "Couldn't figure out base path of packlist ${pl}" unless $pack_base;
174 foreach my $source (lines_of $pl) {
175 # there is presumably a better way to do "is this under this base?"
176 # but if so, it's not obvious to me in File::Spec
177 next unless substr($source,0,length $pack_base) eq $pack_base;
178 my $target = rel2abs( abs2rel($source, $pack_base), $where );
179 my $target_dir = catpath((splitpath $target)[0,1]);
181 copy $source => $target;
186 sub script_command_file {
187 my ($self, $args) = @_;
188 my $file = shift @$args;
190 my @dirs = grep -d, map rel2abs($_, $cwd), ('lib','fatlib');
192 foreach my $dir (@dirs) {
195 !/\.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;
196 $files{File::Spec::Unix->abs2rel($File::Find::name,$dir)} = do {
197 local (@ARGV, $/) = ($File::Find::name); <>
202 my $start = stripspace <<' END_START';
203 # This chunk of stuff was generated by App::FatPacker. To find the original
204 # file's code, look for the end of this BEGIN block or the string 'FATPACK'
208 my $end = stripspace <<' END_END';
209 s/^ //mg for values %fatpacked;
212 if (my $fat = $fatpacked{$_[1]}) {
215 return 0 unless length $fat;
216 $fat =~ s/^([^\n]*\n?)//;
221 open my $fh, '<', \$fat
222 or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
228 } # END OF FATPACK CODE
231 (my $stub = $_) =~ s/\.pm$//;
232 my $name = uc join '_', split '/', $stub;
233 my $data = $files{$_}; $data =~ s/^/ /mg; $data =~ s/(?<!\n)\z/\n/;
234 '$fatpacked{'.perlstring($_).qq!} = <<'${name}';\n!
235 .qq!${data}${name}\n!;
237 print join "\n", $start, @segments, $end;
244 App::FatPacker - pack your dependencies onto your script file
248 $ fatpack trace myscript.pl
249 $ fatpack packlists-for `cat fatpacker.trace` >packlists
250 $ fatpack tree `cat packlists`
251 $ (head -n1 myscript.pl |grep '^#!'; fatpack file; cat myscript.pl) >myscript.packed.pl
253 The C<head -n1 myscript.pl |grep '^#!'> code pulls out the Unix shebang
254 line, if there is one, and injects it at the start of the packed script.
256 See the documentation for the L<fatpack> script itself for more information.
258 The programmatic API for this code is not yet fully decided, hence the 0.9
259 release version. Expect that to be cleaned up for 1.0.
263 L<article for Perl Advent 2012|http://www.perladvent.org/2012/2012-12-14.html>
267 Your current best avenue is to come annoy annoy mst on #toolchain on
268 irc.perl.org. There should be a non-IRC means of support by 1.0.
272 Matt S. Trout (mst) <mst@shadowcat.co.uk>
276 miyagawa - Tatsuhiko Miyagawa (cpan:MIYAGAWA) <miyagawa@bulknews.net>
278 tokuhirom - MATSUNO★Tokuhiro (cpan:TOKUHIROM) <tokuhirom@gmail.com>
280 dg - David Leadbeater (cpan:DGL) <dgl@dgl.cx>
282 gugod - 劉康民 (cpan:GUGOD) <gugod@cpan.org>
284 t0m - Tomas Doran (cpan:BOBTFISH) <bobtfish@bobtfish.net>
286 sawyer - Sawyer X (cpan:XSAWYERX) <xsawyerx@cpan.org>
288 ether - Karen Etheridge (cpan:ETHER) <ether@cpan.org>
290 Mithaldu - Christian Walde (cpan:MITHALDU) <walde.christian@googlemail.com>
292 Many more people are probably owed thanks for ideas. Yet
293 another doc nit to fix.
297 Copyright (c) 2010 the App::FatPacker L</AUTHOR> and L</CONTRIBUTORS>
302 This library is free software and may be distributed under the same terms