X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FApp%2FFatPacker.pm;h=db65c001f455cf79177a9eff5087c1cc0bef60ce;hb=de0c2ef75de79bd3eaa8f29e9f583e7e86e42981;hp=8b623ac9e8a725a7e6b7c563fd9265381934a617;hpb=f147c6f08a0d3d16fb512f65bae989850a6afc90;p=p5sagit%2FApp-FatPacker.git diff --git a/lib/App/FatPacker.pm b/lib/App/FatPacker.pm index 8b623ac..db65c00 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}||[]}; @@ -141,9 +142,17 @@ sub script_command_packlists_for { sub packlists_containing { my ($self, $targets) = @_; - my @targets = @$targets; - foreach my $t (@targets) { - require $t; + my @targets; + { + local @INC = ('lib', @INC); + foreach my $t (@$targets) { + unless (eval { require $t; 1}) { + warn "Failed to load ${t}: $@\n" + ."Make sure you're not missing a packlist as a result\n"; + next; + } + push @targets, $t; + } } my @search = grep -d $_, map catdir($_, 'auto'), @INC; my %pack_rev; @@ -174,8 +183,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; } } @@ -274,15 +286,17 @@ sub fatpack_end { if ($] < 5.008) { *{"${class}::INC"} = sub { - if (my $fat = $_[0]{$_[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; + }); + } }; } @@ -334,7 +348,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 @@ -343,8 +357,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 @@ -372,6 +388,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.