[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