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