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