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(mkpath rmtree);
16 our $VERSION = '0.009006'; # 0.9.6
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]);
143 copy $source => $target;
148 sub script_command_file {
149 my ($self, $args) = @_;
150 my $file = shift @$args;
152 my @dirs = map rel2abs($_, $cwd), ('lib','fatlib');
154 foreach my $dir (@dirs) {
157 !/\.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;
158 $files{abs2rel($File::Find::name,$dir)} = do {
159 local (@ARGV, $/) = ($File::Find::name); <>
163 my $start = stripspace <<' END_START';
164 # This chunk of stuff was generated by App::FatPacker. To find the original
165 # file's code, look for the end of this BEGIN block or the string 'FATPACK'
169 my $end = stripspace <<' END_END';
170 s/^ //mg for values %fatpacked;
173 if (my $fat = $fatpacked{$_[1]}) {
174 open my $fh, '<', \$fat
175 or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
181 } # END OF FATPACK CODE
184 (my $stub = $_) =~ s/\.pm$//;
185 my $name = uc join '_', split '/', $stub;
186 my $data = $files{$_}; $data =~ s/^/ /mg; $data =~ s/(?<!\n)\z/\n/;
187 '$fatpacked{'.perlstring($_).qq!} = <<'${name}';\n!
188 .qq!${data}${name}\n!;
190 print join "\n", $start, @segments, $end;
195 App::FatPacker - pack your dependencies onto your script file
199 $ fatpack trace myscript.pl
200 $ fatpack packlists-for `cat fatpacker.trace` >packlists
201 $ fatpack tree `cat packlists`
202 $ (fatpack file; cat myscript.pl) >myscript.packed.pl
204 See the documentation for the L<fatpack> script itself for more information.
206 The programmatic API for this code is not yet fully decided, hence the 0.9.1
207 release version. Expect that to be cleaned up for 1.0.
211 Your current best avenue is to come annoy annoy mst on #toolchain on
212 irc.perl.org. There should be a non-IRC means of support by 1.0.
216 Matt S. Trout (mst) <mst@shadowcat.co.uk>
220 None as yet, though I probably owe lots of people thanks for ideas. Yet
221 another doc nit to fix.
225 Copyright (c) 2010 the App::FatPacker L</AUTHOR> and L</CONTRIBUTORS>
230 This library is free software and may be distributed under the same terms