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";
26 \@EXPORT = qw(%Config);
27 \@EXPORT_OK = qw(myconfig config_sh config_vars);
30 or die "Perl lib version ($myver) doesn't match executable version (\$])";
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.
39 @extensions{@extensions} = @extensions;
46 next if m:^#!/bin/sh:;
47 # Catch CONFIG=true and PERL_VERSION=n line from Configure.
48 s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/;
50 # grandfather PATCHLEVEL and SUBVERSION
52 if ($k eq 'PERL_VERSION') {
53 push @v_others, "PATCHLEVEL='$v'\n";
55 elsif ($k eq 'PERL_SUBVERSION') {
56 push @v_others, "SUBVERSION='$v'\n";
59 # We can delimit things in config.sh with either ' or ".
60 unless ($in_v or m/^(\w+)=(['"])(.*\n)/){
61 push(@non_v, "#$_"); # not a name='value' line
65 if ($in_v) { $val .= $_; }
66 else { ($name,$val) = ($1,$3); }
67 $in_v = $val !~ /$quote\n/;
69 if ($extensions{$name}) { s,/,::,g }
70 if (!$fast{$name}){ push(@v_others, "$name=$quote$val"); next; }
71 push(@v_fast,"$name=$quote$val");
74 foreach(@non_v){ print CONFIG $_ }
77 "my \$config_sh = <<'!END!';\n",
78 join("", @v_fast, sort @v_others),
81 # copy config summary format from the myconfig script
83 print CONFIG "my \$summary = <<'!END!';\n";
85 open(MYCONFIG,"<myconfig") || die "open myconfig failed: $!";
86 1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
87 do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
90 print CONFIG "\n!END!\n", <<'EOT';
91 my $summary_expanded = 0;
94 return $summary if $summary_expanded;
95 $summary =~ s{\$(\w+)}
96 { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge;
97 $summary_expanded = 1;
104 print CONFIG <<'ENDOFEND';
107 # check for cached value (which may be undef so we use exists not defined)
108 return $_[0]->{$_[1]} if (exists $_[0]->{$_[1]});
110 # Search for it in the big string
111 my($value, $start, $marker, $quote_type);
114 # return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m);
115 # Check for the common case, ' delimeted
116 $start = index($config_sh, "\n$marker$quote_type");
117 # If that failed, check for " delimited
120 $start = index($config_sh, "\n$marker$quote_type");
122 return undef if ( ($start == -1) && # in case it's first
123 (substr($config_sh, 0, length($marker)) ne $marker) );
125 # It's the very first thing we found. Skip $start forward
126 # and figure out the quote mark after the =.
127 $start = length($marker) + 1;
128 $quote_type = substr($config_sh, $start - 1, 1);
131 $start += length($marker) + 2;
133 $value = substr($config_sh, $start,
134 index($config_sh, "$quote_type\n", $start) - $start);
136 # If we had a double-quote, we'd better eval it so escape
137 # sequences and such can be interpolated. Since the incoming
138 # value is supposed to follow shell rules and not perl rules,
139 # we escape any perl variable markers
140 if ($quote_type eq '"') {
141 $value =~ s/\$/\\\$/g;
142 $value =~ s/\@/\\\@/g;
143 eval "\$value = \"$value\"";
145 #$value = sprintf($value) if $quote_type eq '"';
146 $value = undef if $value eq 'undef'; # So we can say "if $Config{'foo'}".
147 $_[0]->{$_[1]} = $value; # cache it
155 # my($key) = $config_sh =~ m/^(.*?)=/;
156 substr($config_sh, 0, index($config_sh, '=') );
161 # Find out how the current key's quoted so we can skip to its end.
162 my $quote = substr($config_sh, index($config_sh, "=", $prevpos)+1, 1);
163 my $pos = index($config_sh, qq($quote\n), $prevpos) + 2;
164 my $len = index($config_sh, "=", $pos) - $pos;
166 $len > 0 ? substr($config_sh, $pos, $len) : undef;
170 # exists($_[0]->{$_[1]}) or $config_sh =~ m/^$_[1]=/m;
171 exists($_[0]->{$_[1]}) or
172 index($config_sh, "\n$_[1]='") != -1 or
173 substr($config_sh, 0, length($_[1])+2) eq "$_[1]='" or
174 index($config_sh, "\n$_[1]=\"") != -1 or
175 substr($config_sh, 0, length($_[1])+2) eq "$_[1]=\"";
178 sub STORE { die "\%Config::Config is read-only\n" }
179 sub DELETE { &STORE }
189 my @matches = ($config_sh =~ /^$re=.*\n/mg);
190 @matches ? (print @matches) : print "$re: not found\n";
195 config_re($_), next if /\W/;
196 my $v=(exists $Config{$_}) ? $Config{$_} : 'UNKNOWN';
197 $v='undef' unless defined $v;
205 print CONFIG <<'ENDOFSET';
208 my ($value, $v) = $config_sh =~ m/^used_aout='(.*)'\s*$/m;
209 for (split ' ', $value) {
210 ($v) = $config_sh =~ m/^aout_$_='(.*)'\s*$/m;
211 $preconfig{$_} = $v eq 'undef' ? undef : $v;
214 sub TIEHASH { bless {%preconfig} }
217 print CONFIG <<'ENDOFSET';
218 sub TIEHASH { bless {} }
222 print CONFIG <<'ENDOFTAIL';
224 # avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
227 tie %Config, 'Config';
234 Config - access Perl configuration information
239 if ($Config{'cc'} =~ /gcc/) {
240 print "built by gcc\n";
243 use Config qw(myconfig config_sh config_vars);
249 config_vars(qw(osname archname));
254 The Config module contains all the information that was available to
255 the C<Configure> program at Perl build time (over 900 values).
257 Shell variables from the F<config.sh> file (written by Configure) are
258 stored in the readonly-variable C<%Config>, indexed by their names.
260 Values stored in config.sh as 'undef' are returned as undefined
261 values. The perl C<exists> function can be used to check if a
262 named variable exists.
268 Returns a textual summary of the major perl configuration values.
269 See also C<-V> in L<perlrun/Switches>.
273 Returns the entire perl configuration information in the form of the
274 original config.sh shell variable assignment script.
276 =item config_vars(@names)
278 Prints to STDOUT the values of the named configuration variable. Each is
279 printed on a separate line in the form:
283 Names which are unknown are output as C<name='UNKNOWN';>.
284 See also C<-V:name> in L<perlrun/Switches>.
290 Here's a more sophisticated example of using %Config:
297 unless($Config{sig_name} && $Config{sig_num}) {
300 my @names = split ' ', $Config{sig_name};
301 @sig_num{@names} = split ' ', $Config{sig_num};
303 $sig_name[$sig_num{$_}] ||= $_;
307 print "signal #17 = $sig_name[17]\n";
308 if ($sig_num{ALRM}) {
309 print "SIGALRM is $sig_num{ALRM}\n";
314 Because this information is not stored within the perl executable
315 itself it is possible (but unlikely) that the information does not
316 relate to the actual perl binary which is being used to access it.
318 The Config module is installed into the architecture and version
319 specific library directory ($Config{installarchlib}) and it checks the
320 perl version number when loaded.
322 The values stored in config.sh may be either single-quoted or
323 double-quoted. Double-quoted strings are handy for those cases where you
324 need to include escape sequences in the strings. To avoid runtime variable
325 interpolation, any C<$> and C<@> characters are replaced by C<\$> and
326 C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
327 or C<\@> in double-quoted strings unless you're willing to deal with the
328 consequences. (The slashes will end up escaped and the C<$> or C<@> will
329 trigger variable interpolation)
333 Most C<Config> variables are determined by the C<Configure> script
334 on platforms supported by it (which is most UNIX platforms). Some
335 platforms have custom-made C<Config> variables, and may thus not have
336 some of the variables described below, or may have extraneous variables
337 specific to that particular port. See the port specific documentation
342 open(GLOS, "<$glossary") or die "Can't open $glossary: $!";
348 s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m;
349 my $c = substr $1, 0, 1;
350 unless ($seen{$c}++) {
351 print CONFIG <<EOF if $text;
363 s/n't/n\00t/g; # leave can't, won't etc untouched
364 s/^\t\s+(.*)/\n\t$1\n/gm; # Indented lines ===> paragraphs
365 s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text
366 s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
367 s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
368 s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
370 (?<! [\w./<\'\"] ) # Only standalone file names
371 (?! e \. g \. ) # Not e.g.
372 (?! \. \. \. ) # Not ...
374 ( [\w./]* [./] [\w./]* ) # Require . or / inside
375 (?<! \. (?= \s ) ) # Do not include trailing dot
376 (?! [\w/] ) # Include all of it
378 (F<$1>)xg; # /usr/local
379 s/((?<=\s)~\w*)/F<$1>/g; # ~name
380 s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD
381 s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
382 s/n[\0]t/n't/g; # undo can't, won't damage
385 <GLOS>; # Skip the preamble
391 print CONFIG <<'ENDOFTAIL';
397 This module contains a good example of how to use tie to implement a
398 cache and an example of how to make a tied variable readonly to those
408 # Now do some simple tests on the Config.pm file we have created
413 die "$0: $config_pm not valid"
414 unless $Config{'CONFIG'} eq 'true';
416 die "$0: error processing $config_pm"
417 if defined($Config{'an impossible name'})
418 or $Config{'CONFIG'} ne 'true' # test cache
421 die "$0: error processing $config_pm"
422 if eval '$Config{"cc"} = 1'
423 or eval 'delete $Config{"cc"}'