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