This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
971af7fbdd7ba056ba0db0edc0fb030cc7f96811
[perl5.git] / configpm
1 #!./miniperl -w
2
3 my $config_pm = $ARGV[0] || 'lib/Config.pm';
4 my $glossary = $ARGV[1] || 'Porting/Glossary';
5 @ARGV = "./config.sh";
6
7 # list names to put first (and hence lookup fastest)
8 @fast = qw(archname osname osvers prefix libs libpth
9         dynamic_ext static_ext extensions dlsrc so
10         sig_name sig_num cc ccflags cppflags
11         privlibexp archlibexp installprivlib installarchlib
12         sharpbang startsh shsharp
13 );
14
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
18
19 open CONFIG, ">$config_pm" or die "Can't open $config_pm: $!\n";
20 $myver = $];
21
22 print CONFIG <<"ENDOFBEG";
23 package Config;
24 use Exporter ();
25 \@ISA = (Exporter);
26 \@EXPORT = qw(%Config);
27 \@EXPORT_OK = qw(myconfig config_sh config_vars);
28
29 \$] == $myver
30   or die "Perl lib version ($myver) doesn't match executable version (\$])";
31
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
35 ENDOFBEG
36
37
38 @fast{@fast} = @fast;
39 @extensions{@extensions} = @extensions;
40 @non_v=();
41 @v_fast=();
42 @v_others=();
43 $in_v = 0;
44
45 while (<>) {
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/;
49     unless ($in_v or m/^(\w+)='(.*\n)/){
50         push(@non_v, "#$_"); # not a name='value' line
51         next;
52     }
53     if ($in_v) { $val .= $_;             }
54     else       { ($name,$val) = ($1,$2); }
55     $in_v = $val !~ /'\n/;
56     next if $in_v;
57     if ($extensions{$name}) { s,/,::,g }
58     if (!$fast{$name}){ push(@v_others, "$name='$val"); next; }
59     push(@v_fast,"$name='$val");
60 }
61
62 foreach(@non_v){ print CONFIG $_ }
63
64 print CONFIG "\n",
65     "my \$config_sh = <<'!END!';\n",
66     join("", @v_fast, sort @v_others),
67     "!END!\n\n";
68
69 # copy config summary format from the myconfig script
70
71 print CONFIG "my \$summary = <<'!END!';\n";
72
73 open(MYCONFIG,"<myconfig") || die "open myconfig failed: $!";
74 1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
75 do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
76 close(MYCONFIG);
77
78 print CONFIG "\n!END!\n", <<'EOT';
79 my $summary_expanded = 0;
80
81 sub myconfig {
82         return $summary if $summary_expanded;
83         $summary =~ s{\$(\w+)}
84                      { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge;
85         $summary_expanded = 1;
86         $summary;
87 }
88 EOT
89
90 # ----
91
92 print CONFIG <<'ENDOFEND';
93
94 sub FETCH { 
95     # check for cached value (which may be undef so we use exists not defined)
96     return $_[0]->{$_[1]} if (exists $_[0]->{$_[1]});
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, 
108         index($config_sh, qq('\n), $start) - $start);
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  
115 my $prevpos = 0;
116
117 sub FIRSTKEY {
118     $prevpos = 0;
119     # my($key) = $config_sh =~ m/^(.*?)=/;
120     substr($config_sh, 0, index($config_sh, '=') );
121     # $key;
122 }
123
124 sub NEXTKEY {
125     my $pos = index($config_sh, qq('\n), $prevpos) + 2;
126     my $len = index($config_sh, "=", $pos) - $pos;
127     $prevpos = $pos;
128     $len > 0 ? substr($config_sh, $pos, $len) : undef;
129 }
130
131 sub EXISTS { 
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]='";
136 }
137
138 sub STORE  { die "\%Config::Config is read-only\n" }
139 sub DELETE { &STORE }
140 sub CLEAR  { &STORE }
141
142
143 sub config_sh {
144     $config_sh
145 }
146
147 sub 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
153 sub config_vars {
154     foreach(@_){
155         config_re($_), next if /\W/;
156         my $v=(exists $Config{$_}) ? $Config{$_} : 'UNKNOWN';
157         $v='undef' unless defined $v;
158         print "$_='$v';\n";
159     }
160 }
161
162 ENDOFEND
163
164 if ($^O eq 'os2') {
165   print CONFIG <<'ENDOFSET';
166 my %preconfig;
167 if ($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 }
174 sub TIEHASH { bless {%preconfig} }
175 ENDOFSET
176 } else {
177   print CONFIG <<'ENDOFSET';
178 sub TIEHASH { bless {} }
179 ENDOFSET
180 }
181
182 print CONFIG <<'ENDOFTAIL';
183
184 # avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
185 sub DESTROY { }
186
187 tie %Config, 'Config';
188
189 1;
190 __END__
191
192 =head1 NAME
193
194 Config - 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
214 The Config module contains all the information that was available to
215 the C<Configure> program at Perl build time (over 900 values).
216
217 Shell variables from the F<config.sh> file (written by Configure) are
218 stored in the readonly-variable C<%Config>, indexed by their names.
219
220 Values stored in config.sh as 'undef' are returned as undefined
221 values.  The perl C<exists> function can be used to check if a
222 named variable exists.
223
224 =over 4
225
226 =item myconfig()
227
228 Returns a textual summary of the major perl configuration values.
229 See also C<-V> in L<perlrun/Switches>.
230
231 =item config_sh()
232
233 Returns the entire perl configuration information in the form of the
234 original config.sh shell variable assignment script.
235
236 =item config_vars(@names)
237
238 Prints to STDOUT the values of the named configuration variable. Each is
239 printed on a separate line in the form:
240
241   name='value';
242
243 Names which are unknown are output as C<name='UNKNOWN';>.
244 See also C<-V:name> in L<perlrun/Switches>.
245
246 =back
247
248 =head1 EXAMPLE
249
250 Here's a more sophisticated example of using %Config:
251
252     use Config;
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     }
266
267     print "signal #17 = $sig_name[17]\n";
268     if ($sig_num{ALRM}) { 
269         print "SIGALRM is $sig_num{ALRM}\n";
270     }   
271
272 =head1 WARNING
273
274 Because this information is not stored within the perl executable
275 itself it is possible (but unlikely) that the information does not
276 relate to the actual perl binary which is being used to access it.
277
278 The Config module is installed into the architecture and version
279 specific library directory ($Config{installarchlib}) and it checks the
280 perl version number when loaded.
281
282 =head1 GLOSSARY
283
284 Most C<Config> variables are determined by the C<Configure> script
285 on platforms supported by it (which is most UNIX platforms).  Some
286 platforms have custom-made C<Config> variables, and may thus not have
287 some of the variables described below, or may have extraneous variables
288 specific to that particular port.  See the port specific documentation
289 in such cases.
290
291 ENDOFTAIL
292
293 open(GLOS, "<$glossary") or die "Can't open $glossary: $!";
294 %seen = ();
295 $text = 0;
296 $/ = '';
297
298 sub process {
299   s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m;
300   my $c = substr $1, 0, 1;
301   unless ($seen{$c}++) {
302     print CONFIG <<EOF if $text;
303 =back
304
305 EOF
306     print CONFIG <<EOF;
307 =head2 $c
308
309 =over
310
311 EOF
312     $text = 1;
313   }
314   s/n't/n\00t/g;                # leave can't, won't etc untouched
315   s/^\t\s+(.*)/\n\t$1\n/gm;     # Indented lines ===> paragraphs
316   s/^(?<!\n\n)\t(.*)/$1/gm;     # Not indented lines ===> text
317   s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
318   s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
319   s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
320   s{
321      (?<! [\w./<\'\"] )         # Only standalone file names
322      (?! e \. g \. )            # Not e.g.
323      (?! \. \. \. )             # Not ...
324      (?! \d )                   # Not 5.004
325      ( [\w./]* [./] [\w./]* )   # Require . or / inside
326      (?<! \. (?= \s ) )         # Do not include trailing dot
327      (?! [\w/] )                # Include all of it
328    }
329    (F<$1>)xg;                   # /usr/local
330   s/((?<=\s)~\w*)/F<$1>/g;      # ~name
331   s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g;    # UNISTD
332   s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
333   s/n[\0]t/n't/g;               # undo can't, won't damage
334 }
335
336 <GLOS>;                         # Skip the preamble
337 while (<GLOS>) {
338   process;
339   print CONFIG;
340 }
341
342 print CONFIG <<'ENDOFTAIL';
343
344 =back
345
346 =head1 NOTE
347
348 This module contains a good example of how to use tie to implement a
349 cache and an example of how to make a tied variable readonly to those
350 outside of it.
351
352 =cut
353
354 ENDOFTAIL
355
356 close(CONFIG);
357 close(GLOS);
358
359 # Now do some simple tests on the Config.pm file we have created
360 unshift(@INC,'lib');
361 require $config_pm;
362 import Config;
363
364 die "$0: $config_pm not valid"
365         unless $Config{'CONFIG'} eq 'true';
366
367 die "$0: error processing $config_pm"
368         if defined($Config{'an impossible name'})
369         or $Config{'CONFIG'} ne 'true' # test cache
370         ;
371
372 die "$0: error processing $config_pm"
373         if eval '$Config{"cc"} = 1'
374         or eval 'delete $Config{"cc"}'
375         ;
376
377
378 exit 0;