X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FApp%2FFatPacker.pm;h=cfa2db80aec9d7b0d95fcc7247f3dfc5ce67b2c7;hb=9fecf34853eb73b3f1f37ebc0af4b9a541650ba7;hp=1aaba1c53019ed1d00b3afe0dc3f78872879b06a;hpb=ef3dc7725bcd41282269b299fda0c65c2ad034c3;p=p5sagit%2FApp-FatPacker.git diff --git a/lib/App/FatPacker.pm b/lib/App/FatPacker.pm index 1aaba1c..cfa2db8 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.010000'; # 0.10.0 +our $VERSION = '0.010005'; # 0.10.5 $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; } } @@ -274,15 +281,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; + }); + } }; } @@ -343,8 +352,10 @@ L
=head1 SUPPORT -Your current best avenue is to come 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