[Bast-commits] r4641 - DBIx-Class-Tree-NestedSet/lib/DBIx/Class/Tree

[rafl at dev.catalyst.perl.org]

Author: rafl
Date: 2008-07-25 01:59:33 +0100 (Fri, 25 Jul 2008)
New Revision: 4641

Modified:
   DBIx-Class-Tree-NestedSet/lib/DBIx/Class/Tree/NestedSet.pm
Log:
Make the accessor name for parent configurable.

Modified: DBIx-Class-Tree-NestedSet/lib/DBIx/Class/Tree/NestedSet.pm
===================================================================
--- DBIx-Class-Tree-NestedSet/lib/DBIx/Class/Tree/NestedSet.pm	2008-07-25 00:54:40 UTC (rev 4640)
+++ DBIx-Class-Tree-NestedSet/lib/DBIx/Class/Tree/NestedSet.pm	2008-07-25 00:59:33 UTC (rev 4641)
@@ -16,6 +16,7 @@
             nodes_rel    => 'nodes',
             children_rel => 'children',
             parents_rel  => 'parents',
+            parent_rel   => 'parent',
             %{ $args },
         };
 
@@ -53,18 +54,20 @@
               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 parent {
-    my ($self) = @_;
-
-    return $self->parents->first;
-}
-
 sub insert {
     my ($self, @args) = @_;