configpm

   1 #!./miniperl -w
   2 use strict;
   3 use vars qw(%Config $Config_SH_expanded);
   4
   5 my $how_many_common = 22;
   6
   7 # commonly used names to precache (and hence lookup fastest)
   8 my %Common;
   9
  10 while ($how_many_common--) {
  11     $_ = <DATA>;
  12     chomp;
  13     /^(\S+):\s*(\d+)$/ or die "Malformed line '$_'";
  14     $Common{$1} = $1;
  15 }
  16
  17 # names of things which may need to have slashes changed to double-colons
  18 my %Extensions = map {($_,$_)}
  19                  qw(dynamic_ext static_ext extensions known_extensions);
  20
  21 # allowed opts as well as specifies default and initial values
  22 my %Allowed_Opts = (
  23     'cross'    => '', # --cross=PLATFORM - crosscompiling for PLATFORM
  24     'glossary' => 1,  # --no-glossary  - no glossary file inclusion,
  25                       #                  for compactness
  26     'heavy' => '',   # pathname of the Config_heavy.pl file
  27 );
  28
  29 sub opts {
  30     # user specified options
  31     my %given_opts = (
  32         # --opt=smth
  33         (map {/^--([\-_\w]+)=(.*)$/} @ARGV),
  34         # --opt --no-opt --noopt
  35         (map {/^no-?(.*)$/i?($1=>0):($_=>1)} map {/^--([\-_\w]+)$/} @ARGV),
  36     );
  37
  38     my %opts = (%Allowed_Opts, %given_opts);
  39
  40     for my $opt (grep {!exists $Allowed_Opts{$_}} keys %given_opts) {
  41         die "option '$opt' is not recognized";
  42     }
  43     @ARGV = grep {!/^--/} @ARGV;
  44
  45     return %opts;
  46 }
  47
  48
  49 my %Opts = opts();
  50
  51 my ($Config_PM, $Config_heavy);
  52 my $Glossary = $ARGV[1] || 'Porting/Glossary';
  53
  54 if ($Opts{cross}) {
  55   # creating cross-platform config file
  56   mkdir "xlib";
  57   mkdir "xlib/$Opts{cross}";
  58   $Config_PM = $ARGV[0] || "xlib/$Opts{cross}/Config.pm";
  59 }
  60 else {
  61   $Config_PM = $ARGV[0] || 'lib/Config.pm';
  62 }
  63 if ($Opts{heavy}) {
  64   $Config_heavy = $Opts{heavy};
  65 }
  66 else {
  67   ($Config_heavy = $Config_PM) =~ s!\.pm$!_heavy.pl!;
  68   die "Can't automatically determine name for Config_heavy.pl from '$Config_PM'"
  69     if $Config_heavy eq $Config_PM;
  70 }
  71
  72 open CONFIG, ">$Config_PM" or die "Can't open $Config_PM: $!\n";
  73 open CONFIG_HEAVY, ">$Config_heavy" or die "Can't open $Config_heavy: $!\n";
  74
  75 print CONFIG_HEAVY <<'ENDOFBEG';
  76 # This file was created by configpm when Perl was built. Any changes
  77 # made to this file will be lost the next time perl is built.
  78
  79 package Config;
  80 use strict;
  81 # use warnings; Pulls in Carp
  82 # use vars pulls in Carp
  83 ENDOFBEG
  84
  85 my $myver = sprintf "v%vd", $^V;
  86
  87 printf CONFIG <<'ENDOFBEG', ($myver) x 3;
  88 # This file was created by configpm when Perl was built. Any changes
  89 # made to this file will be lost the next time perl is built.
  90
  91 package Config;
  92 use strict;
  93 # use warnings; Pulls in Carp
  94 # use vars pulls in Carp
  95 @Config::EXPORT = qw(%%Config);
  96 @Config::EXPORT_OK = qw(myconfig config_sh config_vars config_re);
  97
  98 # Need to stub all the functions to make code such as print Config::config_sh
  99 # keep working
 100
 101 sub myconfig;
 102 sub config_sh;
 103 sub config_vars;
 104 sub config_re;
 105
 106 my %%Export_Cache = map {($_ => 1)} (@Config::EXPORT, @Config::EXPORT_OK);
 107
 108 our %%Config;
 109
 110 # Define our own import method to avoid pulling in the full Exporter:
 111 sub import {
 112     my $pkg = shift;
 113     @_ = @Config::EXPORT unless @_;
 114
 115     my @funcs = grep $_ ne '%%Config', @_;
 116     my $export_Config = @funcs < @_ ? 1 : 0;
 117
 118     no strict 'refs';
 119     my $callpkg = caller(0);
 120     foreach my $func (@funcs) {
 121         die sprintf qq{"%%s" is not exported by the %%s module\n},
 122             $func, __PACKAGE__ unless $Export_Cache{$func};
 123         *{$callpkg.'::'.$func} = \&{$func};
 124     }
 125
 126     *{"$callpkg\::Config"} = \%%Config if $export_Config;
 127     return;
 128 }
 129
 130 die "Perl lib version (%s) doesn't match executable version ($])"
 131     unless $^V;
 132
 133 $^V eq %s
 134     or die "Perl lib version (%s) doesn't match executable version (" .
 135         sprintf("v%%vd",$^V) . ")";
 136
 137 ENDOFBEG
 138
 139
 140 my @non_v    = ();
 141 my @v_others = ();
 142 my $in_v     = 0;
 143 my %Data     = ();
 144
 145 # This is somewhat grim, but I want the code for parsing config.sh here and
 146 # now so that I can expand $Config{ivsize} and $Config{ivtype}
 147
 148 my $fetch_string = <<'EOT';
 149
 150 # Search for it in the big string
 151 sub fetch_string {
 152     my($self, $key) = @_;
 153
 154     my $quote_type = "'";
 155     my $marker = "$key=";
 156
 157     # Check for the common case, ' delimited
 158     my $start = index($Config_SH_expanded, "\n$marker$quote_type");
 159     # If that failed, check for " delimited
 160     if ($start == -1) {
 161         $quote_type = '"';
 162         $start = index($Config_SH_expanded, "\n$marker$quote_type");
 163     }
 164     # Start can never be -1 now, as we've rigged the long string we're
 165     # searching with an initial dummy newline.
 166     return undef if $start == -1;
 167
 168     $start += length($marker) + 2;
 169
 170     my $value = substr($Config_SH_expanded, $start,
 171                        index($Config_SH_expanded, "$quote_type\n", $start)
 172                        - $start);
 173
 174     # If we had a double-quote, we'd better eval it so escape
 175     # sequences and such can be interpolated. Since the incoming
 176     # value is supposed to follow shell rules and not perl rules,
 177     # we escape any perl variable markers
 178     if ($quote_type eq '"') {
 179         $value =~ s/\$/\\\$/g;
 180         $value =~ s/\@/\\\@/g;
 181         eval "\$value = \"$value\"";
 182     }
 183
 184     # So we can say "if $Config{'foo'}".
 185     $value = undef if $value eq 'undef';
 186     $self->{$key} = $value; # cache it
 187 }
 188 EOT
 189
 190 eval $fetch_string;
 191 die if $@;
 192
 193 {
 194   my ($name, $val);
 195   open(CONFIG_SH, 'config.sh') || die "Can't open config.sh: $!";
 196   while (<CONFIG_SH>) {
 197     next if m:^#!/bin/sh:;
 198
 199     # Catch PERL_CONFIG_SH=true and PERL_VERSION=n line from Configure.
 200     s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/ or m/^(\w+)='(.*)'$/;
 201     my($k, $v) = ($1, $2);
 202
 203     # grandfather PATCHLEVEL and SUBVERSION and CONFIG
 204     if ($k) {
 205         if ($k eq 'PERL_VERSION') {
 206             push @v_others, "PATCHLEVEL='$v'\n";
 207         }
 208         elsif ($k eq 'PERL_SUBVERSION') {
 209             push @v_others, "SUBVERSION='$v'\n";
 210         }
 211         elsif ($k eq 'PERL_CONFIG_SH') {
 212             push @v_others, "CONFIG='$v'\n";
 213         }
 214     }
 215
 216     # We can delimit things in config.sh with either ' or ".
 217     unless ($in_v or m/^(\w+)=(['"])(.*\n)/){
 218         push(@non_v, "#$_"); # not a name='value' line
 219         next;
 220     }
 221     my $quote = $2;
 222     if ($in_v) {
 223         $val .= $_;
 224     }
 225     else {
 226         ($name,$val) = ($1,$3);
 227     }
 228     $in_v = $val !~ /$quote\n/;
 229     next if $in_v;
 230
 231     s,/,::,g if $Extensions{$name};
 232
 233     $val =~ s/$quote\n?\z//;
 234
 235     my $line = "$name=$quote$val$quote\n";
 236     push(@v_others, $line);
 237   }
 238   close CONFIG_SH;
 239 }
 240
 241
 242 # Calculation for the keys for byteorder
 243 # This is somewhat grim, but I need to run fetch_string here.
 244 our $Config_SH_expanded = join "\n", '', @v_others;
 245
 246 my $t = fetch_string ({}, 'ivtype');
 247 my $s = fetch_string ({}, 'ivsize');
 248
 249 # byteorder does exist on its own but we overlay a virtual
 250 # dynamically recomputed value.
 251
 252 # However, ivtype and ivsize will not vary for sane fat binaries
 253
 254 my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
 255
 256 my $byteorder_code;
 257 if ($s == 4 || $s == 8) {
 258     my $list = join ',', reverse(2..$s);
 259     my $format = 'a'x$s;
 260     $byteorder_code = <<"EOT";
 261
 262 my \$i = 0;
 263 foreach my \$c ($list) { \$i |= ord(\$c); \$i <<= 8 }
 264 \$i |= ord(1);
 265 our \$byteorder = join('', unpack('$format', pack('$f', \$i)));
 266 EOT
 267 } else {
 268     $byteorder_code = "our \$byteorder = '?'x$s;\n";
 269 }
 270
 271 print CONFIG_HEAVY @non_v, "\n";
 272
 273 # copy config summary format from the myconfig.SH script
 274 print CONFIG_HEAVY "our \$summary : unique = <<'!END!';\n";
 275 open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
 276 1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
 277 do { print CONFIG_HEAVY $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
 278 close(MYCONFIG);
 279
 280 # NB. as $summary is unique, we need to copy it in a lexical variable
 281 # before expanding it, because may have been made readonly if a perl
 282 # interpreter has been cloned.
 283
 284 print CONFIG_HEAVY "\n!END!\n", <<'EOT';
 285 my $summary_expanded;
 286
 287 sub myconfig {
 288     return $summary_expanded if $summary_expanded;
 289     ($summary_expanded = $summary) =~ s{\$(\w+)}
 290                  { my $c = $Config::Config{$1}; defined($c) ? $c : 'undef' }ge;
 291     $summary_expanded;
 292 }
 293
 294 local *_ = \my $a;
 295 $_ = <<'!END!';
 296 EOT
 297
 298 print CONFIG_HEAVY join('', sort @v_others), "!END!\n";
 299
 300 # Only need the dynamic byteorder code in Config.pm if 'byteorder' is one of
 301 # the precached keys
 302 if ($Common{byteorder}) {
 303     print CONFIG $byteorder_code;
 304 } else {
 305     print CONFIG_HEAVY $byteorder_code;
 306 }
 307
 308 print CONFIG_HEAVY <<'EOT';
 309 s/(byteorder=)(['"]).*?\2/$1$2$Config::byteorder$2/m;
 310
 311 my $config_sh_len = length $_;
 312
 313 our $Config_SH_expanded : unique = "\n$_" . << 'EOVIRTUAL';
 314 EOT
 315
 316 foreach my $prefix (qw(ccflags ldflags)) {
 317     my $value = fetch_string ({}, $prefix);
 318     my $withlargefiles = fetch_string ({}, $prefix . "_uselargefiles");
 319     $value =~ s/\Q$withlargefiles\E\b//;
 320     print CONFIG_HEAVY "${prefix}_nolargefiles='$value'\n";
 321 }
 322
 323 foreach my $prefix (qw(libs libswanted)) {
 324     my $value = fetch_string ({}, $prefix);
 325     my @lflibswanted
 326        = split(' ', fetch_string ({}, 'libswanted_uselargefiles'));
 327     if (@lflibswanted) {
 328         my %lflibswanted;
 329         @lflibswanted{@lflibswanted} = ();
 330         if ($prefix eq 'libs') {
 331             my @libs = grep { /^-l(.+)/ &&
 332                             not exists $lflibswanted{$1} }
 333                                     split(' ', fetch_string ({}, 'libs'));
 334             $value = join(' ', @libs);
 335         } else {
 336             my @libswanted = grep { not exists $lflibswanted{$_} }
 337                                   split(' ', fetch_string ({}, 'libswanted'));
 338             $value = join(' ', @libswanted);
 339         }
 340     }
 341     print CONFIG_HEAVY "${prefix}_nolargefiles='$value'\n";
 342 }
 343
 344 print CONFIG_HEAVY "EOVIRTUAL\n";
 345
 346 print CONFIG_HEAVY $fetch_string;
 347
 348 print CONFIG <<'ENDOFEND';
 349
 350 sub FETCH {
 351     my($self, $key) = @_;
 352
 353     # check for cached value (which may be undef so we use exists not defined)
 354     return $self->{$key} if exists $self->{$key};
 355
 356     return $self->fetch_string($key);
 357 }
 358 ENDOFEND
 359
 360 print CONFIG_HEAVY <<'ENDOFEND';
 361 my $prevpos = 0;
 362
 363 sub FIRSTKEY {
 364     $prevpos = 0;
 365     substr($Config_SH_expanded, 1, index($Config_SH_expanded, '=') - 1 );
 366 }
 367
 368 sub NEXTKEY {
 369     # Find out how the current key's quoted so we can skip to its end.
 370     my $quote = substr($Config_SH_expanded,
 371                        index($Config_SH_expanded, "=", $prevpos)+1, 1);
 372     my $pos = index($Config_SH_expanded, qq($quote\n), $prevpos) + 2;
 373     my $len = index($Config_SH_expanded, "=", $pos) - $pos;
 374     $prevpos = $pos;
 375     $len > 0 ? substr($Config_SH_expanded, $pos, $len) : undef;
 376 }
 377
 378 sub EXISTS {
 379     return 1 if exists($_[0]->{$_[1]});
 380
 381     return(index($Config_SH_expanded, "\n$_[1]='") != -1 or
 382            index($Config_SH_expanded, "\n$_[1]=\"") != -1
 383           );
 384 }
 385
 386 sub STORE  { die "\%Config::Config is read-only\n" }
 387 *DELETE = \&STORE;
 388 *CLEAR  = \&STORE;
 389
 390
 391 sub config_sh {
 392     substr $Config_SH_expanded, 1, $config_sh_len;
 393 }
 394
 395 sub config_re {
 396     my $re = shift;
 397     return map { chomp; $_ } grep eval{ /^(?:$re)=/ }, split /^/,
 398     $Config_SH_expanded;
 399 }
 400
 401 sub config_vars {
 402     # implements -V:cfgvar option (see perlrun -V:)
 403     foreach (@_) {
 404         # find optional leading, trailing colons; and query-spec
 405         my ($notag,$qry,$lncont) = m/^(:)?(.*?)(:)?$/;  # flags fore and aft,
 406         # map colon-flags to print decorations
 407         my $prfx = $notag ? '': "$qry=";                # tag-prefix for print
 408         my $lnend = $lncont ? ' ' : ";\n";              # line ending for print
 409
 410         # all config-vars are by definition \w only, any \W means regex
 411         if ($qry =~ /\W/) {
 412             my @matches = config_re($qry);
 413             print map "$_$lnend", @matches ? @matches : "$qry: not found"               if !$notag;
 414             print map { s/\w+=//; "$_$lnend" } @matches ? @matches : "$qry: not found"  if  $notag;
 415         } else {
 416             my $v = (exists $Config::Config{$qry}) ? $Config::Config{$qry}
 417                                                    : 'UNKNOWN';
 418             $v = 'undef' unless defined $v;
 419             print "${prfx}'${v}'$lnend";
 420         }
 421     }
 422 }
 423
 424 # Called by the real AUTOLOAD
 425 sub launcher {
 426     undef &AUTOLOAD;
 427     goto \&$Config::AUTOLOAD;
 428 }
 429
 430 1;
 431 ENDOFEND
 432
 433 if ($^O eq 'os2') {
 434     print CONFIG <<'ENDOFSET';
 435 my %preconfig;
 436 if ($OS2::is_aout) {
 437     my ($value, $v) = $Config_SH_expanded =~ m/^used_aout='(.*)'\s*$/m;
 438     for (split ' ', $value) {
 439         ($v) = $Config_SH_expanded =~ m/^aout_$_='(.*)'\s*$/m;
 440         $preconfig{$_} = $v eq 'undef' ? undef : $v;
 441     }
 442 }
 443 $preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't
 444 sub TIEHASH { bless {%preconfig} }
 445 ENDOFSET
 446     # Extract the name of the DLL from the makefile to avoid duplication
 447     my ($f) = grep -r, qw(GNUMakefile Makefile);
 448     my $dll;
 449     if (open my $fh, '<', $f) {
 450         while (<$fh>) {
 451             $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
 452         }
 453     }
 454     print CONFIG <<ENDOFSET if $dll;
 455 \$preconfig{dll_name} = '$dll';
 456 ENDOFSET
 457 } else {
 458     print CONFIG <<'ENDOFSET';
 459 sub TIEHASH {
 460     bless $_[1], $_[0];
 461 }
 462 ENDOFSET
 463 }
 464
 465 foreach my $key (keys %Common) {
 466     my $value = fetch_string ({}, $key);
 467     # Is it safe on the LHS of => ?
 468     my $qkey = $key =~ /^[A-Za-z_][A-Za-z0-9_]*$/ ? $key : "'$key'";
 469     if (defined $value) {
 470         # Quote things for a '' string
 471         $value =~ s!\\!\\\\!g;
 472         $value =~ s!'!\\'!g;
 473         $value = "'$value'";
 474     } else {
 475         $value = "undef";
 476     }
 477     $Common{$key} = "$qkey => $value";
 478 }
 479
 480 if ($Common{byteorder}) {
 481     $Common{byteorder} = 'byteorder => $byteorder';
 482 }
 483 my $fast_config = join '', map { "    $_,\n" } sort values %Common;
 484
 485 print CONFIG sprintf <<'ENDOFTIE', $fast_config;
 486
 487 sub DESTROY { }
 488
 489 sub AUTOLOAD {
 490     require 'Config_heavy.pl';
 491     goto \&launcher;
 492     die "&Config::AUTOLOAD failed on $Config::AUTOLOAD";
 493 }
 494
 495 tie %%Config, 'Config', {
 496 %s};
 497
 498 1;
 499 ENDOFTIE
 500
 501
 502 open(CONFIG_POD, ">lib/Config.pod") or die "Can't open lib/Config.pod: $!";
 503 print CONFIG_POD <<'ENDOFTAIL';
 504 =head1 NAME
 505
 506 Config - access Perl configuration information
 507
 508 =head1 SYNOPSIS
 509
 510     use Config;
 511     if ($Config{usethreads}) {
 512         print "has thread support\n"
 513     }
 514
 515     use Config qw(myconfig config_sh config_vars config_re);
 516
 517     print myconfig();
 518
 519     print config_sh();
 520
 521     print config_re();
 522
 523     config_vars(qw(osname archname));
 524
 525
 526 =head1 DESCRIPTION
 527
 528 The Config module contains all the information that was available to
 529 the C<Configure> program at Perl build time (over 900 values).
 530
 531 Shell variables from the F<config.sh> file (written by Configure) are
 532 stored in the readonly-variable C<%Config>, indexed by their names.
 533
 534 Values stored in config.sh as 'undef' are returned as undefined
 535 values.  The perl C<exists> function can be used to check if a
 536 named variable exists.
 537
 538 =over 4
 539
 540 =item myconfig()
 541
 542 Returns a textual summary of the major perl configuration values.
 543 See also C<-V> in L<perlrun/Switches>.
 544
 545 =item config_sh()
 546
 547 Returns the entire perl configuration information in the form of the
 548 original config.sh shell variable assignment script.
 549
 550 =item config_re($regex)
 551
 552 Like config_sh() but returns, as a list, only the config entries who's
 553 names match the $regex.
 554
 555 =item config_vars(@names)
 556
 557 Prints to STDOUT the values of the named configuration variable. Each is
 558 printed on a separate line in the form:
 559
 560   name='value';
 561
 562 Names which are unknown are output as C<name='UNKNOWN';>.
 563 See also C<-V:name> in L<perlrun/Switches>.
 564
 565 =back
 566
 567 =head1 EXAMPLE
 568
 569 Here's a more sophisticated example of using %Config:
 570
 571     use Config;
 572     use strict;
 573
 574     my %sig_num;
 575     my @sig_name;
 576     unless($Config{sig_name} && $Config{sig_num}) {
 577         die "No sigs?";
 578     } else {
 579         my @names = split ' ', $Config{sig_name};
 580         @sig_num{@names} = split ' ', $Config{sig_num};
 581         foreach (@names) {
 582             $sig_name[$sig_num{$_}] ||= $_;
 583         }
 584     }
 585
 586     print "signal #17 = $sig_name[17]\n";
 587     if ($sig_num{ALRM}) {
 588         print "SIGALRM is $sig_num{ALRM}\n";
 589     }
 590
 591 =head1 WARNING
 592
 593 Because this information is not stored within the perl executable
 594 itself it is possible (but unlikely) that the information does not
 595 relate to the actual perl binary which is being used to access it.
 596
 597 The Config module is installed into the architecture and version
 598 specific library directory ($Config{installarchlib}) and it checks the
 599 perl version number when loaded.
 600
 601 The values stored in config.sh may be either single-quoted or
 602 double-quoted. Double-quoted strings are handy for those cases where you
 603 need to include escape sequences in the strings. To avoid runtime variable
 604 interpolation, any C<$> and C<@> characters are replaced by C<\$> and
 605 C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
 606 or C<\@> in double-quoted strings unless you're willing to deal with the
 607 consequences. (The slashes will end up escaped and the C<$> or C<@> will
 608 trigger variable interpolation)
 609
 610 =head1 GLOSSARY
 611
 612 Most C<Config> variables are determined by the C<Configure> script
 613 on platforms supported by it (which is most UNIX platforms).  Some
 614 platforms have custom-made C<Config> variables, and may thus not have
 615 some of the variables described below, or may have extraneous variables
 616 specific to that particular port.  See the port specific documentation
 617 in such cases.
 618
 619 ENDOFTAIL
 620
 621 if ($Opts{glossary}) {
 622   open(GLOS, "<$Glossary") or die "Can't open $Glossary: $!";
 623 }
 624 my %seen = ();
 625 my $text = 0;
 626 $/ = '';
 627
 628 sub process {
 629   if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
 630     my $c = substr $1, 0, 1;
 631     unless ($seen{$c}++) {
 632       print CONFIG_POD <<EOF if $text;
 633 =back
 634
 635 EOF
 636       print CONFIG_POD <<EOF;
 637 =head2 $c
 638
 639 =over 4
 640
 641 EOF
 642      $text = 1;
 643     }
 644   }
 645   elsif (!$text || !/\A\t/) {
 646     warn "Expected a Configure variable header",
 647       ($text ? " or another paragraph of description" : () );
 648   }
 649   s/n't/n\00t/g;                # leave can't, won't etc untouched
 650   s/^\t\s+(.*)/\n$1/gm;         # Indented lines ===> new paragraph
 651   s/^(?<!\n\n)\t(.*)/$1/gm;     # Not indented lines ===> text
 652   s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
 653   s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
 654   s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
 655   s{
 656      (?<! [\w./<\'\"] )         # Only standalone file names
 657      (?! e \. g \. )            # Not e.g.
 658      (?! \. \. \. )             # Not ...
 659      (?! \d )                   # Not 5.004
 660      (?! read/ )                # Not read/write
 661      (?! etc\. )                # Not etc.
 662      (?! I/O )                  # Not I/O
 663      (
 664         \$ ?                    # Allow leading $
 665         [\w./]* [./] [\w./]*    # Require . or / inside
 666      )
 667      (?<! \. (?= [\s)] ) )      # Do not include trailing dot
 668      (?! [\w/] )                # Include all of it
 669    }
 670    (F<$1>)xg;                   # /usr/local
 671   s/((?<=\s)~\w*)/F<$1>/g;      # ~name
 672   s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g;    # UNISTD
 673   s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
 674   s/n[\0]t/n't/g;               # undo can't, won't damage
 675 }
 676
 677 if ($Opts{glossary}) {
 678     <GLOS>;                             # Skip the "DO NOT EDIT"
 679     <GLOS>;                             # Skip the preamble
 680   while (<GLOS>) {
 681     process;
 682     print CONFIG_POD;
 683   }
 684 }
 685
 686 print CONFIG_POD <<'ENDOFTAIL';
 687
 688 =back
 689
 690 =head1 NOTE
 691
 692 This module contains a good example of how to use tie to implement a
 693 cache and an example of how to make a tied variable readonly to those
 694 outside of it.
 695
 696 =cut
 697
 698 ENDOFTAIL
 699
 700 close(CONFIG_HEAVY);
 701 close(CONFIG);
 702 close(GLOS);
 703 close(CONFIG_POD);
 704
 705 # Now create Cross.pm if needed
 706 if ($Opts{cross}) {
 707   open CROSS, ">lib/Cross.pm" or die "Can not open >lib/Cross.pm: $!";
 708   my $cross = <<'EOS';
 709 # typical invocation:
 710 #   perl -MCross Makefile.PL
 711 #   perl -MCross=wince -V:cc
 712 package Cross;
 713
 714 sub import {
 715   my ($package,$platform) = @_;
 716   unless (defined $platform) {
 717     # if $platform is not specified, then use last one when
 718     # 'configpm; was invoked with --cross option
 719     $platform = '***replace-marker***';
 720   }
 721   @INC = map {/\blib\b/?(do{local $_=$_;s/\blib\b/xlib\/$platform/;$_},$_):($_)} @INC;
 722   $::Cross::platform = $platform;
 723 }
 724
 725 1;
 726 EOS
 727   $cross =~ s/\*\*\*replace-marker\*\*\*/$Opts{cross}/g;
 728   print CROSS $cross;
 729   close CROSS;
 730 }
 731
 732 # Now do some simple tests on the Config.pm file we have created
 733 unshift(@INC,'lib');
 734 require $Config_PM;
 735 import Config;
 736
 737 die "$0: $Config_PM not valid"
 738         unless $Config{'PERL_CONFIG_SH'} eq 'true';
 739
 740 die "$0: error processing $Config_PM"
 741         if defined($Config{'an impossible name'})
 742         or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache
 743         ;
 744
 745 die "$0: error processing $Config_PM"
 746         if eval '$Config{"cc"} = 1'
 747         or eval 'delete $Config{"cc"}'
 748         ;
 749
 750
 751 exit 0;
 752 # Popularity of various entries in %Config, based on a large build and test
 753 # run of code in the Fotango build system:
 754 __DATA__
 755 path_sep:       8490
 756 d_readlink:     7101
 757 d_symlink:      7101
 758 archlibexp:     4318
 759 sitearchexp:    4305
 760 sitelibexp:     4305
 761 privlibexp:     4163
 762 ldlibpthname:   4041
 763 libpth: 2134
 764 archname:       1591
 765 exe_ext:        1256
 766 scriptdir:      1155
 767 version:        1116
 768 useithreads:    1002
 769 osvers: 982
 770 osname: 851
 771 inc_version_list:       783
 772 dont_use_nlink: 779
 773 intsize:        759
 774 usevendorprefix:        642
 775 dlsrc:  624
 776 cc:     541
 777 lib_ext:        520
 778 so:     512
 779 ld:     501
 780 ccdlflags:      500
 781 ldflags:        495
 782 obj_ext:        495
 783 cccdlflags:     493
 784 lddlflags:      493
 785 ar:     492
 786 dlext:  492
 787 libc:   492
 788 ranlib: 492
 789 full_ar:        491
 790 vendorarchexp:  491
 791 vendorlibexp:   491
 792 installman1dir: 489
 793 installman3dir: 489
 794 installsitebin: 489
 795 installsiteman1dir:     489
 796 installsiteman3dir:     489
 797 installvendorman1dir:   489
 798 installvendorman3dir:   489
 799 d_flexfnam:     474
 800 eunicefix:      360
 801 d_link: 347
 802 installsitearch:        344
 803 installscript:  341
 804 installprivlib: 337
 805 binexp: 336
 806 installarchlib: 336
 807 installprefixexp:       336
 808 installsitelib: 336
 809 installstyle:   336
 810 installvendorarch:      336
 811 installvendorbin:       336
 812 installvendorlib:       336
 813 man1ext:        336
 814 man3ext:        336
 815 sh:     336
 816 siteprefixexp:  336
 817 installbin:     335
 818 usedl:  332
 819 ccflags:        285
 820 startperl:      232
 821 optimize:       231
 822 usemymalloc:    229
 823 cpprun: 228
 824 sharpbang:      228
 825 perllibs:       225
 826 usesfio:        224
 827 usethreads:     220
 828 perlpath:       218
 829 extensions:     217
 830 usesocks:       208
 831 shellflags:     198
 832 make:   191
 833 d_pwage:        189
 834 d_pwchange:     189
 835 d_pwclass:      189
 836 d_pwcomment:    189
 837 d_pwexpire:     189
 838 d_pwgecos:      189
 839 d_pwpasswd:     189
 840 d_pwquota:      189
 841 gccversion:     189
 842 libs:   186
 843 useshrplib:     186
 844 cppflags:       185
 845 ptrsize:        185
 846 shrpenv:        185
 847 static_ext:     185
 848 use5005threads: 185
 849 uselargefiles:  185
 850 alignbytes:     184
 851 byteorder:      184
 852 ccversion:      184
 853 config_args:    184
 854 cppminus:       184