[perl5.git] / cpan / Config-Perl-V / V.pm

#!/pro/bin/perl

package Config::Perl::V;

use strict;
use warnings;

use Config;
use Exporter;
use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
$VERSION     = "0.28";
@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

    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} 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 {
    eval { require Digest::MD5 };
    $@ and return "00000000000000000000000000000000";

    my $conf = shift || summary ();
    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<the hash structure> below,
and return that as a hash reference. It optionally accepts an option to
include more entries from %ENV. See L<environment> 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<myconfig ()> is used instead.

=head2 $md5 = signature ([$conf])

Return the MD5 of the info returned by C<summary ()> without the
C<config_args> entry.

If C<Digest::MD5> 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<perl -V>, 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<build> 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<perl -V>
than their actual name in C<%Config>, I decided to leave the C<config> 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<PERL>, but you can pass the C<env> 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<perl -V> fills its report
with, and it has the same variables that C<Config::myconfig> 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 <h.m.brand@xs4all.nl>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2009-2016 H.Merijn Brand

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
Commit	Line	Data
4b07058c RS	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);
275d368b MB	11	$VERSION = "0.28";
275d368b MB	12	@ISA = qw( Exporter );
4b07058c RS	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
21555490 MB	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
4b07058c RS	29	my %BTD = map { $_ => 0 } qw(
	30
	31	DEBUGGING
215cc5d7	32	NO_HASH_SEED
b4ade012	33	NO_MATHOMS
215cc5d7	34	NO_TAINT_SUPPORT
21555490	35	PERL_BOOL_AS_CHAR
9a4196f3	36	PERL_COPY_ON_WRITE
4b07058c RS	37	PERL_DISABLE_PMC
4b07058c RS	38	PERL_DONT_CREATE_GVSV
215cc5d7	39	PERL_EXTERNAL_GLOB
215cc5d7	40	PERL_HASH_FUNC_DJB2
215cc5d7 MB	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
b4ade012 MB	45	PERL_HASH_FUNC_SDBM
	46	PERL_HASH_FUNC_SIPHASH
	47	PERL_HASH_FUNC_SUPERFAST
4b07058c RS	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
215cc5d7	56	PERL_NEW_COPY_ON_WRITE
834069b8	57	PERL_OP_PARENT
215cc5d7 MB	58	PERL_PERTURB_KEYS_DETERMINISTIC
	59	PERL_PERTURB_KEYS_DISABLED
	60	PERL_PERTURB_KEYS_RANDOM
4b07058c RS	61	PERL_PRESERVE_IVUV
	62	PERL_RELOCATABLE_INCPUSH
	63	PERL_USE_DEVEL
	64	PERL_USE_SAFE_PUTENV
6b3eaabc	65	SILENT_NO_TAINT_SUPPORT
4b07058c RS	66	UNLINK_ALL_VERSIONS
	67	USE_ATTRIBUTES_FOR_PERLIO
	68	USE_FAST_STDIO
215cc5d7	69	USE_HASH_SEED_EXPLICIT
4b07058c	70	USE_LOCALE
215cc5d7	71	USE_LOCALE_CTYPE
9a4196f3	72	USE_NO_REGISTRY
4b07058c RS	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
215cc5d7	82	HAVE_INTERP_INTERN
4b07058c RS	83	MULTIPLICITY
4b07058c RS	84	MYMALLOC
21555490	85	PERL_DEBUG_READONLY_COW
4b07058c RS	86	PERL_DEBUG_READONLY_OPS
4b07058c RS	87	PERL_GLOBAL_STRUCT
b4ade012	88	PERL_GLOBAL_STRUCT_PRIVATE
4b07058c RS	89	PERL_IMPLICIT_CONTEXT
4b07058c RS	90	PERL_IMPLICIT_SYS
b4ade012	91	PERLIO_LAYERS
4b07058c RS	92	PERL_MAD
	93	PERL_MICRO
	94	PERL_NEED_APPCTX
	95	PERL_NEED_TIMESBASE
	96	PERL_OLD_COPY_ON_WRITE
4b07058c RS	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
b4ade012	110	USE_LOCALE_TIME
4b07058c RS	111	USE_LONG_DOUBLE
4b07058c RS	112	USE_PERLIO
6fdf23c2	113	USE_QUADMATH
4b07058c RS	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
215cc5d7	123	# 1. Always present in %Config - lib/Config.pm #87 tie %Config
4b07058c RS	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
275d368b	164	usemymalloc default_inc_excludes_dot bincompat5005
4b07058c RS	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
275d368b	193	sub _make_derived {
4b07058c RS	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
275d368b MB	232	$conf->{config}{$_} \|\|= "undef" for grep m/^(?:use\|def)/ => @config_vars;
275d368b MB	233
4b07058c RS	234	$conf;
	235	} # _make_derived
	236
275d368b	237	sub plv2hash {
4b07058c	238	my %config;
4b07058c	239
b4ade012 MB	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	}
4b07058c	257
6b3eaabc MB	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
60df6830 MB	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
4b07058c RS	277
	278	while (my ($k, $v) = each %kv) {
	279	$k =~ s/\s+$//;
60df6830	280	$v =~ s/\s*\n\z//;
4b07058c RS	281	$v =~ s/,$//;
4b07058c RS	282	$v =~ m/^'(.*)'$/ and $v = $1;
4b07058c RS	283	$v =~ s/\s+$//;
	284	$config{$k} = $v;
	285	}
	286	}
b4ade012	287
4b07058c	288	my $build = { %empty_build };
b4ade012 MB	289
	290	$pv =~ m{^\s+Compiled at\s+(.*)}m
	291	and $build->{stamp} = $1;
60df6830 MB	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
b4ade012 MB	295	and map { $build->{options}{$_} = 1 } split m/\s+\|\n/ => $1;
b4ade012 MB	296
4b07058c	297	$build->{osname} = $config{osname};
b4ade012 MB	298	$pv =~ m{^\s+Built under\s+(.*)}m
	299	and $build->{osname} = $1;
	300	$config{osname} \|\|= $build->{osname};
	301
4b07058c RS	302	return _make_derived ({
	303	build => $build,
	304	environment => {},
	305	config => \%config,
	306	derived => {},
	307	inc => [],
	308	});
	309	} # plv2hash
	310
275d368b	311	sub summary {
4b07058c RS	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
275d368b	323	default_inc_excludes_dot
4b07058c RS	324	);
	325	$info{$_}++ for grep { $conf->{build}{options}{$_} } keys %{$conf->{build}{options}};
	326
	327	return \%info;
	328	} # summary
	329
275d368b	330	sub signature {
4b07058c RS	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
275d368b	341	sub myconfig {
4b07058c RS	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];
b4ade012 MB	360	my $cnf = plv2hash (qx[$^X -V]);
	361
	362	$build->{$_} = $cnf->{build}{$_} for qw( osname stamp patches options );
4b07058c RS	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
6b3eaabc	549	Copyright (C) 2009-2016 H.Merijn Brand
4b07058c RS	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