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=PALTFORM - crosscompiling for PLATFORM
21 'glossary' => 1, # --no-glossary - no glossary file inclusion,
26 # user specified options
29 (map {/^--([\-_\w]+)=(.*)$/} @ARGV),
30 # --opt --no-opt --noopt
31 (map {/^no-?(.*)$/i?($1=>0):($_=>1)} map {/^--([\-_\w]+)$/} @ARGV),
34 my %opts = (%Allowed_Opts, %given_opts);
36 for my $opt (grep {!exists $Allowed_Opts{$_}} keys %given_opts) {
37 die "option '$opt' is not recognized";
39 @ARGV = grep {!/^--/} @ARGV;
48 my $Glossary = $ARGV[1] || 'Porting/Glossary';
51 # creating cross-platform config file
53 mkdir "xlib/$Opts{cross}";
54 $Config_PM = $ARGV[0] || "xlib/$Opts{cross}/Config.pm";
57 $Config_PM = $ARGV[0] || 'lib/Config.pm';
61 open CONFIG, ">$Config_PM" or die "Can't open $Config_PM: $!\n";
63 my $myver = sprintf "v%vd", $^V;
65 printf CONFIG <<'ENDOFBEG', ($myver) x 3;
66 # This file was created by configpm when Perl was built. Any changes
67 # made to this file will be lost the next time perl is built.
71 # use warnings; Pulls in Carp
72 # use vars pulls in Carp
73 @Config::EXPORT = qw(%%Config);
74 @Config::EXPORT_OK = qw(myconfig config_sh config_vars config_re);
76 my %%Export_Cache = map {($_ => 1)} (@Config::EXPORT, @Config::EXPORT_OK);
80 # Define our own import method to avoid pulling in the full Exporter:
83 @_ = @Config::EXPORT unless @_;
85 my @funcs = grep $_ ne '%%Config', @_;
86 my $export_Config = @funcs < @_ ? 1 : 0;
89 my $callpkg = caller(0);
90 foreach my $func (@funcs) {
91 die sprintf qq{"%%s" is not exported by the %%s module\n},
92 $func, __PACKAGE__ unless $Export_Cache{$func};
93 *{$callpkg.'::'.$func} = \&{$func};
96 *{"$callpkg\::Config"} = \%%Config if $export_Config;
100 die "Perl lib version (%s) doesn't match executable version ($])"
104 or die "Perl lib version (%s) doesn't match executable version (" .
105 sprintf("v%%vd",$^V) . ")";
117 # This is somewhat grim, but I want the code for parsing config.sh here and
118 # now so that I can expand $Config{ivsize} and $Config{ivtype}
120 my $fetch_string = <<'EOT';
122 # Search for it in the big string
124 my($self, $key) = @_;
126 my $quote_type = "'";
127 my $marker = "$key=";
129 # Check for the common case, ' delimited
130 my $start = index($Config_SH_expanded, "\n$marker$quote_type");
131 # If that failed, check for " delimited
134 $start = index($Config_SH_expanded, "\n$marker$quote_type");
136 # Start can never be -1 now, as we've rigged the long string we're
137 # searching with an initial dummy newline.
138 return undef if $start == -1;
140 $start += length($marker) + 2;
142 my $value = substr($Config_SH_expanded, $start,
143 index($Config_SH_expanded, "$quote_type\n", $start)
146 # If we had a double-quote, we'd better eval it so escape
147 # sequences and such can be interpolated. Since the incoming
148 # value is supposed to follow shell rules and not perl rules,
149 # we escape any perl variable markers
150 if ($quote_type eq '"') {
151 $value =~ s/\$/\\\$/g;
152 $value =~ s/\@/\\\@/g;
153 eval "\$value = \"$value\"";
156 # So we can say "if $Config{'foo'}".
157 $value = undef if $value eq 'undef';
158 $self->{$key} = $value; # cache it
167 open(CONFIG_SH, 'config.sh') || die "Can't open config.sh: $!";
168 while (<CONFIG_SH>) {
169 next if m:^#!/bin/sh:;
171 # Catch PERL_CONFIG_SH=true and PERL_VERSION=n line from Configure.
172 s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/ or m/^(\w+)='(.*)'$/;
173 my($k, $v) = ($1, $2);
175 # grandfather PATCHLEVEL and SUBVERSION and CONFIG
177 if ($k eq 'PERL_VERSION') {
178 push @v_others, "PATCHLEVEL='$v'\n";
180 elsif ($k eq 'PERL_SUBVERSION') {
181 push @v_others, "SUBVERSION='$v'\n";
183 elsif ($k eq 'PERL_CONFIG_SH') {
184 push @v_others, "CONFIG='$v'\n";
188 # We can delimit things in config.sh with either ' or ".
189 unless ($in_v or m/^(\w+)=(['"])(.*\n)/){
190 push(@non_v, "#$_"); # not a name='value' line
198 ($name,$val) = ($1,$3);
200 $in_v = $val !~ /$quote\n/;
203 s,/,::,g if $Extensions{$name};
205 $val =~ s/$quote\n?\z//;
207 my $line = "$name=$quote$val$quote\n";
208 if (!$Common{$name}){
209 push(@v_others, $line);
212 push(@v_fast, $line);
213 $v_fast{$name} = "'$name' => $quote$val$quote";
220 # Calculation for the keys for byteorder
221 # This is somewhat grim, but I need to run fetch_string here.
222 our $Config_SH_expanded = join "\n", '', @v_fast, @v_others;
224 my $t = fetch_string ({}, 'ivtype');
225 my $s = fetch_string ({}, 'ivsize');
227 # byteorder does exist on its own but we overlay a virtual
228 # dynamically recomputed value.
230 # However, ivtype and ivsize will not vary for sane fat binaries
232 my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
235 if ($s == 4 || $s == 8) {
236 my $list = join ',', reverse(2..$s);
238 $byteorder_code = <<"EOT";
240 foreach my \$c ($list) { \$i |= ord(\$c); \$i <<= 8 }
242 my \$byteorder = join('', unpack('$format', pack('$f', \$i)));
245 $byteorder_code = "my \$byteorder = '?'x$s;\n";
248 print CONFIG @non_v, "\n";
250 # copy config summary format from the myconfig.SH script
251 print CONFIG "our \$summary : unique = <<'!END!';\n";
252 open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
253 1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
254 do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
257 # NB. as $summary is unique, we need to copy it in a lexical variable
258 # before expanding it, because may have been made readonly if a perl
259 # interpreter has been cloned.
261 print CONFIG "\n!END!\n", $byteorder_code, <<'EOT';
262 my $summary_expanded;
265 return $summary_expanded if $summary_expanded;
266 ($summary_expanded = $summary) =~ s{\$(\w+)}
267 { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge;
275 print CONFIG join("", @v_fast, sort @v_others);
277 print CONFIG <<'EOT';
279 s/(byteorder=)(['"]).*?\2/$1$2$byteorder$2/m;
280 our $Config_SH : unique = $_;
282 our $Config_SH_expanded : unique = "\n$_" . << 'EOVIRTUAL';
285 foreach my $prefix (qw(ccflags ldflags)) {
286 my $value = fetch_string ({}, $prefix);
287 my $withlargefiles = fetch_string ({}, $prefix . "_uselargefiles");
288 $value =~ s/\Q$withlargefiles\E\b//;
289 print CONFIG "${prefix}_nolargefiles='$value'\n";
292 foreach my $prefix (qw(libs libswanted)) {
293 my $value = fetch_string ({}, $prefix);
295 = split(' ', fetch_string ({}, 'libswanted_uselargefiles'));
298 @lflibswanted{@lflibswanted} = ();
299 if ($prefix eq 'libs') {
300 my @libs = grep { /^-l(.+)/ &&
301 not exists $lflibswanted{$1} }
302 split(' ', fetch_string ({}, 'libs'));
303 $value = join(' ', @libs);
305 my @libswanted = grep { not exists $lflibswanted{$_} }
306 split(' ', fetch_string ({}, 'libswanted'));
307 $value = join(' ', @libswanted);
310 print CONFIG "${prefix}_nolargefiles='$value'\n";
313 print CONFIG "EOVIRTUAL\n";
315 print CONFIG $fetch_string;
317 print CONFIG <<'ENDOFEND';
320 my($self, $key) = @_;
322 # check for cached value (which may be undef so we use exists not defined)
323 return $self->{$key} if exists $self->{$key};
325 return $self->fetch_string($key);
332 substr($Config_SH_expanded, 1, index($Config_SH_expanded, '=') - 1 );
336 # Find out how the current key's quoted so we can skip to its end.
337 my $quote = substr($Config_SH_expanded,
338 index($Config_SH_expanded, "=", $prevpos)+1, 1);
339 my $pos = index($Config_SH_expanded, qq($quote\n), $prevpos) + 2;
340 my $len = index($Config_SH_expanded, "=", $pos) - $pos;
342 $len > 0 ? substr($Config_SH_expanded, $pos, $len) : undef;
346 return 1 if exists($_[0]->{$_[1]});
348 return(index($Config_SH_expanded, "\n$_[1]='") != -1 or
349 index($Config_SH_expanded, "\n$_[1]=\"") != -1
353 sub STORE { die "\%Config::Config is read-only\n" }
364 return map { chomp; $_ } grep eval{ /^(?:$re)=/ }, split /^/,
369 # implements -V:cfgvar option (see perlrun -V:)
371 # find optional leading, trailing colons; and query-spec
372 my ($notag,$qry,$lncont) = m/^(:)?(.*?)(:)?$/; # flags fore and aft,
373 # map colon-flags to print decorations
374 my $prfx = $notag ? '': "$qry="; # tag-prefix for print
375 my $lnend = $lncont ? ' ' : ";\n"; # line ending for print
377 # all config-vars are by definition \w only, any \W means regex
379 my @matches = config_re($qry);
380 print map "$_$lnend", @matches ? @matches : "$qry: not found" if !$notag;
381 print map { s/\w+=//; "$_$lnend" } @matches ? @matches : "$qry: not found" if $notag;
383 my $v = (exists $Config{$qry}) ? $Config{$qry} : 'UNKNOWN';
384 $v = 'undef' unless defined $v;
385 print "${prfx}'${v}'$lnend";
393 print CONFIG <<'ENDOFSET';
396 my ($value, $v) = $Config_SH_expanded =~ m/^used_aout='(.*)'\s*$/m;
397 for (split ' ', $value) {
398 ($v) = $Config_SH_expanded =~ m/^aout_$_='(.*)'\s*$/m;
399 $preconfig{$_} = $v eq 'undef' ? undef : $v;
402 $preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't
403 sub TIEHASH { bless {%preconfig} }
405 # Extract the name of the DLL from the makefile to avoid duplication
406 my ($f) = grep -r, qw(GNUMakefile Makefile);
408 if (open my $fh, '<', $f) {
410 $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
413 print CONFIG <<ENDOFSET if $dll;
414 \$preconfig{dll_name} = '$dll';
417 print CONFIG <<'ENDOFSET';
424 my $fast_config = join '', map { " $_,\n" }
425 sort values (%v_fast), 'byteorder => $byteorder' ;
427 print CONFIG sprintf <<'ENDOFTIE', $fast_config;
429 # avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
432 tie %%Config, 'Config', {
440 open(CONFIG_POD, ">lib/Config.pod") or die "Can't open lib/Config.pod: $!";
441 print CONFIG_POD <<'ENDOFTAIL';
444 Config - access Perl configuration information
449 if ($Config{usethreads}) {
450 print "has thread support\n"
453 use Config qw(myconfig config_sh config_vars config_re);
461 config_vars(qw(osname archname));
466 The Config module contains all the information that was available to
467 the C<Configure> program at Perl build time (over 900 values).
469 Shell variables from the F<config.sh> file (written by Configure) are
470 stored in the readonly-variable C<%Config>, indexed by their names.
472 Values stored in config.sh as 'undef' are returned as undefined
473 values. The perl C<exists> function can be used to check if a
474 named variable exists.
480 Returns a textual summary of the major perl configuration values.
481 See also C<-V> in L<perlrun/Switches>.
485 Returns the entire perl configuration information in the form of the
486 original config.sh shell variable assignment script.
488 =item config_re($regex)
490 Like config_sh() but returns, as a list, only the config entries who's
491 names match the $regex.
493 =item config_vars(@names)
495 Prints to STDOUT the values of the named configuration variable. Each is
496 printed on a separate line in the form:
500 Names which are unknown are output as C<name='UNKNOWN';>.
501 See also C<-V:name> in L<perlrun/Switches>.
507 Here's a more sophisticated example of using %Config:
514 unless($Config{sig_name} && $Config{sig_num}) {
517 my @names = split ' ', $Config{sig_name};
518 @sig_num{@names} = split ' ', $Config{sig_num};
520 $sig_name[$sig_num{$_}] ||= $_;
524 print "signal #17 = $sig_name[17]\n";
525 if ($sig_num{ALRM}) {
526 print "SIGALRM is $sig_num{ALRM}\n";
531 Because this information is not stored within the perl executable
532 itself it is possible (but unlikely) that the information does not
533 relate to the actual perl binary which is being used to access it.
535 The Config module is installed into the architecture and version
536 specific library directory ($Config{installarchlib}) and it checks the
537 perl version number when loaded.
539 The values stored in config.sh may be either single-quoted or
540 double-quoted. Double-quoted strings are handy for those cases where you
541 need to include escape sequences in the strings. To avoid runtime variable
542 interpolation, any C<$> and C<@> characters are replaced by C<\$> and
543 C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
544 or C<\@> in double-quoted strings unless you're willing to deal with the
545 consequences. (The slashes will end up escaped and the C<$> or C<@> will
546 trigger variable interpolation)
550 Most C<Config> variables are determined by the C<Configure> script
551 on platforms supported by it (which is most UNIX platforms). Some
552 platforms have custom-made C<Config> variables, and may thus not have
553 some of the variables described below, or may have extraneous variables
554 specific to that particular port. See the port specific documentation
559 if ($Opts{glossary}) {
560 open(GLOS, "<$Glossary") or die "Can't open $Glossary: $!";
567 if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
568 my $c = substr $1, 0, 1;
569 unless ($seen{$c}++) {
570 print CONFIG_POD <<EOF if $text;
574 print CONFIG_POD <<EOF;
583 elsif (!$text || !/\A\t/) {
584 warn "Expected a Configure variable header",
585 ($text ? " or another paragraph of description" : () );
587 s/n't/n\00t/g; # leave can't, won't etc untouched
588 s/^\t\s+(.*)/\n$1/gm; # Indented lines ===> new paragraph
589 s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text
590 s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
591 s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
592 s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
594 (?<! [\w./<\'\"] ) # Only standalone file names
595 (?! e \. g \. ) # Not e.g.
596 (?! \. \. \. ) # Not ...
598 (?! read/ ) # Not read/write
599 (?! etc\. ) # Not etc.
602 \$ ? # Allow leading $
603 [\w./]* [./] [\w./]* # Require . or / inside
605 (?<! \. (?= [\s)] ) ) # Do not include trailing dot
606 (?! [\w/] ) # Include all of it
608 (F<$1>)xg; # /usr/local
609 s/((?<=\s)~\w*)/F<$1>/g; # ~name
610 s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD
611 s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
612 s/n[\0]t/n't/g; # undo can't, won't damage
615 if ($Opts{glossary}) {
616 <GLOS>; # Skip the "DO NOT EDIT"
617 <GLOS>; # Skip the preamble
624 print CONFIG_POD <<'ENDOFTAIL';
630 This module contains a good example of how to use tie to implement a
631 cache and an example of how to make a tied variable readonly to those
642 # Now create Cross.pm if needed
644 open CROSS, ">lib/Cross.pm" or die "Can not open >lib/Cross.pm: $!";
646 # typical invocation:
647 # perl -MCross Makefile.PL
648 # perl -MCross=wince -V:cc
652 my ($package,$platform) = @_;
653 unless (defined $platform) {
654 # if $platform is not specified, then use last one when
655 # 'configpm; was invoked with --cross option
656 $platform = '***replace-marker***';
658 @INC = map {/\blib\b/?(do{local $_=$_;s/\blib\b/xlib\/$platform/;$_},$_):($_)} @INC;
659 $::Cross::platform = $platform;
664 $cross =~ s/\*\*\*replace-marker\*\*\*/$Opts{cross}/g;
669 # Now do some simple tests on the Config.pm file we have created
674 die "$0: $Config_PM not valid"
675 unless $Config{'PERL_CONFIG_SH'} eq 'true';
677 die "$0: error processing $Config_PM"
678 if defined($Config{'an impossible name'})
679 or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache
682 die "$0: error processing $Config_PM"
683 if eval '$Config{"cc"} = 1'
684 or eval 'delete $Config{"cc"}'