source: vendor/perl/5.8.8/configpm@ 3749

Last change on this file since 3749 was 3181, checked in by bird, 18 years ago

perl 5.8.8

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