Don't use $4 when it might be undef
[perl.git] / configpm
1 #!./miniperl -w
2
3 $config_pm = $ARGV[0] || 'lib/Config.pm';
4 @ARGV = "./config.sh";
5
6 # list names to put first (and hence lookup fastest)
7 @fast = qw(archname osname osvers prefix libs libpth
8         dynamic_ext static_ext extensions dlsrc so
9         sig_name sig_num cc ccflags cppflags
10         privlibexp archlibexp installprivlib installarchlib
11         sharpbang startsh shsharp
12 );
13
14 # names of things which may need to have slashes changed to double-colons
15 @extensions = qw(dynamic_ext static_ext extensions known_extensions);
16
17
18 open CONFIG, ">$config_pm" or die "Can't open $config_pm: $!\n";
19 $myver = $];
20
21 print CONFIG <<"ENDOFBEG";
22 package Config;
23 use Exporter ();
24 \@ISA = (Exporter);
25 \@EXPORT = qw(%Config);
26 \@EXPORT_OK = qw(myconfig config_sh config_vars);
27
28 \$] == $myver
29   or die "Perl lib version ($myver) doesn't match executable version (\$])";
30
31 # This file was created by configpm when Perl was built. Any changes
32 # made to this file will be lost the next time perl is built.
33
34 ENDOFBEG
35
36
37 @fast{@fast} = @fast;
38 @extensions{@extensions} = @extensions;
39 @non_v=();
40 @v_fast=();
41 @v_others=();
42 $in_v = 0;
43
44 while (<>) {
45     next if m:^#!/bin/sh:;
46     # Catch CONFIG=true and PATCHLEVEL=n line from Configure.
47     s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/;
48     unless ($in_v or m/^(\w+)='(.*\n)/){
49         push(@non_v, "#$_"); # not a name='value' line
50         next;
51     }
52     if ($in_v) { $val .= $_;             }
53     else       { ($name,$val) = ($1,$2); }
54     $in_v = $val !~ /'\n/;
55     next if $in_v;
56     if ($extensions{$name}) { s,/,::,g }
57     if (!$fast{$name}){ push(@v_others, "$name='$val"); next; }
58     push(@v_fast,"$name='$val");
59 }
60
61 foreach(@non_v){ print CONFIG $_ }
62
63 print CONFIG "\n",
64     "my \$config_sh = <<'!END!';\n",
65     join("", @v_fast, sort @v_others),
66     "!END!\n\n";
67
68 # copy config summary format from the myconfig script
69
70 print CONFIG "my \$summary = <<'!END!';\n";
71
72 open(MYCONFIG,"<myconfig") || die "open myconfig failed: $!";
73 1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
74 do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
75 close(MYCONFIG);
76
77 print CONFIG "\n!END!\n", <<'EOT';
78 my $summary_expanded = 0;
79
80 sub myconfig {
81         return $summary if $summary_expanded;
82         $summary =~ s/\$(\w+)/$Config{$1}/ge;
83         $summary_expanded = 1;
84         $summary;
85 }
86 EOT
87
88 # ----
89
90 print CONFIG <<'ENDOFEND';
91
92 sub FETCH { 
93     # check for cached value (which may be undef so we use exists not defined)
94     return $_[0]->{$_[1]} if (exists $_[0]->{$_[1]});
95
96     # Search for it in the big string 
97     my($value, $start, $marker);
98     $marker = "$_[1]='";
99     # return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m);
100     $start = index($config_sh, "\n$marker");
101     return undef if ( ($start == -1) &&  # in case it's first 
102         (substr($config_sh, 0, length($marker)) ne $marker) );
103     if ($start == -1) { $start = length($marker) } 
104         else { $start += length($marker) + 1 }
105     $value = substr($config_sh, $start, 
106         index($config_sh, qq('\n), $start) - $start);
107  
108     $value = undef if $value eq 'undef'; # So we can say "if $Config{'foo'}".
109     $_[0]->{$_[1]} = $value; # cache it
110     return $value;
111 }
112  
113 my $prevpos = 0;
114
115 sub FIRSTKEY {
116     $prevpos = 0;
117     # my($key) = $config_sh =~ m/^(.*?)=/;
118     substr($config_sh, 0, index($config_sh, '=') );
119     # $key;
120 }
121
122 sub NEXTKEY {
123     my $pos = index($config_sh, qq('\n), $prevpos) + 2;
124     my $len = index($config_sh, "=", $pos) - $pos;
125     $prevpos = $pos;
126     $len > 0 ? substr($config_sh, $pos, $len) : undef;
127 }
128
129 sub EXISTS { 
130     # exists($_[0]->{$_[1]})  or  $config_sh =~ m/^$_[1]=/m;
131     exists($_[0]->{$_[1]}) or
132     index($config_sh, "\n$_[1]='") != -1 or
133     substr($config_sh, 0, length($_[1])+2) eq "$_[1]='";
134 }
135
136 sub STORE  { die "\%Config::Config is read-only\n" }
137 sub DELETE { &STORE }
138 sub CLEAR  { &STORE }
139
140
141 sub config_sh {
142     $config_sh
143 }
144
145 sub config_re {
146     my $re = shift;
147     my @matches = ($config_sh =~ /^$re=.*\n/mg);
148     @matches ? (print @matches) : print "$re: not found\n";
149 }
150
151 sub config_vars {
152     foreach(@_){
153         config_re($_), next if /\W/;
154         my $v=(exists $Config{$_}) ? $Config{$_} : 'UNKNOWN';
155         $v='undef' unless defined $v;
156         print "$_='$v';\n";
157     }
158 }
159
160 ENDOFEND
161
162 if ($^O eq 'os2') {
163   print CONFIG <<'ENDOFSET';
164 my %preconfig;
165 if ($OS2::is_aout) {
166     my ($value, $v) = $config_sh =~ m/^used_aout='(.*)'\s*$/m;
167     for (split ' ', $value) {
168         ($v) = $config_sh =~ m/^aout_$_='(.*)'\s*$/m;
169         $preconfig{$_} = $v eq 'undef' ? undef : $v;
170     }
171 }
172 sub TIEHASH { bless {%preconfig} }
173 ENDOFSET
174 } else {
175   print CONFIG <<'ENDOFSET';
176 sub TIEHASH { bless {} }
177 ENDOFSET
178 }
179
180 print CONFIG <<'ENDOFTAIL';
181
182 tie %Config, 'Config';
183
184 1;
185 __END__
186
187 =head1 NAME
188
189 Config - access Perl configuration information
190
191 =head1 SYNOPSIS
192
193     use Config;
194     if ($Config{'cc'} =~ /gcc/) {
195         print "built by gcc\n";
196     } 
197
198     use Config qw(myconfig config_sh config_vars);
199
200     print myconfig();
201
202     print config_sh();
203
204     config_vars(qw(osname archname));
205
206
207 =head1 DESCRIPTION
208
209 The Config module contains all the information that was available to
210 the C<Configure> program at Perl build time (over 900 values).
211
212 Shell variables from the F<config.sh> file (written by Configure) are
213 stored in the readonly-variable C<%Config>, indexed by their names.
214
215 Values stored in config.sh as 'undef' are returned as undefined
216 values.  The perl C<exists> function can be used to check if a
217 named variable exists.
218
219 =over 4
220
221 =item myconfig()
222
223 Returns a textual summary of the major perl configuration values.
224 See also C<-V> in L<perlrun/Switches>.
225
226 =item config_sh()
227
228 Returns the entire perl configuration information in the form of the
229 original config.sh shell variable assignment script.
230
231 =item config_vars(@names)
232
233 Prints to STDOUT the values of the named configuration variable. Each is
234 printed on a separate line in the form:
235
236   name='value';
237
238 Names which are unknown are output as C<name='UNKNOWN';>.
239 See also C<-V:name> in L<perlrun/Switches>.
240
241 =back
242
243 =head1 EXAMPLE
244
245 Here's a more sophisticated example of using %Config:
246
247     use Config;
248     use strict;
249
250     my %sig_num;
251     my @sig_name;
252     unless($Config{sig_name} && $Config{sig_num}) {
253         die "No sigs?";
254     } else {
255         my @names = split ' ', $Config{sig_name};
256         @sig_num{@names} = split ' ', $Config{sig_num};
257         foreach (@names) {
258             $sig_name[$sig_num{$_}] ||= $_;
259         }   
260     }
261
262     print "signal #17 = $sig_name[17]\n";
263     if ($sig_num{ALRM}) { 
264         print "SIGALRM is $sig_num{ALRM}\n";
265     }   
266
267 =head1 WARNING
268
269 Because this information is not stored within the perl executable
270 itself it is possible (but unlikely) that the information does not
271 relate to the actual perl binary which is being used to access it.
272
273 The Config module is installed into the architecture and version
274 specific library directory ($Config{installarchlib}) and it checks the
275 perl version number when loaded.
276
277 =head1 NOTE
278
279 This module contains a good example of how to use tie to implement a
280 cache and an example of how to make a tied variable readonly to those
281 outside of it.
282
283 =cut
284
285 ENDOFTAIL
286
287 close(CONFIG);
288
289 # Now do some simple tests on the Config.pm file we have created
290 unshift(@INC,'lib');
291 require $config_pm;
292 import Config;
293
294 die "$0: $config_pm not valid"
295         unless $Config{'CONFIG'} eq 'true';
296
297 die "$0: error processing $config_pm"
298         if defined($Config{'an impossible name'})
299         or $Config{'CONFIG'} ne 'true' # test cache
300         ;
301
302 die "$0: error processing $config_pm"
303         if eval '$Config{"cc"} = 1'
304         or eval 'delete $Config{"cc"}'
305         ;
306
307
308 exit 0;