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