[carton] 265/472: Add back the 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 0f71a18c14650bd97b129d4dd22a829847917200
Author: Tatsuhiko Miyagawa <miyagawa at bulknews.net>
Date:   Mon Jun 3 18:05:46 2013 +0900

    Add back the tree command!
---
 lib/Carton/CLI.pm        | 37 +++++++++++++++++++++++++++++++++++++
 lib/Carton/Dependency.pm |  5 +++++
 2 files changed, 42 insertions(+)

diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm
index b3bf6bd..06ee8ac 100644
--- a/lib/Carton/CLI.pm
+++ b/lib/Carton/CLI.pm
@@ -16,6 +16,9 @@ use Scalar::Util;
 use Try::Tiny;
 use Moo;
 
+use Module::CPANfile;
+use CPAN::Meta::Requirements;
+
 use constant { SUCCESS => 0, INFO => 1, WARN => 2, ERROR => 3 };
 
 our $UseSystem = 0; # 1 for unit testing
@@ -252,6 +255,40 @@ sub cmd_list {
     }
 }
 
+sub cmd_tree {
+    my($self, @args) = @_;
+
+    my $lock = $self->find_lock
+      or $self->error("Can't find carton.lock: Run `carton install` to rebuild the lock file.\n");
+
+    my $cpanfile = Module::CPANfile->load($self->find_cpanfile);
+    my $prereqs = $cpanfile->prereqs;
+
+    my $level = 0;
+    $self->dump_tree($lock, undef, $prereqs, $level);
+}
+
+sub dump_tree {
+    my($self, $lock, $name, $prereqs, $level) = @_;
+
+    my $req = CPAN::Meta::Requirements->new;
+    $req->add_requirements($prereqs->requirements_for($_, 'requires'))
+      for qw( configure build runtime test);
+
+    if ($name) {
+        $self->print( (" " x ($level - 1)) . "\\_ $name\n" );
+    }
+
+    my $requirements = $req->as_string_hash;
+    while (my($module, $version) = each %$requirements) {
+        if (my $dependency = $lock->find($module)) {
+            $self->dump_tree($lock, $dependency->dist, $dependency->prereqs, $level + 1);
+        } else {
+            # TODO: probably core, what if otherwise?
+        }
+    }
+}
+
 sub cmd_check {
     my($self, @args) = @_;
     die <<EOF;
diff --git a/lib/Carton/Dependency.pm b/lib/Carton/Dependency.pm
index 14511eb..a204265 100644
--- a/lib/Carton/Dependency.pm
+++ b/lib/Carton/Dependency.pm
@@ -16,4 +16,9 @@ sub distfile {
     $self->pathname;
 }
 
+sub prereqs {
+    my $self = shift;
+    $self->mymeta->effective_prereqs;
+}
+
 1;

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