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 (21 years, 4 months ago) by root
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +0 -10 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.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