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