X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FApp%2FFatPacker.pm;h=b90a57e89f814bb0629b0c0f932cca0b4ec1a4c5;hb=ae85237869ad1f8be65b58c8b90cd8338c8cf33b;hp=b5baa36590a87b28246e5e468f4d84392de9405d;hpb=ab7608eef71b34a00dabc43403352bad63a35726;p=p5sagit%2FApp-FatPacker.git diff --git a/lib/App/FatPacker.pm b/lib/App/FatPacker.pm index b5baa36..b90a57e 100644 --- a/lib/App/FatPacker.pm +++ b/lib/App/FatPacker.pm @@ -14,7 +14,7 @@ use File::Copy qw(copy); use File::Path qw(mkpath rmtree); use B qw(perlstring); -our $VERSION = '0.009018'; # 0.009.017 +our $VERSION = '0.010_006'; # 0.10.6 $VERSION = eval $VERSION; @@ -117,7 +117,8 @@ sub trace { my $output = $opts{output}; my $trace_opts = join ',', $output||'>&STDOUT', @{$opts{use}||[]}; - local $ENV{PERL5OPT} = '-MApp::FatPacker::Trace='.$trace_opts; + local $ENV{PERL5OPT} = join ' ', + ($ENV{PERL5OPT}||()), '-MApp::FatPacker::Trace='.$trace_opts; my @args = @{$opts{args}||[]}; @@ -142,8 +143,11 @@ sub script_command_packlists_for { sub packlists_containing { my ($self, $targets) = @_; my @targets = @$targets; - foreach my $t (@targets) { - require $t; + { + local @INC = ('lib', @INC); + foreach my $t (@targets) { + require $t; + } } my @search = grep -d $_, map catdir($_, 'auto'), @INC; my %pack_rev; @@ -174,8 +178,11 @@ sub packlists_to_tree { my $pack_base; PART: foreach my $p (0 .. $#dir_parts) { if ($dir_parts[$p] eq 'auto') { - # $p-2 since it's /$Config{archname}/auto - $pack_base = catpath $vol, catdir @dir_parts[0..$p-2]; + # $p-2 normally since it's /$Config{archname}/auto but + # if the last bit is a number it's $Config{archname}/$version/auto + # so use $p-3 in that case + my $version_lib = 0+!!($dir_parts[$p-1] =~ /^[0-9.]+$/); + $pack_base = catpath $vol, catdir @dir_parts[0..$p-(2+$version_lib)]; last PART; } } @@ -268,35 +275,35 @@ sub fatpack_end { return stripspace <<' END_END'; s/^ //mg for values %fatpacked; - my $class = "${\\%fatpacked}"; + my $class = 'FatPacked::'.(0+\%fatpacked); + no strict 'refs'; *{"${class}::files"} = sub { keys %{$_[0]} }; if ($] < 5.008) { - *{"${class}::INC"} = sub { - if (my $fat = $fatpacked{$_[1]}) { - return sub { - return 0 unless length $fat; - $fat =~ s/^([^\n]*\n?)//; - $_ = $1; - return 1; - }; - } - return; - } + if (my $fat = $_[0]{$_[1]}) { + my $pos = 0; + my $last = length $fat; + return (sub { + return 0 if $pos == $last; + my $next = (1 + index $fat, "\n", $pos) || $last; + $_ .= substr $fat, $pos, $next - $pos; + $pos = $next; + return 1; + }); + } + }; } else { - *{"${class}::INC"} = sub { - if (my $fat = $_[0]{$_[1]}) { + if (my $fat = $_[0]{$_[1]}) { open my $fh, '<', \$fat or die "FatPacker error loading $_[1] (could be a perl installation issue?)"; return $fh; } return; }; - } unshift @INC, bless \%fatpacked, $class; @@ -336,7 +343,7 @@ Or, with more step-by-step control: See the documentation for the L script itself for more information. -The programmatic API for this code is not yet fully decided, hence the 0.9 +The programmatic API for this code is not yet fully decided, hence the 0.x release version. Expect that to be cleaned up for 1.0. =head1 SEE ALSO @@ -345,8 +352,10 @@ L
=head1 SUPPORT -Your current best avenue is to come annoy annoy mst on #toolchain on -irc.perl.org. There should be a non-IRC means of support by 1.0. +Bugs may be submitted through L +(or L). + +You can normally also obtain assistance on irc, in #toolchain on irc.perl.org. =head1 AUTHOR @@ -374,6 +383,8 @@ dolmen - Olivier Mengué (cpan:DOLMEN) djerius - Diab Jerius (cpan:DJERIUS) +haarg - Graham Knop (cpan:HAARG> + Many more people are probably owed thanks for ideas. Yet another doc nit to fix.