package ExtUtils::Packlist;
-use 5.006;
+use 5.00503;
use strict;
use Carp qw();
-our $VERSION = '0.04';
+use Config;
+use vars qw($VERSION $Relocations);
+$VERSION = '1.41';
+$VERSION = eval $VERSION;
# Used for generating filehandle globs. IO::File might not be available!
my $fhname = "FH1";
+=begin _undocumented
+
+=item mkfh()
+
+Make a filehandle. Same kind of idea as Symbol::gensym().
+
+=cut
+
sub mkfh()
{
no strict;
return($fh);
}
+=item __find_relocations
+
+Works out what absolute paths in the configuration have been located at run
+time relative to $^X, and generates a regexp that matches them
+
+=end _undocumented
+
+=cut
+
+sub __find_relocations
+{
+ my %paths;
+ while (my ($raw_key, $raw_val) = each %Config) {
+ my $exp_key = $raw_key . "exp";
+ next unless exists $Config{$exp_key};
+ next unless $raw_val =~ m!\.\.\./!;
+ $paths{$Config{$exp_key}}++;
+ }
+ # Longest prefixes go first in the alternatives
+ my $alternations = join "|", map {quotemeta $_}
+ sort {length $b <=> length $a} keys %paths;
+ qr/^($alternations)/o;
+}
+
sub new($$)
{
my ($class, $packfile) = @_;
while (defined($line = <$fh>))
{
chomp $line;
- my ($key, @kvs) = $line;
+ my ($key, $data) = $line;
if ($key =~ /^(.*?)( \w+=.*)$/)
{
$key = $1;
- @kvs = split(' ', $2);
+ $data = { map { split('=', $_) } split(' ', $2)};
+
+ if ($Config{userelocatableinc} && $data->{relocate_as})
+ {
+ require File::Spec;
+ require Cwd;
+ my ($vol, $dir) = File::Spec->splitpath($packfile);
+ my $newpath = File::Spec->catpath($vol, $dir, $data->{relocate_as});
+ $key = Cwd::realpath($newpath);
+ }
}
$key =~ s!/\./!/!g; # Some .packlists have spurious '/./' bits in the paths
- if (! @kvs)
- {
- $self->{data}->{$key} = undef;
- }
- else
- {
- my ($data) = {};
- foreach my $kv (@kvs)
- {
- my ($k, $v) = split('=', $kv);
- $data->{$k} = $v;
- }
- $self->{data}->{$key} = $data;
- }
+ $self->{data}->{$key} = $data;
}
close($fh);
}
open($fh, ">$packfile") || Carp::croak("Can't open file $packfile: $!");
foreach my $key (sort(keys(%{$self->{data}})))
{
+ my $data = $self->{data}->{$key};
+ if ($Config{userelocatableinc}) {
+ $Relocations ||= __find_relocations();
+ if ($packfile =~ $Relocations) {
+ # We are writing into a subdirectory of a run-time relocated
+ # path. Figure out if the this file is also within a subdir.
+ my $prefix = $1;
+ if (File::Spec->no_upwards(File::Spec->abs2rel($key, $prefix)))
+ {
+ # The relocated path is within the found prefix
+ my $packfile_prefix;
+ (undef, $packfile_prefix)
+ = File::Spec->splitpath($packfile);
+
+ my $relocate_as
+ = File::Spec->abs2rel($key, $packfile_prefix);
+
+ if (!ref $data) {
+ $data = {};
+ }
+ $data->{relocate_as} = $relocate_as;
+ }
+ }
+ }
print $fh ("$key");
- if (ref($self->{data}->{$key}))
+ if (ref($data))
{
- my $data = $self->{data}->{$key};
foreach my $k (sort(keys(%$data)))
{
print $fh (" $k=$data->{$k}");