Unicode properties: fix L& (the #12319 didn't allow L&,
[p5sagit/p5-mst-13.2.git] / configpm
CommitLineData
a0d0e21e 1#!./miniperl -w
8990e307 2
ebc74a4b 3my $config_pm = $ARGV[0] || 'lib/Config.pm';
3b5ca523 4my $glossary = $ARGV[1] || 'Porting/Glossary';
8990e307 5@ARGV = "./config.sh";
6
a0d0e21e 7# list names to put first (and hence lookup fastest)
3c81428c 8@fast = qw(archname osname osvers prefix libs libpth
9 dynamic_ext static_ext extensions dlsrc so
743c51bc 10 sig_name sig_num cc ccflags cppflags
3c81428c 11 privlibexp archlibexp installprivlib installarchlib
a0d0e21e 12 sharpbang startsh shsharp
3c81428c 13);
a0d0e21e 14
fec02dd3 15# names of things which may need to have slashes changed to double-colons
16@extensions = qw(dynamic_ext static_ext extensions known_extensions);
17
a0d0e21e 18
19open CONFIG, ">$config_pm" or die "Can't open $config_pm: $!\n";
dd101d75 20$myver = sprintf "v%vd", $^V;
3c81428c 21
e3d0cac0 22print CONFIG <<'ENDOFBEG_NOQ', <<"ENDOFBEG";
8990e307 23package Config;
3c81428c 24use Exporter ();
e3d0cac0 25@EXPORT = qw(%Config);
26@EXPORT_OK = qw(myconfig config_sh config_vars);
27
28# Define our own import method to avoid pulling in the full Exporter:
29sub import {
30 my $pkg = shift;
31 @_ = @EXPORT unless @_;
32 my @func = grep {$_ ne '%Config'} @_;
4365a961 33 local $Exporter::ExportLevel = 1;
e3d0cac0 34 Exporter::import('Config', @func) if @func;
35 return if @func == @_;
36 my $callpkg = caller(0);
37 *{"$callpkg\::Config"} = \%Config;
38}
39
40ENDOFBEG_NOQ
de98c553 41die "Perl lib version ($myver) doesn't match executable version (\$])"
42 unless \$^V;
43
dd101d75 44\$^V eq $myver
45 or die "Perl lib version ($myver) doesn't match executable version (" .
46 (sprintf "v%vd",\$^V) . ")";
8990e307 47
a0d0e21e 48# This file was created by configpm when Perl was built. Any changes
49# made to this file will be lost the next time perl is built.
50
8990e307 51ENDOFBEG
52
16d20bd9 53
a0d0e21e 54@fast{@fast} = @fast;
fec02dd3 55@extensions{@extensions} = @extensions;
a0d0e21e 56@non_v=();
57@v_fast=();
58@v_others=();
44a8e56a 59$in_v = 0;
a0d0e21e 60
85e6fe83 61while (<>) {
a0d0e21e 62 next if m:^#!/bin/sh:;
a02608de 63 # Catch PERL_CONFIG_SH=true and PERL_VERSION=n line from Configure.
a0d0e21e 64 s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/;
cceca5ed 65 my ($k,$v) = ($1,$2);
2000072c 66 # grandfather PATCHLEVEL and SUBVERSION and CONFIG
cceca5ed 67 if ($k) {
68 if ($k eq 'PERL_VERSION') {
69 push @v_others, "PATCHLEVEL='$v'\n";
70 }
71 elsif ($k eq 'PERL_SUBVERSION') {
72 push @v_others, "SUBVERSION='$v'\n";
73 }
a02608de 74 elsif ($k eq 'PERL_CONFIG_SH') {
2000072c 75 push @v_others, "CONFIG='$v'\n";
76 }
cceca5ed 77 }
435ec615 78 # We can delimit things in config.sh with either ' or ".
79 unless ($in_v or m/^(\w+)=(['"])(.*\n)/){
a0d0e21e 80 push(@non_v, "#$_"); # not a name='value' line
81 next;
82 }
435ec615 83 $quote = $2;
44a8e56a 84 if ($in_v) { $val .= $_; }
435ec615 85 else { ($name,$val) = ($1,$3); }
86 $in_v = $val !~ /$quote\n/;
44a8e56a 87 next if $in_v;
fec02dd3 88 if ($extensions{$name}) { s,/,::,g }
435ec615 89 if (!$fast{$name}){ push(@v_others, "$name=$quote$val"); next; }
90 push(@v_fast,"$name=$quote$val");
a0d0e21e 91}
92
93foreach(@non_v){ print CONFIG $_ }
94
95print CONFIG "\n",
3c81428c 96 "my \$config_sh = <<'!END!';\n",
a0d0e21e 97 join("", @v_fast, sort @v_others),
3c81428c 98 "!END!\n\n";
99
a6c40364 100# copy config summary format from the myconfig.SH script
3c81428c 101
102print CONFIG "my \$summary = <<'!END!';\n";
103
3b5ca523 104open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
54310121 1051 while defined($_ = <MYCONFIG>) && !/^Summary of/;
106do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
3c81428c 107close(MYCONFIG);
a0d0e21e 108
3c81428c 109print CONFIG "\n!END!\n", <<'EOT';
110my $summary_expanded = 0;
111
112sub myconfig {
113 return $summary if $summary_expanded;
ca8cad5c 114 $summary =~ s{\$(\w+)}
115 { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge;
3c81428c 116 $summary_expanded = 1;
117 $summary;
118}
119EOT
120
121# ----
a0d0e21e 122
123print CONFIG <<'ENDOFEND';
124
a0d0e21e 125sub FETCH {
aa1bdcb8 126 # check for cached value (which may be undef so we use exists not defined)
a0d0e21e 127 return $_[0]->{$_[1]} if (exists $_[0]->{$_[1]});
aa1bdcb8 128
129 # Search for it in the big string
435ec615 130 my($value, $start, $marker, $quote_type);
46f36567 131
435ec615 132 $quote_type = "'";
4b2ec495 133 # Virtual entries.
46f36567 134 if ($_[1] eq 'byteorder') {
4b2ec495 135 # byteorder does exist on its own but we overlay a virtual
136 # dynamically recomputed value.
46f36567 137 my $t = $Config{ivtype};
138 my $s = $Config{ivsize};
139 my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
46f36567 140 if ($s == 4 || $s == 8) {
ad66e0eb 141 my $i = 0;
142 foreach my $c (reverse(2..$s)) { $i |= ord($c); $i <<= 8 }
143 $i |= ord(1);
46f36567 144 $value = join('', unpack('a'x$s, pack($f, $i)));
145 } else {
146 $value = '?'x$s;
147 }
4b2ec495 148 } elsif ($_[1] =~ /^((?:cc|ld)flags|libs(?:wanted)?)_nolargefiles/) {
149 # These are purely virtual, they do not exist, but need to
150 # be computed on demand for largefile-incapable extensions.
45c9e83b 151 my $key = "${1}_uselargefiles";
4b2ec495 152 $value = $Config{$1};
153 my $withlargefiles = $Config{$key};
154 if ($key =~ /^(?:cc|ld)flags_/) {
155 $value =~ s/\Q$withlargefiles\E\b//;
156 } elsif ($key =~ /^libs/) {
45c9e83b 157 my @lflibswanted = split(' ', $Config{libswanted_uselargefiles});
4b2ec495 158 if (@lflibswanted) {
159 my %lflibswanted;
160 @lflibswanted{@lflibswanted} = ();
161 if ($key =~ /^libs_/) {
162 my @libs = grep { /^-l(.+)/ &&
163 not exists $lflibswanted{$1} }
164 split(' ', $Config{libs});
165 $Config{libs} = join(' ', @libs);
166 } elsif ($key =~ /^libswanted_/) {
167 my @libswanted = grep { not exists $lflibswanted{$_} }
168 split(' ', $Config{libswanted});
169 $Config{libswanted} = join(' ', @libswanted);
170 }
171 }
172 }
46f36567 173 } else {
174 $marker = "$_[1]=";
175 # return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m);
176 # Check for the common case, ' delimeted
177 $start = index($config_sh, "\n$marker$quote_type");
178 # If that failed, check for " delimited
179 if ($start == -1) {
180 $quote_type = '"';
181 $start = index($config_sh, "\n$marker$quote_type");
182 }
183 return undef if ( ($start == -1) && # in case it's first
184 (substr($config_sh, 0, length($marker)) ne $marker) );
185 if ($start == -1) {
186 # It's the very first thing we found. Skip $start forward
187 # and figure out the quote mark after the =.
188 $start = length($marker) + 1;
189 $quote_type = substr($config_sh, $start - 1, 1);
190 }
191 else {
192 $start += length($marker) + 2;
193 }
194 $value = substr($config_sh, $start,
195 index($config_sh, "$quote_type\n", $start) - $start);
435ec615 196 }
435ec615 197 # If we had a double-quote, we'd better eval it so escape
198 # sequences and such can be interpolated. Since the incoming
199 # value is supposed to follow shell rules and not perl rules,
200 # we escape any perl variable markers
201 if ($quote_type eq '"') {
46f36567 202 $value =~ s/\$/\\\$/g;
203 $value =~ s/\@/\\\@/g;
204 eval "\$value = \"$value\"";
435ec615 205 }
206 #$value = sprintf($value) if $quote_type eq '"';
46f36567 207 # So we can say "if $Config{'foo'}".
208 $value = undef if $value eq 'undef';
a0d0e21e 209 $_[0]->{$_[1]} = $value; # cache it
210 return $value;
211}
212
3c81428c 213my $prevpos = 0;
214
a0d0e21e 215sub FIRSTKEY {
216 $prevpos = 0;
aa1bdcb8 217 # my($key) = $config_sh =~ m/^(.*?)=/;
218 substr($config_sh, 0, index($config_sh, '=') );
219 # $key;
a0d0e21e 220}
221
222sub NEXTKEY {
435ec615 223 # Find out how the current key's quoted so we can skip to its end.
224 my $quote = substr($config_sh, index($config_sh, "=", $prevpos)+1, 1);
225 my $pos = index($config_sh, qq($quote\n), $prevpos) + 2;
3c81428c 226 my $len = index($config_sh, "=", $pos) - $pos;
a0d0e21e 227 $prevpos = $pos;
3c81428c 228 $len > 0 ? substr($config_sh, $pos, $len) : undef;
85e6fe83 229}
a0d0e21e 230
3c81428c 231sub EXISTS {
aa1bdcb8 232 # exists($_[0]->{$_[1]}) or $config_sh =~ m/^$_[1]=/m;
233 exists($_[0]->{$_[1]}) or
234 index($config_sh, "\n$_[1]='") != -1 or
435ec615 235 substr($config_sh, 0, length($_[1])+2) eq "$_[1]='" or
236 index($config_sh, "\n$_[1]=\"") != -1 or
4b2ec495 237 substr($config_sh, 0, length($_[1])+2) eq "$_[1]=\"" or
238 $_[1] =~ /^(?:(?:cc|ld)flags|libs(?:wanted)?)_nolargefiles$/;
a0d0e21e 239}
240
3c81428c 241sub STORE { die "\%Config::Config is read-only\n" }
242sub DELETE { &STORE }
243sub CLEAR { &STORE }
a0d0e21e 244
3c81428c 245
246sub config_sh {
247 $config_sh
748a9306 248}
9193ea20 249
250sub config_re {
251 my $re = shift;
252 my @matches = ($config_sh =~ /^$re=.*\n/mg);
253 @matches ? (print @matches) : print "$re: not found\n";
254}
255
3c81428c 256sub config_vars {
257 foreach(@_){
9193ea20 258 config_re($_), next if /\W/;
3c81428c 259 my $v=(exists $Config{$_}) ? $Config{$_} : 'UNKNOWN';
260 $v='undef' unless defined $v;
261 print "$_='$v';\n";
262 }
263}
264
9193ea20 265ENDOFEND
266
267if ($^O eq 'os2') {
268 print CONFIG <<'ENDOFSET';
269my %preconfig;
270if ($OS2::is_aout) {
271 my ($value, $v) = $config_sh =~ m/^used_aout='(.*)'\s*$/m;
272 for (split ' ', $value) {
273 ($v) = $config_sh =~ m/^aout_$_='(.*)'\s*$/m;
274 $preconfig{$_} = $v eq 'undef' ? undef : $v;
275 }
276}
764df951 277$preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't
9193ea20 278sub TIEHASH { bless {%preconfig} }
279ENDOFSET
280} else {
281 print CONFIG <<'ENDOFSET';
282sub TIEHASH { bless {} }
283ENDOFSET
284}
285
286print CONFIG <<'ENDOFTAIL';
287
fb73857a 288# avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
289sub DESTROY { }
290
9193ea20 291tie %Config, 'Config';
292
3c81428c 2931;
294__END__
748a9306 295
3c81428c 296=head1 NAME
a0d0e21e 297
3c81428c 298Config - access Perl configuration information
299
300=head1 SYNOPSIS
301
302 use Config;
303 if ($Config{'cc'} =~ /gcc/) {
304 print "built by gcc\n";
305 }
306
307 use Config qw(myconfig config_sh config_vars);
308
309 print myconfig();
310
311 print config_sh();
312
313 config_vars(qw(osname archname));
314
315
316=head1 DESCRIPTION
317
318The Config module contains all the information that was available to
319the C<Configure> program at Perl build time (over 900 values).
320
321Shell variables from the F<config.sh> file (written by Configure) are
322stored in the readonly-variable C<%Config>, indexed by their names.
323
324Values stored in config.sh as 'undef' are returned as undefined
1fef88e7 325values. The perl C<exists> function can be used to check if a
3c81428c 326named variable exists.
327
328=over 4
329
330=item myconfig()
331
332Returns a textual summary of the major perl configuration values.
333See also C<-V> in L<perlrun/Switches>.
334
335=item config_sh()
336
337Returns the entire perl configuration information in the form of the
338original config.sh shell variable assignment script.
339
340=item config_vars(@names)
341
342Prints to STDOUT the values of the named configuration variable. Each is
343printed on a separate line in the form:
344
345 name='value';
346
347Names which are unknown are output as C<name='UNKNOWN';>.
348See also C<-V:name> in L<perlrun/Switches>.
349
350=back
351
352=head1 EXAMPLE
353
354Here's a more sophisticated example of using %Config:
355
356 use Config;
743c51bc 357 use strict;
358
359 my %sig_num;
360 my @sig_name;
361 unless($Config{sig_name} && $Config{sig_num}) {
362 die "No sigs?";
363 } else {
364 my @names = split ' ', $Config{sig_name};
365 @sig_num{@names} = split ' ', $Config{sig_num};
366 foreach (@names) {
367 $sig_name[$sig_num{$_}] ||= $_;
368 }
369 }
3c81428c 370
743c51bc 371 print "signal #17 = $sig_name[17]\n";
372 if ($sig_num{ALRM}) {
373 print "SIGALRM is $sig_num{ALRM}\n";
3c81428c 374 }
375
376=head1 WARNING
377
378Because this information is not stored within the perl executable
379itself it is possible (but unlikely) that the information does not
380relate to the actual perl binary which is being used to access it.
381
382The Config module is installed into the architecture and version
383specific library directory ($Config{installarchlib}) and it checks the
384perl version number when loaded.
385
435ec615 386The values stored in config.sh may be either single-quoted or
387double-quoted. Double-quoted strings are handy for those cases where you
388need to include escape sequences in the strings. To avoid runtime variable
389interpolation, any C<$> and C<@> characters are replaced by C<\$> and
390C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
391or C<\@> in double-quoted strings unless you're willing to deal with the
392consequences. (The slashes will end up escaped and the C<$> or C<@> will
393trigger variable interpolation)
394
ebc74a4b 395=head1 GLOSSARY
396
397Most C<Config> variables are determined by the C<Configure> script
398on platforms supported by it (which is most UNIX platforms). Some
399platforms have custom-made C<Config> variables, and may thus not have
400some of the variables described below, or may have extraneous variables
401specific to that particular port. See the port specific documentation
402in such cases.
403
ebc74a4b 404ENDOFTAIL
405
406open(GLOS, "<$glossary") or die "Can't open $glossary: $!";
fb87c415 407%seen = ();
408$text = 0;
409$/ = '';
410
411sub process {
412 s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m;
413 my $c = substr $1, 0, 1;
414 unless ($seen{$c}++) {
415 print CONFIG <<EOF if $text;
416=back
ebc74a4b 417
fb87c415 418EOF
419 print CONFIG <<EOF;
420=head2 $c
421
bbc7dcd2 422=over 4
fb87c415 423
424EOF
425 $text = 1;
426 }
427 s/n't/n\00t/g; # leave can't, won't etc untouched
428 s/^\t\s+(.*)/\n\t$1\n/gm; # Indented lines ===> paragraphs
429 s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text
430 s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
431 s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
432 s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
433 s{
434 (?<! [\w./<\'\"] ) # Only standalone file names
435 (?! e \. g \. ) # Not e.g.
436 (?! \. \. \. ) # Not ...
437 (?! \d ) # Not 5.004
438 ( [\w./]* [./] [\w./]* ) # Require . or / inside
439 (?<! \. (?= \s ) ) # Do not include trailing dot
440 (?! [\w/] ) # Include all of it
441 }
442 (F<$1>)xg; # /usr/local
443 s/((?<=\s)~\w*)/F<$1>/g; # ~name
444 s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD
445 s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
446 s/n[\0]t/n't/g; # undo can't, won't damage
ebc74a4b 447}
448
fb87c415 449<GLOS>; # Skip the preamble
450while (<GLOS>) {
451 process;
452 print CONFIG;
453}
ebc74a4b 454
455print CONFIG <<'ENDOFTAIL';
456
457=back
458
3c81428c 459=head1 NOTE
460
461This module contains a good example of how to use tie to implement a
462cache and an example of how to make a tied variable readonly to those
463outside of it.
464
465=cut
a0d0e21e 466
9193ea20 467ENDOFTAIL
a0d0e21e 468
469close(CONFIG);
ebc74a4b 470close(GLOS);
a0d0e21e 471
472# Now do some simple tests on the Config.pm file we have created
473unshift(@INC,'lib');
474require $config_pm;
475import Config;
476
477die "$0: $config_pm not valid"
a02608de 478 unless $Config{'PERL_CONFIG_SH'} eq 'true';
a0d0e21e 479
480die "$0: error processing $config_pm"
481 if defined($Config{'an impossible name'})
a02608de 482 or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache
a0d0e21e 483 ;
484
485die "$0: error processing $config_pm"
486 if eval '$Config{"cc"} = 1'
487 or eval 'delete $Config{"cc"}'
488 ;
489
490
85e6fe83 491exit 0;