Update copyright to 2013
[Config-Perl-V.git] / V.pm
blobaebde80700a2f5da6f704de7a50144deb40ef1d7
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.16";
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 1768 (first block)
26 # perl.h line 4454 (second block),
27 my %BTD = map { $_ => 0 } qw(
29 DEBUGGING
30 NO_MATHOMS
31 PERL_DISABLE_PMC
32 PERL_DONT_CREATE_GVSV
33 PERL_IS_MINIPERL
34 PERL_MALLOC_WRAP
35 PERL_MEM_LOG
36 PERL_MEM_LOG_ENV
37 PERL_MEM_LOG_ENV_FD
38 PERL_MEM_LOG_STDERR
39 PERL_MEM_LOG_TIMESTAMP
40 PERL_USE_DEVEL
41 PERL_USE_SAFE_PUTENV
42 USE_ATTRIBUTES_FOR_PERLIO
43 USE_FAST_STDIO
44 USE_PERL_ATOF
45 USE_SITECUSTOMIZE
47 DEBUG_LEAKING_SCALARS
48 DEBUG_LEAKING_SCALARS_FORK_DUMP
49 DECCRTL_SOCKETS
50 FAKE_THREADS
51 MULTIPLICITY
52 MYMALLOC
53 PERL_DEBUG_READONLY_OPS
54 PERL_GLOBAL_STRUCT
55 PERL_IMPLICIT_CONTEXT
56 PERL_IMPLICIT_SYS
57 PERL_MAD
58 PERL_NEED_APPCTX
59 PERL_NEED_TIMESBASE
60 PERL_OLD_COPY_ON_WRITE
61 PERL_POISON
62 PERL_TRACK_MEMPOOL
63 PERL_USES_PL_PIDSTATUS
64 PL_OP_SLAB_ALLOC
65 THREADS_HAVE_PIDS
66 USE_64_BIT_ALL
67 USE_64_BIT_INT
68 USE_IEEE
69 USE_ITHREADS
70 USE_LARGE_FILES
71 USE_LONG_DOUBLE
72 USE_PERLIO
73 USE_REENTRANT_API
74 USE_SFIO
75 USE_SOCKS
76 VMS_DO_SOCKETS
77 VMS_SYMBOL_CASE_AS_IS
80 # These are all the keys that are
81 # 1. Always present in %Config (first block)
82 # 2. Reported by 'perl -V' (the rest)
83 my @config_vars = qw(
85 api_subversion
86 api_version
87 api_versionstring
88 archlibexp
89 dont_use_nlink
90 d_readlink
91 d_symlink
92 exe_ext
93 inc_version_list
94 ldlibpthname
95 patchlevel
96 path_sep
97 perl_patchlevel
98 privlibexp
99 scriptdir
100 sitearchexp
101 sitelibexp
102 subversion
103 usevendorprefix
104 version
106 git_commit_id
107 git_describe
108 git_branch
109 git_uncommitted_changes
110 git_commit_id_title
111 git_snapshot_date
113 package revision version_patchlevel_string
115 osname osvers archname
116 myuname
117 config_args
118 hint useposix d_sigaction
119 useithreads usemultiplicity
120 useperlio d_sfio uselargefiles usesocks
121 use64bitint use64bitall uselongdouble
122 usemymalloc bincompat5005
124 cc ccflags
125 optimize
126 cppflags
127 ccversion gccversion gccosandvers
128 intsize longsize ptrsize doublesize byteorder
129 d_longlong longlongsize d_longdbl longdblsize
130 ivtype ivsize nvtype nvsize lseektype lseeksize
131 alignbytes prototype
133 ld ldflags
134 libpth
135 libs
136 perllibs
137 libc so useshrplib libperl
138 gnulibc_version
140 dlsrc dlext d_dlsymun ccdlflags
141 cccdlflags lddlflags
144 my %empty_build = (
145 osname => "",
146 stamp => 0,
147 options => { %BTD },
148 patches => [],
151 sub _make_derived
153 my $conf = shift;
155 for ( [ lseektype => "Off_t" ],
156 [ myuname => "uname" ],
157 [ perl_patchlevel => "patch" ],
159 my ($official, $derived) = @$_;
160 $conf->{config}{$derived} ||= $conf->{config}{$official};
161 $conf->{config}{$official} ||= $conf->{config}{$derived};
162 $conf->{derived}{$derived} = delete $conf->{config}{$derived};
165 if (exists $conf->{config}{version_patchlevel_string} &&
166 !exists $conf->{config}{api_version}) {
167 my $vps = $conf->{config}{version_patchlevel_string};
168 $vps =~ s{\b revision \s+ (\S+) }{}x and
169 $conf->{config}{revision} ||= $1;
171 $vps =~ s{\b version \s+ (\S+) }{}x and
172 $conf->{config}{api_version} ||= $1;
173 $vps =~ s{\b subversion \s+ (\S+) }{}x and
174 $conf->{config}{subversion} ||= $1;
175 $vps =~ s{\b patch \s+ (\S+) }{}x and
176 $conf->{config}{perl_patchlevel} ||= $1;
179 ($conf->{config}{version_patchlevel_string} ||= join " ",
180 map { ($_, $conf->{config}{$_} ) }
181 grep { $conf->{config}{$_} }
182 qw( api_version subversion perl_patchlevel )) =~ s/\bperl_//;
184 $conf->{config}{perl_patchlevel} ||= ""; # 0 is not a valid patchlevel
186 if ($conf->{config}{perl_patchlevel} =~ m{^git\w*-([^-]+)}i) {
187 $conf->{config}{git_branch} ||= $1;
188 $conf->{config}{git_describe} ||= $conf->{config}{perl_patchlevel};
191 $conf;
192 } # _make_derived
194 sub plv2hash
196 my %config;
197 for (split m/\n+/ => join "\n", @_) {
199 if (s/^Summary of my\s+(\S+)\s+\(\s*(.*?)\s*\)//) {
200 $config{"package"} = $1;
201 my $rev = $2;
202 $rev =~ s/^ revision \s+ (\S+) \s*//x and $config{revision} = $1;
203 $rev and $config{version_patchlevel_string} = $rev;
204 my ($rel) = $config{package} =~ m{perl(\d)};
205 my ($vers, $subvers) = $rev =~ m{version\s+(\d+)\s+subversion\s+(\d+)};
206 defined $vers && defined $subvers && defined $rel and
207 $config{version} = "$rel.$vers.$subvers";
208 next;
211 if (s/^\s+(Snapshot of:)\s+(\S+)//) {
212 $config{git_commit_id_title} = $1;
213 $config{git_commit_id} = $2;
214 next;
217 my %kv = m/\G,?\s*([^=]+)=('[^']+?'|\S+)/gc;
219 while (my ($k, $v) = each %kv) {
220 $k =~ s/\s+$//;
221 $v =~ s/,$//;
222 $v =~ m/^'(.*)'$/ and $v = $1;
223 $v =~ s/^\s+//;
224 $v =~ s/\s+$//;
225 $config{$k} = $v;
228 my $build = { %empty_build };
229 $build->{osname} = $config{osname};
230 return _make_derived ({
231 build => $build,
232 environment => {},
233 config => \%config,
234 derived => {},
235 inc => [],
237 } # plv2hash
239 sub summary
241 my $conf = shift || myconfig ();
242 ref $conf eq "HASH" &&
243 exists $conf->{config} && exists $conf->{build} or return;
245 my %info = map {
246 exists $conf->{config}{$_} ? ( $_ => $conf->{config}{$_} ) : () }
247 qw( archname osname osvers revision patchlevel subversion version
248 cc ccversion gccversion config_args inc_version_list
249 d_longdbl d_longlong use64bitall use64bitint useithreads
250 uselongdouble usemultiplicity usemymalloc useperlio useshrplib
251 doublesize intsize ivsize nvsize longdblsize longlongsize lseeksize
253 $info{$_}++ for grep { $conf->{build}{options}{$_} } keys %{$conf->{build}{options}};
255 return \%info;
256 } # summary
258 sub signature
260 eval { require Digest::MD5 };
261 $@ and return "00000000000000000000000000000000";
263 my $conf = shift || summary ();
264 delete $conf->{config_args};
265 return Digest::MD5::md5_hex (join "\xFF" => map {
266 "$_=".(defined $conf->{$_} ? $conf->{$_} : "\xFE");
267 } sort keys %$conf);
268 } # signature
270 sub myconfig
272 my $args = shift;
273 my %args = ref $args eq "HASH" ? %$args :
274 ref $args eq "ARRAY" ? @$args : ();
276 my $build = { %empty_build };
278 # 5.14.0 and later provide all the information without shelling out
279 my $stamp = eval { Config::compile_date () };
280 if (defined $stamp) {
281 $stamp =~ s/^Compiled at //;
282 $build->{osname} = $^O;
283 $build->{stamp} = $stamp;
284 $build->{patches} = [ Config::local_patches () ];
285 $build->{options}{$_} = 1 for Config::bincompat_options (),
286 Config::non_bincompat_options ();
288 else {
289 #y $pv = qx[$^X -e"sub Config::myconfig{};" -V];
290 my $pv = qx[$^X -V];
291 $pv =~ s{.*?\n\n}{}s;
292 $pv =~ s{\n(?: \s+|\t\s*)}{ }g;
294 #print $pv;
296 $pv =~ m{^\s+Built under (.*)}m and $build->{osname} = $1;
297 $pv =~ m{^\s+Compiled at (.*)}m and $build->{stamp} = $1;
298 $pv =~ m{^\s+Locally applied patches:\s+(.*)}m and $build->{patches} = [ split m/\s+/, $1 ];
299 $pv =~ m{^\s+Compile-time options:\s+(.*)}m and map { $build->{options}{$_} = 1 } split m/\s+/, $1;
302 my @KEYS = keys %ENV;
303 my %env =
304 map { $_ => $ENV{$_} } grep m/^PERL/ => @KEYS;
305 $args{env} and
306 map { $env{$_} = $ENV{$_} } grep m{$args{env}} => @KEYS;
308 my %config = map { $_ => $Config{$_} } @config_vars;
310 return _make_derived ({
311 build => $build,
312 environment => \%env,
313 config => \%config,
314 derived => {},
315 inc => \@INC,
317 } # myconfig
321 __END__
323 =head1 NAME
325 Config::Perl::V - Structured data retrieval of perl -V output
327 =head1 SYNOPSIS
329 use Config::Perl::V;
331 my $local_config = Config::Perl::V::myconfig ();
332 print $local_config->{config}{osname};
334 =head1 DESCRIPTION
336 =head2 $conf = myconfig ()
338 This function will collect the data described in L<the hash structure> below,
339 and return that as a hash reference. It optionally accepts an option to
340 include more entries from %ENV. See L<environment> below.
342 Note that this will not work on uninstalled perls when called with
343 C<-I/path/to/uninstalled/perl/lib>, but it works when that path is in
344 C<$PERL5LIB> or in C<$PERL5OPT>, as paths passed using C<-I> are not
345 known when the C<-V> information is collected.
347 =head2 $conf = plv2hash ($text [, ...])
349 Convert a sole 'perl -V' text block, or list of lines, to a complete
350 myconfig hash. All unknown entries are defaulted.
352 =head2 $info = summary ([$conf])
354 Return an arbitrary selection of the information. If no C<$conf> is
355 given, C<myconfig ()> is used instead.
357 =head2 $md5 = signature ([$conf])
359 Return the MD5 of the info returned by C<summary ()> without the
360 C<config_args> entry.
362 If C<Digest::MD5> is not available, it return a string with only C<0>'s.
364 =head2 The hash structure
366 The returned hash consists of 4 parts:
368 =over 4
370 =item build
372 This information is extracted from the second block that is emitted by
373 C<perl -V>, and usually looks something like
375 Characteristics of this binary (from libperl):
376 Compile-time options: DEBUGGING USE_64_BIT_INT USE_LARGE_FILES
377 Locally applied patches:
378 defined-or
379 MAINT24637
380 Built under linux
381 Compiled at Jun 13 2005 10:44:20
382 @INC:
383 /usr/lib/perl5/5.8.7/i686-linux-64int
384 /usr/lib/perl5/5.8.7
385 /usr/lib/perl5/site_perl/5.8.7/i686-linux-64int
386 /usr/lib/perl5/site_perl/5.8.7
387 /usr/lib/perl5/site_perl
392 Characteristics of this binary (from libperl):
393 Compile-time options: DEBUGGING MULTIPLICITY
394 PERL_DONT_CREATE_GVSV PERL_IMPLICIT_CONTEXT
395 PERL_MALLOC_WRAP PERL_TRACK_MEMPOOL
396 PERL_USE_SAFE_PUTENV USE_ITHREADS
397 USE_LARGE_FILES USE_PERLIO
398 USE_REENTRANT_API
399 Built under linux
400 Compiled at Jan 28 2009 15:26:59
402 This information is not available anywhere else, including C<%Config>,
403 but it is the information that is only known to the perl binary.
405 The extracted information is stored in 5 entries in the C<build> hash:
407 =over 4
409 =item osname
411 This is most likely the same as C<$Config{osname}>, and was the name
412 known when perl was built. It might be different if perl was cross-compiled.
414 The default for this field, if it cannot be extracted, is to copy
415 C<$Config{osname}>. The two may be differing in casing (OpenBSD vs openbsd).
417 =item stamp
419 This is the time string for which the perl binary was compiled. The default
420 value is 0.
422 =item options
424 This is a hash with all the known defines as keys. The value is either 0,
425 which means unknown or unset, or 1, which means defined.
427 =item derived
429 As some variables are reported by a different name in the output of C<perl -V>
430 than their actual name in C<%Config>, I decided to leave the C<config> entry
431 as close to reality as possible, and put in the entries that might have been
432 guessed by the printed output in a separate block.
434 =item patches
436 This is a list of optionally locally applied patches. Default is an empty list.
438 =back
440 =item environment
442 By default this hash is only filled with the environment variables
443 out of %ENV that start with C<PERL>, but you can pass the C<env> option
444 to myconfig to get more
446 my $conf = Config::Perl::V::myconfig ({ env => qr/^ORACLE/ });
447 my $conf = Config::Perl::V::myconfig ([ env => qr/^ORACLE/ ]);
449 =item config
451 This hash is filled with the variables that C<perl -V> fills its report
452 with, and it has the same variables that C<Config::myconfig> returns
453 from C<%Config>.
455 =item inc
457 This is the list of default @INC.
459 =back
461 =head1 REASONING
463 This module was written to be able to return the configuration for the
464 currently used perl as deeply as needed for the CPANTESTERS framework.
465 Up until now they used the output of myconfig as a single text blob,
466 and so it was missing the vital binary characteristics of the running
467 perl and the optional applied patches.
469 =head1 BUGS
471 Please feedback what is wrong
473 =head1 TODO
475 * Implement retrieval functions/methods
476 * Documentation
477 * Error checking
478 * Tests
480 =head1 AUTHOR
482 H.Merijn Brand <h.m.brand@xs4all.nl>
484 =head1 COPYRIGHT AND LICENSE
486 Copyright (C) 2009-2013 H.Merijn Brand
488 This library is free software; you can redistribute it and/or modify
489 it under the same terms as Perl itself.
491 =cut