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";
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 Exporter::import('Config', @func) if @func;
34 return if @func == @_;
35 my $callpkg = caller(0);
36 *{"$callpkg\::Config"} = \%Config;
41 or die "Perl lib version ($myver) doesn't match executable version (\$])";
43 # This file was created by configpm when Perl was built. Any changes
44 # made to this file will be lost the next time perl is built.
50 @extensions{@extensions} = @extensions;
57 next if m:^#!/bin/sh:;
58 # Catch CONFIGDOTSH=true and PERL_VERSION=n line from Configure.
59 s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/;
61 # grandfather PATCHLEVEL and SUBVERSION and CONFIG
63 if ($k eq 'PERL_VERSION') {
64 push @v_others, "PATCHLEVEL='$v'\n";
66 elsif ($k eq 'PERL_SUBVERSION') {
67 push @v_others, "SUBVERSION='$v'\n";
69 elsif ($k eq 'CONFIGDOTSH') {
70 push @v_others, "CONFIG='$v'\n";
73 # We can delimit things in config.sh with either ' or ".
74 unless ($in_v or m/^(\w+)=(['"])(.*\n)/){
75 push(@non_v, "#$_"); # not a name='value' line
79 if ($in_v) { $val .= $_; }
80 else { ($name,$val) = ($1,$3); }
81 $in_v = $val !~ /$quote\n/;
83 if ($extensions{$name}) { s,/,::,g }
84 if (!$fast{$name}){ push(@v_others, "$name=$quote$val"); next; }
85 push(@v_fast,"$name=$quote$val");
88 foreach(@non_v){ print CONFIG $_ }
91 "my \$config_sh = <<'!END!';\n",
92 join("", @v_fast, sort @v_others),
95 # copy config summary format from the myconfig.SH script
97 print CONFIG "my \$summary = <<'!END!';\n";
99 open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
100 1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
101 do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
104 print CONFIG "\n!END!\n", <<'EOT';
105 my $summary_expanded = 0;
108 return $summary if $summary_expanded;
109 $summary =~ s{\$(\w+)}
110 { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge;
111 $summary_expanded = 1;
118 print CONFIG <<'ENDOFEND';
121 # check for cached value (which may be undef so we use exists not defined)
122 return $_[0]->{$_[1]} if (exists $_[0]->{$_[1]});
124 # Search for it in the big string
125 my($value, $start, $marker, $quote_type);
128 # return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m);
129 # Check for the common case, ' delimeted
130 $start = index($config_sh, "\n$marker$quote_type");
131 # If that failed, check for " delimited
134 $start = index($config_sh, "\n$marker$quote_type");
136 return undef if ( ($start == -1) && # in case it's first
137 (substr($config_sh, 0, length($marker)) ne $marker) );
139 # It's the very first thing we found. Skip $start forward
140 # and figure out the quote mark after the =.
141 $start = length($marker) + 1;
142 $quote_type = substr($config_sh, $start - 1, 1);
145 $start += length($marker) + 2;
147 $value = substr($config_sh, $start,
148 index($config_sh, "$quote_type\n", $start) - $start);
150 # If we had a double-quote, we'd better eval it so escape
151 # sequences and such can be interpolated. Since the incoming
152 # value is supposed to follow shell rules and not perl rules,
153 # we escape any perl variable markers
154 if ($quote_type eq '"') {
155 $value =~ s/\$/\\\$/g;
156 $value =~ s/\@/\\\@/g;
157 eval "\$value = \"$value\"";
159 #$value = sprintf($value) if $quote_type eq '"';
160 $value = undef if $value eq 'undef'; # So we can say "if $Config{'foo'}".
161 $_[0]->{$_[1]} = $value; # cache it
169 # my($key) = $config_sh =~ m/^(.*?)=/;
170 substr($config_sh, 0, index($config_sh, '=') );
175 # Find out how the current key's quoted so we can skip to its end.
176 my $quote = substr($config_sh, index($config_sh, "=", $prevpos)+1, 1);
177 my $pos = index($config_sh, qq($quote\n), $prevpos) + 2;
178 my $len = index($config_sh, "=", $pos) - $pos;
180 $len > 0 ? substr($config_sh, $pos, $len) : undef;
184 # exists($_[0]->{$_[1]}) or $config_sh =~ m/^$_[1]=/m;
185 exists($_[0]->{$_[1]}) or
186 index($config_sh, "\n$_[1]='") != -1 or
187 substr($config_sh, 0, length($_[1])+2) eq "$_[1]='" or
188 index($config_sh, "\n$_[1]=\"") != -1 or
189 substr($config_sh, 0, length($_[1])+2) eq "$_[1]=\"";
192 sub STORE { die "\%Config::Config is read-only\n" }
193 sub DELETE { &STORE }
203 my @matches = ($config_sh =~ /^$re=.*\n/mg);
204 @matches ? (print @matches) : print "$re: not found\n";
209 config_re($_), next if /\W/;
210 my $v=(exists $Config{$_}) ? $Config{$_} : 'UNKNOWN';
211 $v='undef' unless defined $v;
219 print CONFIG <<'ENDOFSET';
222 my ($value, $v) = $config_sh =~ m/^used_aout='(.*)'\s*$/m;
223 for (split ' ', $value) {
224 ($v) = $config_sh =~ m/^aout_$_='(.*)'\s*$/m;
225 $preconfig{$_} = $v eq 'undef' ? undef : $v;
228 sub TIEHASH { bless {%preconfig} }
231 print CONFIG <<'ENDOFSET';
232 sub TIEHASH { bless {} }
236 print CONFIG <<'ENDOFTAIL';
238 # avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
241 tie %Config, 'Config';
248 Config - access Perl configuration information
253 if ($Config{'cc'} =~ /gcc/) {
254 print "built by gcc\n";
257 use Config qw(myconfig config_sh config_vars);
263 config_vars(qw(osname archname));
268 The Config module contains all the information that was available to
269 the C<Configure> program at Perl build time (over 900 values).
271 Shell variables from the F<config.sh> file (written by Configure) are
272 stored in the readonly-variable C<%Config>, indexed by their names.
274 Values stored in config.sh as 'undef' are returned as undefined
275 values. The perl C<exists> function can be used to check if a
276 named variable exists.
282 Returns a textual summary of the major perl configuration values.
283 See also C<-V> in L<perlrun/Switches>.
287 Returns the entire perl configuration information in the form of the
288 original config.sh shell variable assignment script.
290 =item config_vars(@names)
292 Prints to STDOUT the values of the named configuration variable. Each is
293 printed on a separate line in the form:
297 Names which are unknown are output as C<name='UNKNOWN';>.
298 See also C<-V:name> in L<perlrun/Switches>.
304 Here's a more sophisticated example of using %Config:
311 unless($Config{sig_name} && $Config{sig_num}) {
314 my @names = split ' ', $Config{sig_name};
315 @sig_num{@names} = split ' ', $Config{sig_num};
317 $sig_name[$sig_num{$_}] ||= $_;
321 print "signal #17 = $sig_name[17]\n";
322 if ($sig_num{ALRM}) {
323 print "SIGALRM is $sig_num{ALRM}\n";
328 Because this information is not stored within the perl executable
329 itself it is possible (but unlikely) that the information does not
330 relate to the actual perl binary which is being used to access it.
332 The Config module is installed into the architecture and version
333 specific library directory ($Config{installarchlib}) and it checks the
334 perl version number when loaded.
336 The values stored in config.sh may be either single-quoted or
337 double-quoted. Double-quoted strings are handy for those cases where you
338 need to include escape sequences in the strings. To avoid runtime variable
339 interpolation, any C<$> and C<@> characters are replaced by C<\$> and
340 C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
341 or C<\@> in double-quoted strings unless you're willing to deal with the
342 consequences. (The slashes will end up escaped and the C<$> or C<@> will
343 trigger variable interpolation)
347 Most C<Config> variables are determined by the C<Configure> script
348 on platforms supported by it (which is most UNIX platforms). Some
349 platforms have custom-made C<Config> variables, and may thus not have
350 some of the variables described below, or may have extraneous variables
351 specific to that particular port. See the port specific documentation
356 open(GLOS, "<$glossary") or die "Can't open $glossary: $!";
362 s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m;
363 my $c = substr $1, 0, 1;
364 unless ($seen{$c}++) {
365 print CONFIG <<EOF if $text;
377 s/n't/n\00t/g; # leave can't, won't etc untouched
378 s/^\t\s+(.*)/\n\t$1\n/gm; # Indented lines ===> paragraphs
379 s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text
380 s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
381 s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
382 s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
384 (?<! [\w./<\'\"] ) # Only standalone file names
385 (?! e \. g \. ) # Not e.g.
386 (?! \. \. \. ) # Not ...
388 ( [\w./]* [./] [\w./]* ) # Require . or / inside
389 (?<! \. (?= \s ) ) # Do not include trailing dot
390 (?! [\w/] ) # Include all of it
392 (F<$1>)xg; # /usr/local
393 s/((?<=\s)~\w*)/F<$1>/g; # ~name
394 s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD
395 s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
396 s/n[\0]t/n't/g; # undo can't, won't damage
399 <GLOS>; # Skip the preamble
405 print CONFIG <<'ENDOFTAIL';
411 This module contains a good example of how to use tie to implement a
412 cache and an example of how to make a tied variable readonly to those
422 # Now do some simple tests on the Config.pm file we have created
427 die "$0: $config_pm not valid"
428 unless $Config{'CONFIGDOTSH'} eq 'true';
430 die "$0: error processing $config_pm"
431 if defined($Config{'an impossible name'})
432 or $Config{'CONFIGDOTSH'} ne 'true' # test cache
435 die "$0: error processing $config_pm"
436 if eval '$Config{"cc"} = 1'
437 or eval 'delete $Config{"cc"}'