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