3 # commonly used names to put first (and hence lookup fastest)
4 my %Common = map {($_,$_)}
5 qw(archname osname osvers prefix libs libpth
6 dynamic_ext static_ext dlsrc so
8 privlibexp archlibexp installprivlib installarchlib
9 sharpbang startsh shsharp
12 # names of things which may need to have slashes changed to double-colons
13 my %Extensions = map {($_,$_)}
14 qw(dynamic_ext static_ext extensions known_extensions);
16 # allowed opts as well as specifies default and initial values
18 'cross' => '', # --cross=PALTFORM - crosscompiling for PLATFORM
19 'glossary' => 1, # --no-glossary - no glossary file inclusion,
24 # user specified options
27 (map {/^--([\-_\w]+)=(.*)$/} @ARGV),
28 # --opt --no-opt --noopt
29 (map {/^no-?(.*)$/i?($1=>0):($_=>1)} map {/^--([\-_\w]+)$/} @ARGV),
32 my %opts = (%Allowed_Opts, %given_opts);
34 for my $opt (grep {!exists $Allowed_Opts{$_}} keys %given_opts) {
35 die "option '$opt' is not recognized";
37 @ARGV = grep {!/^--/} @ARGV;
46 my $Glossary = $ARGV[1] || 'Porting/Glossary';
49 # creating cross-platform config file
51 mkdir "xlib/$Opts{cross}";
52 $Config_PM = $ARGV[0] || "xlib/$Opts{cross}/Config.pm";
55 $Config_PM = $ARGV[0] || 'lib/Config.pm';
59 open CONFIG, ">$Config_PM" or die "Can't open $Config_PM: $!\n";
61 my $myver = sprintf "v%vd", $^V;
63 printf CONFIG <<'ENDOFBEG', ($myver) x 3;
64 # This file was created by configpm when Perl was built. Any changes
65 # made to this file will be lost the next time perl is built.
68 @EXPORT = qw(%%Config);
69 @EXPORT_OK = qw(myconfig config_sh config_vars config_re);
71 my %%Export_Cache = map {($_ => 1)} (@EXPORT, @EXPORT_OK);
73 # Define our own import method to avoid pulling in the full Exporter:
76 @_ = @EXPORT unless @_;
78 my @funcs = grep $_ ne '%%Config', @_;
79 my $export_Config = @funcs < @_ ? 1 : 0;
81 my $callpkg = caller(0);
82 foreach my $func (@funcs) {
83 die sprintf qq{"%%s" is not exported by the %%s module\n},
84 $func, __PACKAGE__ unless $Export_Cache{$func};
85 *{$callpkg.'::'.$func} = \&{$func};
88 *{"$callpkg\::Config"} = \%%Config if $export_Config;
92 die "Perl lib version (%s) doesn't match executable version ($])"
96 or die "Perl lib version (%s) doesn't match executable version (" .
97 sprintf("v%%vd",$^V) . ")";
109 # This is somewhat grim, but I want the code for parsing config.sh here and
110 # now so that I can expand $Config{ivsize} and $Config{ivtype}
112 my $fetch_string = <<'EOT';
114 # Search for it in the big string
116 my($self, $key) = @_;
118 my $quote_type = "'";
119 my $marker = "$key=";
121 # Check for the common case, ' delimited
122 my $start = index($Config_SH, "\n$marker$quote_type");
123 # If that failed, check for " delimited
126 $start = index($Config_SH, "\n$marker$quote_type");
128 return undef if ( ($start == -1) && # in case it's first
129 (substr($Config_SH, 0, length($marker)) ne $marker) );
131 # It's the very first thing we found. Skip $start forward
132 # and figure out the quote mark after the =.
133 $start = length($marker) + 1;
134 $quote_type = substr($Config_SH, $start - 1, 1);
137 $start += length($marker) + 2;
140 my $value = substr($Config_SH, $start,
141 index($Config_SH, "$quote_type\n", $start) - $start);
143 # If we had a double-quote, we'd better eval it so escape
144 # sequences and such can be interpolated. Since the incoming
145 # value is supposed to follow shell rules and not perl rules,
146 # we escape any perl variable markers
147 if ($quote_type eq '"') {
148 $value =~ s/\$/\\\$/g;
149 $value =~ s/\@/\\\@/g;
150 eval "\$value = \"$value\"";
153 # So we can say "if $Config{'foo'}".
154 $value = undef if $value eq 'undef';
155 $self->{$key} = $value; # cache it
162 open(CONFIG_SH, 'config.sh') || die "Can't open config.sh: $!";
163 while (<CONFIG_SH>) {
164 next if m:^#!/bin/sh:;
166 # Catch PERL_CONFIG_SH=true and PERL_VERSION=n line from Configure.
167 s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/ or m/^(\w+)='(.*)'$/;
168 my($k, $v) = ($1, $2);
170 # grandfather PATCHLEVEL and SUBVERSION and CONFIG
172 if ($k eq 'PERL_VERSION') {
173 push @v_others, "PATCHLEVEL='$v'\n";
175 elsif ($k eq 'PERL_SUBVERSION') {
176 push @v_others, "SUBVERSION='$v'\n";
178 elsif ($k eq 'PERL_CONFIG_SH') {
179 push @v_others, "CONFIG='$v'\n";
183 # We can delimit things in config.sh with either ' or ".
184 unless ($in_v or m/^(\w+)=(['"])(.*\n)/){
185 push(@non_v, "#$_"); # not a name='value' line
193 ($name,$val) = ($1,$3);
195 $in_v = $val !~ /$quote\n/;
198 s,/,::,g if $Extensions{$name};
200 $val =~ s/$quote\n?\z//;
202 my $line = "$name=$quote$val$quote\n";
203 if (!$Common{$name}){
204 push(@v_others, $line);
207 push(@v_fast, $line);
208 $v_fast{$name} = "'$name' => $quote$val$quote";
213 print CONFIG @non_v, "\n";
215 # copy config summary format from the myconfig.SH script
216 print CONFIG "my \$summary = <<'!END!';\n";
217 open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
218 1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
219 do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
222 print CONFIG "\n!END!\n", <<'EOT';
223 my $summary_expanded = 0;
226 return $summary if $summary_expanded;
227 $summary =~ s{\$(\w+)}
228 { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge;
229 $summary_expanded = 1;
233 our $Config_SH : unique = <<'!END!';
236 print CONFIG join("", @v_fast, sort @v_others);
238 print CONFIG "!END!\n", $fetch_string;
240 print CONFIG <<'ENDOFEND';
243 my($self, $key) = @_;
247 if ($key =~ /^((?:cc|ld)flags|libs(?:wanted)?)_nolargefiles/) {
248 # These are purely virtual, they do not exist, but need to
249 # be computed on demand for largefile-incapable extensions.
250 my $new_key = "${1}_uselargefiles";
251 $value = $Config{$1};
252 my $withlargefiles = $Config{$new_key};
253 if ($new_key =~ /^(?:cc|ld)flags_/) {
254 $value =~ s/\Q$withlargefiles\E\b//;
255 } elsif ($new_key =~ /^libs/) {
256 my @lflibswanted = split(' ', $Config{libswanted_uselargefiles});
259 @lflibswanted{@lflibswanted} = ();
260 if ($new_key =~ /^libs_/) {
261 my @libs = grep { /^-l(.+)/ &&
262 not exists $lflibswanted{$1} }
263 split(' ', $Config{libs});
264 $Config{libs} = join(' ', @libs);
265 } elsif ($new_key =~ /^libswanted_/) {
266 my @libswanted = grep { not exists $lflibswanted{$_} }
267 split(' ', $Config{libswanted});
268 $Config{libswanted} = join(' ', @libswanted);
274 $self->{$key} = $value;
278 my($self, $key) = @_;
280 # check for cached value (which may be undef so we use exists not defined)
281 return $self->{$key} if exists $self->{$key};
283 $self->fetch_string($key);
284 return $self->{$key} if exists $self->{$key};
285 $self->fetch_virtual($key);
287 # Might not exist, in which undef is correct.
288 return $self->{$key};
295 substr($Config_SH, 0, index($Config_SH, '=') );
299 # Find out how the current key's quoted so we can skip to its end.
300 my $quote = substr($Config_SH, index($Config_SH, "=", $prevpos)+1, 1);
301 my $pos = index($Config_SH, qq($quote\n), $prevpos) + 2;
302 my $len = index($Config_SH, "=", $pos) - $pos;
304 $len > 0 ? substr($Config_SH, $pos, $len) : undef;
308 return 1 if exists($_[0]->{$_[1]});
310 return(index($Config_SH, "\n$_[1]='") != -1 or
311 substr($Config_SH, 0, length($_[1])+2) eq "$_[1]='" or
312 index($Config_SH, "\n$_[1]=\"") != -1 or
313 substr($Config_SH, 0, length($_[1])+2) eq "$_[1]=\"" or
314 $_[1] =~ /^(?:(?:cc|ld)flags|libs(?:wanted)?)_nolargefiles$/
318 sub STORE { die "\%Config::Config is read-only\n" }
329 return map { chomp; $_ } grep /^$re=/, split /^/, $Config_SH;
335 my @matches = config_re($_);
336 print map "$_\n", @matches ? @matches : "$_: not found";
338 my $v = (exists $Config{$_}) ? $Config{$_} : 'UNKNOWN';
339 $v = 'undef' unless defined $v;
348 print CONFIG <<'ENDOFSET';
351 my ($value, $v) = $Config_SH =~ m/^used_aout='(.*)'\s*$/m;
352 for (split ' ', $value) {
353 ($v) = $Config_SH =~ m/^aout_$_='(.*)'\s*$/m;
354 $preconfig{$_} = $v eq 'undef' ? undef : $v;
357 $preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't
358 sub TIEHASH { bless {%preconfig} }
360 # Extract the name of the DLL from the makefile to avoid duplication
361 my ($f) = grep -r, qw(GNUMakefile Makefile);
363 if (open my $fh, '<', $f) {
365 $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
368 print CONFIG <<ENDOFSET if $dll;
369 \$preconfig{dll_name} = '$dll';
372 print CONFIG <<'ENDOFSET';
380 # Calculation for the keys for byteorder
381 # This is somewhat grim, but I need to run fetch_string here.
382 our $Config_SH = join "\n", @v_fast, @v_others;
384 my $t = fetch_string ({}, 'ivtype');
385 my $s = fetch_string ({}, 'ivsize');
387 # byteorder does exist on its own but we overlay a virtual
388 # dynamically recomputed value.
390 # However, ivtype and ivsize will not vary for sane fat binaries
392 my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
395 if ($s == 4 || $s == 8) {
396 my $list = join ',', reverse(2..$s);
398 $byteorder_code = <<"EOT";
400 foreach my \$c ($list) { \$i |= ord(\$c); \$i <<= 8 }
402 my \$value = join('', unpack('$format', pack('$f', \$i)));
405 $byteorder_code = "\$value = '?'x$s;\n";
408 my $fast_config = join '', map { " $_,\n" }
409 values (%v_fast), 'byteorder => $value' ;
411 print CONFIG sprintf <<'ENDOFTIE', $byteorder_code, $fast_config;
413 # avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
418 tie %%Config, 'Config', {
426 open(CONFIG_POD, ">lib/Config.pod") or die "Can't open lib/Config.pod: $!";
427 print CONFIG_POD <<'ENDOFTAIL';
430 Config - access Perl configuration information
435 if ($Config{'cc'} =~ /gcc/) {
436 print "built by gcc\n";
439 use Config qw(myconfig config_sh config_vars config_re);
447 config_vars(qw(osname archname));
452 The Config module contains all the information that was available to
453 the C<Configure> program at Perl build time (over 900 values).
455 Shell variables from the F<config.sh> file (written by Configure) are
456 stored in the readonly-variable C<%Config>, indexed by their names.
458 Values stored in config.sh as 'undef' are returned as undefined
459 values. The perl C<exists> function can be used to check if a
460 named variable exists.
466 Returns a textual summary of the major perl configuration values.
467 See also C<-V> in L<perlrun/Switches>.
471 Returns the entire perl configuration information in the form of the
472 original config.sh shell variable assignment script.
474 =item config_re($regex)
476 Like config_sh() but returns, as a list, only the config entries who's
477 names match the $regex.
479 =item config_vars(@names)
481 Prints to STDOUT the values of the named configuration variable. Each is
482 printed on a separate line in the form:
486 Names which are unknown are output as C<name='UNKNOWN';>.
487 See also C<-V:name> in L<perlrun/Switches>.
493 Here's a more sophisticated example of using %Config:
500 unless($Config{sig_name} && $Config{sig_num}) {
503 my @names = split ' ', $Config{sig_name};
504 @sig_num{@names} = split ' ', $Config{sig_num};
506 $sig_name[$sig_num{$_}] ||= $_;
510 print "signal #17 = $sig_name[17]\n";
511 if ($sig_num{ALRM}) {
512 print "SIGALRM is $sig_num{ALRM}\n";
517 Because this information is not stored within the perl executable
518 itself it is possible (but unlikely) that the information does not
519 relate to the actual perl binary which is being used to access it.
521 The Config module is installed into the architecture and version
522 specific library directory ($Config{installarchlib}) and it checks the
523 perl version number when loaded.
525 The values stored in config.sh may be either single-quoted or
526 double-quoted. Double-quoted strings are handy for those cases where you
527 need to include escape sequences in the strings. To avoid runtime variable
528 interpolation, any C<$> and C<@> characters are replaced by C<\$> and
529 C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
530 or C<\@> in double-quoted strings unless you're willing to deal with the
531 consequences. (The slashes will end up escaped and the C<$> or C<@> will
532 trigger variable interpolation)
536 Most C<Config> variables are determined by the C<Configure> script
537 on platforms supported by it (which is most UNIX platforms). Some
538 platforms have custom-made C<Config> variables, and may thus not have
539 some of the variables described below, or may have extraneous variables
540 specific to that particular port. See the port specific documentation
545 if ($Opts{glossary}) {
546 open(GLOS, "<$Glossary") or die "Can't open $Glossary: $!";
553 if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
554 my $c = substr $1, 0, 1;
555 unless ($seen{$c}++) {
556 print CONFIG_POD <<EOF if $text;
560 print CONFIG_POD <<EOF;
569 elsif (!$text || !/\A\t/) {
570 warn "Expected a Configure variable header",
571 ($text ? " or another paragraph of description" : () );
573 s/n't/n\00t/g; # leave can't, won't etc untouched
574 s/^\t\s+(.*)/\n$1/gm; # Indented lines ===> new paragraph
575 s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text
576 s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
577 s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
578 s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
580 (?<! [\w./<\'\"] ) # Only standalone file names
581 (?! e \. g \. ) # Not e.g.
582 (?! \. \. \. ) # Not ...
584 (?! read/ ) # Not read/write
585 (?! etc\. ) # Not etc.
588 \$ ? # Allow leading $
589 [\w./]* [./] [\w./]* # Require . or / inside
591 (?<! \. (?= [\s)] ) ) # Do not include trailing dot
592 (?! [\w/] ) # Include all of it
594 (F<$1>)xg; # /usr/local
595 s/((?<=\s)~\w*)/F<$1>/g; # ~name
596 s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD
597 s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
598 s/n[\0]t/n't/g; # undo can't, won't damage
601 if ($Opts{glossary}) {
602 <GLOS>; # Skip the "DO NOT EDIT"
603 <GLOS>; # Skip the preamble
610 print CONFIG_POD <<'ENDOFTAIL';
616 This module contains a good example of how to use tie to implement a
617 cache and an example of how to make a tied variable readonly to those
628 # Now create Cross.pm if needed
630 open CROSS, ">lib/Cross.pm" or die "Can not open >lib/Cross.pm: $!";
632 # typical invocation:
633 # perl -MCross Makefile.PL
634 # perl -MCross=wince -V:cc
638 my ($package,$platform) = @_;
639 unless (defined $platform) {
640 # if $platform is not specified, then use last one when
641 # 'configpm; was invoked with --cross option
642 $platform = '***replace-marker***';
644 @INC = map {/\blib\b/?(do{local $_=$_;s/\blib\b/xlib\/$platform/;$_},$_):($_)} @INC;
645 $::Cross::platform = $platform;
650 $cross =~ s/\*\*\*replace-marker\*\*\*/$Opts{cross}/g;
655 # Now do some simple tests on the Config.pm file we have created
660 die "$0: $Config_PM not valid"
661 unless $Config{'PERL_CONFIG_SH'} eq 'true';
663 die "$0: error processing $Config_PM"
664 if defined($Config{'an impossible name'})
665 or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache
668 die "$0: error processing $Config_PM"
669 if eval '$Config{"cc"} = 1'
670 or eval 'delete $Config{"cc"}'