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