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
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.19";
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_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
112 # 1. Always present in %Config - lib/Config.pm #87 tie %Config
113 # 2. Reported by 'perl -V' (the rest)
114 my @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
175 my %empty_build = (
176     osname  => "",
177     stamp   => 0,
178     options => { %BTD },
179     patches => [],
180     );
181
182 sub _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
225 sub 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
270 sub 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
289 sub 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
301 sub 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;
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;
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
354 1;
355
356 __END__
357
358 =head1 NAME
359
360 Config::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
373 This function will collect the data described in L<the hash structure> below,
374 and return that as a hash reference. It optionally accepts an option to
375 include more entries from %ENV. See L<environment> below.
376
377 Note that this will not work on uninstalled perls when called with
378 C<-I/path/to/uninstalled/perl/lib>, but it works when that path is in
379 C<$PERL5LIB> or in C<$PERL5OPT>, as paths passed using C<-I> are not
380 known when the C<-V> information is collected.
381
382 =head2 $conf = plv2hash ($text [, ...])
383
384 Convert a sole 'perl -V' text block, or list of lines, to a complete
385 myconfig hash.  All unknown entries are defaulted.
386
387 =head2 $info = summary ([$conf])
388
389 Return an arbitrary selection of the information. If no C<$conf> is
390 given, C<myconfig ()> is used instead.
391
392 =head2 $md5 = signature ([$conf])
393
394 Return the MD5 of the info returned by C<summary ()> without the
395 C<config_args> entry.
396
397 If C<Digest::MD5> is not available, it return a string with only C<0>'s.
398
399 =head2 The hash structure
400
401 The returned hash consists of 4 parts:
402
403 =over 4
404
405 =item build
406
407 This information is extracted from the second block that is emitted by
408 C<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
425 or
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
437 This information is not available anywhere else, including C<%Config>,
438 but it is the information that is only known to the perl binary.
439
440 The extracted information is stored in 5 entries in the C<build> hash:
441
442 =over 4
443
444 =item osname
445
446 This is most likely the same as C<$Config{osname}>, and was the name
447 known when perl was built. It might be different if perl was cross-compiled.
448
449 The default for this field, if it cannot be extracted, is to copy
450 C<$Config{osname}>. The two may be differing in casing (OpenBSD vs openbsd).
451
452 =item stamp
453
454 This is the time string for which the perl binary was compiled. The default
455 value is 0.
456
457 =item options
458
459 This is a hash with all the known defines as keys. The value is either 0,
460 which means unknown or unset, or 1, which means defined.
461
462 =item derived
463
464 As some variables are reported by a different name in the output of C<perl -V>
465 than their actual name in C<%Config>, I decided to leave the C<config> entry
466 as close to reality as possible, and put in the entries that might have been
467 guessed by the printed output in a separate block.
468
469 =item patches
470
471 This is a list of optionally locally applied patches. Default is an empty list.
472
473 =back
474
475 =item environment
476
477 By default this hash is only filled with the environment variables
478 out of %ENV that start with C<PERL>, but you can pass the C<env> option
479 to 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
486 This hash is filled with the variables that C<perl -V> fills its report
487 with, and it has the same variables that C<Config::myconfig> returns
488 from C<%Config>.
489
490 =item inc
491
492 This is the list of default @INC.
493
494 =back
495
496 =head1 REASONING
497
498 This module was written to be able to return the configuration for the
499 currently used perl as deeply as needed for the CPANTESTERS framework.
500 Up until now they used the output of myconfig as a single text blob,
501 and so it was missing the vital binary characteristics of the running
502 perl and the optional applied patches.
503
504 =head1 BUGS
505
506 Please 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
517 H.Merijn Brand <h.m.brand@xs4all.nl>
518
519 =head1 COPYRIGHT AND LICENSE
520
521 Copyright (C) 2009-2013 H.Merijn Brand
522
523 This library is free software; you can redistribute it and/or modify
524 it under the same terms as Perl itself.
525
526 =cut