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.009001'; # 0.9.1
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) =~ s/-/_/g;
51 if (my $meth = $self->can("script_command_${cmd}")) {
54 die "No such command ${cmd}";
58 sub script_command_trace {
59 my ($self, $args) = @_;
61 $args = call_parser $args => [
63 'to-stderr' => \my $to_stderr,
66 die "Can't use to and to-stderr on same call" if $file && $to_stderr;
68 (my $use_file = $file) ||= 'fatpacker.trace';
69 if (!$to_stderr and -e $use_file) {
70 unlink $use_file or die "Couldn't remove old trace file: $!";
75 } elsif ($to_stderr) {
82 local $ENV{PERL5OPT} = '-MApp::FatPacker::Trace'.$arg;
87 sub script_command_packlists_for {
88 my ($self, $args) = @_;
89 foreach my $pl ($self->packlists_containing($args)) {
94 sub packlists_containing {
95 my ($self, $targets) = @_;
96 my @targets = @$targets;
97 require $_ for @targets;
98 my @search = grep -d $_, map catdir($_, 'auto'), @INC;
102 return unless $_ eq '.packlist' && -f $_;
103 $pack_rev{$_} = $File::Find::name for lines_of $File::Find::name;
105 chdir($cwd) or die "Couldn't chdir back to ${cwd} after find: $!";
106 my %found; @found{map +($pack_rev{$INC{$_}}||()), @targets} = ();
110 sub script_command_tree {
111 my ($self, $args) = @_;
112 my $base = catdir(cwd,'fatlib');
113 $self->packlists_to_tree($base, $args);
116 sub packlists_to_tree {
117 my ($self, $where, $packlists) = @_;
120 foreach my $pl (@$packlists) {
121 my ($vol, $dirs, $file) = splitpath $pl;
122 my @dir_parts = splitdir $dirs;
124 PART: foreach my $p (0 .. $#dir_parts) {
125 if ($dir_parts[$p] eq 'auto') {
126 # $p-2 since it's <wanted path>/$Config{archname}/auto
127 $pack_base = catpath $vol, catdir @dir_parts[0..$p-2];
131 die "Couldn't figure out base path of packlist ${pl}" unless $pack_base;
132 foreach my $source (lines_of $pl) {
133 # there is presumably a better way to do "is this under this base?"
134 # but if so, it's not obvious to me in File::Spec
135 next unless substr($source,0,length $pack_base) eq $pack_base;
136 my $target = rel2abs( abs2rel($source, $pack_base), $where );
137 my $target_dir = catpath((splitpath $target)[0,1]);
138 make_path $target_dir;
139 copy $source => $target;
144 sub script_command_file {
145 my ($self, $args) = @_;
146 my $file = shift @$args;
148 my @dirs = map rel2abs($_, $cwd), ('lib','fatlib');
150 foreach my $dir (@dirs) {
153 !/\.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;
154 $files{abs2rel($File::Find::name,$dir)} = do {
155 local (@ARGV, $/) = ($File::Find::name); <>
159 my $start = stripspace <<' END_START';
160 # This chunk of stuff was generated by App::FatPacker. To find the original
161 # file's code, look for the end of this BEGIN block or the string 'FATPACK'
165 my $end = stripspace <<' END_END';
166 s/^ //mg for values %fatpacked;
169 if (my $fat = $fatpacked{$_[1]}) {
170 open my $fh, '<', \$fat;
176 } # END OF FATPACK CODE
179 (my $stub = $_) =~ s/\.pm$//;
180 my $name = uc join '_', split '/', $stub;
181 my $data = $files{$_}; $data =~ s/^/ /mg;
182 '$fatpacked{'.perlstring($_).qq!} = <<'${name}';\n!
183 .qq!${data}${name}\n!;
185 print join "\n", $start, @segments, $end;
190 App::FatPacker - pack your dependencies onto your script file
194 $ fatpack trace myscript.pl
195 $ fatpack packlists-for `cat factpacker.trace` >packlists
196 $ fatpack tree fatlib `cat packlists`
197 $ (fatpack file; cat myscript.pl) >myscript.packed.pl
199 See the documentation for the L<fatpack> script itself for more information.
201 The programmatic API for this code is not yet fully decided, hence the 0.9.1
202 release version. Expect that to be cleaned up for 1.0.
206 Your current best avenue is to come annoy annoy mst on #toolchain on
207 irc.perl.org. There should be a non-IRC means of support by 1.0.
211 Matt S. Trout (mst) <mst@shadowcat.co.uk>
215 None as yet, though I probably owe lots of people thanks for ideas. Yet
216 another doc nit to fix.
220 Copyright (c) 2010 the App::FatPacker L</AUTHOR> and L</CONTRIBUTORS>
225 This library is free software and may be distributed under the same terms