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