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