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