#!./miniperl -w
+use strict;
+use vars qw(%Config $Config_SH_expanded);
# commonly used names to put first (and hence lookup fastest)
my %Common = map {($_,$_)}
# made to this file will be lost the next time perl is built.
package Config;
-@EXPORT = qw(%%Config);
-@EXPORT_OK = qw(myconfig config_sh config_vars config_re);
+use strict;
+# use warnings; Pulls in Carp
+# use vars pulls in Carp
+@Config::EXPORT = qw(%%Config);
+@Config::EXPORT_OK = qw(myconfig config_sh config_vars config_re);
-my %%Export_Cache = map {($_ => 1)} (@EXPORT, @EXPORT_OK);
+my %%Export_Cache = map {($_ => 1)} (@Config::EXPORT, @Config::EXPORT_OK);
+
+our %%Config;
# Define our own import method to avoid pulling in the full Exporter:
sub import {
my $pkg = shift;
- @_ = @EXPORT unless @_;
+ @_ = @Config::EXPORT unless @_;
my @funcs = grep $_ ne '%%Config', @_;
my $export_Config = @funcs < @_ ? 1 : 0;
+ no strict 'refs';
my $callpkg = caller(0);
foreach my $func (@funcs) {
die sprintf qq{"%%s" is not exported by the %%s module\n},
my $marker = "$key=";
# Check for the common case, ' delimited
- my $start = index($Config_SH, "\n$marker$quote_type");
+ 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, "\n$marker$quote_type");
- }
- return undef if ( ($start == -1) && # in case it's first
- (substr($Config_SH, 0, length($marker)) ne $marker) );
- if ($start == -1) {
- # It's the very first thing we found. Skip $start forward
- # and figure out the quote mark after the =.
- $start = length($marker) + 1;
- $quote_type = substr($Config_SH, $start - 1, 1);
- }
- else {
- $start += length($marker) + 2;
+ $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, $start,
- index($Config_SH, "$quote_type\n", $start) - $start);
+ 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
eval $fetch_string;
die if $@;
-open(CONFIG_SH, 'config.sh') || die "Can't open config.sh: $!";
-while (<CONFIG_SH>) {
+{
+ my ($name, $val);
+ open(CONFIG_SH, 'config.sh') || die "Can't open config.sh: $!";
+ while (<CONFIG_SH>) {
next if m:^#!/bin/sh:;
# Catch PERL_CONFIG_SH=true and PERL_VERSION=n line from Configure.
push(@non_v, "#$_"); # not a name='value' line
next;
}
- $quote = $2;
+ my $quote = $2;
if ($in_v) {
$val .= $_;
}
push(@v_fast, $line);
$v_fast{$name} = "'$name' => $quote$val$quote";
}
+ }
+ close CONFIG_SH;
}
-close CONFIG_SH;
+
# Calculation for the keys for byteorder
# This is somewhat grim, but I need to run fetch_string here.
-our $Config_SH = join "\n", @v_fast, @v_others;
+our $Config_SH_expanded = join "\n", '', @v_fast, @v_others;
my $t = fetch_string ({}, 'ivtype');
my $s = fetch_string ({}, 'ivsize');
!END!
s/(byteorder=)(['"]).*?\2/$1$2$byteorder$2/m;
our $Config_SH : unique = $_;
-EOT
-
-print CONFIG $fetch_string;
-print CONFIG <<'ENDOFEND';
+our $Config_SH_expanded : unique = "\n$_" . << 'EOVIRTUAL';
+EOT
-sub fetch_virtual {
- my($self, $key) = @_;
+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 "${prefix}_nolargefiles='$value'\n";
+}
- my $value;
-
- if ($key =~ /^((?:cc|ld)flags|libs(?:wanted)?)_nolargefiles/) {
- # These are purely virtual, they do not exist, but need to
- # be computed on demand for largefile-incapable extensions.
- my $new_key = "${1}_uselargefiles";
- $value = $Config{$1};
- my $withlargefiles = $Config{$new_key};
- if ($new_key =~ /^(?:cc|ld)flags_/) {
- $value =~ s/\Q$withlargefiles\E\b//;
- } elsif ($new_key =~ /^libs/) {
- my @lflibswanted = split(' ', $Config{libswanted_uselargefiles});
- if (@lflibswanted) {
- my %lflibswanted;
- @lflibswanted{@lflibswanted} = ();
- if ($new_key =~ /^libs_/) {
- my @libs = grep { /^-l(.+)/ &&
- not exists $lflibswanted{$1} }
- split(' ', $Config{libs});
- $Config{libs} = join(' ', @libs);
- } elsif ($new_key =~ /^libswanted_/) {
- my @libswanted = grep { not exists $lflibswanted{$_} }
- split(' ', $Config{libswanted});
- $Config{libswanted} = join(' ', @libswanted);
- }
- }
+foreach my $prefix (qw(libs libswanted)) {
+ my $value = fetch_string ({}, $prefix);
+ my @lflibswanted
+ = split(' ', fetch_string ({}, 'libswanted_uselargefiles'));
+ if (@lflibswanted) {
+ my %lflibswanted;
+ @lflibswanted{@lflibswanted} = ();
+ if ($prefix eq 'libs') {
+ my @libs = grep { /^-l(.+)/ &&
+ not exists $lflibswanted{$1} }
+ split(' ', fetch_string ({}, 'libs'));
+ $value = join(' ', @libs);
+ } else {
+ my @libswanted = grep { not exists $lflibswanted{$_} }
+ split(' ', fetch_string ({}, 'libswanted'));
+ $value = join(' ', @libswanted);
}
}
-
- $self->{$key} = $value;
+ print CONFIG "${prefix}_nolargefiles='$value'\n";
}
+print CONFIG "EOVIRTUAL\n";
+
+print CONFIG $fetch_string;
+
+print CONFIG <<'ENDOFEND';
+
sub FETCH {
my($self, $key) = @_;
# check for cached value (which may be undef so we use exists not defined)
return $self->{$key} if exists $self->{$key};
- $self->fetch_string($key);
- return $self->{$key} if exists $self->{$key};
- $self->fetch_virtual($key);
-
- # Might not exist, in which undef is correct.
- return $self->{$key};
+ return $self->fetch_string($key);
}
my $prevpos = 0;
sub FIRSTKEY {
$prevpos = 0;
- substr($Config_SH, 0, index($Config_SH, '=') );
+ substr($Config_SH_expanded, 1, index($Config_SH_expanded, '=') - 1 );
}
sub NEXTKEY {
# Find out how the current key's quoted so we can skip to its end.
- my $quote = substr($Config_SH, index($Config_SH, "=", $prevpos)+1, 1);
- my $pos = index($Config_SH, qq($quote\n), $prevpos) + 2;
- my $len = index($Config_SH, "=", $pos) - $pos;
+ my $quote = substr($Config_SH_expanded,
+ index($Config_SH_expanded, "=", $prevpos)+1, 1);
+ my $pos = index($Config_SH_expanded, qq($quote\n), $prevpos) + 2;
+ my $len = index($Config_SH_expanded, "=", $pos) - $pos;
$prevpos = $pos;
- $len > 0 ? substr($Config_SH, $pos, $len) : undef;
+ $len > 0 ? substr($Config_SH_expanded, $pos, $len) : undef;
}
-sub EXISTS {
+sub EXISTS {
return 1 if exists($_[0]->{$_[1]});
- return(index($Config_SH, "\n$_[1]='") != -1 or
- substr($Config_SH, 0, length($_[1])+2) eq "$_[1]='" or
- index($Config_SH, "\n$_[1]=\"") != -1 or
- substr($Config_SH, 0, length($_[1])+2) eq "$_[1]=\"" or
- $_[1] =~ /^(?:(?:cc|ld)flags|libs(?:wanted)?)_nolargefiles$/
+ return(index($Config_SH_expanded, "\n$_[1]='") != -1 or
+ index($Config_SH_expanded, "\n$_[1]=\"") != -1
);
}
sub config_re {
my $re = shift;
- return map { chomp; $_ } grep eval{ /^(?:$re)=/ }, split /^/, $Config_SH;
+ return map { chomp; $_ } grep eval{ /^(?:$re)=/ }, split /^/,
+ $Config_SH_expanded;
}
sub config_vars {
+ # implements -V:cfgvar option (see perlrun -V:)
foreach (@_) {
+ # find optional leading, trailing colons; and query-spec
my ($notag,$qry,$lncont) = m/^(:)?(.*?)(:)?$/; # flags fore and aft,
- my $prfx = $notag ? '': "$qry="; # prefix for print
- my $lnend = $lncont ? ' ' : ";\n"; # ending for print
+ # map colon-flags to print decorations
+ my $prfx = $notag ? '': "$qry="; # tag-prefix for print
+ my $lnend = $lncont ? ' ' : ";\n"; # line ending for print
+ # all config-vars are by definition \w only, any \W means regex
if ($qry =~ /\W/) {
my @matches = config_re($qry);
print map "$_$lnend", @matches ? @matches : "$qry: not found" if !$notag;
print CONFIG <<'ENDOFSET';
my %preconfig;
if ($OS2::is_aout) {
- my ($value, $v) = $Config_SH =~ m/^used_aout='(.*)'\s*$/m;
+ my ($value, $v) = $Config_SH_expanded =~ m/^used_aout='(.*)'\s*$/m;
for (split ' ', $value) {
- ($v) = $Config_SH =~ m/^aout_$_='(.*)'\s*$/m;
+ ($v) = $Config_SH_expanded =~ m/^aout_$_='(.*)'\s*$/m;
$preconfig{$_} = $v eq 'undef' ? undef : $v;
}
}
if ($Opts{glossary}) {
open(GLOS, "<$Glossary") or die "Can't open $Glossary: $!";
}
-%seen = ();
-$text = 0;
+my %seen = ();
+my $text = 0;
$/ = '';
sub process {
projects / p5sagit/p5-mst-13.2.git / blobdiff