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