summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Config/Perl/V.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Config/Perl/V.pm')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Config/Perl/V.pm509
1 files changed, 509 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Config/Perl/V.pm b/Master/tlpkg/tlperl/lib/Config/Perl/V.pm
new file mode 100755
index 00000000000..c52b82608cf
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Config/Perl/V.pm
@@ -0,0 +1,509 @@
+#!/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.17";
+@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 1661 S_Internals_V ()
+# perl.h line 4664 (second block),
+my %BTD = map { $_ => 0 } qw(
+
+ DEBUGGING
+ NO_MATHOMS
+ PERL_DISABLE_PMC
+ PERL_DONT_CREATE_GVSV
+ 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_PRESERVE_IVUV
+ PERL_RELOCATABLE_INCPUSH
+ PERL_USE_DEVEL
+ PERL_USE_SAFE_PUTENV
+ UNLINK_ALL_VERSIONS
+ USE_ATTRIBUTES_FOR_PERLIO
+ USE_FAST_STDIO
+ USE_LOCALE
+ USE_PERL_ATOF
+ USE_SITECUSTOMIZE
+
+ DEBUG_LEAKING_SCALARS
+ DEBUG_LEAKING_SCALARS_FORK_DUMP
+ DECCRTL_SOCKETS
+ FAKE_THREADS
+ FCRYPT
+ HAS_TIMES
+ MULTIPLICITY
+ MYMALLOC
+ PERLIO_LAYERS
+ PERL_DEBUG_READONLY_OPS
+ PERL_GLOBAL_STRUCT
+ PERL_IMPLICIT_CONTEXT
+ PERL_IMPLICIT_SYS
+ PERL_MAD
+ PERL_MICRO
+ PERL_NEED_APPCTX
+ PERL_NEED_TIMESBASE
+ PERL_OLD_COPY_ON_WRITE
+ PERL_NEW_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_LONG_DOUBLE
+ USE_PERLIO
+ 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 (first block)
+# 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;
+ for (split m/\n+/ => join "\n", @_) {
+
+ if (s/^Summary of my\s+(\S+)\s+\(\s*(.*?)\s*\)//) {
+ $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";
+ next;
+ }
+
+ if (s/^\s+(Snapshot of:)\s+(\S+)//) {
+ $config{git_commit_id_title} = $1;
+ $config{git_commit_id} = $2;
+ next;
+ }
+
+ my %kv = m/\G,?\s*([^=]+)=('[^']+?'|\S+)/gc;
+
+ while (my ($k, $v) = each %kv) {
+ $k =~ s/\s+$//;
+ $v =~ s/,$//;
+ $v =~ m/^'(.*)'$/ and $v = $1;
+ $v =~ s/^\s+//;
+ $v =~ s/\s+$//;
+ $config{$k} = $v;
+ }
+ }
+ my $build = { %empty_build };
+ $build->{osname} = $config{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 $pv = qx[$^X -V];
+ $pv =~ s{.*?\n\n}{}s;
+ $pv =~ s{\n(?: \s+|\t\s*)}{\0}g;
+
+ # print STDERR $pv;
+
+ $pv =~ m{^\s+Built under\s+(.*)}m
+ and $build->{osname} = $1;
+ $pv =~ m{^\s+Compiled at\s+(.*)}m
+ and $build->{stamp} = $1;
+ $pv =~ m{^\s+Locally applied patches:(?:\s+|\0)(.*)}m
+ and $build->{patches} = [ split m/\0+/, $1 ];
+ $pv =~ m{^\s+Compile-time options:(?:\s+|\0)(.*)}m
+ and map { $build->{options}{$_} = 1 } split m/\s+|\0/ => $1;
+ }
+
+ 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-2013 H.Merijn Brand
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut