3 my $config_pm = $ARGV[0] || 'lib/Config.pm';
4 my $glossary = $ARGV[1] || 'Porting/Glossary';
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
15 # names of things which may need to have slashes changed to double-colons
16 @extensions = qw(dynamic_ext static_ext extensions known_extensions);
19 open CONFIG, ">$config_pm" or die "Can't open $config_pm: $!\n";
20 $myver = sprintf "v%vd", $^V;
22 print CONFIG <<'ENDOFBEG_NOQ', <<"ENDOFBEG";
25 @EXPORT = qw(%Config);
26 @EXPORT_OK = qw(myconfig config_sh config_vars);
28 # Define our own import method to avoid pulling in the full Exporter:
31 @_ = @EXPORT unless @_;
32 my @func = grep {$_ ne '%Config'} @_;
33 local $Exporter::ExportLevel = 1;
34 Exporter::import('Config', @func) if @func;
35 return if @func == @_;
36 my $callpkg = caller(0);
37 *{"$callpkg\::Config"} = \%Config;
41 die "Perl lib version ($myver) doesn't match executable version (\$])"
45 or die "Perl lib version ($myver) doesn't match executable version (" .
46 (sprintf "v%vd",\$^V) . ")";
48 # This file was created by configpm when Perl was built. Any changes
49 # made to this file will be lost the next time perl is built.
55 @extensions{@extensions} = @extensions;
62 next if m:^#!/bin/sh:;
63 # Catch CONFIGDOTSH=true and PERL_VERSION=n line from Configure.
64 s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/;
66 # grandfather PATCHLEVEL and SUBVERSION and CONFIG
68 if ($k eq 'PERL_VERSION') {
69 push @v_others, "PATCHLEVEL='$v'\n";
71 elsif ($k eq 'PERL_SUBVERSION') {
72 push @v_others, "SUBVERSION='$v'\n";
74 elsif ($k eq 'CONFIGDOTSH') {
75 push @v_others, "CONFIG='$v'\n";
78 # We can delimit things in config.sh with either ' or ".
79 unless ($in_v or m/^(\w+)=(['"])(.*\n)/){
80 push(@non_v, "#$_"); # not a name='value' line
84 if ($in_v) { $val .= $_; }
85 else { ($name,$val) = ($1,$3); }
86 $in_v = $val !~ /$quote\n/;
88 if ($extensions{$name}) { s,/,::,g }
89 if (!$fast{$name}){ push(@v_others, "$name=$quote$val"); next; }
90 push(@v_fast,"$name=$quote$val");
93 foreach(@non_v){ print CONFIG $_ }
96 "my \$config_sh = <<'!END!';\n",
97 join("", @v_fast, sort @v_others),
100 # copy config summary format from the myconfig.SH script
102 print CONFIG "my \$summary = <<'!END!';\n";
104 open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
105 1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
106 do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
109 print CONFIG "\n!END!\n", <<'EOT';
110 my $summary_expanded = 0;
113 return $summary if $summary_expanded;
114 $summary =~ s{\$(\w+)}
115 { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge;
116 $summary_expanded = 1;
123 print CONFIG <<'ENDOFEND';
126 # check for cached value (which may be undef so we use exists not defined)
127 return $_[0]->{$_[1]} if (exists $_[0]->{$_[1]});
129 # Search for it in the big string
130 my($value, $start, $marker, $quote_type);
133 if ($_[1] eq 'byteorder') {
134 my $t = $Config{ivtype};
135 my $s = $Config{ivsize};
136 my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
137 if ($s == 4 || $s == 8) {
139 foreach my $c (reverse(2..$s)) { $i |= ord($c); $i <<= 8 }
141 $value = join('', unpack('a'x$s, pack($f, $i)));
147 # return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m);
148 # Check for the common case, ' delimeted
149 $start = index($config_sh, "\n$marker$quote_type");
150 # If that failed, check for " delimited
153 $start = index($config_sh, "\n$marker$quote_type");
155 return undef if ( ($start == -1) && # in case it's first
156 (substr($config_sh, 0, length($marker)) ne $marker) );
158 # It's the very first thing we found. Skip $start forward
159 # and figure out the quote mark after the =.
160 $start = length($marker) + 1;
161 $quote_type = substr($config_sh, $start - 1, 1);
164 $start += length($marker) + 2;
166 $value = substr($config_sh, $start,
167 index($config_sh, "$quote_type\n", $start) - $start);
169 # If we had a double-quote, we'd better eval it so escape
170 # sequences and such can be interpolated. Since the incoming
171 # value is supposed to follow shell rules and not perl rules,
172 # we escape any perl variable markers
173 if ($quote_type eq '"') {
174 $value =~ s/\$/\\\$/g;
175 $value =~ s/\@/\\\@/g;
176 eval "\$value = \"$value\"";
178 #$value = sprintf($value) if $quote_type eq '"';
179 # So we can say "if $Config{'foo'}".
180 $value = undef if $value eq 'undef';
181 $_[0]->{$_[1]} = $value; # cache it
189 # my($key) = $config_sh =~ m/^(.*?)=/;
190 substr($config_sh, 0, index($config_sh, '=') );
195 # Find out how the current key's quoted so we can skip to its end.
196 my $quote = substr($config_sh, index($config_sh, "=", $prevpos)+1, 1);
197 my $pos = index($config_sh, qq($quote\n), $prevpos) + 2;
198 my $len = index($config_sh, "=", $pos) - $pos;
200 $len > 0 ? substr($config_sh, $pos, $len) : undef;
204 # exists($_[0]->{$_[1]}) or $config_sh =~ m/^$_[1]=/m;
205 exists($_[0]->{$_[1]}) or
206 index($config_sh, "\n$_[1]='") != -1 or
207 substr($config_sh, 0, length($_[1])+2) eq "$_[1]='" or
208 index($config_sh, "\n$_[1]=\"") != -1 or
209 substr($config_sh, 0, length($_[1])+2) eq "$_[1]=\"";
212 sub STORE { die "\%Config::Config is read-only\n" }
213 sub DELETE { &STORE }
223 my @matches = ($config_sh =~ /^$re=.*\n/mg);
224 @matches ? (print @matches) : print "$re: not found\n";
229 config_re($_), next if /\W/;
230 my $v=(exists $Config{$_}) ? $Config{$_} : 'UNKNOWN';
231 $v='undef' unless defined $v;
239 print CONFIG <<'ENDOFSET';
242 my ($value, $v) = $config_sh =~ m/^used_aout='(.*)'\s*$/m;
243 for (split ' ', $value) {
244 ($v) = $config_sh =~ m/^aout_$_='(.*)'\s*$/m;
245 $preconfig{$_} = $v eq 'undef' ? undef : $v;
248 sub TIEHASH { bless {%preconfig} }
251 print CONFIG <<'ENDOFSET';
252 sub TIEHASH { bless {} }
256 print CONFIG <<'ENDOFTAIL';
258 # avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
261 tie %Config, 'Config';
268 Config - access Perl configuration information
273 if ($Config{'cc'} =~ /gcc/) {
274 print "built by gcc\n";
277 use Config qw(myconfig config_sh config_vars);
283 config_vars(qw(osname archname));
288 The Config module contains all the information that was available to
289 the C<Configure> program at Perl build time (over 900 values).
291 Shell variables from the F<config.sh> file (written by Configure) are
292 stored in the readonly-variable C<%Config>, indexed by their names.
294 Values stored in config.sh as 'undef' are returned as undefined
295 values. The perl C<exists> function can be used to check if a
296 named variable exists.
302 Returns a textual summary of the major perl configuration values.
303 See also C<-V> in L<perlrun/Switches>.
307 Returns the entire perl configuration information in the form of the
308 original config.sh shell variable assignment script.
310 =item config_vars(@names)
312 Prints to STDOUT the values of the named configuration variable. Each is
313 printed on a separate line in the form:
317 Names which are unknown are output as C<name='UNKNOWN';>.
318 See also C<-V:name> in L<perlrun/Switches>.
324 Here's a more sophisticated example of using %Config:
331 unless($Config{sig_name} && $Config{sig_num}) {
334 my @names = split ' ', $Config{sig_name};
335 @sig_num{@names} = split ' ', $Config{sig_num};
337 $sig_name[$sig_num{$_}] ||= $_;
341 print "signal #17 = $sig_name[17]\n";
342 if ($sig_num{ALRM}) {
343 print "SIGALRM is $sig_num{ALRM}\n";
348 Because this information is not stored within the perl executable
349 itself it is possible (but unlikely) that the information does not
350 relate to the actual perl binary which is being used to access it.
352 The Config module is installed into the architecture and version
353 specific library directory ($Config{installarchlib}) and it checks the
354 perl version number when loaded.
356 The values stored in config.sh may be either single-quoted or
357 double-quoted. Double-quoted strings are handy for those cases where you
358 need to include escape sequences in the strings. To avoid runtime variable
359 interpolation, any C<$> and C<@> characters are replaced by C<\$> and
360 C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
361 or C<\@> in double-quoted strings unless you're willing to deal with the
362 consequences. (The slashes will end up escaped and the C<$> or C<@> will
363 trigger variable interpolation)
367 Most C<Config> variables are determined by the C<Configure> script
368 on platforms supported by it (which is most UNIX platforms). Some
369 platforms have custom-made C<Config> variables, and may thus not have
370 some of the variables described below, or may have extraneous variables
371 specific to that particular port. See the port specific documentation
376 open(GLOS, "<$glossary") or die "Can't open $glossary: $!";
382 s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m;
383 my $c = substr $1, 0, 1;
384 unless ($seen{$c}++) {
385 print CONFIG <<EOF if $text;
397 s/n't/n\00t/g; # leave can't, won't etc untouched
398 s/^\t\s+(.*)/\n\t$1\n/gm; # Indented lines ===> paragraphs
399 s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text
400 s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
401 s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
402 s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
404 (?<! [\w./<\'\"] ) # Only standalone file names
405 (?! e \. g \. ) # Not e.g.
406 (?! \. \. \. ) # Not ...
408 ( [\w./]* [./] [\w./]* ) # Require . or / inside
409 (?<! \. (?= \s ) ) # Do not include trailing dot
410 (?! [\w/] ) # Include all of it
412 (F<$1>)xg; # /usr/local
413 s/((?<=\s)~\w*)/F<$1>/g; # ~name
414 s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD
415 s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
416 s/n[\0]t/n't/g; # undo can't, won't damage
419 <GLOS>; # Skip the preamble
425 print CONFIG <<'ENDOFTAIL';
431 This module contains a good example of how to use tie to implement a
432 cache and an example of how to make a tied variable readonly to those
442 # Now do some simple tests on the Config.pm file we have created
447 die "$0: $config_pm not valid"
448 unless $Config{'CONFIGDOTSH'} eq 'true';
450 die "$0: error processing $config_pm"
451 if defined($Config{'an impossible name'})
452 or $Config{'CONFIGDOTSH'} ne 'true' # test cache
455 die "$0: error processing $config_pm"
456 if eval '$Config{"cc"} = 1'
457 or eval 'delete $Config{"cc"}'