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
12 use File::Copy qw(copy);
13 use File::Path qw(make_path remove_tree);
16 our $VERSION = '0.009003'; # 0.9.3
18 $VERSION = eval $VERSION;
20 my $option_parser = Getopt::Long::Parser->new(
21 config => [ qw(require_order pass_through bundling no_auto_abbrev) ]
25 local *ARGV = [ @{$_[0]} ];
26 $option_parser->getoptions(@{$_[1]});
31 map +(chomp,$_)[1], do { local @ARGV = ($_[0]); <> };
36 $text =~ /^(\s+)/ && $text =~ s/^$1//mg;
41 $_[1] eq '-run_script'
42 and return shift->new->run_script;
45 sub new { bless({}, $_[0]) }
48 my ($self, $args) = @_;
49 my @args = $args ? @$args : @ARGV;
50 (my $cmd = shift @args || 'help') =~ s/-/_/g;
51 if (my $meth = $self->can("script_command_${cmd}")) {
54 die "No such command ${cmd}";
58 sub script_command_help {
59 print "Try `perldoc fatpack` for how to use me\n";
62 sub script_command_trace {
63 my ($self, $args) = @_;
65 $args = call_parser $args => [
67 'to-stderr' => \my $to_stderr,
70 die "Can't use to and to-stderr on same call" if $file && $to_stderr;
72 (my $use_file = $file) ||= 'fatpacker.trace';
73 if (!$to_stderr and -e $use_file) {
74 unlink $use_file or die "Couldn't remove old trace file: $!";
79 } elsif ($to_stderr) {
86 local $ENV{PERL5OPT} = '-MApp::FatPacker::Trace'.$arg;
91 sub script_command_packlists_for {
92 my ($self, $args) = @_;
93 foreach my $pl ($self->packlists_containing($args)) {
98 sub packlists_containing {
99 my ($self, $targets) = @_;
100 my @targets = @$targets;
101 require $_ for @targets;
102 my @search = grep -d $_, map catdir($_, 'auto'), @INC;
106 return unless $_ eq '.packlist' && -f $_;
107 $pack_rev{$_} = $File::Find::name for lines_of $File::Find::name;
109 chdir($cwd) or die "Couldn't chdir back to ${cwd} after find: $!";
110 my %found; @found{map +($pack_rev{$INC{$_}}||()), @targets} = ();
114 sub script_command_tree {
115 my ($self, $args) = @_;
116 my $base = catdir(cwd,'fatlib');
117 $self->packlists_to_tree($base, $args);
120 sub packlists_to_tree {
121 my ($self, $where, $packlists) = @_;
124 foreach my $pl (@$packlists) {
125 my ($vol, $dirs, $file) = splitpath $pl;
126 my @dir_parts = splitdir $dirs;
128 PART: foreach my $p (0 .. $#dir_parts) {
129 if ($dir_parts[$p] eq 'auto') {
130 # $p-2 since it's <wanted path>/$Config{archname}/auto
131 $pack_base = catpath $vol, catdir @dir_parts[0..$p-2];
135 die "Couldn't figure out base path of packlist ${pl}" unless $pack_base;
136 foreach my $source (lines_of $pl) {
137 # there is presumably a better way to do "is this under this base?"
138 # but if so, it's not obvious to me in File::Spec
139 next unless substr($source,0,length $pack_base) eq $pack_base;
140 my $target = rel2abs( abs2rel($source, $pack_base), $where );
141 my $target_dir = catpath((splitpath $target)[0,1]);
142 make_path $target_dir;
143 copy $source => $target;
148 sub script_command_file {
149 my ($self, $args) = @_;
151 $args = call_parser $args => [
152 'data-pack' => \my $data_pack,
153 'main=s' => \my $main_file,
156 my $file = shift @$args;
158 my @dirs = map rel2abs($_, $cwd), ('lib','fatlib');
160 foreach my $dir (@dirs) {
163 !/\.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;
164 $files{abs2rel($File::Find::name,$dir)} = do {
165 local (@ARGV, $/) = ($File::Find::name); <>
171 generate_file_data_style(\%files, $main_file);
173 generate_file_hash_style(\%files);
177 sub generate_file_hash_style {
180 my $start = stripspace <<' END_START';
181 # This chunk of stuff was generated by App::FatPacker. To find the original
182 # file's code, look for the end of this BEGIN block or the string 'FATPACK'
186 my $end = stripspace <<' END_END';
187 s/^ //mg for values %fatpacked;
190 if (my $fat = $fatpacked{$_[1]}) {
191 open my $fh, '<', \$fat
192 or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
197 } # END OF FATPACK CODE
200 (my $stub = $_) =~ s/\.pm$//;
201 my $name = uc join '_', split '/', $stub;
202 my $data = $files->{$_}; $data =~ s/^/ /mg; $data =~ s/(?<!\n)\z/\n/;
203 '$fatpacked{'.perlstring($_).qq!} = <<'${name}';\n!
204 .qq!${data}${name}\n!;
206 print join "\n", $start, @segments, $end;
209 sub generate_file_data_style {
210 my($files, $main) = @_;
213 open my $main_fh, '<', $main or die "Can't open '$main': $!";
214 $files->{"fatpacked-main"} = join "", <$main_fh>;
217 my $start = stripspace <<' END_START';
218 # This chunk of stuff was generated by App::FatPacker. Do not edit.
224 (my $stub = $_) =~ s/\.pm$//;
225 my $data = $files->{$_};
226 $data =~ s/(?<!\n)\z/\n/;
227 [$_, length $data, \$data];
232 for my $segment (@segments) {
233 $fatpack_data .= " ".perlstring($segment->[0])." => [$start_idx, $segment->[1]],\n";
234 $start_idx += $segment->[1];
237 my $end = stripspace <<' END_END';
240 my $data_pos = tell DATA;
242 if(my $fat = $fatpacked{$_[1]}) {
243 seek DATA, $data_pos + $fat->[0], 0;
244 local $/ = \$fat->[1];
245 open my $fh, '<', \scalar <DATA>;
250 # END OF FATPACK CODE
252 do 'fatpacked-main' or die $@;
255 print join "\n", $start, $fatpack_data, $end;
256 print join "\n", "__DATA__", join "", map ${$_->[2]}, @segments;
261 App::FatPacker - pack your dependencies onto your script file
265 $ fatpack trace myscript.pl
266 $ fatpack packlists-for `cat fatpacker.trace` >packlists
267 $ fatpack tree `cat packlists`
268 $ (fatpack file; cat myscript.pl) >myscript.packed.pl
270 See the documentation for the L<fatpack> script itself for more information.
272 The programmatic API for this code is not yet fully decided, hence the 0.9.1
273 release version. Expect that to be cleaned up for 1.0.
277 Your current best avenue is to come annoy annoy mst on #toolchain on
278 irc.perl.org. There should be a non-IRC means of support by 1.0.
282 Matt S. Trout (mst) <mst@shadowcat.co.uk>
286 None as yet, though I probably owe lots of people thanks for ideas. Yet
287 another doc nit to fix.
291 Copyright (c) 2010 the App::FatPacker L</AUTHOR> and L</CONTRIBUTORS>
296 This library is free software and may be distributed under the same terms