That test was not testing what it was supposed to test :)
[Config-Perl-V.git] / V.pm
blobe5d9681982f368421c1aee9498ac4827a62f19fb
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.21";
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_MATHOMS
33 NO_HASH_SEED
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_SIPHASH
40 PERL_HASH_FUNC_SDBM
41 PERL_HASH_FUNC_DJB2
42 PERL_HASH_FUNC_SUPERFAST
43 PERL_HASH_FUNC_MURMUR3
44 PERL_HASH_FUNC_ONE_AT_A_TIME
45 PERL_HASH_FUNC_ONE_AT_A_TIME_HARD
46 PERL_HASH_FUNC_ONE_AT_A_TIME_OLD
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 PERLIO_LAYERS
82 PERL_DEBUG_READONLY_COW
83 PERL_DEBUG_READONLY_OPS
84 PERL_GLOBAL_STRUCT
85 PERL_IMPLICIT_CONTEXT
86 PERL_IMPLICIT_SYS
87 PERL_MAD
88 PERL_MICRO
89 PERL_NEED_APPCTX
90 PERL_NEED_TIMESBASE
91 PERL_OLD_COPY_ON_WRITE
92 PERL_POISON
93 PERL_SAWAMPERSAND
94 PERL_TRACK_MEMPOOL
95 PERL_USES_PL_PIDSTATUS
96 PL_OP_SLAB_ALLOC
97 THREADS_HAVE_PIDS
98 USE_64_BIT_ALL
99 USE_64_BIT_INT
100 USE_IEEE
101 USE_ITHREADS
102 USE_LARGE_FILES
103 USE_LOCALE_COLLATE
104 USE_LOCALE_NUMERIC
105 USE_LONG_DOUBLE
106 USE_PERLIO
107 USE_REENTRANT_API
108 USE_SFIO
109 USE_SOCKS
110 VMS_DO_SOCKETS
111 VMS_SHORTEN_LONG_SYMBOLS
112 VMS_SYMBOL_CASE_AS_IS
115 # These are all the keys that are
116 # 1. Always present in %Config - lib/Config.pm #87 tie %Config
117 # 2. Reported by 'perl -V' (the rest)
118 my @config_vars = qw(
120 api_subversion
121 api_version
122 api_versionstring
123 archlibexp
124 dont_use_nlink
125 d_readlink
126 d_symlink
127 exe_ext
128 inc_version_list
129 ldlibpthname
130 patchlevel
131 path_sep
132 perl_patchlevel
133 privlibexp
134 scriptdir
135 sitearchexp
136 sitelibexp
137 subversion
138 usevendorprefix
139 version
141 git_commit_id
142 git_describe
143 git_branch
144 git_uncommitted_changes
145 git_commit_id_title
146 git_snapshot_date
148 package revision version_patchlevel_string
150 osname osvers archname
151 myuname
152 config_args
153 hint useposix d_sigaction
154 useithreads usemultiplicity
155 useperlio d_sfio uselargefiles usesocks
156 use64bitint use64bitall uselongdouble
157 usemymalloc bincompat5005
159 cc ccflags
160 optimize
161 cppflags
162 ccversion gccversion gccosandvers
163 intsize longsize ptrsize doublesize byteorder
164 d_longlong longlongsize d_longdbl longdblsize
165 ivtype ivsize nvtype nvsize lseektype lseeksize
166 alignbytes prototype
168 ld ldflags
169 libpth
170 libs
171 perllibs
172 libc so useshrplib libperl
173 gnulibc_version
175 dlsrc dlext d_dlsymun ccdlflags
176 cccdlflags lddlflags
179 my %empty_build = (
180 osname => "",
181 stamp => 0,
182 options => { %BTD },
183 patches => [],
186 sub _make_derived
188 my $conf = shift;
190 for ( [ lseektype => "Off_t" ],
191 [ myuname => "uname" ],
192 [ perl_patchlevel => "patch" ],
194 my ($official, $derived) = @$_;
195 $conf->{config}{$derived} ||= $conf->{config}{$official};
196 $conf->{config}{$official} ||= $conf->{config}{$derived};
197 $conf->{derived}{$derived} = delete $conf->{config}{$derived};
200 if (exists $conf->{config}{version_patchlevel_string} &&
201 !exists $conf->{config}{api_version}) {
202 my $vps = $conf->{config}{version_patchlevel_string};
203 $vps =~ s{\b revision \s+ (\S+) }{}x and
204 $conf->{config}{revision} ||= $1;
206 $vps =~ s{\b version \s+ (\S+) }{}x and
207 $conf->{config}{api_version} ||= $1;
208 $vps =~ s{\b subversion \s+ (\S+) }{}x and
209 $conf->{config}{subversion} ||= $1;
210 $vps =~ s{\b patch \s+ (\S+) }{}x and
211 $conf->{config}{perl_patchlevel} ||= $1;
214 ($conf->{config}{version_patchlevel_string} ||= join " ",
215 map { ($_, $conf->{config}{$_} ) }
216 grep { $conf->{config}{$_} }
217 qw( api_version subversion perl_patchlevel )) =~ s/\bperl_//;
219 $conf->{config}{perl_patchlevel} ||= ""; # 0 is not a valid patchlevel
221 if ($conf->{config}{perl_patchlevel} =~ m{^git\w*-([^-]+)}i) {
222 $conf->{config}{git_branch} ||= $1;
223 $conf->{config}{git_describe} ||= $conf->{config}{perl_patchlevel};
226 $conf;
227 } # _make_derived
229 sub plv2hash
231 my %config;
232 for (split m/\n+/ => join "\n", @_) {
234 if (s/^Summary of my\s+(\S+)\s+\(\s*(.*?)\s*\)//) {
235 $config{"package"} = $1;
236 my $rev = $2;
237 $rev =~ s/^ revision \s+ (\S+) \s*//x and $config{revision} = $1;
238 $rev and $config{version_patchlevel_string} = $rev;
239 my ($rel) = $config{package} =~ m{perl(\d)};
240 my ($vers, $subvers) = $rev =~ m{version\s+(\d+)\s+subversion\s+(\d+)};
241 defined $vers && defined $subvers && defined $rel and
242 $config{version} = "$rel.$vers.$subvers";
243 next;
246 if (s/^\s+(Snapshot of:)\s+(\S+)//) {
247 $config{git_commit_id_title} = $1;
248 $config{git_commit_id} = $2;
249 next;
252 my %kv = m/\G,?\s*([^=]+)=('[^']+?'|\S+)/gc;
254 while (my ($k, $v) = each %kv) {
255 $k =~ s/\s+$//;
256 $v =~ s/,$//;
257 $v =~ m/^'(.*)'$/ and $v = $1;
258 $v =~ s/^\s+//;
259 $v =~ s/\s+$//;
260 $config{$k} = $v;
263 my $build = { %empty_build };
264 $build->{osname} = $config{osname};
265 return _make_derived ({
266 build => $build,
267 environment => {},
268 config => \%config,
269 derived => {},
270 inc => [],
272 } # plv2hash
274 sub summary
276 my $conf = shift || myconfig ();
277 ref $conf eq "HASH" &&
278 exists $conf->{config} && exists $conf->{build} or return;
280 my %info = map {
281 exists $conf->{config}{$_} ? ( $_ => $conf->{config}{$_} ) : () }
282 qw( archname osname osvers revision patchlevel subversion version
283 cc ccversion gccversion config_args inc_version_list
284 d_longdbl d_longlong use64bitall use64bitint useithreads
285 uselongdouble usemultiplicity usemymalloc useperlio useshrplib
286 doublesize intsize ivsize nvsize longdblsize longlongsize lseeksize
288 $info{$_}++ for grep { $conf->{build}{options}{$_} } keys %{$conf->{build}{options}};
290 return \%info;
291 } # summary
293 sub signature
295 eval { require Digest::MD5 };
296 $@ and return "00000000000000000000000000000000";
298 my $conf = shift || summary ();
299 delete $conf->{config_args};
300 return Digest::MD5::md5_hex (join "\xFF" => map {
301 "$_=".(defined $conf->{$_} ? $conf->{$_} : "\xFE");
302 } sort keys %$conf);
303 } # signature
305 sub myconfig
307 my $args = shift;
308 my %args = ref $args eq "HASH" ? %$args :
309 ref $args eq "ARRAY" ? @$args : ();
311 my $build = { %empty_build };
313 # 5.14.0 and later provide all the information without shelling out
314 my $stamp = eval { Config::compile_date () };
315 if (defined $stamp) {
316 $stamp =~ s/^Compiled at //;
317 $build->{osname} = $^O;
318 $build->{stamp} = $stamp;
319 $build->{patches} = [ Config::local_patches () ];
320 $build->{options}{$_} = 1 for Config::bincompat_options (),
321 Config::non_bincompat_options ();
323 else {
324 #y $pv = qx[$^X -e"sub Config::myconfig{};" -V];
325 my $pv = qx[$^X -V];
326 $pv =~ s{.*?\n\n}{}s;
327 $pv =~ s{\n(?: \s+|\t\s*)}{\0}g;
329 # print STDERR $pv;
331 $pv =~ m{^\s+Built under\s+(.*)}m
332 and $build->{osname} = $1;
333 $pv =~ m{^\s+Compiled at\s+(.*)}m
334 and $build->{stamp} = $1;
335 $pv =~ m{^\s+Locally applied patches:(?:\s+|\0)(.*)}m
336 and $build->{patches} = [ split m/\0+/, $1 ];
337 $pv =~ m{^\s+Compile-time options:(?:\s+|\0)(.*)}m
338 and map { $build->{options}{$_} = 1 } split m/\s+|\0/ => $1;
341 my @KEYS = keys %ENV;
342 my %env =
343 map { $_ => $ENV{$_} } grep m/^PERL/ => @KEYS;
344 $args{env} and
345 map { $env{$_} = $ENV{$_} } grep m{$args{env}} => @KEYS;
347 my %config = map { $_ => $Config{$_} } @config_vars;
349 return _make_derived ({
350 build => $build,
351 environment => \%env,
352 config => \%config,
353 derived => {},
354 inc => \@INC,
356 } # myconfig
360 __END__
362 =head1 NAME
364 Config::Perl::V - Structured data retrieval of perl -V output
366 =head1 SYNOPSIS
368 use Config::Perl::V;
370 my $local_config = Config::Perl::V::myconfig ();
371 print $local_config->{config}{osname};
373 =head1 DESCRIPTION
375 =head2 $conf = myconfig ()
377 This function will collect the data described in L<the hash structure> below,
378 and return that as a hash reference. It optionally accepts an option to
379 include more entries from %ENV. See L<environment> below.
381 Note that this will not work on uninstalled perls when called with
382 C<-I/path/to/uninstalled/perl/lib>, but it works when that path is in
383 C<$PERL5LIB> or in C<$PERL5OPT>, as paths passed using C<-I> are not
384 known when the C<-V> information is collected.
386 =head2 $conf = plv2hash ($text [, ...])
388 Convert a sole 'perl -V' text block, or list of lines, to a complete
389 myconfig hash. All unknown entries are defaulted.
391 =head2 $info = summary ([$conf])
393 Return an arbitrary selection of the information. If no C<$conf> is
394 given, C<myconfig ()> is used instead.
396 =head2 $md5 = signature ([$conf])
398 Return the MD5 of the info returned by C<summary ()> without the
399 C<config_args> entry.
401 If C<Digest::MD5> is not available, it return a string with only C<0>'s.
403 =head2 The hash structure
405 The returned hash consists of 4 parts:
407 =over 4
409 =item build
411 This information is extracted from the second block that is emitted by
412 C<perl -V>, and usually looks something like
414 Characteristics of this binary (from libperl):
415 Compile-time options: DEBUGGING USE_64_BIT_INT USE_LARGE_FILES
416 Locally applied patches:
417 defined-or
418 MAINT24637
419 Built under linux
420 Compiled at Jun 13 2005 10:44:20
421 @INC:
422 /usr/lib/perl5/5.8.7/i686-linux-64int
423 /usr/lib/perl5/5.8.7
424 /usr/lib/perl5/site_perl/5.8.7/i686-linux-64int
425 /usr/lib/perl5/site_perl/5.8.7
426 /usr/lib/perl5/site_perl
431 Characteristics of this binary (from libperl):
432 Compile-time options: DEBUGGING MULTIPLICITY
433 PERL_DONT_CREATE_GVSV PERL_IMPLICIT_CONTEXT
434 PERL_MALLOC_WRAP PERL_TRACK_MEMPOOL
435 PERL_USE_SAFE_PUTENV USE_ITHREADS
436 USE_LARGE_FILES USE_PERLIO
437 USE_REENTRANT_API
438 Built under linux
439 Compiled at Jan 28 2009 15:26:59
441 This information is not available anywhere else, including C<%Config>,
442 but it is the information that is only known to the perl binary.
444 The extracted information is stored in 5 entries in the C<build> hash:
446 =over 4
448 =item osname
450 This is most likely the same as C<$Config{osname}>, and was the name
451 known when perl was built. It might be different if perl was cross-compiled.
453 The default for this field, if it cannot be extracted, is to copy
454 C<$Config{osname}>. The two may be differing in casing (OpenBSD vs openbsd).
456 =item stamp
458 This is the time string for which the perl binary was compiled. The default
459 value is 0.
461 =item options
463 This is a hash with all the known defines as keys. The value is either 0,
464 which means unknown or unset, or 1, which means defined.
466 =item derived
468 As some variables are reported by a different name in the output of C<perl -V>
469 than their actual name in C<%Config>, I decided to leave the C<config> entry
470 as close to reality as possible, and put in the entries that might have been
471 guessed by the printed output in a separate block.
473 =item patches
475 This is a list of optionally locally applied patches. Default is an empty list.
477 =back
479 =item environment
481 By default this hash is only filled with the environment variables
482 out of %ENV that start with C<PERL>, but you can pass the C<env> option
483 to myconfig to get more
485 my $conf = Config::Perl::V::myconfig ({ env => qr/^ORACLE/ });
486 my $conf = Config::Perl::V::myconfig ([ env => qr/^ORACLE/ ]);
488 =item config
490 This hash is filled with the variables that C<perl -V> fills its report
491 with, and it has the same variables that C<Config::myconfig> returns
492 from C<%Config>.
494 =item inc
496 This is the list of default @INC.
498 =back
500 =head1 REASONING
502 This module was written to be able to return the configuration for the
503 currently used perl as deeply as needed for the CPANTESTERS framework.
504 Up until now they used the output of myconfig as a single text blob,
505 and so it was missing the vital binary characteristics of the running
506 perl and the optional applied patches.
508 =head1 BUGS
510 Please feedback what is wrong
512 =head1 TODO
514 * Implement retrieval functions/methods
515 * Documentation
516 * Error checking
517 * Tests
519 =head1 AUTHOR
521 H.Merijn Brand <h.m.brand@xs4all.nl>
523 =head1 COPYRIGHT AND LICENSE
525 Copyright (C) 2009-2014 H.Merijn Brand
527 This library is free software; you can redistribute it and/or modify
528 it under the same terms as Perl itself.
530 =cut