1 package App::FatPacker;
4 use warnings FATAL => 'all';
7 use File::Find qw(find);
8 use File::Spec::Functions qw(
9 catdir splitpath splitdir catpath rel2abs abs2rel
12 use File::Copy qw(copy);
13 use File::Path qw(mkpath rmtree);
16 our $VERSION = '0.009012'; # 0.9.012
18 $VERSION = eval $VERSION;
22 my ($args, $options) = @_;
24 local *ARGV = [ @{$args} ];
25 $self->{option_parser}->getoptions(@$options);
31 map +(chomp,$_)[1], do { local @ARGV = ($_[0]); <> };
36 $text =~ /^(\s+)/ && $text =~ s/^$1//mg;
41 $_[1] && $_[1] eq '-run_script'
42 and return shift->new->run_script;
47 option_parser => Getopt::Long::Parser->new(
48 config => [ qw(require_order pass_through bundling no_auto_abbrev) ]
54 my ($self, $args) = @_;
55 my @args = $args ? @$args : @ARGV;
56 (my $cmd = shift @args || 'help') =~ s/-/_/g;
58 if (my $meth = $self->can("script_command_${cmd}")) {
61 die "No such command ${cmd}";
65 sub script_command_help {
66 print "Try `perldoc fatpack` for how to use me\n";
69 sub script_command_trace {
70 my ($self, $args) = @_;
72 $args = $self->call_parser($args => [
74 'to-stderr' => \my $to_stderr,
75 'use=s' => \my @additional_use
78 die "Can't use to and to-stderr on same call" if $file && $to_stderr;
80 $file ||= 'fatpacker.trace';
82 if (!$to_stderr and -e $file) {
83 unlink $file or die "Couldn't remove old trace file: $!";
94 use => \@additional_use,
101 my ($self, %opts) = @_;
105 my $output = $opts{output} || do {
106 $capture++; '>&STDOUT'
109 my $trace_opts = join ',', $output||'>&STDOUT', @{$opts{use}||[]};
111 local $ENV{PERL5OPT} = '-MApp::FatPacker::Trace='.$trace_opts;
113 my @args = @{$opts{args}||[]};
116 # user specified output target, JFDI
120 # no output target specified, slurp
121 open my $out_fh, '-|', $^X, @args;
122 return do { local $/; <$out_fh> };
126 sub script_command_packlists_for {
127 my ($self, $args) = @_;
128 foreach my $pl ($self->packlists_containing($args)) {
133 sub packlists_containing {
134 my ($self, $targets) = @_;
135 my @targets = @$targets;
136 foreach my $t (@targets) {
139 my @search = grep -d $_, map catdir($_, 'auto'), @INC;
143 return unless $_ eq '.packlist' && -f $_;
144 $pack_rev{$_} = $File::Find::name for lines_of $File::Find::name;
146 chdir($cwd) or die "Couldn't chdir back to ${cwd} after find: $!";
147 my %found; @found{map +($pack_rev{$INC{$_}}||()), @targets} = ();
151 sub script_command_tree {
152 my ($self, $args) = @_;
153 my $base = catdir(cwd,'fatlib');
154 $self->packlists_to_tree($base, $args);
157 sub packlists_to_tree {
158 my ($self, $where, $packlists) = @_;
161 foreach my $pl (@$packlists) {
162 my ($vol, $dirs, $file) = splitpath $pl;
163 my @dir_parts = splitdir $dirs;
165 PART: foreach my $p (0 .. $#dir_parts) {
166 if ($dir_parts[$p] eq 'auto') {
167 # $p-2 since it's <wanted path>/$Config{archname}/auto
168 $pack_base = catpath $vol, catdir @dir_parts[0..$p-2];
172 die "Couldn't figure out base path of packlist ${pl}" unless $pack_base;
173 foreach my $source (lines_of $pl) {
174 # there is presumably a better way to do "is this under this base?"
175 # but if so, it's not obvious to me in File::Spec
176 next unless substr($source,0,length $pack_base) eq $pack_base;
177 my $target = rel2abs( abs2rel($source, $pack_base), $where );
178 my $target_dir = catpath((splitpath $target)[0,1]);
180 copy $source => $target;
185 sub script_command_file {
186 my ($self, $args) = @_;
187 my $file = shift @$args;
189 my @dirs = map rel2abs($_, $cwd), ('lib','fatlib');
191 foreach my $dir (@dirs) {
194 !/\.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;
195 $files{File::Spec::Unix->abs2rel($File::Find::name,$dir)} = do {
196 local (@ARGV, $/) = ($File::Find::name); <>
201 my $start = stripspace <<' END_START';
202 # This chunk of stuff was generated by App::FatPacker. To find the original
203 # file's code, look for the end of this BEGIN block or the string 'FATPACK'
207 my $end = stripspace <<' END_END';
208 s/^ //mg for values %fatpacked;
211 if (my $fat = $fatpacked{$_[1]}) {
214 return 0 unless length $fat;
215 $text =~ s/^([^\n]*\n?)//;
220 open my $fh, '<', \$fat
221 or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
227 } # END OF FATPACK CODE
230 (my $stub = $_) =~ s/\.pm$//;
231 my $name = uc join '_', split '/', $stub;
232 my $data = $files{$_}; $data =~ s/^/ /mg; $data =~ s/(?<!\n)\z/\n/;
233 '$fatpacked{'.perlstring($_).qq!} = <<'${name}';\n!
234 .qq!${data}${name}\n!;
236 print join "\n", $start, @segments, $end;
243 App::FatPacker - pack your dependencies onto your script file
247 $ fatpack trace myscript.pl
248 $ fatpack packlists-for `cat fatpacker.trace` >packlists
249 $ fatpack tree `cat packlists`
250 $ (fatpack file; cat myscript.pl) >myscript.packed.pl
252 See the documentation for the L<fatpack> script itself for more information.
254 The programmatic API for this code is not yet fully decided, hence the 0.9
255 release version. Expect that to be cleaned up for 1.0.
259 Your current best avenue is to come annoy annoy mst on #toolchain on
260 irc.perl.org. There should be a non-IRC means of support by 1.0.
264 Matt S. Trout (mst) <mst@shadowcat.co.uk>
268 miyagawa - Tatsuhiko Miyagawa (cpan:MIYAGAWA) <miyagawa@bulknews.net>
270 tokuhirom - MATSUNO★Tokuhiro (cpan:TOKUHIROM) <tokuhirom@gmail.com>
272 dg - David Leadbeater (cpan:DGL) <dgl@dgl.cx>
274 gugod - 劉康民 (cpan:GUGOD) <gugod@cpan.org>
276 t0m - Tomas Doran (cpan:BOBTFISH) <bobtfish@bobtfish.net>
278 sawyer - Sawyer X (cpan:XSAWYERX) <xsawyerx@cpan.org>
280 ether - Karen Etheridge (cpan:ETHER) <ether@cpan.org>
282 Mithaldu - Christian Walde (cpan:MITHALDU) <walde.christian@googlemail.com>
284 Many more people are probably owed thanks for ideas. Yet
285 another doc nit to fix.
289 Copyright (c) 2010 the App::FatPacker L</AUTHOR> and L</CONTRIBUTORS>
294 This library is free software and may be distributed under the same terms