configpm

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