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 my $i = unpack($f, pack('C*', map { ord() } 1..$s));
138 if ($s == 4 || $s == 8) {
139 $value = join('', unpack('a'x$s, pack($f, $i)));
145 # return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m);
146 # Check for the common case, ' delimeted
147 $start = index($config_sh, "\n$marker$quote_type");
148 # If that failed, check for " delimited
151 $start = index($config_sh, "\n$marker$quote_type");
153 return undef if ( ($start == -1) && # in case it's first
154 (substr($config_sh, 0, length($marker)) ne $marker) );
156 # It's the very first thing we found. Skip $start forward
157 # and figure out the quote mark after the =.
158 $start = length($marker) + 1;
159 $quote_type = substr($config_sh, $start - 1, 1);
162 $start += length($marker) + 2;
164 $value = substr($config_sh, $start,
165 index($config_sh, "$quote_type\n", $start) - $start);
167 # If we had a double-quote, we'd better eval it so escape
168 # sequences and such can be interpolated. Since the incoming
169 # value is supposed to follow shell rules and not perl rules,
170 # we escape any perl variable markers
171 if ($quote_type eq '"') {
172 $value =~ s/\$/\\\$/g;
173 $value =~ s/\@/\\\@/g;
174 eval "\$value = \"$value\"";
176 #$value = sprintf($value) if $quote_type eq '"';
177 # So we can say "if $Config{'foo'}".
178 $value = undef if $value eq 'undef';
179 $_[0]->{$_[1]} = $value; # cache it
187 # my($key) = $config_sh =~ m/^(.*?)=/;
188 substr($config_sh, 0, index($config_sh, '=') );
193 # Find out how the current key's quoted so we can skip to its end.
194 my $quote = substr($config_sh, index($config_sh, "=", $prevpos)+1, 1);
195 my $pos = index($config_sh, qq($quote\n), $prevpos) + 2;
196 my $len = index($config_sh, "=", $pos) - $pos;
198 $len > 0 ? substr($config_sh, $pos, $len) : undef;
202 # exists($_[0]->{$_[1]}) or $config_sh =~ m/^$_[1]=/m;
203 exists($_[0]->{$_[1]}) or
204 index($config_sh, "\n$_[1]='") != -1 or
205 substr($config_sh, 0, length($_[1])+2) eq "$_[1]='" or
206 index($config_sh, "\n$_[1]=\"") != -1 or
207 substr($config_sh, 0, length($_[1])+2) eq "$_[1]=\"";
210 sub STORE { die "\%Config::Config is read-only\n" }
211 sub DELETE { &STORE }
221 my @matches = ($config_sh =~ /^$re=.*\n/mg);
222 @matches ? (print @matches) : print "$re: not found\n";
227 config_re($_), next if /\W/;
228 my $v=(exists $Config{$_}) ? $Config{$_} : 'UNKNOWN';
229 $v='undef' unless defined $v;
237 print CONFIG <<'ENDOFSET';
240 my ($value, $v) = $config_sh =~ m/^used_aout='(.*)'\s*$/m;
241 for (split ' ', $value) {
242 ($v) = $config_sh =~ m/^aout_$_='(.*)'\s*$/m;
243 $preconfig{$_} = $v eq 'undef' ? undef : $v;
246 sub TIEHASH { bless {%preconfig} }
249 print CONFIG <<'ENDOFSET';
250 sub TIEHASH { bless {} }
254 print CONFIG <<'ENDOFTAIL';
256 # avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
259 tie %Config, 'Config';
266 Config - access Perl configuration information
271 if ($Config{'cc'} =~ /gcc/) {
272 print "built by gcc\n";
275 use Config qw(myconfig config_sh config_vars);
281 config_vars(qw(osname archname));
286 The Config module contains all the information that was available to
287 the C<Configure> program at Perl build time (over 900 values).
289 Shell variables from the F<config.sh> file (written by Configure) are
290 stored in the readonly-variable C<%Config>, indexed by their names.
292 Values stored in config.sh as 'undef' are returned as undefined
293 values. The perl C<exists> function can be used to check if a
294 named variable exists.
300 Returns a textual summary of the major perl configuration values.
301 See also C<-V> in L<perlrun/Switches>.
305 Returns the entire perl configuration information in the form of the
306 original config.sh shell variable assignment script.
308 =item config_vars(@names)
310 Prints to STDOUT the values of the named configuration variable. Each is
311 printed on a separate line in the form:
315 Names which are unknown are output as C<name='UNKNOWN';>.
316 See also C<-V:name> in L<perlrun/Switches>.
322 Here's a more sophisticated example of using %Config:
329 unless($Config{sig_name} && $Config{sig_num}) {
332 my @names = split ' ', $Config{sig_name};
333 @sig_num{@names} = split ' ', $Config{sig_num};
335 $sig_name[$sig_num{$_}] ||= $_;
339 print "signal #17 = $sig_name[17]\n";
340 if ($sig_num{ALRM}) {
341 print "SIGALRM is $sig_num{ALRM}\n";
346 Because this information is not stored within the perl executable
347 itself it is possible (but unlikely) that the information does not
348 relate to the actual perl binary which is being used to access it.
350 The Config module is installed into the architecture and version
351 specific library directory ($Config{installarchlib}) and it checks the
352 perl version number when loaded.
354 The values stored in config.sh may be either single-quoted or
355 double-quoted. Double-quoted strings are handy for those cases where you
356 need to include escape sequences in the strings. To avoid runtime variable
357 interpolation, any C<$> and C<@> characters are replaced by C<\$> and
358 C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
359 or C<\@> in double-quoted strings unless you're willing to deal with the
360 consequences. (The slashes will end up escaped and the C<$> or C<@> will
361 trigger variable interpolation)
365 Most C<Config> variables are determined by the C<Configure> script
366 on platforms supported by it (which is most UNIX platforms). Some
367 platforms have custom-made C<Config> variables, and may thus not have
368 some of the variables described below, or may have extraneous variables
369 specific to that particular port. See the port specific documentation
374 open(GLOS, "<$glossary") or die "Can't open $glossary: $!";
380 s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m;
381 my $c = substr $1, 0, 1;
382 unless ($seen{$c}++) {
383 print CONFIG <<EOF if $text;
395 s/n't/n\00t/g; # leave can't, won't etc untouched
396 s/^\t\s+(.*)/\n\t$1\n/gm; # Indented lines ===> paragraphs
397 s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text
398 s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
399 s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
400 s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
402 (?<! [\w./<\'\"] ) # Only standalone file names
403 (?! e \. g \. ) # Not e.g.
404 (?! \. \. \. ) # Not ...
406 ( [\w./]* [./] [\w./]* ) # Require . or / inside
407 (?<! \. (?= \s ) ) # Do not include trailing dot
408 (?! [\w/] ) # Include all of it
410 (F<$1>)xg; # /usr/local
411 s/((?<=\s)~\w*)/F<$1>/g; # ~name
412 s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD
413 s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
414 s/n[\0]t/n't/g; # undo can't, won't damage
417 <GLOS>; # Skip the preamble
423 print CONFIG <<'ENDOFTAIL';
429 This module contains a good example of how to use tie to implement a
430 cache and an example of how to make a tied variable readonly to those
440 # Now do some simple tests on the Config.pm file we have created
445 die "$0: $config_pm not valid"
446 unless $Config{'CONFIGDOTSH'} eq 'true';
448 die "$0: error processing $config_pm"
449 if defined($Config{'an impossible name'})
450 or $Config{'CONFIGDOTSH'} ne 'true' # test cache
453 die "$0: error processing $config_pm"
454 if eval '$Config{"cc"} = 1'
455 or eval 'delete $Config{"cc"}'