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 # Calculation for the keys for byteorder
214 # This is somewhat grim, but I need to run fetch_string here.
215 our $Config_SH = join "\n", @v_fast, @v_others;
217 my $t = fetch_string ({}, 'ivtype');
218 my $s = fetch_string ({}, 'ivsize');
220 # byteorder does exist on its own but we overlay a virtual
221 # dynamically recomputed value.
223 # However, ivtype and ivsize will not vary for sane fat binaries
225 my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
228 if ($s == 4 || $s == 8) {
229 my $list = join ',', reverse(2..$s);
231 $byteorder_code = <<"EOT";
233 foreach my \$c ($list) { \$i |= ord(\$c); \$i <<= 8 }
235 my \$byteorder = join('', unpack('$format', pack('$f', \$i)));
238 $byteorder_code = "my \$byteorder = '?'x$s;\n";
241 print CONFIG @non_v, "\n";
243 # copy config summary format from the myconfig.SH script
244 print CONFIG "our \$summary : unique = <<'!END!';\n";
245 open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
246 1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
247 do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
250 # NB. as $summary is unique, we need to copy it in a lexical variable
251 # before expanding it, because may have been made readonly if a perl
252 # interpreter has been cloned.
254 print CONFIG "\n!END!\n", $byteorder_code, <<'EOT';
255 my $summary_expanded;
258 return $summary_expanded if $summary_expanded;
259 ($summary_expanded = $summary) =~ s{\$(\w+)}
260 { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge;
268 print CONFIG join("", @v_fast, sort @v_others);
270 print CONFIG <<'EOT';
272 s/(byteorder=)(['"]).*?\2/$1$2$byteorder$2/m;
273 our $Config_SH : unique = $_;
276 print CONFIG $fetch_string;
278 print CONFIG <<'ENDOFEND';
281 my($self, $key) = @_;
285 if ($key =~ /^((?:cc|ld)flags|libs(?:wanted)?)_nolargefiles/) {
286 # These are purely virtual, they do not exist, but need to
287 # be computed on demand for largefile-incapable extensions.
288 my $new_key = "${1}_uselargefiles";
289 $value = $Config{$1};
290 my $withlargefiles = $Config{$new_key};
291 if ($new_key =~ /^(?:cc|ld)flags_/) {
292 $value =~ s/\Q$withlargefiles\E\b//;
293 } elsif ($new_key =~ /^libs/) {
294 my @lflibswanted = split(' ', $Config{libswanted_uselargefiles});
297 @lflibswanted{@lflibswanted} = ();
298 if ($new_key =~ /^libs_/) {
299 my @libs = grep { /^-l(.+)/ &&
300 not exists $lflibswanted{$1} }
301 split(' ', $Config{libs});
302 $Config{libs} = join(' ', @libs);
303 } elsif ($new_key =~ /^libswanted_/) {
304 my @libswanted = grep { not exists $lflibswanted{$_} }
305 split(' ', $Config{libswanted});
306 $Config{libswanted} = join(' ', @libswanted);
312 $self->{$key} = $value;
316 my($self, $key) = @_;
318 # check for cached value (which may be undef so we use exists not defined)
319 return $self->{$key} if exists $self->{$key};
321 $self->fetch_string($key);
322 return $self->{$key} if exists $self->{$key};
323 $self->fetch_virtual($key);
325 # Might not exist, in which undef is correct.
326 return $self->{$key};
333 substr($Config_SH, 0, index($Config_SH, '=') );
337 # Find out how the current key's quoted so we can skip to its end.
338 my $quote = substr($Config_SH, index($Config_SH, "=", $prevpos)+1, 1);
339 my $pos = index($Config_SH, qq($quote\n), $prevpos) + 2;
340 my $len = index($Config_SH, "=", $pos) - $pos;
342 $len > 0 ? substr($Config_SH, $pos, $len) : undef;
346 return 1 if exists($_[0]->{$_[1]});
348 return(index($Config_SH, "\n$_[1]='") != -1 or
349 substr($Config_SH, 0, length($_[1])+2) eq "$_[1]='" or
350 index($Config_SH, "\n$_[1]=\"") != -1 or
351 substr($Config_SH, 0, length($_[1])+2) eq "$_[1]=\"" or
352 $_[1] =~ /^(?:(?:cc|ld)flags|libs(?:wanted)?)_nolargefiles$/
356 sub STORE { die "\%Config::Config is read-only\n" }
367 return map { chomp; $_ } grep eval{ /^(?:$re)=/ }, split /^/, $Config_SH;
371 # implements -V:cfgvar option (see perlrun -V:)
373 # find optional leading, trailing colons; and query-spec
374 my ($notag,$qry,$lncont) = m/^(:)?(.*?)(:)?$/; # flags fore and aft,
375 # map colon-flags to print decorations
376 my $prfx = $notag ? '': "$qry="; # tag-prefix for print
377 my $lnend = $lncont ? ' ' : ";\n"; # line ending for print
379 # all config-vars are by definition \w only, any \W means regex
381 my @matches = config_re($qry);
382 print map "$_$lnend", @matches ? @matches : "$qry: not found" if !$notag;
383 print map { s/\w+=//; "$_$lnend" } @matches ? @matches : "$qry: not found" if $notag;
385 my $v = (exists $Config{$qry}) ? $Config{$qry} : 'UNKNOWN';
386 $v = 'undef' unless defined $v;
387 print "${prfx}'${v}'$lnend";
395 print CONFIG <<'ENDOFSET';
398 my ($value, $v) = $Config_SH =~ m/^used_aout='(.*)'\s*$/m;
399 for (split ' ', $value) {
400 ($v) = $Config_SH =~ m/^aout_$_='(.*)'\s*$/m;
401 $preconfig{$_} = $v eq 'undef' ? undef : $v;
404 $preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't
405 sub TIEHASH { bless {%preconfig} }
407 # Extract the name of the DLL from the makefile to avoid duplication
408 my ($f) = grep -r, qw(GNUMakefile Makefile);
410 if (open my $fh, '<', $f) {
412 $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
415 print CONFIG <<ENDOFSET if $dll;
416 \$preconfig{dll_name} = '$dll';
419 print CONFIG <<'ENDOFSET';
426 my $fast_config = join '', map { " $_,\n" }
427 sort values (%v_fast), 'byteorder => $byteorder' ;
429 print CONFIG sprintf <<'ENDOFTIE', $fast_config;
431 # avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
434 tie %%Config, 'Config', {
442 open(CONFIG_POD, ">lib/Config.pod") or die "Can't open lib/Config.pod: $!";
443 print CONFIG_POD <<'ENDOFTAIL';
446 Config - access Perl configuration information
451 if ($Config{usethreads}) {
452 print "has thread support\n"
455 use Config qw(myconfig config_sh config_vars config_re);
463 config_vars(qw(osname archname));
468 The Config module contains all the information that was available to
469 the C<Configure> program at Perl build time (over 900 values).
471 Shell variables from the F<config.sh> file (written by Configure) are
472 stored in the readonly-variable C<%Config>, indexed by their names.
474 Values stored in config.sh as 'undef' are returned as undefined
475 values. The perl C<exists> function can be used to check if a
476 named variable exists.
482 Returns a textual summary of the major perl configuration values.
483 See also C<-V> in L<perlrun/Switches>.
487 Returns the entire perl configuration information in the form of the
488 original config.sh shell variable assignment script.
490 =item config_re($regex)
492 Like config_sh() but returns, as a list, only the config entries who's
493 names match the $regex.
495 =item config_vars(@names)
497 Prints to STDOUT the values of the named configuration variable. Each is
498 printed on a separate line in the form:
502 Names which are unknown are output as C<name='UNKNOWN';>.
503 See also C<-V:name> in L<perlrun/Switches>.
509 Here's a more sophisticated example of using %Config:
516 unless($Config{sig_name} && $Config{sig_num}) {
519 my @names = split ' ', $Config{sig_name};
520 @sig_num{@names} = split ' ', $Config{sig_num};
522 $sig_name[$sig_num{$_}] ||= $_;
526 print "signal #17 = $sig_name[17]\n";
527 if ($sig_num{ALRM}) {
528 print "SIGALRM is $sig_num{ALRM}\n";
533 Because this information is not stored within the perl executable
534 itself it is possible (but unlikely) that the information does not
535 relate to the actual perl binary which is being used to access it.
537 The Config module is installed into the architecture and version
538 specific library directory ($Config{installarchlib}) and it checks the
539 perl version number when loaded.
541 The values stored in config.sh may be either single-quoted or
542 double-quoted. Double-quoted strings are handy for those cases where you
543 need to include escape sequences in the strings. To avoid runtime variable
544 interpolation, any C<$> and C<@> characters are replaced by C<\$> and
545 C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
546 or C<\@> in double-quoted strings unless you're willing to deal with the
547 consequences. (The slashes will end up escaped and the C<$> or C<@> will
548 trigger variable interpolation)
552 Most C<Config> variables are determined by the C<Configure> script
553 on platforms supported by it (which is most UNIX platforms). Some
554 platforms have custom-made C<Config> variables, and may thus not have
555 some of the variables described below, or may have extraneous variables
556 specific to that particular port. See the port specific documentation
561 if ($Opts{glossary}) {
562 open(GLOS, "<$Glossary") or die "Can't open $Glossary: $!";
569 if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
570 my $c = substr $1, 0, 1;
571 unless ($seen{$c}++) {
572 print CONFIG_POD <<EOF if $text;
576 print CONFIG_POD <<EOF;
585 elsif (!$text || !/\A\t/) {
586 warn "Expected a Configure variable header",
587 ($text ? " or another paragraph of description" : () );
589 s/n't/n\00t/g; # leave can't, won't etc untouched
590 s/^\t\s+(.*)/\n$1/gm; # Indented lines ===> new paragraph
591 s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text
592 s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
593 s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
594 s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
596 (?<! [\w./<\'\"] ) # Only standalone file names
597 (?! e \. g \. ) # Not e.g.
598 (?! \. \. \. ) # Not ...
600 (?! read/ ) # Not read/write
601 (?! etc\. ) # Not etc.
604 \$ ? # Allow leading $
605 [\w./]* [./] [\w./]* # Require . or / inside
607 (?<! \. (?= [\s)] ) ) # Do not include trailing dot
608 (?! [\w/] ) # Include all of it
610 (F<$1>)xg; # /usr/local
611 s/((?<=\s)~\w*)/F<$1>/g; # ~name
612 s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD
613 s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
614 s/n[\0]t/n't/g; # undo can't, won't damage
617 if ($Opts{glossary}) {
618 <GLOS>; # Skip the "DO NOT EDIT"
619 <GLOS>; # Skip the preamble
626 print CONFIG_POD <<'ENDOFTAIL';
632 This module contains a good example of how to use tie to implement a
633 cache and an example of how to make a tied variable readonly to those
644 # Now create Cross.pm if needed
646 open CROSS, ">lib/Cross.pm" or die "Can not open >lib/Cross.pm: $!";
648 # typical invocation:
649 # perl -MCross Makefile.PL
650 # perl -MCross=wince -V:cc
654 my ($package,$platform) = @_;
655 unless (defined $platform) {
656 # if $platform is not specified, then use last one when
657 # 'configpm; was invoked with --cross option
658 $platform = '***replace-marker***';
660 @INC = map {/\blib\b/?(do{local $_=$_;s/\blib\b/xlib\/$platform/;$_},$_):($_)} @INC;
661 $::Cross::platform = $platform;
666 $cross =~ s/\*\*\*replace-marker\*\*\*/$Opts{cross}/g;
671 # Now do some simple tests on the Config.pm file we have created
676 die "$0: $Config_PM not valid"
677 unless $Config{'PERL_CONFIG_SH'} eq 'true';
679 die "$0: error processing $Config_PM"
680 if defined($Config{'an impossible name'})
681 or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache
684 die "$0: error processing $Config_PM"
685 if eval '$Config{"cc"} = 1'
686 or eval 'delete $Config{"cc"}'