1 |
#!./miniperl -w |
2 |
use strict; |
3 |
use vars qw(%Config $Config_SH_expanded); |
4 |
|
5 |
my $how_many_common = 22; |
6 |
|
7 |
# commonly used names to precache (and hence lookup fastest) |
8 |
my %Common; |
9 |
|
10 |
while ($how_many_common--) { |
11 |
$_ = <DATA>; |
12 |
chomp; |
13 |
/^(\S+):\s*(\d+)$/ or die "Malformed line '$_'"; |
14 |
$Common{$1} = $1; |
15 |
} |
16 |
|
17 |
# names of things which may need to have slashes changed to double-colons |
18 |
my %Extensions = map {($_,$_)} |
19 |
qw(dynamic_ext static_ext extensions known_extensions); |
20 |
|
21 |
# allowed opts as well as specifies default and initial values |
22 |
my %Allowed_Opts = ( |
23 |
'cross' => '', # --cross=PLATFORM - crosscompiling for PLATFORM |
24 |
'glossary' => 1, # --no-glossary - no glossary file inclusion, |
25 |
# for compactness |
26 |
'heavy' => '', # pathname of the Config_heavy.pl file |
27 |
); |
28 |
|
29 |
sub 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 |
} |
47 |
|
48 |
|
49 |
my %Opts = opts(); |
50 |
|
51 |
my ($Config_PM, $Config_heavy); |
52 |
my $Glossary = $ARGV[1] || 'Porting/Glossary'; |
53 |
|
54 |
if ($Opts{cross}) { |
55 |
# creating cross-platform config file |
56 |
mkdir "xlib"; |
57 |
mkdir "xlib/$Opts{cross}"; |
58 |
$Config_PM = $ARGV[0] || "xlib/$Opts{cross}/Config.pm"; |
59 |
} |
60 |
else { |
61 |
$Config_PM = $ARGV[0] || 'lib/Config.pm'; |
62 |
} |
63 |
if ($Opts{heavy}) { |
64 |
$Config_heavy = $Opts{heavy}; |
65 |
} |
66 |
else { |
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 |
} |
71 |
|
72 |
open CONFIG, ">$Config_PM" or die "Can't open $Config_PM: $!\n"; |
73 |
open CONFIG_HEAVY, ">$Config_heavy" or die "Can't open $Config_heavy: $!\n"; |
74 |
|
75 |
print 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 |
|
79 |
package Config; |
80 |
use strict; |
81 |
# use warnings; Pulls in Carp |
82 |
# use vars pulls in Carp |
83 |
ENDOFBEG |
84 |
|
85 |
my $myver = sprintf "v%vd", $^V; |
86 |
|
87 |
printf 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. |
90 |
|
91 |
package Config; |
92 |
use 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); |
97 |
|
98 |
# Need to stub all the functions to make code such as print Config::config_sh |
99 |
# keep working |
100 |
|
101 |
sub myconfig; |
102 |
sub config_sh; |
103 |
sub config_vars; |
104 |
sub config_re; |
105 |
|
106 |
my %%Export_Cache = map {($_ => 1)} (@Config::EXPORT, @Config::EXPORT_OK); |
107 |
|
108 |
our %%Config; |
109 |
|
110 |
# Define our own import method to avoid pulling in the full Exporter: |
111 |
sub import { |
112 |
my $pkg = shift; |
113 |
@_ = @Config::EXPORT unless @_; |
114 |
|
115 |
my @funcs = grep $_ ne '%%Config', @_; |
116 |
my $export_Config = @funcs < @_ ? 1 : 0; |
117 |
|
118 |
no strict 'refs'; |
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 |
} |
125 |
|
126 |
*{"$callpkg\::Config"} = \%%Config if $export_Config; |
127 |
return; |
128 |
} |
129 |
|
130 |
die "Perl lib version (%s) doesn't match executable version ($])" |
131 |
unless $^V; |
132 |
|
133 |
$^V eq %s |
134 |
or die "Perl lib version (%s) doesn't match executable version (" . |
135 |
sprintf("v%%vd",$^V) . ")"; |
136 |
|
137 |
ENDOFBEG |
138 |
|
139 |
|
140 |
my @non_v = (); |
141 |
my @v_others = (); |
142 |
my $in_v = 0; |
143 |
my %Data = (); |
144 |
|
145 |
|
146 |
my %seen_quotes; |
147 |
{ |
148 |
my ($name, $val); |
149 |
open(CONFIG_SH, 'config.sh') || die "Can't open config.sh: $!"; |
150 |
while (<CONFIG_SH>) { |
151 |
next if m:^#!/bin/sh:; |
152 |
|
153 |
# Catch PERL_CONFIG_SH=true and PERL_VERSION=n line from Configure. |
154 |
s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/ or m/^(\w+)='(.*)'$/; |
155 |
my($k, $v) = ($1, $2); |
156 |
|
157 |
# grandfather PATCHLEVEL and SUBVERSION and CONFIG |
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 |
} |
165 |
elsif ($k eq 'PERL_CONFIG_SH') { |
166 |
push @v_others, "CONFIG='$v'\n"; |
167 |
} |
168 |
} |
169 |
|
170 |
# We can delimit things in config.sh with either ' or ". |
171 |
unless ($in_v or m/^(\w+)=(['"])(.*\n)/){ |
172 |
push(@non_v, "#$_"); # not a name='value' line |
173 |
next; |
174 |
} |
175 |
my $quote = $2; |
176 |
if ($in_v) { |
177 |
$val .= $_; |
178 |
} |
179 |
else { |
180 |
($name,$val) = ($1,$3); |
181 |
} |
182 |
$in_v = $val !~ /$quote\n/; |
183 |
next if $in_v; |
184 |
|
185 |
s,/,::,g if $Extensions{$name}; |
186 |
|
187 |
$val =~ s/$quote\n?\z//; |
188 |
|
189 |
my $line = "$name=$quote$val$quote\n"; |
190 |
push(@v_others, $line); |
191 |
$seen_quotes{$quote}++; |
192 |
} |
193 |
close CONFIG_SH; |
194 |
} |
195 |
|
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 |
|
199 |
my $fetch_string = <<'EOT'; |
200 |
|
201 |
# Search for it in the big string |
202 |
sub fetch_string { |
203 |
my($self, $key) = @_; |
204 |
|
205 |
EOT |
206 |
|
207 |
if ($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 |
} |
220 |
EOT |
221 |
} else { |
222 |
$fetch_string .= <<'EOT'; |
223 |
# We only have ' delimted. |
224 |
my $start = index($Config_SH_expanded, "\n$key=\'"); |
225 |
EOT |
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 |
|
234 |
EOT |
235 |
if (!$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); |
241 |
EOT |
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 |
} |
257 |
EOT |
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 |
} |
264 |
EOT |
265 |
|
266 |
eval $fetch_string; |
267 |
die if $@; |
268 |
|
269 |
# Calculation for the keys for byteorder |
270 |
# This is somewhat grim, but I need to run fetch_string here. |
271 |
our $Config_SH_expanded = join "\n", '', @v_others; |
272 |
|
273 |
my $t = fetch_string ({}, 'ivtype'); |
274 |
my $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 |
|
281 |
my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I'; |
282 |
|
283 |
my $byteorder_code; |
284 |
if ($s == 4 || $s == 8) { |
285 |
my $list = join ',', reverse(2..$s); |
286 |
my $format = 'a'x$s; |
287 |
$byteorder_code = <<"EOT"; |
288 |
|
289 |
my \$i = 0; |
290 |
foreach my \$c ($list) { \$i |= ord(\$c); \$i <<= 8 } |
291 |
\$i |= ord(1); |
292 |
our \$byteorder = join('', unpack('$format', pack('$f', \$i))); |
293 |
EOT |
294 |
} else { |
295 |
$byteorder_code = "our \$byteorder = '?'x$s;\n"; |
296 |
} |
297 |
|
298 |
print CONFIG_HEAVY @non_v, "\n"; |
299 |
|
300 |
# copy config summary format from the myconfig.SH script |
301 |
print CONFIG_HEAVY "our \$summary : unique = <<'!END!';\n"; |
302 |
open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!"; |
303 |
1 while defined($_ = <MYCONFIG>) && !/^Summary of/; |
304 |
do { print CONFIG_HEAVY $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/; |
305 |
close(MYCONFIG); |
306 |
|
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 |
|
311 |
print CONFIG_HEAVY "\n!END!\n", <<'EOT'; |
312 |
my $summary_expanded; |
313 |
|
314 |
sub myconfig { |
315 |
return $summary_expanded if $summary_expanded; |
316 |
($summary_expanded = $summary) =~ s{\$(\w+)} |
317 |
{ my $c = $Config::Config{$1}; defined($c) ? $c : 'undef' }ge; |
318 |
$summary_expanded; |
319 |
} |
320 |
|
321 |
local *_ = \my $a; |
322 |
$_ = <<'!END!'; |
323 |
EOT |
324 |
|
325 |
print CONFIG_HEAVY join('', sort @v_others), "!END!\n"; |
326 |
|
327 |
# Only need the dynamic byteorder code in Config.pm if 'byteorder' is one of |
328 |
# the precached keys |
329 |
if ($Common{byteorder}) { |
330 |
print CONFIG $byteorder_code; |
331 |
} else { |
332 |
print CONFIG_HEAVY $byteorder_code; |
333 |
} |
334 |
|
335 |
print CONFIG_HEAVY <<'EOT'; |
336 |
s/(byteorder=)(['"]).*?\2/$1$2$Config::byteorder$2/m; |
337 |
|
338 |
my $config_sh_len = length $_; |
339 |
|
340 |
our $Config_SH_expanded : unique = "\n$_" . << 'EOVIRTUAL'; |
341 |
EOT |
342 |
|
343 |
foreach 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//; |
347 |
print CONFIG_HEAVY "${prefix}_nolargefiles='$value'\n"; |
348 |
} |
349 |
|
350 |
foreach 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); |
366 |
} |
367 |
} |
368 |
print CONFIG_HEAVY "${prefix}_nolargefiles='$value'\n"; |
369 |
} |
370 |
|
371 |
print CONFIG_HEAVY "EOVIRTUAL\n"; |
372 |
|
373 |
print CONFIG_HEAVY $fetch_string; |
374 |
|
375 |
print CONFIG <<'ENDOFEND'; |
376 |
|
377 |
sub FETCH { |
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 |
|
383 |
return $self->fetch_string($key); |
384 |
} |
385 |
ENDOFEND |
386 |
|
387 |
print CONFIG_HEAVY <<'ENDOFEND'; |
388 |
|
389 |
my $prevpos = 0; |
390 |
|
391 |
sub FIRSTKEY { |
392 |
$prevpos = 0; |
393 |
substr($Config_SH_expanded, 1, index($Config_SH_expanded, '=') - 1 ); |
394 |
} |
395 |
|
396 |
sub NEXTKEY { |
397 |
ENDOFEND |
398 |
if ($seen_quotes{'"'}) { |
399 |
print CONFIG_HEAVY <<'ENDOFEND'; |
400 |
# Find out how the current key's quoted so we can skip to its end. |
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; |
404 |
ENDOFEND |
405 |
} else { |
406 |
# Just ' quotes, so it's much easier. |
407 |
print CONFIG_HEAVY <<'ENDOFEND'; |
408 |
my $pos = index($Config_SH_expanded, qq('\n), $prevpos) + 2; |
409 |
ENDOFEND |
410 |
} |
411 |
print CONFIG_HEAVY <<'ENDOFEND'; |
412 |
my $len = index($Config_SH_expanded, "=", $pos) - $pos; |
413 |
$prevpos = $pos; |
414 |
$len > 0 ? substr($Config_SH_expanded, $pos, $len) : undef; |
415 |
} |
416 |
|
417 |
sub EXISTS { |
418 |
return 1 if exists($_[0]->{$_[1]}); |
419 |
|
420 |
return(index($Config_SH_expanded, "\n$_[1]='") != -1 |
421 |
ENDOFEND |
422 |
if ($seen_quotes{'"'}) { |
423 |
print CONFIG_HEAVY <<'ENDOFEND'; |
424 |
or index($Config_SH_expanded, "\n$_[1]=\"") != -1 |
425 |
ENDOFEND |
426 |
} |
427 |
print CONFIG_HEAVY <<'ENDOFEND'; |
428 |
); |
429 |
} |
430 |
|
431 |
sub STORE { die "\%Config::Config is read-only\n" } |
432 |
*DELETE = \&STORE; |
433 |
*CLEAR = \&STORE; |
434 |
|
435 |
|
436 |
sub config_sh { |
437 |
substr $Config_SH_expanded, 1, $config_sh_len; |
438 |
} |
439 |
|
440 |
sub config_re { |
441 |
my $re = shift; |
442 |
return map { chomp; $_ } grep eval{ /^(?:$re)=/ }, split /^/, |
443 |
$Config_SH_expanded; |
444 |
} |
445 |
|
446 |
sub config_vars { |
447 |
# implements -V:cfgvar option (see perlrun -V:) |
448 |
foreach (@_) { |
449 |
# find optional leading, trailing colons; and query-spec |
450 |
my ($notag,$qry,$lncont) = m/^(:)?(.*?)(:)?$/; # flags fore and aft, |
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 |
454 |
|
455 |
# all config-vars are by definition \w only, any \W means regex |
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; |
460 |
} else { |
461 |
my $v = (exists $Config::Config{$qry}) ? $Config::Config{$qry} |
462 |
: 'UNKNOWN'; |
463 |
$v = 'undef' unless defined $v; |
464 |
print "${prfx}'${v}'$lnend"; |
465 |
} |
466 |
} |
467 |
} |
468 |
|
469 |
# Called by the real AUTOLOAD |
470 |
sub launcher { |
471 |
undef &AUTOLOAD; |
472 |
goto \&$Config::AUTOLOAD; |
473 |
} |
474 |
|
475 |
1; |
476 |
ENDOFEND |
477 |
|
478 |
if ($^O eq 'os2') { |
479 |
print CONFIG <<'ENDOFSET'; |
480 |
my %preconfig; |
481 |
if ($OS2::is_aout) { |
482 |
my ($value, $v) = $Config_SH_expanded =~ m/^used_aout='(.*)'\s*$/m; |
483 |
for (split ' ', $value) { |
484 |
($v) = $Config_SH_expanded =~ m/^aout_$_='(.*)'\s*$/m; |
485 |
$preconfig{$_} = $v eq 'undef' ? undef : $v; |
486 |
} |
487 |
} |
488 |
$preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't |
489 |
sub TIEHASH { bless {%preconfig} } |
490 |
ENDOFSET |
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 |
} |
498 |
} |
499 |
print CONFIG <<ENDOFSET if $dll; |
500 |
\$preconfig{dll_name} = '$dll'; |
501 |
ENDOFSET |
502 |
} else { |
503 |
print CONFIG <<'ENDOFSET'; |
504 |
sub TIEHASH { |
505 |
bless $_[1], $_[0]; |
506 |
} |
507 |
ENDOFSET |
508 |
} |
509 |
|
510 |
foreach 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 |
} |
524 |
|
525 |
if ($Common{byteorder}) { |
526 |
$Common{byteorder} = 'byteorder => $byteorder'; |
527 |
} |
528 |
my $fast_config = join '', map { " $_,\n" } sort values %Common; |
529 |
|
530 |
print CONFIG sprintf <<'ENDOFTIE', $fast_config; |
531 |
|
532 |
sub DESTROY { } |
533 |
|
534 |
sub AUTOLOAD { |
535 |
require 'Config_heavy.pl'; |
536 |
goto \&launcher; |
537 |
die "&Config::AUTOLOAD failed on $Config::AUTOLOAD"; |
538 |
} |
539 |
|
540 |
tie %%Config, 'Config', { |
541 |
%s}; |
542 |
|
543 |
1; |
544 |
ENDOFTIE |
545 |
|
546 |
|
547 |
open(CONFIG_POD, ">lib/Config.pod") or die "Can't open lib/Config.pod: $!"; |
548 |
print CONFIG_POD <<'ENDOFTAIL'; |
549 |
=head1 NAME |
550 |
|
551 |
Config - access Perl configuration information |
552 |
|
553 |
=head1 SYNOPSIS |
554 |
|
555 |
use Config; |
556 |
if ($Config{usethreads}) { |
557 |
print "has thread support\n" |
558 |
} |
559 |
|
560 |
use Config qw(myconfig config_sh config_vars config_re); |
561 |
|
562 |
print myconfig(); |
563 |
|
564 |
print config_sh(); |
565 |
|
566 |
print config_re(); |
567 |
|
568 |
config_vars(qw(osname archname)); |
569 |
|
570 |
|
571 |
=head1 DESCRIPTION |
572 |
|
573 |
The Config module contains all the information that was available to |
574 |
the C<Configure> program at Perl build time (over 900 values). |
575 |
|
576 |
Shell variables from the F<config.sh> file (written by Configure) are |
577 |
stored in the readonly-variable C<%Config>, indexed by their names. |
578 |
|
579 |
Values stored in config.sh as 'undef' are returned as undefined |
580 |
values. The perl C<exists> function can be used to check if a |
581 |
named variable exists. |
582 |
|
583 |
=over 4 |
584 |
|
585 |
=item myconfig() |
586 |
|
587 |
Returns a textual summary of the major perl configuration values. |
588 |
See also C<-V> in L<perlrun/Switches>. |
589 |
|
590 |
=item config_sh() |
591 |
|
592 |
Returns the entire perl configuration information in the form of the |
593 |
original config.sh shell variable assignment script. |
594 |
|
595 |
=item config_re($regex) |
596 |
|
597 |
Like config_sh() but returns, as a list, only the config entries who's |
598 |
names match the $regex. |
599 |
|
600 |
=item config_vars(@names) |
601 |
|
602 |
Prints to STDOUT the values of the named configuration variable. Each is |
603 |
printed on a separate line in the form: |
604 |
|
605 |
name='value'; |
606 |
|
607 |
Names which are unknown are output as C<name='UNKNOWN';>. |
608 |
See also C<-V:name> in L<perlrun/Switches>. |
609 |
|
610 |
=back |
611 |
|
612 |
=head1 EXAMPLE |
613 |
|
614 |
Here's a more sophisticated example of using %Config: |
615 |
|
616 |
use Config; |
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 |
} |
630 |
|
631 |
print "signal #17 = $sig_name[17]\n"; |
632 |
if ($sig_num{ALRM}) { |
633 |
print "SIGALRM is $sig_num{ALRM}\n"; |
634 |
} |
635 |
|
636 |
=head1 WARNING |
637 |
|
638 |
Because this information is not stored within the perl executable |
639 |
itself it is possible (but unlikely) that the information does not |
640 |
relate to the actual perl binary which is being used to access it. |
641 |
|
642 |
The Config module is installed into the architecture and version |
643 |
specific library directory ($Config{installarchlib}) and it checks the |
644 |
perl version number when loaded. |
645 |
|
646 |
The values stored in config.sh may be either single-quoted or |
647 |
double-quoted. Double-quoted strings are handy for those cases where you |
648 |
need to include escape sequences in the strings. To avoid runtime variable |
649 |
interpolation, any C<$> and C<@> characters are replaced by C<\$> and |
650 |
C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$> |
651 |
or C<\@> in double-quoted strings unless you're willing to deal with the |
652 |
consequences. (The slashes will end up escaped and the C<$> or C<@> will |
653 |
trigger variable interpolation) |
654 |
|
655 |
=head1 GLOSSARY |
656 |
|
657 |
Most C<Config> variables are determined by the C<Configure> script |
658 |
on platforms supported by it (which is most UNIX platforms). Some |
659 |
platforms have custom-made C<Config> variables, and may thus not have |
660 |
some of the variables described below, or may have extraneous variables |
661 |
specific to that particular port. See the port specific documentation |
662 |
in such cases. |
663 |
|
664 |
ENDOFTAIL |
665 |
|
666 |
my %seen = (); |
667 |
my $text = 0; |
668 |
$/ = ''; |
669 |
|
670 |
sub process { |
671 |
if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) { |
672 |
my $c = substr $1, 0, 1; |
673 |
unless ($seen{$c}++) { |
674 |
print CONFIG_POD <<EOF if $text; |
675 |
=back |
676 |
|
677 |
EOF |
678 |
print CONFIG_POD <<EOF; |
679 |
=head2 $c |
680 |
|
681 |
=over 4 |
682 |
|
683 |
EOF |
684 |
$text = 1; |
685 |
} |
686 |
} |
687 |
elsif (!$text || !/\A\t/) { |
688 |
warn "Expected a Configure variable header", |
689 |
($text ? " or another paragraph of description" : () ); |
690 |
} |
691 |
s/n't/n\00t/g; # leave can't, won't etc untouched |
692 |
s/^\t\s+(.*)/\n$1/gm; # Indented lines ===> new paragraph |
693 |
s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text |
694 |
s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o' |
695 |
s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command |
696 |
s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s' |
697 |
s{ |
698 |
(?<! [\w./<\'\"] ) # Only standalone file names |
699 |
(?! e \. g \. ) # Not e.g. |
700 |
(?! \. \. \. ) # Not ... |
701 |
(?! \d ) # Not 5.004 |
702 |
(?! read/ ) # Not read/write |
703 |
(?! etc\. ) # Not etc. |
704 |
(?! I/O ) # Not I/O |
705 |
( |
706 |
\$ ? # Allow leading $ |
707 |
[\w./]* [./] [\w./]* # Require . or / inside |
708 |
) |
709 |
(?<! \. (?= [\s)] ) ) # Do not include trailing dot |
710 |
(?! [\w/] ) # Include all of it |
711 |
} |
712 |
(F<$1>)xg; # /usr/local |
713 |
s/((?<=\s)~\w*)/F<$1>/g; # ~name |
714 |
s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD |
715 |
s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro |
716 |
s/n[\0]t/n't/g; # undo can't, won't damage |
717 |
} |
718 |
|
719 |
print CONFIG_POD <<'ENDOFTAIL'; |
720 |
|
721 |
=back |
722 |
|
723 |
=head1 NOTE |
724 |
|
725 |
This module contains a good example of how to use tie to implement a |
726 |
cache and an example of how to make a tied variable readonly to those |
727 |
outside of it. |
728 |
|
729 |
=cut |
730 |
|
731 |
ENDOFTAIL |
732 |
|
733 |
close(CONFIG_HEAVY); |
734 |
close(CONFIG); |
735 |
close(CONFIG_POD); |
736 |
|
737 |
# Now create Cross.pm if needed |
738 |
if ($Opts{cross}) { |
739 |
open CROSS, ">lib/Cross.pm" or die "Can not open >lib/Cross.pm: $!"; |
740 |
my $cross = <<'EOS'; |
741 |
# typical invocation: |
742 |
# perl -MCross Makefile.PL |
743 |
# perl -MCross=wince -V:cc |
744 |
package Cross; |
745 |
|
746 |
sub import { |
747 |
my ($package,$platform) = @_; |
748 |
unless (defined $platform) { |
749 |
# if $platform is not specified, then use last one when |
750 |
# 'configpm; was invoked with --cross option |
751 |
$platform = '***replace-marker***'; |
752 |
} |
753 |
@INC = map {/\blib\b/?(do{local $_=$_;s/\blib\b/xlib\/$platform/;$_},$_):($_)} @INC; |
754 |
$::Cross::platform = $platform; |
755 |
} |
756 |
|
757 |
1; |
758 |
EOS |
759 |
$cross =~ s/\*\*\*replace-marker\*\*\*/$Opts{cross}/g; |
760 |
print CROSS $cross; |
761 |
close CROSS; |
762 |
} |
763 |
|
764 |
# Now do some simple tests on the Config.pm file we have created |
765 |
unshift(@INC,'lib'); |
766 |
require $Config_PM; |
767 |
import Config; |
768 |
|
769 |
die "$0: $Config_PM not valid" |
770 |
unless $Config{'PERL_CONFIG_SH'} eq 'true'; |
771 |
|
772 |
die "$0: error processing $Config_PM" |
773 |
if defined($Config{'an impossible name'}) |
774 |
or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache |
775 |
; |
776 |
|
777 |
die "$0: error processing $Config_PM" |
778 |
if eval '$Config{"cc"} = 1' |
779 |
or eval 'delete $Config{"cc"}' |
780 |
; |
781 |
|
782 |
|
783 |
exit 0; |
784 |
# Popularity of various entries in %Config, based on a large build and test |
785 |
# run of code in the Fotango build system: |
786 |
__DATA__ |
787 |
path_sep: 8490 |
788 |
d_readlink: 7101 |
789 |
d_symlink: 7101 |
790 |
archlibexp: 4318 |
791 |
sitearchexp: 4305 |
792 |
sitelibexp: 4305 |
793 |
privlibexp: 4163 |
794 |
ldlibpthname: 4041 |
795 |
libpth: 2134 |
796 |
archname: 1591 |
797 |
exe_ext: 1256 |
798 |
scriptdir: 1155 |
799 |
version: 1116 |
800 |
useithreads: 1002 |
801 |
osvers: 982 |
802 |
osname: 851 |
803 |
inc_version_list: 783 |
804 |
dont_use_nlink: 779 |
805 |
intsize: 759 |
806 |
usevendorprefix: 642 |
807 |
dlsrc: 624 |
808 |
cc: 541 |
809 |
lib_ext: 520 |
810 |
so: 512 |
811 |
ld: 501 |
812 |
ccdlflags: 500 |
813 |
ldflags: 495 |
814 |
obj_ext: 495 |
815 |
cccdlflags: 493 |
816 |
lddlflags: 493 |
817 |
ar: 492 |
818 |
dlext: 492 |
819 |
libc: 492 |
820 |
ranlib: 492 |
821 |
full_ar: 491 |
822 |
vendorarchexp: 491 |
823 |
vendorlibexp: 491 |
824 |
installman1dir: 489 |
825 |
installman3dir: 489 |
826 |
installsitebin: 489 |
827 |
installsiteman1dir: 489 |
828 |
installsiteman3dir: 489 |
829 |
installvendorman1dir: 489 |
830 |
installvendorman3dir: 489 |
831 |
d_flexfnam: 474 |
832 |
eunicefix: 360 |
833 |
d_link: 347 |
834 |
installsitearch: 344 |
835 |
installscript: 341 |
836 |
installprivlib: 337 |
837 |
binexp: 336 |
838 |
installarchlib: 336 |
839 |
installprefixexp: 336 |
840 |
installsitelib: 336 |
841 |
installstyle: 336 |
842 |
installvendorarch: 336 |
843 |
installvendorbin: 336 |
844 |
installvendorlib: 336 |
845 |
man1ext: 336 |
846 |
man3ext: 336 |
847 |
sh: 336 |
848 |
siteprefixexp: 336 |
849 |
installbin: 335 |
850 |
usedl: 332 |
851 |
ccflags: 285 |
852 |
startperl: 232 |
853 |
optimize: 231 |
854 |
usemymalloc: 229 |
855 |
cpprun: 228 |
856 |
sharpbang: 228 |
857 |
perllibs: 225 |
858 |
usesfio: 224 |
859 |
usethreads: 220 |
860 |
perlpath: 218 |
861 |
extensions: 217 |
862 |
usesocks: 208 |
863 |
shellflags: 198 |
864 |
make: 191 |
865 |
d_pwage: 189 |
866 |
d_pwchange: 189 |
867 |
d_pwclass: 189 |
868 |
d_pwcomment: 189 |
869 |
d_pwexpire: 189 |
870 |
d_pwgecos: 189 |
871 |
d_pwpasswd: 189 |
872 |
d_pwquota: 189 |
873 |
gccversion: 189 |
874 |
libs: 186 |
875 |
useshrplib: 186 |
876 |
cppflags: 185 |
877 |
ptrsize: 185 |
878 |
shrpenv: 185 |
879 |
static_ext: 185 |
880 |
use5005threads: 185 |
881 |
uselargefiles: 185 |
882 |
alignbytes: 184 |
883 |
byteorder: 184 |
884 |
ccversion: 184 |
885 |
config_args: 184 |
886 |
cppminus: 184 |