configpm revision 7c478bd95313f5f23a4c958a745db2134aa03244
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
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync#!./miniperl -w
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync# list names to put first (and hence lookup fastest)
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync@fast = qw(archname osname osvers prefix libs libpth
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync privlibexp archlibexp installprivlib installarchlib
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync# names of things which may need to have slashes changed to double-colons
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync@extensions = qw(dynamic_ext static_ext extensions known_extensions);
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncopen CONFIG, ">$config_pm" or die "Can't open $config_pm: $!\n";
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync# Define our own import method to avoid pulling in the full Exporter:
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync my $pkg = shift;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync return if @func == @_;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncdie "Perl lib version ($myver) doesn't match executable version (\$])"
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync or die "Perl lib version ($myver) doesn't match executable version (" .
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync# This file was created by configpm when Perl was built. Any changes
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync# made to this file will be lost the next time perl is built.
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync # Catch CONFIGDOTSH=true and PERL_VERSION=n line from Configure.
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync # We can delimit things in config.sh with either ' or ".
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync $quote = $2;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync if ($in_v) { $val .= $_; }
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync else { ($name,$val) = ($1,$3); }
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync $in_v = $val !~ /$quote\n/;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync next if $in_v;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync if ($extensions{$name}) { s,/,::,g }
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync if (!$fast{$name}){ push(@v_others, "$name=$quote$val"); next; }
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync push(@v_fast,"$name=$quote$val");
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncforeach(@non_v){ print CONFIG $_ }
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncprint CONFIG "\n",
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync join("", @v_fast, sort @v_others),
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync "!END!\n\n";
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync# copy config summary format from the myconfig.SH script
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncopen(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncdo { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncclose(MYCONFIG);
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncmy $summary_expanded = 0;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncsub myconfig {
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync return $summary if $summary_expanded;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync $summary =~ s{\$(\w+)}
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync $summary_expanded = 1;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync # check for cached value (which may be undef so we use exists not defined)
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync return $_[0]->{$_[1]} if (exists $_[0]->{$_[1]});
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync # Search for it in the big string
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync my($value, $start, $marker, $quote_type);
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync # Virtual entries.
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync if ($_[1] eq 'byteorder') {
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync # byteorder does exist on its own but we overlay a virtual
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync # dynamically recomputed value.
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync my $t = $Config{ivtype};
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync my $s = $Config{ivsize};
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync if ($s == 4 || $s == 8) {
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync foreach my $c (reverse(2..$s)) { $i |= ord($c); $i <<= 8 }
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync $i |= ord(1);
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync $value = join('', unpack('a'x$s, pack($f, $i)));
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync } elsif ($_[1] =~ /^((?:cc|ld)flags|libs(?:wanted)?)_nolargefiles/) {
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync # These are purely virtual, they do not exist, but need to
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync # be computed on demand for largefile-incapable extensions.
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync if ($key =~ /^(?:cc|ld)flags_/) {
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync } elsif ($key =~ /^libs/) {
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync my @lflibswanted = split(' ', $Config{libswanted_uselargefiles});
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync if (@lflibswanted) {
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync my %lflibswanted;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync @lflibswanted{@lflibswanted} = ();
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync if ($key =~ /^libs_/) {
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync my @libs = grep { /^-l(.+)/ &&
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync not exists $lflibswanted{$1} }
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync split(' ', $Config{libs});
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync $Config{libs} = join(' ', @libs);
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync } elsif ($key =~ /^libswanted_/) {
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync my @libswanted = grep { not exists $lflibswanted{$_} }
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync split(' ', $Config{libswanted});
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync $Config{libswanted} = join(' ', @libswanted);
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync # return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m);
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync # Check for the common case, ' delimeted
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync $start = index($config_sh, "\n$marker$quote_type");
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync $start = index($config_sh, "\n$marker$quote_type");
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync return undef if ( ($start == -1) && # in case it's first
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync (substr($config_sh, 0, length($marker)) ne $marker) );
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync # It's the very first thing we found. Skip $start forward
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync index($config_sh, "$quote_type\n", $start) - $start);
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync # If we had a double-quote, we'd better eval it so escape
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync # sequences and such can be interpolated. Since the incoming
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync # value is supposed to follow shell rules and not perl rules,
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync $value =~ s/\$/\\\$/g;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync $value =~ s/\@/\\\@/g;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync # Find out how the current key's quoted so we can skip to its end.
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync my $quote = substr($config_sh, index($config_sh, "=", $prevpos)+1, 1);
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync my $pos = index($config_sh, qq($quote\n), $prevpos) + 2;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync # exists($_[0]->{$_[1]}) or $config_sh =~ m/^$_[1]=/m;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync substr($config_sh, 0, length($_[1])+2) eq "$_[1]='" or
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync substr($config_sh, 0, length($_[1])+2) eq "$_[1]=\"" or
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync $_[1] =~ /^(?:(?:cc|ld)flags|libs(?:wanted)?)_nolargefiles$/;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync my $re = shift;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync @matches ? (print @matches) : print "$re: not found\n";
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync my $v=(exists $Config{$_}) ? $Config{$_} : 'UNKNOWN';
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync my ($value, $v) = $config_sh =~ m/^used_aout='(.*)'\s*$/m;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync# avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncThe Config module contains all the information that was available to
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncthe C<Configure> program at Perl build time (over 900 values).
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncShell variables from the F<config.sh> file (written by Configure) are
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncstored in the readonly-variable C<%Config>, indexed by their names.
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncValues stored in config.sh as 'undef' are returned as undefined
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncvalues. The perl C<exists> function can be used to check if a
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncReturns a textual summary of the major perl configuration values.
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncReturns the entire perl configuration information in the form of the
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncoriginal config.sh shell variable assignment script.
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncPrints to STDOUT the values of the named configuration variable. Each is
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncNames which are unknown are output as C<name='UNKNOWN';>.
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncHere's a more sophisticated example of using %Config:
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync use Config;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync use strict;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync my %sig_num;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync my @sig_name;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync unless($Config{sig_name} && $Config{sig_num}) {
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync die "No sigs?";
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync my @names = split ' ', $Config{sig_name};
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync @sig_num{@names} = split ' ', $Config{sig_num};
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync foreach (@names) {
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync $sig_name[$sig_num{$_}] ||= $_;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync print "signal #17 = $sig_name[17]\n";
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync if ($sig_num{ALRM}) {
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync print "SIGALRM is $sig_num{ALRM}\n";
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync=head1 WARNING
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncBecause this information is not stored within the perl executable
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncitself it is possible (but unlikely) that the information does not
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncrelate to the actual perl binary which is being used to access it.
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncThe Config module is installed into the architecture and version
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncspecific library directory ($Config{installarchlib}) and it checks the
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncperl version number when loaded.
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncThe values stored in config.sh may be either single-quoted or
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncdouble-quoted. Double-quoted strings are handy for those cases where you
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncneed to include escape sequences in the strings. To avoid runtime variable
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncinterpolation, any C<$> and C<@> characters are replaced by C<\$> and
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncC<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncor C<\@> in double-quoted strings unless you're willing to deal with the
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncconsequences. (The slashes will end up escaped and the C<$> or C<@> will
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncMost C<Config> variables are determined by the C<Configure> script
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncon platforms supported by it (which is most UNIX platforms). Some
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncplatforms have custom-made C<Config> variables, and may thus not have
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncsome of the variables described below, or may have extraneous variables
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncspecific to that particular port. See the port specific documentation
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncopen(GLOS, "<$glossary") or die "Can't open $glossary: $!";
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync my $c = substr $1, 0, 1;
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync s/^\t\s+(.*)/\n\t$1\n/gm; # Indented lines ===> paragraphs
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync (?<! [\w./<\'\"] ) # Only standalone file names
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync (?! e \. g \. ) # Not e.g.
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync (?! \. \. \. ) # Not ...
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync (?! \d ) # Not 5.004
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync ( [\w./]* [./] [\w./]* ) # Require . or / inside
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync (?<! \. (?= \s ) ) # Do not include trailing dot
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync (?! [\w/] ) # Include all of it
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync (F<$1>)xg; # /usr/local
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync s/((?<=\s)~\w*)/F<$1>/g; # ~name
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsyncThis module contains a good example of how to use tie to implement a
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsynccache and an example of how to make a tied variable readonly to those
069b9101fbd3b049610c5511b1cc9534d01ea472vboxsync# Now do some simple tests on the Config.pm file we have created