Skip to content
Browse files

implement take_cutting; add tests

  • Loading branch information...
1 parent f2bf5b7 commit 0f4becf9b98dbfb366f30369538e1bded886f2a4 @moritz committed Mar 15, 2011
Showing with 119 additions and 0 deletions.
  1. +43 −0 lib/DBIx/Class/Tree/NestedSet.pm
  2. +76 −0 t/17-cutting.t
View
43 lib/DBIx/Class/Tree/NestedSet.pm
@@ -545,6 +545,49 @@ sub attach_left_sibling {
# otherwise it comes from the primary key
#
sub take_cutting {
+ my $self = shift;
+
+ my ($root, $left, $right, $level) = $self->_get_columns;
+
+
+ $self->result_source->schema->txn_do(sub {
+ my $p_lft = $self->$left;
+ my $p_rgt = $self->$right;
+ return $self if $p_lft == $p_rgt + 1;
+
+ my $pk = ($self->result_source->primary_columns)[0];
+
+ $self->discard_changes;
+ my $root_id = $self->$root;
+
+ my $p_diff = $p_rgt - $p_lft;
+ my $l_diff = $self->$level - 1;
+ my $new_id = $self->$pk;
+ # I'd love to use $self->descendants->update(...),
+ # but it dies with "_strip_cond_qualifiers() is unable to
+ # handle a condition reftype SCALAR".
+ # tough beans.
+ $self->nodes_rs->search({
+ $root => $root_id,
+ $left => {'>=' => $p_lft },
+ $right => {'<=' => $p_rgt },
+ })->update({
+ $left => \"$left - $p_lft + 1",
+ $right => \"$right - $p_lft + 1",
+ $root => $new_id,
+ $level => \"$level - $l_diff",
+ });
+
+ # fix up the rest of the tree
+ $self->nodes_rs->search({
+ $root => $root_id,
+ $left => { '>=' => $p_rgt},
+ })->update({
+ $left => \"$left - $p_diff",
+ $right => \"$right - $p_diff",
+ });
+ });
+ return $self;
}
# Move a node to the left
View
76 t/17-cutting.t
@@ -0,0 +1,76 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+use DBICx::TestDatabase;
+use Data::Dumper;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use lib "$FindBin::Bin/tlib";
+
+use TestTree;
+
+BEGIN { use_ok('TestSchema') }
+
+my $schema = DBICx::TestDatabase->new('TestSchema');
+isa_ok($schema, 'DBIx::Class::Schema');
+
+my $test_tree = TestTree->new({schema => $schema});
+
+my $trees = $schema->resultset('MultiTree');
+isa_ok($trees, 'DBIx::Class::ResultSet');
+
+# Create the tree
+# taken from t/16-siblings.t
+my $tree1 = $trees->create({ content => '1 tree root'});
+
+my $child1_1 = $tree1->add_to_children({ content => '1 child 1' });
+my $child1_2 = $tree1->add_to_children({ content => '1 child 2' });
+my $child1_3 = $tree1->add_to_children({ content => '1 child 3' });
+my $child1_4 = $tree1->add_to_children({ content => '1 child 4' });
+
+my $gchild1_1 = $child1_2->add_to_children({ content => '1 g-child 1' });
+my $gchild1_2 = $child1_2->add_to_children({ content => '1 g-child 2' });
+my $gchild1_3 = $child1_4->add_to_children({ content => '1 g-child 3' });
+my $gchild1_4 = $child1_4->add_to_children({ content => '1 g-child 4' });
+
+my $ggchild1 = $gchild1_2->add_to_children({ content => '1 gg-child 1' });
+
+sub refresh {
+ for ($tree1, $child1_1, $child1_2, $child1_3, $child1_4,
+ $gchild1_1, $gchild1_2, $gchild1_3, $gchild1_4,
+ $ggchild1) {
+
+ $_->discard_changes;
+ }
+}
+
+refresh();
+
+goto NEXT;
+NEXT:
+
+
+# Check that the test tree is constructed correctly
+is_deeply(
+ [map { $_->id} $tree1->nodes],
+ [map { $_->id} $tree1, $child1_1, $child1_2, $gchild1_1, $gchild1_2, $ggchild1, $child1_3, $child1_4, $gchild1_3, $gchild1_4],
+ 'Test Tree is organised correctly.',
+);
+
+my $subtree = $child1_2->take_cutting;
+refresh();
+
+is_deeply(
+ [map { $_->id } $subtree->nodes],
+ [map { $_->id } $child1_2, $gchild1_1, $gchild1_2, $ggchild1],
+ 'cut out tree is organised correctly.');
+
+is_deeply(
+ [map { $_->id } $tree1->nodes],
+ [map { $_->id } $tree1, $child1_1, $child1_3, $child1_4, $gchild1_3, $gchild1_4],
+ 'remainder of tree intact.');
+
+done_testing;

0 comments on commit 0f4becf

Please sign in to comment.
Something went wrong with that request. Please try again.