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