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.
69 @EXPORT = qw(%%Config);
70 @EXPORT_OK = qw(myconfig config_sh config_vars);
72 # Define our own import method to avoid pulling in the full Exporter:
75 @_ = @EXPORT unless @_;
77 my @func = grep {$_ ne '%%Config'} @_;
78 local $Exporter::ExportLevel = 1;
79 Exporter::import('Config', @func) if @func;
81 return if @func == @_;
83 my $callpkg = caller(0);
84 *{"$callpkg\::Config"} = \%%Config;
87 die "Perl lib version (%s) doesn't match executable version ($])"
91 or die "Perl lib version (%s) doesn't match executable version (" .
92 (sprintf "v%vd",$^V) . ")";
104 # This is somewhat grim, but I want the code for parsing config.sh here and
105 # now so that I can expand $Config{ivsize} and $Config{ivtype}
107 my $fetch_string = <<'EOT';
109 # Search for it in the big string
111 my($self, $key) = @_;
113 my $quote_type = "'";
114 my $marker = "$key=";
116 # Check for the common case, ' delimeted
117 my $start = index($Config_SH, "\n$marker$quote_type");
118 # If that failed, check for " delimited
121 $start = index($Config_SH, "\n$marker$quote_type");
123 return undef if ( ($start == -1) && # in case it's first
124 (substr($Config_SH, 0, length($marker)) ne $marker) );
126 # It's the very first thing we found. Skip $start forward
127 # and figure out the quote mark after the =.
128 $start = length($marker) + 1;
129 $quote_type = substr($Config_SH, $start - 1, 1);
132 $start += length($marker) + 2;
135 my $value = substr($Config_SH, $start,
136 index($Config_SH, "$quote_type\n", $start) - $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 print CONFIG @non_v, "\n";
210 # copy config summary format from the myconfig.SH script
211 print CONFIG "my \$summary = <<'!END!';\n";
212 open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
213 1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
214 do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
217 print CONFIG "\n!END!\n", <<'EOT';
218 my $summary_expanded = 0;
221 return $summary if $summary_expanded;
222 $summary =~ s{\$(\w+)}
223 { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge;
224 $summary_expanded = 1;
228 our $Config_SH : unique = <<'!END!';
231 print CONFIG join("", @v_fast, sort @v_others);
233 print CONFIG "!END!\n", $fetch_string;
235 print CONFIG <<'ENDOFEND';
238 my($self, $key) = @_;
242 if ($key =~ /^((?:cc|ld)flags|libs(?:wanted)?)_nolargefiles/) {
243 # These are purely virtual, they do not exist, but need to
244 # be computed on demand for largefile-incapable extensions.
245 my $new_key = "${1}_uselargefiles";
246 $value = $Config{$1};
247 my $withlargefiles = $Config{$new_key};
248 if ($new_key =~ /^(?:cc|ld)flags_/) {
249 $value =~ s/\Q$withlargefiles\E\b//;
250 } elsif ($new_key =~ /^libs/) {
251 my @lflibswanted = split(' ', $Config{libswanted_uselargefiles});
254 @lflibswanted{@lflibswanted} = ();
255 if ($new_key =~ /^libs_/) {
256 my @libs = grep { /^-l(.+)/ &&
257 not exists $lflibswanted{$1} }
258 split(' ', $Config{libs});
259 $Config{libs} = join(' ', @libs);
260 } elsif ($new_key =~ /^libswanted_/) {
261 my @libswanted = grep { not exists $lflibswanted{$_} }
262 split(' ', $Config{libswanted});
263 $Config{libswanted} = join(' ', @libswanted);
269 $self->{$key} = $value;
273 my($self, $key) = @_;
275 # check for cached value (which may be undef so we use exists not defined)
276 return $self->{$key} if exists $self->{$key};
278 $self->fetch_string($key);
279 return $self->{$key} if exists $self->{$key};
280 $self->fetch_virtual($key);
282 # Might not exist, in which undef is correct.
283 return $self->{$key};
290 substr($Config_SH, 0, index($Config_SH, '=') );
294 # Find out how the current key's quoted so we can skip to its end.
295 my $quote = substr($Config_SH, index($Config_SH, "=", $prevpos)+1, 1);
296 my $pos = index($Config_SH, qq($quote\n), $prevpos) + 2;
297 my $len = index($Config_SH, "=", $pos) - $pos;
299 $len > 0 ? substr($Config_SH, $pos, $len) : undef;
303 return 1 if exists($_[0]->{$_[1]});
305 return(index($Config_SH, "\n$_[1]='") != -1 or
306 substr($Config_SH, 0, length($_[1])+2) eq "$_[1]='" or
307 index($Config_SH, "\n$_[1]=\"") != -1 or
308 substr($Config_SH, 0, length($_[1])+2) eq "$_[1]=\"" or
309 $_[1] =~ /^(?:(?:cc|ld)flags|libs(?:wanted)?)_nolargefiles$/
313 sub STORE { die "\%Config::Config is read-only\n" }
324 my @matches = grep /^$re=/, split /^/, $Config_SH;
325 @matches ? (print @matches) : print "$re: not found\n";
330 config_re($_), next if /\W/;
331 my $v=(exists $Config{$_}) ? $Config{$_} : 'UNKNOWN';
332 $v='undef' unless defined $v;
340 print CONFIG <<'ENDOFSET';
343 my ($value, $v) = $Config_SH =~ m/^used_aout='(.*)'\s*$/m;
344 for (split ' ', $value) {
345 ($v) = $Config_SH =~ m/^aout_$_='(.*)'\s*$/m;
346 $preconfig{$_} = $v eq 'undef' ? undef : $v;
349 $preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't
350 sub TIEHASH { bless {%preconfig} }
352 # Extract the name of the DLL from the makefile to avoid duplication
353 my ($f) = grep -r, qw(GNUMakefile Makefile);
355 if (open my $fh, '<', $f) {
357 $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
360 print CONFIG <<ENDOFSET if $dll;
361 \$preconfig{dll_name} = '$dll';
364 print CONFIG <<'ENDOFSET';
372 # Calculation for the keys for byteorder
373 # This is somewhat grim, but I need to run fetch_string here.
374 our $Config_SH = join "\n", @v_fast, @v_others;
376 my $t = fetch_string ({}, 'ivtype');
377 my $s = fetch_string ({}, 'ivsize');
379 # byteorder does exist on its own but we overlay a virtual
380 # dynamically recomputed value.
382 # However, ivtype and ivsize will not vary for sane fat binaries
384 my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
387 if ($s == 4 || $s == 8) {
389 my $list = join ',', reverse(2..$s);
391 $byteorder_code = <<"EOT";
393 foreach my \$c ($list) { \$i |= ord(\$c); \$i <<= 8 }
395 my \$value = join('', unpack('$format', pack('$f', \$i)));
398 $byteorder_code = "\$value = '?'x$s;\n";
401 my $fast_config = join '', map { " $_,\n" }
402 values (%v_fast), 'byteorder => $value' ;
404 print CONFIG sprintf <<'ENDOFTIE', $byteorder_code, $fast_config;
406 # avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
411 tie %%Config, 'Config', {
419 open(CONFIG_POD, ">lib/Config.pod") or die "Can't open lib/Config.pod: $!";
420 print CONFIG_POD <<'ENDOFTAIL';
423 Config - access Perl configuration information
428 if ($Config{'cc'} =~ /gcc/) {
429 print "built by gcc\n";
432 use Config qw(myconfig config_sh config_vars);
438 config_vars(qw(osname archname));
443 The Config module contains all the information that was available to
444 the C<Configure> program at Perl build time (over 900 values).
446 Shell variables from the F<config.sh> file (written by Configure) are
447 stored in the readonly-variable C<%Config>, indexed by their names.
449 Values stored in config.sh as 'undef' are returned as undefined
450 values. The perl C<exists> function can be used to check if a
451 named variable exists.
457 Returns a textual summary of the major perl configuration values.
458 See also C<-V> in L<perlrun/Switches>.
462 Returns the entire perl configuration information in the form of the
463 original config.sh shell variable assignment script.
465 =item config_vars(@names)
467 Prints to STDOUT the values of the named configuration variable. Each is
468 printed on a separate line in the form:
472 Names which are unknown are output as C<name='UNKNOWN';>.
473 See also C<-V:name> in L<perlrun/Switches>.
479 Here's a more sophisticated example of using %Config:
486 unless($Config{sig_name} && $Config{sig_num}) {
489 my @names = split ' ', $Config{sig_name};
490 @sig_num{@names} = split ' ', $Config{sig_num};
492 $sig_name[$sig_num{$_}] ||= $_;
496 print "signal #17 = $sig_name[17]\n";
497 if ($sig_num{ALRM}) {
498 print "SIGALRM is $sig_num{ALRM}\n";
503 Because this information is not stored within the perl executable
504 itself it is possible (but unlikely) that the information does not
505 relate to the actual perl binary which is being used to access it.
507 The Config module is installed into the architecture and version
508 specific library directory ($Config{installarchlib}) and it checks the
509 perl version number when loaded.
511 The values stored in config.sh may be either single-quoted or
512 double-quoted. Double-quoted strings are handy for those cases where you
513 need to include escape sequences in the strings. To avoid runtime variable
514 interpolation, any C<$> and C<@> characters are replaced by C<\$> and
515 C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
516 or C<\@> in double-quoted strings unless you're willing to deal with the
517 consequences. (The slashes will end up escaped and the C<$> or C<@> will
518 trigger variable interpolation)
522 Most C<Config> variables are determined by the C<Configure> script
523 on platforms supported by it (which is most UNIX platforms). Some
524 platforms have custom-made C<Config> variables, and may thus not have
525 some of the variables described below, or may have extraneous variables
526 specific to that particular port. See the port specific documentation
531 if ($Opts{glossary}) {
532 open(GLOS, "<$Glossary") or die "Can't open $Glossary: $!";
539 if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
540 my $c = substr $1, 0, 1;
541 unless ($seen{$c}++) {
542 print CONFIG_POD <<EOF if $text;
546 print CONFIG_POD <<EOF;
555 elsif (!$text || !/\A\t/) {
556 warn "Expected a Configure variable header",
557 ($text ? " or another paragraph of description" : () );
559 s/n't/n\00t/g; # leave can't, won't etc untouched
560 s/^\t\s+(.*)/\n$1/gm; # Indented lines ===> new paragraph
561 s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text
562 s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
563 s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
564 s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
566 (?<! [\w./<\'\"] ) # Only standalone file names
567 (?! e \. g \. ) # Not e.g.
568 (?! \. \. \. ) # Not ...
570 (?! read/ ) # Not read/write
571 (?! etc\. ) # Not etc.
574 \$ ? # Allow leading $
575 [\w./]* [./] [\w./]* # Require . or / inside
577 (?<! \. (?= [\s)] ) ) # Do not include trailing dot
578 (?! [\w/] ) # Include all of it
580 (F<$1>)xg; # /usr/local
581 s/((?<=\s)~\w*)/F<$1>/g; # ~name
582 s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD
583 s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
584 s/n[\0]t/n't/g; # undo can't, won't damage
587 if ($Opts{glossary}) {
588 <GLOS>; # Skip the "DO NOT EDIT"
589 <GLOS>; # Skip the preamble
596 print CONFIG_POD <<'ENDOFTAIL';
602 This module contains a good example of how to use tie to implement a
603 cache and an example of how to make a tied variable readonly to those
614 # Now create Cross.pm if needed
616 open CROSS, ">lib/Cross.pm" or die "Can not open >lib/Cross.pm: $!";
618 # typical invocation:
619 # perl -MCross Makefile.PL
620 # perl -MCross=wince -V:cc
624 my ($package,$platform) = @_;
625 unless (defined $platform) {
626 # if $platform is not specified, then use last one when
627 # 'configpm; was invoked with --cross option
628 $platform = '***replace-marker***';
630 @INC = map {/\blib\b/?(do{local $_=$_;s/\blib\b/xlib\/$platform/;$_},$_):($_)} @INC;
631 $::Cross::platform = $platform;
636 $cross =~ s/\*\*\*replace-marker\*\*\*/$Opts{cross}/g;
641 # Now do some simple tests on the Config.pm file we have created
646 die "$0: $Config_PM not valid"
647 unless $Config{'PERL_CONFIG_SH'} eq 'true';
649 die "$0: error processing $Config_PM"
650 if defined($Config{'an impossible name'})
651 or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache
654 die "$0: error processing $Config_PM"
655 if eval '$Config{"cc"} = 1'
656 or eval 'delete $Config{"cc"}'