3 use vars qw(%Config $Config_SH_expanded);
5 # commonly used names to put first (and hence lookup fastest)
6 my %Common = map {($_,$_)}
7 qw(archname osname osvers prefix libs libpth
8 dynamic_ext static_ext dlsrc so
10 privlibexp archlibexp installprivlib installarchlib
11 sharpbang startsh shsharp
14 # names of things which may need to have slashes changed to double-colons
15 my %Extensions = map {($_,$_)}
16 qw(dynamic_ext static_ext extensions known_extensions);
18 # allowed opts as well as specifies default and initial values
20 'cross' => '', # --cross=PLATFORM - crosscompiling for PLATFORM
21 'glossary' => 1, # --no-glossary - no glossary file inclusion,
23 'heavy' => '', # pathname of the Config_heavy.pl file
27 # user specified options
30 (map {/^--([\-_\w]+)=(.*)$/} @ARGV),
31 # --opt --no-opt --noopt
32 (map {/^no-?(.*)$/i?($1=>0):($_=>1)} map {/^--([\-_\w]+)$/} @ARGV),
35 my %opts = (%Allowed_Opts, %given_opts);
37 for my $opt (grep {!exists $Allowed_Opts{$_}} keys %given_opts) {
38 die "option '$opt' is not recognized";
40 @ARGV = grep {!/^--/} @ARGV;
48 my ($Config_PM, $Config_heavy);
49 my $Glossary = $ARGV[1] || 'Porting/Glossary';
52 # creating cross-platform config file
54 mkdir "xlib/$Opts{cross}";
55 $Config_PM = $ARGV[0] || "xlib/$Opts{cross}/Config.pm";
58 $Config_PM = $ARGV[0] || 'lib/Config.pm';
61 $Config_heavy = $Opts{heavy};
64 ($Config_heavy = $Config_PM) =~ s!\.pm$!_heavy.pl!;
65 die "Can't automatically determine name for Config_heavy.pl from '$Config_PM'"
66 if $Config_heavy eq $Config_PM;
69 open CONFIG, ">$Config_PM" or die "Can't open $Config_PM: $!\n";
70 open CONFIG_HEAVY, ">$Config_heavy" or die "Can't open $Config_heavy: $!\n";
72 print CONFIG_HEAVY <<'ENDOFBEG';
73 # This file was created by configpm when Perl was built. Any changes
74 # made to this file will be lost the next time perl is built.
78 # use warnings; Pulls in Carp
79 # use vars pulls in Carp
82 my $myver = sprintf "v%vd", $^V;
84 printf CONFIG <<'ENDOFBEG', ($myver) x 3;
85 # This file was created by configpm when Perl was built. Any changes
86 # made to this file will be lost the next time perl is built.
90 # use warnings; Pulls in Carp
91 # use vars pulls in Carp
92 @Config::EXPORT = qw(%%Config);
93 @Config::EXPORT_OK = qw(myconfig config_sh config_vars config_re);
95 my %%Export_Cache = map {($_ => 1)} (@Config::EXPORT, @Config::EXPORT_OK);
99 # Define our own import method to avoid pulling in the full Exporter:
102 @_ = @Config::EXPORT unless @_;
104 my @funcs = grep $_ ne '%%Config', @_;
105 my $export_Config = @funcs < @_ ? 1 : 0;
108 my $callpkg = caller(0);
109 foreach my $func (@funcs) {
110 die sprintf qq{"%%s" is not exported by the %%s module\n},
111 $func, __PACKAGE__ unless $Export_Cache{$func};
112 *{$callpkg.'::'.$func} = \&{$func};
115 *{"$callpkg\::Config"} = \%%Config if $export_Config;
119 die "Perl lib version (%s) doesn't match executable version ($])"
123 or die "Perl lib version (%s) doesn't match executable version (" .
124 sprintf("v%%vd",$^V) . ")";
136 # This is somewhat grim, but I want the code for parsing config.sh here and
137 # now so that I can expand $Config{ivsize} and $Config{ivtype}
139 my $fetch_string = <<'EOT';
141 # Search for it in the big string
143 my($self, $key) = @_;
145 my $quote_type = "'";
146 my $marker = "$key=";
148 # Check for the common case, ' delimited
149 my $start = index($Config_SH_expanded, "\n$marker$quote_type");
150 # If that failed, check for " delimited
153 $start = index($Config_SH_expanded, "\n$marker$quote_type");
155 # Start can never be -1 now, as we've rigged the long string we're
156 # searching with an initial dummy newline.
157 return undef if $start == -1;
159 $start += length($marker) + 2;
161 my $value = substr($Config_SH_expanded, $start,
162 index($Config_SH_expanded, "$quote_type\n", $start)
165 # If we had a double-quote, we'd better eval it so escape
166 # sequences and such can be interpolated. Since the incoming
167 # value is supposed to follow shell rules and not perl rules,
168 # we escape any perl variable markers
169 if ($quote_type eq '"') {
170 $value =~ s/\$/\\\$/g;
171 $value =~ s/\@/\\\@/g;
172 eval "\$value = \"$value\"";
175 # So we can say "if $Config{'foo'}".
176 $value = undef if $value eq 'undef';
177 $self->{$key} = $value; # cache it
186 open(CONFIG_SH, 'config.sh') || die "Can't open config.sh: $!";
187 while (<CONFIG_SH>) {
188 next if m:^#!/bin/sh:;
190 # Catch PERL_CONFIG_SH=true and PERL_VERSION=n line from Configure.
191 s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/ or m/^(\w+)='(.*)'$/;
192 my($k, $v) = ($1, $2);
194 # grandfather PATCHLEVEL and SUBVERSION and CONFIG
196 if ($k eq 'PERL_VERSION') {
197 push @v_others, "PATCHLEVEL='$v'\n";
199 elsif ($k eq 'PERL_SUBVERSION') {
200 push @v_others, "SUBVERSION='$v'\n";
202 elsif ($k eq 'PERL_CONFIG_SH') {
203 push @v_others, "CONFIG='$v'\n";
207 # We can delimit things in config.sh with either ' or ".
208 unless ($in_v or m/^(\w+)=(['"])(.*\n)/){
209 push(@non_v, "#$_"); # not a name='value' line
217 ($name,$val) = ($1,$3);
219 $in_v = $val !~ /$quote\n/;
222 s,/,::,g if $Extensions{$name};
224 $val =~ s/$quote\n?\z//;
226 my $line = "$name=$quote$val$quote\n";
227 if (!$Common{$name}){
228 push(@v_others, $line);
231 push(@v_fast, $line);
232 $v_fast{$name} = "'$name' => $quote$val$quote";
239 # Calculation for the keys for byteorder
240 # This is somewhat grim, but I need to run fetch_string here.
241 our $Config_SH_expanded = join "\n", '', @v_fast, @v_others;
243 my $t = fetch_string ({}, 'ivtype');
244 my $s = fetch_string ({}, 'ivsize');
246 # byteorder does exist on its own but we overlay a virtual
247 # dynamically recomputed value.
249 # However, ivtype and ivsize will not vary for sane fat binaries
251 my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
254 if ($s == 4 || $s == 8) {
255 my $list = join ',', reverse(2..$s);
257 $byteorder_code = <<"EOT";
259 foreach my \$c ($list) { \$i |= ord(\$c); \$i <<= 8 }
261 our \$byteorder = join('', unpack('$format', pack('$f', \$i)));
264 $byteorder_code = "our \$byteorder = '?'x$s;\n";
266 print CONFIG $byteorder_code;
268 print CONFIG_HEAVY @non_v, "\n";
270 # copy config summary format from the myconfig.SH script
271 print CONFIG_HEAVY "our \$summary : unique = <<'!END!';\n";
272 open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
273 1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
274 do { print CONFIG_HEAVY $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
277 # NB. as $summary is unique, we need to copy it in a lexical variable
278 # before expanding it, because may have been made readonly if a perl
279 # interpreter has been cloned.
281 print CONFIG_HEAVY "\n!END!\n", <<'EOT';
282 my $summary_expanded;
285 return $summary_expanded if $summary_expanded;
286 ($summary_expanded = $summary) =~ s{\$(\w+)}
287 { my $c = $Config::Config{$1}; defined($c) ? $c : 'undef' }ge;
295 print CONFIG_HEAVY join("", @v_fast, sort @v_others);
297 print CONFIG_HEAVY <<'EOT';
299 s/(byteorder=)(['"]).*?\2/$1$2$Config::byteorder$2/m;
300 our $Config_SH : unique = $_;
302 our $Config_SH_expanded : unique = "\n$_" . << 'EOVIRTUAL';
305 foreach my $prefix (qw(ccflags ldflags)) {
306 my $value = fetch_string ({}, $prefix);
307 my $withlargefiles = fetch_string ({}, $prefix . "_uselargefiles");
308 $value =~ s/\Q$withlargefiles\E\b//;
309 print CONFIG_HEAVY "${prefix}_nolargefiles='$value'\n";
312 foreach my $prefix (qw(libs libswanted)) {
313 my $value = fetch_string ({}, $prefix);
315 = split(' ', fetch_string ({}, 'libswanted_uselargefiles'));
318 @lflibswanted{@lflibswanted} = ();
319 if ($prefix eq 'libs') {
320 my @libs = grep { /^-l(.+)/ &&
321 not exists $lflibswanted{$1} }
322 split(' ', fetch_string ({}, 'libs'));
323 $value = join(' ', @libs);
325 my @libswanted = grep { not exists $lflibswanted{$_} }
326 split(' ', fetch_string ({}, 'libswanted'));
327 $value = join(' ', @libswanted);
330 print CONFIG_HEAVY "${prefix}_nolargefiles='$value'\n";
333 print CONFIG_HEAVY "EOVIRTUAL\n";
335 print CONFIG_HEAVY $fetch_string;
337 print CONFIG <<'ENDOFEND';
340 my($self, $key) = @_;
342 # check for cached value (which may be undef so we use exists not defined)
343 return $self->{$key} if exists $self->{$key};
345 return $self->fetch_string($key);
349 print CONFIG_HEAVY <<'ENDOFEND';
354 substr($Config_SH_expanded, 1, index($Config_SH_expanded, '=') - 1 );
358 # Find out how the current key's quoted so we can skip to its end.
359 my $quote = substr($Config_SH_expanded,
360 index($Config_SH_expanded, "=", $prevpos)+1, 1);
361 my $pos = index($Config_SH_expanded, qq($quote\n), $prevpos) + 2;
362 my $len = index($Config_SH_expanded, "=", $pos) - $pos;
364 $len > 0 ? substr($Config_SH_expanded, $pos, $len) : undef;
368 return 1 if exists($_[0]->{$_[1]});
370 return(index($Config_SH_expanded, "\n$_[1]='") != -1 or
371 index($Config_SH_expanded, "\n$_[1]=\"") != -1
375 sub STORE { die "\%Config::Config is read-only\n" }
386 return map { chomp; $_ } grep eval{ /^(?:$re)=/ }, split /^/,
391 # implements -V:cfgvar option (see perlrun -V:)
393 # find optional leading, trailing colons; and query-spec
394 my ($notag,$qry,$lncont) = m/^(:)?(.*?)(:)?$/; # flags fore and aft,
395 # map colon-flags to print decorations
396 my $prfx = $notag ? '': "$qry="; # tag-prefix for print
397 my $lnend = $lncont ? ' ' : ";\n"; # line ending for print
399 # all config-vars are by definition \w only, any \W means regex
401 my @matches = config_re($qry);
402 print map "$_$lnend", @matches ? @matches : "$qry: not found" if !$notag;
403 print map { s/\w+=//; "$_$lnend" } @matches ? @matches : "$qry: not found" if $notag;
405 my $v = (exists $Config::Config{$qry}) ? $Config::Config{$qry}
407 $v = 'undef' unless defined $v;
408 print "${prfx}'${v}'$lnend";
413 # Called by the real AUTOLOAD
416 goto \&$Config::AUTOLOAD;
423 print CONFIG <<'ENDOFSET';
426 my ($value, $v) = $Config_SH_expanded =~ m/^used_aout='(.*)'\s*$/m;
427 for (split ' ', $value) {
428 ($v) = $Config_SH_expanded =~ m/^aout_$_='(.*)'\s*$/m;
429 $preconfig{$_} = $v eq 'undef' ? undef : $v;
432 $preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't
433 sub TIEHASH { bless {%preconfig} }
435 # Extract the name of the DLL from the makefile to avoid duplication
436 my ($f) = grep -r, qw(GNUMakefile Makefile);
438 if (open my $fh, '<', $f) {
440 $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
443 print CONFIG <<ENDOFSET if $dll;
444 \$preconfig{dll_name} = '$dll';
447 print CONFIG <<'ENDOFSET';
454 my $fast_config = join '', map { " $_,\n" }
455 sort values (%v_fast), 'byteorder => $byteorder' ;
457 print CONFIG sprintf <<'ENDOFTIE', $fast_config;
462 require 'config_heavy.pl';
464 die "&Config::AUTOLOAD failed on $Config::AUTOLOAD";
467 tie %%Config, 'Config', {
475 open(CONFIG_POD, ">lib/Config.pod") or die "Can't open lib/Config.pod: $!";
476 print CONFIG_POD <<'ENDOFTAIL';
479 Config - access Perl configuration information
484 if ($Config{usethreads}) {
485 print "has thread support\n"
488 use Config qw(myconfig config_sh config_vars config_re);
496 config_vars(qw(osname archname));
501 The Config module contains all the information that was available to
502 the C<Configure> program at Perl build time (over 900 values).
504 Shell variables from the F<config.sh> file (written by Configure) are
505 stored in the readonly-variable C<%Config>, indexed by their names.
507 Values stored in config.sh as 'undef' are returned as undefined
508 values. The perl C<exists> function can be used to check if a
509 named variable exists.
515 Returns a textual summary of the major perl configuration values.
516 See also C<-V> in L<perlrun/Switches>.
520 Returns the entire perl configuration information in the form of the
521 original config.sh shell variable assignment script.
523 =item config_re($regex)
525 Like config_sh() but returns, as a list, only the config entries who's
526 names match the $regex.
528 =item config_vars(@names)
530 Prints to STDOUT the values of the named configuration variable. Each is
531 printed on a separate line in the form:
535 Names which are unknown are output as C<name='UNKNOWN';>.
536 See also C<-V:name> in L<perlrun/Switches>.
542 Here's a more sophisticated example of using %Config:
549 unless($Config{sig_name} && $Config{sig_num}) {
552 my @names = split ' ', $Config{sig_name};
553 @sig_num{@names} = split ' ', $Config{sig_num};
555 $sig_name[$sig_num{$_}] ||= $_;
559 print "signal #17 = $sig_name[17]\n";
560 if ($sig_num{ALRM}) {
561 print "SIGALRM is $sig_num{ALRM}\n";
566 Because this information is not stored within the perl executable
567 itself it is possible (but unlikely) that the information does not
568 relate to the actual perl binary which is being used to access it.
570 The Config module is installed into the architecture and version
571 specific library directory ($Config{installarchlib}) and it checks the
572 perl version number when loaded.
574 The values stored in config.sh may be either single-quoted or
575 double-quoted. Double-quoted strings are handy for those cases where you
576 need to include escape sequences in the strings. To avoid runtime variable
577 interpolation, any C<$> and C<@> characters are replaced by C<\$> and
578 C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
579 or C<\@> in double-quoted strings unless you're willing to deal with the
580 consequences. (The slashes will end up escaped and the C<$> or C<@> will
581 trigger variable interpolation)
585 Most C<Config> variables are determined by the C<Configure> script
586 on platforms supported by it (which is most UNIX platforms). Some
587 platforms have custom-made C<Config> variables, and may thus not have
588 some of the variables described below, or may have extraneous variables
589 specific to that particular port. See the port specific documentation
594 if ($Opts{glossary}) {
595 open(GLOS, "<$Glossary") or die "Can't open $Glossary: $!";
602 if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
603 my $c = substr $1, 0, 1;
604 unless ($seen{$c}++) {
605 print CONFIG_POD <<EOF if $text;
609 print CONFIG_POD <<EOF;
618 elsif (!$text || !/\A\t/) {
619 warn "Expected a Configure variable header",
620 ($text ? " or another paragraph of description" : () );
622 s/n't/n\00t/g; # leave can't, won't etc untouched
623 s/^\t\s+(.*)/\n$1/gm; # Indented lines ===> new paragraph
624 s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text
625 s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
626 s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
627 s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
629 (?<! [\w./<\'\"] ) # Only standalone file names
630 (?! e \. g \. ) # Not e.g.
631 (?! \. \. \. ) # Not ...
633 (?! read/ ) # Not read/write
634 (?! etc\. ) # Not etc.
637 \$ ? # Allow leading $
638 [\w./]* [./] [\w./]* # Require . or / inside
640 (?<! \. (?= [\s)] ) ) # Do not include trailing dot
641 (?! [\w/] ) # Include all of it
643 (F<$1>)xg; # /usr/local
644 s/((?<=\s)~\w*)/F<$1>/g; # ~name
645 s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD
646 s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
647 s/n[\0]t/n't/g; # undo can't, won't damage
650 if ($Opts{glossary}) {
651 <GLOS>; # Skip the "DO NOT EDIT"
652 <GLOS>; # Skip the preamble
659 print CONFIG_POD <<'ENDOFTAIL';
665 This module contains a good example of how to use tie to implement a
666 cache and an example of how to make a tied variable readonly to those
678 # Now create Cross.pm if needed
680 open CROSS, ">lib/Cross.pm" or die "Can not open >lib/Cross.pm: $!";
682 # typical invocation:
683 # perl -MCross Makefile.PL
684 # perl -MCross=wince -V:cc
688 my ($package,$platform) = @_;
689 unless (defined $platform) {
690 # if $platform is not specified, then use last one when
691 # 'configpm; was invoked with --cross option
692 $platform = '***replace-marker***';
694 @INC = map {/\blib\b/?(do{local $_=$_;s/\blib\b/xlib\/$platform/;$_},$_):($_)} @INC;
695 $::Cross::platform = $platform;
700 $cross =~ s/\*\*\*replace-marker\*\*\*/$Opts{cross}/g;
705 # Now do some simple tests on the Config.pm file we have created
710 die "$0: $Config_PM not valid"
711 unless $Config{'PERL_CONFIG_SH'} eq 'true';
713 die "$0: error processing $Config_PM"
714 if defined($Config{'an impossible name'})
715 or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache
718 die "$0: error processing $Config_PM"
719 if eval '$Config{"cc"} = 1'
720 or eval 'delete $Config{"cc"}'