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