Remove Encode::Tcl::Extended, suggested by
[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;
cb551bf9 252 my @matches = grep /^$re=/, split /^/, $config_sh;
9193ea20 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
30500b05 280 # Extract the name of the DLL from the makefile to avoid duplication
281 my ($f) = grep -r, qw(GNUMakefile Makefile);
282 my $dll;
283 if (open my $fh, '<', $f) {
284 while (<$fh>) {
285 $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
286 }
287 }
288 print CONFIG <<ENDOFSET if $dll;
289\$preconfig{dll_name} = '$dll';
290ENDOFSET
9193ea20 291} else {
292 print CONFIG <<'ENDOFSET';
293sub TIEHASH { bless {} }
294ENDOFSET
295}
296
297print CONFIG <<'ENDOFTAIL';
298
fb73857a 299# avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
300sub DESTROY { }
301
9193ea20 302tie %Config, 'Config';
303
3c81428c 3041;
305__END__
748a9306 306
3c81428c 307=head1 NAME
a0d0e21e 308
3c81428c 309Config - access Perl configuration information
310
311=head1 SYNOPSIS
312
313 use Config;
314 if ($Config{'cc'} =~ /gcc/) {
315 print "built by gcc\n";
316 }
317
318 use Config qw(myconfig config_sh config_vars);
319
320 print myconfig();
321
322 print config_sh();
323
324 config_vars(qw(osname archname));
325
326
327=head1 DESCRIPTION
328
329The Config module contains all the information that was available to
330the C<Configure> program at Perl build time (over 900 values).
331
332Shell variables from the F<config.sh> file (written by Configure) are
333stored in the readonly-variable C<%Config>, indexed by their names.
334
335Values stored in config.sh as 'undef' are returned as undefined
1fef88e7 336values. The perl C<exists> function can be used to check if a
3c81428c 337named variable exists.
338
339=over 4
340
341=item myconfig()
342
343Returns a textual summary of the major perl configuration values.
344See also C<-V> in L<perlrun/Switches>.
345
346=item config_sh()
347
348Returns the entire perl configuration information in the form of the
349original config.sh shell variable assignment script.
350
351=item config_vars(@names)
352
353Prints to STDOUT the values of the named configuration variable. Each is
354printed on a separate line in the form:
355
356 name='value';
357
358Names which are unknown are output as C<name='UNKNOWN';>.
359See also C<-V:name> in L<perlrun/Switches>.
360
361=back
362
363=head1 EXAMPLE
364
365Here's a more sophisticated example of using %Config:
366
367 use Config;
743c51bc 368 use strict;
369
370 my %sig_num;
371 my @sig_name;
372 unless($Config{sig_name} && $Config{sig_num}) {
373 die "No sigs?";
374 } else {
375 my @names = split ' ', $Config{sig_name};
376 @sig_num{@names} = split ' ', $Config{sig_num};
377 foreach (@names) {
378 $sig_name[$sig_num{$_}] ||= $_;
379 }
380 }
3c81428c 381
743c51bc 382 print "signal #17 = $sig_name[17]\n";
383 if ($sig_num{ALRM}) {
384 print "SIGALRM is $sig_num{ALRM}\n";
3c81428c 385 }
386
387=head1 WARNING
388
389Because this information is not stored within the perl executable
390itself it is possible (but unlikely) that the information does not
391relate to the actual perl binary which is being used to access it.
392
393The Config module is installed into the architecture and version
394specific library directory ($Config{installarchlib}) and it checks the
395perl version number when loaded.
396
435ec615 397The values stored in config.sh may be either single-quoted or
398double-quoted. Double-quoted strings are handy for those cases where you
399need to include escape sequences in the strings. To avoid runtime variable
400interpolation, any C<$> and C<@> characters are replaced by C<\$> and
401C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
402or C<\@> in double-quoted strings unless you're willing to deal with the
403consequences. (The slashes will end up escaped and the C<$> or C<@> will
404trigger variable interpolation)
405
ebc74a4b 406=head1 GLOSSARY
407
408Most C<Config> variables are determined by the C<Configure> script
409on platforms supported by it (which is most UNIX platforms). Some
410platforms have custom-made C<Config> variables, and may thus not have
411some of the variables described below, or may have extraneous variables
412specific to that particular port. See the port specific documentation
413in such cases.
414
ebc74a4b 415ENDOFTAIL
416
417open(GLOS, "<$glossary") or die "Can't open $glossary: $!";
fb87c415 418%seen = ();
419$text = 0;
420$/ = '';
421
422sub process {
aade5aff 423 if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
424 my $c = substr $1, 0, 1;
425 unless ($seen{$c}++) {
426 print CONFIG <<EOF if $text;
fb87c415 427=back
ebc74a4b 428
fb87c415 429EOF
aade5aff 430 print CONFIG <<EOF;
fb87c415 431=head2 $c
432
bbc7dcd2 433=over 4
fb87c415 434
435EOF
aade5aff 436 $text = 1;
437 }
438 }
439 elsif (!$text || !/\A\t/) {
440 warn "Expected a Configure variable header",
441 ($text ? " or another paragraph of description" : () );
fb87c415 442 }
443 s/n't/n\00t/g; # leave can't, won't etc untouched
444 s/^\t\s+(.*)/\n\t$1\n/gm; # Indented lines ===> paragraphs
445 s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text
446 s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
447 s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
448 s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
449 s{
450 (?<! [\w./<\'\"] ) # Only standalone file names
451 (?! e \. g \. ) # Not e.g.
452 (?! \. \. \. ) # Not ...
453 (?! \d ) # Not 5.004
a1151a3c 454 (?! read/ ) # Not read/write
455 (?! etc\. ) # Not etc.
456 (?! I/O ) # Not I/O
457 (
458 \$ ? # Allow leading $
459 [\w./]* [./] [\w./]* # Require . or / inside
460 )
461 (?<! \. (?= [\s)] ) ) # Do not include trailing dot
fb87c415 462 (?! [\w/] ) # Include all of it
463 }
464 (F<$1>)xg; # /usr/local
465 s/((?<=\s)~\w*)/F<$1>/g; # ~name
466 s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD
467 s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
468 s/n[\0]t/n't/g; # undo can't, won't damage
ebc74a4b 469}
470
fb87c415 471<GLOS>; # Skip the preamble
472while (<GLOS>) {
473 process;
474 print CONFIG;
475}
ebc74a4b 476
477print CONFIG <<'ENDOFTAIL';
478
479=back
480
3c81428c 481=head1 NOTE
482
483This module contains a good example of how to use tie to implement a
484cache and an example of how to make a tied variable readonly to those
485outside of it.
486
487=cut
a0d0e21e 488
9193ea20 489ENDOFTAIL
a0d0e21e 490
491close(CONFIG);
ebc74a4b 492close(GLOS);
a0d0e21e 493
494# Now do some simple tests on the Config.pm file we have created
495unshift(@INC,'lib');
496require $config_pm;
497import Config;
498
499die "$0: $config_pm not valid"
a02608de 500 unless $Config{'PERL_CONFIG_SH'} eq 'true';
a0d0e21e 501
502die "$0: error processing $config_pm"
503 if defined($Config{'an impossible name'})
a02608de 504 or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache
a0d0e21e 505 ;
506
507die "$0: error processing $config_pm"
508 if eval '$Config{"cc"} = 1'
509 or eval 'delete $Config{"cc"}'
510 ;
511
512
85e6fe83 513exit 0;