Moved Positional code to a separate module.
[dbsrgits/DBIx-Class-Tree.git] / lib / DBIx / Class / Tree / AdjacencyList / Positional.pm
diff --git a/lib/DBIx/Class/Tree/AdjacencyList/Positional.pm b/lib/DBIx/Class/Tree/AdjacencyList/Positional.pm
new file mode 100644 (file)
index 0000000..97e4149
--- /dev/null
@@ -0,0 +1,213 @@
+# vim: ts=8:sw=4:sts=4:et
+package DBIx::Class::Tree::AdjacencyList::Positional;
+use strict;
+use warnings;
+use base qw( DBIx::Class );
+use Carp qw( croak );
+
+__PACKAGE__->load_components(qw(
+    Tree::AdjacencyList
+    Positional
+));
+
+=head1 NAME
+
+DBIx::Class::Tree::AdjacencyList::Positional - Glue DBIx::Class::Positional and DBIx::Class::Tree::AdjacencyList together. (EXPERIMENTAL)
+
+=head1 SYNOPSIS
+
+Create a table for your tree data.
+
+  CREATE TABLE employees (
+    employee_id INTEGER PRIMARY KEY AUTOINCREMENT,
+    parent_id INTEGER NOT NULL,
+    position INTEGER NOT NULL,
+    name TEXT NOT NULL
+  );
+
+In your Schema or DB class add Tree::AdjacencyList::Positional 
+to the top of the component list.
+
+  __PACKAGE__->load_components(qw( Tree::AdjacencyList::Positional ... ));
+
+Specify the column that contains the parent ID and position of each row.
+
+  package My::Employee;
+  __PACKAGE__->parent_column('parent_id');
+  __PACAKGE__->position_column('position');
+
+This module provides a few extra methods beyond what 
+L<DBIx::Class::Positional> and L<DBIx::Class::Tree::AdjacencyList> 
+already provide.
+
+  my $parent = $employee->parent();
+  $employee->parent( $parent_obj );
+  $employee->parent( $parent_id );
+  
+  my $children_rs = $employee->children();
+  my @children = $employee->children();
+  
+  $parent->append_child( $child );
+  $parent->prepend_child( $child );
+  
+  $this->attach_before( $that );
+  $this->attach_after( $that );
+
+=head1 DESCRIPTION
+
+This module provides methods for working with adjacency lists and positional 
+rows.  All of the methods that L<DBIx::Class::Positional> and 
+L<DBIx::Class::Tree::AdjacencyList> provide are available with this module.  
+If you 
+
+=head1 METHODS
+
+=head2 parent
+
+  my $parent = $employee->parent();
+  $employee->parent( $parent_obj );
+  $employee->parent( $parent_id );
+  
+  my $children_rs = $employee->children();
+  my @children = $employee->children();
+
+This method works exactly like it does in the 
+DBIx::Class::Tree::AdjacencyList module except that it will 
+first move the object to the last position of the list, change 
+the parent ID, then move the object to the last position of 
+the new list.  This ensures the intergrity of the positions.
+
+=cut
+
+sub parent {
+    my( $self, $new_parent ) = @_;
+    if ($new_parent) {
+        if (ref($new_parent)) {
+            $new_parent = $new_parent->id() || 0;
+        }
+        return 0 if ($new_parent == ($self->get_column($self->parent_column())||0));
+        $self->move_last();
+        return 0 if (!$self->next::method( $new_parent ));
+        $self->set_column(
+            $self->position_column() => $self->search( {$self->_collection_clause()} )->count() + 1
+        );
+        $self->update();
+        return 1;
+    }
+    else {
+        return $self->next::method();
+    }
+}
+
+=head2 children
+
+  my $children_rs = $employee->children();
+  my @children = $employee->children();
+
+This method works just like it does in the 
+DBIx::Class::Tree::AdjacencyList module except it 
+orders the children by there position.
+
+=cut
+
+sub children {
+    my( $self ) = @_;
+    my $rs = $self->search(
+        { $self->parent_column() => $self->id() },
+        { order_by => $self->position_column() }
+    );
+    return $rs->all() if (wantarray());
+    return $rs;
+}
+
+=head2 append_child
+
+  $parent->append_child( $child );
+
+Sets the child to have the specified parent and moves the 
+child to the last position.
+
+=cut
+
+sub append_child {
+    my( $self, $child ) = @_;
+    $child->parent( $self );
+}
+
+=head2 prepend_child
+
+  $parent->prepend_child( $child );
+
+Sets the child to have the specified parent and moves the 
+child to the first position.
+
+=cut
+
+sub prepend_child {
+    my( $self, $child ) = @_;
+    $child->parent( $self );
+    $child->move_first();
+}
+
+=head2 attach_before
+
+  $this->attach_before( $that );
+
+Attaches the object at the position just before the 
+calling object's position.
+
+=cut
+
+sub attach_before {
+    my( $self, $sibling ) = @_;
+    $sibling->parent( $self->parent() );
+    $sibling->move_to( $self->get_column($self->position_column()) );
+}
+
+=head2 attach_after
+
+  $this->attach_after( $that );
+
+Attaches the object at the position just after the 
+calling object's position.
+
+=cut
+
+sub attach_after {
+    my( $self, $sibling ) = @_;
+    $sibling->parent( $self->parent() );
+    $sibling->move_to( $self->get_column($self->position_column()) + 1 );
+}
+
+=head1 PRIVATE METHODS
+
+These methods are used internally.  You should never have the 
+need to use them.
+
+=head2 _collection_clause
+
+This method is provided as an override of the method in 
+L<DBIx::Class::Positional>.  This method is what provides the 
+glue between AdjacencyList and Positional.
+
+=cut
+
+sub _collection_clause {
+    my( $self ) = @_;
+    return (
+        $self->parent_column() =>
+        $self->get_column($self->parent_column())
+    );
+}
+
+1;
+__END__
+
+=head1 AUTHOR
+
+Aran Clary Deltac <bluefeet@cpan.org>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+