[Bast-commits] r4619 - in DBIx-Class-Tree-NestedSet: . lib lib/DBIx lib/DBIx/Class lib/DBIx/Class/Tree

rafl at dev.catalyst.perl.org rafl at dev.catalyst.perl.org
Fri Jul 25 01:42:46 BST 2008


Author: rafl
Date: 2008-07-25 01:42:46 +0100 (Fri, 25 Jul 2008)
New Revision: 4619

Added:
   DBIx-Class-Tree-NestedSet/lib/
   DBIx-Class-Tree-NestedSet/lib/DBIx/
   DBIx-Class-Tree-NestedSet/lib/DBIx/Class/
   DBIx-Class-Tree-NestedSet/lib/DBIx/Class/Tree/
   DBIx-Class-Tree-NestedSet/lib/DBIx/Class/Tree/NestedSet.pm
Log:
Initial version.

Added: DBIx-Class-Tree-NestedSet/lib/DBIx/Class/Tree/NestedSet.pm
===================================================================
--- DBIx-Class-Tree-NestedSet/lib/DBIx/Class/Tree/NestedSet.pm	                        (rev 0)
+++ DBIx-Class-Tree-NestedSet/lib/DBIx/Class/Tree/NestedSet.pm	2008-07-25 00:42:46 UTC (rev 4619)
@@ -0,0 +1,60 @@
+use strict;
+use warnings;
+
+package DBIx::Class::Tree::NestedSet;
+
+use parent 'DBIx::Class';
+
+__PACKAGE__->mk_classdata( _tree_columns => 'foo' );
+
+sub tree_columns {
+    my ($class, $args) = @_;
+
+    if (defined $args) {
+        my ($root, $left, $right) = map {
+            $args->{"${_}_column"}
+        } qw/root left right/;
+
+        my $table     = $class->table;
+        my %join_cond = { "foreign.$root" => "me.$root" };
+
+        $class->belongs_to(
+            root => $class,
+            \%join_cond,
+            { where => 'me.left = 1', },
+        );
+
+        $class->has_many(
+            nodes => $class,
+            \%join_cond,
+        );
+
+        $class->has_many(
+            children => $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(
+            parents => $class,
+            { %join_cond, },
+            { where    => \"child.$left > me.$left AND child.$right < me.$right",
+              order_by =>  "me.$right",
+              from     =>  "$table me, $table child" },
+        );
+
+        $class->_tree_columns($args);
+    }
+
+    return $class->_tree_columns;
+}
+
+sub parent {
+    my ($self) = @_;
+
+    return $self->parents->first;
+}
+
+1;




More information about the Bast-commits mailing list