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