This is an automated email from the git hooks/post-receive script. kanashiro-guest pushed a commit to branch master in repository carton.
commit d2d25194dc929933c7462bde3a3220ddd44b9b54 Author: Tatsuhiko Miyagawa <miyag...@bulknews.net> Date: Tue Jul 23 23:00:26 2013 -0700 move Requirements to Tree --- lib/Carton/CLI.pm | 20 +++++++++----------- lib/Carton/Environment.pm | 7 +++++++ lib/Carton/{Requirements.pm => Tree.pm} | 31 ++++++++++++++++++------------- 3 files changed, 34 insertions(+), 24 deletions(-) diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm index 749d6bb..52efc1f 100644 --- a/lib/Carton/CLI.pm +++ b/lib/Carton/CLI.pm @@ -17,7 +17,6 @@ use Carton::Snapshot; use Carton::Util; use Carton::Environment; use Carton::Error; -use Carton::Requirements; use constant { SUCCESS => 0, INFO => 1, WARN => 2, ERROR => 3 }; @@ -256,16 +255,16 @@ sub cmd_tree { $env->snapshot->load; $env->cpanfile->load; - my $requirements = Carton::Requirements->new(snapshot => $env->snapshot, requirements => $env->cpanfile->requirements); - my %seen; my $dumper = sub { - my($dependency, $level) = @_; + my($dependency, $reqs, $level) = @_; + return if $level == 0; return if $dependency->dist->is_core; return if $seen{$dependency->distname}++; $self->printf( "%s%s (%s)\n", " " x ($level - 1), $dependency->module, $dependency->distname, INFO ); }; - $requirements->walk_down($dumper); + + $env->tree->walk_down($dumper); } sub cmd_check { @@ -283,14 +282,13 @@ sub cmd_check { # TODO remove snapshot # TODO pass git spec to Requirements? - my $requirements = Carton::Requirements->new(snapshot => $env->snapshot, requirements => $env->cpanfile->requirements); - $requirements->walk_down(sub { }); + my $merged_reqs = $env->tree->merged_requirements; my @missing; - for my $module ($requirements->all->required_modules) { + for my $module ($merged_reqs->required_modules) { my $install = $env->snapshot->find_or_core($module); if ($install) { - unless ($requirements->all->accepts_module($module => $install->version_for($module))) { + unless ($merged_reqs->accepts_module($module => $install->version_for($module))) { push @missing, [ $module, 1, $install->version ]; } } else { @@ -304,10 +302,10 @@ sub cmd_check { my($module, $unsatisfied, $version) = @$missing; if ($unsatisfied) { $self->printf(" %s has version %s. Needs %s\n", - $module, $version, $requirements->all->requirements_for_module($module), INFO); + $module, $version, $merged_reqs->requirements_for_module($module), INFO); } else { $self->printf(" %s is not installed. Needs %s\n", - $module, $requirements->all->requirements_for_module($module), INFO); + $module, $merged_reqs->requirements_for_module($module), INFO); } } $self->printf("Run `carton install` to install them.\n", INFO); diff --git a/lib/Carton/Environment.pm b/lib/Carton/Environment.pm index 6fb31c3..3253b8b 100644 --- a/lib/Carton/Environment.pm +++ b/lib/Carton/Environment.pm @@ -5,12 +5,14 @@ use Moo; use Carton::CPANfile; use Carton::Snapshot; use Carton::Error; +use Carton::Tree; use Path::Tiny; has cpanfile => (is => 'rw'); has snapshot => (is => 'lazy'); has install_path => (is => 'rw', lazy => 1, builder => 1, coerce => sub { Path::Tiny->new($_[0])->absolute }); has vendor_cache => (is => 'lazy'); +has tree => (is => 'rw', lazy => 1, builder => 1); sub _build_snapshot { my $self = shift; @@ -31,6 +33,11 @@ sub _build_vendor_cache { Path::Tiny->new($self->install_path->dirname . "/vendor/cache"); } +sub _build_tree { + my $self = shift; + Carton::Tree->new(cpanfile => $self->cpanfile, snapshot => $self->snapshot); +} + sub build_with { my($class, $cpanfile) = @_; diff --git a/lib/Carton/Requirements.pm b/lib/Carton/Tree.pm similarity index 68% rename from lib/Carton/Requirements.pm rename to lib/Carton/Tree.pm index fa5f524..b6664d4 100644 --- a/lib/Carton/Requirements.pm +++ b/lib/Carton/Tree.pm @@ -1,12 +1,10 @@ -package Carton::Requirements; +package Carton::Tree; use strict; use Carton::Dependency; use Moo; -use CPAN::Meta::Requirements; +has cpanfile => (is => 'ro'); has snapshot => (is => 'ro'); -has requirements => (is => 'ro'); -has all => (is => 'ro', default => sub { CPAN::Meta::Requirements->new }); sub walk_down { my($self, $cb) = @_; @@ -14,10 +12,7 @@ sub walk_down { my $dumper; $dumper = sub { my($dependency, $reqs, $level, $parent) = @_; - $cb->($dependency, $level) if $dependency; - - $self->all->add_requirements($reqs) unless $self->all->is_finalized; - + $cb->($dependency, $reqs, $level); local $parent->{$dependency->distname} = 1 if $dependency; for my $module (sort $reqs->required_modules) { @@ -31,10 +26,7 @@ sub walk_down { } }; - $dumper->(undef, $self->requirements, 0, {}); - - $self->all->clear_requirement('perl'); - $self->all->finalize; + $dumper->(undef, $self->cpanfile->requirements, 0, {}); } sub dependency_for { @@ -53,6 +45,19 @@ sub dependency_for { return $dep; } -1; +sub merged_requirements { + my $self = shift; + my $merged_reqs = CPAN::Meta::Requirements->new; + $self->walk_down(sub { + my($dependency, $reqs, $level) = @_; + $merged_reqs->add_requirements($reqs); + }); + $merged_reqs->clear_requirement('perl'); + $merged_reqs->finalize; + + $merged_reqs; +} + +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