# made to this file will be lost the next time perl is built.
package Config;
-use Exporter ();
@EXPORT = qw(%%Config);
-@EXPORT_OK = qw(myconfig config_sh config_vars);
+@EXPORT_OK = qw(myconfig config_sh config_vars config_re);
+
+my %%Export_Cache = map {($_ => 1)} (@EXPORT, @EXPORT_OK);
# Define our own import method to avoid pulling in the full Exporter:
sub import {
- my $pkg = shift;
- @_ = @EXPORT unless @_;
+ my $pkg = shift;
+ @_ = @EXPORT unless @_;
- my @func = grep {$_ ne '%%Config'} @_;
- local $Exporter::ExportLevel = 1;
- Exporter::import('Config', @func) if @func;
+ my @funcs = grep $_ ne '%%Config', @_;
+ my $export_Config = @funcs < @_ ? 1 : 0;
- return if @func == @_;
+ my $callpkg = caller(0);
+ foreach my $func (@funcs) {
+ die sprintf qq{"%%s" is not exported by the %%s module\n},
+ $func, __PACKAGE__ unless $Export_Cache{$func};
+ *{$callpkg.'::'.$func} = \&{$func};
+ }
- my $callpkg = caller(0);
- *{"$callpkg\::Config"} = \%%Config;
+ *{"$callpkg\::Config"} = \%%Config if $export_Config;
+ return;
}
die "Perl lib version (%s) doesn't match executable version ($])"
unless $^V;
$^V eq %s
- or die "Perl lib version (%s) doesn't match executable version (" .
- (sprintf "v%vd",$^V) . ")";
+ or die "Perl lib version (%s) doesn't match executable version (" .
+ sprintf("v%%vd",$^V) . ")";
ENDOFBEG
my $quote_type = "'";
my $marker = "$key=";
- # Check for the common case, ' delimeted
+ # Check for the common case, ' delimited
my $start = index($Config_SH, "\n$marker$quote_type");
# If that failed, check for " delimited
if ($start == -1) {
print CONFIG @non_v, "\n";
# copy config summary format from the myconfig.SH script
-print CONFIG "my \$summary = <<'!END!';\n";
+print CONFIG "our \$summary : unique = <<'!END!';\n";
open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\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 "\n!END!\n", <<'EOT';
-my $summary_expanded = 0;
+my $summary_expanded;
sub myconfig {
- return $summary if $summary_expanded;
- $summary =~ s{\$(\w+)}
- { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge;
- $summary_expanded = 1;
- $summary;
+ return $summary_expanded if $summary_expanded;
+ ($summary_expanded = $summary) =~ s{\$(\w+)}
+ { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge;
+ $summary_expanded;
}
-our $Config_SH : shared = <<'!END!';
+our $Config_SH : unique = <<'!END!';
EOT
print CONFIG join("", @v_fast, sort @v_others);
sub config_re {
my $re = shift;
- my @matches = grep /^$re=/, split /^/, $Config_SH;
- @matches ? (print @matches) : print "$re: not found\n";
+ return map { chomp; $_ } grep /^$re=/, split /^/, $Config_SH;
}
sub config_vars {
- foreach(@_){
- config_re($_), next if /\W/;
- my $v=(exists $Config{$_}) ? $Config{$_} : 'UNKNOWN';
- $v='undef' unless defined $v;
- print "$_='$v';\n";
+ foreach (@_) {
+ if (/\W/) {
+ my @matches = config_re($_);
+ print map "$_\n", @matches ? @matches : "$_: not found";
+ } else {
+ my $v = (exists $Config{$_}) ? $Config{$_} : 'UNKNOWN';
+ $v = 'undef' unless defined $v;
+ print "$_='$v';\n";
+ }
}
}
ENDOFEND
if ($^O eq 'os2') {
- print CONFIG <<'ENDOFSET';
+ print CONFIG <<'ENDOFSET';
my %preconfig;
if ($OS2::is_aout) {
my ($value, $v) = $Config_SH =~ m/^used_aout='(.*)'\s*$/m;
$preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't
sub TIEHASH { bless {%preconfig} }
ENDOFSET
- # Extract the name of the DLL from the makefile to avoid duplication
- my ($f) = grep -r, qw(GNUMakefile Makefile);
- my $dll;
- if (open my $fh, '<', $f) {
- while (<$fh>) {
- $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
+ # Extract the name of the DLL from the makefile to avoid duplication
+ my ($f) = grep -r, qw(GNUMakefile Makefile);
+ my $dll;
+ if (open my $fh, '<', $f) {
+ while (<$fh>) {
+ $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
+ }
}
- }
- print CONFIG <<ENDOFSET if $dll;
+ print CONFIG <<ENDOFSET if $dll;
\$preconfig{dll_name} = '$dll';
ENDOFSET
} else {
- print CONFIG <<'ENDOFSET';
+ print CONFIG <<'ENDOFSET';
sub TIEHASH {
bless $_[1], $_[0];
}
my $byteorder_code;
if ($s == 4 || $s == 8) {
-
- my $list = join ',', reverse(2..$s);
- my $format = 'a'x$s;
- $byteorder_code = <<"EOT";
+ 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);
my \$value = join('', unpack('$format', pack('$f', \$i)));
EOT
} else {
- $byteorder_code = "\$value = '?'x$s;\n";
+ $byteorder_code = "\$value = '?'x$s;\n";
}
my $fast_config = join '', map { " $_,\n" }
- values (%v_fast), 'byteorder => $value' ;
+ sort values (%v_fast), 'byteorder => $value' ;
print CONFIG sprintf <<'ENDOFTIE', $byteorder_code, $fast_config;
print "built by gcc\n";
}
- use Config qw(myconfig config_sh config_vars);
+ use Config qw(myconfig config_sh config_vars config_re);
print myconfig();
print config_sh();
+ print config_re();
+
config_vars(qw(osname archname));
Returns the entire perl configuration information in the form of the
original config.sh shell variable assignment script.
+=item config_re($regex)
+
+Like config_sh() but returns, as a list, only the config entries who's
+names match the $regex.
+
=item config_vars(@names)
Prints to STDOUT the values of the named configuration variable. Each is
https://perl5.git.perl.org / perl5.git / blobdiff