This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: Inconsistent arithmetics on refs
[perl5.git] / configpm
CommitLineData
a0d0e21e 1#!./miniperl -w
8990e307 2
ebc74a4b
GS
3my $config_pm = $ARGV[0] || 'lib/Config.pm';
4my $glossary = $ARGV[1] || 'Porting/Glossary';
8990e307
LW
5@ARGV = "./config.sh";
6
a0d0e21e 7# list names to put first (and hence lookup fastest)
3c81428c
PP
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
AD
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
LW
18
19open CONFIG, ">$config_pm" or die "Can't open $config_pm: $!\n";
a5f75d66 20$myver = $];
3c81428c 21
a0d0e21e 22print CONFIG <<"ENDOFBEG";
8990e307 23package Config;
3c81428c 24use Exporter ();
8990e307
LW
25\@ISA = (Exporter);
26\@EXPORT = qw(%Config);
3c81428c 27\@EXPORT_OK = qw(myconfig config_sh config_vars);
8990e307 28
a5f75d66 29\$] == $myver
9193ea20 30 or die "Perl lib version ($myver) doesn't match executable version (\$])";
8990e307 31
a0d0e21e
LW
32# This file was created by configpm when Perl was built. Any changes
33# made to this file will be lost the next time perl is built.
34
8990e307
LW
35ENDOFBEG
36
16d20bd9 37
a0d0e21e 38@fast{@fast} = @fast;
fec02dd3 39@extensions{@extensions} = @extensions;
a0d0e21e
LW
40@non_v=();
41@v_fast=();
42@v_others=();
44a8e56a 43$in_v = 0;
a0d0e21e 44
85e6fe83 45while (<>) {
a0d0e21e
LW
46 next if m:^#!/bin/sh:;
47 # Catch CONFIG=true and PATCHLEVEL=n line from Configure.
48 s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/;
44a8e56a 49 unless ($in_v or m/^(\w+)='(.*\n)/){
a0d0e21e
LW
50 push(@non_v, "#$_"); # not a name='value' line
51 next;
52 }
44a8e56a
PP
53 if ($in_v) { $val .= $_; }
54 else { ($name,$val) = ($1,$2); }
55 $in_v = $val !~ /'\n/;
56 next if $in_v;
fec02dd3 57 if ($extensions{$name}) { s,/,::,g }
44a8e56a
PP
58 if (!$fast{$name}){ push(@v_others, "$name='$val"); next; }
59 push(@v_fast,"$name='$val");
a0d0e21e
LW
60}
61
62foreach(@non_v){ print CONFIG $_ }
63
64print CONFIG "\n",
3c81428c 65 "my \$config_sh = <<'!END!';\n",
a0d0e21e 66 join("", @v_fast, sort @v_others),
3c81428c
PP
67 "!END!\n\n";
68
69# copy config summary format from the myconfig script
70
71print CONFIG "my \$summary = <<'!END!';\n";
72
73open(MYCONFIG,"<myconfig") || die "open myconfig failed: $!";
54310121
PP
741 while defined($_ = <MYCONFIG>) && !/^Summary of/;
75do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
3c81428c 76close(MYCONFIG);
a0d0e21e 77
3c81428c
PP
78print CONFIG "\n!END!\n", <<'EOT';
79my $summary_expanded = 0;
80
81sub myconfig {
82 return $summary if $summary_expanded;
ca8cad5c
TB
83 $summary =~ s{\$(\w+)}
84 { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge;
3c81428c
PP
85 $summary_expanded = 1;
86 $summary;
87}
88EOT
89
90# ----
a0d0e21e
LW
91
92print CONFIG <<'ENDOFEND';
93
a0d0e21e 94sub FETCH {
aa1bdcb8 95 # check for cached value (which may be undef so we use exists not defined)
a0d0e21e 96 return $_[0]->{$_[1]} if (exists $_[0]->{$_[1]});
aa1bdcb8
TP
97
98 # Search for it in the big string
99 my($value, $start, $marker);
100 $marker = "$_[1]='";
101 # return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m);
102 $start = index($config_sh, "\n$marker");
103 return undef if ( ($start == -1) && # in case it's first
104 (substr($config_sh, 0, length($marker)) ne $marker) );
105 if ($start == -1) { $start = length($marker) }
106 else { $start += length($marker) + 1 }
107 $value = substr($config_sh, $start,
44a8e56a 108 index($config_sh, qq('\n), $start) - $start);
a0d0e21e
LW
109
110 $value = undef if $value eq 'undef'; # So we can say "if $Config{'foo'}".
111 $_[0]->{$_[1]} = $value; # cache it
112 return $value;
113}
114
3c81428c
PP
115my $prevpos = 0;
116
a0d0e21e
LW
117sub FIRSTKEY {
118 $prevpos = 0;
aa1bdcb8
TP
119 # my($key) = $config_sh =~ m/^(.*?)=/;
120 substr($config_sh, 0, index($config_sh, '=') );
121 # $key;
a0d0e21e
LW
122}
123
124sub NEXTKEY {
44a8e56a 125 my $pos = index($config_sh, qq('\n), $prevpos) + 2;
3c81428c 126 my $len = index($config_sh, "=", $pos) - $pos;
a0d0e21e 127 $prevpos = $pos;
3c81428c 128 $len > 0 ? substr($config_sh, $pos, $len) : undef;
85e6fe83 129}
a0d0e21e 130
3c81428c 131sub EXISTS {
aa1bdcb8
TP
132 # exists($_[0]->{$_[1]}) or $config_sh =~ m/^$_[1]=/m;
133 exists($_[0]->{$_[1]}) or
134 index($config_sh, "\n$_[1]='") != -1 or
135 substr($config_sh, 0, length($_[1])+2) eq "$_[1]='";
a0d0e21e
LW
136}
137
3c81428c
PP
138sub STORE { die "\%Config::Config is read-only\n" }
139sub DELETE { &STORE }
140sub CLEAR { &STORE }
a0d0e21e 141
3c81428c
PP
142
143sub config_sh {
144 $config_sh
748a9306 145}
9193ea20
PP
146
147sub config_re {
148 my $re = shift;
149 my @matches = ($config_sh =~ /^$re=.*\n/mg);
150 @matches ? (print @matches) : print "$re: not found\n";
151}
152
3c81428c
PP
153sub config_vars {
154 foreach(@_){
9193ea20 155 config_re($_), next if /\W/;
3c81428c
PP
156 my $v=(exists $Config{$_}) ? $Config{$_} : 'UNKNOWN';
157 $v='undef' unless defined $v;
158 print "$_='$v';\n";
159 }
160}
161
9193ea20
PP
162ENDOFEND
163
164if ($^O eq 'os2') {
165 print CONFIG <<'ENDOFSET';
166my %preconfig;
167if ($OS2::is_aout) {
168 my ($value, $v) = $config_sh =~ m/^used_aout='(.*)'\s*$/m;
169 for (split ' ', $value) {
170 ($v) = $config_sh =~ m/^aout_$_='(.*)'\s*$/m;
171 $preconfig{$_} = $v eq 'undef' ? undef : $v;
172 }
173}
174sub TIEHASH { bless {%preconfig} }
175ENDOFSET
176} else {
177 print CONFIG <<'ENDOFSET';
178sub TIEHASH { bless {} }
179ENDOFSET
180}
181
182print CONFIG <<'ENDOFTAIL';
183
fb73857a
PP
184# avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
185sub DESTROY { }
186
9193ea20
PP
187tie %Config, 'Config';
188
3c81428c
PP
1891;
190__END__
748a9306 191
3c81428c 192=head1 NAME
a0d0e21e 193
3c81428c
PP
194Config - access Perl configuration information
195
196=head1 SYNOPSIS
197
198 use Config;
199 if ($Config{'cc'} =~ /gcc/) {
200 print "built by gcc\n";
201 }
202
203 use Config qw(myconfig config_sh config_vars);
204
205 print myconfig();
206
207 print config_sh();
208
209 config_vars(qw(osname archname));
210
211
212=head1 DESCRIPTION
213
214The Config module contains all the information that was available to
215the C<Configure> program at Perl build time (over 900 values).
216
217Shell variables from the F<config.sh> file (written by Configure) are
218stored in the readonly-variable C<%Config>, indexed by their names.
219
220Values stored in config.sh as 'undef' are returned as undefined
1fef88e7 221values. The perl C<exists> function can be used to check if a
3c81428c
PP
222named variable exists.
223
224=over 4
225
226=item myconfig()
227
228Returns a textual summary of the major perl configuration values.
229See also C<-V> in L<perlrun/Switches>.
230
231=item config_sh()
232
233Returns the entire perl configuration information in the form of the
234original config.sh shell variable assignment script.
235
236=item config_vars(@names)
237
238Prints to STDOUT the values of the named configuration variable. Each is
239printed on a separate line in the form:
240
241 name='value';
242
243Names which are unknown are output as C<name='UNKNOWN';>.
244See also C<-V:name> in L<perlrun/Switches>.
245
246=back
247
248=head1 EXAMPLE
249
250Here's a more sophisticated example of using %Config:
251
252 use Config;
743c51bc
WK
253 use strict;
254
255 my %sig_num;
256 my @sig_name;
257 unless($Config{sig_name} && $Config{sig_num}) {
258 die "No sigs?";
259 } else {
260 my @names = split ' ', $Config{sig_name};
261 @sig_num{@names} = split ' ', $Config{sig_num};
262 foreach (@names) {
263 $sig_name[$sig_num{$_}] ||= $_;
264 }
265 }
3c81428c 266
743c51bc
WK
267 print "signal #17 = $sig_name[17]\n";
268 if ($sig_num{ALRM}) {
269 print "SIGALRM is $sig_num{ALRM}\n";
3c81428c
PP
270 }
271
272=head1 WARNING
273
274Because this information is not stored within the perl executable
275itself it is possible (but unlikely) that the information does not
276relate to the actual perl binary which is being used to access it.
277
278The Config module is installed into the architecture and version
279specific library directory ($Config{installarchlib}) and it checks the
280perl version number when loaded.
281
ebc74a4b
GS
282=head1 GLOSSARY
283
284Most C<Config> variables are determined by the C<Configure> script
285on platforms supported by it (which is most UNIX platforms). Some
286platforms have custom-made C<Config> variables, and may thus not have
287some of the variables described below, or may have extraneous variables
288specific to that particular port. See the port specific documentation
289in such cases.
290
291=over 4
292
293ENDOFTAIL
294
295open(GLOS, "<$glossary") or die "Can't open $glossary: $!";
296
297my ($var,$unit,$indentpara);
298my $text = "";
299while (<GLOS>) {
300 if (/^\s*(.*)\s*\(\s*(.+\.U)\s*\):\s*$/) {
301 print CONFIG "\n=item $var\n\n$text\n" if $var and $text;
302 ($var,$unit,$text) = ($1,$2,"");
303 }
304 else {
305 # bite off exactly one tab-width
306 s/^([ ]{8}|[ ]{0,7}\t)//;
307
308 # indented stuff starts a separate paragraph
309 if (/^\s/) {
310 $text .= "\n" unless $indentpara;
311 $indentpara = 1;
312 }
313 else {
314 $text .= "\n" if $indentpara;
315 $indentpara = 0;
316 }
317 $text .= $_;
318 }
319}
320
321print CONFIG "\n=item $var\n\n$text\n" if $var and $text;
322
323print CONFIG <<'ENDOFTAIL';
324
325=back
326
3c81428c
PP
327=head1 NOTE
328
329This module contains a good example of how to use tie to implement a
330cache and an example of how to make a tied variable readonly to those
331outside of it.
332
333=cut
a0d0e21e 334
9193ea20 335ENDOFTAIL
a0d0e21e
LW
336
337close(CONFIG);
ebc74a4b 338close(GLOS);
a0d0e21e
LW
339
340# Now do some simple tests on the Config.pm file we have created
341unshift(@INC,'lib');
342require $config_pm;
343import Config;
344
345die "$0: $config_pm not valid"
346 unless $Config{'CONFIG'} eq 'true';
347
348die "$0: error processing $config_pm"
349 if defined($Config{'an impossible name'})
350 or $Config{'CONFIG'} ne 'true' # test cache
351 ;
352
353die "$0: error processing $config_pm"
354 if eval '$Config{"cc"} = 1'
355 or eval 'delete $Config{"cc"}'
356 ;
357
358
85e6fe83 359exit 0;