This is an automated email from the git hooks/post-receive script. kanashiro-guest pushed a commit to branch master in repository carton.
commit 491f32779253a977c2f2dc801b4db44844e27395 Author: Tatsuhiko Miyagawa <[email protected]> Date: Sun Jun 26 17:06:50 2011 -0700 check now checks if you miss some dependencies in your build file --- lib/Carton.pm | 71 ++++++++++++++++++++++++++++++++++++++++++------------- lib/Carton/CLI.pm | 27 ++++++++++++++------- 2 files changed, 74 insertions(+), 24 deletions(-) diff --git a/lib/Carton.pm b/lib/Carton.pm index 9ee47a1..7d89b7a 100644 --- a/lib/Carton.pm +++ b/lib/Carton.pm @@ -160,10 +160,18 @@ sub build_index { return $index; } -sub walk_down_tree { - my($self, $lock, $cb) = @_; +sub is_core { + my($self, $module, $want_ver, $perl_version) = @_; + $perl_version ||= $]; require Module::CoreList; + my $core_ver = $Module::CoreList::version{$perl_version + 0}{$module}; + + return $core_ver && version->new($core_ver) >= version->new($want_ver); +}; + +sub walk_down_tree { + my($self, $lock, $cb) = @_; my %seen; my $tree = $self->build_tree($lock->{modules}); @@ -173,7 +181,7 @@ sub walk_down_tree { if ($node->metadata->{dist}) { $cb->($node->metadata, $depth); - } elsif (!$Module::CoreList::version{$]+0}{$node->key}) { + } elsif ($self->is_core($node->key, 0)) { warn "Couldn't find ", $node->key, "\n"; } }); @@ -291,22 +299,53 @@ sub find_locals { sub check_satisfies { my($self, $lock, $deps) = @_; - my @missing; + # TODO recurse dep tree to see all your dependencies are satisfied + # TODO then check if something is remaining in $lock, which is not specified in the build file + + my @unsatisfied; my $index = $self->build_index($lock->{modules}); - for my $dep (@$deps) { - # TODO recurse to see all your dependencies are satisfied? - my($mod, $ver) = split /~/, $dep; - my $found = $index->{$mod}; - unless ($found && (!$ver or version->new($found->{version}) >= version->new($ver))) { - push @missing, { - module => $mod, - version => $ver, - found => $found ? $found->{version} : undef, - }; - } + my %pool = %{$lock->{modules}}; # copy + + my @root = map { [ split /~/, $_, 2 ] } @$deps; + + for my $dep (@root) { + $self->_check_satisfies($dep, \@unsatisfied, $index, \%pool); } - return @missing; + return { + unsatisfied => \@unsatisfied, + superflous => [ values %pool ], + }; +} + +sub _check_satisfies { + my($self, $dep, $unsatisfied, $index, $pool) = @_; + + my($mod, $ver) = @$dep; + + my $found = $index->{$mod}; + if ($found) { + delete $pool->{$found->{meta}{name}}; + } elsif ($self->is_core($mod, $ver)) { + return; + } + + unless ($found and (!$ver or version->new($found->{version}) >= version->new($ver))) { + push @$unsatisfied, { + module => $mod, + version => $ver, + found => $found ? $found->{version} : undef, + }; + return; + } + + my $meta = $found->{meta}; + for my $requires (values %{$meta->{requires}}) { + for my $module (keys %$requires) { + next if $module eq 'perl'; + $self->_check_satisfies([ $module, $requires->{$module} ], $unsatisfied, $index, $pool); + } + } } diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm index 30ba653..7e93421 100644 --- a/lib/Carton/CLI.pm +++ b/lib/Carton/CLI.pm @@ -201,16 +201,27 @@ sub cmd_check { my $lock = $self->carton->build_lock; my @deps = $self->carton->list_dependencies; - my @unsatisfied = $self->carton->check_satisfies($lock, \@deps); - if (@unsatisfied) { + my $res = $self->carton->check_satisfies($lock, \@deps); + + my $ok = 1; + if (@{$res->{unsatisfied}}) { $self->print("Following dependencies are not satisfied. Run `carton install` to install them.\n", WARN); - for my $dep (@unsatisfied) { - $self->print("$dep->{module} " . - ($dep->{version} ? "($dep->{version}" . ($dep->{found} ? " > $dep->{found})" : ")") : "") . - "\n"); + for my $dep (@{$res->{unsatisfied}}) { + $self->print(" $dep->{module} " . ($dep->{version} ? "($dep->{version})" : "") . "\n"); } - } else { - $self->print("Dependencies specified in your $file are satisfied.\n", SUCCESS); + $ok = 0; + } + + if (@{$res->{superflous}}) { + $self->print("Following modules are found in $self->{path} but couldn't be tracked from your $file\n", WARN); + for my $dep (@{$res->{superflous}}) { + $self->print(" $dep->{module} " . ($dep->{version} ? "($dep->{version})" : "") . "\n"); + } + $ok = 0; + } + + if ($ok) { + $self->print("Dependencies specified in your $file are satisfied and completely match with modules in $self->{path}.\n", SUCCESS); } } -- 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 [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
