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