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