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