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