add reduce fallback for perl < 5.8.9 (mst)

diff --git a/META.json b/META.json
index 7aac77e..30b084c 100644 (file)
--- a/META.json
+++ b/META.json
@@ -47,7 +47,7 @@
             "Exporter" : "0",
             "List::Util" : "0",
             "Scalar::Util" : "0",
-            "perl" : "5.008009"
+            "perl" : "5.008001"
          }
       },
       "test" : {

diff --git a/Makefile.PL b/Makefile.PL
index 5ac628c..4df3382 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -2,7 +2,7 @@
 use strict;
 use warnings;
 
-use 5.008009;
+use 5.008001;
 
 use ExtUtils::MakeMaker;
 
@@ -14,7 +14,7 @@ my %WriteMakefileArgs = (
   },
   "DISTNAME" => "DOM-Tiny",
   "LICENSE" => "artistic_2",
-  "MIN_PERL_VERSION" => "5.008009",
+  "MIN_PERL_VERSION" => "5.008001",
   "NAME" => "DOM::Tiny",
   "PREREQ_PM" => {
     "Carp" => 0,

diff --git a/cpanfile b/cpanfile
index 1c8a128..581cd98 100644 (file)
--- a/cpanfile
+++ b/cpanfile
@@ -1,4 +1,4 @@
-requires 'perl' => '5.008009';
+requires 'perl' => '5.008001';
 requires 'Carp';
 requires 'Exporter';
 requires 'List::Util';

diff --git a/lib/DOM/Tiny/_Collection.pm b/lib/DOM/Tiny/_Collection.pm
index 4c27742..44a1741 100644 (file)
--- a/lib/DOM/Tiny/_Collection.pm
+++ b/lib/DOM/Tiny/_Collection.pm
@@ -6,6 +6,8 @@ use Carp 'croak';
 use List::Util;
 use Scalar::Util 'blessed';
 
+use constant REDUCE => ($] >= 5.008009 ? \&List::Util::reduce : \&_reduce);
+
 our $VERSION = '0.002';
 
 sub new {
@@ -57,7 +59,7 @@ sub map {
 sub reduce {
   my $self = shift;
   @_ = (@_, @$self);
-  goto &List::Util::reduce;
+  goto &{REDUCE()};
 }
 
 sub reverse { $_[0]->new(reverse @{$_[0]}) }
@@ -104,6 +106,28 @@ sub _flatten {
   map { _ref($_) ? _flatten(@$_) : $_ } @_;
 }
 
+# For perl < 5.8.9
+sub _reduce (&@) {
+  my $code = shift;
+
+  return shift unless @_ > 1;
+
+  my $caller = caller;
+
+  no strict 'refs';
+
+  local(*{$caller."::a"}) = \my $a;
+  local(*{$caller."::b"}) = \my $b;
+
+  $a = shift;
+  foreach (@_) {
+    $b = $_;
+    $a = &{$code}();
+  }
+
+  $a;
+}
+
 sub _ref { ref $_[0] eq 'ARRAY' || blessed $_[0] && $_[0]->isa(__PACKAGE__) }
 
 1;

diff --git a/t/dom.t b/t/dom.t
index 31ccd14..e345d27 100644 (file)
--- a/t/dom.t
+++ b/t/dom.t
@@ -2493,7 +2493,7 @@ is $dom->tree->[5][1], ' HTML4 ',             'right comment';
 is $dom->tree->[7][1], ' bad idea -- HTML4 ', 'right comment';
 
 SKIP: {
-  skip 'Regex subexpression recursion causes SIGSEGV on 5.8', 1 if $] < 5.010000;
+  skip 'Regex subexpression recursion causes SIGSEGV on 5.8', 1 unless $] >= 5.010000;
   # Huge number of attributes
   $dom = DOM::Tiny->new('<div ' . ('a=b ' x 32768) . '>Test</div>');
   is $dom->at('div[a=b]')->text, 'Test', 'right text';