This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Cheat. (Add a leading newline, and so remove all the special
[perl5.git] / configpm
CommitLineData
a0d0e21e 1#!./miniperl -w
8990e307 2
5435c704
NC
3# commonly used names to put first (and hence lookup fastest)
4my %Common = map {($_,$_)}
5 qw(archname osname osvers prefix libs libpth
6 dynamic_ext static_ext dlsrc so
7 cc ccflags cppflags
8 privlibexp archlibexp installprivlib installarchlib
9 sharpbang startsh shsharp
10 );
11
12# names of things which may need to have slashes changed to double-colons
13my %Extensions = map {($_,$_)}
14 qw(dynamic_ext static_ext extensions known_extensions);
15
16# allowed opts as well as specifies default and initial values
17my %Allowed_Opts = (
18 'cross' => '', # --cross=PALTFORM - crosscompiling for PLATFORM
19 'glossary' => 1, # --no-glossary - no glossary file inclusion,
20 # for compactness
18f68570 21);
18f68570 22
5435c704
NC
23sub opts {
24 # user specified options
25 my %given_opts = (
26 # --opt=smth
27 (map {/^--([\-_\w]+)=(.*)$/} @ARGV),
28 # --opt --no-opt --noopt
29 (map {/^no-?(.*)$/i?($1=>0):($_=>1)} map {/^--([\-_\w]+)$/} @ARGV),
30 );
31
32 my %opts = (%Allowed_Opts, %given_opts);
33
34 for my $opt (grep {!exists $Allowed_Opts{$_}} keys %given_opts) {
35 die "option '$opt' is not recognized";
36 }
37 @ARGV = grep {!/^--/} @ARGV;
38
39 return %opts;
40}
18f68570 41
5435c704
NC
42
43my %Opts = opts();
44
45my $Config_PM;
46my $Glossary = $ARGV[1] || 'Porting/Glossary';
47
48if ($Opts{cross}) {
18f68570
VK
49 # creating cross-platform config file
50 mkdir "xlib";
5435c704
NC
51 mkdir "xlib/$Opts{cross}";
52 $Config_PM = $ARGV[0] || "xlib/$Opts{cross}/Config.pm";
18f68570
VK
53}
54else {
5435c704 55 $Config_PM = $ARGV[0] || 'lib/Config.pm';
18f68570
VK
56}
57
8990e307 58
5435c704 59open CONFIG, ">$Config_PM" or die "Can't open $Config_PM: $!\n";
fec02dd3 60
5435c704 61my $myver = sprintf "v%vd", $^V;
a0d0e21e 62
5435c704
NC
63printf CONFIG <<'ENDOFBEG', ($myver) x 3;
64# This file was created by configpm when Perl was built. Any changes
65# made to this file will be lost the next time perl is built.
3c81428c 66
8990e307 67package Config;
5435c704 68@EXPORT = qw(%%Config);
a48f8c77
MS
69@EXPORT_OK = qw(myconfig config_sh config_vars config_re);
70
71my %%Export_Cache = map {($_ => 1)} (@EXPORT, @EXPORT_OK);
e3d0cac0
IZ
72
73# Define our own import method to avoid pulling in the full Exporter:
74sub import {
a48f8c77
MS
75 my $pkg = shift;
76 @_ = @EXPORT unless @_;
5435c704 77
a48f8c77
MS
78 my @funcs = grep $_ ne '%%Config', @_;
79 my $export_Config = @funcs < @_ ? 1 : 0;
5435c704 80
a48f8c77
MS
81 my $callpkg = caller(0);
82 foreach my $func (@funcs) {
83 die sprintf qq{"%%s" is not exported by the %%s module\n},
84 $func, __PACKAGE__ unless $Export_Cache{$func};
85 *{$callpkg.'::'.$func} = \&{$func};
86 }
5435c704 87
a48f8c77
MS
88 *{"$callpkg\::Config"} = \%%Config if $export_Config;
89 return;
e3d0cac0
IZ
90}
91
5435c704
NC
92die "Perl lib version (%s) doesn't match executable version ($])"
93 unless $^V;
de98c553 94
5435c704 95$^V eq %s
a48f8c77
MS
96 or die "Perl lib version (%s) doesn't match executable version (" .
97 sprintf("v%%vd",$^V) . ")";
a0d0e21e 98
8990e307
LW
99ENDOFBEG
100
16d20bd9 101
5435c704
NC
102my @non_v = ();
103my @v_fast = ();
104my %v_fast = ();
105my @v_others = ();
106my $in_v = 0;
107my %Data = ();
108
109# This is somewhat grim, but I want the code for parsing config.sh here and
110# now so that I can expand $Config{ivsize} and $Config{ivtype}
111
112my $fetch_string = <<'EOT';
113
114# Search for it in the big string
115sub fetch_string {
116 my($self, $key) = @_;
117
118 my $quote_type = "'";
119 my $marker = "$key=";
120
a6d6498e 121 # Check for the common case, ' delimited
3be00128 122 my $start = index($Config_SH_expanded, "\n$marker$quote_type");
5435c704
NC
123 # If that failed, check for " delimited
124 if ($start == -1) {
125 $quote_type = '"';
3be00128 126 $start = index($Config_SH_expanded, "\n$marker$quote_type");
5435c704 127 }
3be00128
NC
128 # Start can never be -1 now, as we've rigged the long string we're
129 # searching with an initial dummy newline.
130 return undef if $start == -1;
5435c704 131
3be00128
NC
132 $start += length($marker) + 2;
133
134 my $value = substr($Config_SH_expanded, $start,
135 index($Config_SH_expanded, "$quote_type\n", $start)
136 - $start);
5435c704
NC
137
138 # If we had a double-quote, we'd better eval it so escape
139 # sequences and such can be interpolated. Since the incoming
140 # value is supposed to follow shell rules and not perl rules,
141 # we escape any perl variable markers
142 if ($quote_type eq '"') {
143 $value =~ s/\$/\\\$/g;
144 $value =~ s/\@/\\\@/g;
145 eval "\$value = \"$value\"";
146 }
147
148 # So we can say "if $Config{'foo'}".
149 $value = undef if $value eq 'undef';
150 $self->{$key} = $value; # cache it
151}
152EOT
153
154eval $fetch_string;
155die if $@;
a0d0e21e 156
5435c704
NC
157open(CONFIG_SH, 'config.sh') || die "Can't open config.sh: $!";
158while (<CONFIG_SH>) {
a0d0e21e 159 next if m:^#!/bin/sh:;
5435c704 160
a02608de 161 # Catch PERL_CONFIG_SH=true and PERL_VERSION=n line from Configure.
d4de4258 162 s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/ or m/^(\w+)='(.*)'$/;
3905a40f 163 my($k, $v) = ($1, $2);
5435c704 164
2000072c 165 # grandfather PATCHLEVEL and SUBVERSION and CONFIG
cceca5ed
GS
166 if ($k) {
167 if ($k eq 'PERL_VERSION') {
168 push @v_others, "PATCHLEVEL='$v'\n";
169 }
170 elsif ($k eq 'PERL_SUBVERSION') {
171 push @v_others, "SUBVERSION='$v'\n";
172 }
a02608de 173 elsif ($k eq 'PERL_CONFIG_SH') {
2000072c
JH
174 push @v_others, "CONFIG='$v'\n";
175 }
cceca5ed 176 }
5435c704 177
435ec615
HM
178 # We can delimit things in config.sh with either ' or ".
179 unless ($in_v or m/^(\w+)=(['"])(.*\n)/){
a0d0e21e
LW
180 push(@non_v, "#$_"); # not a name='value' line
181 next;
182 }
435ec615 183 $quote = $2;
5435c704
NC
184 if ($in_v) {
185 $val .= $_;
186 }
187 else {
188 ($name,$val) = ($1,$3);
189 }
435ec615 190 $in_v = $val !~ /$quote\n/;
44a8e56a 191 next if $in_v;
a0d0e21e 192
5435c704 193 s,/,::,g if $Extensions{$name};
a0d0e21e 194
5435c704 195 $val =~ s/$quote\n?\z//;
3c81428c 196
5435c704
NC
197 my $line = "$name=$quote$val$quote\n";
198 if (!$Common{$name}){
199 push(@v_others, $line);
200 }
201 else {
202 push(@v_fast, $line);
203 $v_fast{$name} = "'$name' => $quote$val$quote";
204 }
205}
206close CONFIG_SH;
3c81428c 207
8468119f
NC
208# Calculation for the keys for byteorder
209# This is somewhat grim, but I need to run fetch_string here.
3be00128 210our $Config_SH_expanded = join "\n", @v_fast, @v_others;
8468119f
NC
211
212my $t = fetch_string ({}, 'ivtype');
213my $s = fetch_string ({}, 'ivsize');
214
215# byteorder does exist on its own but we overlay a virtual
216# dynamically recomputed value.
217
218# However, ivtype and ivsize will not vary for sane fat binaries
219
220my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
221
222my $byteorder_code;
223if ($s == 4 || $s == 8) {
224 my $list = join ',', reverse(2..$s);
225 my $format = 'a'x$s;
226 $byteorder_code = <<"EOT";
227my \$i = 0;
228foreach my \$c ($list) { \$i |= ord(\$c); \$i <<= 8 }
229\$i |= ord(1);
230my \$byteorder = join('', unpack('$format', pack('$f', \$i)));
231EOT
232} else {
233 $byteorder_code = "my \$byteorder = '?'x$s;\n";
234}
235
5435c704 236print CONFIG @non_v, "\n";
3c81428c 237
5435c704 238# copy config summary format from the myconfig.SH script
504b85fc 239print CONFIG "our \$summary : unique = <<'!END!';\n";
3b5ca523 240open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
54310121
PP
2411 while defined($_ = <MYCONFIG>) && !/^Summary of/;
242do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
3c81428c 243close(MYCONFIG);
a0d0e21e 244
90ec21fb
EM
245# NB. as $summary is unique, we need to copy it in a lexical variable
246# before expanding it, because may have been made readonly if a perl
247# interpreter has been cloned.
248
8468119f 249print CONFIG "\n!END!\n", $byteorder_code, <<'EOT';
90ec21fb 250my $summary_expanded;
3c81428c
PP
251
252sub myconfig {
90ec21fb
EM
253 return $summary_expanded if $summary_expanded;
254 ($summary_expanded = $summary) =~ s{\$(\w+)}
a48f8c77 255 { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge;
90ec21fb 256 $summary_expanded;
3c81428c 257}
5435c704 258
8468119f
NC
259local *_ = \my $a;
260$_ = <<'!END!';
3c81428c
PP
261EOT
262
5435c704
NC
263print CONFIG join("", @v_fast, sort @v_others);
264
8468119f
NC
265print CONFIG <<'EOT';
266!END!
267s/(byteorder=)(['"]).*?\2/$1$2$byteorder$2/m;
268our $Config_SH : unique = $_;
3be00128
NC
269
270our $Config_SH_expanded : unique = "\n$_";
8468119f
NC
271EOT
272
273print CONFIG $fetch_string;
a0d0e21e
LW
274
275print CONFIG <<'ENDOFEND';
276
5435c704
NC
277sub fetch_virtual {
278 my($self, $key) = @_;
279
280 my $value;
281
282 if ($key =~ /^((?:cc|ld)flags|libs(?:wanted)?)_nolargefiles/) {
4b2ec495
JH
283 # These are purely virtual, they do not exist, but need to
284 # be computed on demand for largefile-incapable extensions.
5435c704 285 my $new_key = "${1}_uselargefiles";
4b2ec495 286 $value = $Config{$1};
5435c704
NC
287 my $withlargefiles = $Config{$new_key};
288 if ($new_key =~ /^(?:cc|ld)flags_/) {
4b2ec495 289 $value =~ s/\Q$withlargefiles\E\b//;
5435c704 290 } elsif ($new_key =~ /^libs/) {
45c9e83b 291 my @lflibswanted = split(' ', $Config{libswanted_uselargefiles});
4b2ec495
JH
292 if (@lflibswanted) {
293 my %lflibswanted;
294 @lflibswanted{@lflibswanted} = ();
5435c704 295 if ($new_key =~ /^libs_/) {
4b2ec495
JH
296 my @libs = grep { /^-l(.+)/ &&
297 not exists $lflibswanted{$1} }
298 split(' ', $Config{libs});
a6ea9771 299 $value = join(' ', @libs);
5435c704 300 } elsif ($new_key =~ /^libswanted_/) {
4b2ec495
JH
301 my @libswanted = grep { not exists $lflibswanted{$_} }
302 split(' ', $Config{libswanted});
a6ea9771 303 $value = join(' ', @libswanted);
4b2ec495
JH
304 }
305 }
306 }
435ec615 307 }
5435c704
NC
308
309 $self->{$key} = $value;
310}
311
312sub FETCH {
313 my($self, $key) = @_;
314
315 # check for cached value (which may be undef so we use exists not defined)
316 return $self->{$key} if exists $self->{$key};
317
318 $self->fetch_string($key);
319 return $self->{$key} if exists $self->{$key};
320 $self->fetch_virtual($key);
321
322 # Might not exist, in which undef is correct.
323 return $self->{$key};
a0d0e21e
LW
324}
325
3c81428c
PP
326my $prevpos = 0;
327
a0d0e21e
LW
328sub FIRSTKEY {
329 $prevpos = 0;
3be00128 330 substr($Config_SH_expanded, 0, index($Config_SH_expanded, '=') );
a0d0e21e
LW
331}
332
333sub NEXTKEY {
435ec615 334 # Find out how the current key's quoted so we can skip to its end.
3be00128
NC
335 my $quote = substr($Config_SH_expanded,
336 index($Config_SH_expanded, "=", $prevpos)+1, 1);
337 my $pos = index($Config_SH_expanded, qq($quote\n), $prevpos) + 2;
338 my $len = index($Config_SH_expanded, "=", $pos) - $pos;
a0d0e21e 339 $prevpos = $pos;
3be00128 340 $len > 0 ? substr($Config_SH_expanded, $pos, $len) : undef;
85e6fe83 341}
a0d0e21e 342
3c81428c 343sub EXISTS {
5435c704
NC
344 return 1 if exists($_[0]->{$_[1]});
345
3be00128
NC
346 return(index($Config_SH_expanded, "\n$_[1]='") != -1 or
347 substr($Config_SH_expanded, 0, length($_[1])+2) eq "$_[1]='" or
348 index($Config_SH_expanded, "\n$_[1]=\"") != -1 or
349 substr($Config_SH_expanded, 0, length($_[1])+2) eq "$_[1]=\"" or
5435c704
NC
350 $_[1] =~ /^(?:(?:cc|ld)flags|libs(?:wanted)?)_nolargefiles$/
351 );
a0d0e21e
LW
352}
353
3c81428c 354sub STORE { die "\%Config::Config is read-only\n" }
5435c704
NC
355*DELETE = \&STORE;
356*CLEAR = \&STORE;
a0d0e21e 357
3c81428c
PP
358
359sub config_sh {
5435c704 360 $Config_SH
748a9306 361}
9193ea20
PP
362
363sub config_re {
364 my $re = shift;
3be00128
NC
365 return map { chomp; $_ } grep eval{ /^(?:$re)=/ }, split /^/,
366 $Config_SH_expanded;
9193ea20
PP
367}
368
3c81428c 369sub config_vars {
307dc113 370 # implements -V:cfgvar option (see perlrun -V:)
a48f8c77 371 foreach (@_) {
307dc113 372 # find optional leading, trailing colons; and query-spec
4a305f6a 373 my ($notag,$qry,$lncont) = m/^(:)?(.*?)(:)?$/; # flags fore and aft,
307dc113
JC
374 # map colon-flags to print decorations
375 my $prfx = $notag ? '': "$qry="; # tag-prefix for print
376 my $lnend = $lncont ? ' ' : ";\n"; # line ending for print
4a305f6a 377
307dc113 378 # all config-vars are by definition \w only, any \W means regex
4a305f6a
JC
379 if ($qry =~ /\W/) {
380 my @matches = config_re($qry);
381 print map "$_$lnend", @matches ? @matches : "$qry: not found" if !$notag;
382 print map { s/\w+=//; "$_$lnend" } @matches ? @matches : "$qry: not found" if $notag;
a48f8c77 383 } else {
4a305f6a 384 my $v = (exists $Config{$qry}) ? $Config{$qry} : 'UNKNOWN';
a48f8c77 385 $v = 'undef' unless defined $v;
4a305f6a 386 print "${prfx}'${v}'$lnend";
a48f8c77 387 }
3c81428c
PP
388 }
389}
390
9193ea20
PP
391ENDOFEND
392
393if ($^O eq 'os2') {
a48f8c77 394 print CONFIG <<'ENDOFSET';
9193ea20
PP
395my %preconfig;
396if ($OS2::is_aout) {
3be00128 397 my ($value, $v) = $Config_SH_expanded =~ m/^used_aout='(.*)'\s*$/m;
9193ea20 398 for (split ' ', $value) {
3be00128 399 ($v) = $Config_SH_expanded =~ m/^aout_$_='(.*)'\s*$/m;
9193ea20
PP
400 $preconfig{$_} = $v eq 'undef' ? undef : $v;
401 }
402}
764df951 403$preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't
9193ea20
PP
404sub TIEHASH { bless {%preconfig} }
405ENDOFSET
a48f8c77
MS
406 # Extract the name of the DLL from the makefile to avoid duplication
407 my ($f) = grep -r, qw(GNUMakefile Makefile);
408 my $dll;
409 if (open my $fh, '<', $f) {
410 while (<$fh>) {
411 $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
412 }
30500b05 413 }
a48f8c77 414 print CONFIG <<ENDOFSET if $dll;
30500b05
IZ
415\$preconfig{dll_name} = '$dll';
416ENDOFSET
9193ea20 417} else {
a48f8c77 418 print CONFIG <<'ENDOFSET';
5435c704
NC
419sub TIEHASH {
420 bless $_[1], $_[0];
421}
9193ea20
PP
422ENDOFSET
423}
424
5435c704 425my $fast_config = join '', map { " $_,\n" }
8468119f 426 sort values (%v_fast), 'byteorder => $byteorder' ;
5435c704 427
8468119f 428print CONFIG sprintf <<'ENDOFTIE', $fast_config;
9193ea20 429
fb73857a
PP
430# avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
431sub DESTROY { }
432
5435c704
NC
433tie %%Config, 'Config', {
434%s
435};
9193ea20 436
3c81428c 4371;
5435c704
NC
438ENDOFTIE
439
748a9306 440
5435c704
NC
441open(CONFIG_POD, ">lib/Config.pod") or die "Can't open lib/Config.pod: $!";
442print CONFIG_POD <<'ENDOFTAIL';
3c81428c 443=head1 NAME
a0d0e21e 444
3c81428c
PP
445Config - access Perl configuration information
446
447=head1 SYNOPSIS
448
449 use Config;
63f18be6
NC
450 if ($Config{usethreads}) {
451 print "has thread support\n"
3c81428c
PP
452 }
453
a48f8c77 454 use Config qw(myconfig config_sh config_vars config_re);
3c81428c
PP
455
456 print myconfig();
457
458 print config_sh();
459
a48f8c77
MS
460 print config_re();
461
3c81428c
PP
462 config_vars(qw(osname archname));
463
464
465=head1 DESCRIPTION
466
467The Config module contains all the information that was available to
468the C<Configure> program at Perl build time (over 900 values).
469
470Shell variables from the F<config.sh> file (written by Configure) are
471stored in the readonly-variable C<%Config>, indexed by their names.
472
473Values stored in config.sh as 'undef' are returned as undefined
1fef88e7 474values. The perl C<exists> function can be used to check if a
3c81428c
PP
475named variable exists.
476
477=over 4
478
479=item myconfig()
480
481Returns a textual summary of the major perl configuration values.
482See also C<-V> in L<perlrun/Switches>.
483
484=item config_sh()
485
486Returns the entire perl configuration information in the form of the
487original config.sh shell variable assignment script.
488
a48f8c77
MS
489=item config_re($regex)
490
491Like config_sh() but returns, as a list, only the config entries who's
492names match the $regex.
493
3c81428c
PP
494=item config_vars(@names)
495
496Prints to STDOUT the values of the named configuration variable. Each is
497printed on a separate line in the form:
498
499 name='value';
500
501Names which are unknown are output as C<name='UNKNOWN';>.
502See also C<-V:name> in L<perlrun/Switches>.
503
504=back
505
506=head1 EXAMPLE
507
508Here's a more sophisticated example of using %Config:
509
510 use Config;
743c51bc
WK
511 use strict;
512
513 my %sig_num;
514 my @sig_name;
515 unless($Config{sig_name} && $Config{sig_num}) {
516 die "No sigs?";
517 } else {
518 my @names = split ' ', $Config{sig_name};
519 @sig_num{@names} = split ' ', $Config{sig_num};
520 foreach (@names) {
521 $sig_name[$sig_num{$_}] ||= $_;
522 }
523 }
3c81428c 524
743c51bc
WK
525 print "signal #17 = $sig_name[17]\n";
526 if ($sig_num{ALRM}) {
527 print "SIGALRM is $sig_num{ALRM}\n";
3c81428c
PP
528 }
529
530=head1 WARNING
531
532Because this information is not stored within the perl executable
533itself it is possible (but unlikely) that the information does not
534relate to the actual perl binary which is being used to access it.
535
536The Config module is installed into the architecture and version
537specific library directory ($Config{installarchlib}) and it checks the
538perl version number when loaded.
539
435ec615
HM
540The values stored in config.sh may be either single-quoted or
541double-quoted. Double-quoted strings are handy for those cases where you
542need to include escape sequences in the strings. To avoid runtime variable
543interpolation, any C<$> and C<@> characters are replaced by C<\$> and
544C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
545or C<\@> in double-quoted strings unless you're willing to deal with the
546consequences. (The slashes will end up escaped and the C<$> or C<@> will
547trigger variable interpolation)
548
ebc74a4b
GS
549=head1 GLOSSARY
550
551Most C<Config> variables are determined by the C<Configure> script
552on platforms supported by it (which is most UNIX platforms). Some
553platforms have custom-made C<Config> variables, and may thus not have
554some of the variables described below, or may have extraneous variables
555specific to that particular port. See the port specific documentation
556in such cases.
557
ebc74a4b
GS
558ENDOFTAIL
559
5435c704
NC
560if ($Opts{glossary}) {
561 open(GLOS, "<$Glossary") or die "Can't open $Glossary: $!";
18f68570 562}
fb87c415
IZ
563%seen = ();
564$text = 0;
565$/ = '';
566
567sub process {
aade5aff
YST
568 if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
569 my $c = substr $1, 0, 1;
570 unless ($seen{$c}++) {
5435c704 571 print CONFIG_POD <<EOF if $text;
fb87c415 572=back
ebc74a4b 573
fb87c415 574EOF
5435c704 575 print CONFIG_POD <<EOF;
fb87c415
IZ
576=head2 $c
577
bbc7dcd2 578=over 4
fb87c415
IZ
579
580EOF
aade5aff
YST
581 $text = 1;
582 }
583 }
584 elsif (!$text || !/\A\t/) {
585 warn "Expected a Configure variable header",
586 ($text ? " or another paragraph of description" : () );
fb87c415
IZ
587 }
588 s/n't/n\00t/g; # leave can't, won't etc untouched
9b22980b 589 s/^\t\s+(.*)/\n$1/gm; # Indented lines ===> new paragraph
fb87c415
IZ
590 s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text
591 s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
592 s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
593 s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
594 s{
595 (?<! [\w./<\'\"] ) # Only standalone file names
596 (?! e \. g \. ) # Not e.g.
597 (?! \. \. \. ) # Not ...
598 (?! \d ) # Not 5.004
a1151a3c
RGS
599 (?! read/ ) # Not read/write
600 (?! etc\. ) # Not etc.
601 (?! I/O ) # Not I/O
602 (
603 \$ ? # Allow leading $
604 [\w./]* [./] [\w./]* # Require . or / inside
605 )
606 (?<! \. (?= [\s)] ) ) # Do not include trailing dot
fb87c415
IZ
607 (?! [\w/] ) # Include all of it
608 }
609 (F<$1>)xg; # /usr/local
610 s/((?<=\s)~\w*)/F<$1>/g; # ~name
611 s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD
612 s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
613 s/n[\0]t/n't/g; # undo can't, won't damage
ebc74a4b
GS
614}
615
5435c704 616if ($Opts{glossary}) {
7701ffb5
JH
617 <GLOS>; # Skip the "DO NOT EDIT"
618 <GLOS>; # Skip the preamble
18f68570
VK
619 while (<GLOS>) {
620 process;
5435c704 621 print CONFIG_POD;
18f68570 622 }
fb87c415 623}
ebc74a4b 624
5435c704 625print CONFIG_POD <<'ENDOFTAIL';
ebc74a4b
GS
626
627=back
628
3c81428c
PP
629=head1 NOTE
630
631This module contains a good example of how to use tie to implement a
632cache and an example of how to make a tied variable readonly to those
633outside of it.
634
635=cut
a0d0e21e 636
9193ea20 637ENDOFTAIL
a0d0e21e
LW
638
639close(CONFIG);
ebc74a4b 640close(GLOS);
5435c704 641close(CONFIG_POD);
a0d0e21e 642
18f68570 643# Now create Cross.pm if needed
5435c704 644if ($Opts{cross}) {
18f68570 645 open CROSS, ">lib/Cross.pm" or die "Can not open >lib/Cross.pm: $!";
47bcb90d
VK
646 my $cross = <<'EOS';
647# typical invocation:
648# perl -MCross Makefile.PL
649# perl -MCross=wince -V:cc
650package Cross;
651
652sub import {
653 my ($package,$platform) = @_;
654 unless (defined $platform) {
655 # if $platform is not specified, then use last one when
656 # 'configpm; was invoked with --cross option
657 $platform = '***replace-marker***';
658 }
659 @INC = map {/\blib\b/?(do{local $_=$_;s/\blib\b/xlib\/$platform/;$_},$_):($_)} @INC;
e2a02c1e 660 $::Cross::platform = $platform;
18f68570 661}
47bcb90d 662
18f68570
VK
6631;
664EOS
5435c704 665 $cross =~ s/\*\*\*replace-marker\*\*\*/$Opts{cross}/g;
47bcb90d 666 print CROSS $cross;
18f68570
VK
667 close CROSS;
668}
669
a0d0e21e
LW
670# Now do some simple tests on the Config.pm file we have created
671unshift(@INC,'lib');
5435c704 672require $Config_PM;
a0d0e21e
LW
673import Config;
674
5435c704 675die "$0: $Config_PM not valid"
a02608de 676 unless $Config{'PERL_CONFIG_SH'} eq 'true';
a0d0e21e 677
5435c704 678die "$0: error processing $Config_PM"
a0d0e21e 679 if defined($Config{'an impossible name'})
a02608de 680 or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache
a0d0e21e
LW
681 ;
682
5435c704 683die "$0: error processing $Config_PM"
a0d0e21e
LW
684 if eval '$Config{"cc"} = 1'
685 or eval 'delete $Config{"cc"}'
686 ;
687
688
85e6fe83 689exit 0;