X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=configpm;h=90e95a1decd021fbbbb65ddb7a27998f5c365a04;hb=363c40c40eaf5d0cfd92f460a3f838c41f9756ad;hp=9ab7057dc35f345cf940dedee2cc5e9c0cd489da;hpb=d4de4258b931cc1df88e6dfd94fd1a8f5c8d48d0;p=p5sagit%2Fp5-mst-13.2.git diff --git a/configpm b/configpm index 9ab7057..90e95a1 100755 --- a/configpm +++ b/configpm @@ -65,31 +65,36 @@ printf CONFIG <<'ENDOFBEG', ($myver) x 3; # 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 @@ -113,7 +118,7 @@ sub fetch_string { 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) { @@ -208,7 +213,7 @@ close CONFIG_SH; 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,") && !/^Summary of/; do { print CONFIG $_ } until !defined($_ = ) || /^\s*$/; @@ -218,14 +223,14 @@ print CONFIG "\n!END!\n", <<'EOT'; my $summary_expanded = 0; 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 if $summary_expanded; + $summary =~ s{\$(\w+)} + { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge; + $summary_expanded = 1; + $summary; } -our $Config_SH : shared = <<'!END!'; +our $Config_SH : unique = <<'!END!'; EOT print CONFIG join("", @v_fast, sort @v_others); @@ -321,23 +326,26 @@ sub config_sh { 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; @@ -349,19 +357,19 @@ if ($OS2::is_aout) { $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 < $value' ; + sort values (%v_fast), 'byteorder => $value' ; print CONFIG sprintf <<'ENDOFTIE', $byteorder_code, $fast_config; @@ -429,12 +436,14 @@ Config - access Perl configuration information 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)); @@ -462,6 +471,11 @@ See also C<-V> in L. 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