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 <miyag...@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 _______________________________________________ Pkg-perl-cvs-commits mailing list Pkg-perl-cvs-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits