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