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