X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=configpm;h=ab26eefe407ce1f125f3c2ee90342f797539890a;hb=89e33a0587050e7ef2e88ba45c87444d8506f821;hp=43f6173232784a5bd60394420f84648896ee55ef;hpb=43d06990aaa822f75a12bcbeb69ad08960bcb417;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/configpm b/configpm
index 43f6173..ab26eef 100755
--- a/configpm
+++ b/configpm
@@ -82,7 +82,7 @@ use strict;
 # use vars pulls in Carp
 ENDOFBEG
 
-my $myver = sprintf "v%vd", $^V;
+my $myver = sprintf "%vd", $^V;
 
 printf CONFIG <<'ENDOFBEG', ($myver) x 3;
 # This file was created by configpm when Perl was built. Any changes
@@ -138,59 +138,12 @@ ENDOFBEG
 
 
 my @non_v    = ();
-my @v_fast   = ();
 my @v_others = ();
 my $in_v     = 0;
 my %Data     = ();
 
-# This is somewhat grim, but I want the code for parsing config.sh here and
-# now so that I can expand $Config{ivsize} and $Config{ivtype}
-
-my $fetch_string = <<'EOT';
-
-# Search for it in the big string 
-sub fetch_string {
-    my($self, $key) = @_;
-
-    my $quote_type = "'";
-    my $marker = "$key=";
-
-    # Check for the common case, ' delimited
-    my $start = index($Config_SH_expanded, "\n$marker$quote_type");
-    # If that failed, check for " delimited
-    if ($start == -1) {
-        $quote_type = '"';
-        $start = index($Config_SH_expanded, "\n$marker$quote_type");
-    }
-    # Start can never be -1 now, as we've rigged the long string we're
-    # searching with an initial dummy newline.
-    return undef if $start == -1;
-
-    $start += length($marker) + 2;
-
-    my $value = substr($Config_SH_expanded, $start, 
-                       index($Config_SH_expanded, "$quote_type\n", $start)
-		       - $start);
-
-    # If we had a double-quote, we'd better eval it so escape
-    # sequences and such can be interpolated. Since the incoming
-    # value is supposed to follow shell rules and not perl rules,
-    # we escape any perl variable markers
-    if ($quote_type eq '"') {
-	$value =~ s/\$/\\\$/g;
-	$value =~ s/\@/\\\@/g;
-	eval "\$value = \"$value\"";
-    }
-
-    # So we can say "if $Config{'foo'}".
-    $value = undef if $value eq 'undef';
-    $self->{$key} = $value; # cache it
-}
-EOT
-
-eval $fetch_string;
-die if $@;
 
+my %seen_quotes;
 {
   my ($name, $val);
   open(CONFIG_SH, 'config.sh') || die "Can't open config.sh: $!";
@@ -234,20 +187,88 @@ die if $@;
     $val =~ s/$quote\n?\z//;
 
     my $line = "$name=$quote$val$quote\n";
-    if (!$Common{$name}){
-        push(@v_others, $line);
-    }
-    else {
-        push(@v_fast, $line);
-    }
+    push(@v_others, $line);
+    $seen_quotes{$quote}++;
   }
   close CONFIG_SH;
 }
 
+# This is somewhat grim, but I want the code for parsing config.sh here and
+# now so that I can expand $Config{ivsize} and $Config{ivtype}
+
+my $fetch_string = <<'EOT';
+
+# Search for it in the big string
+sub fetch_string {
+    my($self, $key) = @_;
+
+EOT
+
+if ($seen_quotes{'"'}) {
+    # We need the full ' and " code
+    $fetch_string .= <<'EOT';
+    my $quote_type = "'";
+    my $marker = "$key=";
+
+    # Check for the common case, ' delimited
+    my $start = index($Config_SH_expanded, "\n$marker$quote_type");
+    # If that failed, check for " delimited
+    if ($start == -1) {
+        $quote_type = '"';
+        $start = index($Config_SH_expanded, "\n$marker$quote_type");
+    }
+EOT
+} else {
+    $fetch_string .= <<'EOT';
+    # We only have ' delimted.
+    my $start = index($Config_SH_expanded, "\n$key=\'");
+EOT
+}
+$fetch_string .= <<'EOT';
+    # Start can never be -1 now, as we've rigged the long string we're
+    # searching with an initial dummy newline.
+    return undef if $start == -1;
+
+    $start += length($key) + 3;
+
+EOT
+if (!$seen_quotes{'"'}) {
+    # Don't need the full ' and " code, or the eval expansion.
+    $fetch_string .= <<'EOT';
+    my $value = substr($Config_SH_expanded, $start,
+                       index($Config_SH_expanded, "'\n", $start)
+		       - $start);
+EOT
+} else {
+    $fetch_string .= <<'EOT';
+    my $value = substr($Config_SH_expanded, $start,
+                       index($Config_SH_expanded, "$quote_type\n", $start)
+		       - $start);
+
+    # If we had a double-quote, we'd better eval it so escape
+    # sequences and such can be interpolated. Since the incoming
+    # value is supposed to follow shell rules and not perl rules,
+    # we escape any perl variable markers
+    if ($quote_type eq '"') {
+	$value =~ s/\$/\\\$/g;
+	$value =~ s/\@/\\\@/g;
+	eval "\$value = \"$value\"";
+    }
+EOT
+}
+$fetch_string .= <<'EOT';
+    # So we can say "if $Config{'foo'}".
+    $value = undef if $value eq 'undef';
+    $self->{$key} = $value; # cache it
+}
+EOT
+
+eval $fetch_string;
+die if $@;
 
 # Calculation for the keys for byteorder
 # This is somewhat grim, but I need to run fetch_string here.
-our $Config_SH_expanded = join "\n", '', @v_fast, @v_others;
+our $Config_SH_expanded = join "\n", '', @v_others;
 
 my $t = fetch_string ({}, 'ivtype');
 my $s = fetch_string ({}, 'ivsize');
@@ -264,6 +285,7 @@ if ($s == 4 || $s == 8) {
     my $list = join ',', reverse(2..$s);
     my $format = 'a'x$s;
     $byteorder_code = <<"EOT";
+
 my \$i = 0;
 foreach my \$c ($list) { \$i |= ord(\$c); \$i <<= 8 }
 \$i |= ord(1);
@@ -272,7 +294,70 @@ EOT
 } else {
     $byteorder_code = "our \$byteorder = '?'x$s;\n";
 }
-print CONFIG $byteorder_code;
+
+my @need_relocation;
+
+if (fetch_string({},'userelocatableinc')) {
+    foreach my $what (qw(archlibexp
+			 privlibexp
+			 sitearchexp
+			 sitelibexp
+			 sitelib_stem
+			 vendorarchexp
+			 vendorlibexp
+			 vendorlib_stem)) {
+	push @need_relocation, $what if fetch_string({}, $what) =~ m!^\.\.\./!;
+    }
+}
+
+my %need_relocation;
+@need_relocation{@need_relocation} = @need_relocation;
+
+# This can have .../ anywhere:
+if (fetch_string({}, 'otherlibdirs') =~ m!\.\.\./!) {
+    $need_relocation{otherlibdirs} = 'otherlibdirs';
+}
+
+my $relocation_code = <<'EOT';
+
+sub relocate_inc {
+  my $libdir = shift;
+  return $libdir unless $libdir =~ s!^\.\.\./!!;
+  my $prefix = $^X;
+  if ($prefix =~ s!/[^/]*$!!) {
+    while ($libdir =~ m!^\.\./!) {
+      # Loop while $libdir starts "../" and $prefix still has a trailing
+      # directory
+      last unless $prefix =~ s!/([^/]+)$!!;
+      # but bail out if the directory we picked off the end of $prefix is .
+      # or ..
+      if ($1 eq '.' or $1 eq '..') {
+	# Undo! This should be rare, hence code it this way rather than a
+	# check each time before the s!!! above.
+	$prefix = "$prefix/$1";
+	last;
+      }
+      # Remove that leading ../ and loop again
+      substr ($libdir, 0, 3, '');
+    }
+    $libdir = "$prefix/$libdir";
+  }
+  $libdir;
+}
+EOT
+
+if (%need_relocation) {
+  my $relocations_in_common;
+  # otherlibdirs only features in the hash
+  foreach (keys %need_relocation) {
+    $relocations_in_common++ if $Common{$_};
+  }
+  if ($relocations_in_common) {
+    print CONFIG $relocation_code;
+  } else {
+    print CONFIG_HEAVY $relocation_code;
+  }
+}
 
 print CONFIG_HEAVY @non_v, "\n";
 
@@ -301,10 +386,34 @@ local *_ = \my $a;
 $_ = <<'!END!';
 EOT
 
-print CONFIG_HEAVY join("", @v_fast, sort @v_others);
+print CONFIG_HEAVY join('', sort @v_others), "!END!\n";
+
+# Only need the dynamic byteorder code in Config.pm if 'byteorder' is one of
+# the precached keys
+if ($Common{byteorder}) {
+    print CONFIG $byteorder_code;
+} else {
+    print CONFIG_HEAVY $byteorder_code;
+}
+
+if (@need_relocation) {
+print CONFIG_HEAVY 'foreach my $what (qw(', join (' ', @need_relocation),
+      ")) {\n", <<'EOT';
+    s/^($what=)(['"])(.*?)\2/$1 . $2 . relocate_inc($3) . $2/me;
+}
+EOT
+# Currently it only makes sense to do the ... relocation on Unix, so there's
+# no need to emulate the "which separator for this platform" logic in perl.c -
+# ':' will always be applicable
+if ($need_relocation{otherlibdirs}) {
+print CONFIG_HEAVY << 'EOT';
+s{^(otherlibdirs=)(['"])(.*?)\2}
+ {$1 . $2 . join ':', map {relocate_inc($_)} split ':', $3 . $2}me;
+EOT
+}
+}
 
 print CONFIG_HEAVY <<'EOT';
-!END!
 s/(byteorder=)(['"]).*?\2/$1$2$Config::byteorder$2/m;
 
 my $config_sh_len = length $_;
@@ -315,12 +424,16 @@ EOT
 foreach my $prefix (qw(ccflags ldflags)) {
     my $value = fetch_string ({}, $prefix);
     my $withlargefiles = fetch_string ({}, $prefix . "_uselargefiles");
-    $value =~ s/\Q$withlargefiles\E\b//;
-    print CONFIG_HEAVY "${prefix}_nolargefiles='$value'\n";
+    if (defined $withlargefiles) {
+        $value =~ s/\Q$withlargefiles\E\b//;
+        print CONFIG_HEAVY "${prefix}_nolargefiles='$value'\n";
+    }
 }
 
 foreach my $prefix (qw(libs libswanted)) {
     my $value = fetch_string ({}, $prefix);
+    my $withlf = fetch_string ({}, 'libswanted_uselargefiles');
+    next unless defined $withlf;
     my @lflibswanted
        = split(' ', fetch_string ({}, 'libswanted_uselargefiles'));
     if (@lflibswanted) {
@@ -357,6 +470,7 @@ sub FETCH {
 ENDOFEND
 
 print CONFIG_HEAVY <<'ENDOFEND';
+
 my $prevpos = 0;
 
 sub FIRSTKEY {
@@ -365,10 +479,21 @@ sub FIRSTKEY {
 }
 
 sub NEXTKEY {
+ENDOFEND
+if ($seen_quotes{'"'}) {
+print CONFIG_HEAVY <<'ENDOFEND';
     # Find out how the current key's quoted so we can skip to its end.
     my $quote = substr($Config_SH_expanded,
 		       index($Config_SH_expanded, "=", $prevpos)+1, 1);
     my $pos = index($Config_SH_expanded, qq($quote\n), $prevpos) + 2;
+ENDOFEND
+} else {
+    # Just ' quotes, so it's much easier.
+print CONFIG_HEAVY <<'ENDOFEND';
+    my $pos = index($Config_SH_expanded, qq('\n), $prevpos) + 2;
+ENDOFEND
+}
+print CONFIG_HEAVY <<'ENDOFEND';
     my $len = index($Config_SH_expanded, "=", $pos) - $pos;
     $prevpos = $pos;
     $len > 0 ? substr($Config_SH_expanded, $pos, $len) : undef;
@@ -377,8 +502,14 @@ sub NEXTKEY {
 sub EXISTS {
     return 1 if exists($_[0]->{$_[1]});
 
-    return(index($Config_SH_expanded, "\n$_[1]='") != -1 or
-           index($Config_SH_expanded, "\n$_[1]=\"") != -1
+    return(index($Config_SH_expanded, "\n$_[1]='") != -1
+ENDOFEND
+if ($seen_quotes{'"'}) {
+print CONFIG_HEAVY <<'ENDOFEND';
+           or index($Config_SH_expanded, "\n$_[1]=\"") != -1
+ENDOFEND
+}
+print CONFIG_HEAVY <<'ENDOFEND';
           );
 }
 
@@ -470,13 +601,21 @@ foreach my $key (keys %Common) {
 	$value =~ s!\\!\\\\!g;
 	$value =~ s!'!\\'!g;
 	$value = "'$value'";
+	if ($key eq 'otherlibdirs') {
+	    $value = "join (':', map {relocate_inc(\$_)} split (':', $value))";
+	} elsif ($need_relocation{$key}) {
+	    $value = "relocate_inc($value)";
+	}
     } else {
 	$value = "undef";
     }
     $Common{$key} = "$qkey => $value";
 }
-my $fast_config = join '', map { "    $_,\n" }
-    sort (values %Common, 'byteorder => $byteorder');
+
+if ($Common{byteorder}) {
+    $Common{byteorder} = 'byteorder => $byteorder';
+}
+my $fast_config = join '', map { "    $_,\n" } sort values %Common;
 
 print CONFIG sprintf <<'ENDOFTIE', $fast_config;
 
@@ -488,10 +627,9 @@ sub AUTOLOAD {
     die "&Config::AUTOLOAD failed on $Config::AUTOLOAD";
 }
 
+# tie returns the object, so the value returned to require will be true.
 tie %%Config, 'Config', {
 %s};
-
-1;
 ENDOFTIE
 
 
@@ -727,7 +865,9 @@ EOS
 
 # Now do some simple tests on the Config.pm file we have created
 unshift(@INC,'lib');
+unshift(@INC,'xlib/symbian') if $Opts{cross};
 require $Config_PM;
+require $Config_heavy;
 import Config;
 
 die "$0: $Config_PM not valid"