This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Only require File::Spec::Functions on Win32, as only it needs rel2abs().
[perl5.git] / configpm
CommitLineData
a0d0e21e 1#!./miniperl -w
962e59f3
DM
2#
3# configpm
4#
8ed6d636
VK
5# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
6# 2002, 2003, 2004, 2005, 2006, 2007 Larry Wall and others.
962e59f3
DM
7#
8#
9# Regenerate the files
10#
11# lib/Config.pm
12# lib/Config_heavy.pl
13# lib/Config.pod
14# lib/Cross.pm (optionally)
15#
8ed6d636 16#
962e59f3
DM
17# from the contents of the static files
18#
19# Porting/Glossary
20# myconfig.SH
21#
22# and from the contents of the Configure-generated file
23#
24# config.sh
25#
8ed6d636
VK
26# Note that output directory is xlib/[cross-name]/ for cross-compiling
27#
962e59f3
DM
28# It will only update Config.pm and Config_heavy.pl if the contents of
29# either file would be different. Note that *both* files are updated in
30# this case, since for example an extension makefile that has a dependency
31# on Config.pm should trigger even if only Config_heavy.pl has changed.
32
33sub usage { die <<EOF }
d2d98f31 34usage: $0 [ options ]
962e59f3
DM
35 --cross=PLATFORM cross-compile for a different platform
36 --no-glossary don't include Porting/Glossary in lib/Config.pod
4e73d6a4 37 --chdir=dir change directory before writing files
962e59f3
DM
38EOF
39
2f4f46ad
NC
40use strict;
41use vars qw(%Config $Config_SH_expanded);
8990e307 42
a8e1d30b
NC
43my $how_many_common = 22;
44
45# commonly used names to precache (and hence lookup fastest)
46my %Common;
47
48while ($how_many_common--) {
49 $_ = <DATA>;
50 chomp;
51 /^(\S+):\s*(\d+)$/ or die "Malformed line '$_'";
52 $Common{$1} = $1;
53}
5435c704
NC
54
55# names of things which may need to have slashes changed to double-colons
56my %Extensions = map {($_,$_)}
57 qw(dynamic_ext static_ext extensions known_extensions);
58
59# allowed opts as well as specifies default and initial values
60my %Allowed_Opts = (
2d9d8159
NC
61 'cross' => '', # --cross=PLATFORM - crosscompiling for PLATFORM
62 'glossary' => 1, # --no-glossary - no glossary file inclusion,
5435c704 63 # for compactness
4e73d6a4 64 'chdir' => '', # --chdir=dir - change directory before writing files
18f68570 65);
18f68570 66
5435c704
NC
67sub opts {
68 # user specified options
69 my %given_opts = (
70 # --opt=smth
71 (map {/^--([\-_\w]+)=(.*)$/} @ARGV),
72 # --opt --no-opt --noopt
73 (map {/^no-?(.*)$/i?($1=>0):($_=>1)} map {/^--([\-_\w]+)$/} @ARGV),
74 );
75
76 my %opts = (%Allowed_Opts, %given_opts);
77
78 for my $opt (grep {!exists $Allowed_Opts{$_}} keys %given_opts) {
962e59f3
DM
79 warn "option '$opt' is not recognized";
80 usage;
5435c704
NC
81 }
82 @ARGV = grep {!/^--/} @ARGV;
83
84 return %opts;
85}
18f68570 86
5435c704
NC
87
88my %Opts = opts();
89
4e73d6a4
NC
90if ($Opts{chdir}) {
91 chdir $Opts{chdir} or die "$0: could not chdir $Opts{chdir}: $!"
92}
93
8ed6d636 94my ($Config_SH, $Config_PM, $Config_heavy, $Config_POD);
d2d98f31 95my $Glossary = 'Porting/Glossary';
5435c704
NC
96
97if ($Opts{cross}) {
18f68570
VK
98 # creating cross-platform config file
99 mkdir "xlib";
5435c704 100 mkdir "xlib/$Opts{cross}";
d2d98f31 101 $Config_PM = "xlib/$Opts{cross}/Config.pm";
8ed6d636
VK
102 $Config_POD = "xlib/$Opts{cross}/Config.pod";
103 $Config_SH = "Cross/config-$Opts{cross}.sh";
18f68570
VK
104}
105else {
d2d98f31 106 $Config_PM = "lib/Config.pm";
8ed6d636
VK
107 $Config_POD = "lib/Config.pod";
108 $Config_SH = "config.sh";
18f68570 109}
d2d98f31
VK
110($Config_heavy = $Config_PM) =~ s/\.pm$/_heavy.pl/;
111die "Can't automatically determine name for Config_heavy.pl from '$Config_PM'"
112 if $Config_heavy eq $Config_PM;
8990e307 113
962e59f3
DM
114my $config_txt;
115my $heavy_txt;
2d9d8159 116
962e59f3 117$heavy_txt .= <<'ENDOFBEG';
2d9d8159
NC
118# This file was created by configpm when Perl was built. Any changes
119# made to this file will be lost the next time perl is built.
120
121package Config;
122use strict;
123# use warnings; Pulls in Carp
124# use vars pulls in Carp
125ENDOFBEG
fec02dd3 126
9137345a 127my $myver = sprintf "%vd", $^V;
a0d0e21e 128
962e59f3 129$config_txt .= sprintf <<'ENDOFBEG', ($myver) x 3;
5435c704
NC
130# This file was created by configpm when Perl was built. Any changes
131# made to this file will be lost the next time perl is built.
3c81428c 132
3acf89b2
MB
133# for a description of the variables, please have a look at the
134# Glossary file, as written in the Porting folder, or use the url:
135# http://perl5.git.perl.org/perl.git/blob/HEAD:/Porting/Glossary
136
8990e307 137package Config;
2f4f46ad
NC
138use strict;
139# use warnings; Pulls in Carp
140# use vars pulls in Carp
141@Config::EXPORT = qw(%%Config);
142@Config::EXPORT_OK = qw(myconfig config_sh config_vars config_re);
a48f8c77 143
43d06990
NC
144# Need to stub all the functions to make code such as print Config::config_sh
145# keep working
146
147sub myconfig;
148sub config_sh;
149sub config_vars;
150sub config_re;
151
2f4f46ad
NC
152my %%Export_Cache = map {($_ => 1)} (@Config::EXPORT, @Config::EXPORT_OK);
153
154our %%Config;
e3d0cac0
IZ
155
156# Define our own import method to avoid pulling in the full Exporter:
157sub import {
a48f8c77 158 my $pkg = shift;
2f4f46ad 159 @_ = @Config::EXPORT unless @_;
5435c704 160
a48f8c77
MS
161 my @funcs = grep $_ ne '%%Config', @_;
162 my $export_Config = @funcs < @_ ? 1 : 0;
5435c704 163
2f4f46ad 164 no strict 'refs';
a48f8c77
MS
165 my $callpkg = caller(0);
166 foreach my $func (@funcs) {
167 die sprintf qq{"%%s" is not exported by the %%s module\n},
168 $func, __PACKAGE__ unless $Export_Cache{$func};
169 *{$callpkg.'::'.$func} = \&{$func};
170 }
5435c704 171
a48f8c77
MS
172 *{"$callpkg\::Config"} = \%%Config if $export_Config;
173 return;
e3d0cac0
IZ
174}
175
5435c704
NC
176die "Perl lib version (%s) doesn't match executable version ($])"
177 unless $^V;
de98c553 178
5435c704 179$^V eq %s
a48f8c77
MS
180 or die "Perl lib version (%s) doesn't match executable version (" .
181 sprintf("v%%vd",$^V) . ")";
a0d0e21e 182
8990e307
LW
183ENDOFBEG
184
16d20bd9 185
5435c704 186my @non_v = ();
5435c704
NC
187my @v_others = ();
188my $in_v = 0;
189my %Data = ();
190
a0d0e21e 191
1a9ca827 192my %seen_quotes;
2f4f46ad
NC
193{
194 my ($name, $val);
8ed6d636 195 open(CONFIG_SH, $Config_SH) || die "Can't open $Config_SH: $!";
2f4f46ad 196 while (<CONFIG_SH>) {
a0d0e21e 197 next if m:^#!/bin/sh:;
5435c704 198
a02608de 199 # Catch PERL_CONFIG_SH=true and PERL_VERSION=n line from Configure.
d4de4258 200 s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/ or m/^(\w+)='(.*)'$/;
3905a40f 201 my($k, $v) = ($1, $2);
5435c704 202
2000072c 203 # grandfather PATCHLEVEL and SUBVERSION and CONFIG
cceca5ed
GS
204 if ($k) {
205 if ($k eq 'PERL_VERSION') {
206 push @v_others, "PATCHLEVEL='$v'\n";
207 }
208 elsif ($k eq 'PERL_SUBVERSION') {
209 push @v_others, "SUBVERSION='$v'\n";
210 }
a02608de 211 elsif ($k eq 'PERL_CONFIG_SH') {
2000072c
JH
212 push @v_others, "CONFIG='$v'\n";
213 }
cceca5ed 214 }
5435c704 215
435ec615
HM
216 # We can delimit things in config.sh with either ' or ".
217 unless ($in_v or m/^(\w+)=(['"])(.*\n)/){
a0d0e21e
LW
218 push(@non_v, "#$_"); # not a name='value' line
219 next;
220 }
2f4f46ad 221 my $quote = $2;
5435c704
NC
222 if ($in_v) {
223 $val .= $_;
224 }
225 else {
226 ($name,$val) = ($1,$3);
227 }
435ec615 228 $in_v = $val !~ /$quote\n/;
44a8e56a 229 next if $in_v;
a0d0e21e 230
5435c704 231 s,/,::,g if $Extensions{$name};
a0d0e21e 232
5435c704 233 $val =~ s/$quote\n?\z//;
3c81428c 234
5435c704 235 my $line = "$name=$quote$val$quote\n";
deeea481 236 push(@v_others, $line);
1a9ca827 237 $seen_quotes{$quote}++;
2f4f46ad
NC
238 }
239 close CONFIG_SH;
5435c704 240}
2f4f46ad 241
1a9ca827
NC
242# This is somewhat grim, but I want the code for parsing config.sh here and
243# now so that I can expand $Config{ivsize} and $Config{ivtype}
244
245my $fetch_string = <<'EOT';
246
247# Search for it in the big string
248sub fetch_string {
249 my($self, $key) = @_;
250
251EOT
252
253if ($seen_quotes{'"'}) {
254 # We need the full ' and " code
255 $fetch_string .= <<'EOT';
256 my $quote_type = "'";
257 my $marker = "$key=";
258
259 # Check for the common case, ' delimited
260 my $start = index($Config_SH_expanded, "\n$marker$quote_type");
261 # If that failed, check for " delimited
262 if ($start == -1) {
263 $quote_type = '"';
264 $start = index($Config_SH_expanded, "\n$marker$quote_type");
265 }
266EOT
267} else {
268 $fetch_string .= <<'EOT';
269 # We only have ' delimted.
270 my $start = index($Config_SH_expanded, "\n$key=\'");
271EOT
272}
273$fetch_string .= <<'EOT';
274 # Start can never be -1 now, as we've rigged the long string we're
275 # searching with an initial dummy newline.
276 return undef if $start == -1;
277
278 $start += length($key) + 3;
279
280EOT
281if (!$seen_quotes{'"'}) {
282 # Don't need the full ' and " code, or the eval expansion.
283 $fetch_string .= <<'EOT';
284 my $value = substr($Config_SH_expanded, $start,
285 index($Config_SH_expanded, "'\n", $start)
286 - $start);
287EOT
288} else {
289 $fetch_string .= <<'EOT';
290 my $value = substr($Config_SH_expanded, $start,
291 index($Config_SH_expanded, "$quote_type\n", $start)
292 - $start);
293
294 # If we had a double-quote, we'd better eval it so escape
295 # sequences and such can be interpolated. Since the incoming
296 # value is supposed to follow shell rules and not perl rules,
297 # we escape any perl variable markers
298 if ($quote_type eq '"') {
299 $value =~ s/\$/\\\$/g;
300 $value =~ s/\@/\\\@/g;
301 eval "\$value = \"$value\"";
302 }
303EOT
304}
305$fetch_string .= <<'EOT';
306 # So we can say "if $Config{'foo'}".
307 $value = undef if $value eq 'undef';
308 $self->{$key} = $value; # cache it
309}
310EOT
311
312eval $fetch_string;
313die if $@;
3c81428c 314
8468119f
NC
315# Calculation for the keys for byteorder
316# This is somewhat grim, but I need to run fetch_string here.
deeea481 317our $Config_SH_expanded = join "\n", '', @v_others;
8468119f
NC
318
319my $t = fetch_string ({}, 'ivtype');
320my $s = fetch_string ({}, 'ivsize');
321
322# byteorder does exist on its own but we overlay a virtual
323# dynamically recomputed value.
324
325# However, ivtype and ivsize will not vary for sane fat binaries
326
327my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
328
329my $byteorder_code;
330if ($s == 4 || $s == 8) {
331 my $list = join ',', reverse(2..$s);
332 my $format = 'a'x$s;
333 $byteorder_code = <<"EOT";
2855b621 334
8468119f
NC
335my \$i = 0;
336foreach my \$c ($list) { \$i |= ord(\$c); \$i <<= 8 }
337\$i |= ord(1);
2d9d8159 338our \$byteorder = join('', unpack('$format', pack('$f', \$i)));
8468119f
NC
339EOT
340} else {
2d9d8159 341 $byteorder_code = "our \$byteorder = '?'x$s;\n";
8468119f
NC
342}
343
88fe16b2
NC
344my @need_relocation;
345
346if (fetch_string({},'userelocatableinc')) {
4d20abad
NC
347 foreach my $what (qw(prefixexp
348
349 archlibexp
350 html1direxp
351 html3direxp
352 man1direxp
353 man3direxp
91f668c3 354 privlibexp
4d20abad 355 scriptdirexp
91f668c3 356 sitearchexp
4d20abad
NC
357 sitebinexp
358 sitehtml1direxp
359 sitehtml3direxp
91f668c3 360 sitelibexp
4d20abad
NC
361 siteman1direxp
362 siteman3direxp
363 sitescriptexp
91f668c3 364 vendorarchexp
4d20abad
NC
365 vendorbinexp
366 vendorhtml1direxp
367 vendorhtml3direxp
91f668c3 368 vendorlibexp
4d20abad
NC
369 vendorman1direxp
370 vendorman3direxp
371 vendorscriptexp
372
373 siteprefixexp
374 sitelib_stem
1d230ada
NC
375 vendorlib_stem
376
377 installarchlib
378 installhtml1dir
379 installhtml3dir
380 installman1dir
381 installman3dir
382 installprefix
383 installprefixexp
384 installprivlib
385 installscript
386 installsitearch
387 installsitebin
388 installsitehtml1dir
389 installsitehtml3dir
390 installsitelib
391 installsiteman1dir
392 installsiteman3dir
393 installsitescript
394 installvendorarch
395 installvendorbin
396 installvendorhtml1dir
397 installvendorhtml3dir
398 installvendorlib
399 installvendorman1dir
400 installvendorman3dir
401 installvendorscript
402 )) {
88fe16b2
NC
403 push @need_relocation, $what if fetch_string({}, $what) =~ m!^\.\.\./!;
404 }
88fe16b2
NC
405}
406
407my %need_relocation;
408@need_relocation{@need_relocation} = @need_relocation;
409
91f668c3
NC
410# This can have .../ anywhere:
411if (fetch_string({}, 'otherlibdirs') =~ m!\.\.\./!) {
412 $need_relocation{otherlibdirs} = 'otherlibdirs';
413}
414
88fe16b2
NC
415my $relocation_code = <<'EOT';
416
417sub relocate_inc {
418 my $libdir = shift;
419 return $libdir unless $libdir =~ s!^\.\.\./!!;
420 my $prefix = $^X;
421 if ($prefix =~ s!/[^/]*$!!) {
422 while ($libdir =~ m!^\.\./!) {
423 # Loop while $libdir starts "../" and $prefix still has a trailing
424 # directory
425 last unless $prefix =~ s!/([^/]+)$!!;
426 # but bail out if the directory we picked off the end of $prefix is .
427 # or ..
428 if ($1 eq '.' or $1 eq '..') {
429 # Undo! This should be rare, hence code it this way rather than a
430 # check each time before the s!!! above.
431 $prefix = "$prefix/$1";
432 last;
433 }
434 # Remove that leading ../ and loop again
435 substr ($libdir, 0, 3, '');
436 }
437 $libdir = "$prefix/$libdir";
438 }
439 $libdir;
440}
441EOT
442
91f668c3 443if (%need_relocation) {
88fe16b2 444 my $relocations_in_common;
91f668c3
NC
445 # otherlibdirs only features in the hash
446 foreach (keys %need_relocation) {
88fe16b2
NC
447 $relocations_in_common++ if $Common{$_};
448 }
449 if ($relocations_in_common) {
962e59f3 450 $config_txt .= $relocation_code;
88fe16b2 451 } else {
962e59f3 452 $heavy_txt .= $relocation_code;
88fe16b2
NC
453 }
454}
455
962e59f3 456$heavy_txt .= join('', @non_v) . "\n";
3c81428c 457
5435c704 458# copy config summary format from the myconfig.SH script
962e59f3 459$heavy_txt .= "our \$summary = <<'!END!';\n";
3b5ca523 460open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
54310121 4611 while defined($_ = <MYCONFIG>) && !/^Summary of/;
962e59f3 462do { $heavy_txt .= $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
3c81428c 463close(MYCONFIG);
a0d0e21e 464
962e59f3 465$heavy_txt .= "\n!END!\n" . <<'EOT';
90ec21fb 466my $summary_expanded;
3c81428c
PP
467
468sub myconfig {
90ec21fb
EM
469 return $summary_expanded if $summary_expanded;
470 ($summary_expanded = $summary) =~ s{\$(\w+)}
46807d8e
YO
471 {
472 my $c;
473 if ($1 eq 'git_ancestor_line') {
474 if ($Config::Config{git_ancestor}) {
475 $c= "\n Ancestor: $Config::Config{git_ancestor}";
476 } else {
477 $c= "";
478 }
479 } else {
480 $c = $Config::Config{$1};
481 }
482 defined($c) ? $c : 'undef'
483 }ge;
90ec21fb 484 $summary_expanded;
3c81428c 485}
5435c704 486
8468119f
NC
487local *_ = \my $a;
488$_ = <<'!END!';
3c81428c
PP
489EOT
490
962e59f3 491$heavy_txt .= join('', sort @v_others) . "!END!\n";
2855b621
NC
492
493# Only need the dynamic byteorder code in Config.pm if 'byteorder' is one of
494# the precached keys
495if ($Common{byteorder}) {
962e59f3 496 $config_txt .= $byteorder_code;
2855b621 497} else {
962e59f3 498 $heavy_txt .= $byteorder_code;
2855b621 499}
5435c704 500
88fe16b2 501if (@need_relocation) {
962e59f3
DM
502$heavy_txt .= 'foreach my $what (qw(' . join (' ', @need_relocation) .
503 ")) {\n" . <<'EOT';
8d962fa1 504 s/^($what=)(['"])(.*?)\2/$1 . $2 . relocate_inc($3) . $2/me;
88fe16b2
NC
505}
506EOT
91f668c3
NC
507# Currently it only makes sense to do the ... relocation on Unix, so there's
508# no need to emulate the "which separator for this platform" logic in perl.c -
509# ':' will always be applicable
510if ($need_relocation{otherlibdirs}) {
962e59f3 511$heavy_txt .= << 'EOT';
91f668c3
NC
512s{^(otherlibdirs=)(['"])(.*?)\2}
513 {$1 . $2 . join ':', map {relocate_inc($_)} split ':', $3 . $2}me;
514EOT
515}
88fe16b2
NC
516}
517
962e59f3 518$heavy_txt .= <<'EOT';
2d9d8159 519s/(byteorder=)(['"]).*?\2/$1$2$Config::byteorder$2/m;
43d06990
NC
520
521my $config_sh_len = length $_;
3be00128 522
e935c5a4 523our $Config_SH_expanded = "\n$_" . << 'EOVIRTUAL';
8468119f
NC
524EOT
525
06482b90
NC
526foreach my $prefix (qw(ccflags ldflags)) {
527 my $value = fetch_string ({}, $prefix);
528 my $withlargefiles = fetch_string ({}, $prefix . "_uselargefiles");
27da23d5
JH
529 if (defined $withlargefiles) {
530 $value =~ s/\Q$withlargefiles\E\b//;
962e59f3 531 $heavy_txt .= "${prefix}_nolargefiles='$value'\n";
27da23d5 532 }
06482b90 533}
5435c704 534
06482b90
NC
535foreach my $prefix (qw(libs libswanted)) {
536 my $value = fetch_string ({}, $prefix);
27da23d5
JH
537 my $withlf = fetch_string ({}, 'libswanted_uselargefiles');
538 next unless defined $withlf;
06482b90
NC
539 my @lflibswanted
540 = split(' ', fetch_string ({}, 'libswanted_uselargefiles'));
541 if (@lflibswanted) {
542 my %lflibswanted;
543 @lflibswanted{@lflibswanted} = ();
544 if ($prefix eq 'libs') {
545 my @libs = grep { /^-l(.+)/ &&
546 not exists $lflibswanted{$1} }
547 split(' ', fetch_string ({}, 'libs'));
548 $value = join(' ', @libs);
549 } else {
550 my @libswanted = grep { not exists $lflibswanted{$_} }
551 split(' ', fetch_string ({}, 'libswanted'));
552 $value = join(' ', @libswanted);
4b2ec495 553 }
435ec615 554 }
962e59f3 555 $heavy_txt .= "${prefix}_nolargefiles='$value'\n";
5435c704
NC
556}
557
962e59f3 558$heavy_txt .= "EOVIRTUAL\n";
06482b90 559
46807d8e 560$heavy_txt .= <<'ENDOFGIT';
505afc73 561eval {
12d7e04d
YO
562 # do not have hairy conniptions if this isnt available
563 require 'Config_git.pl';
564 $Config_SH_expanded .= $Config::Git_Data;
505afc73
YO
565 1;
566} or warn "Warning: failed to load Config_git.pl, something strange about this perl...\n";
46807d8e
YO
567ENDOFGIT
568
962e59f3 569$heavy_txt .= $fetch_string;
06482b90 570
962e59f3 571$config_txt .= <<'ENDOFEND';
06482b90 572
2d9d8159 573sub FETCH {
5435c704
NC
574 my($self, $key) = @_;
575
576 # check for cached value (which may be undef so we use exists not defined)
577 return $self->{$key} if exists $self->{$key};
578
06482b90 579 return $self->fetch_string($key);
a0d0e21e 580}
2d9d8159
NC
581ENDOFEND
582
962e59f3 583$heavy_txt .= <<'ENDOFEND';
1a9ca827 584
3c81428c
PP
585my $prevpos = 0;
586
a0d0e21e
LW
587sub FIRSTKEY {
588 $prevpos = 0;
2ddb7828 589 substr($Config_SH_expanded, 1, index($Config_SH_expanded, '=') - 1 );
a0d0e21e
LW
590}
591
592sub NEXTKEY {
1a9ca827
NC
593ENDOFEND
594if ($seen_quotes{'"'}) {
962e59f3 595$heavy_txt .= <<'ENDOFEND';
435ec615 596 # Find out how the current key's quoted so we can skip to its end.
3be00128
NC
597 my $quote = substr($Config_SH_expanded,
598 index($Config_SH_expanded, "=", $prevpos)+1, 1);
599 my $pos = index($Config_SH_expanded, qq($quote\n), $prevpos) + 2;
1a9ca827
NC
600ENDOFEND
601} else {
602 # Just ' quotes, so it's much easier.
962e59f3 603$heavy_txt .= <<'ENDOFEND';
1a9ca827
NC
604 my $pos = index($Config_SH_expanded, qq('\n), $prevpos) + 2;
605ENDOFEND
606}
962e59f3 607$heavy_txt .= <<'ENDOFEND';
3be00128 608 my $len = index($Config_SH_expanded, "=", $pos) - $pos;
a0d0e21e 609 $prevpos = $pos;
3be00128 610 $len > 0 ? substr($Config_SH_expanded, $pos, $len) : undef;
85e6fe83 611}
a0d0e21e 612
2ddb7828 613sub EXISTS {
5435c704
NC
614 return 1 if exists($_[0]->{$_[1]});
615
1a9ca827
NC
616 return(index($Config_SH_expanded, "\n$_[1]='") != -1
617ENDOFEND
618if ($seen_quotes{'"'}) {
962e59f3 619$heavy_txt .= <<'ENDOFEND';
1a9ca827
NC
620 or index($Config_SH_expanded, "\n$_[1]=\"") != -1
621ENDOFEND
622}
962e59f3 623$heavy_txt .= <<'ENDOFEND';
5435c704 624 );
a0d0e21e
LW
625}
626
3c81428c 627sub STORE { die "\%Config::Config is read-only\n" }
5435c704
NC
628*DELETE = \&STORE;
629*CLEAR = \&STORE;
a0d0e21e 630
3c81428c
PP
631
632sub config_sh {
43d06990 633 substr $Config_SH_expanded, 1, $config_sh_len;
748a9306 634}
9193ea20
PP
635
636sub config_re {
637 my $re = shift;
3be00128
NC
638 return map { chomp; $_ } grep eval{ /^(?:$re)=/ }, split /^/,
639 $Config_SH_expanded;
9193ea20
PP
640}
641
3c81428c 642sub config_vars {
307dc113 643 # implements -V:cfgvar option (see perlrun -V:)
a48f8c77 644 foreach (@_) {
307dc113 645 # find optional leading, trailing colons; and query-spec
4a305f6a 646 my ($notag,$qry,$lncont) = m/^(:)?(.*?)(:)?$/; # flags fore and aft,
307dc113
JC
647 # map colon-flags to print decorations
648 my $prfx = $notag ? '': "$qry="; # tag-prefix for print
649 my $lnend = $lncont ? ' ' : ";\n"; # line ending for print
4a305f6a 650
307dc113 651 # all config-vars are by definition \w only, any \W means regex
4a305f6a
JC
652 if ($qry =~ /\W/) {
653 my @matches = config_re($qry);
654 print map "$_$lnend", @matches ? @matches : "$qry: not found" if !$notag;
655 print map { s/\w+=//; "$_$lnend" } @matches ? @matches : "$qry: not found" if $notag;
a48f8c77 656 } else {
2d9d8159
NC
657 my $v = (exists $Config::Config{$qry}) ? $Config::Config{$qry}
658 : 'UNKNOWN';
a48f8c77 659 $v = 'undef' unless defined $v;
4a305f6a 660 print "${prfx}'${v}'$lnend";
a48f8c77 661 }
3c81428c
PP
662 }
663}
664
2d9d8159
NC
665# Called by the real AUTOLOAD
666sub launcher {
667 undef &AUTOLOAD;
668 goto \&$Config::AUTOLOAD;
669}
670
6711;
9193ea20
PP
672ENDOFEND
673
674if ($^O eq 'os2') {
962e59f3 675 $config_txt .= <<'ENDOFSET';
9193ea20
PP
676my %preconfig;
677if ($OS2::is_aout) {
3be00128 678 my ($value, $v) = $Config_SH_expanded =~ m/^used_aout='(.*)'\s*$/m;
9193ea20 679 for (split ' ', $value) {
3be00128 680 ($v) = $Config_SH_expanded =~ m/^aout_$_='(.*)'\s*$/m;
9193ea20
PP
681 $preconfig{$_} = $v eq 'undef' ? undef : $v;
682 }
683}
764df951 684$preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't
9193ea20
PP
685sub TIEHASH { bless {%preconfig} }
686ENDOFSET
a48f8c77
MS
687 # Extract the name of the DLL from the makefile to avoid duplication
688 my ($f) = grep -r, qw(GNUMakefile Makefile);
689 my $dll;
690 if (open my $fh, '<', $f) {
691 while (<$fh>) {
692 $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
693 }
30500b05 694 }
962e59f3 695 $config_txt .= <<ENDOFSET if $dll;
30500b05
IZ
696\$preconfig{dll_name} = '$dll';
697ENDOFSET
9193ea20 698} else {
962e59f3 699 $config_txt .= <<'ENDOFSET';
5435c704
NC
700sub TIEHASH {
701 bless $_[1], $_[0];
702}
9193ea20
PP
703ENDOFSET
704}
705
a8e1d30b
NC
706foreach my $key (keys %Common) {
707 my $value = fetch_string ({}, $key);
708 # Is it safe on the LHS of => ?
709 my $qkey = $key =~ /^[A-Za-z_][A-Za-z0-9_]*$/ ? $key : "'$key'";
710 if (defined $value) {
711 # Quote things for a '' string
712 $value =~ s!\\!\\\\!g;
713 $value =~ s!'!\\'!g;
714 $value = "'$value'";
91f668c3
NC
715 if ($key eq 'otherlibdirs') {
716 $value = "join (':', map {relocate_inc(\$_)} split (':', $value))";
717 } elsif ($need_relocation{$key}) {
88fe16b2
NC
718 $value = "relocate_inc($value)";
719 }
a8e1d30b
NC
720 } else {
721 $value = "undef";
722 }
723 $Common{$key} = "$qkey => $value";
724}
2855b621
NC
725
726if ($Common{byteorder}) {
727 $Common{byteorder} = 'byteorder => $byteorder';
728}
729my $fast_config = join '', map { " $_,\n" } sort values %Common;
5435c704 730
938af39e
NC
731# Sanity check needed to stop an infite loop if Config_heavy.pl fails to define
732# &launcher for some reason (eg it got truncated)
962e59f3 733$config_txt .= sprintf <<'ENDOFTIE', $fast_config;
9193ea20 734
fb73857a
PP
735sub DESTROY { }
736
2d9d8159 737sub AUTOLOAD {
c1b2b415 738 require 'Config_heavy.pl';
938af39e 739 goto \&launcher unless $Config::AUTOLOAD =~ /launcher$/;
2d9d8159
NC
740 die "&Config::AUTOLOAD failed on $Config::AUTOLOAD";
741}
742
2c165900 743# tie returns the object, so the value returned to require will be true.
5435c704 744tie %%Config, 'Config', {
a8e1d30b 745%s};
5435c704
NC
746ENDOFTIE
747
748a9306 748
8ed6d636 749open(CONFIG_POD, ">$Config_POD") or die "Can't open $Config_POD: $!";
5435c704 750print CONFIG_POD <<'ENDOFTAIL';
3c81428c 751=head1 NAME
a0d0e21e 752
3c81428c
PP
753Config - access Perl configuration information
754
755=head1 SYNOPSIS
756
757 use Config;
63f18be6
NC
758 if ($Config{usethreads}) {
759 print "has thread support\n"
3c81428c
PP
760 }
761
a48f8c77 762 use Config qw(myconfig config_sh config_vars config_re);
3c81428c
PP
763
764 print myconfig();
765
766 print config_sh();
767
a48f8c77
MS
768 print config_re();
769
3c81428c
PP
770 config_vars(qw(osname archname));
771
772
773=head1 DESCRIPTION
774
775The Config module contains all the information that was available to
776the C<Configure> program at Perl build time (over 900 values).
777
778Shell variables from the F<config.sh> file (written by Configure) are
779stored in the readonly-variable C<%Config>, indexed by their names.
780
781Values stored in config.sh as 'undef' are returned as undefined
1fef88e7 782values. The perl C<exists> function can be used to check if a
3c81428c
PP
783named variable exists.
784
3acf89b2
MB
785For a description of the variables, please have a look at the
786Glossary file, as written in the Porting folder, or use the url:
787http://perl5.git.perl.org/perl.git/blob/HEAD:/Porting/Glossary
788
3c81428c
PP
789=over 4
790
791=item myconfig()
792
793Returns a textual summary of the major perl configuration values.
794See also C<-V> in L<perlrun/Switches>.
795
796=item config_sh()
797
798Returns the entire perl configuration information in the form of the
799original config.sh shell variable assignment script.
800
a48f8c77
MS
801=item config_re($regex)
802
803Like config_sh() but returns, as a list, only the config entries who's
804names match the $regex.
805
3c81428c
PP
806=item config_vars(@names)
807
808Prints to STDOUT the values of the named configuration variable. Each is
809printed on a separate line in the form:
810
811 name='value';
812
813Names which are unknown are output as C<name='UNKNOWN';>.
814See also C<-V:name> in L<perlrun/Switches>.
815
816=back
817
818=head1 EXAMPLE
819
820Here's a more sophisticated example of using %Config:
821
822 use Config;
743c51bc
WK
823 use strict;
824
825 my %sig_num;
826 my @sig_name;
827 unless($Config{sig_name} && $Config{sig_num}) {
828 die "No sigs?";
829 } else {
830 my @names = split ' ', $Config{sig_name};
831 @sig_num{@names} = split ' ', $Config{sig_num};
832 foreach (@names) {
833 $sig_name[$sig_num{$_}] ||= $_;
834 }
835 }
3c81428c 836
743c51bc
WK
837 print "signal #17 = $sig_name[17]\n";
838 if ($sig_num{ALRM}) {
839 print "SIGALRM is $sig_num{ALRM}\n";
3c81428c
PP
840 }
841
842=head1 WARNING
843
844Because this information is not stored within the perl executable
845itself it is possible (but unlikely) that the information does not
846relate to the actual perl binary which is being used to access it.
847
848The Config module is installed into the architecture and version
849specific library directory ($Config{installarchlib}) and it checks the
850perl version number when loaded.
851
435ec615
HM
852The values stored in config.sh may be either single-quoted or
853double-quoted. Double-quoted strings are handy for those cases where you
854need to include escape sequences in the strings. To avoid runtime variable
855interpolation, any C<$> and C<@> characters are replaced by C<\$> and
856C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
857or C<\@> in double-quoted strings unless you're willing to deal with the
858consequences. (The slashes will end up escaped and the C<$> or C<@> will
859trigger variable interpolation)
860
ebc74a4b
GS
861=head1 GLOSSARY
862
863Most C<Config> variables are determined by the C<Configure> script
864on platforms supported by it (which is most UNIX platforms). Some
865platforms have custom-made C<Config> variables, and may thus not have
866some of the variables described below, or may have extraneous variables
867specific to that particular port. See the port specific documentation
868in such cases.
869
c90cd22b
RGS
870=cut
871
ebc74a4b
GS
872ENDOFTAIL
873
5435c704
NC
874if ($Opts{glossary}) {
875 open(GLOS, "<$Glossary") or die "Can't open $Glossary: $!";
18f68570 876}
2f4f46ad
NC
877my %seen = ();
878my $text = 0;
fb87c415
IZ
879$/ = '';
880
881sub process {
aade5aff
YST
882 if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
883 my $c = substr $1, 0, 1;
884 unless ($seen{$c}++) {
5435c704 885 print CONFIG_POD <<EOF if $text;
fb87c415 886=back
ebc74a4b 887
c90cd22b
RGS
888=cut
889
fb87c415 890EOF
5435c704 891 print CONFIG_POD <<EOF;
fb87c415
IZ
892=head2 $c
893
bbc7dcd2 894=over 4
fb87c415 895
c90cd22b
RGS
896=cut
897
fb87c415 898EOF
aade5aff
YST
899 $text = 1;
900 }
901 }
902 elsif (!$text || !/\A\t/) {
903 warn "Expected a Configure variable header",
904 ($text ? " or another paragraph of description" : () );
fb87c415
IZ
905 }
906 s/n't/n\00t/g; # leave can't, won't etc untouched
9b22980b 907 s/^\t\s+(.*)/\n$1/gm; # Indented lines ===> new paragraph
fb87c415
IZ
908 s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text
909 s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
910 s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
911 s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
912 s{
913 (?<! [\w./<\'\"] ) # Only standalone file names
914 (?! e \. g \. ) # Not e.g.
915 (?! \. \. \. ) # Not ...
916 (?! \d ) # Not 5.004
a1151a3c
RGS
917 (?! read/ ) # Not read/write
918 (?! etc\. ) # Not etc.
919 (?! I/O ) # Not I/O
920 (
921 \$ ? # Allow leading $
922 [\w./]* [./] [\w./]* # Require . or / inside
923 )
924 (?<! \. (?= [\s)] ) ) # Do not include trailing dot
fb87c415
IZ
925 (?! [\w/] ) # Include all of it
926 }
927 (F<$1>)xg; # /usr/local
928 s/((?<=\s)~\w*)/F<$1>/g; # ~name
929 s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD
930 s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
931 s/n[\0]t/n't/g; # undo can't, won't damage
ebc74a4b
GS
932}
933
5435c704 934if ($Opts{glossary}) {
7701ffb5
JH
935 <GLOS>; # Skip the "DO NOT EDIT"
936 <GLOS>; # Skip the preamble
18f68570
VK
937 while (<GLOS>) {
938 process;
5435c704 939 print CONFIG_POD;
18f68570 940 }
fb87c415 941}
ebc74a4b 942
5435c704 943print CONFIG_POD <<'ENDOFTAIL';
ebc74a4b
GS
944
945=back
946
58ab6743
RS
947=head1 GIT DATA
948
949Information on the git commit from which the current perl binary was compiled
950can be found in the variable C<$Config::Git_Data>. The variable is a
951structured string that looks something like this:
952
953 git_commit_id='ea0c2dbd5f5ac6845ecc7ec6696415bf8e27bd52'
954 git_describe='GitLive-blead-1076-gea0c2db'
955 git_branch='smartmatch'
956 git_uncommitted_changes=''
957 git_commit_id_title='Commit id:'
958 git_commit_date='2009-05-09 17:47:31 +0200'
959
960Its format is not guaranteed not to change over time.
961
3c81428c
PP
962=head1 NOTE
963
964This module contains a good example of how to use tie to implement a
965cache and an example of how to make a tied variable readonly to those
966outside of it.
967
968=cut
a0d0e21e 969
9193ea20 970ENDOFTAIL
a0d0e21e 971
962e59f3 972close(GLOS) if $Opts{glossary};
5435c704 973close(CONFIG_POD);
8ed6d636 974print "written $Config_POD\n";
962e59f3
DM
975
976my $orig_config_txt = "";
977my $orig_heavy_txt = "";
978{
979 local $/;
980 my $fh;
981 $orig_config_txt = <$fh> if open $fh, "<", $Config_PM;
982 $orig_heavy_txt = <$fh> if open $fh, "<", $Config_heavy;
983}
984
985if ($orig_config_txt ne $config_txt or $orig_heavy_txt ne $heavy_txt) {
986 open CONFIG, ">", $Config_PM or die "Can't open $Config_PM: $!\n";
987 open CONFIG_HEAVY, ">", $Config_heavy or die "Can't open $Config_heavy: $!\n";
988 print CONFIG $config_txt;
989 print CONFIG_HEAVY $heavy_txt;
990 close(CONFIG_HEAVY);
991 close(CONFIG);
992 print "updated $Config_PM\n";
993 print "updated $Config_heavy\n";
994}
995
a0d0e21e 996
18f68570 997# Now create Cross.pm if needed
5435c704 998if ($Opts{cross}) {
18f68570 999 open CROSS, ">lib/Cross.pm" or die "Can not open >lib/Cross.pm: $!";
47bcb90d
VK
1000 my $cross = <<'EOS';
1001# typical invocation:
1002# perl -MCross Makefile.PL
1003# perl -MCross=wince -V:cc
1004package Cross;
1005
1006sub import {
1007 my ($package,$platform) = @_;
1008 unless (defined $platform) {
1009 # if $platform is not specified, then use last one when
1010 # 'configpm; was invoked with --cross option
1011 $platform = '***replace-marker***';
1012 }
1013 @INC = map {/\blib\b/?(do{local $_=$_;s/\blib\b/xlib\/$platform/;$_},$_):($_)} @INC;
e2a02c1e 1014 $::Cross::platform = $platform;
18f68570 1015}
47bcb90d 1016
18f68570
VK
10171;
1018EOS
5435c704 1019 $cross =~ s/\*\*\*replace-marker\*\*\*/$Opts{cross}/g;
47bcb90d 1020 print CROSS $cross;
18f68570 1021 close CROSS;
962e59f3 1022 print "written lib/Cross.pm\n";
42d1cefd 1023 unshift(@INC,"xlib/$Opts{cross}");
18f68570
VK
1024}
1025
a0d0e21e
LW
1026# Now do some simple tests on the Config.pm file we have created
1027unshift(@INC,'lib');
27da23d5 1028unshift(@INC,'xlib/symbian') if $Opts{cross};
5435c704 1029require $Config_PM;
ae7e4cc1 1030require $Config_heavy;
a0d0e21e
LW
1031import Config;
1032
5435c704 1033die "$0: $Config_PM not valid"
a02608de 1034 unless $Config{'PERL_CONFIG_SH'} eq 'true';
a0d0e21e 1035
5435c704 1036die "$0: error processing $Config_PM"
a0d0e21e 1037 if defined($Config{'an impossible name'})
a02608de 1038 or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache
a0d0e21e
LW
1039 ;
1040
5435c704 1041die "$0: error processing $Config_PM"
a0d0e21e
LW
1042 if eval '$Config{"cc"} = 1'
1043 or eval 'delete $Config{"cc"}'
1044 ;
1045
1046
85e6fe83 1047exit 0;
a8e1d30b
NC
1048# Popularity of various entries in %Config, based on a large build and test
1049# run of code in the Fotango build system:
1050__DATA__
1051path_sep: 8490
1052d_readlink: 7101
1053d_symlink: 7101
1054archlibexp: 4318
1055sitearchexp: 4305
1056sitelibexp: 4305
1057privlibexp: 4163
1058ldlibpthname: 4041
1059libpth: 2134
1060archname: 1591
1061exe_ext: 1256
1062scriptdir: 1155
1063version: 1116
1064useithreads: 1002
1065osvers: 982
1066osname: 851
1067inc_version_list: 783
1068dont_use_nlink: 779
1069intsize: 759
1070usevendorprefix: 642
1071dlsrc: 624
1072cc: 541
1073lib_ext: 520
1074so: 512
1075ld: 501
1076ccdlflags: 500
1077ldflags: 495
1078obj_ext: 495
1079cccdlflags: 493
1080lddlflags: 493
1081ar: 492
1082dlext: 492
1083libc: 492
1084ranlib: 492
1085full_ar: 491
1086vendorarchexp: 491
1087vendorlibexp: 491
1088installman1dir: 489
1089installman3dir: 489
1090installsitebin: 489
1091installsiteman1dir: 489
1092installsiteman3dir: 489
1093installvendorman1dir: 489
1094installvendorman3dir: 489
1095d_flexfnam: 474
1096eunicefix: 360
1097d_link: 347
1098installsitearch: 344
1099installscript: 341
1100installprivlib: 337
1101binexp: 336
1102installarchlib: 336
1103installprefixexp: 336
1104installsitelib: 336
1105installstyle: 336
1106installvendorarch: 336
1107installvendorbin: 336
1108installvendorlib: 336
1109man1ext: 336
1110man3ext: 336
1111sh: 336
1112siteprefixexp: 336
1113installbin: 335
1114usedl: 332
1115ccflags: 285
1116startperl: 232
1117optimize: 231
1118usemymalloc: 229
1119cpprun: 228
1120sharpbang: 228
1121perllibs: 225
1122usesfio: 224
1123usethreads: 220
1124perlpath: 218
1125extensions: 217
1126usesocks: 208
1127shellflags: 198
1128make: 191
1129d_pwage: 189
1130d_pwchange: 189
1131d_pwclass: 189
1132d_pwcomment: 189
1133d_pwexpire: 189
1134d_pwgecos: 189
1135d_pwpasswd: 189
1136d_pwquota: 189
1137gccversion: 189
1138libs: 186
1139useshrplib: 186
1140cppflags: 185
1141ptrsize: 185
1142shrpenv: 185
1143static_ext: 185
1144use5005threads: 185
1145uselargefiles: 185
1146alignbytes: 184
1147byteorder: 184
1148ccversion: 184
1149config_args: 184
1150cppminus: 184