This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
locale.c: Create a convenience #define
[perl5.git] / cpan / Config-Perl-V / V.pm
CommitLineData
4b07058c
RS
1package Config::Perl::V;
2
3use strict;
4use warnings;
5
6use Config;
7use Exporter;
8use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
3eb80770 9$VERSION = "0.34";
275d368b 10@ISA = qw( Exporter );
4b07058c
RS
11@EXPORT_OK = qw( plv2hash summary myconfig signature );
12%EXPORT_TAGS = (
edd16cfc
MB
13 'all' => [ @EXPORT_OK ],
14 'sig' => [ "signature" ],
4b07058c
RS
15 );
16
17# Characteristics of this binary (from libperl):
18# Compile-time options: DEBUGGING PERL_DONT_CREATE_GVSV PERL_MALLOC_WRAP
19# USE_64_BIT_INT USE_LARGE_FILES USE_PERLIO
20
21# The list are as the perl binary has stored it in PL_bincompat_options
22# search for it in
21555490
MB
23# perl.c line 1643 S_Internals_V ()
24# perl -ne'(/^S_Internals_V/../^}/)&&s/^\s+"( .*)"/$1/ and print' perl.c
25# perl.h line 4566 PL_bincompat_options
26# perl -ne'(/^\w.*PL_bincompat/../^\w}/)&&s/^\s+"( .*)"/$1/ and print' perl.h
edd16cfc 27my %BTD = map {( $_ => 0 )} qw(
4b07058c
RS
28
29 DEBUGGING
215cc5d7 30 NO_HASH_SEED
b4ade012 31 NO_MATHOMS
3eb80770
MB
32 NO_PERL_INTERNAL_RAND_SEED
33 NO_PERL_RAND_SEED
215cc5d7 34 NO_TAINT_SUPPORT
21555490 35 PERL_BOOL_AS_CHAR
9a4196f3 36 PERL_COPY_ON_WRITE
4b07058c
RS
37 PERL_DISABLE_PMC
38 PERL_DONT_CREATE_GVSV
215cc5d7 39 PERL_EXTERNAL_GLOB
215cc5d7 40 PERL_HASH_FUNC_DJB2
215cc5d7
MB
41 PERL_HASH_FUNC_MURMUR3
42 PERL_HASH_FUNC_ONE_AT_A_TIME
43 PERL_HASH_FUNC_ONE_AT_A_TIME_HARD
44 PERL_HASH_FUNC_ONE_AT_A_TIME_OLD
b4ade012
MB
45 PERL_HASH_FUNC_SDBM
46 PERL_HASH_FUNC_SIPHASH
47 PERL_HASH_FUNC_SUPERFAST
4b07058c
RS
48 PERL_IS_MINIPERL
49 PERL_MALLOC_WRAP
50 PERL_MEM_LOG
51 PERL_MEM_LOG_ENV
52 PERL_MEM_LOG_ENV_FD
53 PERL_MEM_LOG_NOIMPL
54 PERL_MEM_LOG_STDERR
55 PERL_MEM_LOG_TIMESTAMP
215cc5d7 56 PERL_NEW_COPY_ON_WRITE
834069b8 57 PERL_OP_PARENT
215cc5d7
MB
58 PERL_PERTURB_KEYS_DETERMINISTIC
59 PERL_PERTURB_KEYS_DISABLED
60 PERL_PERTURB_KEYS_RANDOM
4b07058c
RS
61 PERL_PRESERVE_IVUV
62 PERL_RELOCATABLE_INCPUSH
63 PERL_USE_DEVEL
64 PERL_USE_SAFE_PUTENV
3eb80770 65 PERL_USE_UNSHARED_KEYS_IN_LARGE_HASHES
6b3eaabc 66 SILENT_NO_TAINT_SUPPORT
4b07058c
RS
67 UNLINK_ALL_VERSIONS
68 USE_ATTRIBUTES_FOR_PERLIO
69 USE_FAST_STDIO
215cc5d7 70 USE_HASH_SEED_EXPLICIT
4b07058c 71 USE_LOCALE
215cc5d7 72 USE_LOCALE_CTYPE
9a4196f3 73 USE_NO_REGISTRY
4b07058c
RS
74 USE_PERL_ATOF
75 USE_SITECUSTOMIZE
72b2b1d9 76 USE_THREAD_SAFE_LOCALE
4b07058c
RS
77
78 DEBUG_LEAKING_SCALARS
79 DEBUG_LEAKING_SCALARS_FORK_DUMP
80 DECCRTL_SOCKETS
81 FAKE_THREADS
82 FCRYPT
83 HAS_TIMES
215cc5d7 84 HAVE_INTERP_INTERN
4b07058c
RS
85 MULTIPLICITY
86 MYMALLOC
3eb80770 87 NO_HASH_SEED
21555490 88 PERL_DEBUG_READONLY_COW
4b07058c
RS
89 PERL_DEBUG_READONLY_OPS
90 PERL_GLOBAL_STRUCT
b4ade012 91 PERL_GLOBAL_STRUCT_PRIVATE
3eb80770
MB
92 PERL_HASH_NO_SBOX32
93 PERL_HASH_USE_SBOX32
4b07058c
RS
94 PERL_IMPLICIT_CONTEXT
95 PERL_IMPLICIT_SYS
b4ade012 96 PERLIO_LAYERS
4b07058c
RS
97 PERL_MAD
98 PERL_MICRO
99 PERL_NEED_APPCTX
100 PERL_NEED_TIMESBASE
101 PERL_OLD_COPY_ON_WRITE
4b07058c
RS
102 PERL_POISON
103 PERL_SAWAMPERSAND
104 PERL_TRACK_MEMPOOL
105 PERL_USES_PL_PIDSTATUS
106 PL_OP_SLAB_ALLOC
107 THREADS_HAVE_PIDS
108 USE_64_BIT_ALL
109 USE_64_BIT_INT
110 USE_IEEE
111 USE_ITHREADS
112 USE_LARGE_FILES
113 USE_LOCALE_COLLATE
114 USE_LOCALE_NUMERIC
b4ade012 115 USE_LOCALE_TIME
4b07058c
RS
116 USE_LONG_DOUBLE
117 USE_PERLIO
6fdf23c2 118 USE_QUADMATH
4b07058c
RS
119 USE_REENTRANT_API
120 USE_SFIO
121 USE_SOCKS
122 VMS_DO_SOCKETS
123 VMS_SHORTEN_LONG_SYMBOLS
124 VMS_SYMBOL_CASE_AS_IS
125 );
126
127# These are all the keys that are
215cc5d7 128# 1. Always present in %Config - lib/Config.pm #87 tie %Config
4b07058c
RS
129# 2. Reported by 'perl -V' (the rest)
130my @config_vars = qw(
131
132 api_subversion
133 api_version
134 api_versionstring
135 archlibexp
136 dont_use_nlink
137 d_readlink
138 d_symlink
139 exe_ext
140 inc_version_list
141 ldlibpthname
142 patchlevel
143 path_sep
144 perl_patchlevel
145 privlibexp
146 scriptdir
147 sitearchexp
148 sitelibexp
149 subversion
150 usevendorprefix
151 version
152
153 git_commit_id
154 git_describe
155 git_branch
156 git_uncommitted_changes
157 git_commit_id_title
158 git_snapshot_date
159
160 package revision version_patchlevel_string
161
162 osname osvers archname
163 myuname
164 config_args
165 hint useposix d_sigaction
166 useithreads usemultiplicity
167 useperlio d_sfio uselargefiles usesocks
168 use64bitint use64bitall uselongdouble
275d368b 169 usemymalloc default_inc_excludes_dot bincompat5005
4b07058c
RS
170
171 cc ccflags
172 optimize
173 cppflags
174 ccversion gccversion gccosandvers
175 intsize longsize ptrsize doublesize byteorder
176 d_longlong longlongsize d_longdbl longdblsize
177 ivtype ivsize nvtype nvsize lseektype lseeksize
178 alignbytes prototype
179
180 ld ldflags
181 libpth
182 libs
183 perllibs
184 libc so useshrplib libperl
185 gnulibc_version
186
187 dlsrc dlext d_dlsymun ccdlflags
188 cccdlflags lddlflags
189 );
190
191my %empty_build = (
edd16cfc
MB
192 'osname' => "",
193 'stamp' => 0,
194 'options' => { %BTD },
195 'patches' => [],
4b07058c
RS
196 );
197
275d368b 198sub _make_derived {
4b07058c
RS
199 my $conf = shift;
200
edd16cfc
MB
201 for ( [ 'lseektype' => "Off_t" ],
202 [ 'myuname' => "uname" ],
203 [ 'perl_patchlevel' => "patch" ],
4b07058c 204 ) {
edd16cfc
MB
205 my ($official, $derived) = @{$_};
206 $conf->{'config'}{$derived} ||= $conf->{'config'}{$official};
207 $conf->{'config'}{$official} ||= $conf->{'config'}{$derived};
208 $conf->{'derived'}{$derived} = delete $conf->{'config'}{$derived};
4b07058c
RS
209 }
210
edd16cfc
MB
211 if (exists $conf->{'config'}{'version_patchlevel_string'} &&
212 !exists $conf->{'config'}{'api_version'}) {
213 my $vps = $conf->{'config'}{'version_patchlevel_string'};
4b07058c 214 $vps =~ s{\b revision \s+ (\S+) }{}x and
edd16cfc 215 $conf->{'config'}{'revision'} ||= $1;
4b07058c
RS
216
217 $vps =~ s{\b version \s+ (\S+) }{}x and
edd16cfc 218 $conf->{'config'}{'api_version'} ||= $1;
4b07058c 219 $vps =~ s{\b subversion \s+ (\S+) }{}x and
edd16cfc 220 $conf->{'config'}{'subversion'} ||= $1;
4b07058c 221 $vps =~ s{\b patch \s+ (\S+) }{}x and
edd16cfc 222 $conf->{'config'}{'perl_patchlevel'} ||= $1;
4b07058c
RS
223 }
224
edd16cfc
MB
225 ($conf->{'config'}{'version_patchlevel_string'} ||= join " ",
226 map { ($_, $conf->{'config'}{$_} ) }
227 grep { $conf->{'config'}{$_} }
4b07058c
RS
228 qw( api_version subversion perl_patchlevel )) =~ s/\bperl_//;
229
edd16cfc 230 $conf->{'config'}{'perl_patchlevel'} ||= ""; # 0 is not a valid patchlevel
4b07058c 231
edd16cfc
MB
232 if ($conf->{'config'}{'perl_patchlevel'} =~ m{^git\w*-([^-]+)}i) {
233 $conf->{'config'}{'git_branch'} ||= $1;
234 $conf->{'config'}{'git_describe'} ||= $conf->{'config'}{'perl_patchlevel'};
4b07058c
RS
235 }
236
edd16cfc 237 $conf->{'config'}{$_} ||= "undef" for grep m{^(?:use|def)} => @config_vars;
275d368b 238
4b07058c
RS
239 $conf;
240 } # _make_derived
241
275d368b 242sub plv2hash {
4b07058c 243 my %config;
4b07058c 244
b4ade012
MB
245 my $pv = join "\n" => @_;
246
edd16cfc
MB
247 if ($pv =~ m{^Summary of my\s+(\S+)\s+\(\s*(.*?)\s*\)}m) {
248 $config{'package'} = $1;
b4ade012 249 my $rev = $2;
edd16cfc
MB
250 $rev =~ s/^ revision \s+ (\S+) \s*//x and $config{'revision'} = $1;
251 $rev and $config{'version_patchlevel_string'} = $rev;
252 my ($rel) = $config{'package'} =~ m{perl(\d)};
b4ade012
MB
253 my ($vers, $subvers) = $rev =~ m{version\s+(\d+)\s+subversion\s+(\d+)};
254 defined $vers && defined $subvers && defined $rel and
edd16cfc 255 $config{'version'} = "$rel.$vers.$subvers";
b4ade012
MB
256 }
257
edd16cfc
MB
258 if ($pv =~ m{^\s+(Snapshot of:)\s+(\S+)}) {
259 $config{'git_commit_id_title'} = $1;
260 $config{'git_commit_id'} = $2;
b4ade012 261 }
4b07058c 262
6b3eaabc
MB
263 # these are always last on line and can have multiple quotation styles
264 for my $k (qw( ccflags ldflags lddlflags )) {
265 $pv =~ s{, \s* $k \s*=\s* (.*) \s*$}{}mx or next;
266 my $v = $1;
267 $v =~ s/\s*,\s*$//;
268 $v =~ s/^(['"])(.*)\1$/$2/;
269 $config{$k} = $v;
270 }
271
60df6830
MB
272 if (my %kv = ($pv =~ m{\b
273 (\w+) # key
274 \s*= # assign
275 ( '\s*[^']*?\s*' # quoted value
276 | \S+[^=]*?\s*\n # unquoted running till end of line
277 | \S+ # unquoted value
278 | \s*\n # empty
279 )
280 (?:,?\s+|\s*\n)? # separator (5.8.x reports did not have a ','
281 }gx)) { # between every kv pair
4b07058c
RS
282
283 while (my ($k, $v) = each %kv) {
edd16cfc
MB
284 $k =~ s{\s+$} {};
285 $v =~ s{\s*\n\z} {};
286 $v =~ s{,$} {};
287 $v =~ m{^'(.*)'$} and $v = $1;
288 $v =~ s{\s+$} {};
4b07058c
RS
289 $config{$k} = $v;
290 }
291 }
b4ade012 292
4b07058c 293 my $build = { %empty_build };
b4ade012
MB
294
295 $pv =~ m{^\s+Compiled at\s+(.*)}m
edd16cfc 296 and $build->{'stamp'} = $1;
60df6830 297 $pv =~ m{^\s+Locally applied patches:(?:\s+|\n)(.*?)(?:[\s\n]+Buil[td] under)}ms
edd16cfc 298 and $build->{'patches'} = [ split m{\n+\s*}, $1 ];
60df6830 299 $pv =~ m{^\s+Compile-time options:(?:\s+|\n)(.*?)(?:[\s\n]+(?:Locally applied|Buil[td] under))}ms
edd16cfc 300 and map { $build->{'options'}{$_} = 1 } split m{\s+|\n} => $1;
b4ade012 301
edd16cfc 302 $build->{'osname'} = $config{'osname'};
b4ade012 303 $pv =~ m{^\s+Built under\s+(.*)}m
edd16cfc
MB
304 and $build->{'osname'} = $1;
305 $config{'osname'} ||= $build->{'osname'};
b4ade012 306
4b07058c 307 return _make_derived ({
edd16cfc
MB
308 'build' => $build,
309 'environment' => {},
310 'config' => \%config,
311 'derived' => {},
312 'inc' => [],
4b07058c
RS
313 });
314 } # plv2hash
315
275d368b 316sub summary {
4b07058c 317 my $conf = shift || myconfig ();
eeb5a5dc 318 ref $conf eq "HASH"
edd16cfc
MB
319 && exists $conf->{'config'}
320 && exists $conf->{'build'}
321 && ref $conf->{'config'} eq "HASH"
322 && ref $conf->{'build'} eq "HASH" or return;
4b07058c
RS
323
324 my %info = map {
edd16cfc 325 exists $conf->{'config'}{$_} ? ( $_ => $conf->{'config'}{$_} ) : () }
4b07058c
RS
326 qw( archname osname osvers revision patchlevel subversion version
327 cc ccversion gccversion config_args inc_version_list
328 d_longdbl d_longlong use64bitall use64bitint useithreads
329 uselongdouble usemultiplicity usemymalloc useperlio useshrplib
330 doublesize intsize ivsize nvsize longdblsize longlongsize lseeksize
275d368b 331 default_inc_excludes_dot
4b07058c 332 );
edd16cfc 333 $info{$_}++ for grep { $conf->{'build'}{'options'}{$_} } keys %{$conf->{'build'}{'options'}};
4b07058c
RS
334
335 return \%info;
336 } # summary
337
275d368b 338sub signature {
eeb5a5dc
CBW
339 my $no_md5 = "0" x 32;
340 my $conf = summary (shift) or return $no_md5;
341
4b07058c 342 eval { require Digest::MD5 };
eeb5a5dc
CBW
343 $@ and return $no_md5;
344
edd16cfc
MB
345 $conf->{'cc'} =~ s{.*\bccache\s+}{};
346 $conf->{'cc'} =~ s{.*[/\\]}{};
4b07058c 347
edd16cfc 348 delete $conf->{'config_args'};
4b07058c
RS
349 return Digest::MD5::md5_hex (join "\xFF" => map {
350 "$_=".(defined $conf->{$_} ? $conf->{$_} : "\xFE");
edd16cfc 351 } sort keys %{$conf});
4b07058c
RS
352 } # signature
353
275d368b 354sub myconfig {
4b07058c 355 my $args = shift;
edd16cfc
MB
356 my %args = ref $args eq "HASH" ? %{$args} :
357 ref $args eq "ARRAY" ? @{$args} : ();
4b07058c
RS
358
359 my $build = { %empty_build };
360
361 # 5.14.0 and later provide all the information without shelling out
362 my $stamp = eval { Config::compile_date () };
363 if (defined $stamp) {
364 $stamp =~ s/^Compiled at //;
edd16cfc
MB
365 $build->{'osname'} = $^O;
366 $build->{'stamp'} = $stamp;
367 $build->{'patches'} = [ Config::local_patches () ];
368 $build->{'options'}{$_} = 1 for Config::bincompat_options (),
369 Config::non_bincompat_options ();
4b07058c
RS
370 }
371 else {
372 #y $pv = qx[$^X -e"sub Config::myconfig{};" -V];
b4ade012
MB
373 my $cnf = plv2hash (qx[$^X -V]);
374
edd16cfc 375 $build->{$_} = $cnf->{'build'}{$_} for qw( osname stamp patches options );
4b07058c
RS
376 }
377
378 my @KEYS = keys %ENV;
379 my %env =
edd16cfc
MB
380 map {( $_ => $ENV{$_} )} grep m{^PERL} => @KEYS;
381 if ($args{'env'}) {
382 $env{$_} = $ENV{$_} for grep m{$args{'env'}} => @KEYS;
383 }
4b07058c
RS
384
385 my %config = map { $_ => $Config{$_} } @config_vars;
386
387 return _make_derived ({
edd16cfc
MB
388 'build' => $build,
389 'environment' => \%env,
390 'config' => \%config,
391 'derived' => {},
392 'inc' => \@INC,
4b07058c
RS
393 });
394 } # myconfig
395
3961;
397
398__END__
399
400=head1 NAME
401
402Config::Perl::V - Structured data retrieval of perl -V output
403
404=head1 SYNOPSIS
405
406 use Config::Perl::V;
407
408 my $local_config = Config::Perl::V::myconfig ();
409 print $local_config->{config}{osname};
410
411=head1 DESCRIPTION
412
413=head2 $conf = myconfig ()
414
72b2b1d9 415This function will collect the data described in L</"The hash structure"> below,
4b07058c 416and return that as a hash reference. It optionally accepts an option to
72b2b1d9 417include more entries from %ENV. See L</environment> below.
4b07058c
RS
418
419Note that this will not work on uninstalled perls when called with
420C<-I/path/to/uninstalled/perl/lib>, but it works when that path is in
421C<$PERL5LIB> or in C<$PERL5OPT>, as paths passed using C<-I> are not
422known when the C<-V> information is collected.
423
424=head2 $conf = plv2hash ($text [, ...])
425
426Convert a sole 'perl -V' text block, or list of lines, to a complete
427myconfig hash. All unknown entries are defaulted.
428
429=head2 $info = summary ([$conf])
430
431Return an arbitrary selection of the information. If no C<$conf> is
432given, C<myconfig ()> is used instead.
433
434=head2 $md5 = signature ([$conf])
435
436Return the MD5 of the info returned by C<summary ()> without the
437C<config_args> entry.
438
439If C<Digest::MD5> is not available, it return a string with only C<0>'s.
440
441=head2 The hash structure
442
443The returned hash consists of 4 parts:
444
445=over 4
446
447=item build
448
449This information is extracted from the second block that is emitted by
450C<perl -V>, and usually looks something like
451
452 Characteristics of this binary (from libperl):
453 Compile-time options: DEBUGGING USE_64_BIT_INT USE_LARGE_FILES
454 Locally applied patches:
455 defined-or
456 MAINT24637
457 Built under linux
458 Compiled at Jun 13 2005 10:44:20
459 @INC:
460 /usr/lib/perl5/5.8.7/i686-linux-64int
461 /usr/lib/perl5/5.8.7
462 /usr/lib/perl5/site_perl/5.8.7/i686-linux-64int
463 /usr/lib/perl5/site_perl/5.8.7
464 /usr/lib/perl5/site_perl
465 .
466
467or
468
469 Characteristics of this binary (from libperl):
470 Compile-time options: DEBUGGING MULTIPLICITY
471 PERL_DONT_CREATE_GVSV PERL_IMPLICIT_CONTEXT
472 PERL_MALLOC_WRAP PERL_TRACK_MEMPOOL
473 PERL_USE_SAFE_PUTENV USE_ITHREADS
474 USE_LARGE_FILES USE_PERLIO
475 USE_REENTRANT_API
476 Built under linux
477 Compiled at Jan 28 2009 15:26:59
478
479This information is not available anywhere else, including C<%Config>,
480but it is the information that is only known to the perl binary.
481
482The extracted information is stored in 5 entries in the C<build> hash:
483
484=over 4
485
486=item osname
487
488This is most likely the same as C<$Config{osname}>, and was the name
489known when perl was built. It might be different if perl was cross-compiled.
490
491The default for this field, if it cannot be extracted, is to copy
492C<$Config{osname}>. The two may be differing in casing (OpenBSD vs openbsd).
493
494=item stamp
495
496This is the time string for which the perl binary was compiled. The default
497value is 0.
498
499=item options
500
501This is a hash with all the known defines as keys. The value is either 0,
502which means unknown or unset, or 1, which means defined.
503
504=item derived
505
506As some variables are reported by a different name in the output of C<perl -V>
507than their actual name in C<%Config>, I decided to leave the C<config> entry
508as close to reality as possible, and put in the entries that might have been
509guessed by the printed output in a separate block.
510
511=item patches
512
513This is a list of optionally locally applied patches. Default is an empty list.
514
515=back
516
517=item environment
518
519By default this hash is only filled with the environment variables
520out of %ENV that start with C<PERL>, but you can pass the C<env> option
521to myconfig to get more
522
523 my $conf = Config::Perl::V::myconfig ({ env => qr/^ORACLE/ });
524 my $conf = Config::Perl::V::myconfig ([ env => qr/^ORACLE/ ]);
525
526=item config
527
528This hash is filled with the variables that C<perl -V> fills its report
529with, and it has the same variables that C<Config::myconfig> returns
530from C<%Config>.
531
532=item inc
533
534This is the list of default @INC.
535
536=back
537
538=head1 REASONING
539
540This module was written to be able to return the configuration for the
541currently used perl as deeply as needed for the CPANTESTERS framework.
542Up until now they used the output of myconfig as a single text blob,
543and so it was missing the vital binary characteristics of the running
544perl and the optional applied patches.
545
546=head1 BUGS
547
548Please feedback what is wrong
549
550=head1 TODO
551
552 * Implement retrieval functions/methods
553 * Documentation
554 * Error checking
555 * Tests
556
557=head1 AUTHOR
558
559H.Merijn Brand <h.m.brand@xs4all.nl>
560
561=head1 COPYRIGHT AND LICENSE
562
3eb80770 563Copyright (C) 2009-2022 H.Merijn Brand
4b07058c
RS
564
565This library is free software; you can redistribute it and/or modify
566it under the same terms as Perl itself.
567
568=cut