This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add \o{} escape
[perl5.git] / configpm
... / ...
CommitLineData
1#!./miniperl -w
2#
3# configpm
4#
5# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
6# 2002, 2003, 2004, 2005, 2006, 2007 Larry Wall and others.
7#
8#
9# Regenerate the files
10#
11# lib/Config.pm
12# lib/Config_heavy.pl
13# lib/Config.pod
14# lib/Cross.pm (optionally)
15#
16#
17# from the contents of the static files
18#
19# Porting/Glossary
20# myconfig.SH
21#
22# and from the contents of the Configure-generated file
23#
24# config.sh
25#
26# Note that output directory is xlib/[cross-name]/ for cross-compiling
27#
28# It will only update Config.pm and Config_heavy.pl if the contents of
29# either file would be different. Note that *both* files are updated in
30# this case, since for example an extension makefile that has a dependency
31# on Config.pm should trigger even if only Config_heavy.pl has changed.
32
33sub usage { die <<EOF }
34usage: $0 [ options ]
35 --cross=PLATFORM cross-compile for a different platform
36 --no-glossary don't include Porting/Glossary in lib/Config.pod
37 --chdir=dir change directory before writing files
38EOF
39
40use strict;
41use vars qw(%Config $Config_SH_expanded);
42
43my $how_many_common = 22;
44
45# commonly used names to precache (and hence lookup fastest)
46my %Common;
47
48while ($how_many_common--) {
49 $_ = <DATA>;
50 chomp;
51 /^(\S+):\s*(\d+)$/ or die "Malformed line '$_'";
52 $Common{$1} = $1;
53}
54
55# names of things which may need to have slashes changed to double-colons
56my %Extensions = map {($_,$_)}
57 qw(dynamic_ext static_ext extensions known_extensions);
58
59# allowed opts as well as specifies default and initial values
60my %Allowed_Opts = (
61 'cross' => '', # --cross=PLATFORM - crosscompiling for PLATFORM
62 'glossary' => 1, # --no-glossary - no glossary file inclusion,
63 # for compactness
64 'chdir' => '', # --chdir=dir - change directory before writing files
65);
66
67sub opts {
68 # user specified options
69 my %given_opts = (
70 # --opt=smth
71 (map {/^--([\-_\w]+)=(.*)$/} @ARGV),
72 # --opt --no-opt --noopt
73 (map {/^no-?(.*)$/i?($1=>0):($_=>1)} map {/^--([\-_\w]+)$/} @ARGV),
74 );
75
76 my %opts = (%Allowed_Opts, %given_opts);
77
78 for my $opt (grep {!exists $Allowed_Opts{$_}} keys %given_opts) {
79 warn "option '$opt' is not recognized";
80 usage;
81 }
82 @ARGV = grep {!/^--/} @ARGV;
83
84 return %opts;
85}
86
87
88my %Opts = opts();
89
90if ($Opts{chdir}) {
91 chdir $Opts{chdir} or die "$0: could not chdir $Opts{chdir}: $!"
92}
93
94my ($Config_SH, $Config_PM, $Config_heavy, $Config_POD);
95my $Glossary = 'Porting/Glossary';
96
97if ($Opts{cross}) {
98 # creating cross-platform config file
99 mkdir "xlib";
100 mkdir "xlib/$Opts{cross}";
101 $Config_PM = "xlib/$Opts{cross}/Config.pm";
102 $Config_POD = "xlib/$Opts{cross}/Config.pod";
103 $Config_SH = "Cross/config-$Opts{cross}.sh";
104}
105else {
106 $Config_PM = "lib/Config.pm";
107 $Config_POD = "lib/Config.pod";
108 $Config_SH = "config.sh";
109}
110($Config_heavy = $Config_PM) =~ s/\.pm$/_heavy.pl/;
111die "Can't automatically determine name for Config_heavy.pl from '$Config_PM'"
112 if $Config_heavy eq $Config_PM;
113
114my $config_txt;
115my $heavy_txt;
116
117$heavy_txt .= <<'ENDOFBEG';
118# This file was created by configpm when Perl was built. Any changes
119# made to this file will be lost the next time perl is built.
120
121package Config;
122use strict;
123# use warnings; Pulls in Carp
124# use vars pulls in Carp
125
126sub _V {
127 my ($bincompat, $non_bincompat, $date, @patches) = Internals::V();
128
129 my $opts = join ' ', sort split ' ', "$bincompat $non_bincompat";
130
131 # wrap at 76 columns.
132
133 $opts =~ s/(?=.{53})(.{1,53}) /$1\n /mg;
134
135 print Config::myconfig();
136 if ($^O eq 'VMS') {
137 print "\nCharacteristics of this PERLSHR image: \n";
138 } else {
139 print "\nCharacteristics of this binary (from libperl): \n";
140 }
141
142 print " Compile-time options: $opts\n";
143
144 if (@patches) {
145 print " Locally applied patches:\n";
146 print "\t$_\n" foreach @patches;
147 }
148
149 print " Built under $^O\n";
150
151 print " $date\n" if defined $date;
152
153 my @env = map { "$_=\"$ENV{$_}\"" } sort grep {/^PERL/} keys %ENV;
154 push @env, "CYGWIN=\"$ENV{CYGWIN}\"" if $^O eq 'cygwin';
155
156 if (@env) {
157 print " \%ENV:\n";
158 print " $_\n" foreach @env;
159 }
160 print " \@INC:\n";
161 print " $_\n" foreach @INC;
162}
163
164ENDOFBEG
165
166my $myver = sprintf "%vd", $^V;
167
168$config_txt .= sprintf <<'ENDOFBEG', ($myver) x 3;
169# This file was created by configpm when Perl was built. Any changes
170# made to this file will be lost the next time perl is built.
171
172# for a description of the variables, please have a look at the
173# Glossary file, as written in the Porting folder, or use the url:
174# http://perl5.git.perl.org/perl.git/blob/HEAD:/Porting/Glossary
175
176package Config;
177use strict;
178# use warnings; Pulls in Carp
179# use vars pulls in Carp
180@Config::EXPORT = qw(%%Config);
181@Config::EXPORT_OK = qw(myconfig config_sh config_vars config_re);
182
183# Need to stub all the functions to make code such as print Config::config_sh
184# keep working
185
186sub myconfig;
187sub config_sh;
188sub config_vars;
189sub config_re;
190
191# Skip @Config::EXPORT because it only contains %%Config, which we special
192# case below as it's not a function. @Config::EXPORT won't change in the
193# lifetime of Perl 5.
194my %%Export_Cache = map {($_ => 1)} @Config::EXPORT_OK;
195
196our %%Config;
197
198# Define our own import method to avoid pulling in the full Exporter:
199sub import {
200 shift;
201 @_ = @Config::EXPORT unless @_;
202
203 my @funcs = grep $_ ne '%%Config', @_;
204 my $export_Config = @funcs < @_ ? 1 : 0;
205
206 no strict 'refs';
207 my $callpkg = caller(0);
208 foreach my $func (@funcs) {
209 die qq{"$func" is not exported by the Config module\n}
210 unless $Export_Cache{$func};
211 *{$callpkg.'::'.$func} = \&{$func};
212 }
213
214 *{"$callpkg\::Config"} = \%%Config if $export_Config;
215 return;
216}
217
218die "Perl lib version (%s) doesn't match executable version ($])"
219 unless $^V;
220
221$^V eq %s
222 or die "Perl lib version (%s) doesn't match executable version (" .
223 sprintf("v%%vd",$^V) . ")";
224
225ENDOFBEG
226
227
228my @non_v = ();
229my @v_others = ();
230my $in_v = 0;
231my %Data = ();
232
233
234my %seen_quotes;
235{
236 my ($name, $val);
237 open(CONFIG_SH, $Config_SH) || die "Can't open $Config_SH: $!";
238 while (<CONFIG_SH>) {
239 next if m:^#!/bin/sh:;
240
241 # Catch PERL_CONFIG_SH=true and PERL_VERSION=n line from Configure.
242 s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/ or m/^(\w+)='(.*)'$/;
243 my($k, $v) = ($1, $2);
244
245 # grandfather PATCHLEVEL and SUBVERSION and CONFIG
246 if ($k) {
247 if ($k eq 'PERL_VERSION') {
248 push @v_others, "PATCHLEVEL='$v'\n";
249 }
250 elsif ($k eq 'PERL_SUBVERSION') {
251 push @v_others, "SUBVERSION='$v'\n";
252 }
253 elsif ($k eq 'PERL_CONFIG_SH') {
254 push @v_others, "CONFIG='$v'\n";
255 }
256 }
257
258 # We can delimit things in config.sh with either ' or ".
259 unless ($in_v or m/^(\w+)=(['"])(.*\n)/){
260 push(@non_v, "#$_"); # not a name='value' line
261 next;
262 }
263 my $quote = $2;
264 if ($in_v) {
265 $val .= $_;
266 }
267 else {
268 ($name,$val) = ($1,$3);
269 }
270 $in_v = $val !~ /$quote\n/;
271 next if $in_v;
272
273 s,/,::,g if $Extensions{$name};
274
275 $val =~ s/$quote\n?\z//;
276
277 my $line = "$name=$quote$val$quote\n";
278 push(@v_others, $line);
279 $seen_quotes{$quote}++;
280 }
281 close CONFIG_SH;
282}
283
284# This is somewhat grim, but I want the code for parsing config.sh here and
285# now so that I can expand $Config{ivsize} and $Config{ivtype}
286
287my $fetch_string = <<'EOT';
288
289# Search for it in the big string
290sub fetch_string {
291 my($self, $key) = @_;
292
293EOT
294
295if ($seen_quotes{'"'}) {
296 # We need the full ' and " code
297
298$fetch_string .= <<'EOT';
299 return undef unless my ($quote_type, $value) = $Config_SH_expanded =~ /\n$key=(['"])(.*?)\1\n/s;
300
301 # If we had a double-quote, we'd better eval it so escape
302 # sequences and such can be interpolated. Since the incoming
303 # value is supposed to follow shell rules and not perl rules,
304 # we escape any perl variable markers
305
306 # Historically, since " 'support' was added in change 1409, the
307 # interpolation was done before the undef. Stick to this arguably buggy
308 # behaviour as we're refactoring.
309 if ($quote_type eq '"') {
310 $value =~ s/\$/\\\$/g;
311 $value =~ s/\@/\\\@/g;
312 eval "\$value = \"$value\"";
313 }
314
315 # So we can say "if $Config{'foo'}".
316 $self->{$key} = $value eq 'undef' ? undef : $value; # cache it
317}
318EOT
319
320} else {
321 # We only have ' delimted.
322
323$fetch_string .= <<'EOT';
324 return undef unless $Config_SH_expanded =~ /\n$key=\'(.*?)\'\n/s;
325 # So we can say "if $Config{'foo'}".
326 $self->{$key} = $1 eq 'undef' ? undef : $1;
327}
328EOT
329
330}
331
332eval $fetch_string;
333die if $@;
334
335# Calculation for the keys for byteorder
336# This is somewhat grim, but I need to run fetch_string here.
337our $Config_SH_expanded = join "\n", '', @v_others;
338
339my $t = fetch_string ({}, 'ivtype');
340my $s = fetch_string ({}, 'ivsize');
341
342# byteorder does exist on its own but we overlay a virtual
343# dynamically recomputed value.
344
345# However, ivtype and ivsize will not vary for sane fat binaries
346
347my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
348
349my $byteorder_code;
350if ($s == 4 || $s == 8) {
351 my $list = join ',', reverse(2..$s);
352 my $format = 'a'x$s;
353 $byteorder_code = <<"EOT";
354
355my \$i = 0;
356foreach my \$c ($list) { \$i |= ord(\$c); \$i <<= 8 }
357\$i |= ord(1);
358our \$byteorder = join('', unpack('$format', pack('$f', \$i)));
359EOT
360} else {
361 $byteorder_code = "our \$byteorder = '?'x$s;\n";
362}
363
364my @need_relocation;
365
366if (fetch_string({},'userelocatableinc')) {
367 foreach my $what (qw(prefixexp
368
369 archlibexp
370 html1direxp
371 html3direxp
372 man1direxp
373 man3direxp
374 privlibexp
375 scriptdirexp
376 sitearchexp
377 sitebinexp
378 sitehtml1direxp
379 sitehtml3direxp
380 sitelibexp
381 siteman1direxp
382 siteman3direxp
383 sitescriptexp
384 vendorarchexp
385 vendorbinexp
386 vendorhtml1direxp
387 vendorhtml3direxp
388 vendorlibexp
389 vendorman1direxp
390 vendorman3direxp
391 vendorscriptexp
392
393 siteprefixexp
394 sitelib_stem
395 vendorlib_stem
396
397 installarchlib
398 installhtml1dir
399 installhtml3dir
400 installman1dir
401 installman3dir
402 installprefix
403 installprefixexp
404 installprivlib
405 installscript
406 installsitearch
407 installsitebin
408 installsitehtml1dir
409 installsitehtml3dir
410 installsitelib
411 installsiteman1dir
412 installsiteman3dir
413 installsitescript
414 installvendorarch
415 installvendorbin
416 installvendorhtml1dir
417 installvendorhtml3dir
418 installvendorlib
419 installvendorman1dir
420 installvendorman3dir
421 installvendorscript
422 )) {
423 push @need_relocation, $what if fetch_string({}, $what) =~ m!^\.\.\./!;
424 }
425}
426
427my %need_relocation;
428@need_relocation{@need_relocation} = @need_relocation;
429
430# This can have .../ anywhere:
431if (fetch_string({}, 'otherlibdirs') =~ m!\.\.\./!) {
432 $need_relocation{otherlibdirs} = 'otherlibdirs';
433}
434
435my $relocation_code = <<'EOT';
436
437sub relocate_inc {
438 my $libdir = shift;
439 return $libdir unless $libdir =~ s!^\.\.\./!!;
440 my $prefix = $^X;
441 if ($prefix =~ s!/[^/]*$!!) {
442 while ($libdir =~ m!^\.\./!) {
443 # Loop while $libdir starts "../" and $prefix still has a trailing
444 # directory
445 last unless $prefix =~ s!/([^/]+)$!!;
446 # but bail out if the directory we picked off the end of $prefix is .
447 # or ..
448 if ($1 eq '.' or $1 eq '..') {
449 # Undo! This should be rare, hence code it this way rather than a
450 # check each time before the s!!! above.
451 $prefix = "$prefix/$1";
452 last;
453 }
454 # Remove that leading ../ and loop again
455 substr ($libdir, 0, 3, '');
456 }
457 $libdir = "$prefix/$libdir";
458 }
459 $libdir;
460}
461EOT
462
463if (%need_relocation) {
464 my $relocations_in_common;
465 # otherlibdirs only features in the hash
466 foreach (keys %need_relocation) {
467 $relocations_in_common++ if $Common{$_};
468 }
469 if ($relocations_in_common) {
470 $config_txt .= $relocation_code;
471 } else {
472 $heavy_txt .= $relocation_code;
473 }
474}
475
476$heavy_txt .= join('', @non_v) . "\n";
477
478# copy config summary format from the myconfig.SH script
479$heavy_txt .= "our \$summary = <<'!END!';\n";
480open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
4811 while defined($_ = <MYCONFIG>) && !/^Summary of/;
482do { $heavy_txt .= $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
483close(MYCONFIG);
484
485$heavy_txt .= "\n!END!\n" . <<'EOT';
486my $summary_expanded;
487
488sub myconfig {
489 return $summary_expanded if $summary_expanded;
490 ($summary_expanded = $summary) =~ s{\$(\w+)}
491 {
492 my $c;
493 if ($1 eq 'git_ancestor_line') {
494 if ($Config::Config{git_ancestor}) {
495 $c= "\n Ancestor: $Config::Config{git_ancestor}";
496 } else {
497 $c= "";
498 }
499 } else {
500 $c = $Config::Config{$1};
501 }
502 defined($c) ? $c : 'undef'
503 }ge;
504 $summary_expanded;
505}
506
507local *_ = \my $a;
508$_ = <<'!END!';
509EOT
510
511$heavy_txt .= join('', sort @v_others) . "!END!\n";
512
513# Only need the dynamic byteorder code in Config.pm if 'byteorder' is one of
514# the precached keys
515if ($Common{byteorder}) {
516 $config_txt .= $byteorder_code;
517} else {
518 $heavy_txt .= $byteorder_code;
519}
520
521if (@need_relocation) {
522$heavy_txt .= 'foreach my $what (qw(' . join (' ', @need_relocation) .
523 ")) {\n" . <<'EOT';
524 s/^($what=)(['"])(.*?)\2/$1 . $2 . relocate_inc($3) . $2/me;
525}
526EOT
527# Currently it only makes sense to do the ... relocation on Unix, so there's
528# no need to emulate the "which separator for this platform" logic in perl.c -
529# ':' will always be applicable
530if ($need_relocation{otherlibdirs}) {
531$heavy_txt .= << 'EOT';
532s{^(otherlibdirs=)(['"])(.*?)\2}
533 {$1 . $2 . join ':', map {relocate_inc($_)} split ':', $3 . $2}me;
534EOT
535}
536}
537
538$heavy_txt .= <<'EOT';
539s/(byteorder=)(['"]).*?\2/$1$2$Config::byteorder$2/m;
540
541my $config_sh_len = length $_;
542
543our $Config_SH_expanded = "\n$_" . << 'EOVIRTUAL';
544EOT
545
546foreach my $prefix (qw(ccflags ldflags)) {
547 my $value = fetch_string ({}, $prefix);
548 my $withlargefiles = fetch_string ({}, $prefix . "_uselargefiles");
549 if (defined $withlargefiles) {
550 $value =~ s/\Q$withlargefiles\E\b//;
551 $heavy_txt .= "${prefix}_nolargefiles='$value'\n";
552 }
553}
554
555foreach my $prefix (qw(libs libswanted)) {
556 my $value = fetch_string ({}, $prefix);
557 my $withlf = fetch_string ({}, 'libswanted_uselargefiles');
558 next unless defined $withlf;
559 my @lflibswanted
560 = split(' ', fetch_string ({}, 'libswanted_uselargefiles'));
561 if (@lflibswanted) {
562 my %lflibswanted;
563 @lflibswanted{@lflibswanted} = ();
564 if ($prefix eq 'libs') {
565 my @libs = grep { /^-l(.+)/ &&
566 not exists $lflibswanted{$1} }
567 split(' ', fetch_string ({}, 'libs'));
568 $value = join(' ', @libs);
569 } else {
570 my @libswanted = grep { not exists $lflibswanted{$_} }
571 split(' ', fetch_string ({}, 'libswanted'));
572 $value = join(' ', @libswanted);
573 }
574 }
575 $heavy_txt .= "${prefix}_nolargefiles='$value'\n";
576}
577
578$heavy_txt .= "EOVIRTUAL\n";
579
580$heavy_txt .= <<'ENDOFGIT';
581eval {
582 # do not have hairy conniptions if this isnt available
583 require 'Config_git.pl';
584 $Config_SH_expanded .= $Config::Git_Data;
585 1;
586} or warn "Warning: failed to load Config_git.pl, something strange about this perl...\n";
587ENDOFGIT
588
589$heavy_txt .= $fetch_string;
590
591$config_txt .= <<'ENDOFEND';
592
593sub FETCH {
594 my($self, $key) = @_;
595
596 # check for cached value (which may be undef so we use exists not defined)
597 return $self->{$key} if exists $self->{$key};
598
599 return $self->fetch_string($key);
600}
601ENDOFEND
602
603$heavy_txt .= <<'ENDOFEND';
604
605my $prevpos = 0;
606
607sub FIRSTKEY {
608 $prevpos = 0;
609 substr($Config_SH_expanded, 1, index($Config_SH_expanded, '=') - 1 );
610}
611
612sub NEXTKEY {
613ENDOFEND
614if ($seen_quotes{'"'}) {
615$heavy_txt .= <<'ENDOFEND';
616 # Find out how the current key's quoted so we can skip to its end.
617 my $quote = substr($Config_SH_expanded,
618 index($Config_SH_expanded, "=", $prevpos)+1, 1);
619 my $pos = index($Config_SH_expanded, qq($quote\n), $prevpos) + 2;
620ENDOFEND
621} else {
622 # Just ' quotes, so it's much easier.
623$heavy_txt .= <<'ENDOFEND';
624 my $pos = index($Config_SH_expanded, qq('\n), $prevpos) + 2;
625ENDOFEND
626}
627$heavy_txt .= <<'ENDOFEND';
628 my $len = index($Config_SH_expanded, "=", $pos) - $pos;
629 $prevpos = $pos;
630 $len > 0 ? substr($Config_SH_expanded, $pos, $len) : undef;
631}
632
633sub EXISTS {
634 return 1 if exists($_[0]->{$_[1]});
635
636 return(index($Config_SH_expanded, "\n$_[1]='") != -1
637ENDOFEND
638if ($seen_quotes{'"'}) {
639$heavy_txt .= <<'ENDOFEND';
640 or index($Config_SH_expanded, "\n$_[1]=\"") != -1
641ENDOFEND
642}
643$heavy_txt .= <<'ENDOFEND';
644 );
645}
646
647sub STORE { die "\%Config::Config is read-only\n" }
648*DELETE = \&STORE;
649*CLEAR = \&STORE;
650
651
652sub config_sh {
653 substr $Config_SH_expanded, 1, $config_sh_len;
654}
655
656sub config_re {
657 my $re = shift;
658 return map { chomp; $_ } grep eval{ /^(?:$re)=/ }, split /^/,
659 $Config_SH_expanded;
660}
661
662sub config_vars {
663 # implements -V:cfgvar option (see perlrun -V:)
664 foreach (@_) {
665 # find optional leading, trailing colons; and query-spec
666 my ($notag,$qry,$lncont) = m/^(:)?(.*?)(:)?$/; # flags fore and aft,
667 # map colon-flags to print decorations
668 my $prfx = $notag ? '': "$qry="; # tag-prefix for print
669 my $lnend = $lncont ? ' ' : ";\n"; # line ending for print
670
671 # all config-vars are by definition \w only, any \W means regex
672 if ($qry =~ /\W/) {
673 my @matches = config_re($qry);
674 print map "$_$lnend", @matches ? @matches : "$qry: not found" if !$notag;
675 print map { s/\w+=//; "$_$lnend" } @matches ? @matches : "$qry: not found" if $notag;
676 } else {
677 my $v = (exists $Config::Config{$qry}) ? $Config::Config{$qry}
678 : 'UNKNOWN';
679 $v = 'undef' unless defined $v;
680 print "${prfx}'${v}'$lnend";
681 }
682 }
683}
684
685# Called by the real AUTOLOAD
686sub launcher {
687 undef &AUTOLOAD;
688 goto \&$Config::AUTOLOAD;
689}
690
6911;
692ENDOFEND
693
694if ($^O eq 'os2') {
695 $config_txt .= <<'ENDOFSET';
696my %preconfig;
697if ($OS2::is_aout) {
698 my ($value, $v) = $Config_SH_expanded =~ m/^used_aout='(.*)'\s*$/m;
699 for (split ' ', $value) {
700 ($v) = $Config_SH_expanded =~ m/^aout_$_='(.*)'\s*$/m;
701 $preconfig{$_} = $v eq 'undef' ? undef : $v;
702 }
703}
704$preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't
705sub TIEHASH { bless {%preconfig} }
706ENDOFSET
707 # Extract the name of the DLL from the makefile to avoid duplication
708 my ($f) = grep -r, qw(GNUMakefile Makefile);
709 my $dll;
710 if (open my $fh, '<', $f) {
711 while (<$fh>) {
712 $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
713 }
714 }
715 $config_txt .= <<ENDOFSET if $dll;
716\$preconfig{dll_name} = '$dll';
717ENDOFSET
718} else {
719 $config_txt .= <<'ENDOFSET';
720sub TIEHASH {
721 bless $_[1], $_[0];
722}
723ENDOFSET
724}
725
726foreach my $key (keys %Common) {
727 my $value = fetch_string ({}, $key);
728 # Is it safe on the LHS of => ?
729 my $qkey = $key =~ /^[A-Za-z_][A-Za-z0-9_]*$/ ? $key : "'$key'";
730 if (defined $value) {
731 # Quote things for a '' string
732 $value =~ s!\\!\\\\!g;
733 $value =~ s!'!\\'!g;
734 $value = "'$value'";
735 if ($key eq 'otherlibdirs') {
736 $value = "join (':', map {relocate_inc(\$_)} split (':', $value))";
737 } elsif ($need_relocation{$key}) {
738 $value = "relocate_inc($value)";
739 }
740 } else {
741 $value = "undef";
742 }
743 $Common{$key} = "$qkey => $value";
744}
745
746if ($Common{byteorder}) {
747 $Common{byteorder} = 'byteorder => $byteorder';
748}
749my $fast_config = join '', map { " $_,\n" } sort values %Common;
750
751# Sanity check needed to stop an infite loop if Config_heavy.pl fails to define
752# &launcher for some reason (eg it got truncated)
753$config_txt .= sprintf <<'ENDOFTIE', $fast_config;
754
755sub DESTROY { }
756
757sub AUTOLOAD {
758 require 'Config_heavy.pl';
759 goto \&launcher unless $Config::AUTOLOAD =~ /launcher$/;
760 die "&Config::AUTOLOAD failed on $Config::AUTOLOAD";
761}
762
763# tie returns the object, so the value returned to require will be true.
764tie %%Config, 'Config', {
765%s};
766ENDOFTIE
767
768
769open(CONFIG_POD, ">$Config_POD") or die "Can't open $Config_POD: $!";
770print CONFIG_POD <<'ENDOFTAIL';
771=head1 NAME
772
773Config - access Perl configuration information
774
775=head1 SYNOPSIS
776
777 use Config;
778 if ($Config{usethreads}) {
779 print "has thread support\n"
780 }
781
782 use Config qw(myconfig config_sh config_vars config_re);
783
784 print myconfig();
785
786 print config_sh();
787
788 print config_re();
789
790 config_vars(qw(osname archname));
791
792
793=head1 DESCRIPTION
794
795The Config module contains all the information that was available to
796the C<Configure> program at Perl build time (over 900 values).
797
798Shell variables from the F<config.sh> file (written by Configure) are
799stored in the readonly-variable C<%Config>, indexed by their names.
800
801Values stored in config.sh as 'undef' are returned as undefined
802values. The perl C<exists> function can be used to check if a
803named variable exists.
804
805For a description of the variables, please have a look at the
806Glossary file, as written in the Porting folder, or use the url:
807http://perl5.git.perl.org/perl.git/blob/HEAD:/Porting/Glossary
808
809=over 4
810
811=item myconfig()
812
813Returns a textual summary of the major perl configuration values.
814See also C<-V> in L<perlrun/Switches>.
815
816=item config_sh()
817
818Returns the entire perl configuration information in the form of the
819original config.sh shell variable assignment script.
820
821=item config_re($regex)
822
823Like config_sh() but returns, as a list, only the config entries who's
824names match the $regex.
825
826=item config_vars(@names)
827
828Prints to STDOUT the values of the named configuration variable. Each is
829printed on a separate line in the form:
830
831 name='value';
832
833Names which are unknown are output as C<name='UNKNOWN';>.
834See also C<-V:name> in L<perlrun/Switches>.
835
836=back
837
838=head1 EXAMPLE
839
840Here's a more sophisticated example of using %Config:
841
842 use Config;
843 use strict;
844
845 my %sig_num;
846 my @sig_name;
847 unless($Config{sig_name} && $Config{sig_num}) {
848 die "No sigs?";
849 } else {
850 my @names = split ' ', $Config{sig_name};
851 @sig_num{@names} = split ' ', $Config{sig_num};
852 foreach (@names) {
853 $sig_name[$sig_num{$_}] ||= $_;
854 }
855 }
856
857 print "signal #17 = $sig_name[17]\n";
858 if ($sig_num{ALRM}) {
859 print "SIGALRM is $sig_num{ALRM}\n";
860 }
861
862=head1 WARNING
863
864Because this information is not stored within the perl executable
865itself it is possible (but unlikely) that the information does not
866relate to the actual perl binary which is being used to access it.
867
868The Config module is installed into the architecture and version
869specific library directory ($Config{installarchlib}) and it checks the
870perl version number when loaded.
871
872The values stored in config.sh may be either single-quoted or
873double-quoted. Double-quoted strings are handy for those cases where you
874need to include escape sequences in the strings. To avoid runtime variable
875interpolation, any C<$> and C<@> characters are replaced by C<\$> and
876C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
877or C<\@> in double-quoted strings unless you're willing to deal with the
878consequences. (The slashes will end up escaped and the C<$> or C<@> will
879trigger variable interpolation)
880
881=head1 GLOSSARY
882
883Most C<Config> variables are determined by the C<Configure> script
884on platforms supported by it (which is most UNIX platforms). Some
885platforms have custom-made C<Config> variables, and may thus not have
886some of the variables described below, or may have extraneous variables
887specific to that particular port. See the port specific documentation
888in such cases.
889
890=cut
891
892ENDOFTAIL
893
894if ($Opts{glossary}) {
895 open(GLOS, "<$Glossary") or die "Can't open $Glossary: $!";
896}
897my %seen = ();
898my $text = 0;
899$/ = '';
900
901sub process {
902 if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
903 my $c = substr $1, 0, 1;
904 unless ($seen{$c}++) {
905 print CONFIG_POD <<EOF if $text;
906=back
907
908=cut
909
910EOF
911 print CONFIG_POD <<EOF;
912=head2 $c
913
914=over 4
915
916=cut
917
918EOF
919 $text = 1;
920 }
921 }
922 elsif (!$text || !/\A\t/) {
923 warn "Expected a Configure variable header",
924 ($text ? " or another paragraph of description" : () );
925 }
926 s/n't/n\00t/g; # leave can't, won't etc untouched
927 s/^\t\s+(.*)/\n$1/gm; # Indented lines ===> new paragraph
928 s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text
929 s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
930 s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
931 s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
932 s{
933 (?<! [\w./<\'\"] ) # Only standalone file names
934 (?! e \. g \. ) # Not e.g.
935 (?! \. \. \. ) # Not ...
936 (?! \d ) # Not 5.004
937 (?! read/ ) # Not read/write
938 (?! etc\. ) # Not etc.
939 (?! I/O ) # Not I/O
940 (
941 \$ ? # Allow leading $
942 [\w./]* [./] [\w./]* # Require . or / inside
943 )
944 (?<! \. (?= [\s)] ) ) # Do not include trailing dot
945 (?! [\w/] ) # Include all of it
946 }
947 (F<$1>)xg; # /usr/local
948 s/((?<=\s)~\w*)/F<$1>/g; # ~name
949 s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD
950 s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
951 s/n[\0]t/n't/g; # undo can't, won't damage
952}
953
954if ($Opts{glossary}) {
955 <GLOS>; # Skip the "DO NOT EDIT"
956 <GLOS>; # Skip the preamble
957 while (<GLOS>) {
958 process;
959 print CONFIG_POD;
960 }
961}
962
963print CONFIG_POD <<'ENDOFTAIL';
964
965=back
966
967=head1 GIT DATA
968
969Information on the git commit from which the current perl binary was compiled
970can be found in the variable C<$Config::Git_Data>. The variable is a
971structured string that looks something like this:
972
973 git_commit_id='ea0c2dbd5f5ac6845ecc7ec6696415bf8e27bd52'
974 git_describe='GitLive-blead-1076-gea0c2db'
975 git_branch='smartmatch'
976 git_uncommitted_changes=''
977 git_commit_id_title='Commit id:'
978 git_commit_date='2009-05-09 17:47:31 +0200'
979
980Its format is not guaranteed not to change over time.
981
982=head1 NOTE
983
984This module contains a good example of how to use tie to implement a
985cache and an example of how to make a tied variable readonly to those
986outside of it.
987
988=cut
989
990ENDOFTAIL
991
992close(GLOS) if $Opts{glossary};
993close(CONFIG_POD);
994print "written $Config_POD\n";
995
996my $orig_config_txt = "";
997my $orig_heavy_txt = "";
998{
999 local $/;
1000 my $fh;
1001 $orig_config_txt = <$fh> if open $fh, "<", $Config_PM;
1002 $orig_heavy_txt = <$fh> if open $fh, "<", $Config_heavy;
1003}
1004
1005if ($orig_config_txt ne $config_txt or $orig_heavy_txt ne $heavy_txt) {
1006 open CONFIG, ">", $Config_PM or die "Can't open $Config_PM: $!\n";
1007 open CONFIG_HEAVY, ">", $Config_heavy or die "Can't open $Config_heavy: $!\n";
1008 print CONFIG $config_txt;
1009 print CONFIG_HEAVY $heavy_txt;
1010 close(CONFIG_HEAVY);
1011 close(CONFIG);
1012 print "updated $Config_PM\n";
1013 print "updated $Config_heavy\n";
1014}
1015
1016
1017# Now create Cross.pm if needed
1018if ($Opts{cross}) {
1019 open CROSS, ">lib/Cross.pm" or die "Can not open >lib/Cross.pm: $!";
1020 my $cross = <<'EOS';
1021# typical invocation:
1022# perl -MCross Makefile.PL
1023# perl -MCross=wince -V:cc
1024package Cross;
1025
1026sub import {
1027 my ($package,$platform) = @_;
1028 unless (defined $platform) {
1029 # if $platform is not specified, then use last one when
1030 # 'configpm; was invoked with --cross option
1031 $platform = '***replace-marker***';
1032 }
1033 @INC = map {/\blib\b/?(do{local $_=$_;s/\blib\b/xlib\/$platform/;$_},$_):($_)} @INC;
1034 $::Cross::platform = $platform;
1035}
1036
10371;
1038EOS
1039 $cross =~ s/\*\*\*replace-marker\*\*\*/$Opts{cross}/g;
1040 print CROSS $cross;
1041 close CROSS;
1042 print "written lib/Cross.pm\n";
1043 unshift(@INC,"xlib/$Opts{cross}");
1044}
1045
1046# Now do some simple tests on the Config.pm file we have created
1047unshift(@INC,'lib');
1048unshift(@INC,'xlib/symbian') if $Opts{cross};
1049require $Config_PM;
1050require $Config_heavy;
1051import Config;
1052
1053die "$0: $Config_PM not valid"
1054 unless $Config{'PERL_CONFIG_SH'} eq 'true';
1055
1056die "$0: error processing $Config_PM"
1057 if defined($Config{'an impossible name'})
1058 or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache
1059 ;
1060
1061die "$0: error processing $Config_PM"
1062 if eval '$Config{"cc"} = 1'
1063 or eval 'delete $Config{"cc"}'
1064 ;
1065
1066
1067exit 0;
1068# Popularity of various entries in %Config, based on a large build and test
1069# run of code in the Fotango build system:
1070__DATA__
1071path_sep: 8490
1072d_readlink: 7101
1073d_symlink: 7101
1074archlibexp: 4318
1075sitearchexp: 4305
1076sitelibexp: 4305
1077privlibexp: 4163
1078ldlibpthname: 4041
1079libpth: 2134
1080archname: 1591
1081exe_ext: 1256
1082scriptdir: 1155
1083version: 1116
1084useithreads: 1002
1085osvers: 982
1086osname: 851
1087inc_version_list: 783
1088dont_use_nlink: 779
1089intsize: 759
1090usevendorprefix: 642
1091dlsrc: 624
1092cc: 541
1093lib_ext: 520
1094so: 512
1095ld: 501
1096ccdlflags: 500
1097ldflags: 495
1098obj_ext: 495
1099cccdlflags: 493
1100lddlflags: 493
1101ar: 492
1102dlext: 492
1103libc: 492
1104ranlib: 492
1105full_ar: 491
1106vendorarchexp: 491
1107vendorlibexp: 491
1108installman1dir: 489
1109installman3dir: 489
1110installsitebin: 489
1111installsiteman1dir: 489
1112installsiteman3dir: 489
1113installvendorman1dir: 489
1114installvendorman3dir: 489
1115d_flexfnam: 474
1116eunicefix: 360
1117d_link: 347
1118installsitearch: 344
1119installscript: 341
1120installprivlib: 337
1121binexp: 336
1122installarchlib: 336
1123installprefixexp: 336
1124installsitelib: 336
1125installstyle: 336
1126installvendorarch: 336
1127installvendorbin: 336
1128installvendorlib: 336
1129man1ext: 336
1130man3ext: 336
1131sh: 336
1132siteprefixexp: 336
1133installbin: 335
1134usedl: 332
1135ccflags: 285
1136startperl: 232
1137optimize: 231
1138usemymalloc: 229
1139cpprun: 228
1140sharpbang: 228
1141perllibs: 225
1142usesfio: 224
1143usethreads: 220
1144perlpath: 218
1145extensions: 217
1146usesocks: 208
1147shellflags: 198
1148make: 191
1149d_pwage: 189
1150d_pwchange: 189
1151d_pwclass: 189
1152d_pwcomment: 189
1153d_pwexpire: 189
1154d_pwgecos: 189
1155d_pwpasswd: 189
1156d_pwquota: 189
1157gccversion: 189
1158libs: 186
1159useshrplib: 186
1160cppflags: 185
1161ptrsize: 185
1162shrpenv: 185
1163static_ext: 185
1164use5005threads: 185
1165uselargefiles: 185
1166alignbytes: 184
1167byteorder: 184
1168ccversion: 184
1169config_args: 184
1170cppminus: 184