On towards new version
[Config-Perl-V.git] / V.pm
blobfbdf6a4e469f75e9621a32c46a12d96a45e75947
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(\w+)\s*=\s*('[^']+?'|\S+)/g)) {
255 while (my ($k, $v) = each %kv) {
256 $k =~ s/\s+$//;
257 $v =~ s/,$//;
258 $v =~ m/^'(.*)'$/ and $v = $1;
259 $v =~ s/^\s+//;
260 $v =~ s/\s+$//;
261 $config{$k} = $v;
265 my $build = { %empty_build };
267 $pv =~ m{^\s+Compiled at\s+(.*)}m
268 and $build->{stamp} = $1;
269 $pv =~ m{^\s+Locally applied patches:(?:\s+|\n)(.*)}m
270 and $build->{patches} = [ split m/\n+/, $1 ];
271 $pv =~ m{^\s+Compile-time options:(?:\s+|\n)(.*)}m
272 and map { $build->{options}{$_} = 1 } split m/\s+|\n/ => $1;
274 $build->{osname} = $config{osname};
275 $pv =~ m{^\s+Built under\s+(.*)}m
276 and $build->{osname} = $1;
277 $config{osname} ||= $build->{osname};
279 return _make_derived ({
280 build => $build,
281 environment => {},
282 config => \%config,
283 derived => {},
284 inc => [],
286 } # plv2hash
288 sub summary
290 my $conf = shift || myconfig ();
291 ref $conf eq "HASH" &&
292 exists $conf->{config} && exists $conf->{build} or return;
294 my %info = map {
295 exists $conf->{config}{$_} ? ( $_ => $conf->{config}{$_} ) : () }
296 qw( archname osname osvers revision patchlevel subversion version
297 cc ccversion gccversion config_args inc_version_list
298 d_longdbl d_longlong use64bitall use64bitint useithreads
299 uselongdouble usemultiplicity usemymalloc useperlio useshrplib
300 doublesize intsize ivsize nvsize longdblsize longlongsize lseeksize
302 $info{$_}++ for grep { $conf->{build}{options}{$_} } keys %{$conf->{build}{options}};
304 return \%info;
305 } # summary
307 sub signature
309 eval { require Digest::MD5 };
310 $@ and return "00000000000000000000000000000000";
312 my $conf = shift || summary ();
313 delete $conf->{config_args};
314 return Digest::MD5::md5_hex (join "\xFF" => map {
315 "$_=".(defined $conf->{$_} ? $conf->{$_} : "\xFE");
316 } sort keys %$conf);
317 } # signature
319 sub myconfig
321 my $args = shift;
322 my %args = ref $args eq "HASH" ? %$args :
323 ref $args eq "ARRAY" ? @$args : ();
325 my $build = { %empty_build };
327 # 5.14.0 and later provide all the information without shelling out
328 my $stamp = eval { Config::compile_date () };
329 if (defined $stamp) {
330 $stamp =~ s/^Compiled at //;
331 $build->{osname} = $^O;
332 $build->{stamp} = $stamp;
333 $build->{patches} = [ Config::local_patches () ];
334 $build->{options}{$_} = 1 for Config::bincompat_options (),
335 Config::non_bincompat_options ();
337 else {
338 #y $pv = qx[$^X -e"sub Config::myconfig{};" -V];
339 my $cnf = plv2hash (qx[$^X -V]);
341 $build->{$_} = $cnf->{build}{$_} for qw( osname stamp patches options );
344 my @KEYS = keys %ENV;
345 my %env =
346 map { $_ => $ENV{$_} } grep m/^PERL/ => @KEYS;
347 $args{env} and
348 map { $env{$_} = $ENV{$_} } grep m{$args{env}} => @KEYS;
350 my %config = map { $_ => $Config{$_} } @config_vars;
352 return _make_derived ({
353 build => $build,
354 environment => \%env,
355 config => \%config,
356 derived => {},
357 inc => \@INC,
359 } # myconfig
363 __END__
365 =head1 NAME
367 Config::Perl::V - Structured data retrieval of perl -V output
369 =head1 SYNOPSIS
371 use Config::Perl::V;
373 my $local_config = Config::Perl::V::myconfig ();
374 print $local_config->{config}{osname};
376 =head1 DESCRIPTION
378 =head2 $conf = myconfig ()
380 This function will collect the data described in L<the hash structure> below,
381 and return that as a hash reference. It optionally accepts an option to
382 include more entries from %ENV. See L<environment> below.
384 Note that this will not work on uninstalled perls when called with
385 C<-I/path/to/uninstalled/perl/lib>, but it works when that path is in
386 C<$PERL5LIB> or in C<$PERL5OPT>, as paths passed using C<-I> are not
387 known when the C<-V> information is collected.
389 =head2 $conf = plv2hash ($text [, ...])
391 Convert a sole 'perl -V' text block, or list of lines, to a complete
392 myconfig hash. All unknown entries are defaulted.
394 =head2 $info = summary ([$conf])
396 Return an arbitrary selection of the information. If no C<$conf> is
397 given, C<myconfig ()> is used instead.
399 =head2 $md5 = signature ([$conf])
401 Return the MD5 of the info returned by C<summary ()> without the
402 C<config_args> entry.
404 If C<Digest::MD5> is not available, it return a string with only C<0>'s.
406 =head2 The hash structure
408 The returned hash consists of 4 parts:
410 =over 4
412 =item build
414 This information is extracted from the second block that is emitted by
415 C<perl -V>, and usually looks something like
417 Characteristics of this binary (from libperl):
418 Compile-time options: DEBUGGING USE_64_BIT_INT USE_LARGE_FILES
419 Locally applied patches:
420 defined-or
421 MAINT24637
422 Built under linux
423 Compiled at Jun 13 2005 10:44:20
424 @INC:
425 /usr/lib/perl5/5.8.7/i686-linux-64int
426 /usr/lib/perl5/5.8.7
427 /usr/lib/perl5/site_perl/5.8.7/i686-linux-64int
428 /usr/lib/perl5/site_perl/5.8.7
429 /usr/lib/perl5/site_perl
434 Characteristics of this binary (from libperl):
435 Compile-time options: DEBUGGING MULTIPLICITY
436 PERL_DONT_CREATE_GVSV PERL_IMPLICIT_CONTEXT
437 PERL_MALLOC_WRAP PERL_TRACK_MEMPOOL
438 PERL_USE_SAFE_PUTENV USE_ITHREADS
439 USE_LARGE_FILES USE_PERLIO
440 USE_REENTRANT_API
441 Built under linux
442 Compiled at Jan 28 2009 15:26:59
444 This information is not available anywhere else, including C<%Config>,
445 but it is the information that is only known to the perl binary.
447 The extracted information is stored in 5 entries in the C<build> hash:
449 =over 4
451 =item osname
453 This is most likely the same as C<$Config{osname}>, and was the name
454 known when perl was built. It might be different if perl was cross-compiled.
456 The default for this field, if it cannot be extracted, is to copy
457 C<$Config{osname}>. The two may be differing in casing (OpenBSD vs openbsd).
459 =item stamp
461 This is the time string for which the perl binary was compiled. The default
462 value is 0.
464 =item options
466 This is a hash with all the known defines as keys. The value is either 0,
467 which means unknown or unset, or 1, which means defined.
469 =item derived
471 As some variables are reported by a different name in the output of C<perl -V>
472 than their actual name in C<%Config>, I decided to leave the C<config> entry
473 as close to reality as possible, and put in the entries that might have been
474 guessed by the printed output in a separate block.
476 =item patches
478 This is a list of optionally locally applied patches. Default is an empty list.
480 =back
482 =item environment
484 By default this hash is only filled with the environment variables
485 out of %ENV that start with C<PERL>, but you can pass the C<env> option
486 to myconfig to get more
488 my $conf = Config::Perl::V::myconfig ({ env => qr/^ORACLE/ });
489 my $conf = Config::Perl::V::myconfig ([ env => qr/^ORACLE/ ]);
491 =item config
493 This hash is filled with the variables that C<perl -V> fills its report
494 with, and it has the same variables that C<Config::myconfig> returns
495 from C<%Config>.
497 =item inc
499 This is the list of default @INC.
501 =back
503 =head1 REASONING
505 This module was written to be able to return the configuration for the
506 currently used perl as deeply as needed for the CPANTESTERS framework.
507 Up until now they used the output of myconfig as a single text blob,
508 and so it was missing the vital binary characteristics of the running
509 perl and the optional applied patches.
511 =head1 BUGS
513 Please feedback what is wrong
515 =head1 TODO
517 * Implement retrieval functions/methods
518 * Documentation
519 * Error checking
520 * Tests
522 =head1 AUTHOR
524 H.Merijn Brand <h.m.brand@xs4all.nl>
526 =head1 COPYRIGHT AND LICENSE
528 Copyright (C) 2009-2014 H.Merijn Brand
530 This library is free software; you can redistribute it and/or modify
531 it under the same terms as Perl itself.
533 =cut