configpm

   1 #!./miniperl -w
   2 #
   3 # configpm
   4 #
   5 # Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
   6 # 2002, 2003, 2004, 2005, 2006, 2007 Larry Wall and others.
   7 #
   8 #
   9 # Regenerate the files
  10 #
  11 #    lib/Config.pm
  12 #    lib/Config_heavy.pl
  13 #    lib/Config.pod
  14 #    lib/Cross.pm (optionally)
  15 #
  16 #
  17 # from the contents of the static files
  18 #
  19 #    Porting/Glossary
  20 #    myconfig.SH
  21 #
  22 # and from the contents of the Configure-generated file
  23 #
  24 #    config.sh
  25 #
  26 # Note that output directory is xlib/[cross-name]/ for cross-compiling
  27 #
  28 # It will only update Config.pm and Config_heavy.pl if the contents of
  29 # either file would be different. Note that *both* files are updated in
  30 # this case, since for example an extension makefile that has a dependency
  31 # on Config.pm should trigger even if only Config_heavy.pl has changed.
  32
  33 sub usage { die <<EOF }
  34 usage: $0  [ options ]
  35     --cross=PLATFORM    cross-compile for a different platform
  36     --no-glossary       don't include Porting/Glossary in lib/Config.pod
  37     --chdir=dir         change directory before writing files
  38 EOF
  39
  40 use strict;
  41 use vars qw(%Config $Config_SH_expanded);
  42
  43 my $how_many_common = 22;
  44
  45 # commonly used names to precache (and hence lookup fastest)
  46 my %Common;
  47
  48 while ($how_many_common--) {
  49     $_ = <DATA>;
  50     chomp;
  51     /^(\S+):\s*(\d+)$/ or die "Malformed line '$_'";
  52     $Common{$1} = $1;
  53 }
  54
  55 # names of things which may need to have slashes changed to double-colons
  56 my %Extensions = map {($_,$_)}
  57                  qw(dynamic_ext static_ext extensions known_extensions);
  58
  59 # allowed opts as well as specifies default and initial values
  60 my %Allowed_Opts = (
  61     'cross'    => '', # --cross=PLATFORM - crosscompiling for PLATFORM
  62     'glossary' => 1,  # --no-glossary  - no glossary file inclusion,
  63                       #                  for compactness
  64     'chdir'    => '', # --chdir=dir    - change directory before writing files
  65 );
  66
  67 sub opts {
  68     # user specified options
  69     my %given_opts = (
  70         # --opt=smth
  71         (map {/^--([\-_\w]+)=(.*)$/} @ARGV),
  72         # --opt --no-opt --noopt
  73         (map {/^no-?(.*)$/i?($1=>0):($_=>1)} map {/^--([\-_\w]+)$/} @ARGV),
  74     );
  75
  76     my %opts = (%Allowed_Opts, %given_opts);
  77
  78     for my $opt (grep {!exists $Allowed_Opts{$_}} keys %given_opts) {
  79         warn "option '$opt' is not recognized";
  80         usage;
  81     }
  82     @ARGV = grep {!/^--/} @ARGV;
  83
  84     return %opts;
  85 }
  86
  87
  88 my %Opts = opts();
  89
  90 if ($Opts{chdir}) {
  91     chdir $Opts{chdir} or die "$0: could not chdir $Opts{chdir}: $!"
  92 }
  93
  94 my ($Config_SH, $Config_PM, $Config_heavy, $Config_POD);
  95 my $Glossary = 'Porting/Glossary';
  96
  97 if ($Opts{cross}) {
  98   # creating cross-platform config file
  99   mkdir "xlib";
 100   mkdir "xlib/$Opts{cross}";
 101   $Config_PM = "xlib/$Opts{cross}/Config.pm";
 102   $Config_POD = "xlib/$Opts{cross}/Config.pod";
 103   $Config_SH = "Cross/config-$Opts{cross}.sh";
 104 }
 105 else {
 106   $Config_PM = "lib/Config.pm";
 107   $Config_POD = "lib/Config.pod";
 108   $Config_SH = "config.sh";
 109 }
 110 ($Config_heavy = $Config_PM) =~ s/\.pm$/_heavy.pl/;
 111 die "Can't automatically determine name for Config_heavy.pl from '$Config_PM'"
 112   if $Config_heavy eq $Config_PM;
 113
 114 my $config_txt;
 115 my $heavy_txt;
 116
 117 $heavy_txt .= <<'ENDOFBEG';
 118 # This file was created by configpm when Perl was built. Any changes
 119 # made to this file will be lost the next time perl is built.
 120
 121 package Config;
 122 use strict;
 123 # use warnings; Pulls in Carp
 124 # use vars pulls in Carp
 125
 126 sub _V {
 127     my ($bincompat, $non_bincompat, $date, @patches) = Internals::V();
 128
 129     my $opts = join ' ', sort split ' ', "$bincompat $non_bincompat";
 130
 131     # wrap at 76 columns.
 132
 133     $opts =~ s/(?=.{53})(.{1,53}) /$1\n                        /mg;
 134
 135     print Config::myconfig();
 136     if ($^O eq 'VMS') {
 137         print "\nCharacteristics of this PERLSHR image: \n";
 138     } else {
 139         print "\nCharacteristics of this binary (from libperl): \n";
 140     }
 141
 142     print "  Compile-time options: $opts\n";
 143
 144     if (@patches) {
 145         print "  Locally applied patches:\n";
 146         print "\t$_\n" foreach @patches;
 147     }
 148
 149     print "  Built under $^O\n";
 150
 151     print "  $date\n" if defined $date;
 152
 153     my @env = map { "$_=\"$ENV{$_}\"" } sort grep {/^PERL/} keys %ENV;
 154     push @env, "CYGWIN=\"$ENV{CYGWIN}\"" if $^O eq 'cygwin';
 155
 156     if (@env) {
 157         print "  \%ENV:\n";
 158         print "    $_\n" foreach @env;
 159     }
 160     print "  \@INC:\n";
 161     print "    $_\n" foreach @INC;
 162 }
 163
 164 ENDOFBEG
 165
 166 my $myver = sprintf "%vd", $^V;
 167
 168 $config_txt .= sprintf <<'ENDOFBEG', ($myver) x 3;
 169 # This file was created by configpm when Perl was built. Any changes
 170 # made to this file will be lost the next time perl is built.
 171
 172 # for a description of the variables, please have a look at the
 173 # Glossary file, as written in the Porting folder, or use the url:
 174 # http://perl5.git.perl.org/perl.git/blob/HEAD:/Porting/Glossary
 175
 176 package Config;
 177 use strict;
 178 # use warnings; Pulls in Carp
 179 # use vars pulls in Carp
 180 @Config::EXPORT = qw(%%Config);
 181 @Config::EXPORT_OK = qw(myconfig config_sh config_vars config_re);
 182
 183 # Need to stub all the functions to make code such as print Config::config_sh
 184 # keep working
 185
 186 sub myconfig;
 187 sub config_sh;
 188 sub config_vars;
 189 sub config_re;
 190
 191 # Skip @Config::EXPORT because it only contains %%Config, which we special
 192 # case below as it's not a function. @Config::EXPORT won't change in the
 193 # lifetime of Perl 5.
 194 my %%Export_Cache = map {($_ => 1)} @Config::EXPORT_OK;
 195
 196 our %%Config;
 197
 198 # Define our own import method to avoid pulling in the full Exporter:
 199 sub import {
 200     shift;
 201     @_ = @Config::EXPORT unless @_;
 202
 203     my @funcs = grep $_ ne '%%Config', @_;
 204     my $export_Config = @funcs < @_ ? 1 : 0;
 205
 206     no strict 'refs';
 207     my $callpkg = caller(0);
 208     foreach my $func (@funcs) {
 209         die qq{"$func" is not exported by the Config module\n}
 210             unless $Export_Cache{$func};
 211         *{$callpkg.'::'.$func} = \&{$func};
 212     }
 213
 214     *{"$callpkg\::Config"} = \%%Config if $export_Config;
 215     return;
 216 }
 217
 218 die "Perl lib version (%s) doesn't match executable version ($])"
 219     unless $^V;
 220
 221 $^V eq %s
 222     or die "Perl lib version (%s) doesn't match executable version (" .
 223         sprintf("v%%vd",$^V) . ")";
 224
 225 ENDOFBEG
 226
 227
 228 my @non_v    = ();
 229 my @v_others = ();
 230 my $in_v     = 0;
 231 my %Data     = ();
 232
 233
 234 my %seen_quotes;
 235 {
 236   my ($name, $val);
 237   open(CONFIG_SH, $Config_SH) || die "Can't open $Config_SH: $!";
 238   while (<CONFIG_SH>) {
 239     next if m:^#!/bin/sh:;
 240
 241     # Catch PERL_CONFIG_SH=true and PERL_VERSION=n line from Configure.
 242     s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/ or m/^(\w+)='(.*)'$/;
 243     my($k, $v) = ($1, $2);
 244
 245     # grandfather PATCHLEVEL and SUBVERSION and CONFIG
 246     if ($k) {
 247         if ($k eq 'PERL_VERSION') {
 248             push @v_others, "PATCHLEVEL='$v'\n";
 249         }
 250         elsif ($k eq 'PERL_SUBVERSION') {
 251             push @v_others, "SUBVERSION='$v'\n";
 252         }
 253         elsif ($k eq 'PERL_CONFIG_SH') {
 254             push @v_others, "CONFIG='$v'\n";
 255         }
 256     }
 257
 258     # We can delimit things in config.sh with either ' or ".
 259     unless ($in_v or m/^(\w+)=(['"])(.*\n)/){
 260         push(@non_v, "#$_"); # not a name='value' line
 261         next;
 262     }
 263     my $quote = $2;
 264     if ($in_v) {
 265         $val .= $_;
 266     }
 267     else {
 268         ($name,$val) = ($1,$3);
 269     }
 270     $in_v = $val !~ /$quote\n/;
 271     next if $in_v;
 272
 273     s,/,::,g if $Extensions{$name};
 274
 275     $val =~ s/$quote\n?\z//;
 276
 277     my $line = "$name=$quote$val$quote\n";
 278     push(@v_others, $line);
 279     $seen_quotes{$quote}++;
 280   }
 281   close CONFIG_SH;
 282 }
 283
 284 # This is somewhat grim, but I want the code for parsing config.sh here and
 285 # now so that I can expand $Config{ivsize} and $Config{ivtype}
 286
 287 my $fetch_string = <<'EOT';
 288
 289 # Search for it in the big string
 290 sub fetch_string {
 291     my($self, $key) = @_;
 292
 293 EOT
 294
 295 if ($seen_quotes{'"'}) {
 296     # We need the full ' and " code
 297
 298 $fetch_string .= <<'EOT';
 299     return undef unless my ($quote_type, $value) = $Config_SH_expanded =~ /\n$key=(['"])(.*?)\1\n/s;
 300
 301     # If we had a double-quote, we'd better eval it so escape
 302     # sequences and such can be interpolated. Since the incoming
 303     # value is supposed to follow shell rules and not perl rules,
 304     # we escape any perl variable markers
 305
 306     # Historically, since " 'support' was added in change 1409, the
 307     # interpolation was done before the undef. Stick to this arguably buggy
 308     # behaviour as we're refactoring.
 309     if ($quote_type eq '"') {
 310         $value =~ s/\$/\\\$/g;
 311         $value =~ s/\@/\\\@/g;
 312         eval "\$value = \"$value\"";
 313     }
 314
 315     # So we can say "if $Config{'foo'}".
 316     $self->{$key} = $value eq 'undef' ? undef : $value; # cache it
 317 }
 318 EOT
 319
 320 } else {
 321     # We only have ' delimted.
 322
 323 $fetch_string .= <<'EOT';
 324     return undef unless $Config_SH_expanded =~ /\n$key=\'(.*?)\'\n/s;
 325     # So we can say "if $Config{'foo'}".
 326     $self->{$key} = $1 eq 'undef' ? undef : $1;
 327 }
 328 EOT
 329
 330 }
 331
 332 eval $fetch_string;
 333 die if $@;
 334
 335 # Calculation for the keys for byteorder
 336 # This is somewhat grim, but I need to run fetch_string here.
 337 our $Config_SH_expanded = join "\n", '', @v_others;
 338
 339 my $t = fetch_string ({}, 'ivtype');
 340 my $s = fetch_string ({}, 'ivsize');
 341
 342 # byteorder does exist on its own but we overlay a virtual
 343 # dynamically recomputed value.
 344
 345 # However, ivtype and ivsize will not vary for sane fat binaries
 346
 347 my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
 348
 349 my $byteorder_code;
 350 if ($s == 4 || $s == 8) {
 351     my $list = join ',', reverse(2..$s);
 352     my $format = 'a'x$s;
 353     $byteorder_code = <<"EOT";
 354
 355 my \$i = 0;
 356 foreach my \$c ($list) { \$i |= ord(\$c); \$i <<= 8 }
 357 \$i |= ord(1);
 358 our \$byteorder = join('', unpack('$format', pack('$f', \$i)));
 359 EOT
 360 } else {
 361     $byteorder_code = "our \$byteorder = '?'x$s;\n";
 362 }
 363
 364 my @need_relocation;
 365
 366 if (fetch_string({},'userelocatableinc')) {
 367     foreach my $what (qw(prefixexp
 368
 369                          archlibexp
 370                          html1direxp
 371                          html3direxp
 372                          man1direxp
 373                          man3direxp
 374                          privlibexp
 375                          scriptdirexp
 376                          sitearchexp
 377                          sitebinexp
 378                          sitehtml1direxp
 379                          sitehtml3direxp
 380                          sitelibexp
 381                          siteman1direxp
 382                          siteman3direxp
 383                          sitescriptexp
 384                          vendorarchexp
 385                          vendorbinexp
 386                          vendorhtml1direxp
 387                          vendorhtml3direxp
 388                          vendorlibexp
 389                          vendorman1direxp
 390                          vendorman3direxp
 391                          vendorscriptexp
 392
 393                          siteprefixexp
 394                          sitelib_stem
 395                          vendorlib_stem
 396
 397                          installarchlib
 398                          installhtml1dir
 399                          installhtml3dir
 400                          installman1dir
 401                          installman3dir
 402                          installprefix
 403                          installprefixexp
 404                          installprivlib
 405                          installscript
 406                          installsitearch
 407                          installsitebin
 408                          installsitehtml1dir
 409                          installsitehtml3dir
 410                          installsitelib
 411                          installsiteman1dir
 412                          installsiteman3dir
 413                          installsitescript
 414                          installvendorarch
 415                          installvendorbin
 416                          installvendorhtml1dir
 417                          installvendorhtml3dir
 418                          installvendorlib
 419                          installvendorman1dir
 420                          installvendorman3dir
 421                          installvendorscript
 422                          )) {
 423         push @need_relocation, $what if fetch_string({}, $what) =~ m!^\.\.\./!;
 424     }
 425 }
 426
 427 my %need_relocation;
 428 @need_relocation{@need_relocation} = @need_relocation;
 429
 430 # This can have .../ anywhere:
 431 if (fetch_string({}, 'otherlibdirs') =~ m!\.\.\./!) {
 432     $need_relocation{otherlibdirs} = 'otherlibdirs';
 433 }
 434
 435 my $relocation_code = <<'EOT';
 436
 437 sub relocate_inc {
 438   my $libdir = shift;
 439   return $libdir unless $libdir =~ s!^\.\.\./!!;
 440   my $prefix = $^X;
 441   if ($prefix =~ s!/[^/]*$!!) {
 442     while ($libdir =~ m!^\.\./!) {
 443       # Loop while $libdir starts "../" and $prefix still has a trailing
 444       # directory
 445       last unless $prefix =~ s!/([^/]+)$!!;
 446       # but bail out if the directory we picked off the end of $prefix is .
 447       # or ..
 448       if ($1 eq '.' or $1 eq '..') {
 449         # Undo! This should be rare, hence code it this way rather than a
 450         # check each time before the s!!! above.
 451         $prefix = "$prefix/$1";
 452         last;
 453       }
 454       # Remove that leading ../ and loop again
 455       substr ($libdir, 0, 3, '');
 456     }
 457     $libdir = "$prefix/$libdir";
 458   }
 459   $libdir;
 460 }
 461 EOT
 462
 463 if (%need_relocation) {
 464   my $relocations_in_common;
 465   # otherlibdirs only features in the hash
 466   foreach (keys %need_relocation) {
 467     $relocations_in_common++ if $Common{$_};
 468   }
 469   if ($relocations_in_common) {
 470     $config_txt .= $relocation_code;
 471   } else {
 472     $heavy_txt .= $relocation_code;
 473   }
 474 }
 475
 476 $heavy_txt .= join('', @non_v) . "\n";
 477
 478 # copy config summary format from the myconfig.SH script
 479 $heavy_txt .= "our \$summary = <<'!END!';\n";
 480 open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
 481 1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
 482 do { $heavy_txt .= $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
 483 close(MYCONFIG);
 484
 485 $heavy_txt .= "\n!END!\n" . <<'EOT';
 486 my $summary_expanded;
 487
 488 sub myconfig {
 489     return $summary_expanded if $summary_expanded;
 490     ($summary_expanded = $summary) =~ s{\$(\w+)}
 491                  {
 492                         my $c;
 493                         if ($1 eq 'git_ancestor_line') {
 494                                 if ($Config::Config{git_ancestor}) {
 495                                         $c= "\n  Ancestor: $Config::Config{git_ancestor}";
 496                                 } else {
 497                                         $c= "";
 498                                 }
 499                         } else {
 500                                 $c = $Config::Config{$1};
 501                         }
 502                         defined($c) ? $c : 'undef'
 503                 }ge;
 504     $summary_expanded;
 505 }
 506
 507 local *_ = \my $a;
 508 $_ = <<'!END!';
 509 EOT
 510
 511 $heavy_txt .= join('', sort @v_others) . "!END!\n";
 512
 513 # Only need the dynamic byteorder code in Config.pm if 'byteorder' is one of
 514 # the precached keys
 515 if ($Common{byteorder}) {
 516     $config_txt .= $byteorder_code;
 517 } else {
 518     $heavy_txt .= $byteorder_code;
 519 }
 520
 521 if (@need_relocation) {
 522 $heavy_txt .= 'foreach my $what (qw(' . join (' ', @need_relocation) .
 523       ")) {\n" . <<'EOT';
 524     s/^($what=)(['"])(.*?)\2/$1 . $2 . relocate_inc($3) . $2/me;
 525 }
 526 EOT
 527 # Currently it only makes sense to do the ... relocation on Unix, so there's
 528 # no need to emulate the "which separator for this platform" logic in perl.c -
 529 # ':' will always be applicable
 530 if ($need_relocation{otherlibdirs}) {
 531 $heavy_txt .= << 'EOT';
 532 s{^(otherlibdirs=)(['"])(.*?)\2}
 533  {$1 . $2 . join ':', map {relocate_inc($_)} split ':', $3 . $2}me;
 534 EOT
 535 }
 536 }
 537
 538 $heavy_txt .= <<'EOT';
 539 s/(byteorder=)(['"]).*?\2/$1$2$Config::byteorder$2/m;
 540
 541 my $config_sh_len = length $_;
 542
 543 our $Config_SH_expanded = "\n$_" . << 'EOVIRTUAL';
 544 EOT
 545
 546 foreach my $prefix (qw(ccflags ldflags)) {
 547     my $value = fetch_string ({}, $prefix);
 548     my $withlargefiles = fetch_string ({}, $prefix . "_uselargefiles");
 549     if (defined $withlargefiles) {
 550         $value =~ s/\Q$withlargefiles\E\b//;
 551         $heavy_txt .= "${prefix}_nolargefiles='$value'\n";
 552     }
 553 }
 554
 555 foreach my $prefix (qw(libs libswanted)) {
 556     my $value = fetch_string ({}, $prefix);
 557     my $withlf = fetch_string ({}, 'libswanted_uselargefiles');
 558     next unless defined $withlf;
 559     my @lflibswanted
 560        = split(' ', fetch_string ({}, 'libswanted_uselargefiles'));
 561     if (@lflibswanted) {
 562         my %lflibswanted;
 563         @lflibswanted{@lflibswanted} = ();
 564         if ($prefix eq 'libs') {
 565             my @libs = grep { /^-l(.+)/ &&
 566                             not exists $lflibswanted{$1} }
 567                                     split(' ', fetch_string ({}, 'libs'));
 568             $value = join(' ', @libs);
 569         } else {
 570             my @libswanted = grep { not exists $lflibswanted{$_} }
 571                                   split(' ', fetch_string ({}, 'libswanted'));
 572             $value = join(' ', @libswanted);
 573         }
 574     }
 575     $heavy_txt .= "${prefix}_nolargefiles='$value'\n";
 576 }
 577
 578 $heavy_txt .= "EOVIRTUAL\n";
 579
 580 $heavy_txt .= <<'ENDOFGIT';
 581 eval {
 582         # do not have hairy conniptions if this isnt available
 583         require 'Config_git.pl';
 584         $Config_SH_expanded .= $Config::Git_Data;
 585         1;
 586 } or warn "Warning: failed to load Config_git.pl, something strange about this perl...\n";
 587 ENDOFGIT
 588
 589 $heavy_txt .= $fetch_string;
 590
 591 $config_txt .= <<'ENDOFEND';
 592
 593 sub FETCH {
 594     my($self, $key) = @_;
 595
 596     # check for cached value (which may be undef so we use exists not defined)
 597     return $self->{$key} if exists $self->{$key};
 598
 599     return $self->fetch_string($key);
 600 }
 601 ENDOFEND
 602
 603 $heavy_txt .= <<'ENDOFEND';
 604
 605 my $prevpos = 0;
 606
 607 sub FIRSTKEY {
 608     $prevpos = 0;
 609     substr($Config_SH_expanded, 1, index($Config_SH_expanded, '=') - 1 );
 610 }
 611
 612 sub NEXTKEY {
 613 ENDOFEND
 614 if ($seen_quotes{'"'}) {
 615 $heavy_txt .= <<'ENDOFEND';
 616     # Find out how the current key's quoted so we can skip to its end.
 617     my $quote = substr($Config_SH_expanded,
 618                        index($Config_SH_expanded, "=", $prevpos)+1, 1);
 619     my $pos = index($Config_SH_expanded, qq($quote\n), $prevpos) + 2;
 620 ENDOFEND
 621 } else {
 622     # Just ' quotes, so it's much easier.
 623 $heavy_txt .= <<'ENDOFEND';
 624     my $pos = index($Config_SH_expanded, qq('\n), $prevpos) + 2;
 625 ENDOFEND
 626 }
 627 $heavy_txt .= <<'ENDOFEND';
 628     my $len = index($Config_SH_expanded, "=", $pos) - $pos;
 629     $prevpos = $pos;
 630     $len > 0 ? substr($Config_SH_expanded, $pos, $len) : undef;
 631 }
 632
 633 sub EXISTS {
 634     return 1 if exists($_[0]->{$_[1]});
 635
 636     return(index($Config_SH_expanded, "\n$_[1]='") != -1
 637 ENDOFEND
 638 if ($seen_quotes{'"'}) {
 639 $heavy_txt .= <<'ENDOFEND';
 640            or index($Config_SH_expanded, "\n$_[1]=\"") != -1
 641 ENDOFEND
 642 }
 643 $heavy_txt .= <<'ENDOFEND';
 644           );
 645 }
 646
 647 sub STORE  { die "\%Config::Config is read-only\n" }
 648 *DELETE = \&STORE;
 649 *CLEAR  = \&STORE;
 650
 651
 652 sub config_sh {
 653     substr $Config_SH_expanded, 1, $config_sh_len;
 654 }
 655
 656 sub config_re {
 657     my $re = shift;
 658     return map { chomp; $_ } grep eval{ /^(?:$re)=/ }, split /^/,
 659     $Config_SH_expanded;
 660 }
 661
 662 sub config_vars {
 663     # implements -V:cfgvar option (see perlrun -V:)
 664     foreach (@_) {
 665         # find optional leading, trailing colons; and query-spec
 666         my ($notag,$qry,$lncont) = m/^(:)?(.*?)(:)?$/;  # flags fore and aft,
 667         # map colon-flags to print decorations
 668         my $prfx = $notag ? '': "$qry=";                # tag-prefix for print
 669         my $lnend = $lncont ? ' ' : ";\n";              # line ending for print
 670
 671         # all config-vars are by definition \w only, any \W means regex
 672         if ($qry =~ /\W/) {
 673             my @matches = config_re($qry);
 674             print map "$_$lnend", @matches ? @matches : "$qry: not found"               if !$notag;
 675             print map { s/\w+=//; "$_$lnend" } @matches ? @matches : "$qry: not found"  if  $notag;
 676         } else {
 677             my $v = (exists $Config::Config{$qry}) ? $Config::Config{$qry}
 678                                                    : 'UNKNOWN';
 679             $v = 'undef' unless defined $v;
 680             print "${prfx}'${v}'$lnend";
 681         }
 682     }
 683 }
 684
 685 # Called by the real AUTOLOAD
 686 sub launcher {
 687     undef &AUTOLOAD;
 688     goto \&$Config::AUTOLOAD;
 689 }
 690
 691 1;
 692 ENDOFEND
 693
 694 if ($^O eq 'os2') {
 695     $config_txt .= <<'ENDOFSET';
 696 my %preconfig;
 697 if ($OS2::is_aout) {
 698     my ($value, $v) = $Config_SH_expanded =~ m/^used_aout='(.*)'\s*$/m;
 699     for (split ' ', $value) {
 700         ($v) = $Config_SH_expanded =~ m/^aout_$_='(.*)'\s*$/m;
 701         $preconfig{$_} = $v eq 'undef' ? undef : $v;
 702     }
 703 }
 704 $preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't
 705 sub TIEHASH { bless {%preconfig} }
 706 ENDOFSET
 707     # Extract the name of the DLL from the makefile to avoid duplication
 708     my ($f) = grep -r, qw(GNUMakefile Makefile);
 709     my $dll;
 710     if (open my $fh, '<', $f) {
 711         while (<$fh>) {
 712             $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
 713         }
 714     }
 715     $config_txt .= <<ENDOFSET if $dll;
 716 \$preconfig{dll_name} = '$dll';
 717 ENDOFSET
 718 } else {
 719     $config_txt .= <<'ENDOFSET';
 720 sub TIEHASH {
 721     bless $_[1], $_[0];
 722 }
 723 ENDOFSET
 724 }
 725
 726 foreach my $key (keys %Common) {
 727     my $value = fetch_string ({}, $key);
 728     # Is it safe on the LHS of => ?
 729     my $qkey = $key =~ /^[A-Za-z_][A-Za-z0-9_]*$/ ? $key : "'$key'";
 730     if (defined $value) {
 731         # Quote things for a '' string
 732         $value =~ s!\\!\\\\!g;
 733         $value =~ s!'!\\'!g;
 734         $value = "'$value'";
 735         if ($key eq 'otherlibdirs') {
 736             $value = "join (':', map {relocate_inc(\$_)} split (':', $value))";
 737         } elsif ($need_relocation{$key}) {
 738             $value = "relocate_inc($value)";
 739         }
 740     } else {
 741         $value = "undef";
 742     }
 743     $Common{$key} = "$qkey => $value";
 744 }
 745
 746 if ($Common{byteorder}) {
 747     $Common{byteorder} = 'byteorder => $byteorder';
 748 }
 749 my $fast_config = join '', map { "    $_,\n" } sort values %Common;
 750
 751 # Sanity check needed to stop an infite loop if Config_heavy.pl fails to define
 752 # &launcher for some reason (eg it got truncated)
 753 $config_txt .= sprintf <<'ENDOFTIE', $fast_config;
 754
 755 sub DESTROY { }
 756
 757 sub AUTOLOAD {
 758     require 'Config_heavy.pl';
 759     goto \&launcher unless $Config::AUTOLOAD =~ /launcher$/;
 760     die "&Config::AUTOLOAD failed on $Config::AUTOLOAD";
 761 }
 762
 763 # tie returns the object, so the value returned to require will be true.
 764 tie %%Config, 'Config', {
 765 %s};
 766 ENDOFTIE
 767
 768
 769 open(CONFIG_POD, ">$Config_POD") or die "Can't open $Config_POD: $!";
 770 print CONFIG_POD <<'ENDOFTAIL';
 771 =head1 NAME
 772
 773 Config - access Perl configuration information
 774
 775 =head1 SYNOPSIS
 776
 777     use Config;
 778     if ($Config{usethreads}) {
 779         print "has thread support\n"
 780     }
 781
 782     use Config qw(myconfig config_sh config_vars config_re);
 783
 784     print myconfig();
 785
 786     print config_sh();
 787
 788     print config_re();
 789
 790     config_vars(qw(osname archname));
 791
 792
 793 =head1 DESCRIPTION
 794
 795 The Config module contains all the information that was available to
 796 the C<Configure> program at Perl build time (over 900 values).
 797
 798 Shell variables from the F<config.sh> file (written by Configure) are
 799 stored in the readonly-variable C<%Config>, indexed by their names.
 800
 801 Values stored in config.sh as 'undef' are returned as undefined
 802 values.  The perl C<exists> function can be used to check if a
 803 named variable exists.
 804
 805 For a description of the variables, please have a look at the
 806 Glossary file, as written in the Porting folder, or use the url:
 807 http://perl5.git.perl.org/perl.git/blob/HEAD:/Porting/Glossary
 808
 809 =over 4
 810
 811 =item myconfig()
 812
 813 Returns a textual summary of the major perl configuration values.
 814 See also C<-V> in L<perlrun/Switches>.
 815
 816 =item config_sh()
 817
 818 Returns the entire perl configuration information in the form of the
 819 original config.sh shell variable assignment script.
 820
 821 =item config_re($regex)
 822
 823 Like config_sh() but returns, as a list, only the config entries who's
 824 names match the $regex.
 825
 826 =item config_vars(@names)
 827
 828 Prints to STDOUT the values of the named configuration variable. Each is
 829 printed on a separate line in the form:
 830
 831   name='value';
 832
 833 Names which are unknown are output as C<name='UNKNOWN';>.
 834 See also C<-V:name> in L<perlrun/Switches>.
 835
 836 =back
 837
 838 =head1 EXAMPLE
 839
 840 Here's a more sophisticated example of using %Config:
 841
 842     use Config;
 843     use strict;
 844
 845     my %sig_num;
 846     my @sig_name;
 847     unless($Config{sig_name} && $Config{sig_num}) {
 848         die "No sigs?";
 849     } else {
 850         my @names = split ' ', $Config{sig_name};
 851         @sig_num{@names} = split ' ', $Config{sig_num};
 852         foreach (@names) {
 853             $sig_name[$sig_num{$_}] ||= $_;
 854         }
 855     }
 856
 857     print "signal #17 = $sig_name[17]\n";
 858     if ($sig_num{ALRM}) {
 859         print "SIGALRM is $sig_num{ALRM}\n";
 860     }
 861
 862 =head1 WARNING
 863
 864 Because this information is not stored within the perl executable
 865 itself it is possible (but unlikely) that the information does not
 866 relate to the actual perl binary which is being used to access it.
 867
 868 The Config module is installed into the architecture and version
 869 specific library directory ($Config{installarchlib}) and it checks the
 870 perl version number when loaded.
 871
 872 The values stored in config.sh may be either single-quoted or
 873 double-quoted. Double-quoted strings are handy for those cases where you
 874 need to include escape sequences in the strings. To avoid runtime variable
 875 interpolation, any C<$> and C<@> characters are replaced by C<\$> and
 876 C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
 877 or C<\@> in double-quoted strings unless you're willing to deal with the
 878 consequences. (The slashes will end up escaped and the C<$> or C<@> will
 879 trigger variable interpolation)
 880
 881 =head1 GLOSSARY
 882
 883 Most C<Config> variables are determined by the C<Configure> script
 884 on platforms supported by it (which is most UNIX platforms).  Some
 885 platforms have custom-made C<Config> variables, and may thus not have
 886 some of the variables described below, or may have extraneous variables
 887 specific to that particular port.  See the port specific documentation
 888 in such cases.
 889
 890 =cut
 891
 892 ENDOFTAIL
 893
 894 if ($Opts{glossary}) {
 895   open(GLOS, "<$Glossary") or die "Can't open $Glossary: $!";
 896 }
 897 my %seen = ();
 898 my $text = 0;
 899 $/ = '';
 900
 901 sub process {
 902   if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
 903     my $c = substr $1, 0, 1;
 904     unless ($seen{$c}++) {
 905       print CONFIG_POD <<EOF if $text;
 906 =back
 907
 908 =cut
 909
 910 EOF
 911       print CONFIG_POD <<EOF;
 912 =head2 $c
 913
 914 =over 4
 915
 916 =cut
 917
 918 EOF
 919      $text = 1;
 920     }
 921   }
 922   elsif (!$text || !/\A\t/) {
 923     warn "Expected a Configure variable header",
 924       ($text ? " or another paragraph of description" : () );
 925   }
 926   s/n't/n\00t/g;                # leave can't, won't etc untouched
 927   s/^\t\s+(.*)/\n$1/gm;         # Indented lines ===> new paragraph
 928   s/^(?<!\n\n)\t(.*)/$1/gm;     # Not indented lines ===> text
 929   s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
 930   s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
 931   s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
 932   s{
 933      (?<! [\w./<\'\"] )         # Only standalone file names
 934      (?! e \. g \. )            # Not e.g.
 935      (?! \. \. \. )             # Not ...
 936      (?! \d )                   # Not 5.004
 937      (?! read/ )                # Not read/write
 938      (?! etc\. )                # Not etc.
 939      (?! I/O )                  # Not I/O
 940      (
 941         \$ ?                    # Allow leading $
 942         [\w./]* [./] [\w./]*    # Require . or / inside
 943      )
 944      (?<! \. (?= [\s)] ) )      # Do not include trailing dot
 945      (?! [\w/] )                # Include all of it
 946    }
 947    (F<$1>)xg;                   # /usr/local
 948   s/((?<=\s)~\w*)/F<$1>/g;      # ~name
 949   s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g;    # UNISTD
 950   s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
 951   s/n[\0]t/n't/g;               # undo can't, won't damage
 952 }
 953
 954 if ($Opts{glossary}) {
 955     <GLOS>;                             # Skip the "DO NOT EDIT"
 956     <GLOS>;                             # Skip the preamble
 957   while (<GLOS>) {
 958     process;
 959     print CONFIG_POD;
 960   }
 961 }
 962
 963 print CONFIG_POD <<'ENDOFTAIL';
 964
 965 =back
 966
 967 =head1 GIT DATA
 968
 969 Information on the git commit from which the current perl binary was compiled
 970 can be found in the variable C<$Config::Git_Data>.  The variable is a
 971 structured string that looks something like this:
 972
 973   git_commit_id='ea0c2dbd5f5ac6845ecc7ec6696415bf8e27bd52'
 974   git_describe='GitLive-blead-1076-gea0c2db'
 975   git_branch='smartmatch'
 976   git_uncommitted_changes=''
 977   git_commit_id_title='Commit id:'
 978   git_commit_date='2009-05-09 17:47:31 +0200'
 979
 980 Its format is not guaranteed not to change over time.
 981
 982 =head1 NOTE
 983
 984 This module contains a good example of how to use tie to implement a
 985 cache and an example of how to make a tied variable readonly to those
 986 outside of it.
 987
 988 =cut
 989
 990 ENDOFTAIL
 991
 992 close(GLOS) if $Opts{glossary};
 993 close(CONFIG_POD);
 994 print "written $Config_POD\n";
 995
 996 my $orig_config_txt = "";
 997 my $orig_heavy_txt = "";
 998 {
 999     local $/;
1000     my $fh;
1001     $orig_config_txt = <$fh> if open $fh, "<", $Config_PM;
1002     $orig_heavy_txt  = <$fh> if open $fh, "<", $Config_heavy;
1003 }
1004
1005 if ($orig_config_txt ne $config_txt or $orig_heavy_txt ne $heavy_txt) {
1006     open CONFIG, ">", $Config_PM or die "Can't open $Config_PM: $!\n";
1007     open CONFIG_HEAVY, ">", $Config_heavy or die "Can't open $Config_heavy: $!\n";
1008     print CONFIG $config_txt;
1009     print CONFIG_HEAVY $heavy_txt;
1010     close(CONFIG_HEAVY);
1011     close(CONFIG);
1012     print "updated $Config_PM\n";
1013     print "updated $Config_heavy\n";
1014 }
1015
1016
1017 # Now create Cross.pm if needed
1018 if ($Opts{cross}) {
1019   open CROSS, ">lib/Cross.pm" or die "Can not open >lib/Cross.pm: $!";
1020   my $cross = <<'EOS';
1021 # typical invocation:
1022 #   perl -MCross Makefile.PL
1023 #   perl -MCross=wince -V:cc
1024 package Cross;
1025
1026 sub import {
1027   my ($package,$platform) = @_;
1028   unless (defined $platform) {
1029     # if $platform is not specified, then use last one when
1030     # 'configpm; was invoked with --cross option
1031     $platform = '***replace-marker***';
1032   }
1033   @INC = map {/\blib\b/?(do{local $_=$_;s/\blib\b/xlib\/$platform/;$_},$_):($_)} @INC;
1034   $::Cross::platform = $platform;
1035 }
1036
1037 1;
1038 EOS
1039   $cross =~ s/\*\*\*replace-marker\*\*\*/$Opts{cross}/g;
1040   print CROSS $cross;
1041   close CROSS;
1042   print "written lib/Cross.pm\n";
1043   unshift(@INC,"xlib/$Opts{cross}");
1044 }
1045
1046 # Now do some simple tests on the Config.pm file we have created
1047 unshift(@INC,'lib');
1048 unshift(@INC,'xlib/symbian') if $Opts{cross};
1049 require $Config_PM;
1050 require $Config_heavy;
1051 import Config;
1052
1053 die "$0: $Config_PM not valid"
1054         unless $Config{'PERL_CONFIG_SH'} eq 'true';
1055
1056 die "$0: error processing $Config_PM"
1057         if defined($Config{'an impossible name'})
1058         or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache
1059         ;
1060
1061 die "$0: error processing $Config_PM"
1062         if eval '$Config{"cc"} = 1'
1063         or eval 'delete $Config{"cc"}'
1064         ;
1065
1066
1067 exit 0;
1068 # Popularity of various entries in %Config, based on a large build and test
1069 # run of code in the Fotango build system:
1070 __DATA__
1071 path_sep:       8490
1072 d_readlink:     7101
1073 d_symlink:      7101
1074 archlibexp:     4318
1075 sitearchexp:    4305
1076 sitelibexp:     4305
1077 privlibexp:     4163
1078 ldlibpthname:   4041
1079 libpth: 2134
1080 archname:       1591
1081 exe_ext:        1256
1082 scriptdir:      1155
1083 version:        1116
1084 useithreads:    1002
1085 osvers: 982
1086 osname: 851
1087 inc_version_list:       783
1088 dont_use_nlink: 779
1089 intsize:        759
1090 usevendorprefix:        642
1091 dlsrc:  624
1092 cc:     541
1093 lib_ext:        520
1094 so:     512
1095 ld:     501
1096 ccdlflags:      500
1097 ldflags:        495
1098 obj_ext:        495
1099 cccdlflags:     493
1100 lddlflags:      493
1101 ar:     492
1102 dlext:  492
1103 libc:   492
1104 ranlib: 492
1105 full_ar:        491
1106 vendorarchexp:  491
1107 vendorlibexp:   491
1108 installman1dir: 489
1109 installman3dir: 489
1110 installsitebin: 489
1111 installsiteman1dir:     489
1112 installsiteman3dir:     489
1113 installvendorman1dir:   489
1114 installvendorman3dir:   489
1115 d_flexfnam:     474
1116 eunicefix:      360
1117 d_link: 347
1118 installsitearch:        344
1119 installscript:  341
1120 installprivlib: 337
1121 binexp: 336
1122 installarchlib: 336
1123 installprefixexp:       336
1124 installsitelib: 336
1125 installstyle:   336
1126 installvendorarch:      336
1127 installvendorbin:       336
1128 installvendorlib:       336
1129 man1ext:        336
1130 man3ext:        336
1131 sh:     336
1132 siteprefixexp:  336
1133 installbin:     335
1134 usedl:  332
1135 ccflags:        285
1136 startperl:      232
1137 optimize:       231
1138 usemymalloc:    229
1139 cpprun: 228
1140 sharpbang:      228
1141 perllibs:       225
1142 usesfio:        224
1143 usethreads:     220
1144 perlpath:       218
1145 extensions:     217
1146 usesocks:       208
1147 shellflags:     198
1148 make:   191
1149 d_pwage:        189
1150 d_pwchange:     189
1151 d_pwclass:      189
1152 d_pwcomment:    189
1153 d_pwexpire:     189
1154 d_pwgecos:      189
1155 d_pwpasswd:     189
1156 d_pwquota:      189
1157 gccversion:     189
1158 libs:   186
1159 useshrplib:     186
1160 cppflags:       185
1161 ptrsize:        185
1162 shrpenv:        185
1163 static_ext:     185
1164 use5005threads: 185
1165 uselargefiles:  185
1166 alignbytes:     184
1167 byteorder:      184
1168 ccversion:      184
1169 config_args:    184
1170 cppminus:       184