This is an automated email from the git hooks/post-receive script. kanashiro-guest pushed a commit to branch master in repository carton.
commit 0673a8bba69086704f5490e2d3ef9ffa0601ff88 Author: Tatsuhiko Miyagawa <[email protected]> Date: Wed Jun 29 23:33:33 2011 -0400 Uninstalling modules should not remove dependencies in Makefile.PL. Fixes #16 In $tree->normalize, check if the sub-tree of the element is actually specified as a direct dependency in Makefile.PL, in which case, restore the link to the sub-tree in the root child elements. --- lib/Carton.pm | 4 ++-- lib/Carton/CLI.pm | 14 ++++++++++++-- lib/Carton/Tree.pm | 17 ++++++++++++++--- 3 files changed, 28 insertions(+), 7 deletions(-) diff --git a/lib/Carton.pm b/lib/Carton.pm index d483cf9..f09a1f6 100644 --- a/lib/Carton.pm +++ b/lib/Carton.pm @@ -203,7 +203,7 @@ sub walk_down_tree { } sub build_tree { - my($self, $modules) = @_; + my($self, $modules, $root) = @_; my $idx = $self->build_index($modules); my $pool = { %$modules }; # copy @@ -214,7 +214,7 @@ sub build_tree { $self->_build_tree($pick, $tree, $tree, $pool, $idx); } - $tree->finalize; + $tree->finalize($root); return $tree; } diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm index bca6ecc..87062a3 100644 --- a/lib/Carton/CLI.pm +++ b/lib/Carton/CLI.pm @@ -195,15 +195,25 @@ sub cmd_uninstall { } } + my %root; + if ($self->has_build_file) { + for my $dep ($self->carton->list_dependencies) { + my($mod, $ver) = split /~/, $dep; + if (exists $index->{$mod}) { + $root{ $index->{$mod}{meta}{name} } = 1; + } + } + } + # only can uninstall root dependencies - my $tree = $self->carton->build_tree($lock->{modules}); + my $tree = $self->carton->build_tree($lock->{modules}, \%root); for my $root ($tree->children) { if (grep $_->{name} eq $root->key, @meta) { $tree->remove_child($root); } } - my @missing = grep !$tree->has_child($_), keys %{$lock->{modules}}; + my @missing = grep !$tree->find_child($_), keys %{$lock->{modules}}; for my $module (@missing) { my $meta = $lock->{modules}{$module}; $self->print("Uninstalling $meta->{dist}\n"); diff --git a/lib/Carton/Tree.pm b/lib/Carton/Tree.pm index ebd0fe6..7454b08 100644 --- a/lib/Carton/Tree.pm +++ b/lib/Carton/Tree.pm @@ -103,7 +103,9 @@ sub new { } sub finalize { - my $self = shift; + my($self, $want_root) = @_; + + $want_root ||= {}; my %subtree; my @ancestor; @@ -125,17 +127,26 @@ sub finalize { my $up = sub { pop @ancestor }; $self->_walk_down($down, $up, 0); - # remove root nodes that are sub-tree of another + # normalize: remove root nodes that are sub-tree of another for my $child ($self->children) { if ($subtree{$child->key}) { $self->remove_child($child); } } + # Ugh, but if the build file is there, restore the links to sub-tree as a root elements + my %curr_root = map { ($_->key => 1) } $self->children; + for my $key (keys %$want_root) { + my $node = $self->find_child($key) or next; + unless ($curr_root{$node->key}) { + $self->add_child($node); + } + } + %cache = (); } -sub has_child { +sub find_child { my($self, $key) = @_; my $child; -- 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
