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# https://github.com/Perl/perl5/blob/blead/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, '>:raw', $Config_POD) or die "Can't open $Config_POD: $!"; 860print CONFIG_POD <<'ENDOFTAIL'; 861=head1 NAME 862 863=for comment Generated by configpm. Any changes made here will be lost! 864 865Config - access Perl configuration information 866 867=head1 SYNOPSIS 868 869 use Config; 870 if ($Config{usethreads}) { 871 print "has thread support\n" 872 } 873 874 use Config qw(myconfig config_sh config_vars config_re); 875 876 print myconfig(); 877 878 print config_sh(); 879 880 print config_re(); 881 882 config_vars(qw(osname archname)); 883 884 885=head1 DESCRIPTION 886 887The Config module contains all the information that was available to 888the C<Configure> program at Perl build time (over 900 values). 889 890Shell variables from the F<config.sh> file (written by Configure) are 891stored in the readonly-variable C<%Config>, indexed by their names. 892 893Values stored in config.sh as 'undef' are returned as undefined 894values. The perl C<exists> function can be used to check if a 895named variable exists. 896 897For a description of the variables, please have a look at the 898Glossary file, as written in the Porting folder, or use the url: 899https://github.com/Perl/perl5/blob/blead/Porting/Glossary 900 901=over 4 902 903=item myconfig() 904 905Returns a textual summary of the major perl configuration values. 906See also C<-V> in L<perlrun/Command Switches>. 907 908=item config_sh() 909 910Returns the entire perl configuration information in the form of the 911original config.sh shell variable assignment script. 912 913=item config_re($regex) 914 915Like config_sh() but returns, as a list, only the config entries who's 916names match the $regex. 917 918=item config_vars(@names) 919 920Prints to STDOUT the values of the named configuration variable. Each is 921printed on a separate line in the form: 922 923 name='value'; 924 925Names which are unknown are output as C<name='UNKNOWN';>. 926See also C<-V:name> in L<perlrun/Command Switches>. 927 928=item bincompat_options() 929 930Returns a list of C pre-processor options used when compiling this F<perl> 931binary, which affect its binary compatibility with extensions. 932C<bincompat_options()> and C<non_bincompat_options()> are shown together in 933the output of C<perl -V> as I<Compile-time options>. 934 935=item non_bincompat_options() 936 937Returns a list of C pre-processor options used when compiling this F<perl> 938binary, which do not affect binary compatibility with extensions. 939 940=item compile_date() 941 942Returns the compile date (as a string), equivalent to what is shown by 943C<perl -V> 944 945=item local_patches() 946 947Returns a list of the names of locally applied patches, equivalent to what 948is shown by C<perl -V>. 949 950=item header_files() 951 952Returns a list of the header files that should be used as dependencies for 953XS code, for this version of Perl on this platform. 954 955=back 956 957=head1 EXAMPLE 958 959Here's a more sophisticated example of using %Config: 960 961 use Config; 962 use strict; 963 964 my %sig_num; 965 my @sig_name; 966 unless($Config{sig_name} && $Config{sig_num}) { 967 die "No sigs?"; 968 } else { 969 my @names = split ' ', $Config{sig_name}; 970 @sig_num{@names} = split ' ', $Config{sig_num}; 971 foreach (@names) { 972 $sig_name[$sig_num{$_}] ||= $_; 973 } 974 } 975 976 print "signal #17 = $sig_name[17]\n"; 977 if ($sig_num{ALRM}) { 978 print "SIGALRM is $sig_num{ALRM}\n"; 979 } 980 981=head1 WARNING 982 983Because this information is not stored within the perl executable 984itself it is possible (but unlikely) that the information does not 985relate to the actual perl binary which is being used to access it. 986 987The Config module is installed into the architecture and version 988specific library directory ($Config{installarchlib}) and it checks the 989perl version number when loaded. 990 991The values stored in config.sh may be either single-quoted or 992double-quoted. Double-quoted strings are handy for those cases where you 993need to include escape sequences in the strings. To avoid runtime variable 994interpolation, any C<$> and C<@> characters are replaced by C<\$> and 995C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$> 996or C<\@> in double-quoted strings unless you're willing to deal with the 997consequences. (The slashes will end up escaped and the C<$> or C<@> will 998trigger variable interpolation) 999 1000=head1 GLOSSARY 1001 1002Most C<Config> variables are determined by the C<Configure> script 1003on platforms supported by it (which is most UNIX platforms). Some 1004platforms have custom-made C<Config> variables, and may thus not have 1005some of the variables described below, or may have extraneous variables 1006specific to that particular port. See the port specific documentation 1007in such cases. 1008 1009=cut 1010 1011ENDOFTAIL 1012 1013if ($Opts{glossary}) { 1014 open(GLOS, '<', $Glossary) or die "Can't open $Glossary: $!"; 1015} 1016my %seen = (); 1017my $text = 0; 1018$/ = ''; 1019my $errors= 0; 1020 1021sub process { 1022 if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) { 1023 my $c = substr $1, 0, 1; 1024 unless ($seen{$c}++) { 1025 print CONFIG_POD <<EOF if $text; 1026=back 1027 1028EOF 1029 print CONFIG_POD <<EOF; 1030=head2 $c 1031 1032=over 4 1033 1034EOF 1035 $text = 1; 1036 } 1037 } 1038 elsif (!$text || !/\A\t/) { 1039 warn "Expected a Configure variable header", 1040 ($text ? " or another paragraph of description" : () ), 1041 ", instead we got:\n$_"; 1042 $errors++; 1043 } 1044 s/n't/n\00t/g; # leave can't, won't etc untouched 1045 s/^\t\s+(.*)/\n$1/gm; # Indented lines ===> new paragraph 1046 s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text 1047 s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o' 1048 s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command 1049 s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s' 1050 s{ 1051 (?<! [\w./<\'\"\$] ) # Only standalone file names 1052 (?! e \. g \. ) # Not e.g. 1053 (?! \. \. \. ) # Not ... 1054 (?! \d ) # Not 5.004 1055 (?! read/ ) # Not read/write 1056 (?! etc\. ) # Not etc. 1057 (?! I/O ) # Not I/O 1058 ( 1059 \$ ? # Allow leading $ 1060 [\w./]* [./] [\w./]* # Require . or / inside 1061 ) 1062 (?<! \. (?= [\s)] ) ) # Do not include trailing dot 1063 (?! [\w/] ) # Include all of it 1064 } 1065 (F<$1>)xg; # /usr/local 1066 s/((?<=\s)~\w*)/F<$1>/g; # ~name 1067 s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD 1068 s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro 1069 s/n[\0]t/n't/g; # undo can't, won't damage 1070} 1071 1072if ($Opts{glossary}) { 1073 <GLOS>; # Skip the "DO NOT EDIT" 1074 <GLOS>; # Skip the preamble 1075 while (<GLOS>) { 1076 process; 1077 print CONFIG_POD; 1078 } 1079 if ($errors) { 1080 die "Errors encountered while processing $Glossary. ", 1081 "Header lines are expected to be of the form:\n", 1082 "NAME (CLASS):\n", 1083 "Maybe there is a malformed header?\n", 1084 ; 1085 } 1086} 1087 1088print CONFIG_POD <<'ENDOFTAIL'; 1089 1090=back 1091 1092=head1 GIT DATA 1093 1094Information on the git commit from which the current perl binary was compiled 1095can be found in the variable C<$Config::Git_Data>. The variable is a 1096structured string that looks something like this: 1097 1098 git_commit_id='ea0c2dbd5f5ac6845ecc7ec6696415bf8e27bd52' 1099 git_describe='GitLive-blead-1076-gea0c2db' 1100 git_branch='smartmatch' 1101 git_uncommitted_changes='' 1102 git_commit_id_title='Commit id:' 1103 git_commit_date='2009-05-09 17:47:31 +0200' 1104 1105Its format is not guaranteed not to change over time. 1106 1107=head1 NOTE 1108 1109This module contains a good example of how to use tie to implement a 1110cache and an example of how to make a tied variable readonly to those 1111outside of it. 1112 1113=cut 1114 1115ENDOFTAIL 1116 1117close(GLOS) if $Opts{glossary}; 1118close(CONFIG_POD); 1119print "written $Config_POD\n"; 1120 1121my $orig_config_txt = ""; 1122my $orig_heavy_txt = ""; 1123{ 1124 local $/; 1125 my $fh; 1126 $orig_config_txt = <$fh> if open $fh, "<", $Config_PM; 1127 $orig_heavy_txt = <$fh> if open $fh, "<", $Config_heavy; 1128} 1129 1130if ($orig_config_txt ne $config_txt or $orig_heavy_txt ne $heavy_txt) { 1131 open CONFIG, ">", $Config_PM or die "Can't open $Config_PM: $!\n"; 1132 open CONFIG_HEAVY, ">", $Config_heavy or die "Can't open $Config_heavy: $!\n"; 1133 print CONFIG $config_txt; 1134 print CONFIG_HEAVY $heavy_txt; 1135 close(CONFIG_HEAVY); 1136 close(CONFIG); 1137 print "updated $Config_PM\n"; 1138 print "updated $Config_heavy\n"; 1139} 1140 1141# Now do some simple tests on the Config.pm file we have created 1142unshift(@INC,'lib'); 1143require $Config_PM; 1144require $Config_heavy; 1145import Config; 1146 1147die "$0: $Config_PM not valid" 1148 unless $Config{'PERL_CONFIG_SH'} eq 'true'; 1149 1150die "$0: error processing $Config_PM" 1151 if defined($Config{'an impossible name'}) 1152 or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache 1153 ; 1154 1155die "$0: error processing $Config_PM" 1156 if eval '$Config{"cc"} = 1' 1157 or eval 'delete $Config{"cc"}' 1158 ; 1159 1160 1161exit 0; 1162# Popularity of various entries in %Config, based on a large build and test 1163# run of code in the Fotango build system: 1164__DATA__ 1165path_sep: 8490 1166d_readlink: 7101 1167d_symlink: 7101 1168archlibexp: 4318 1169sitearchexp: 4305 1170sitelibexp: 4305 1171privlibexp: 4163 1172ldlibpthname: 4041 1173libpth: 2134 1174archname: 1591 1175exe_ext: 1256 1176scriptdir: 1155 1177version: 1116 1178useithreads: 1002 1179osvers: 982 1180osname: 851 1181inc_version_list: 783 1182dont_use_nlink: 779 1183intsize: 759 1184usevendorprefix: 642 1185dlsrc: 624 1186cc: 541 1187lib_ext: 520 1188so: 512 1189ld: 501 1190ccdlflags: 500 1191ldflags: 495 1192obj_ext: 495 1193cccdlflags: 493 1194lddlflags: 493 1195ar: 492 1196dlext: 492 1197libc: 492 1198ranlib: 492 1199full_ar: 491 1200vendorarchexp: 491 1201vendorlibexp: 491 1202installman1dir: 489 1203installman3dir: 489 1204installsitebin: 489 1205installsiteman1dir: 489 1206installsiteman3dir: 489 1207installvendorman1dir: 489 1208installvendorman3dir: 489 1209d_flexfnam: 474 1210eunicefix: 360 1211d_link: 347 1212installsitearch: 344 1213installscript: 341 1214installprivlib: 337 1215binexp: 336 1216installarchlib: 336 1217installprefixexp: 336 1218installsitelib: 336 1219installstyle: 336 1220installvendorarch: 336 1221installvendorbin: 336 1222installvendorlib: 336 1223man1ext: 336 1224man3ext: 336 1225sh: 336 1226siteprefixexp: 336 1227installbin: 335 1228usedl: 332 1229ccflags: 285 1230startperl: 232 1231optimize: 231 1232usemymalloc: 229 1233cpprun: 228 1234sharpbang: 228 1235perllibs: 225 1236usesfio: 224 1237usethreads: 220 1238perlpath: 218 1239extensions: 217 1240usesocks: 208 1241shellflags: 198 1242make: 191 1243d_pwage: 189 1244d_pwchange: 189 1245d_pwclass: 189 1246d_pwcomment: 189 1247d_pwexpire: 189 1248d_pwgecos: 189 1249d_pwpasswd: 189 1250d_pwquota: 189 1251gccversion: 189 1252libs: 186 1253useshrplib: 186 1254cppflags: 185 1255ptrsize: 185 1256shrpenv: 185 1257static_ext: 185 1258uselargefiles: 185 1259alignbytes: 184 1260byteorder: 184 1261ccversion: 184 1262config_args: 184 1263cppminus: 184 1264