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