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