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