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