[carton] 356/472: move Requirements to Tree

Lucas Kanashiro kanashiro-guest at moszumanska.debian.org
Fri Jul 24 00:39:24 UTC 2015


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 <miyagawa at 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



More information about the Pkg-perl-cvs-commits mailing list