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