package Config::Perl::V; use strict; use warnings; use Config; use Exporter; use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS); $VERSION = "0.32"; @ISA = qw( Exporter ); @EXPORT_OK = qw( plv2hash summary myconfig signature ); %EXPORT_TAGS = ( all => [ @EXPORT_OK ], sig => [ "signature" ], ); # Characteristics of this binary (from libperl): # Compile-time options: DEBUGGING PERL_DONT_CREATE_GVSV PERL_MALLOC_WRAP # USE_64_BIT_INT USE_LARGE_FILES USE_PERLIO # The list are as the perl binary has stored it in PL_bincompat_options # search for it in # perl.c line 1643 S_Internals_V () # perl -ne'(/^S_Internals_V/../^}/)&&s/^\s+"( .*)"/$1/ and print' perl.c # perl.h line 4566 PL_bincompat_options # perl -ne'(/^\w.*PL_bincompat/../^\w}/)&&s/^\s+"( .*)"/$1/ and print' perl.h my %BTD = map { $_ => 0 } qw( DEBUGGING NO_HASH_SEED NO_MATHOMS NO_TAINT_SUPPORT PERL_BOOL_AS_CHAR PERL_COPY_ON_WRITE PERL_DISABLE_PMC PERL_DONT_CREATE_GVSV PERL_EXTERNAL_GLOB PERL_HASH_FUNC_DJB2 PERL_HASH_FUNC_MURMUR3 PERL_HASH_FUNC_ONE_AT_A_TIME PERL_HASH_FUNC_ONE_AT_A_TIME_HARD PERL_HASH_FUNC_ONE_AT_A_TIME_OLD PERL_HASH_FUNC_SDBM PERL_HASH_FUNC_SIPHASH PERL_HASH_FUNC_SUPERFAST PERL_IS_MINIPERL PERL_MALLOC_WRAP PERL_MEM_LOG PERL_MEM_LOG_ENV PERL_MEM_LOG_ENV_FD PERL_MEM_LOG_NOIMPL PERL_MEM_LOG_STDERR PERL_MEM_LOG_TIMESTAMP PERL_NEW_COPY_ON_WRITE PERL_OP_PARENT PERL_PERTURB_KEYS_DETERMINISTIC PERL_PERTURB_KEYS_DISABLED PERL_PERTURB_KEYS_RANDOM PERL_PRESERVE_IVUV PERL_RELOCATABLE_INCPUSH PERL_USE_DEVEL PERL_USE_SAFE_PUTENV SILENT_NO_TAINT_SUPPORT UNLINK_ALL_VERSIONS USE_ATTRIBUTES_FOR_PERLIO USE_FAST_STDIO USE_HASH_SEED_EXPLICIT USE_LOCALE USE_LOCALE_CTYPE USE_NO_REGISTRY USE_PERL_ATOF USE_SITECUSTOMIZE USE_THREAD_SAFE_LOCALE DEBUG_LEAKING_SCALARS DEBUG_LEAKING_SCALARS_FORK_DUMP DECCRTL_SOCKETS FAKE_THREADS FCRYPT HAS_TIMES HAVE_INTERP_INTERN MULTIPLICITY MYMALLOC PERL_DEBUG_READONLY_COW PERL_DEBUG_READONLY_OPS PERL_GLOBAL_STRUCT PERL_GLOBAL_STRUCT_PRIVATE PERL_IMPLICIT_CONTEXT PERL_IMPLICIT_SYS PERLIO_LAYERS PERL_MAD PERL_MICRO PERL_NEED_APPCTX PERL_NEED_TIMESBASE PERL_OLD_COPY_ON_WRITE PERL_POISON PERL_SAWAMPERSAND PERL_TRACK_MEMPOOL PERL_USES_PL_PIDSTATUS PL_OP_SLAB_ALLOC THREADS_HAVE_PIDS USE_64_BIT_ALL USE_64_BIT_INT USE_IEEE USE_ITHREADS USE_LARGE_FILES USE_LOCALE_COLLATE USE_LOCALE_NUMERIC USE_LOCALE_TIME USE_LONG_DOUBLE USE_PERLIO USE_QUADMATH USE_REENTRANT_API USE_SFIO USE_SOCKS VMS_DO_SOCKETS VMS_SHORTEN_LONG_SYMBOLS VMS_SYMBOL_CASE_AS_IS ); # These are all the keys that are # 1. Always present in %Config - lib/Config.pm #87 tie %Config # 2. Reported by 'perl -V' (the rest) my @config_vars = qw( api_subversion api_version api_versionstring archlibexp dont_use_nlink d_readlink d_symlink exe_ext inc_version_list ldlibpthname patchlevel path_sep perl_patchlevel privlibexp scriptdir sitearchexp sitelibexp subversion usevendorprefix version git_commit_id git_describe git_branch git_uncommitted_changes git_commit_id_title git_snapshot_date package revision version_patchlevel_string osname osvers archname myuname config_args hint useposix d_sigaction useithreads usemultiplicity useperlio d_sfio uselargefiles usesocks use64bitint use64bitall uselongdouble usemymalloc default_inc_excludes_dot bincompat5005 cc ccflags optimize cppflags ccversion gccversion gccosandvers intsize longsize ptrsize doublesize byteorder d_longlong longlongsize d_longdbl longdblsize ivtype ivsize nvtype nvsize lseektype lseeksize alignbytes prototype ld ldflags libpth libs perllibs libc so useshrplib libperl gnulibc_version dlsrc dlext d_dlsymun ccdlflags cccdlflags lddlflags ); my %empty_build = ( osname => "", stamp => 0, options => { %BTD }, patches => [], ); sub _make_derived { my $conf = shift; for ( [ lseektype => "Off_t" ], [ myuname => "uname" ], [ perl_patchlevel => "patch" ], ) { my ($official, $derived) = @$_; $conf->{config}{$derived} ||= $conf->{config}{$official}; $conf->{config}{$official} ||= $conf->{config}{$derived}; $conf->{derived}{$derived} = delete $conf->{config}{$derived}; } if (exists $conf->{config}{version_patchlevel_string} && !exists $conf->{config}{api_version}) { my $vps = $conf->{config}{version_patchlevel_string}; $vps =~ s{\b revision \s+ (\S+) }{}x and $conf->{config}{revision} ||= $1; $vps =~ s{\b version \s+ (\S+) }{}x and $conf->{config}{api_version} ||= $1; $vps =~ s{\b subversion \s+ (\S+) }{}x and $conf->{config}{subversion} ||= $1; $vps =~ s{\b patch \s+ (\S+) }{}x and $conf->{config}{perl_patchlevel} ||= $1; } ($conf->{config}{version_patchlevel_string} ||= join " ", map { ($_, $conf->{config}{$_} ) } grep { $conf->{config}{$_} } qw( api_version subversion perl_patchlevel )) =~ s/\bperl_//; $conf->{config}{perl_patchlevel} ||= ""; # 0 is not a valid patchlevel if ($conf->{config}{perl_patchlevel} =~ m{^git\w*-([^-]+)}i) { $conf->{config}{git_branch} ||= $1; $conf->{config}{git_describe} ||= $conf->{config}{perl_patchlevel}; } $conf->{config}{$_} ||= "undef" for grep m/^(?:use|def)/ => @config_vars; $conf; } # _make_derived sub plv2hash { my %config; my $pv = join "\n" => @_; if ($pv =~ m/^Summary of my\s+(\S+)\s+\(\s*(.*?)\s*\)/m) { $config{"package"} = $1; my $rev = $2; $rev =~ s/^ revision \s+ (\S+) \s*//x and $config{revision} = $1; $rev and $config{version_patchlevel_string} = $rev; my ($rel) = $config{"package"} =~ m{perl(\d)}; my ($vers, $subvers) = $rev =~ m{version\s+(\d+)\s+subversion\s+(\d+)}; defined $vers && defined $subvers && defined $rel and $config{version} = "$rel.$vers.$subvers"; } if ($pv =~ m/^\s+(Snapshot of:)\s+(\S+)/) { $config{git_commit_id_title} = $1; $config{git_commit_id} = $2; } # these are always last on line and can have multiple quotation styles for my $k (qw( ccflags ldflags lddlflags )) { $pv =~ s{, \s* $k \s*=\s* (.*) \s*$}{}mx or next; my $v = $1; $v =~ s/\s*,\s*$//; $v =~ s/^(['"])(.*)\1$/$2/; $config{$k} = $v; } if (my %kv = ($pv =~ m{\b (\w+) # key \s*= # assign ( '\s*[^']*?\s*' # quoted value | \S+[^=]*?\s*\n # unquoted running till end of line | \S+ # unquoted value | \s*\n # empty ) (?:,?\s+|\s*\n)? # separator (5.8.x reports did not have a ',' }gx)) { # between every kv pair while (my ($k, $v) = each %kv) { $k =~ s/\s+$//; $v =~ s/\s*\n\z//; $v =~ s/,$//; $v =~ m/^'(.*)'$/ and $v = $1; $v =~ s/\s+$//; $config{$k} = $v; } } my $build = { %empty_build }; $pv =~ m{^\s+Compiled at\s+(.*)}m and $build->{stamp} = $1; $pv =~ m{^\s+Locally applied patches:(?:\s+|\n)(.*?)(?:[\s\n]+Buil[td] under)}ms and $build->{patches} = [ split m/\n+\s*/, $1 ]; $pv =~ m{^\s+Compile-time options:(?:\s+|\n)(.*?)(?:[\s\n]+(?:Locally applied|Buil[td] under))}ms and map { $build->{options}{$_} = 1 } split m/\s+|\n/ => $1; $build->{osname} = $config{osname}; $pv =~ m{^\s+Built under\s+(.*)}m and $build->{osname} = $1; $config{osname} ||= $build->{osname}; return _make_derived ({ build => $build, environment => {}, config => \%config, derived => {}, inc => [], }); } # plv2hash sub summary { my $conf = shift || myconfig (); ref $conf eq "HASH" && exists $conf->{config} && exists $conf->{build} && ref $conf->{config} eq "HASH" && ref $conf->{build} eq "HASH" or return; my %info = map { exists $conf->{config}{$_} ? ( $_ => $conf->{config}{$_} ) : () } qw( archname osname osvers revision patchlevel subversion version cc ccversion gccversion config_args inc_version_list d_longdbl d_longlong use64bitall use64bitint useithreads uselongdouble usemultiplicity usemymalloc useperlio useshrplib doublesize intsize ivsize nvsize longdblsize longlongsize lseeksize default_inc_excludes_dot ); $info{$_}++ for grep { $conf->{build}{options}{$_} } keys %{$conf->{build}{options}}; return \%info; } # summary sub signature { my $no_md5 = "0" x 32; my $conf = summary (shift) or return $no_md5; eval { require Digest::MD5 }; $@ and return $no_md5; $conf->{cc} =~ s{.*\bccache\s+}{}; $conf->{cc} =~ s{.*[/\\]}{}; delete $conf->{config_args}; return Digest::MD5::md5_hex (join "\xFF" => map { "$_=".(defined $conf->{$_} ? $conf->{$_} : "\xFE"); } sort keys %$conf); } # signature sub myconfig { my $args = shift; my %args = ref $args eq "HASH" ? %$args : ref $args eq "ARRAY" ? @$args : (); my $build = { %empty_build }; # 5.14.0 and later provide all the information without shelling out my $stamp = eval { Config::compile_date () }; if (defined $stamp) { $stamp =~ s/^Compiled at //; $build->{osname} = $^O; $build->{stamp} = $stamp; $build->{patches} = [ Config::local_patches () ]; $build->{options}{$_} = 1 for Config::bincompat_options (), Config::non_bincompat_options (); } else { #y $pv = qx[$^X -e"sub Config::myconfig{};" -V]; my $cnf = plv2hash (qx[$^X -V]); $build->{$_} = $cnf->{build}{$_} for qw( osname stamp patches options ); } my @KEYS = keys %ENV; my %env = map { $_ => $ENV{$_} } grep m/^PERL/ => @KEYS; $args{env} and map { $env{$_} = $ENV{$_} } grep m{$args{env}} => @KEYS; my %config = map { $_ => $Config{$_} } @config_vars; return _make_derived ({ build => $build, environment => \%env, config => \%config, derived => {}, inc => \@INC, }); } # myconfig 1; __END__ =head1 NAME Config::Perl::V - Structured data retrieval of perl -V output =head1 SYNOPSIS use Config::Perl::V; my $local_config = Config::Perl::V::myconfig (); print $local_config->{config}{osname}; =head1 DESCRIPTION =head2 $conf = myconfig () This function will collect the data described in L below, and return that as a hash reference. It optionally accepts an option to include more entries from %ENV. See L below. Note that this will not work on uninstalled perls when called with C<-I/path/to/uninstalled/perl/lib>, but it works when that path is in C<$PERL5LIB> or in C<$PERL5OPT>, as paths passed using C<-I> are not known when the C<-V> information is collected. =head2 $conf = plv2hash ($text [, ...]) Convert a sole 'perl -V' text block, or list of lines, to a complete myconfig hash. All unknown entries are defaulted. =head2 $info = summary ([$conf]) Return an arbitrary selection of the information. If no C<$conf> is given, C is used instead. =head2 $md5 = signature ([$conf]) Return the MD5 of the info returned by C without the C entry. If C is not available, it return a string with only C<0>'s. =head2 The hash structure The returned hash consists of 4 parts: =over 4 =item build This information is extracted from the second block that is emitted by C, and usually looks something like Characteristics of this binary (from libperl): Compile-time options: DEBUGGING USE_64_BIT_INT USE_LARGE_FILES Locally applied patches: defined-or MAINT24637 Built under linux Compiled at Jun 13 2005 10:44:20 @INC: /usr/lib/perl5/5.8.7/i686-linux-64int /usr/lib/perl5/5.8.7 /usr/lib/perl5/site_perl/5.8.7/i686-linux-64int /usr/lib/perl5/site_perl/5.8.7 /usr/lib/perl5/site_perl . or Characteristics of this binary (from libperl): Compile-time options: DEBUGGING MULTIPLICITY PERL_DONT_CREATE_GVSV PERL_IMPLICIT_CONTEXT PERL_MALLOC_WRAP PERL_TRACK_MEMPOOL PERL_USE_SAFE_PUTENV USE_ITHREADS USE_LARGE_FILES USE_PERLIO USE_REENTRANT_API Built under linux Compiled at Jan 28 2009 15:26:59 This information is not available anywhere else, including C<%Config>, but it is the information that is only known to the perl binary. The extracted information is stored in 5 entries in the C hash: =over 4 =item osname This is most likely the same as C<$Config{osname}>, and was the name known when perl was built. It might be different if perl was cross-compiled. The default for this field, if it cannot be extracted, is to copy C<$Config{osname}>. The two may be differing in casing (OpenBSD vs openbsd). =item stamp This is the time string for which the perl binary was compiled. The default value is 0. =item options This is a hash with all the known defines as keys. The value is either 0, which means unknown or unset, or 1, which means defined. =item derived As some variables are reported by a different name in the output of C than their actual name in C<%Config>, I decided to leave the C entry as close to reality as possible, and put in the entries that might have been guessed by the printed output in a separate block. =item patches This is a list of optionally locally applied patches. Default is an empty list. =back =item environment By default this hash is only filled with the environment variables out of %ENV that start with C, but you can pass the C option to myconfig to get more my $conf = Config::Perl::V::myconfig ({ env => qr/^ORACLE/ }); my $conf = Config::Perl::V::myconfig ([ env => qr/^ORACLE/ ]); =item config This hash is filled with the variables that C fills its report with, and it has the same variables that C returns from C<%Config>. =item inc This is the list of default @INC. =back =head1 REASONING This module was written to be able to return the configuration for the currently used perl as deeply as needed for the CPANTESTERS framework. Up until now they used the output of myconfig as a single text blob, and so it was missing the vital binary characteristics of the running perl and the optional applied patches. =head1 BUGS Please feedback what is wrong =head1 TODO * Implement retrieval functions/methods * Documentation * Error checking * Tests =head1 AUTHOR H.Merijn Brand =head1 COPYRIGHT AND LICENSE Copyright (C) 2009-2018 H.Merijn Brand This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut