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