restore ExtUtils-ParseXS portability to Perl 5.6

diff --git a/dist/ExtUtils-ParseXS/Changes b/dist/ExtUtils-ParseXS/Changes
index 358ffc2..b9586bc 100644 (file)
--- a/dist/ExtUtils-ParseXS/Changes
+++ b/dist/ExtUtils-ParseXS/Changes
@@ -1,5 +1,7 @@
 Revision history for Perl extension ExtUtils::ParseXS.
 
+  - Restore portability to Perl 5.6, which was lost at EU-PXS 3.00.
+
 3.15 - Thu Feb  2 08:12:00 CET 2012
   - Fix version for PAUSE indexer.
 

diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
index 3401b96..883d905 100644 (file)
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
@@ -1,7 +1,7 @@
 package ExtUtils::ParseXS;
 use strict;
 
-use 5.008001;  # We use /??{}/ in regexes
+use 5.006001;
 use Cwd;
 use Config;
 use Exporter;
@@ -11,7 +11,7 @@ use Symbol;
 
 our $VERSION;
 BEGIN {
-  $VERSION = '3.15';
+  $VERSION = '3.16';
 }
 use ExtUtils::ParseXS::Constants $VERSION;
 use ExtUtils::ParseXS::CountLines $VERSION;
@@ -1852,7 +1852,7 @@ sub generate_init {
     $subexpr =~ s/\$arg/ST(ix_$var)/g;
     $subexpr =~ s/\n\t/\n\t\t/g;
     $subexpr =~ s/is not of (.*\")/[arg %d] is not of $1, ix_$var + 1/g;
-    $subexpr =~ s/\$var/${var}[ix_$var - $argoff]/;
+    $subexpr =~ s/\$var/${var}\[ix_$var - $argoff]/;
     $expr =~ s/DO_ARRAY_ELEM/$subexpr/;
   }
   if ($expr =~ m#/\*.*scope.*\*/#i) {  # "scope" in C comments
@@ -1938,7 +1938,7 @@ sub generate_output {
       my $subexpr = $suboutputmap->cleaned_code;
       $subexpr =~ s/ntype/subtype/g;
       $subexpr =~ s/\$arg/ST(ix_$var)/g;
-      $subexpr =~ s/\$var/${var}[ix_$var]/g;
+      $subexpr =~ s/\$var/${var}\[ix_$var]/g;
       $subexpr =~ s/\n\t/\n\t\t/g;
       $expr =~ s/DO_ARRAY_ELEM\n/$subexpr/;
       eval "print qq\a$expr\a";

diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm
index a002637..2f822da 100644 (file)
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm
@@ -3,7 +3,7 @@ use strict;
 use warnings;
 use Symbol;
 
-our $VERSION = '3.15';
+our $VERSION = '3.16';
 
 =head1 NAME
 

diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm
index b2a4657..66944cd 100644 (file)
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm
@@ -1,7 +1,7 @@
 package ExtUtils::ParseXS::CountLines;
 use strict;
 
-our $VERSION = '3.15';
+our $VERSION = '3.16';
 
 our $SECTION_END_MARKER;
 

diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
index e4c5104..c4172d0 100644 (file)
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
@@ -6,7 +6,7 @@ use File::Spec;
 use lib qw( lib );
 use ExtUtils::ParseXS::Constants ();
 
-our $VERSION = '3.15';
+our $VERSION = '3.16';
 
 our (@ISA, @EXPORT_OK);
 @ISA = qw(Exporter);

diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm
index 6b22153..2bc9c80 100644 (file)
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm
@@ -2,7 +2,7 @@ package ExtUtils::Typemaps;
 use 5.006001;
 use strict;
 use warnings;
-our $VERSION = '3.15';
+our $VERSION = '3.16';
 #use Carp qw(croak);
 
 require ExtUtils::ParseXS;

diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm
index 6d1d3e0..671110f 100644 (file)
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm
@@ -2,7 +2,7 @@ package ExtUtils::Typemaps::Cmd;
 use 5.006001;
 use strict;
 use warnings;
-our $VERSION = '3.15';
+our $VERSION = '3.16';
 
 use ExtUtils::Typemaps;
 

diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm
index fea3a47..9e7053f 100644 (file)
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm
@@ -2,7 +2,7 @@ package ExtUtils::Typemaps::InputMap;
 use 5.006001;
 use strict;
 use warnings;
-our $VERSION = '3.15';
+our $VERSION = '3.16';
 
 =head1 NAME
 

diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm
index 3475ec8..95cbbcc 100644 (file)
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm
@@ -2,7 +2,7 @@ package ExtUtils::Typemaps::OutputMap;
 use 5.006001;
 use strict;
 use warnings;
-our $VERSION = '3.15';
+our $VERSION = '3.16';
 
 =head1 NAME
 

diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm
index 6604d84..b29e212 100644 (file)
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 require ExtUtils::Typemaps;
 
-our $VERSION = '3.15';
+our $VERSION = '3.16';
 
 =head1 NAME
 

diff --git a/dist/ExtUtils-ParseXS/t/lib/PrimitiveCapture.pm b/dist/ExtUtils-ParseXS/t/lib/PrimitiveCapture.pm
index aa873d4..29dbf65 100644 (file)
--- a/dist/ExtUtils-ParseXS/t/lib/PrimitiveCapture.pm
+++ b/dist/ExtUtils-ParseXS/t/lib/PrimitiveCapture.pm
@@ -2,32 +2,76 @@ package PrimitiveCapture;
 use strict;
 use warnings;
 
-sub capture_stdout {
-  my $sub = shift;
-  my $stdout;
-  open my $oldout, ">&STDOUT" or die "Can't dup STDOUT: $!";
-  close STDOUT;
-  open STDOUT, '>', \$stdout or die "Can't open STDOUT: $!";
-
-  $sub->();
-
-  close STDOUT;
-  open STDOUT, ">&", $oldout or die "Can't dup \$oldout: $!";
-  return $stdout;
-}
-
-sub capture_stderr {
-  my $sub = shift;
-  my $stderr;
-  open my $olderr, ">&STDERR" or die "Can't dup STDERR: $!";
-  close STDERR;
-  open STDERR, '>', \$stderr or die "Can't open STDERR: $!";
-
-  $sub->();
-
-  close STDERR;
-  open STDERR, ">&", $olderr or die "Can't dup \$olderr: $!";
-  return $stderr;
+if ("$]" >= 5.008000) {
+  eval "#line @{[__LINE__+1]} ".q{"lib/PrimitiveCapture.pm"
+    sub capture_stdout {
+      my $sub = shift;
+      my $stdout;
+      open my $oldout, ">&STDOUT" or die "Can't dup STDOUT: $!";
+      close STDOUT;
+      open STDOUT, '>', \$stdout or die "Can't open STDOUT: $!";
+      $sub->();
+      close STDOUT;
+      open STDOUT, ">&", $oldout or die "Can't dup \$oldout: $!";
+      return $stdout;
+    }
+    sub capture_stderr {
+      my $sub = shift;
+      my $stderr;
+      open my $olderr, ">&STDERR" or die "Can't dup STDERR: $!";
+      close STDERR;
+      open STDERR, '>', \$stderr or die "Can't open STDERR: $!";
+      $sub->();
+      close STDERR;
+      open STDERR, ">&", $olderr or die "Can't dup \$olderr: $!";
+      return $stderr;
+    }
+  }; die $@ unless $@ eq "";
+} else {
+  eval "#line @{[__LINE__+1]} ".q{"lib/PrimitiveCapture.pm"
+    use File::Spec;
+    use File::Temp;
+    my $tmpdir;
+    my $i = 0;
+    sub _tmpfile {
+      $tmpdir ||= File::Temp::tempdir(CLEANUP => 1, TMPDIR => 1);
+      return File::Spec->catfile($tmpdir, $i++);
+    }
+    sub _slurp {
+      my $filename = shift;
+      open my $fh, "<", $filename or die "Can't read $filename: $!";
+      local $/ = undef;
+      my $content = <$fh>;
+      defined $content or die "Can't read $filename: $!";
+      return $content;
+    }
+    sub capture_stdout {
+      my $sub = shift;
+      my $tmpfile = _tmpfile();
+      local *OLDSTDOUT;
+      open OLDSTDOUT, ">&STDOUT" or die "Can't dup STDOUT: $!";
+      close STDOUT;
+      open STDOUT, '>', $tmpfile or die "Can't open STDOUT: $!";
+      $sub->();
+      close STDOUT;
+      open STDOUT, ">&OLDSTDOUT" or die "Can't dup OLDSTDOUT: $!";
+      close OLDSTDOUT;
+      return _slurp($tmpfile);
+    }
+    sub capture_stderr {
+      my $sub = shift;
+      my $tmpfile = _tmpfile();
+      local *OLDSTDERR;
+      open OLDSTDERR, ">&STDERR" or die "Can't dup STDERR: $!";
+      close STDERR;
+      open STDERR, '>', $tmpfile or die "Can't open STDERR: $!";
+      $sub->();
+      close STDERR;
+      open STDERR, ">&OLDSTDERR" or die "Can't dup OLDSTDERR: $!";
+      close OLDSTDERR;
+      return _slurp($tmpfile);
+    }
+  }; die $@ unless $@ eq "";
 }
 
 1;