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.009017'; # 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;
152 return unless $_ eq '.packlist' && -f $_;
153 $pack_rev{$_} = $File::Find::name for lines_of $File::Find::name;
155 chdir($cwd) or die "Couldn't chdir back to ${cwd} after find: $!";
156 my %found; @found{map +($pack_rev{$INC{$_}}||()), @targets} = ();
160 sub script_command_tree {
161 my ($self, $args) = @_;
162 my $base = catdir(cwd,'fatlib');
163 $self->packlists_to_tree($base, $args);
166 sub packlists_to_tree {
167 my ($self, $where, $packlists) = @_;
170 foreach my $pl (@$packlists) {
171 my ($vol, $dirs, $file) = splitpath $pl;
172 my @dir_parts = splitdir $dirs;
174 PART: foreach my $p (0 .. $#dir_parts) {
175 if ($dir_parts[$p] eq 'auto') {
176 # $p-2 since it's <wanted path>/$Config{archname}/auto
177 $pack_base = catpath $vol, catdir @dir_parts[0..$p-2];
181 die "Couldn't figure out base path of packlist ${pl}" unless $pack_base;
182 foreach my $source (lines_of $pl) {
183 # there is presumably a better way to do "is this under this base?"
184 # but if so, it's not obvious to me in File::Spec
185 next unless substr($source,0,length $pack_base) eq $pack_base;
186 my $target = rel2abs( abs2rel($source, $pack_base), $where );
187 my $target_dir = catpath((splitpath $target)[0,1]);
189 copy $source => $target;
194 sub script_command_file {
195 my ($self, $args) = @_;
196 my $file = shift @$args;
197 print $self->fatpack_file($file);
201 my ($self, $file) = @_;
203 my @dirs = grep -d, map rel2abs($_, $cwd), ('lib','fatlib');
205 foreach my $dir (@dirs) {
208 !/\.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;
209 $files{File::Spec::Unix->abs2rel($File::Find::name,$dir)} = do {
210 local (@ARGV, $/) = ($File::Find::name); <>
215 my $start = stripspace <<' END_START';
216 # This chunk of stuff was generated by App::FatPacker. To find the original
217 # file's code, look for the end of this BEGIN block or the string 'FATPACK'
221 my $end = stripspace <<' END_END';
222 s/^ //mg for values %fatpacked;
225 if (my $fat = $fatpacked{$_[1]}) {
228 return 0 unless length $fat;
229 $fat =~ s/^([^\n]*\n?)//;
234 open my $fh, '<', \$fat
235 or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
241 } # END OF FATPACK CODE
244 (my $stub = $_) =~ s/\.pm$//;
245 my $name = uc join '_', split '/', $stub;
246 my $data = $files{$_}; $data =~ s/^/ /mg; $data =~ s/(?<!\n)\z/\n/;
247 '$fatpacked{'.perlstring($_).qq!} = <<'${name}';\n!
248 .qq!${data}${name}\n!;
252 if ( defined $file and -r $file ) {
253 open my $fh, "<", $file or die("Can't read $file: $!");
255 $script = join "", <$fh>;
257 unless ( index($shebang, '#!') == 0 ) {
258 $script = $shebang . $script;
262 return join "\n", $shebang, $start, @segments, $end, $script;
269 App::FatPacker - pack your dependencies onto your script file
273 $ fatpack pack myscript.pl >myscript.packed.pl
275 Or, with more step-by-step control:
277 $ fatpack trace myscript.pl
278 $ fatpack packlists-for `cat fatpacker.trace` >packlists
279 $ fatpack tree `cat packlists`
280 $ fatpack file myscript.pl >myscript.packed.pl
282 See the documentation for the L<fatpack> script itself for more information.
284 The programmatic API for this code is not yet fully decided, hence the 0.9
285 release version. Expect that to be cleaned up for 1.0.
289 L<article for Perl Advent 2012|http://www.perladvent.org/2012/2012-12-14.html>
293 Your current best avenue is to come annoy annoy mst on #toolchain on
294 irc.perl.org. There should be a non-IRC means of support by 1.0.
298 Matt S. Trout (mst) <mst@shadowcat.co.uk>
302 miyagawa - Tatsuhiko Miyagawa (cpan:MIYAGAWA) <miyagawa@bulknews.net>
304 tokuhirom - MATSUNO★Tokuhiro (cpan:TOKUHIROM) <tokuhirom@gmail.com>
306 dg - David Leadbeater (cpan:DGL) <dgl@dgl.cx>
308 gugod - 劉康民 (cpan:GUGOD) <gugod@cpan.org>
310 t0m - Tomas Doran (cpan:BOBTFISH) <bobtfish@bobtfish.net>
312 sawyer - Sawyer X (cpan:XSAWYERX) <xsawyerx@cpan.org>
314 ether - Karen Etheridge (cpan:ETHER) <ether@cpan.org>
316 Mithaldu - Christian Walde (cpan:MITHALDU) <walde.christian@googlemail.com>
318 Many more people are probably owed thanks for ideas. Yet
319 another doc nit to fix.
323 Copyright (c) 2010 the App::FatPacker L</AUTHOR> and L</CONTRIBUTORS>
328 This library is free software and may be distributed under the same terms