This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
a6d6d0f14ba4acf8d25ceb71927b9fd4f565aaa4
[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 "v%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(archlib archlibexp
302                          privlib privlibexp
303                          sitearch sitearchexp
304                          sitelib sitelibexp
305                          sitelib_stem
306                          vendorarch vendorarchexp
307                          vendorlib vendorlibexp
308                          vendorlib_stem)) {
309         push @need_relocation, $what if fetch_string({}, $what) =~ m!^\.\.\./!;
310     }
311     # This can have .../ anywhere:
312     push @need_relocation, 'otherlibdirs'
313         if fetch_string({}, 'otherlibdirs') =~ m!\.\.\./!;
314 }
315
316 my %need_relocation;
317 @need_relocation{@need_relocation} = @need_relocation;
318
319 my $relocation_code = <<'EOT';
320
321 sub relocate_inc {
322   my $libdir = shift;
323   return $libdir unless $libdir =~ s!^\.\.\./!!;
324   my $prefix = $^X;
325   if ($prefix =~ s!/[^/]*$!!) {
326     while ($libdir =~ m!^\.\./!) {
327       # Loop while $libdir starts "../" and $prefix still has a trailing
328       # directory
329       last unless $prefix =~ s!/([^/]+)$!!;
330       # but bail out if the directory we picked off the end of $prefix is .
331       # or ..
332       if ($1 eq '.' or $1 eq '..') {
333         # Undo! This should be rare, hence code it this way rather than a
334         # check each time before the s!!! above.
335         $prefix = "$prefix/$1";
336         last;
337       }
338       # Remove that leading ../ and loop again
339       substr ($libdir, 0, 3, '');
340     }
341     $libdir = "$prefix/$libdir";
342   }
343   $libdir;
344 }
345 EOT
346
347 if (@need_relocation) {
348   my $relocations_in_common;
349   foreach (@need_relocation) {
350     $relocations_in_common++ if $Common{$_};
351   }
352   if ($relocations_in_common) {
353     print CONFIG $relocation_code;
354   } else {
355     print CONFIG_HEAVY $relocation_code;
356   }
357 }
358
359 print CONFIG_HEAVY @non_v, "\n";
360
361 # copy config summary format from the myconfig.SH script
362 print CONFIG_HEAVY "our \$summary : unique = <<'!END!';\n";
363 open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
364 1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
365 do { print CONFIG_HEAVY $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
366 close(MYCONFIG);
367
368 # NB. as $summary is unique, we need to copy it in a lexical variable
369 # before expanding it, because may have been made readonly if a perl
370 # interpreter has been cloned.
371
372 print CONFIG_HEAVY "\n!END!\n", <<'EOT';
373 my $summary_expanded;
374
375 sub myconfig {
376     return $summary_expanded if $summary_expanded;
377     ($summary_expanded = $summary) =~ s{\$(\w+)}
378                  { my $c = $Config::Config{$1}; defined($c) ? $c : 'undef' }ge;
379     $summary_expanded;
380 }
381
382 local *_ = \my $a;
383 $_ = <<'!END!';
384 EOT
385
386 print CONFIG_HEAVY join('', sort @v_others), "!END!\n";
387
388 # Only need the dynamic byteorder code in Config.pm if 'byteorder' is one of
389 # the precached keys
390 if ($Common{byteorder}) {
391     print CONFIG $byteorder_code;
392 } else {
393     print CONFIG_HEAVY $byteorder_code;
394 }
395
396 if (@need_relocation) {
397 print CONFIG_HEAVY 'foreach my $what (qw(', join (' ', @need_relocation),
398       ")) {\n", <<'EOT';
399     s/^($what=)(['"])(.*?)\2/$1 . $2 . relocate_inc($3) . $2/me;
400 }
401 EOT
402 }
403
404 print CONFIG_HEAVY <<'EOT';
405 s/(byteorder=)(['"]).*?\2/$1$2$Config::byteorder$2/m;
406
407 my $config_sh_len = length $_;
408
409 our $Config_SH_expanded : unique = "\n$_" . << 'EOVIRTUAL';
410 EOT
411
412 foreach my $prefix (qw(ccflags ldflags)) {
413     my $value = fetch_string ({}, $prefix);
414     my $withlargefiles = fetch_string ({}, $prefix . "_uselargefiles");
415     $value =~ s/\Q$withlargefiles\E\b//;
416     print CONFIG_HEAVY "${prefix}_nolargefiles='$value'\n";
417 }
418
419 foreach my $prefix (qw(libs libswanted)) {
420     my $value = fetch_string ({}, $prefix);
421     my @lflibswanted
422        = split(' ', fetch_string ({}, 'libswanted_uselargefiles'));
423     if (@lflibswanted) {
424         my %lflibswanted;
425         @lflibswanted{@lflibswanted} = ();
426         if ($prefix eq 'libs') {
427             my @libs = grep { /^-l(.+)/ &&
428                             not exists $lflibswanted{$1} }
429                                     split(' ', fetch_string ({}, 'libs'));
430             $value = join(' ', @libs);
431         } else {
432             my @libswanted = grep { not exists $lflibswanted{$_} }
433                                   split(' ', fetch_string ({}, 'libswanted'));
434             $value = join(' ', @libswanted);
435         }
436     }
437     print CONFIG_HEAVY "${prefix}_nolargefiles='$value'\n";
438 }
439
440 print CONFIG_HEAVY "EOVIRTUAL\n";
441
442 print CONFIG_HEAVY $fetch_string;
443
444 print CONFIG <<'ENDOFEND';
445
446 sub FETCH {
447     my($self, $key) = @_;
448
449     # check for cached value (which may be undef so we use exists not defined)
450     return $self->{$key} if exists $self->{$key};
451
452     return $self->fetch_string($key);
453 }
454 ENDOFEND
455
456 print CONFIG_HEAVY <<'ENDOFEND';
457
458 my $prevpos = 0;
459
460 sub FIRSTKEY {
461     $prevpos = 0;
462     substr($Config_SH_expanded, 1, index($Config_SH_expanded, '=') - 1 );
463 }
464
465 sub NEXTKEY {
466 ENDOFEND
467 if ($seen_quotes{'"'}) {
468 print CONFIG_HEAVY <<'ENDOFEND';
469     # Find out how the current key's quoted so we can skip to its end.
470     my $quote = substr($Config_SH_expanded,
471                        index($Config_SH_expanded, "=", $prevpos)+1, 1);
472     my $pos = index($Config_SH_expanded, qq($quote\n), $prevpos) + 2;
473 ENDOFEND
474 } else {
475     # Just ' quotes, so it's much easier.
476 print CONFIG_HEAVY <<'ENDOFEND';
477     my $pos = index($Config_SH_expanded, qq('\n), $prevpos) + 2;
478 ENDOFEND
479 }
480 print CONFIG_HEAVY <<'ENDOFEND';
481     my $len = index($Config_SH_expanded, "=", $pos) - $pos;
482     $prevpos = $pos;
483     $len > 0 ? substr($Config_SH_expanded, $pos, $len) : undef;
484 }
485
486 sub EXISTS {
487     return 1 if exists($_[0]->{$_[1]});
488
489     return(index($Config_SH_expanded, "\n$_[1]='") != -1
490 ENDOFEND
491 if ($seen_quotes{'"'}) {
492 print CONFIG_HEAVY <<'ENDOFEND';
493            or index($Config_SH_expanded, "\n$_[1]=\"") != -1
494 ENDOFEND
495 }
496 print CONFIG_HEAVY <<'ENDOFEND';
497           );
498 }
499
500 sub STORE  { die "\%Config::Config is read-only\n" }
501 *DELETE = \&STORE;
502 *CLEAR  = \&STORE;
503
504
505 sub config_sh {
506     substr $Config_SH_expanded, 1, $config_sh_len;
507 }
508
509 sub config_re {
510     my $re = shift;
511     return map { chomp; $_ } grep eval{ /^(?:$re)=/ }, split /^/,
512     $Config_SH_expanded;
513 }
514
515 sub config_vars {
516     # implements -V:cfgvar option (see perlrun -V:)
517     foreach (@_) {
518         # find optional leading, trailing colons; and query-spec
519         my ($notag,$qry,$lncont) = m/^(:)?(.*?)(:)?$/;  # flags fore and aft, 
520         # map colon-flags to print decorations
521         my $prfx = $notag ? '': "$qry=";                # tag-prefix for print
522         my $lnend = $lncont ? ' ' : ";\n";              # line ending for print
523
524         # all config-vars are by definition \w only, any \W means regex
525         if ($qry =~ /\W/) {
526             my @matches = config_re($qry);
527             print map "$_$lnend", @matches ? @matches : "$qry: not found"               if !$notag;
528             print map { s/\w+=//; "$_$lnend" } @matches ? @matches : "$qry: not found"  if  $notag;
529         } else {
530             my $v = (exists $Config::Config{$qry}) ? $Config::Config{$qry}
531                                                    : 'UNKNOWN';
532             $v = 'undef' unless defined $v;
533             print "${prfx}'${v}'$lnend";
534         }
535     }
536 }
537
538 # Called by the real AUTOLOAD
539 sub launcher {
540     undef &AUTOLOAD;
541     goto \&$Config::AUTOLOAD;
542 }
543
544 1;
545 ENDOFEND
546
547 if ($^O eq 'os2') {
548     print CONFIG <<'ENDOFSET';
549 my %preconfig;
550 if ($OS2::is_aout) {
551     my ($value, $v) = $Config_SH_expanded =~ m/^used_aout='(.*)'\s*$/m;
552     for (split ' ', $value) {
553         ($v) = $Config_SH_expanded =~ m/^aout_$_='(.*)'\s*$/m;
554         $preconfig{$_} = $v eq 'undef' ? undef : $v;
555     }
556 }
557 $preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't
558 sub TIEHASH { bless {%preconfig} }
559 ENDOFSET
560     # Extract the name of the DLL from the makefile to avoid duplication
561     my ($f) = grep -r, qw(GNUMakefile Makefile);
562     my $dll;
563     if (open my $fh, '<', $f) {
564         while (<$fh>) {
565             $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
566         }
567     }
568     print CONFIG <<ENDOFSET if $dll;
569 \$preconfig{dll_name} = '$dll';
570 ENDOFSET
571 } else {
572     print CONFIG <<'ENDOFSET';
573 sub TIEHASH {
574     bless $_[1], $_[0];
575 }
576 ENDOFSET
577 }
578
579 foreach my $key (keys %Common) {
580     my $value = fetch_string ({}, $key);
581     # Is it safe on the LHS of => ?
582     my $qkey = $key =~ /^[A-Za-z_][A-Za-z0-9_]*$/ ? $key : "'$key'";
583     if (defined $value) {
584         # Quote things for a '' string
585         $value =~ s!\\!\\\\!g;
586         $value =~ s!'!\\'!g;
587         $value = "'$value'";
588         if ($need_relocation{$key}) {
589             $value = "relocate_inc($value)";
590         }
591     } else {
592         $value = "undef";
593     }
594     $Common{$key} = "$qkey => $value";
595 }
596
597 if ($Common{byteorder}) {
598     $Common{byteorder} = 'byteorder => $byteorder';
599 }
600 my $fast_config = join '', map { "    $_,\n" } sort values %Common;
601
602 print CONFIG sprintf <<'ENDOFTIE', $fast_config;
603
604 sub DESTROY { }
605
606 sub AUTOLOAD {
607     require 'Config_heavy.pl';
608     goto \&launcher;
609     die "&Config::AUTOLOAD failed on $Config::AUTOLOAD";
610 }
611
612 tie %%Config, 'Config', {
613 %s};
614
615 1;
616 ENDOFTIE
617
618
619 open(CONFIG_POD, ">lib/Config.pod") or die "Can't open lib/Config.pod: $!";
620 print CONFIG_POD <<'ENDOFTAIL';
621 =head1 NAME
622
623 Config - access Perl configuration information
624
625 =head1 SYNOPSIS
626
627     use Config;
628     if ($Config{usethreads}) {
629         print "has thread support\n"
630     } 
631
632     use Config qw(myconfig config_sh config_vars config_re);
633
634     print myconfig();
635
636     print config_sh();
637
638     print config_re();
639
640     config_vars(qw(osname archname));
641
642
643 =head1 DESCRIPTION
644
645 The Config module contains all the information that was available to
646 the C<Configure> program at Perl build time (over 900 values).
647
648 Shell variables from the F<config.sh> file (written by Configure) are
649 stored in the readonly-variable C<%Config>, indexed by their names.
650
651 Values stored in config.sh as 'undef' are returned as undefined
652 values.  The perl C<exists> function can be used to check if a
653 named variable exists.
654
655 =over 4
656
657 =item myconfig()
658
659 Returns a textual summary of the major perl configuration values.
660 See also C<-V> in L<perlrun/Switches>.
661
662 =item config_sh()
663
664 Returns the entire perl configuration information in the form of the
665 original config.sh shell variable assignment script.
666
667 =item config_re($regex)
668
669 Like config_sh() but returns, as a list, only the config entries who's
670 names match the $regex.
671
672 =item config_vars(@names)
673
674 Prints to STDOUT the values of the named configuration variable. Each is
675 printed on a separate line in the form:
676
677   name='value';
678
679 Names which are unknown are output as C<name='UNKNOWN';>.
680 See also C<-V:name> in L<perlrun/Switches>.
681
682 =back
683
684 =head1 EXAMPLE
685
686 Here's a more sophisticated example of using %Config:
687
688     use Config;
689     use strict;
690
691     my %sig_num;
692     my @sig_name;
693     unless($Config{sig_name} && $Config{sig_num}) {
694         die "No sigs?";
695     } else {
696         my @names = split ' ', $Config{sig_name};
697         @sig_num{@names} = split ' ', $Config{sig_num};
698         foreach (@names) {
699             $sig_name[$sig_num{$_}] ||= $_;
700         }   
701     }
702
703     print "signal #17 = $sig_name[17]\n";
704     if ($sig_num{ALRM}) { 
705         print "SIGALRM is $sig_num{ALRM}\n";
706     }   
707
708 =head1 WARNING
709
710 Because this information is not stored within the perl executable
711 itself it is possible (but unlikely) that the information does not
712 relate to the actual perl binary which is being used to access it.
713
714 The Config module is installed into the architecture and version
715 specific library directory ($Config{installarchlib}) and it checks the
716 perl version number when loaded.
717
718 The values stored in config.sh may be either single-quoted or
719 double-quoted. Double-quoted strings are handy for those cases where you
720 need to include escape sequences in the strings. To avoid runtime variable
721 interpolation, any C<$> and C<@> characters are replaced by C<\$> and
722 C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
723 or C<\@> in double-quoted strings unless you're willing to deal with the
724 consequences. (The slashes will end up escaped and the C<$> or C<@> will
725 trigger variable interpolation)
726
727 =head1 GLOSSARY
728
729 Most C<Config> variables are determined by the C<Configure> script
730 on platforms supported by it (which is most UNIX platforms).  Some
731 platforms have custom-made C<Config> variables, and may thus not have
732 some of the variables described below, or may have extraneous variables
733 specific to that particular port.  See the port specific documentation
734 in such cases.
735
736 ENDOFTAIL
737
738 if ($Opts{glossary}) {
739   open(GLOS, "<$Glossary") or die "Can't open $Glossary: $!";
740 }
741 my %seen = ();
742 my $text = 0;
743 $/ = '';
744
745 sub process {
746   if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
747     my $c = substr $1, 0, 1;
748     unless ($seen{$c}++) {
749       print CONFIG_POD <<EOF if $text;
750 =back
751
752 EOF
753       print CONFIG_POD <<EOF;
754 =head2 $c
755
756 =over 4
757
758 EOF
759      $text = 1;
760     }
761   }
762   elsif (!$text || !/\A\t/) {
763     warn "Expected a Configure variable header",
764       ($text ? " or another paragraph of description" : () );
765   }
766   s/n't/n\00t/g;                # leave can't, won't etc untouched
767   s/^\t\s+(.*)/\n$1/gm;         # Indented lines ===> new paragraph
768   s/^(?<!\n\n)\t(.*)/$1/gm;     # Not indented lines ===> text
769   s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
770   s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
771   s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
772   s{
773      (?<! [\w./<\'\"] )         # Only standalone file names
774      (?! e \. g \. )            # Not e.g.
775      (?! \. \. \. )             # Not ...
776      (?! \d )                   # Not 5.004
777      (?! read/ )                # Not read/write
778      (?! etc\. )                # Not etc.
779      (?! I/O )                  # Not I/O
780      (
781         \$ ?                    # Allow leading $
782         [\w./]* [./] [\w./]*    # Require . or / inside
783      )
784      (?<! \. (?= [\s)] ) )      # Do not include trailing dot
785      (?! [\w/] )                # Include all of it
786    }
787    (F<$1>)xg;                   # /usr/local
788   s/((?<=\s)~\w*)/F<$1>/g;      # ~name
789   s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g;    # UNISTD
790   s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
791   s/n[\0]t/n't/g;               # undo can't, won't damage
792 }
793
794 if ($Opts{glossary}) {
795     <GLOS>;                             # Skip the "DO NOT EDIT"
796     <GLOS>;                             # Skip the preamble
797   while (<GLOS>) {
798     process;
799     print CONFIG_POD;
800   }
801 }
802
803 print CONFIG_POD <<'ENDOFTAIL';
804
805 =back
806
807 =head1 NOTE
808
809 This module contains a good example of how to use tie to implement a
810 cache and an example of how to make a tied variable readonly to those
811 outside of it.
812
813 =cut
814
815 ENDOFTAIL
816
817 close(CONFIG_HEAVY);
818 close(CONFIG);
819 close(GLOS);
820 close(CONFIG_POD);
821
822 # Now create Cross.pm if needed
823 if ($Opts{cross}) {
824   open CROSS, ">lib/Cross.pm" or die "Can not open >lib/Cross.pm: $!";
825   my $cross = <<'EOS';
826 # typical invocation:
827 #   perl -MCross Makefile.PL
828 #   perl -MCross=wince -V:cc
829 package Cross;
830
831 sub import {
832   my ($package,$platform) = @_;
833   unless (defined $platform) {
834     # if $platform is not specified, then use last one when
835     # 'configpm; was invoked with --cross option
836     $platform = '***replace-marker***';
837   }
838   @INC = map {/\blib\b/?(do{local $_=$_;s/\blib\b/xlib\/$platform/;$_},$_):($_)} @INC;
839   $::Cross::platform = $platform;
840 }
841
842 1;
843 EOS
844   $cross =~ s/\*\*\*replace-marker\*\*\*/$Opts{cross}/g;
845   print CROSS $cross;
846   close CROSS;
847 }
848
849 # Now do some simple tests on the Config.pm file we have created
850 unshift(@INC,'lib');
851 require $Config_PM;
852 import Config;
853
854 die "$0: $Config_PM not valid"
855         unless $Config{'PERL_CONFIG_SH'} eq 'true';
856
857 die "$0: error processing $Config_PM"
858         if defined($Config{'an impossible name'})
859         or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache
860         ;
861
862 die "$0: error processing $Config_PM"
863         if eval '$Config{"cc"} = 1'
864         or eval 'delete $Config{"cc"}'
865         ;
866
867
868 exit 0;
869 # Popularity of various entries in %Config, based on a large build and test
870 # run of code in the Fotango build system:
871 __DATA__
872 path_sep:       8490
873 d_readlink:     7101
874 d_symlink:      7101
875 archlibexp:     4318
876 sitearchexp:    4305
877 sitelibexp:     4305
878 privlibexp:     4163
879 ldlibpthname:   4041
880 libpth: 2134
881 archname:       1591
882 exe_ext:        1256
883 scriptdir:      1155
884 version:        1116
885 useithreads:    1002
886 osvers: 982
887 osname: 851
888 inc_version_list:       783
889 dont_use_nlink: 779
890 intsize:        759
891 usevendorprefix:        642
892 dlsrc:  624
893 cc:     541
894 lib_ext:        520
895 so:     512
896 ld:     501
897 ccdlflags:      500
898 ldflags:        495
899 obj_ext:        495
900 cccdlflags:     493
901 lddlflags:      493
902 ar:     492
903 dlext:  492
904 libc:   492
905 ranlib: 492
906 full_ar:        491
907 vendorarchexp:  491
908 vendorlibexp:   491
909 installman1dir: 489
910 installman3dir: 489
911 installsitebin: 489
912 installsiteman1dir:     489
913 installsiteman3dir:     489
914 installvendorman1dir:   489
915 installvendorman3dir:   489
916 d_flexfnam:     474
917 eunicefix:      360
918 d_link: 347
919 installsitearch:        344
920 installscript:  341
921 installprivlib: 337
922 binexp: 336
923 installarchlib: 336
924 installprefixexp:       336
925 installsitelib: 336
926 installstyle:   336
927 installvendorarch:      336
928 installvendorbin:       336
929 installvendorlib:       336
930 man1ext:        336
931 man3ext:        336
932 sh:     336
933 siteprefixexp:  336
934 installbin:     335
935 usedl:  332
936 ccflags:        285
937 startperl:      232
938 optimize:       231
939 usemymalloc:    229
940 cpprun: 228
941 sharpbang:      228
942 perllibs:       225
943 usesfio:        224
944 usethreads:     220
945 perlpath:       218
946 extensions:     217
947 usesocks:       208
948 shellflags:     198
949 make:   191
950 d_pwage:        189
951 d_pwchange:     189
952 d_pwclass:      189
953 d_pwcomment:    189
954 d_pwexpire:     189
955 d_pwgecos:      189
956 d_pwpasswd:     189
957 d_pwquota:      189
958 gccversion:     189
959 libs:   186
960 useshrplib:     186
961 cppflags:       185
962 ptrsize:        185
963 shrpenv:        185
964 static_ext:     185
965 use5005threads: 185
966 uselargefiles:  185
967 alignbytes:     184
968 byteorder:      184
969 ccversion:      184
970 config_args:    184
971 cppminus:       184