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