[Bast-commits] r4646 - in DBIx-Class-Tree-NestedSet: .
lib/DBIx/Class/Tree lib/DBIx/Class/Tree/NestedSet t t/lib/TestSchema
rafl at dev.catalyst.perl.org
rafl at dev.catalyst.perl.org
Fri Jul 25 22:23:48 BST 2008
Author: rafl
Date: 2008-07-25 22:23:48 +0100 (Fri, 25 Jul 2008)
New Revision: 4646
Added:
DBIx-Class-Tree-NestedSet/lib/DBIx/Class/Tree/NestedSet/
DBIx-Class-Tree-NestedSet/lib/DBIx/Class/Tree/NestedSet/Multi.pm
DBIx-Class-Tree-NestedSet/t/lib/TestSchema/MultiTree.pm
DBIx-Class-Tree-NestedSet/t/multi.t
Removed:
DBIx-Class-Tree-NestedSet/lib/DBIx/Class/Tree/NestedSet.pm
DBIx-Class-Tree-NestedSet/t/basic.t
DBIx-Class-Tree-NestedSet/t/lib/TestSchema/Tree.pm
Modified:
DBIx-Class-Tree-NestedSet/Makefile.PL
Log:
Rename NestedSet to NestedSet::Multi.
Modified: DBIx-Class-Tree-NestedSet/Makefile.PL
===================================================================
--- DBIx-Class-Tree-NestedSet/Makefile.PL 2008-07-25 10:15:09 UTC (rev 4645)
+++ DBIx-Class-Tree-NestedSet/Makefile.PL 2008-07-25 21:23:48 UTC (rev 4646)
@@ -3,6 +3,6 @@
use inc::Module::Install;
name 'DBIx-Class-Tree-NestedSet';
-all_from 'lib/DBIx/Class/Tree/NestedSet.pm';
+all_from 'lib/DBIx/Class/Tree/NestedSet/Multi.pm';
WriteAll;
Copied: DBIx-Class-Tree-NestedSet/lib/DBIx/Class/Tree/NestedSet/Multi.pm (from rev 4645, DBIx-Class-Tree-NestedSet/lib/DBIx/Class/Tree/NestedSet.pm)
===================================================================
--- DBIx-Class-Tree-NestedSet/lib/DBIx/Class/Tree/NestedSet/Multi.pm (rev 0)
+++ DBIx-Class-Tree-NestedSet/lib/DBIx/Class/Tree/NestedSet/Multi.pm 2008-07-25 21:23:48 UTC (rev 4646)
@@ -0,0 +1,155 @@
+use strict;
+use warnings;
+
+package DBIx::Class::Tree::NestedSet::Multi;
+
+use parent 'DBIx::Class';
+
+our $VERSION = '0.01_01';
+$VERSION = eval $VERSION;
+
+__PACKAGE__->mk_classdata( _tree_columns => {} );
+
+sub tree_columns {
+ my ($class, $args) = @_;
+
+ if (defined $args) {
+ $args = {
+ root_rel => 'root',
+ nodes_rel => 'nodes',
+ children_rel => 'children',
+ parents_rel => 'parents',
+ parent_rel => 'parent',
+ %{ $args },
+ };
+
+ my ($root, $left, $right) = map {
+ $args->{"${_}_column"}
+ } qw/root left right/;
+
+ my $table = $class->table;
+ my %join_cond = ( "foreign.$root" => "self.$root" );
+
+ $class->belongs_to(
+ $args->{root_rel} => $class,
+ \%join_cond,
+ { where => \"me.$left = 1", },
+ );
+
+ $class->has_many(
+ $args->{nodes_rel} => $class,
+ \%join_cond,
+ );
+
+ $class->has_many(
+ $args->{children_rel} => $class,
+ \%join_cond,
+ { where => \"me.$left > parent.$left AND me.$right < parent.$right",
+ order_by => "me.$left",
+ from => "$table me, $table parent" },
+ );
+
+ $class->has_many(
+ $args->{parents_rel} => $class,
+ { %join_cond, },
+ { where => \"child.$left > me.$left AND child.$right < me.$right",
+ order_by => "me.$right",
+ from => "$table me, $table child" },
+ );
+
+ {
+ no strict 'refs';
+ no warnings 'redefine';
+
+ my $meth = $args->{parents_rel};
+ *{ "${class}::${\$args->{parent_rel}}" } = sub { shift->$meth(@_)->first };
+ }
+
+ $class->_tree_columns($args);
+ }
+
+ return $class->_tree_columns;
+}
+
+sub insert {
+ my ($self, @args) = @_;
+
+ my ($root, $left, $right) = map {
+ $self->tree_columns->{"${_}_column"}
+ } qw/root left right/;
+
+ if (!$self->$right) {
+ $self->set_columns({
+ $left => 1,
+ $right => 2,
+ });
+ }
+
+ my $row;
+ my $get_row = $self->next::can;
+ $self->result_source->schema->txn_do(sub {
+ $row = $get_row->($self, @args);
+
+ if (!defined $row->$root) {
+ $row->update({
+ $root => $row->get_column( ($row->result_source->primary_columns)[0] ),
+ });
+
+ $row->discard_changes;
+ }
+ });
+
+ return $row;
+}
+
+sub create_related {
+ my ($self, $rel, $col_data) = @_;
+
+ if ($rel ne $self->tree_columns->{children_rel}) {
+ return $self->next::method($rel => $col_data);
+ }
+
+ my %col_data = %{ $col_data };
+ my ($root, $left, $right) = map {
+ $self->tree_columns->{"${_}_column"}
+ } qw/root left right/;
+
+ my $row;
+ my $get_row = $self->next::can;
+ $self->result_source->schema->txn_do(sub {
+ $self->discard_changes;
+ my $p_rgt = $self->$right;
+
+ $self->nodes_rs->update({
+ $left => \"CASE WHEN $left > $p_rgt THEN $left + 2 ELSE $left END",
+ $right => \"CASE WHEN $right >= $p_rgt THEN $right + 2 ELSE $right END",
+ });
+
+ @col_data{$root, $left, $right} = ($self->$root, $p_rgt, $p_rgt + 1);
+ $row = $get_row->($self, $rel => \%col_data);
+ });
+
+ return $row;
+}
+
+sub search_related {
+ my ($self, $rel, $cond, @rest) = @_;
+ my $pk = ($self->result_source->primary_columns)[0];
+
+ $cond ||= {};
+ if ($rel eq $self->tree_columns->{children_rel}) {
+ $cond->{"parent.$pk"} = $self->$pk,
+ }
+ elsif ($rel eq $self->tree_columns->{parents_rel}) {
+ $cond->{"child.$pk"} = $self->$pk,
+ }
+
+ return $self->next::method($rel, $cond, @rest);
+}
+
+{
+ no warnings 'once';
+ *search_related_rs = \&search_related;
+}
+
+1;
Deleted: DBIx-Class-Tree-NestedSet/lib/DBIx/Class/Tree/NestedSet.pm
===================================================================
--- DBIx-Class-Tree-NestedSet/lib/DBIx/Class/Tree/NestedSet.pm 2008-07-25 10:15:09 UTC (rev 4645)
+++ DBIx-Class-Tree-NestedSet/lib/DBIx/Class/Tree/NestedSet.pm 2008-07-25 21:23:48 UTC (rev 4646)
@@ -1,155 +0,0 @@
-use strict;
-use warnings;
-
-package DBIx::Class::Tree::NestedSet;
-
-use parent 'DBIx::Class';
-
-our $VERSION = '0.01_01';
-$VERSION = eval $VERSION;
-
-__PACKAGE__->mk_classdata( _tree_columns => {} );
-
-sub tree_columns {
- my ($class, $args) = @_;
-
- if (defined $args) {
- $args = {
- root_rel => 'root',
- nodes_rel => 'nodes',
- children_rel => 'children',
- parents_rel => 'parents',
- parent_rel => 'parent',
- %{ $args },
- };
-
- my ($root, $left, $right) = map {
- $args->{"${_}_column"}
- } qw/root left right/;
-
- my $table = $class->table;
- my %join_cond = ( "foreign.$root" => "self.$root" );
-
- $class->belongs_to(
- $args->{root_rel} => $class,
- \%join_cond,
- { where => \"me.$left = 1", },
- );
-
- $class->has_many(
- $args->{nodes_rel} => $class,
- \%join_cond,
- );
-
- $class->has_many(
- $args->{children_rel} => $class,
- \%join_cond,
- { where => \"me.$left > parent.$left AND me.$right < parent.$right",
- order_by => "me.$left",
- from => "$table me, $table parent" },
- );
-
- $class->has_many(
- $args->{parents_rel} => $class,
- { %join_cond, },
- { where => \"child.$left > me.$left AND child.$right < me.$right",
- order_by => "me.$right",
- from => "$table me, $table child" },
- );
-
- {
- no strict 'refs';
- no warnings 'redefine';
-
- my $meth = $args->{parents_rel};
- *{ "${class}::${\$args->{parent_rel}}" } = sub { shift->$meth(@_)->first };
- }
-
- $class->_tree_columns($args);
- }
-
- return $class->_tree_columns;
-}
-
-sub insert {
- my ($self, @args) = @_;
-
- my ($root, $left, $right) = map {
- $self->tree_columns->{"${_}_column"}
- } qw/root left right/;
-
- if (!$self->$right) {
- $self->set_columns({
- $left => 1,
- $right => 2,
- });
- }
-
- my $row;
- my $get_row = $self->next::can;
- $self->result_source->schema->txn_do(sub {
- $row = $get_row->($self, @args);
-
- if (!defined $row->$root) {
- $row->update({
- $root => $row->get_column( ($row->result_source->primary_columns)[0] ),
- });
-
- $row->discard_changes;
- }
- });
-
- return $row;
-}
-
-sub create_related {
- my ($self, $rel, $col_data) = @_;
-
- if ($rel ne $self->tree_columns->{children_rel}) {
- return $self->next::method($rel => $col_data);
- }
-
- my %col_data = %{ $col_data };
- my ($root, $left, $right) = map {
- $self->tree_columns->{"${_}_column"}
- } qw/root left right/;
-
- my $row;
- my $get_row = $self->next::can;
- $self->result_source->schema->txn_do(sub {
- $self->discard_changes;
- my $p_rgt = $self->$right;
-
- $self->nodes_rs->update({
- $left => \"CASE WHEN $left > $p_rgt THEN $left + 2 ELSE $left END",
- $right => \"CASE WHEN $right >= $p_rgt THEN $right + 2 ELSE $right END",
- });
-
- @col_data{$root, $left, $right} = ($self->$root, $p_rgt, $p_rgt + 1);
- $row = $get_row->($self, $rel => \%col_data);
- });
-
- return $row;
-}
-
-sub search_related {
- my ($self, $rel, $cond, @rest) = @_;
- my $pk = ($self->result_source->primary_columns)[0];
-
- $cond ||= {};
- if ($rel eq $self->tree_columns->{children_rel}) {
- $cond->{"parent.$pk"} = $self->$pk,
- }
- elsif ($rel eq $self->tree_columns->{parents_rel}) {
- $cond->{"child.$pk"} = $self->$pk,
- }
-
- return $self->next::method($rel, $cond, @rest);
-}
-
-{
- no warnings 'once';
- *search_related_rs = \&search_related;
-}
-
-1;
Deleted: DBIx-Class-Tree-NestedSet/t/basic.t
===================================================================
--- DBIx-Class-Tree-NestedSet/t/basic.t 2008-07-25 10:15:09 UTC (rev 4645)
+++ DBIx-Class-Tree-NestedSet/t/basic.t 2008-07-25 21:23:48 UTC (rev 4646)
@@ -1,54 +0,0 @@
-use strict;
-use warnings;
-use Test::More tests => 23;
-use DBICx::TestDatabase;
-
-use FindBin;
-use lib "$FindBin::Bin/lib";
-
-BEGIN { use_ok('TestSchema') }
-
-my $schema = DBICx::TestDatabase->new('TestSchema');
-isa_ok($schema, 'DBIx::Class::Schema');
-
-my $trees = $schema->resultset('Tree');
-isa_ok($trees, 'DBIx::Class::ResultSet');
-
-my $root = $trees->create({ content => 'foo' });
-isa_ok($root, 'DBIx::Class::Row');
-
-is($root->parent, undef, 'root has no parent');
-is($root->root->id, $root->id, 'root field gets set automatically');
-is($root->children->count, 0, 'no children, initially');
-is($root->nodes->count, 1, 'nodes include self');
-
-my $child = $root->add_to_children({ content => 'bar' });
-is($child->root->id, $root->id, 'root set for children');
-is($child->parents->count, 1, 'child got one parent');
-is($child->parent->id, $root->id, 'parent rel works');
-is($root->children->count, 1, 'now one child');
-is($root->nodes->count, 2, '... and two related nodes');
-
-my $child2 = $root->add_to_children({ content => 'kooh' });
-
-my $subchild = $child->add_to_children({ content => 'moo' });
-is($subchild->root->id, $root->id, 'root set for subchilds');
-is($root->children->count, 3, 'root now two childs');
-is($root->nodes->count, 4, '... and three related nodes');
-is($child->children->count, 1, 'subnode has one children');
-is($child->nodes->count, 4, '... and three related nodes as well');
-is($subchild->children->count, 0, 'subchild does not have children yet');
-is($subchild->parents->count, 2, '... but two parents');
-is($subchild->parent->id, $child->id, 'direct parent is correct');
-
-is_deeply(
- [map { $_->id } $subchild->parents],
- [map { $_->id } $child, $root],
- 'parents are ordered correctly',
-);
-
-is_deeply(
- [map { $_->id } $root->children],
- [map { $_->id } $child, $subchild, $child2],
- 'roots children are ordered correctly',
-);
Copied: DBIx-Class-Tree-NestedSet/t/lib/TestSchema/MultiTree.pm (from rev 4645, DBIx-Class-Tree-NestedSet/t/lib/TestSchema/Tree.pm)
===================================================================
--- DBIx-Class-Tree-NestedSet/t/lib/TestSchema/MultiTree.pm (rev 0)
+++ DBIx-Class-Tree-NestedSet/t/lib/TestSchema/MultiTree.pm 2008-07-25 21:23:48 UTC (rev 4646)
@@ -0,0 +1,33 @@
+use strict;
+use warnings;
+
+package TestSchema::MultiTree;
+
+use parent 'DBIx::Class';
+
+__PACKAGE__->load_components(qw/Tree::NestedSet::Multi Core/);
+__PACKAGE__->table('tree');
+
+__PACKAGE__->add_columns(
+ id => {
+ data_type => 'integer',
+ is_auto_increment => 1,
+ },
+ root => {
+ data_type => 'integer',
+ is_nullable => 1,
+ },
+ lft => { data_type => 'integer' },
+ rgt => { data_type => 'integer' },
+ content => { data_type => 'text' },
+);
+
+__PACKAGE__->set_primary_key(qw/id/);
+
+__PACKAGE__->tree_columns({
+ root_column => 'root',
+ left_column => 'lft',
+ right_column => 'rgt',
+});
+
+1;
Deleted: DBIx-Class-Tree-NestedSet/t/lib/TestSchema/Tree.pm
===================================================================
--- DBIx-Class-Tree-NestedSet/t/lib/TestSchema/Tree.pm 2008-07-25 10:15:09 UTC (rev 4645)
+++ DBIx-Class-Tree-NestedSet/t/lib/TestSchema/Tree.pm 2008-07-25 21:23:48 UTC (rev 4646)
@@ -1,33 +0,0 @@
-use strict;
-use warnings;
-
-package TestSchema::Tree;
-
-use parent 'DBIx::Class';
-
-__PACKAGE__->load_components(qw/Tree::NestedSet Core/);
-__PACKAGE__->table('tree');
-
-__PACKAGE__->add_columns(
- id => {
- data_type => 'integer',
- is_auto_increment => 1,
- },
- root => {
- data_type => 'integer',
- is_nullable => 1,
- },
- lft => { data_type => 'integer' },
- rgt => { data_type => 'integer' },
- content => { data_type => 'text' },
-);
-
-__PACKAGE__->set_primary_key(qw/id/);
-
-__PACKAGE__->tree_columns({
- root_column => 'root',
- left_column => 'lft',
- right_column => 'rgt',
-});
-
-1;
Copied: DBIx-Class-Tree-NestedSet/t/multi.t (from rev 4645, DBIx-Class-Tree-NestedSet/t/basic.t)
===================================================================
--- DBIx-Class-Tree-NestedSet/t/multi.t (rev 0)
+++ DBIx-Class-Tree-NestedSet/t/multi.t 2008-07-25 21:23:48 UTC (rev 4646)
@@ -0,0 +1,54 @@
+use strict;
+use warnings;
+use Test::More tests => 23;
+use DBICx::TestDatabase;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+BEGIN { use_ok('TestSchema') }
+
+my $schema = DBICx::TestDatabase->new('TestSchema');
+isa_ok($schema, 'DBIx::Class::Schema');
+
+my $trees = $schema->resultset('MultiTree');
+isa_ok($trees, 'DBIx::Class::ResultSet');
+
+my $root = $trees->create({ content => 'foo' });
+isa_ok($root, 'DBIx::Class::Row');
+
+is($root->parent, undef, 'root has no parent');
+is($root->root->id, $root->id, 'root field gets set automatically');
+is($root->children->count, 0, 'no children, initially');
+is($root->nodes->count, 1, 'nodes include self');
+
+my $child = $root->add_to_children({ content => 'bar' });
+is($child->root->id, $root->id, 'root set for children');
+is($child->parents->count, 1, 'child got one parent');
+is($child->parent->id, $root->id, 'parent rel works');
+is($root->children->count, 1, 'now one child');
+is($root->nodes->count, 2, '... and two related nodes');
+
+my $child2 = $root->add_to_children({ content => 'kooh' });
+
+my $subchild = $child->add_to_children({ content => 'moo' });
+is($subchild->root->id, $root->id, 'root set for subchilds');
+is($root->children->count, 3, 'root now two childs');
+is($root->nodes->count, 4, '... and three related nodes');
+is($child->children->count, 1, 'subnode has one children');
+is($child->nodes->count, 4, '... and three related nodes as well');
+is($subchild->children->count, 0, 'subchild does not have children yet');
+is($subchild->parents->count, 2, '... but two parents');
+is($subchild->parent->id, $child->id, 'direct parent is correct');
+
+is_deeply(
+ [map { $_->id } $subchild->parents],
+ [map { $_->id } $child, $root],
+ 'parents are ordered correctly',
+);
+
+is_deeply(
+ [map { $_->id } $root->children],
+ [map { $_->id } $child, $subchild, $child2],
+ 'roots children are ordered correctly',
+);
More information about the Bast-commits
mailing list