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