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