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