Add a note in perltodo about a potential extension of readpipe()

[p5sagit/p5-mst-13.2.git] / configpm

diff --git a/configpm b/configpm
index 08e7099..edd0844 100755 (executable)
--- a/configpm
+++ b/configpm
@@ -118,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) {
@@ -210,32 +210,70 @@ while (<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;
+
+my $t = fetch_string ({}, 'ivtype');
+my $s = fetch_string ({}, 'ivsize');
+
+# byteorder does exist on its own but we overlay a virtual
+# dynamically recomputed value.
+
+# However, ivtype and ivsize will not vary for sane fat binaries
+
+my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
+
+my $byteorder_code;
+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);
+my \$byteorder = join('', unpack('$format', pack('$f', \$i)));
+EOT
+} else {
+    $byteorder_code = "my \$byteorder = '?'x$s;\n";
+}
+
 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);
 
-print CONFIG "\n!END!\n", <<'EOT';
-my $summary_expanded = 0;
+# 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", $byteorder_code, <<'EOT';
+my $summary_expanded;
 
 sub myconfig {
-    return $summary if $summary_expanded;
-    $summary =~ s{\$(\w+)}
+    return $summary_expanded if $summary_expanded;
+    ($summary_expanded = $summary) =~ s{\$(\w+)}
                 { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge;
-    $summary_expanded = 1;
-    $summary;
+    $summary_expanded;
 }
 
-our $Config_SH : unique = <<'!END!';
+local *_ = \my $a;
+$_ = <<'!END!';
 EOT
 
 print CONFIG join("", @v_fast, sort @v_others);
 
-print CONFIG "!END!\n", $fetch_string;
+print CONFIG <<'EOT';
+!END!
+s/(byteorder=)(['"]).*?\2/$1$2$byteorder$2/m;
+our $Config_SH : unique = $_;
+EOT
+
+print CONFIG $fetch_string;
 
 print CONFIG <<'ENDOFEND';
 
@@ -326,18 +364,27 @@ sub config_sh {
 
 sub config_re {
     my $re = shift;
-    return map { chomp; $_ } grep /^$re=/, split /^/, $Config_SH;
+    return map { chomp; $_ } grep eval{ /^(?:$re)=/ }, split /^/, $Config_SH;
 }
 
 sub config_vars {
+    # implements -V:cfgvar option (see perlrun -V:)
     foreach (@_) {
-       if (/\W/) {
-           my @matches = config_re($_);
-           print map "$_\n", @matches ? @matches : "$_: not found";
+       # find optional leading, trailing colons; and query-spec
+       my ($notag,$qry,$lncont) = m/^(:)?(.*?)(:)?$/;  # flags fore and aft, 
+       # 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 map { s/\w+=//; "$_$lnend" } @matches ? @matches : "$qry: not found"  if  $notag;
        } else {
-           my $v = (exists $Config{$_}) ? $Config{$_} : 'UNKNOWN';
+           my $v = (exists $Config{$qry}) ? $Config{$qry} : 'UNKNOWN';
            $v = 'undef' unless defined $v;
-           print "$_='$v';\n";
+           print "${prfx}'${v}'$lnend";
        }
     }
 }
@@ -376,45 +423,14 @@ sub TIEHASH {
 ENDOFSET
 }
 
-
-# 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;
-
-my $t = fetch_string ({}, 'ivtype');
-my $s = fetch_string ({}, 'ivsize');
-
-# byteorder does exist on its own but we overlay a virtual
-# dynamically recomputed value.
-
-# However, ivtype and ivsize will not vary for sane fat binaries
-
-my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
-
-my $byteorder_code;
-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);
-my \$value = join('', unpack('$format', pack('$f', \$i)));
-EOT
-} else {
-    $byteorder_code = "\$value = '?'x$s;\n";
-}
-
 my $fast_config = join '', map { "    $_,\n" }
-    values (%v_fast), 'byteorder => $value' ;
+    sort values (%v_fast), 'byteorder => $byteorder' ;
 
-print CONFIG sprintf <<'ENDOFTIE', $byteorder_code, $fast_config;
+print CONFIG sprintf <<'ENDOFTIE', $fast_config;
 
 # avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
 sub DESTROY { }
 
-%s
-
 tie %%Config, 'Config', {
 %s
 };
@@ -432,8 +448,8 @@ Config - access Perl configuration information
 =head1 SYNOPSIS
 
     use Config;
-    if ($Config{'cc'} =~ /gcc/) {
-       print "built by gcc\n";
+    if ($Config{usethreads}) {
+       print "has thread support\n"
     } 
 
     use Config qw(myconfig config_sh config_vars config_re);