This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
First stab at rather shaky Configure support for relocatable @INC.
[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')) {
4d20abad
NC
301 foreach my $what (qw(prefixexp
302
303 archlibexp
304 html1direxp
305 html3direxp
306 man1direxp
307 man3direxp
91f668c3 308 privlibexp
4d20abad 309 scriptdirexp
91f668c3 310 sitearchexp
4d20abad
NC
311 sitebinexp
312 sitehtml1direxp
313 sitehtml3direxp
91f668c3 314 sitelibexp
4d20abad
NC
315 siteman1direxp
316 siteman3direxp
317 sitescriptexp
91f668c3 318 vendorarchexp
4d20abad
NC
319 vendorbinexp
320 vendorhtml1direxp
321 vendorhtml3direxp
91f668c3 322 vendorlibexp
4d20abad
NC
323 vendorman1direxp
324 vendorman3direxp
325 vendorscriptexp
326
327 siteprefixexp
328 sitelib_stem
88fe16b2
NC
329 vendorlib_stem)) {
330 push @need_relocation, $what if fetch_string({}, $what) =~ m!^\.\.\./!;
331 }
88fe16b2
NC
332}
333
334my %need_relocation;
335@need_relocation{@need_relocation} = @need_relocation;
336
91f668c3
NC
337# This can have .../ anywhere:
338if (fetch_string({}, 'otherlibdirs') =~ m!\.\.\./!) {
339 $need_relocation{otherlibdirs} = 'otherlibdirs';
340}
341
88fe16b2
NC
342my $relocation_code = <<'EOT';
343
344sub relocate_inc {
345 my $libdir = shift;
346 return $libdir unless $libdir =~ s!^\.\.\./!!;
347 my $prefix = $^X;
348 if ($prefix =~ s!/[^/]*$!!) {
349 while ($libdir =~ m!^\.\./!) {
350 # Loop while $libdir starts "../" and $prefix still has a trailing
351 # directory
352 last unless $prefix =~ s!/([^/]+)$!!;
353 # but bail out if the directory we picked off the end of $prefix is .
354 # or ..
355 if ($1 eq '.' or $1 eq '..') {
356 # Undo! This should be rare, hence code it this way rather than a
357 # check each time before the s!!! above.
358 $prefix = "$prefix/$1";
359 last;
360 }
361 # Remove that leading ../ and loop again
362 substr ($libdir, 0, 3, '');
363 }
364 $libdir = "$prefix/$libdir";
365 }
366 $libdir;
367}
368EOT
369
91f668c3 370if (%need_relocation) {
88fe16b2 371 my $relocations_in_common;
91f668c3
NC
372 # otherlibdirs only features in the hash
373 foreach (keys %need_relocation) {
88fe16b2
NC
374 $relocations_in_common++ if $Common{$_};
375 }
376 if ($relocations_in_common) {
377 print CONFIG $relocation_code;
378 } else {
379 print CONFIG_HEAVY $relocation_code;
380 }
381}
382
2d9d8159 383print CONFIG_HEAVY @non_v, "\n";
3c81428c 384
5435c704 385# copy config summary format from the myconfig.SH script
e935c5a4 386print CONFIG_HEAVY "our \$summary = <<'!END!';\n";
3b5ca523 387open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
54310121 3881 while defined($_ = <MYCONFIG>) && !/^Summary of/;
2d9d8159 389do { print CONFIG_HEAVY $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
3c81428c 390close(MYCONFIG);
a0d0e21e 391
2d9d8159 392print CONFIG_HEAVY "\n!END!\n", <<'EOT';
90ec21fb 393my $summary_expanded;
3c81428c
PP
394
395sub myconfig {
90ec21fb
EM
396 return $summary_expanded if $summary_expanded;
397 ($summary_expanded = $summary) =~ s{\$(\w+)}
2d9d8159 398 { my $c = $Config::Config{$1}; defined($c) ? $c : 'undef' }ge;
90ec21fb 399 $summary_expanded;
3c81428c 400}
5435c704 401
8468119f
NC
402local *_ = \my $a;
403$_ = <<'!END!';
3c81428c
PP
404EOT
405
deeea481 406print CONFIG_HEAVY join('', sort @v_others), "!END!\n";
2855b621
NC
407
408# Only need the dynamic byteorder code in Config.pm if 'byteorder' is one of
409# the precached keys
410if ($Common{byteorder}) {
411 print CONFIG $byteorder_code;
412} else {
413 print CONFIG_HEAVY $byteorder_code;
414}
5435c704 415
88fe16b2
NC
416if (@need_relocation) {
417print CONFIG_HEAVY 'foreach my $what (qw(', join (' ', @need_relocation),
418 ")) {\n", <<'EOT';
419 s/^($what=)(['"])(.*?)\2/$1 . $2 . relocate_inc($3) . $2/me;
420}
421EOT
91f668c3
NC
422# Currently it only makes sense to do the ... relocation on Unix, so there's
423# no need to emulate the "which separator for this platform" logic in perl.c -
424# ':' will always be applicable
425if ($need_relocation{otherlibdirs}) {
426print CONFIG_HEAVY << 'EOT';
427s{^(otherlibdirs=)(['"])(.*?)\2}
428 {$1 . $2 . join ':', map {relocate_inc($_)} split ':', $3 . $2}me;
429EOT
430}
88fe16b2
NC
431}
432
2d9d8159 433print CONFIG_HEAVY <<'EOT';
2d9d8159 434s/(byteorder=)(['"]).*?\2/$1$2$Config::byteorder$2/m;
43d06990
NC
435
436my $config_sh_len = length $_;
3be00128 437
e935c5a4 438our $Config_SH_expanded = "\n$_" . << 'EOVIRTUAL';
8468119f
NC
439EOT
440
06482b90
NC
441foreach my $prefix (qw(ccflags ldflags)) {
442 my $value = fetch_string ({}, $prefix);
443 my $withlargefiles = fetch_string ({}, $prefix . "_uselargefiles");
27da23d5
JH
444 if (defined $withlargefiles) {
445 $value =~ s/\Q$withlargefiles\E\b//;
446 print CONFIG_HEAVY "${prefix}_nolargefiles='$value'\n";
447 }
06482b90 448}
5435c704 449
06482b90
NC
450foreach my $prefix (qw(libs libswanted)) {
451 my $value = fetch_string ({}, $prefix);
27da23d5
JH
452 my $withlf = fetch_string ({}, 'libswanted_uselargefiles');
453 next unless defined $withlf;
06482b90
NC
454 my @lflibswanted
455 = split(' ', fetch_string ({}, 'libswanted_uselargefiles'));
456 if (@lflibswanted) {
457 my %lflibswanted;
458 @lflibswanted{@lflibswanted} = ();
459 if ($prefix eq 'libs') {
460 my @libs = grep { /^-l(.+)/ &&
461 not exists $lflibswanted{$1} }
462 split(' ', fetch_string ({}, 'libs'));
463 $value = join(' ', @libs);
464 } else {
465 my @libswanted = grep { not exists $lflibswanted{$_} }
466 split(' ', fetch_string ({}, 'libswanted'));
467 $value = join(' ', @libswanted);
4b2ec495 468 }
435ec615 469 }
2d9d8159 470 print CONFIG_HEAVY "${prefix}_nolargefiles='$value'\n";
5435c704
NC
471}
472
2d9d8159 473print CONFIG_HEAVY "EOVIRTUAL\n";
06482b90 474
2d9d8159 475print CONFIG_HEAVY $fetch_string;
06482b90
NC
476
477print CONFIG <<'ENDOFEND';
478
2d9d8159 479sub FETCH {
5435c704
NC
480 my($self, $key) = @_;
481
482 # check for cached value (which may be undef so we use exists not defined)
483 return $self->{$key} if exists $self->{$key};
484
06482b90 485 return $self->fetch_string($key);
a0d0e21e 486}
2d9d8159
NC
487ENDOFEND
488
489print CONFIG_HEAVY <<'ENDOFEND';
1a9ca827 490
3c81428c
PP
491my $prevpos = 0;
492
a0d0e21e
LW
493sub FIRSTKEY {
494 $prevpos = 0;
2ddb7828 495 substr($Config_SH_expanded, 1, index($Config_SH_expanded, '=') - 1 );
a0d0e21e
LW
496}
497
498sub NEXTKEY {
1a9ca827
NC
499ENDOFEND
500if ($seen_quotes{'"'}) {
501print CONFIG_HEAVY <<'ENDOFEND';
435ec615 502 # Find out how the current key's quoted so we can skip to its end.
3be00128
NC
503 my $quote = substr($Config_SH_expanded,
504 index($Config_SH_expanded, "=", $prevpos)+1, 1);
505 my $pos = index($Config_SH_expanded, qq($quote\n), $prevpos) + 2;
1a9ca827
NC
506ENDOFEND
507} else {
508 # Just ' quotes, so it's much easier.
509print CONFIG_HEAVY <<'ENDOFEND';
510 my $pos = index($Config_SH_expanded, qq('\n), $prevpos) + 2;
511ENDOFEND
512}
513print CONFIG_HEAVY <<'ENDOFEND';
3be00128 514 my $len = index($Config_SH_expanded, "=", $pos) - $pos;
a0d0e21e 515 $prevpos = $pos;
3be00128 516 $len > 0 ? substr($Config_SH_expanded, $pos, $len) : undef;
85e6fe83 517}
a0d0e21e 518
2ddb7828 519sub EXISTS {
5435c704
NC
520 return 1 if exists($_[0]->{$_[1]});
521
1a9ca827
NC
522 return(index($Config_SH_expanded, "\n$_[1]='") != -1
523ENDOFEND
524if ($seen_quotes{'"'}) {
525print CONFIG_HEAVY <<'ENDOFEND';
526 or index($Config_SH_expanded, "\n$_[1]=\"") != -1
527ENDOFEND
528}
529print CONFIG_HEAVY <<'ENDOFEND';
5435c704 530 );
a0d0e21e
LW
531}
532
3c81428c 533sub STORE { die "\%Config::Config is read-only\n" }
5435c704
NC
534*DELETE = \&STORE;
535*CLEAR = \&STORE;
a0d0e21e 536
3c81428c
PP
537
538sub config_sh {
43d06990 539 substr $Config_SH_expanded, 1, $config_sh_len;
748a9306 540}
9193ea20
PP
541
542sub config_re {
543 my $re = shift;
3be00128
NC
544 return map { chomp; $_ } grep eval{ /^(?:$re)=/ }, split /^/,
545 $Config_SH_expanded;
9193ea20
PP
546}
547
3c81428c 548sub config_vars {
307dc113 549 # implements -V:cfgvar option (see perlrun -V:)
a48f8c77 550 foreach (@_) {
307dc113 551 # find optional leading, trailing colons; and query-spec
4a305f6a 552 my ($notag,$qry,$lncont) = m/^(:)?(.*?)(:)?$/; # flags fore and aft,
307dc113
JC
553 # map colon-flags to print decorations
554 my $prfx = $notag ? '': "$qry="; # tag-prefix for print
555 my $lnend = $lncont ? ' ' : ";\n"; # line ending for print
4a305f6a 556
307dc113 557 # all config-vars are by definition \w only, any \W means regex
4a305f6a
JC
558 if ($qry =~ /\W/) {
559 my @matches = config_re($qry);
560 print map "$_$lnend", @matches ? @matches : "$qry: not found" if !$notag;
561 print map { s/\w+=//; "$_$lnend" } @matches ? @matches : "$qry: not found" if $notag;
a48f8c77 562 } else {
2d9d8159
NC
563 my $v = (exists $Config::Config{$qry}) ? $Config::Config{$qry}
564 : 'UNKNOWN';
a48f8c77 565 $v = 'undef' unless defined $v;
4a305f6a 566 print "${prfx}'${v}'$lnend";
a48f8c77 567 }
3c81428c
PP
568 }
569}
570
2d9d8159
NC
571# Called by the real AUTOLOAD
572sub launcher {
573 undef &AUTOLOAD;
574 goto \&$Config::AUTOLOAD;
575}
576
5771;
9193ea20
PP
578ENDOFEND
579
580if ($^O eq 'os2') {
a48f8c77 581 print CONFIG <<'ENDOFSET';
9193ea20
PP
582my %preconfig;
583if ($OS2::is_aout) {
3be00128 584 my ($value, $v) = $Config_SH_expanded =~ m/^used_aout='(.*)'\s*$/m;
9193ea20 585 for (split ' ', $value) {
3be00128 586 ($v) = $Config_SH_expanded =~ m/^aout_$_='(.*)'\s*$/m;
9193ea20
PP
587 $preconfig{$_} = $v eq 'undef' ? undef : $v;
588 }
589}
764df951 590$preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't
9193ea20
PP
591sub TIEHASH { bless {%preconfig} }
592ENDOFSET
a48f8c77
MS
593 # Extract the name of the DLL from the makefile to avoid duplication
594 my ($f) = grep -r, qw(GNUMakefile Makefile);
595 my $dll;
596 if (open my $fh, '<', $f) {
597 while (<$fh>) {
598 $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
599 }
30500b05 600 }
a48f8c77 601 print CONFIG <<ENDOFSET if $dll;
30500b05
IZ
602\$preconfig{dll_name} = '$dll';
603ENDOFSET
9193ea20 604} else {
a48f8c77 605 print CONFIG <<'ENDOFSET';
5435c704
NC
606sub TIEHASH {
607 bless $_[1], $_[0];
608}
9193ea20
PP
609ENDOFSET
610}
611
a8e1d30b
NC
612foreach my $key (keys %Common) {
613 my $value = fetch_string ({}, $key);
614 # Is it safe on the LHS of => ?
615 my $qkey = $key =~ /^[A-Za-z_][A-Za-z0-9_]*$/ ? $key : "'$key'";
616 if (defined $value) {
617 # Quote things for a '' string
618 $value =~ s!\\!\\\\!g;
619 $value =~ s!'!\\'!g;
620 $value = "'$value'";
91f668c3
NC
621 if ($key eq 'otherlibdirs') {
622 $value = "join (':', map {relocate_inc(\$_)} split (':', $value))";
623 } elsif ($need_relocation{$key}) {
88fe16b2
NC
624 $value = "relocate_inc($value)";
625 }
a8e1d30b
NC
626 } else {
627 $value = "undef";
628 }
629 $Common{$key} = "$qkey => $value";
630}
2855b621
NC
631
632if ($Common{byteorder}) {
633 $Common{byteorder} = 'byteorder => $byteorder';
634}
635my $fast_config = join '', map { " $_,\n" } sort values %Common;
5435c704 636
938af39e
NC
637# Sanity check needed to stop an infite loop if Config_heavy.pl fails to define
638# &launcher for some reason (eg it got truncated)
8468119f 639print CONFIG sprintf <<'ENDOFTIE', $fast_config;
9193ea20 640
fb73857a
PP
641sub DESTROY { }
642
2d9d8159 643sub AUTOLOAD {
c1b2b415 644 require 'Config_heavy.pl';
938af39e 645 goto \&launcher unless $Config::AUTOLOAD =~ /launcher$/;
2d9d8159
NC
646 die "&Config::AUTOLOAD failed on $Config::AUTOLOAD";
647}
648
2c165900 649# tie returns the object, so the value returned to require will be true.
5435c704 650tie %%Config, 'Config', {
a8e1d30b 651%s};
5435c704
NC
652ENDOFTIE
653
748a9306 654
5435c704
NC
655open(CONFIG_POD, ">lib/Config.pod") or die "Can't open lib/Config.pod: $!";
656print CONFIG_POD <<'ENDOFTAIL';
3c81428c 657=head1 NAME
a0d0e21e 658
3c81428c
PP
659Config - access Perl configuration information
660
661=head1 SYNOPSIS
662
663 use Config;
63f18be6
NC
664 if ($Config{usethreads}) {
665 print "has thread support\n"
3c81428c
PP
666 }
667
a48f8c77 668 use Config qw(myconfig config_sh config_vars config_re);
3c81428c
PP
669
670 print myconfig();
671
672 print config_sh();
673
a48f8c77
MS
674 print config_re();
675
3c81428c
PP
676 config_vars(qw(osname archname));
677
678
679=head1 DESCRIPTION
680
681The Config module contains all the information that was available to
682the C<Configure> program at Perl build time (over 900 values).
683
684Shell variables from the F<config.sh> file (written by Configure) are
685stored in the readonly-variable C<%Config>, indexed by their names.
686
687Values stored in config.sh as 'undef' are returned as undefined
1fef88e7 688values. The perl C<exists> function can be used to check if a
3c81428c
PP
689named variable exists.
690
691=over 4
692
693=item myconfig()
694
695Returns a textual summary of the major perl configuration values.
696See also C<-V> in L<perlrun/Switches>.
697
698=item config_sh()
699
700Returns the entire perl configuration information in the form of the
701original config.sh shell variable assignment script.
702
a48f8c77
MS
703=item config_re($regex)
704
705Like config_sh() but returns, as a list, only the config entries who's
706names match the $regex.
707
3c81428c
PP
708=item config_vars(@names)
709
710Prints to STDOUT the values of the named configuration variable. Each is
711printed on a separate line in the form:
712
713 name='value';
714
715Names which are unknown are output as C<name='UNKNOWN';>.
716See also C<-V:name> in L<perlrun/Switches>.
717
718=back
719
720=head1 EXAMPLE
721
722Here's a more sophisticated example of using %Config:
723
724 use Config;
743c51bc
WK
725 use strict;
726
727 my %sig_num;
728 my @sig_name;
729 unless($Config{sig_name} && $Config{sig_num}) {
730 die "No sigs?";
731 } else {
732 my @names = split ' ', $Config{sig_name};
733 @sig_num{@names} = split ' ', $Config{sig_num};
734 foreach (@names) {
735 $sig_name[$sig_num{$_}] ||= $_;
736 }
737 }
3c81428c 738
743c51bc
WK
739 print "signal #17 = $sig_name[17]\n";
740 if ($sig_num{ALRM}) {
741 print "SIGALRM is $sig_num{ALRM}\n";
3c81428c
PP
742 }
743
744=head1 WARNING
745
746Because this information is not stored within the perl executable
747itself it is possible (but unlikely) that the information does not
748relate to the actual perl binary which is being used to access it.
749
750The Config module is installed into the architecture and version
751specific library directory ($Config{installarchlib}) and it checks the
752perl version number when loaded.
753
435ec615
HM
754The values stored in config.sh may be either single-quoted or
755double-quoted. Double-quoted strings are handy for those cases where you
756need to include escape sequences in the strings. To avoid runtime variable
757interpolation, any C<$> and C<@> characters are replaced by C<\$> and
758C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
759or C<\@> in double-quoted strings unless you're willing to deal with the
760consequences. (The slashes will end up escaped and the C<$> or C<@> will
761trigger variable interpolation)
762
ebc74a4b
GS
763=head1 GLOSSARY
764
765Most C<Config> variables are determined by the C<Configure> script
766on platforms supported by it (which is most UNIX platforms). Some
767platforms have custom-made C<Config> variables, and may thus not have
768some of the variables described below, or may have extraneous variables
769specific to that particular port. See the port specific documentation
770in such cases.
771
ebc74a4b
GS
772ENDOFTAIL
773
5435c704
NC
774if ($Opts{glossary}) {
775 open(GLOS, "<$Glossary") or die "Can't open $Glossary: $!";
18f68570 776}
2f4f46ad
NC
777my %seen = ();
778my $text = 0;
fb87c415
IZ
779$/ = '';
780
781sub process {
aade5aff
YST
782 if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
783 my $c = substr $1, 0, 1;
784 unless ($seen{$c}++) {
5435c704 785 print CONFIG_POD <<EOF if $text;
fb87c415 786=back
ebc74a4b 787
fb87c415 788EOF
5435c704 789 print CONFIG_POD <<EOF;
fb87c415
IZ
790=head2 $c
791
bbc7dcd2 792=over 4
fb87c415
IZ
793
794EOF
aade5aff
YST
795 $text = 1;
796 }
797 }
798 elsif (!$text || !/\A\t/) {
799 warn "Expected a Configure variable header",
800 ($text ? " or another paragraph of description" : () );
fb87c415
IZ
801 }
802 s/n't/n\00t/g; # leave can't, won't etc untouched
9b22980b 803 s/^\t\s+(.*)/\n$1/gm; # Indented lines ===> new paragraph
fb87c415
IZ
804 s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text
805 s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
806 s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
807 s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
808 s{
809 (?<! [\w./<\'\"] ) # Only standalone file names
810 (?! e \. g \. ) # Not e.g.
811 (?! \. \. \. ) # Not ...
812 (?! \d ) # Not 5.004
a1151a3c
RGS
813 (?! read/ ) # Not read/write
814 (?! etc\. ) # Not etc.
815 (?! I/O ) # Not I/O
816 (
817 \$ ? # Allow leading $
818 [\w./]* [./] [\w./]* # Require . or / inside
819 )
820 (?<! \. (?= [\s)] ) ) # Do not include trailing dot
fb87c415
IZ
821 (?! [\w/] ) # Include all of it
822 }
823 (F<$1>)xg; # /usr/local
824 s/((?<=\s)~\w*)/F<$1>/g; # ~name
825 s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD
826 s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
827 s/n[\0]t/n't/g; # undo can't, won't damage
ebc74a4b
GS
828}
829
5435c704 830if ($Opts{glossary}) {
7701ffb5
JH
831 <GLOS>; # Skip the "DO NOT EDIT"
832 <GLOS>; # Skip the preamble
18f68570
VK
833 while (<GLOS>) {
834 process;
5435c704 835 print CONFIG_POD;
18f68570 836 }
fb87c415 837}
ebc74a4b 838
5435c704 839print CONFIG_POD <<'ENDOFTAIL';
ebc74a4b
GS
840
841=back
842
3c81428c
PP
843=head1 NOTE
844
845This module contains a good example of how to use tie to implement a
846cache and an example of how to make a tied variable readonly to those
847outside of it.
848
849=cut
a0d0e21e 850
9193ea20 851ENDOFTAIL
a0d0e21e 852
2d9d8159 853close(CONFIG_HEAVY);
a0d0e21e 854close(CONFIG);
ebc74a4b 855close(GLOS);
5435c704 856close(CONFIG_POD);
a0d0e21e 857
18f68570 858# Now create Cross.pm if needed
5435c704 859if ($Opts{cross}) {
18f68570 860 open CROSS, ">lib/Cross.pm" or die "Can not open >lib/Cross.pm: $!";
47bcb90d
VK
861 my $cross = <<'EOS';
862# typical invocation:
863# perl -MCross Makefile.PL
864# perl -MCross=wince -V:cc
865package Cross;
866
867sub import {
868 my ($package,$platform) = @_;
869 unless (defined $platform) {
870 # if $platform is not specified, then use last one when
871 # 'configpm; was invoked with --cross option
872 $platform = '***replace-marker***';
873 }
874 @INC = map {/\blib\b/?(do{local $_=$_;s/\blib\b/xlib\/$platform/;$_},$_):($_)} @INC;
e2a02c1e 875 $::Cross::platform = $platform;
18f68570 876}
47bcb90d 877
18f68570
VK
8781;
879EOS
5435c704 880 $cross =~ s/\*\*\*replace-marker\*\*\*/$Opts{cross}/g;
47bcb90d 881 print CROSS $cross;
18f68570 882 close CROSS;
42d1cefd 883 unshift(@INC,"xlib/$Opts{cross}");
18f68570
VK
884}
885
a0d0e21e
LW
886# Now do some simple tests on the Config.pm file we have created
887unshift(@INC,'lib');
27da23d5 888unshift(@INC,'xlib/symbian') if $Opts{cross};
5435c704 889require $Config_PM;
ae7e4cc1 890require $Config_heavy;
a0d0e21e
LW
891import Config;
892
5435c704 893die "$0: $Config_PM not valid"
a02608de 894 unless $Config{'PERL_CONFIG_SH'} eq 'true';
a0d0e21e 895
5435c704 896die "$0: error processing $Config_PM"
a0d0e21e 897 if defined($Config{'an impossible name'})
a02608de 898 or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache
a0d0e21e
LW
899 ;
900
5435c704 901die "$0: error processing $Config_PM"
a0d0e21e
LW
902 if eval '$Config{"cc"} = 1'
903 or eval 'delete $Config{"cc"}'
904 ;
905
906
85e6fe83 907exit 0;
a8e1d30b
NC
908# Popularity of various entries in %Config, based on a large build and test
909# run of code in the Fotango build system:
910__DATA__
911path_sep: 8490
912d_readlink: 7101
913d_symlink: 7101
914archlibexp: 4318
915sitearchexp: 4305
916sitelibexp: 4305
917privlibexp: 4163
918ldlibpthname: 4041
919libpth: 2134
920archname: 1591
921exe_ext: 1256
922scriptdir: 1155
923version: 1116
924useithreads: 1002
925osvers: 982
926osname: 851
927inc_version_list: 783
928dont_use_nlink: 779
929intsize: 759
930usevendorprefix: 642
931dlsrc: 624
932cc: 541
933lib_ext: 520
934so: 512
935ld: 501
936ccdlflags: 500
937ldflags: 495
938obj_ext: 495
939cccdlflags: 493
940lddlflags: 493
941ar: 492
942dlext: 492
943libc: 492
944ranlib: 492
945full_ar: 491
946vendorarchexp: 491
947vendorlibexp: 491
948installman1dir: 489
949installman3dir: 489
950installsitebin: 489
951installsiteman1dir: 489
952installsiteman3dir: 489
953installvendorman1dir: 489
954installvendorman3dir: 489
955d_flexfnam: 474
956eunicefix: 360
957d_link: 347
958installsitearch: 344
959installscript: 341
960installprivlib: 337
961binexp: 336
962installarchlib: 336
963installprefixexp: 336
964installsitelib: 336
965installstyle: 336
966installvendorarch: 336
967installvendorbin: 336
968installvendorlib: 336
969man1ext: 336
970man3ext: 336
971sh: 336
972siteprefixexp: 336
973installbin: 335
974usedl: 332
975ccflags: 285
976startperl: 232
977optimize: 231
978usemymalloc: 229
979cpprun: 228
980sharpbang: 228
981perllibs: 225
982usesfio: 224
983usethreads: 220
984perlpath: 218
985extensions: 217
986usesocks: 208
987shellflags: 198
988make: 191
989d_pwage: 189
990d_pwchange: 189
991d_pwclass: 189
992d_pwcomment: 189
993d_pwexpire: 189
994d_pwgecos: 189
995d_pwpasswd: 189
996d_pwquota: 189
997gccversion: 189
998libs: 186
999useshrplib: 186
1000cppflags: 185
1001ptrsize: 185
1002shrpenv: 185
1003static_ext: 185
1004use5005threads: 185
1005uselargefiles: 185
1006alignbytes: 184
1007byteorder: 184
1008ccversion: 184
1009config_args: 184
1010cppminus: 184