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 "our \$summary : unique = <<'!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 # NB. as $summary is unique, we need to copy it in a lexical variable
223 # before expanding it, because may have been made readonly if a perl
224 # interpreter has been cloned.
226 print CONFIG "\n!END!\n", <<'EOT';
227 my $summary_expanded;
230 return $summary_expanded if $summary_expanded;
231 ($summary_expanded = $summary) =~ s{\$(\w+)}
232 { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge;
236 our $Config_SH : unique = <<'!END!';
239 print CONFIG join("", @v_fast, sort @v_others);
241 print CONFIG "!END!\n", $fetch_string;
243 print CONFIG <<'ENDOFEND';
246 my($self, $key) = @_;
250 if ($key =~ /^((?:cc|ld)flags|libs(?:wanted)?)_nolargefiles/) {
251 # These are purely virtual, they do not exist, but need to
252 # be computed on demand for largefile-incapable extensions.
253 my $new_key = "${1}_uselargefiles";
254 $value = $Config{$1};
255 my $withlargefiles = $Config{$new_key};
256 if ($new_key =~ /^(?:cc|ld)flags_/) {
257 $value =~ s/\Q$withlargefiles\E\b//;
258 } elsif ($new_key =~ /^libs/) {
259 my @lflibswanted = split(' ', $Config{libswanted_uselargefiles});
262 @lflibswanted{@lflibswanted} = ();
263 if ($new_key =~ /^libs_/) {
264 my @libs = grep { /^-l(.+)/ &&
265 not exists $lflibswanted{$1} }
266 split(' ', $Config{libs});
267 $Config{libs} = join(' ', @libs);
268 } elsif ($new_key =~ /^libswanted_/) {
269 my @libswanted = grep { not exists $lflibswanted{$_} }
270 split(' ', $Config{libswanted});
271 $Config{libswanted} = join(' ', @libswanted);
277 $self->{$key} = $value;
281 my($self, $key) = @_;
283 # check for cached value (which may be undef so we use exists not defined)
284 return $self->{$key} if exists $self->{$key};
286 $self->fetch_string($key);
287 return $self->{$key} if exists $self->{$key};
288 $self->fetch_virtual($key);
290 # Might not exist, in which undef is correct.
291 return $self->{$key};
298 substr($Config_SH, 0, index($Config_SH, '=') );
302 # Find out how the current key's quoted so we can skip to its end.
303 my $quote = substr($Config_SH, index($Config_SH, "=", $prevpos)+1, 1);
304 my $pos = index($Config_SH, qq($quote\n), $prevpos) + 2;
305 my $len = index($Config_SH, "=", $pos) - $pos;
307 $len > 0 ? substr($Config_SH, $pos, $len) : undef;
311 return 1 if exists($_[0]->{$_[1]});
313 return(index($Config_SH, "\n$_[1]='") != -1 or
314 substr($Config_SH, 0, length($_[1])+2) eq "$_[1]='" or
315 index($Config_SH, "\n$_[1]=\"") != -1 or
316 substr($Config_SH, 0, length($_[1])+2) eq "$_[1]=\"" or
317 $_[1] =~ /^(?:(?:cc|ld)flags|libs(?:wanted)?)_nolargefiles$/
321 sub STORE { die "\%Config::Config is read-only\n" }
332 return map { chomp; $_ } grep /^$re=/, split /^/, $Config_SH;
337 my ($notag,$qry,$lncont) = m/^(:)?(.*?)(:)?$/; # flags fore and aft,
338 my $prfx = $notag ? '': "$qry="; # prefix for print
339 my $lnend = $lncont ? ' ' : ";\n"; # ending for print
342 my @matches = config_re($qry);
343 print map "$_$lnend", @matches ? @matches : "$qry: not found" if !$notag;
344 print map { s/\w+=//; "$_$lnend" } @matches ? @matches : "$qry: not found" if $notag;
346 my $v = (exists $Config{$qry}) ? $Config{$qry} : 'UNKNOWN';
347 $v = 'undef' unless defined $v;
348 print "${prfx}'${v}'$lnend";
356 print CONFIG <<'ENDOFSET';
359 my ($value, $v) = $Config_SH =~ m/^used_aout='(.*)'\s*$/m;
360 for (split ' ', $value) {
361 ($v) = $Config_SH =~ m/^aout_$_='(.*)'\s*$/m;
362 $preconfig{$_} = $v eq 'undef' ? undef : $v;
365 $preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't
366 sub TIEHASH { bless {%preconfig} }
368 # Extract the name of the DLL from the makefile to avoid duplication
369 my ($f) = grep -r, qw(GNUMakefile Makefile);
371 if (open my $fh, '<', $f) {
373 $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
376 print CONFIG <<ENDOFSET if $dll;
377 \$preconfig{dll_name} = '$dll';
380 print CONFIG <<'ENDOFSET';
388 # Calculation for the keys for byteorder
389 # This is somewhat grim, but I need to run fetch_string here.
390 our $Config_SH = join "\n", @v_fast, @v_others;
392 my $t = fetch_string ({}, 'ivtype');
393 my $s = fetch_string ({}, 'ivsize');
395 # byteorder does exist on its own but we overlay a virtual
396 # dynamically recomputed value.
398 # However, ivtype and ivsize will not vary for sane fat binaries
400 my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
403 if ($s == 4 || $s == 8) {
404 my $list = join ',', reverse(2..$s);
406 $byteorder_code = <<"EOT";
408 foreach my \$c ($list) { \$i |= ord(\$c); \$i <<= 8 }
410 my \$value = join('', unpack('$format', pack('$f', \$i)));
413 $byteorder_code = "\$value = '?'x$s;\n";
416 my $fast_config = join '', map { " $_,\n" }
417 sort values (%v_fast), 'byteorder => $value' ;
419 print CONFIG sprintf <<'ENDOFTIE', $byteorder_code, $fast_config;
421 # avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
426 tie %%Config, 'Config', {
434 open(CONFIG_POD, ">lib/Config.pod") or die "Can't open lib/Config.pod: $!";
435 print CONFIG_POD <<'ENDOFTAIL';
438 Config - access Perl configuration information
443 if ($Config{usethreads}) {
444 print "has thread support\n"
447 use Config qw(myconfig config_sh config_vars config_re);
455 config_vars(qw(osname archname));
460 The Config module contains all the information that was available to
461 the C<Configure> program at Perl build time (over 900 values).
463 Shell variables from the F<config.sh> file (written by Configure) are
464 stored in the readonly-variable C<%Config>, indexed by their names.
466 Values stored in config.sh as 'undef' are returned as undefined
467 values. The perl C<exists> function can be used to check if a
468 named variable exists.
474 Returns a textual summary of the major perl configuration values.
475 See also C<-V> in L<perlrun/Switches>.
479 Returns the entire perl configuration information in the form of the
480 original config.sh shell variable assignment script.
482 =item config_re($regex)
484 Like config_sh() but returns, as a list, only the config entries who's
485 names match the $regex.
487 =item config_vars(@names)
489 Prints to STDOUT the values of the named configuration variable. Each is
490 printed on a separate line in the form:
494 Names which are unknown are output as C<name='UNKNOWN';>.
495 See also C<-V:name> in L<perlrun/Switches>.
501 Here's a more sophisticated example of using %Config:
508 unless($Config{sig_name} && $Config{sig_num}) {
511 my @names = split ' ', $Config{sig_name};
512 @sig_num{@names} = split ' ', $Config{sig_num};
514 $sig_name[$sig_num{$_}] ||= $_;
518 print "signal #17 = $sig_name[17]\n";
519 if ($sig_num{ALRM}) {
520 print "SIGALRM is $sig_num{ALRM}\n";
525 Because this information is not stored within the perl executable
526 itself it is possible (but unlikely) that the information does not
527 relate to the actual perl binary which is being used to access it.
529 The Config module is installed into the architecture and version
530 specific library directory ($Config{installarchlib}) and it checks the
531 perl version number when loaded.
533 The values stored in config.sh may be either single-quoted or
534 double-quoted. Double-quoted strings are handy for those cases where you
535 need to include escape sequences in the strings. To avoid runtime variable
536 interpolation, any C<$> and C<@> characters are replaced by C<\$> and
537 C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
538 or C<\@> in double-quoted strings unless you're willing to deal with the
539 consequences. (The slashes will end up escaped and the C<$> or C<@> will
540 trigger variable interpolation)
544 Most C<Config> variables are determined by the C<Configure> script
545 on platforms supported by it (which is most UNIX platforms). Some
546 platforms have custom-made C<Config> variables, and may thus not have
547 some of the variables described below, or may have extraneous variables
548 specific to that particular port. See the port specific documentation
553 if ($Opts{glossary}) {
554 open(GLOS, "<$Glossary") or die "Can't open $Glossary: $!";
561 if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
562 my $c = substr $1, 0, 1;
563 unless ($seen{$c}++) {
564 print CONFIG_POD <<EOF if $text;
568 print CONFIG_POD <<EOF;
577 elsif (!$text || !/\A\t/) {
578 warn "Expected a Configure variable header",
579 ($text ? " or another paragraph of description" : () );
581 s/n't/n\00t/g; # leave can't, won't etc untouched
582 s/^\t\s+(.*)/\n$1/gm; # Indented lines ===> new paragraph
583 s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text
584 s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
585 s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
586 s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
588 (?<! [\w./<\'\"] ) # Only standalone file names
589 (?! e \. g \. ) # Not e.g.
590 (?! \. \. \. ) # Not ...
592 (?! read/ ) # Not read/write
593 (?! etc\. ) # Not etc.
596 \$ ? # Allow leading $
597 [\w./]* [./] [\w./]* # Require . or / inside
599 (?<! \. (?= [\s)] ) ) # Do not include trailing dot
600 (?! [\w/] ) # Include all of it
602 (F<$1>)xg; # /usr/local
603 s/((?<=\s)~\w*)/F<$1>/g; # ~name
604 s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD
605 s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
606 s/n[\0]t/n't/g; # undo can't, won't damage
609 if ($Opts{glossary}) {
610 <GLOS>; # Skip the "DO NOT EDIT"
611 <GLOS>; # Skip the preamble
618 print CONFIG_POD <<'ENDOFTAIL';
624 This module contains a good example of how to use tie to implement a
625 cache and an example of how to make a tied variable readonly to those
636 # Now create Cross.pm if needed
638 open CROSS, ">lib/Cross.pm" or die "Can not open >lib/Cross.pm: $!";
640 # typical invocation:
641 # perl -MCross Makefile.PL
642 # perl -MCross=wince -V:cc
646 my ($package,$platform) = @_;
647 unless (defined $platform) {
648 # if $platform is not specified, then use last one when
649 # 'configpm; was invoked with --cross option
650 $platform = '***replace-marker***';
652 @INC = map {/\blib\b/?(do{local $_=$_;s/\blib\b/xlib\/$platform/;$_},$_):($_)} @INC;
653 $::Cross::platform = $platform;
658 $cross =~ s/\*\*\*replace-marker\*\*\*/$Opts{cross}/g;
663 # Now do some simple tests on the Config.pm file we have created
668 die "$0: $Config_PM not valid"
669 unless $Config{'PERL_CONFIG_SH'} eq 'true';
671 die "$0: error processing $Config_PM"
672 if defined($Config{'an impossible name'})
673 or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache
676 die "$0: error processing $Config_PM"
677 if eval '$Config{"cc"} = 1'
678 or eval 'delete $Config{"cc"}'