Package: libmail-thread-perl
Version: 2.55-2
Severity: normal
Tags: upstream patch

Reporting here, too, since upstream seems dead.

There is no need to actually perform recursion when traversing
messages to perform callbacks on them.  This quiets down
recursion warnings in large threads (and may avoid crashes).

ref: https://rt.cpan.org/Ticket/Display.html?id=116727
From: Eric Wong <e...@80x24.org>
Subject: [PATCH] avoid recursion warnings in recurse_down

There is no need to actually perform recursion when traversing
messages to perform callbacks on them.  This quiets down
recursion warnings in large threads (and may avoid crashes).
---
 Thread.pm | 36 +++++++++++++++++++++---------------
 1 file changed, 21 insertions(+), 15 deletions(-)

diff --git a/Thread.pm b/Thread.pm
index a0c8903..01e710c 100644
--- a/Thread.pm
+++ b/Thread.pm
@@ -440,22 +440,28 @@ sub order_children {
 }
 
 sub recurse_down {
+    my ($self, $callback) = @_;
     my %seen;
-    my $do_it_all;
-    $do_it_all = sub {
-        my $self = shift;
-        my $callback = shift;
-        $seen{$self}++;
-        $callback->($self);
-
-        if ($self->next && $seen{$self->next}) { $self->next(undef) }
-        $do_it_all->($self->next, $callback)  if $self->next;
-        if ($self->child && $seen{$self->child}) { $self->child(undef) }
-        $do_it_all->($self->child, $callback) if $self->child;
-
-    };
-    $do_it_all->(@_);
-    undef $do_it_all;
+    my @q = ($self);
+    while (my $cont = shift @q) {
+        $seen{$cont} = 1;
+        $callback->($cont);
+
+        if (my $next = $cont->next) {
+            if ($seen{$next}) {
+                $cont->next(undef);
+            } else {
+                push @q, $next;
+            }
+        }
+        if (my $child = $cont->child) {
+            if ($seen{$child}) {
+                $cont->child(undef);
+            } else {
+                push @q, $child;
+            }
+        }
+    }
 }
 
 sub iterate_down {
-- 
EW

Reply via email to