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