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_expanded, "\n$marker$quote_type");
123 # If that failed, check for " delimited
126 $start = index($Config_SH_expanded, "\n$marker$quote_type");
128 # Start can never be -1 now, as we've rigged the long string we're
129 # searching with an initial dummy newline.
130 return undef if $start == -1;
132 $start += length($marker) + 2;
134 my $value = substr($Config_SH_expanded, $start,
135 index($Config_SH_expanded, "$quote_type\n", $start)
138 # If we had a double-quote, we'd better eval it so escape
139 # sequences and such can be interpolated. Since the incoming
140 # value is supposed to follow shell rules and not perl rules,
141 # we escape any perl variable markers
142 if ($quote_type eq '"') {
143 $value =~ s/\$/\\\$/g;
144 $value =~ s/\@/\\\@/g;
145 eval "\$value = \"$value\"";
148 # So we can say "if $Config{'foo'}".
149 $value = undef if $value eq 'undef';
150 $self->{$key} = $value; # cache it
157 open(CONFIG_SH, 'config.sh') || die "Can't open config.sh: $!";
158 while (<CONFIG_SH>) {
159 next if m:^#!/bin/sh:;
161 # Catch PERL_CONFIG_SH=true and PERL_VERSION=n line from Configure.
162 s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/ or m/^(\w+)='(.*)'$/;
163 my($k, $v) = ($1, $2);
165 # grandfather PATCHLEVEL and SUBVERSION and CONFIG
167 if ($k eq 'PERL_VERSION') {
168 push @v_others, "PATCHLEVEL='$v'\n";
170 elsif ($k eq 'PERL_SUBVERSION') {
171 push @v_others, "SUBVERSION='$v'\n";
173 elsif ($k eq 'PERL_CONFIG_SH') {
174 push @v_others, "CONFIG='$v'\n";
178 # We can delimit things in config.sh with either ' or ".
179 unless ($in_v or m/^(\w+)=(['"])(.*\n)/){
180 push(@non_v, "#$_"); # not a name='value' line
188 ($name,$val) = ($1,$3);
190 $in_v = $val !~ /$quote\n/;
193 s,/,::,g if $Extensions{$name};
195 $val =~ s/$quote\n?\z//;
197 my $line = "$name=$quote$val$quote\n";
198 if (!$Common{$name}){
199 push(@v_others, $line);
202 push(@v_fast, $line);
203 $v_fast{$name} = "'$name' => $quote$val$quote";
208 # Calculation for the keys for byteorder
209 # This is somewhat grim, but I need to run fetch_string here.
210 our $Config_SH_expanded = join "\n", @v_fast, @v_others;
212 my $t = fetch_string ({}, 'ivtype');
213 my $s = fetch_string ({}, 'ivsize');
215 # byteorder does exist on its own but we overlay a virtual
216 # dynamically recomputed value.
218 # However, ivtype and ivsize will not vary for sane fat binaries
220 my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
223 if ($s == 4 || $s == 8) {
224 my $list = join ',', reverse(2..$s);
226 $byteorder_code = <<"EOT";
228 foreach my \$c ($list) { \$i |= ord(\$c); \$i <<= 8 }
230 my \$byteorder = join('', unpack('$format', pack('$f', \$i)));
233 $byteorder_code = "my \$byteorder = '?'x$s;\n";
236 print CONFIG @non_v, "\n";
238 # copy config summary format from the myconfig.SH script
239 print CONFIG "our \$summary : unique = <<'!END!';\n";
240 open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
241 1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
242 do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
245 # NB. as $summary is unique, we need to copy it in a lexical variable
246 # before expanding it, because may have been made readonly if a perl
247 # interpreter has been cloned.
249 print CONFIG "\n!END!\n", $byteorder_code, <<'EOT';
250 my $summary_expanded;
253 return $summary_expanded if $summary_expanded;
254 ($summary_expanded = $summary) =~ s{\$(\w+)}
255 { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge;
263 print CONFIG join("", @v_fast, sort @v_others);
265 print CONFIG <<'EOT';
267 s/(byteorder=)(['"]).*?\2/$1$2$byteorder$2/m;
268 our $Config_SH : unique = $_;
270 our $Config_SH_expanded : unique = "\n$_";
273 print CONFIG $fetch_string;
275 print CONFIG <<'ENDOFEND';
278 my($self, $key) = @_;
282 if ($key =~ /^((?:cc|ld)flags|libs(?:wanted)?)_nolargefiles/) {
283 # These are purely virtual, they do not exist, but need to
284 # be computed on demand for largefile-incapable extensions.
285 my $new_key = "${1}_uselargefiles";
286 $value = $Config{$1};
287 my $withlargefiles = $Config{$new_key};
288 if ($new_key =~ /^(?:cc|ld)flags_/) {
289 $value =~ s/\Q$withlargefiles\E\b//;
290 } elsif ($new_key =~ /^libs/) {
291 my @lflibswanted = split(' ', $Config{libswanted_uselargefiles});
294 @lflibswanted{@lflibswanted} = ();
295 if ($new_key =~ /^libs_/) {
296 my @libs = grep { /^-l(.+)/ &&
297 not exists $lflibswanted{$1} }
298 split(' ', $Config{libs});
299 $value = join(' ', @libs);
300 } elsif ($new_key =~ /^libswanted_/) {
301 my @libswanted = grep { not exists $lflibswanted{$_} }
302 split(' ', $Config{libswanted});
303 $value = join(' ', @libswanted);
309 $self->{$key} = $value;
313 my($self, $key) = @_;
315 # check for cached value (which may be undef so we use exists not defined)
316 return $self->{$key} if exists $self->{$key};
318 $self->fetch_string($key);
319 return $self->{$key} if exists $self->{$key};
320 $self->fetch_virtual($key);
322 # Might not exist, in which undef is correct.
323 return $self->{$key};
330 substr($Config_SH_expanded, 0, index($Config_SH_expanded, '=') );
334 # Find out how the current key's quoted so we can skip to its end.
335 my $quote = substr($Config_SH_expanded,
336 index($Config_SH_expanded, "=", $prevpos)+1, 1);
337 my $pos = index($Config_SH_expanded, qq($quote\n), $prevpos) + 2;
338 my $len = index($Config_SH_expanded, "=", $pos) - $pos;
340 $len > 0 ? substr($Config_SH_expanded, $pos, $len) : undef;
344 return 1 if exists($_[0]->{$_[1]});
346 return(index($Config_SH_expanded, "\n$_[1]='") != -1 or
347 substr($Config_SH_expanded, 0, length($_[1])+2) eq "$_[1]='" or
348 index($Config_SH_expanded, "\n$_[1]=\"") != -1 or
349 substr($Config_SH_expanded, 0, length($_[1])+2) eq "$_[1]=\"" or
350 $_[1] =~ /^(?:(?:cc|ld)flags|libs(?:wanted)?)_nolargefiles$/
354 sub STORE { die "\%Config::Config is read-only\n" }
365 return map { chomp; $_ } grep eval{ /^(?:$re)=/ }, split /^/,
370 # implements -V:cfgvar option (see perlrun -V:)
372 # find optional leading, trailing colons; and query-spec
373 my ($notag,$qry,$lncont) = m/^(:)?(.*?)(:)?$/; # flags fore and aft,
374 # map colon-flags to print decorations
375 my $prfx = $notag ? '': "$qry="; # tag-prefix for print
376 my $lnend = $lncont ? ' ' : ";\n"; # line ending for print
378 # all config-vars are by definition \w only, any \W means regex
380 my @matches = config_re($qry);
381 print map "$_$lnend", @matches ? @matches : "$qry: not found" if !$notag;
382 print map { s/\w+=//; "$_$lnend" } @matches ? @matches : "$qry: not found" if $notag;
384 my $v = (exists $Config{$qry}) ? $Config{$qry} : 'UNKNOWN';
385 $v = 'undef' unless defined $v;
386 print "${prfx}'${v}'$lnend";
394 print CONFIG <<'ENDOFSET';
397 my ($value, $v) = $Config_SH_expanded =~ m/^used_aout='(.*)'\s*$/m;
398 for (split ' ', $value) {
399 ($v) = $Config_SH_expanded =~ m/^aout_$_='(.*)'\s*$/m;
400 $preconfig{$_} = $v eq 'undef' ? undef : $v;
403 $preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't
404 sub TIEHASH { bless {%preconfig} }
406 # Extract the name of the DLL from the makefile to avoid duplication
407 my ($f) = grep -r, qw(GNUMakefile Makefile);
409 if (open my $fh, '<', $f) {
411 $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
414 print CONFIG <<ENDOFSET if $dll;
415 \$preconfig{dll_name} = '$dll';
418 print CONFIG <<'ENDOFSET';
425 my $fast_config = join '', map { " $_,\n" }
426 sort values (%v_fast), 'byteorder => $byteorder' ;
428 print CONFIG sprintf <<'ENDOFTIE', $fast_config;
430 # avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
433 tie %%Config, 'Config', {
441 open(CONFIG_POD, ">lib/Config.pod") or die "Can't open lib/Config.pod: $!";
442 print CONFIG_POD <<'ENDOFTAIL';
445 Config - access Perl configuration information
450 if ($Config{usethreads}) {
451 print "has thread support\n"
454 use Config qw(myconfig config_sh config_vars config_re);
462 config_vars(qw(osname archname));
467 The Config module contains all the information that was available to
468 the C<Configure> program at Perl build time (over 900 values).
470 Shell variables from the F<config.sh> file (written by Configure) are
471 stored in the readonly-variable C<%Config>, indexed by their names.
473 Values stored in config.sh as 'undef' are returned as undefined
474 values. The perl C<exists> function can be used to check if a
475 named variable exists.
481 Returns a textual summary of the major perl configuration values.
482 See also C<-V> in L<perlrun/Switches>.
486 Returns the entire perl configuration information in the form of the
487 original config.sh shell variable assignment script.
489 =item config_re($regex)
491 Like config_sh() but returns, as a list, only the config entries who's
492 names match the $regex.
494 =item config_vars(@names)
496 Prints to STDOUT the values of the named configuration variable. Each is
497 printed on a separate line in the form:
501 Names which are unknown are output as C<name='UNKNOWN';>.
502 See also C<-V:name> in L<perlrun/Switches>.
508 Here's a more sophisticated example of using %Config:
515 unless($Config{sig_name} && $Config{sig_num}) {
518 my @names = split ' ', $Config{sig_name};
519 @sig_num{@names} = split ' ', $Config{sig_num};
521 $sig_name[$sig_num{$_}] ||= $_;
525 print "signal #17 = $sig_name[17]\n";
526 if ($sig_num{ALRM}) {
527 print "SIGALRM is $sig_num{ALRM}\n";
532 Because this information is not stored within the perl executable
533 itself it is possible (but unlikely) that the information does not
534 relate to the actual perl binary which is being used to access it.
536 The Config module is installed into the architecture and version
537 specific library directory ($Config{installarchlib}) and it checks the
538 perl version number when loaded.
540 The values stored in config.sh may be either single-quoted or
541 double-quoted. Double-quoted strings are handy for those cases where you
542 need to include escape sequences in the strings. To avoid runtime variable
543 interpolation, any C<$> and C<@> characters are replaced by C<\$> and
544 C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
545 or C<\@> in double-quoted strings unless you're willing to deal with the
546 consequences. (The slashes will end up escaped and the C<$> or C<@> will
547 trigger variable interpolation)
551 Most C<Config> variables are determined by the C<Configure> script
552 on platforms supported by it (which is most UNIX platforms). Some
553 platforms have custom-made C<Config> variables, and may thus not have
554 some of the variables described below, or may have extraneous variables
555 specific to that particular port. See the port specific documentation
560 if ($Opts{glossary}) {
561 open(GLOS, "<$Glossary") or die "Can't open $Glossary: $!";
568 if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
569 my $c = substr $1, 0, 1;
570 unless ($seen{$c}++) {
571 print CONFIG_POD <<EOF if $text;
575 print CONFIG_POD <<EOF;
584 elsif (!$text || !/\A\t/) {
585 warn "Expected a Configure variable header",
586 ($text ? " or another paragraph of description" : () );
588 s/n't/n\00t/g; # leave can't, won't etc untouched
589 s/^\t\s+(.*)/\n$1/gm; # Indented lines ===> new paragraph
590 s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text
591 s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
592 s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
593 s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
595 (?<! [\w./<\'\"] ) # Only standalone file names
596 (?! e \. g \. ) # Not e.g.
597 (?! \. \. \. ) # Not ...
599 (?! read/ ) # Not read/write
600 (?! etc\. ) # Not etc.
603 \$ ? # Allow leading $
604 [\w./]* [./] [\w./]* # Require . or / inside
606 (?<! \. (?= [\s)] ) ) # Do not include trailing dot
607 (?! [\w/] ) # Include all of it
609 (F<$1>)xg; # /usr/local
610 s/((?<=\s)~\w*)/F<$1>/g; # ~name
611 s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD
612 s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
613 s/n[\0]t/n't/g; # undo can't, won't damage
616 if ($Opts{glossary}) {
617 <GLOS>; # Skip the "DO NOT EDIT"
618 <GLOS>; # Skip the preamble
625 print CONFIG_POD <<'ENDOFTAIL';
631 This module contains a good example of how to use tie to implement a
632 cache and an example of how to make a tied variable readonly to those
643 # Now create Cross.pm if needed
645 open CROSS, ">lib/Cross.pm" or die "Can not open >lib/Cross.pm: $!";
647 # typical invocation:
648 # perl -MCross Makefile.PL
649 # perl -MCross=wince -V:cc
653 my ($package,$platform) = @_;
654 unless (defined $platform) {
655 # if $platform is not specified, then use last one when
656 # 'configpm; was invoked with --cross option
657 $platform = '***replace-marker***';
659 @INC = map {/\blib\b/?(do{local $_=$_;s/\blib\b/xlib\/$platform/;$_},$_):($_)} @INC;
660 $::Cross::platform = $platform;
665 $cross =~ s/\*\*\*replace-marker\*\*\*/$Opts{cross}/g;
670 # Now do some simple tests on the Config.pm file we have created
675 die "$0: $Config_PM not valid"
676 unless $Config{'PERL_CONFIG_SH'} eq 'true';
678 die "$0: error processing $Config_PM"
679 if defined($Config{'an impossible name'})
680 or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache
683 die "$0: error processing $Config_PM"
684 if eval '$Config{"cc"} = 1'
685 or eval 'delete $Config{"cc"}'