[carton] 359/472: Allow stopping tree DFS with tree command.

[Lucas Kanashiro]

This is an automated email from the git hooks/post-receive script.

kanashiro-guest pushed a commit to branch master
in repository carton.

commit b911e1049fe59c37a8293e36e869f4776387dba4
Author: Tatsuhiko Miyagawa <miyagawa at bulknews.net>
Date:   Wed Jul 24 08:10:05 2013 -0700

    Allow stopping tree DFS with tree command.
    
    This will make carton tree for a big chain of deps much faster
---
 lib/Carton/CLI.pm  | 4 ++--
 lib/Carton/Tree.pm | 6 +++++-
 2 files changed, 7 insertions(+), 3 deletions(-)

diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm
index 52efc1f..a3f79df 100644
--- a/lib/Carton/CLI.pm
+++ b/lib/Carton/CLI.pm
@@ -259,8 +259,8 @@ sub cmd_tree {
     my $dumper = sub {
         my($dependency, $reqs, $level) = @_;
         return if $level == 0;
-        return if $dependency->dist->is_core;
-        return if $seen{$dependency->distname}++;
+        return Carton::Tree::STOP if $dependency->dist->is_core;
+        return Carton::Tree::STOP if $seen{$dependency->distname}++;
         $self->printf( "%s%s (%s)\n", " " x ($level - 1), $dependency->module, $dependency->distname, INFO );
     };
 
diff --git a/lib/Carton/Tree.pm b/lib/Carton/Tree.pm
index 4d03555..b153570 100644
--- a/lib/Carton/Tree.pm
+++ b/lib/Carton/Tree.pm
@@ -6,13 +6,17 @@ use Moo;
 has cpanfile => (is => 'ro');
 has snapshot => (is => 'ro');
 
+use constant STOP => -1;
+
 sub walk_down {
     my($self, $cb) = @_;
 
     my $dumper; $dumper = sub {
         my($dependency, $reqs, $level, $parent) = @_;
 
-        $cb->($dependency, $reqs, $level);
+        my $ret = $cb->($dependency, $reqs, $level);
+        return if $ret && $ret == STOP;
+
         local $parent->{$dependency->distname} = 1 if $dependency;
 
         for my $module (sort $reqs->required_modules) {

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/carton.git