Do not shell out on 5.14.0 and up if perl provides internals (Nicholas)
authorH.Merijn Brand <merijn@lx09.procura.nl>
Wed, 20 Jun 2012 06:11:19 +0000 (20 08:11 +0200)
committerH.Merijn Brand <merijn@lx09.procura.nl>
Wed, 20 Jun 2012 06:11:19 +0000 (20 08:11 +0200)
Nicholas applied 996978124d77fbe8 in remotes/origin/nicholas/configpm:

Config::Perl::V::myconfig can avoid `$^X -V` on 5.14.0 and later.

On 5.14.0 and later the Config module has subroutines that provide
all the data contained within perl -V, so there's no need to shell
out to $^X to get it.

Also add a test that forces Config::Perl::V::myconfig to shell out,
to check consistency between the two approaches.

Changelog
V.pm
t/10_base.t

index 9c0df83..96505fc 100644 (file)
--- a/Changelog
+++ b/Changelog
@@ -1,3 +1,6 @@
+0.16   - 20 Jun 2012, H.Merijn Brand
+    * Do not shell out on 5.14.0 and up if perl provides internals (Nicholas)
+
 0.15   - 07 Jun 2012, H.Merijn Brand
     * Update copyright to 2012
     * Prepare for CORE inclusion (BinGOs)
diff --git a/V.pm b/V.pm
index b088226..16440b4 100644 (file)
--- a/V.pm
+++ b/V.pm
@@ -8,7 +8,7 @@ use warnings;
 use Config;
 use Exporter;
 use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
-$VERSION     = "0.15";
+$VERSION     = "0.16";
 @ISA         = ("Exporter");
 @EXPORT_OK   = qw( plv2hash summary myconfig signature );
 %EXPORT_TAGS = (
@@ -273,18 +273,31 @@ sub myconfig
     my %args = ref $args eq "HASH"  ? %$args :
                ref $args eq "ARRAY" ? @$args : ();
 
-    #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*)}{ }g;
-
-    #print $pv;
-
     my $build = { %empty_build };
-    $pv =~ m{^\s+Built under (.*)}m                and $build->{osname} = $1;
-    $pv =~ m{^\s+Compiled at (.*)}m                and $build->{stamp}  = $1;
-    $pv =~ m{^\s+Locally applied patches:\s+(.*)}m and $build->{patches} = [ split m/\s+/, $1 ];
-    $pv =~ m{^\s+Compile-time options:\s+(.*)}m    and map { $build->{options}{$_} = 1 } split m/\s+/, $1;
+
+    # 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*)}{ }g;
+
+       #print $pv;
+
+       $pv =~ m{^\s+Built under (.*)}m                and $build->{osname} = $1;
+       $pv =~ m{^\s+Compiled at (.*)}m                and $build->{stamp}  = $1;
+       $pv =~ m{^\s+Locally applied patches:\s+(.*)}m and $build->{patches} = [ split m/\s+/, $1 ];
+       $pv =~ m{^\s+Compile-time options:\s+(.*)}m    and map { $build->{options}{$_} = 1 } split m/\s+/, $1;
+       }
 
     my @KEYS = keys %ENV;
     my %env  =
index 4f24d73..b840ef5 100755 (executable)
@@ -5,7 +5,7 @@ use warnings;
 
 BEGIN {
     use Test::More;
-    my $tests = 7;
+    my $tests = 9;
     unless ($ENV{PERL_CORE}) {
        require Test::NoWarnings;
        Test::NoWarnings->import ();
@@ -22,3 +22,14 @@ for (qw( build environment config inc )) {
     ok (exists $conf->{build},                 "Has build entry");
     }
 is (lc $conf->{build}{osname}, lc $conf->{config}{osname}, "osname");
+
+SKIP: {
+    # Test that the code that shells out to perl -V and parses the output
+    # gives the same results as the code that calls Config::* routines directly.
+    defined &Config::compile_date or
+       skip "This perl doesn't provide perl -V in the Config module", 2;
+    eval q{no warnings "redefine"; sub Config::compile_date { return undef }};
+    is (Config::compile_date (), undef, "Successfully overriden compile_date");
+    is_deeply (Config::Perl::V::myconfig, $conf,
+       "perl -V parsing code produces same result as the Config module");
+    }