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;
97 local $ENV{PERL5OPT} = '-MApp::FatPacker::Trace'.$arg;
102 sub script_command_packlists_for {
103 my ($self, $args) = @_;
104 foreach my $pl ($self->packlists_containing($args)) {
109 sub packlists_containing {
110 my ($self, $targets) = @_;
111 my @targets = @$targets;
112 require $_ for @targets;
113 my @search = grep -d $_, map catdir($_, 'auto'), @INC;
117 return unless $_ eq '.packlist' && -f $_;
118 $pack_rev{$_} = $File::Find::name for lines_of $File::Find::name;
120 chdir($cwd) or die "Couldn't chdir back to ${cwd} after find: $!";
121 my %found; @found{map +($pack_rev{$INC{$_}}||()), @targets} = ();
125 sub script_command_tree {
126 my ($self, $args) = @_;
127 my $base = catdir(cwd,'fatlib');
128 $self->packlists_to_tree($base, $args);
131 sub packlists_to_tree {
132 my ($self, $where, $packlists) = @_;
135 foreach my $pl (@$packlists) {
136 my ($vol, $dirs, $file) = splitpath $pl;
137 my @dir_parts = splitdir $dirs;
139 PART: foreach my $p (0 .. $#dir_parts) {
140 if ($dir_parts[$p] eq 'auto') {
141 # $p-2 since it's <wanted path>/$Config{archname}/auto
142 $pack_base = catpath $vol, catdir @dir_parts[0..$p-2];
146 die "Couldn't figure out base path of packlist ${pl}" unless $pack_base;
147 foreach my $source (lines_of $pl) {
148 # there is presumably a better way to do "is this under this base?"
149 # but if so, it's not obvious to me in File::Spec
150 next unless substr($source,0,length $pack_base) eq $pack_base;
151 my $target = rel2abs( abs2rel($source, $pack_base), $where );
152 my $target_dir = catpath((splitpath $target)[0,1]);
154 copy $source => $target;
159 sub script_command_file {
160 my ($self, $args) = @_;
161 my $file = shift @$args;
163 my @dirs = map rel2abs($_, $cwd), ('lib','fatlib');
165 foreach my $dir (@dirs) {
168 !/\.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;
169 $files{abs2rel($File::Find::name,$dir)} = do {
170 local (@ARGV, $/) = ($File::Find::name); <>
174 my $start = stripspace <<' END_START';
175 # This chunk of stuff was generated by App::FatPacker. To find the original
176 # file's code, look for the end of this BEGIN block or the string 'FATPACK'
180 my $end = stripspace <<' END_END';
181 s/^ //mg for values %fatpacked;
184 if (my $fat = $fatpacked{$_[1]}) {
185 open my $fh, '<', \$fat
186 or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
192 } # END OF FATPACK CODE
195 (my $stub = $_) =~ s/\.pm$//;
196 my $name = uc join '_', split '/', $stub;
197 my $data = $files{$_}; $data =~ s/^/ /mg; $data =~ s/(?<!\n)\z/\n/;
198 '$fatpacked{'.perlstring($_).qq!} = <<'${name}';\n!
199 .qq!${data}${name}\n!;
201 print join "\n", $start, @segments, $end;
206 App::FatPacker - pack your dependencies onto your script file
210 $ fatpack trace myscript.pl
211 $ fatpack packlists-for `cat fatpacker.trace` >packlists
212 $ fatpack tree `cat packlists`
213 $ (fatpack file; cat myscript.pl) >myscript.packed.pl
215 See the documentation for the L<fatpack> script itself for more information.
217 The programmatic API for this code is not yet fully decided, hence the 0.9
218 release version. Expect that to be cleaned up for 1.0.
222 Your current best avenue is to come annoy annoy mst on #toolchain on
223 irc.perl.org. There should be a non-IRC means of support by 1.0.
227 Matt S. Trout (mst) <mst@shadowcat.co.uk>
231 None as yet, though I probably owe lots of people thanks for ideas. Yet
232 another doc nit to fix.
236 Copyright (c) 2010 the App::FatPacker L</AUTHOR> and L</CONTRIBUTORS>
241 This library is free software and may be distributed under the same terms