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