This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Detypo.
[perl5.git] / configpm
CommitLineData
a0d0e21e 1#!./miniperl -w
8990e307 2
18f68570
VK
3# following options are recognized:
4# --no-glossary - no glossary file inclusion, for compactness
5# --cross=PALTFORM - crosscompiling for PLATFORM
6my %opts = (
7 # %known_opts enumerates allowed opts as well as specifies default and initial values
8 my %known_opts = (
9 'cross' => '',
10 'glossary' => 1,
11 ),
12 # options itself
13 my %specified_opts = (
14 (map {/^--([\-_\w]+)=(.*)$/} @ARGV), # --opt=smth
15 (map {/^no-?(.*)$/i?($1=>0):($_=>1)} map {/^--([\-_\w]+)$/} @ARGV), # --opt --no-opt --noopt
16 ),
17);
18die "option '$_' is not recognized" for grep {!exists $known_opts{$_}} keys %specified_opts;
19@ARGV = grep {!/^--/} @ARGV;
20
21my $config_pm;
3b5ca523 22my $glossary = $ARGV[1] || 'Porting/Glossary';
18f68570
VK
23
24if ($opts{cross}) {
25 # creating cross-platform config file
26 mkdir "xlib";
27 mkdir "xlib/$opts{cross}";
28 $config_pm = $ARGV[0] || "xlib/$opts{cross}/Config.pm";
29}
30else {
31 $config_pm = $ARGV[0] || 'lib/Config.pm';
32}
33
8990e307
LW
34@ARGV = "./config.sh";
35
a0d0e21e 36# list names to put first (and hence lookup fastest)
3c81428c
PP
37@fast = qw(archname osname osvers prefix libs libpth
38 dynamic_ext static_ext extensions dlsrc so
743c51bc 39 sig_name sig_num cc ccflags cppflags
3c81428c 40 privlibexp archlibexp installprivlib installarchlib
a0d0e21e 41 sharpbang startsh shsharp
3c81428c 42);
a0d0e21e 43
fec02dd3
AD
44# names of things which may need to have slashes changed to double-colons
45@extensions = qw(dynamic_ext static_ext extensions known_extensions);
46
a0d0e21e
LW
47
48open CONFIG, ">$config_pm" or die "Can't open $config_pm: $!\n";
dd101d75 49$myver = sprintf "v%vd", $^V;
3c81428c 50
e3d0cac0 51print CONFIG <<'ENDOFBEG_NOQ', <<"ENDOFBEG";
8990e307 52package Config;
3c81428c 53use Exporter ();
e3d0cac0
IZ
54@EXPORT = qw(%Config);
55@EXPORT_OK = qw(myconfig config_sh config_vars);
56
57# Define our own import method to avoid pulling in the full Exporter:
58sub import {
59 my $pkg = shift;
60 @_ = @EXPORT unless @_;
61 my @func = grep {$_ ne '%Config'} @_;
4365a961 62 local $Exporter::ExportLevel = 1;
e3d0cac0
IZ
63 Exporter::import('Config', @func) if @func;
64 return if @func == @_;
65 my $callpkg = caller(0);
66 *{"$callpkg\::Config"} = \%Config;
67}
68
69ENDOFBEG_NOQ
de98c553
GS
70die "Perl lib version ($myver) doesn't match executable version (\$])"
71 unless \$^V;
72
dd101d75
JH
73\$^V eq $myver
74 or die "Perl lib version ($myver) doesn't match executable version (" .
75 (sprintf "v%vd",\$^V) . ")";
8990e307 76
a0d0e21e
LW
77# This file was created by configpm when Perl was built. Any changes
78# made to this file will be lost the next time perl is built.
79
8990e307
LW
80ENDOFBEG
81
16d20bd9 82
a0d0e21e 83@fast{@fast} = @fast;
fec02dd3 84@extensions{@extensions} = @extensions;
a0d0e21e
LW
85@non_v=();
86@v_fast=();
87@v_others=();
44a8e56a 88$in_v = 0;
a0d0e21e 89
85e6fe83 90while (<>) {
a0d0e21e 91 next if m:^#!/bin/sh:;
a02608de 92 # Catch PERL_CONFIG_SH=true and PERL_VERSION=n line from Configure.
a0d0e21e 93 s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/;
cceca5ed 94 my ($k,$v) = ($1,$2);
2000072c 95 # grandfather PATCHLEVEL and SUBVERSION and CONFIG
cceca5ed
GS
96 if ($k) {
97 if ($k eq 'PERL_VERSION') {
98 push @v_others, "PATCHLEVEL='$v'\n";
99 }
100 elsif ($k eq 'PERL_SUBVERSION') {
101 push @v_others, "SUBVERSION='$v'\n";
102 }
a02608de 103 elsif ($k eq 'PERL_CONFIG_SH') {
2000072c
JH
104 push @v_others, "CONFIG='$v'\n";
105 }
cceca5ed 106 }
435ec615
HM
107 # We can delimit things in config.sh with either ' or ".
108 unless ($in_v or m/^(\w+)=(['"])(.*\n)/){
a0d0e21e
LW
109 push(@non_v, "#$_"); # not a name='value' line
110 next;
111 }
435ec615 112 $quote = $2;
44a8e56a 113 if ($in_v) { $val .= $_; }
435ec615
HM
114 else { ($name,$val) = ($1,$3); }
115 $in_v = $val !~ /$quote\n/;
44a8e56a 116 next if $in_v;
fec02dd3 117 if ($extensions{$name}) { s,/,::,g }
435ec615
HM
118 if (!$fast{$name}){ push(@v_others, "$name=$quote$val"); next; }
119 push(@v_fast,"$name=$quote$val");
a0d0e21e
LW
120}
121
122foreach(@non_v){ print CONFIG $_ }
123
124print CONFIG "\n",
3c81428c 125 "my \$config_sh = <<'!END!';\n",
a0d0e21e 126 join("", @v_fast, sort @v_others),
3c81428c
PP
127 "!END!\n\n";
128
a6c40364 129# copy config summary format from the myconfig.SH script
3c81428c
PP
130
131print CONFIG "my \$summary = <<'!END!';\n";
132
3b5ca523 133open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
54310121
PP
1341 while defined($_ = <MYCONFIG>) && !/^Summary of/;
135do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
3c81428c 136close(MYCONFIG);
a0d0e21e 137
3c81428c
PP
138print CONFIG "\n!END!\n", <<'EOT';
139my $summary_expanded = 0;
140
141sub myconfig {
142 return $summary if $summary_expanded;
ca8cad5c
TB
143 $summary =~ s{\$(\w+)}
144 { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge;
3c81428c
PP
145 $summary_expanded = 1;
146 $summary;
147}
148EOT
149
150# ----
a0d0e21e
LW
151
152print CONFIG <<'ENDOFEND';
153
a0d0e21e 154sub FETCH {
aa1bdcb8 155 # check for cached value (which may be undef so we use exists not defined)
a0d0e21e 156 return $_[0]->{$_[1]} if (exists $_[0]->{$_[1]});
aa1bdcb8
TP
157
158 # Search for it in the big string
435ec615 159 my($value, $start, $marker, $quote_type);
46f36567 160
435ec615 161 $quote_type = "'";
4b2ec495 162 # Virtual entries.
46f36567 163 if ($_[1] eq 'byteorder') {
4b2ec495
JH
164 # byteorder does exist on its own but we overlay a virtual
165 # dynamically recomputed value.
46f36567
W
166 my $t = $Config{ivtype};
167 my $s = $Config{ivsize};
168 my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
46f36567 169 if ($s == 4 || $s == 8) {
ad66e0eb
JH
170 my $i = 0;
171 foreach my $c (reverse(2..$s)) { $i |= ord($c); $i <<= 8 }
172 $i |= ord(1);
46f36567
W
173 $value = join('', unpack('a'x$s, pack($f, $i)));
174 } else {
175 $value = '?'x$s;
176 }
4b2ec495
JH
177 } elsif ($_[1] =~ /^((?:cc|ld)flags|libs(?:wanted)?)_nolargefiles/) {
178 # These are purely virtual, they do not exist, but need to
179 # be computed on demand for largefile-incapable extensions.
45c9e83b 180 my $key = "${1}_uselargefiles";
4b2ec495
JH
181 $value = $Config{$1};
182 my $withlargefiles = $Config{$key};
183 if ($key =~ /^(?:cc|ld)flags_/) {
184 $value =~ s/\Q$withlargefiles\E\b//;
185 } elsif ($key =~ /^libs/) {
45c9e83b 186 my @lflibswanted = split(' ', $Config{libswanted_uselargefiles});
4b2ec495
JH
187 if (@lflibswanted) {
188 my %lflibswanted;
189 @lflibswanted{@lflibswanted} = ();
190 if ($key =~ /^libs_/) {
191 my @libs = grep { /^-l(.+)/ &&
192 not exists $lflibswanted{$1} }
193 split(' ', $Config{libs});
194 $Config{libs} = join(' ', @libs);
195 } elsif ($key =~ /^libswanted_/) {
196 my @libswanted = grep { not exists $lflibswanted{$_} }
197 split(' ', $Config{libswanted});
198 $Config{libswanted} = join(' ', @libswanted);
199 }
200 }
201 }
46f36567
W
202 } else {
203 $marker = "$_[1]=";
204 # return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m);
205 # Check for the common case, ' delimeted
206 $start = index($config_sh, "\n$marker$quote_type");
207 # If that failed, check for " delimited
208 if ($start == -1) {
209 $quote_type = '"';
210 $start = index($config_sh, "\n$marker$quote_type");
211 }
212 return undef if ( ($start == -1) && # in case it's first
213 (substr($config_sh, 0, length($marker)) ne $marker) );
214 if ($start == -1) {
215 # It's the very first thing we found. Skip $start forward
216 # and figure out the quote mark after the =.
217 $start = length($marker) + 1;
218 $quote_type = substr($config_sh, $start - 1, 1);
219 }
220 else {
221 $start += length($marker) + 2;
222 }
223 $value = substr($config_sh, $start,
224 index($config_sh, "$quote_type\n", $start) - $start);
435ec615 225 }
435ec615
HM
226 # If we had a double-quote, we'd better eval it so escape
227 # sequences and such can be interpolated. Since the incoming
228 # value is supposed to follow shell rules and not perl rules,
229 # we escape any perl variable markers
230 if ($quote_type eq '"') {
46f36567
W
231 $value =~ s/\$/\\\$/g;
232 $value =~ s/\@/\\\@/g;
233 eval "\$value = \"$value\"";
435ec615
HM
234 }
235 #$value = sprintf($value) if $quote_type eq '"';
46f36567
W
236 # So we can say "if $Config{'foo'}".
237 $value = undef if $value eq 'undef';
a0d0e21e
LW
238 $_[0]->{$_[1]} = $value; # cache it
239 return $value;
240}
241
3c81428c
PP
242my $prevpos = 0;
243
a0d0e21e
LW
244sub FIRSTKEY {
245 $prevpos = 0;
aa1bdcb8
TP
246 # my($key) = $config_sh =~ m/^(.*?)=/;
247 substr($config_sh, 0, index($config_sh, '=') );
248 # $key;
a0d0e21e
LW
249}
250
251sub NEXTKEY {
435ec615
HM
252 # Find out how the current key's quoted so we can skip to its end.
253 my $quote = substr($config_sh, index($config_sh, "=", $prevpos)+1, 1);
254 my $pos = index($config_sh, qq($quote\n), $prevpos) + 2;
3c81428c 255 my $len = index($config_sh, "=", $pos) - $pos;
a0d0e21e 256 $prevpos = $pos;
3c81428c 257 $len > 0 ? substr($config_sh, $pos, $len) : undef;
85e6fe83 258}
a0d0e21e 259
3c81428c 260sub EXISTS {
aa1bdcb8
TP
261 # exists($_[0]->{$_[1]}) or $config_sh =~ m/^$_[1]=/m;
262 exists($_[0]->{$_[1]}) or
263 index($config_sh, "\n$_[1]='") != -1 or
435ec615
HM
264 substr($config_sh, 0, length($_[1])+2) eq "$_[1]='" or
265 index($config_sh, "\n$_[1]=\"") != -1 or
4b2ec495
JH
266 substr($config_sh, 0, length($_[1])+2) eq "$_[1]=\"" or
267 $_[1] =~ /^(?:(?:cc|ld)flags|libs(?:wanted)?)_nolargefiles$/;
a0d0e21e
LW
268}
269
3c81428c
PP
270sub STORE { die "\%Config::Config is read-only\n" }
271sub DELETE { &STORE }
272sub CLEAR { &STORE }
a0d0e21e 273
3c81428c
PP
274
275sub config_sh {
276 $config_sh
748a9306 277}
9193ea20
PP
278
279sub config_re {
280 my $re = shift;
cb551bf9 281 my @matches = grep /^$re=/, split /^/, $config_sh;
9193ea20
PP
282 @matches ? (print @matches) : print "$re: not found\n";
283}
284
3c81428c
PP
285sub config_vars {
286 foreach(@_){
9193ea20 287 config_re($_), next if /\W/;
3c81428c
PP
288 my $v=(exists $Config{$_}) ? $Config{$_} : 'UNKNOWN';
289 $v='undef' unless defined $v;
290 print "$_='$v';\n";
291 }
292}
293
9193ea20
PP
294ENDOFEND
295
296if ($^O eq 'os2') {
297 print CONFIG <<'ENDOFSET';
298my %preconfig;
299if ($OS2::is_aout) {
300 my ($value, $v) = $config_sh =~ m/^used_aout='(.*)'\s*$/m;
301 for (split ' ', $value) {
302 ($v) = $config_sh =~ m/^aout_$_='(.*)'\s*$/m;
303 $preconfig{$_} = $v eq 'undef' ? undef : $v;
304 }
305}
764df951 306$preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't
9193ea20
PP
307sub TIEHASH { bless {%preconfig} }
308ENDOFSET
30500b05
IZ
309 # Extract the name of the DLL from the makefile to avoid duplication
310 my ($f) = grep -r, qw(GNUMakefile Makefile);
311 my $dll;
312 if (open my $fh, '<', $f) {
313 while (<$fh>) {
314 $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
315 }
316 }
317 print CONFIG <<ENDOFSET if $dll;
318\$preconfig{dll_name} = '$dll';
319ENDOFSET
9193ea20
PP
320} else {
321 print CONFIG <<'ENDOFSET';
322sub TIEHASH { bless {} }
323ENDOFSET
324}
325
326print CONFIG <<'ENDOFTAIL';
327
fb73857a
PP
328# avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
329sub DESTROY { }
330
9193ea20
PP
331tie %Config, 'Config';
332
3c81428c
PP
3331;
334__END__
748a9306 335
3c81428c 336=head1 NAME
a0d0e21e 337
3c81428c
PP
338Config - access Perl configuration information
339
340=head1 SYNOPSIS
341
342 use Config;
343 if ($Config{'cc'} =~ /gcc/) {
344 print "built by gcc\n";
345 }
346
347 use Config qw(myconfig config_sh config_vars);
348
349 print myconfig();
350
351 print config_sh();
352
353 config_vars(qw(osname archname));
354
355
356=head1 DESCRIPTION
357
358The Config module contains all the information that was available to
359the C<Configure> program at Perl build time (over 900 values).
360
361Shell variables from the F<config.sh> file (written by Configure) are
362stored in the readonly-variable C<%Config>, indexed by their names.
363
364Values stored in config.sh as 'undef' are returned as undefined
1fef88e7 365values. The perl C<exists> function can be used to check if a
3c81428c
PP
366named variable exists.
367
368=over 4
369
370=item myconfig()
371
372Returns a textual summary of the major perl configuration values.
373See also C<-V> in L<perlrun/Switches>.
374
375=item config_sh()
376
377Returns the entire perl configuration information in the form of the
378original config.sh shell variable assignment script.
379
380=item config_vars(@names)
381
382Prints to STDOUT the values of the named configuration variable. Each is
383printed on a separate line in the form:
384
385 name='value';
386
387Names which are unknown are output as C<name='UNKNOWN';>.
388See also C<-V:name> in L<perlrun/Switches>.
389
390=back
391
392=head1 EXAMPLE
393
394Here's a more sophisticated example of using %Config:
395
396 use Config;
743c51bc
WK
397 use strict;
398
399 my %sig_num;
400 my @sig_name;
401 unless($Config{sig_name} && $Config{sig_num}) {
402 die "No sigs?";
403 } else {
404 my @names = split ' ', $Config{sig_name};
405 @sig_num{@names} = split ' ', $Config{sig_num};
406 foreach (@names) {
407 $sig_name[$sig_num{$_}] ||= $_;
408 }
409 }
3c81428c 410
743c51bc
WK
411 print "signal #17 = $sig_name[17]\n";
412 if ($sig_num{ALRM}) {
413 print "SIGALRM is $sig_num{ALRM}\n";
3c81428c
PP
414 }
415
416=head1 WARNING
417
418Because this information is not stored within the perl executable
419itself it is possible (but unlikely) that the information does not
420relate to the actual perl binary which is being used to access it.
421
422The Config module is installed into the architecture and version
423specific library directory ($Config{installarchlib}) and it checks the
424perl version number when loaded.
425
435ec615
HM
426The values stored in config.sh may be either single-quoted or
427double-quoted. Double-quoted strings are handy for those cases where you
428need to include escape sequences in the strings. To avoid runtime variable
429interpolation, any C<$> and C<@> characters are replaced by C<\$> and
430C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
431or C<\@> in double-quoted strings unless you're willing to deal with the
432consequences. (The slashes will end up escaped and the C<$> or C<@> will
433trigger variable interpolation)
434
ebc74a4b
GS
435=head1 GLOSSARY
436
437Most C<Config> variables are determined by the C<Configure> script
438on platforms supported by it (which is most UNIX platforms). Some
439platforms have custom-made C<Config> variables, and may thus not have
440some of the variables described below, or may have extraneous variables
441specific to that particular port. See the port specific documentation
442in such cases.
443
ebc74a4b
GS
444ENDOFTAIL
445
18f68570
VK
446if ($opts{glossary}) {
447 open(GLOS, "<$glossary") or die "Can't open $glossary: $!";
448}
fb87c415
IZ
449%seen = ();
450$text = 0;
451$/ = '';
452
453sub process {
aade5aff
YST
454 if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
455 my $c = substr $1, 0, 1;
456 unless ($seen{$c}++) {
457 print CONFIG <<EOF if $text;
fb87c415 458=back
ebc74a4b 459
fb87c415 460EOF
aade5aff 461 print CONFIG <<EOF;
fb87c415
IZ
462=head2 $c
463
bbc7dcd2 464=over 4
fb87c415
IZ
465
466EOF
aade5aff
YST
467 $text = 1;
468 }
469 }
470 elsif (!$text || !/\A\t/) {
471 warn "Expected a Configure variable header",
472 ($text ? " or another paragraph of description" : () );
fb87c415
IZ
473 }
474 s/n't/n\00t/g; # leave can't, won't etc untouched
475 s/^\t\s+(.*)/\n\t$1\n/gm; # Indented lines ===> paragraphs
476 s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text
477 s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
478 s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
479 s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
480 s{
481 (?<! [\w./<\'\"] ) # Only standalone file names
482 (?! e \. g \. ) # Not e.g.
483 (?! \. \. \. ) # Not ...
484 (?! \d ) # Not 5.004
a1151a3c
RGS
485 (?! read/ ) # Not read/write
486 (?! etc\. ) # Not etc.
487 (?! I/O ) # Not I/O
488 (
489 \$ ? # Allow leading $
490 [\w./]* [./] [\w./]* # Require . or / inside
491 )
492 (?<! \. (?= [\s)] ) ) # Do not include trailing dot
fb87c415
IZ
493 (?! [\w/] ) # Include all of it
494 }
495 (F<$1>)xg; # /usr/local
496 s/((?<=\s)~\w*)/F<$1>/g; # ~name
497 s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD
498 s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
499 s/n[\0]t/n't/g; # undo can't, won't damage
ebc74a4b
GS
500}
501
18f68570
VK
502if ($opts{glossary}) {
503 <GLOS>; # Skip the preamble
504 while (<GLOS>) {
505 process;
506 print CONFIG;
507 }
fb87c415 508}
ebc74a4b
GS
509
510print CONFIG <<'ENDOFTAIL';
511
512=back
513
3c81428c
PP
514=head1 NOTE
515
516This module contains a good example of how to use tie to implement a
517cache and an example of how to make a tied variable readonly to those
518outside of it.
519
520=cut
a0d0e21e 521
9193ea20 522ENDOFTAIL
a0d0e21e
LW
523
524close(CONFIG);
ebc74a4b 525close(GLOS);
a0d0e21e 526
18f68570
VK
527# Now create Cross.pm if needed
528if ($opts{cross}) {
529 open CROSS, ">lib/Cross.pm" or die "Can not open >lib/Cross.pm: $!";
530 print CROSS <<"EOS";
531sub BEGIN {
532 \@INC = map {/\\blib\\b/?(do{local \$_=\$_;s/\\blib\\b/xlib\\/$opts{cross}/;\$_},\$_):(\$_)} \@INC;
533}
5341;
535EOS
536 close CROSS;
537}
538
539
a0d0e21e
LW
540# Now do some simple tests on the Config.pm file we have created
541unshift(@INC,'lib');
542require $config_pm;
543import Config;
544
545die "$0: $config_pm not valid"
a02608de 546 unless $Config{'PERL_CONFIG_SH'} eq 'true';
a0d0e21e
LW
547
548die "$0: error processing $config_pm"
549 if defined($Config{'an impossible name'})
a02608de 550 or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache
a0d0e21e
LW
551 ;
552
553die "$0: error processing $config_pm"
554 if eval '$Config{"cc"} = 1'
555 or eval 'delete $Config{"cc"}'
556 ;
557
558
85e6fe83 559exit 0;