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