1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
|
#!./miniperl -w
$config_pm = $ARGV[0] || 'lib/Config.pm';
@ARGV = "./config.sh";
# list names to put first (and hence lookup fastest)
@fast = qw(osname osvers so libpth archlib
sharpbang startsh shsharp
dynamic_ext static_ext extensions dl_src
sig_name ccflags cppflags intsize);
# names of things which may need to have slashes changed to double-colons
@extensions = qw(dynamic_ext static_ext extensions known_extensions);
open CONFIG, ">$config_pm" or die "Can't open $config_pm: $!\n";
$myver = sprintf("%.3f", $]);
print CONFIG <<"ENDOFBEG";
package Config;
require Exporter;
\@ISA = (Exporter);
\@EXPORT = qw(%Config);
\$] == $myver or die sprintf
"Perl lib version ($myver) doesn't match executable version (%.3f)\\n", \$];
# This file was created by configpm when Perl was built. Any changes
# made to this file will be lost the next time perl is built.
ENDOFBEG
print CONFIG <<'EndOfPod';
=head1 NAME
Config - access Perl configuration option
=head1 SYNOPSIS
use Config;
if ($Config{'cc'} =~ /gcc/) {
print "built by gcc\n";
}
=head1 DESCRIPTION
The Config module contains everything that was available to the
C<Configure> program at Perl build time. Shell variables from
F<config.sh> are stored in the readonly-variable C<%Config>, indexed by
their names.
=head1 EXAMPLE
Here's a more sophisticated example of using %Config:
use Config;
defined $Config{sig_name} || die "No sigs?";
foreach $name (split(' ', $Config{sig_name})) {
$signo{$name} = $i;
$signame[$i] = $name;
$i++;
}
print "signal #17 = $signame[17]\n";
if ($signo{ALRM}) {
print "SIGALRM is $signo{ALRM}\n";
}
=head1 NOTE
This module contains a good example of how to make a variable
readonly to those outside of it.
=cut
EndOfPod
@fast{@fast} = @fast;
@extensions{@extensions} = @extensions;
@non_v=();
@v_fast=();
@v_others=();
while (<>) {
next if m:^#!/bin/sh:;
# Catch CONFIG=true and PATCHLEVEL=n line from Configure.
s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/;
unless (m/^(\w+)='(.*)'\s*$/){
push(@non_v, "#$_"); # not a name='value' line
next;
}
$name = $1;
if ($extensions{$name}) { s,/,::,g }
if (!$fast{$name}){ push(@v_others, $_); next; }
push(@v_fast,$_);
}
foreach(@non_v){ print CONFIG $_ }
print CONFIG "\n",
"\$config_sh=<<'!END!OF!CONFIG!';\n",
join("", @v_fast, sort @v_others),
"!END!OF!CONFIG!\n\n";
print CONFIG <<'ENDOFEND';
tie %Config, Config;
sub TIEHASH { bless {} }
sub FETCH {
# check for cached value (which maybe undef so we use exists not defined)
return $_[0]->{$_[1]} if (exists $_[0]->{$_[1]});
my($value); # search for the item in the big $config_sh string
return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m);
$value = undef if $value eq 'undef'; # So we can say "if $Config{'foo'}".
$_[0]->{$_[1]} = $value; # cache it
return $value;
}
sub FIRSTKEY {
$prevpos = 0;
my $key;
($key) = $config_sh =~ m/^(.*)=/;
$key;
}
sub NEXTKEY {
my ($pos, $len);
$pos = $prevpos;
$pos = index( $config_sh, "\n", $pos) + 1;
$prevpos = $pos;
$len = index( $config_sh, "=", $pos) - $pos;
$len > 0 ? substr( $config_sh, $pos, $len) : undef;
}
sub EXISTS{
exists($_[0]->{$_[1]}) or $config_sh =~ m/^$_[1]=/m;
}
sub readonly { die "\%Config::Config is read-only\n" }
sub myconfig {
my($output);
$output = <<'END';
Summary of my $package (patchlevel $PATCHLEVEL) configuration:
Platform:
osname=$osname, osver=$osvers, archname=$archname
uname='$myuname'
hint=$hint
Compiler:
cc='$cc', optimize='$optimize'
cppflags='$cppflags'
ccflags ='$ccflags'
ldflags ='$ldflags'
stdchar='$stdchar', d_stdstdio=$d_stdstdio, usevfork=$usevfork
voidflags=$voidflags, castflags=$castflags, d_casti32=$d_casti32, d_castneg=$d_castneg
intsize=$intsize, alignbytes=$alignbytes, usemymalloc=$usemymalloc, randbits=$randbits
Libraries:
so=$so
libpth=$libpth
libs=$libs
libc=$libc
Dynamic Linking:
dlsrc=$dlsrc, dlext=$dlext, d_dlsymun=$d_dlsymun
cccdlflags='$cccdlflags', ccdlflags='$ccdlflags', lddlflags='$lddlflags'
END
$output =~ s/\$(\w+)/$Config{$1}/ge;
$output;
}
sub STORE { &readonly }
sub DELETE{ &readonly }
sub CLEAR { &readonly }
1;
ENDOFEND
close(CONFIG);
# Now do some simple tests on the Config.pm file we have created
unshift(@INC,'lib');
require $config_pm;
import Config;
die "$0: $config_pm not valid"
unless $Config{'CONFIG'} eq 'true';
die "$0: error processing $config_pm"
if defined($Config{'an impossible name'})
or $Config{'CONFIG'} ne 'true' # test cache
;
die "$0: error processing $config_pm"
if eval '$Config{"cc"} = 1'
or eval 'delete $Config{"cc"}'
;
exit 0;
|
