This is an automated email from the git hooks/post-receive script. kanashiro-guest pushed a commit to branch master in repository carton.
commit 2ddfe5831639cc40555e77bf2920a7edb286a67b Author: Tatsuhiko Miyagawa <miyag...@bulknews.net> Date: Tue Jun 4 13:14:07 2013 +0900 refactor dependency tracker as Carton::Requirements class --- lib/Carton/CLI.pm | 42 +++++++-------------------- lib/Carton/Dependency.pm | 20 ++++--------- lib/Carton/{Dependency.pm => Dist.pm} | 2 +- lib/Carton/Lock.pm | 8 +++--- lib/Carton/Requirements.pm | 54 +++++++++++++++++++++++++++++++++++ 5 files changed, 74 insertions(+), 52 deletions(-) diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm index 5fed9bc..7a65286 100644 --- a/lib/Carton/CLI.pm +++ b/lib/Carton/CLI.pm @@ -12,12 +12,11 @@ use Carton::Mirror; use Carton::Lock; use Carton::Util; use Carton::Error; -use Scalar::Util; +use Carton::Requirements; use Try::Tiny; use Moo; use Module::CPANfile; -use CPAN::Meta::Requirements; use constant { SUCCESS => 0, INFO => 1, WARN => 2, ERROR => 3 }; @@ -231,9 +230,9 @@ sub cmd_show { or $self->error("Can't find carton.lock: Run `carton install`\n"); for my $module (@args) { - my $dependency = $lock->find($module) + my $dist = $lock->find($module) or $self->error("Couldn't locate $module in carton.lock\n"); - $self->print( $dependency->dist . "\n" ); + $self->print( $dist->dist . "\n" ); } } @@ -250,8 +249,8 @@ sub cmd_list { my $lock = $self->find_lock or $self->error("Can't find carton.lock: Run `carton install` to rebuild the lock file.\n"); - for my $dependency ($lock->dependencies) { - $self->print($dependency->$format . "\n"); + for my $dist ($lock->distributions) { + $self->print($dist->$format . "\n"); } } @@ -262,35 +261,14 @@ sub cmd_tree { 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 $requirements = Carton::Requirements->new(lock => $lock, cpanfile => $cpanfile); - my $dumper = $self->_make_dumper($lock); - $dumper->(undef, $cpanfile->prereqs, 0, {}); + $requirements->walk_down(sub { $self->_dump_requirement(@_) }); } -sub _make_dumper { - my($self, $lock) = @_; - - my $dumper; $dumper = sub { - my($dependency, $prereqs, $level, $seen) = @_; - - my $req = CPAN::Meta::Requirements->new; - $req->add_requirements($prereqs->requirements_for($_, 'requires')) - for qw( configure build runtime test); - - if ($dependency) { - $self->printf( "%s%s (%s)\n", " " x ($level - 1), $dependency->name, $dependency->dist, INFO ); - } - - my $requirements = $req->as_string_hash; - while (my($module, $version) = each %$requirements) { - if (my $dependency = $lock->find($module)) { - next if $seen->{$dependency->dist}++; - $dumper->($dependency, $dependency->prereqs, $level + 1, $seen); - } else { - # TODO: probably core, what if otherwise? - } - } - }; +sub _dump_requirement { + my($self, $dependency, $level) = @_; + $self->printf( "%s%s (%s)\n", " " x ($level - 1), $dependency->module, $dependency->distname, INFO ); } sub cmd_check { diff --git a/lib/Carton/Dependency.pm b/lib/Carton/Dependency.pm index a204265..3c38e9a 100644 --- a/lib/Carton/Dependency.pm +++ b/lib/Carton/Dependency.pm @@ -1,24 +1,14 @@ package Carton::Dependency; use strict; -use CPAN::Meta; use Moo; -has name => (is => 'ro'); -has pathname => (is => 'ro'); -has provides => (is => 'ro'); -has version => (is => 'ro'); -has target => (is => 'ro'); -has dist => (is => 'ro'); -has mymeta => (is => 'ro', coerce => sub { CPAN::Meta->new($_[0], { lazy_validation => 1 }) }); +has module => (is => 'rw'); +has version => (is => 'rw'); +has dist => (is => 'rw', handles => [ qw(prereqs) ]); -sub distfile { +sub distname { my $self = shift; - $self->pathname; -} - -sub prereqs { - my $self = shift; - $self->mymeta->effective_prereqs; + $self->dist->dist; } 1; diff --git a/lib/Carton/Dependency.pm b/lib/Carton/Dist.pm similarity index 94% copy from lib/Carton/Dependency.pm copy to lib/Carton/Dist.pm index a204265..2586803 100644 --- a/lib/Carton/Dependency.pm +++ b/lib/Carton/Dist.pm @@ -1,4 +1,4 @@ -package Carton::Dependency; +package Carton::Dist; use strict; use CPAN::Meta; use Moo; diff --git a/lib/Carton/Lock.pm b/lib/Carton/Lock.pm index 02d8651..7abd40b 100644 --- a/lib/Carton/Lock.pm +++ b/lib/Carton/Lock.pm @@ -1,7 +1,7 @@ package Carton::Lock; use strict; use Config; -use Carton::Dependency; +use Carton::Dist; use Carton::Package; use Carton::Index; use Carton::Util; @@ -26,8 +26,8 @@ sub write { Carton::Util::dump_json({ %$self }, $file); } -sub dependencies { - map Carton::Dependency->new($_), values %{$_[0]->modules} +sub distributions { + map Carton::Dist->new($_), values %{$_[0]->modules} } sub find { @@ -35,7 +35,7 @@ sub find { for my $meta (values %{$_[0]->modules}) { if ($meta->{provides}{$module}) { - return Carton::Dependency->new( $self->modules->{$meta->{name}} ); + return Carton::Dist->new( $self->modules->{$meta->{name}} ); } } diff --git a/lib/Carton/Requirements.pm b/lib/Carton/Requirements.pm new file mode 100644 index 0000000..4d7b587 --- /dev/null +++ b/lib/Carton/Requirements.pm @@ -0,0 +1,54 @@ +package Carton::Requirements; +use strict; +use Carton::Dependency; +use Moo; +use CPAN::Meta::Requirements; + +has lock => (is => 'ro'); +has cpanfile => (is => 'ro'); + +sub walk_down { + my($self, $cb) = @_; + + my $dumper; $dumper = sub { + my($dependency, $prereqs, $level, $seen) = @_; + + $cb->($dependency, $level) if $dependency; + + my $reqs = CPAN::Meta::Requirements->new; + $reqs->add_requirements($prereqs->requirements_for($_, 'requires')) + for qw( configure build runtime test); + + for my $module (sort $reqs->required_modules) { + my $dependency = $self->dependency_for($module, $reqs); + if ($dependency->dist) { + next if $seen->{$dependency->distname}++; + $dumper->($dependency, $dependency->prereqs, $level + 1, $seen); + } else { + # no dist found in lock - probably core + } + } + }; + + $dumper->(undef, $self->cpanfile->prereqs, 0, {}); +} + +sub dependency_for { + my($self, $module, $reqs) = @_; + + my $version = $reqs->requirements_for_module($module); + + my $dep = Carton::Dependency->new; + $dep->module($module); + $dep->version($version); + + if (my $dist = $self->lock->find($module)) { + $dep->dist($dist); + } + + return $dep; +} + +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