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