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