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