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