[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.24";
@ISA         = ("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_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_PERTURB_KEYS_DETERMINISTIC
    PERL_PERTURB_KEYS_DISABLED
    PERL_PERTURB_KEYS_RANDOM
    PERL_PRESERVE_IVUV
    PERL_RELOCATABLE_INCPUSH
    PERL_USE_DEVEL
    PERL_USE_SAFE_PUTENV
    UNLINK_ALL_VERSIONS
    USE_ATTRIBUTES_FOR_PERLIO
    USE_FAST_STDIO
    USE_HASH_SEED_EXPLICIT
    USE_LOCALE
    USE_LOCALE_CTYPE
    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 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;
    } # _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;
	}

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