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;
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';
81 if (!$to_stderr and -e $file) {
82 unlink $file or die "Couldn't remove old trace file: $!";
93 $arg .= "," . join ",", @additional_use;
96 $self->trace($arg, $args);
100 my ($self, $arg, $args) = @_;
103 local $ENV{PERL5OPT} = '-MApp::FatPacker::Trace'.$arg;
108 sub script_command_packlists_for {
109 my ($self, $args) = @_;
110 foreach my $pl ($self->packlists_containing($args)) {
115 sub packlists_containing {
116 my ($self, $targets) = @_;
117 my @targets = @$targets;
118 require $_ for @targets;
119 my @search = grep -d $_, map catdir($_, 'auto'), @INC;
123 return unless $_ eq '.packlist' && -f $_;
124 $pack_rev{$_} = $File::Find::name for lines_of $File::Find::name;
126 chdir($cwd) or die "Couldn't chdir back to ${cwd} after find: $!";
127 my %found; @found{map +($pack_rev{$INC{$_}}||()), @targets} = ();
131 sub script_command_tree {
132 my ($self, $args) = @_;
133 my $base = catdir(cwd,'fatlib');
134 $self->packlists_to_tree($base, $args);
137 sub packlists_to_tree {
138 my ($self, $where, $packlists) = @_;
141 foreach my $pl (@$packlists) {
142 my ($vol, $dirs, $file) = splitpath $pl;
143 my @dir_parts = splitdir $dirs;
145 PART: foreach my $p (0 .. $#dir_parts) {
146 if ($dir_parts[$p] eq 'auto') {
147 # $p-2 since it's <wanted path>/$Config{archname}/auto
148 $pack_base = catpath $vol, catdir @dir_parts[0..$p-2];
152 die "Couldn't figure out base path of packlist ${pl}" unless $pack_base;
153 foreach my $source (lines_of $pl) {
154 # there is presumably a better way to do "is this under this base?"
155 # but if so, it's not obvious to me in File::Spec
156 next unless substr($source,0,length $pack_base) eq $pack_base;
157 my $target = rel2abs( abs2rel($source, $pack_base), $where );
158 my $target_dir = catpath((splitpath $target)[0,1]);
160 copy $source => $target;
165 sub script_command_file {
166 my ($self, $args) = @_;
167 my $file = shift @$args;
169 my @dirs = map rel2abs($_, $cwd), ('lib','fatlib');
171 foreach my $dir (@dirs) {
174 !/\.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;
175 $files{abs2rel($File::Find::name,$dir)} = do {
176 local (@ARGV, $/) = ($File::Find::name); <>
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?)";
198 } # END OF FATPACK CODE
201 (my $stub = $_) =~ s/\.pm$//;
202 my $name = uc join '_', split '/', $stub;
203 my $data = $files{$_}; $data =~ s/^/ /mg; $data =~ s/(?<!\n)\z/\n/;
204 '$fatpacked{'.perlstring($_).qq!} = <<'${name}';\n!
205 .qq!${data}${name}\n!;
207 print join "\n", $start, @segments, $end;
212 App::FatPacker - pack your dependencies onto your script file
216 $ fatpack trace myscript.pl
217 $ fatpack packlists-for `cat fatpacker.trace` >packlists
218 $ fatpack tree `cat packlists`
219 $ (fatpack file; cat myscript.pl) >myscript.packed.pl
221 See the documentation for the L<fatpack> script itself for more information.
223 The programmatic API for this code is not yet fully decided, hence the 0.9
224 release version. Expect that to be cleaned up for 1.0.
228 Your current best avenue is to come annoy annoy mst on #toolchain on
229 irc.perl.org. There should be a non-IRC means of support by 1.0.
233 Matt S. Trout (mst) <mst@shadowcat.co.uk>
237 None as yet, though I probably owe lots of people thanks for ideas. Yet
238 another doc nit to fix.
242 Copyright (c) 2010 the App::FatPacker L</AUTHOR> and L</CONTRIBUTORS>
247 This library is free software and may be distributed under the same terms