ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/staticperl/perl/configpm
Revision: 1.3
Committed: Fri Jul 1 02:16:14 2005 UTC (19 years ago) by root
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +0 -10 lines
Log Message:
*** empty log message ***

File Contents

# Content
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