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