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