X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=configpm;h=ccf7816f293a9fbdc40a239b71ff4c4b7b5d4697;hb=3246d7a3ad86dfa806dd7e514ae5fd2dacd5c0ef;hp=abe71bf03df3ea3fbf25d6e6cb2a4c433b8dabfa;hpb=a8e1d30be55774dfed1ebdbeeb60084324b04c25;p=p5sagit%2Fp5-mst-13.2.git diff --git a/configpm b/configpm index abe71bf..ccf7816 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 @@ -95,6 +95,14 @@ use strict; @Config::EXPORT = qw(%%Config); @Config::EXPORT_OK = qw(myconfig config_sh config_vars config_re); +# Need to stub all the functions to make code such as print Config::config_sh +# keep working + +sub myconfig; +sub config_sh; +sub config_vars; +sub config_re; + my %%Export_Cache = map {($_ => 1)} (@Config::EXPORT, @Config::EXPORT_OK); our %%Config; @@ -130,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: $!"; @@ -226,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'); @@ -256,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); @@ -264,21 +294,80 @@ 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"; # copy config summary format from the myconfig.SH script -print CONFIG_HEAVY "our \$summary : unique = <<'!END!';\n"; +print CONFIG_HEAVY "our \$summary = <<'!END!';\n"; open(MYCONFIG,") && !/^Summary of/; do { print CONFIG_HEAVY $_ } until !defined($_ = ) || /^\s*$/; close(MYCONFIG); -# NB. as $summary is unique, we need to copy it in a lexical variable -# before expanding it, because may have been made readonly if a perl -# interpreter has been cloned. - print CONFIG_HEAVY "\n!END!\n", <<'EOT'; my $summary_expanded; @@ -293,25 +382,54 @@ 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; -our $Config_SH : unique = $_; -our $Config_SH_expanded : unique = "\n$_" . << 'EOVIRTUAL'; +my $config_sh_len = length $_; + +our $Config_SH_expanded = "\n$_" . << 'EOVIRTUAL'; 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) { @@ -348,6 +466,7 @@ sub FETCH { ENDOFEND print CONFIG_HEAVY <<'ENDOFEND'; + my $prevpos = 0; sub FIRSTKEY { @@ -356,10 +475,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; @@ -368,8 +498,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'; ); } @@ -379,7 +515,7 @@ sub STORE { die "\%Config::Config is read-only\n" } sub config_sh { - $Config_SH + substr $Config_SH_expanded, 1, $config_sh_len; } sub config_re { @@ -461,28 +597,37 @@ 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; + +# Sanity check needed to stop an infite loop if Config_heavy.pl fails to define +# &launcher for some reason (eg it got truncated) print CONFIG sprintf <<'ENDOFTIE', $fast_config; sub DESTROY { } sub AUTOLOAD { require 'Config_heavy.pl'; - goto \&launcher; + goto \&launcher unless $Config::AUTOLOAD =~ /launcher$/; 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 @@ -714,11 +859,14 @@ EOS $cross =~ s/\*\*\*replace-marker\*\*\*/$Opts{cross}/g; print CROSS $cross; close CROSS; + unshift(@INC,"xlib/$Opts{cross}"); } # 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"