This is an automated email from the git hooks/post-receive script.
kanashiro-guest pushed a commit to branch master
in repository carton.
commit 5c13391f20c1552235a334be07765eae2df659a4
Author: Tatsuhiko Miyagawa <miyag...@bulknews.net>
Date: Thu May 30 16:12:32 2013 +0900
remove tree related code.
It was nice to have to visualize the dep tree, but not really
necessary for carton install and deployments.
---
lib/Carton.pm | 36 -----------
lib/Carton/CLI.pm | 34 +---------
lib/Carton/Doc/Tree.pod | 13 ----
lib/Carton/Tree.pm | 164 ------------------------------------------------
4 files changed, 2 insertions(+), 245 deletions(-)
diff --git a/lib/Carton.pm b/lib/Carton.pm
index 6953097..a7f78bc 100644
--- a/lib/Carton.pm
+++ b/lib/Carton.pm
@@ -226,39 +226,6 @@ sub walk_down_tree {
});
}
-sub build_tree {
- my($self, $modules, $root) = @_;
-
- my $idx = $self->build_index($modules);
- my $pool = { %$modules }; # copy
-
- my $tree = Carton::Tree->new;
-
- while (my $pick = (keys %$pool)[0]) {
- $self->_build_tree($pick, $tree, $tree, $pool, $idx);
- }
-
- $tree->finalize($root);
-
- return $tree;
-}
-
-sub _build_tree {
- my($self, $elem, $tree, $curr_node, $pool, $idx) = @_;
-
- if (my $cached = Carton::TreeNode->cached($elem)) {
- $curr_node->add_child($cached);
- return;
- }
-
- my $node = Carton::TreeNode->new($elem, $pool);
- $curr_node->add_child($node);
-
- for my $child ( $self->build_deps($node->metadata, $idx) ) {
- $self->_build_tree($child, $tree, $node, $pool, $idx);
- }
-}
-
sub merge_prereqs {
my($self, $prereqs) = @_;
@@ -361,11 +328,8 @@ sub check_satisfies {
$self->_check_satisfies($dep, \@unsatisfied, $index, \%pool);
}
- my $tree = keys %pool ? $self->build_tree(\%pool) : undef;
-
return {
unsatisfied => \@unsatisfied,
- superflous => $tree,
};
}
diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm
index 5e0ea1b..ce84b1d 100644
--- a/lib/Carton/CLI.pm
+++ b/lib/Carton/CLI.pm
@@ -10,7 +10,6 @@ use Term::ANSIColor qw(colored);
use Carton;
use Carton::Util;
use Carton::Error;
-use Carton::Tree;
use Try::Tiny;
use constant { SUCCESS => 0, INFO => 1, WARN => 2, ERROR => 3 };
@@ -217,31 +216,14 @@ sub cmd_show {
}
}
-sub cmd_tree {
- my $self = shift;
- $self->cmd_list("--tree", @_);
-}
-
sub cmd_list {
my($self, @args) = @_;
- my $tree_mode;
- $self->parse_options(\@args, "tree!" => \$tree_mode);
-
my $lock = $self->find_lock
or $self->error("Can't find carton.lock: Run `carton install` to
rebuild the lock file.\n");
- if ($tree_mode) {
- my $tree = $self->carton->build_tree($lock->{modules});
- $self->carton->walk_down_tree($tree, sub {
- my($module, $depth) = @_;
- my $line = " " x $depth . "$module->{dist}\n";
- $self->print($line);
- });
- } else {
- for my $module (values %{$lock->{modules} || {}}) {
- $self->print("$module->{dist}\n");
- }
+ for my $module (values %{$lock->{modules} || {}}) {
+ $self->print("$module->{dist}\n");
}
}
@@ -267,17 +249,6 @@ sub cmd_check {
$ok = 0;
}
- if ($res->{superflous}) {
- $self->printf("Following modules are found in %s but couldn't be
tracked from your $file\n",
- $self->carton->{path}, WARN);
- $self->carton->walk_down_tree($res->{superflous}, sub {
- my($module, $depth) = @_;
- my $line = " " x $depth . "$module->{dist}\n";
- $self->print($line);
- }, 1);
- $ok = 0;
- }
-
if ($ok) {
$self->printf("Dependencies specified in your $file are satisfied and
matches with modules in %s.\n",
$self->carton->{path}, SUCCESS);
@@ -286,7 +257,6 @@ sub cmd_check {
sub cmd_update {
# "cleanly" update distributions in extlib
- # rebuild the tree, update modules with DFS
die <<EOF;
carton update is not implemented yet.
diff --git a/lib/Carton/Doc/Tree.pod b/lib/Carton/Doc/Tree.pod
deleted file mode 100644
index b6b0879..0000000
--- a/lib/Carton/Doc/Tree.pod
+++ /dev/null
@@ -1,13 +0,0 @@
-=head1 NAME
-
-Carton::Doc::Tree - List dependencies in a tree structure
-
-=head1 SYNOPSIS
-
- carton tree
-
-=head1 DESCRIPTION
-
-List the dependencies and version information tracked in the
-I<carton.lock> file as a tree structure. This command is an alias for
-C<carton list --tree>
diff --git a/lib/Carton/Tree.pm b/lib/Carton/Tree.pm
deleted file mode 100644
index fd9b6bb..0000000
--- a/lib/Carton/Tree.pm
+++ /dev/null
@@ -1,164 +0,0 @@
-package Carton::TreeNode;
-use strict;
-use warnings;
-
-my %cache;
-
-sub cached {
- my($class, $key) = @_;
- return $cache{$key};
-}
-
-sub new {
- my($class, $key, $pool) = @_;
-
- my $meta = delete $pool->{$key} || {};
-
- my $self = bless [ $key, $meta, [] ], $class;
- $cache{$key} = $self;
-
- return $self;
-}
-
-sub dump {
- my $self = shift;
- $self->walk_down(sub {
- my($node, $depth) = @_;
- print " " x $depth;
- print $node->key, "\n";
- });
-}
-
-sub walk_down {
- my($self, $cb) = @_;
- $self->_walk_down($cb, undef, 0);
-}
-
-sub _walk_down {
- my($self, $pre_cb, $post_cb, $depth) = @_;
-
- my @child = $self->children;
- for my $child ($self->children) {
- local $Carton::Tree::Abort = 0;
- if ($pre_cb) {
- $pre_cb->($child, $depth, $self);
- }
-
- unless ($Carton::Tree::Abort) {
- $child->_walk_down($pre_cb, $post_cb, $depth + 1);
- }
-
- if ($post_cb) {
- $post_cb->($child, $depth, $self);
- }
- }
-}
-
-sub abort {
- $Carton::Tree::Abort = 1;
-}
-
-sub key { $_[0]->[0] }
-sub metadata { $_[0]->[1] }
-
-sub spec {
- my $self = shift;
-
- my $meta = $self->metadata;
- my $version = $meta->{provides}{$meta->{name}}{version} ||
$meta->{version};
- $meta->{name} . ($version ? '~' . $version : '');
-}
-
-sub children { @{$_[0]->[2]} }
-
-sub add_child {
- my $self = shift;
- push @{$self->[2]}, @_;
-}
-
-sub remove_child {
- my($self, $rm) = @_;
-
- my @new;
- for my $child (@{$self->[2]}) {
- if ($rm->key eq $child->key) {
- undef $child;
- } else {
- push @new, $child;
- }
- }
-
- $self->[2] = \@new;
-}
-
-sub is {
- my($self, $node) = @_;
- $self->key eq $node->key;
-}
-
-package Carton::Tree;
-our @ISA = qw(Carton::TreeNode);
-
-sub new {
- bless [0, {}, []], shift;
-}
-
-sub finalize {
- my($self, $want_root) = @_;
-
- $want_root ||= {};
-
- my %subtree;
- my @ancestor;
-
- my $down = sub {
- my($node, $depth, $parent) = @_;
-
- if (grep $node->is($_), @ancestor) {
- $parent->remove_child($node);
- return $self->abort;
- }
-
- $subtree{$node->key} = 1 if $depth > 0;
-
- push @ancestor, $node;
- return 1;
- };
-
- my $up = sub { pop @ancestor };
- $self->_walk_down($down, $up, 0);
-
- # 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 find_child {
- my($self, $key) = @_;
-
- my $child;
- $self->walk_down(sub {
- if ($_[0]->key eq $key) {
- $child = $_[0];
- return $self->abort;
- }
- });
-
- return $child;
-}
-
-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
