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