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