--- /dev/null
+# vim: ts=8:sw=4:sts=4:et
+package DBIx::Class::Tree::AdjacencyList::Ordered;
+use strict;
+use warnings;
+use base qw( DBIx::Class );
+use Carp qw( croak );
+
+__PACKAGE__->load_components(qw(
+ Tree::AdjacencyList
+ Ordered
+));
+
+=head1 NAME
+
+DBIx::Class::Tree::AdjacencyList::Ordered - Glue DBIx::Class::Ordered and DBIx::Class::Tree::AdjacencyList together. (EXPERIMENTAL)
+
+=head1 SYNOPSIS
+
+Create a table for your tree data.
+
+ CREATE TABLE items (
+ item_id INTEGER PRIMARY KEY AUTOINCREMENT,
+ parent_id INTEGER NOT NULL DEFAULT 0,
+ position INTEGER NOT NULL,
+ name TEXT NOT NULL
+ );
+
+In your Schema or DB class add Tree::AdjacencyList::Ordered
+to the top of the component list.
+
+ __PACKAGE__->load_components(qw( Tree::AdjacencyList::Ordered ... ));
+
+Specify the column that contains the parent ID and position of each row.
+
+ package My::Employee;
+ __PACKAGE__->position_column('position');
+ __PACKAGE__->parent_column('parent_id');
+
+This module provides a few extra methods beyond what
+L<DBIx::Class::Ordered> and L<DBIx::Class::Tree::AdjacencyList>
+already provide.
+
+ my $parent = $item->parent();
+ $item->parent( $parent_obj );
+ $item->parent( $parent_id );
+
+ my $children_rs = $item->children();
+ my @children = $item->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 ordered
+rows. All of the methods that L<DBIx::Class::Ordered> and
+L<DBIx::Class::Tree::AdjacencyList> provide are available with this module.
+
+=head1 METHODS
+
+=head2 parent_column
+
+ __PACKAGE__->parent_column('parent_id');
+
+Works the same as AdjacencyList's parent_column() method, but it
+declares the children() has many relationship to be ordered by the
+position column.
+
+=cut
+
+sub parent_column {
+ my $class = shift;
+ if (@_) {
+ my $parent_col = shift;
+ my $primary_col = ($class->primary_columns())[0];
+ my $position_col = $class->position_column() || croak('You must call position_column() before calling parent_column()');
+ $class->belongs_to( '_parent' => $class => { "foreign.$primary_col" => "self.$parent_col" } );
+ $class->has_many( 'children' => $class => { "foreign.$parent_col" => "self.$primary_col" }, { order_by=>$position_col } );
+ $class->_parent_column( $parent_col );
+ return 1;
+ }
+ return $class->_parent_column();
+}
+
+=head2 parent
+
+ my $parent = $item->parent();
+ $item->parent( $parent_obj );
+ $item->parent( $parent_id );
+
+This method overrides AdjacencyList's parent() method but
+modifies it so that the object is moved to the last position,
+then the parent is changed, and then it is moved to the last
+position of the new list, thus maintaining the intergrity of
+the ordered lists.
+
+=cut
+
+sub parent {
+ my $self = shift;
+ if (@_) {
+ my $new_parent = shift;
+ my $parent_col = $self->_parent_column();
+ if (ref($new_parent)) {
+ $new_parent = $new_parent->id() || croak('Parent object does not have an ID');;
+ }
+ return 0 if ($new_parent == ($self->get_column($parent_col)||0));
+ $self->move_last;
+ $self->set_column( $parent_col => $new_parent );
+ $self->set_column(
+ $self->position_column() =>
+ $self->result_source->resultset->search(
+ {$self->_grouping_clause()}
+ )->count() + 1
+ );
+ $self->update();
+ return 1;
+ }
+ return $self->_parent();
+}
+
+=head2 children
+
+ my $children_rs = $item->children();
+ my @children = $item->children();
+
+This method works just like it does in the
+DBIx::Class::Tree::AdjacencyList module except it
+orders the children by there position.
+
+=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 grouping_column
+
+Postional's grouping_column method does not, and should not, be
+defined when using this module. This method just throws out an
+error if you try to use it.
+
+=cut
+
+sub grouping_column {
+ croak('Use parent_column() instead of grouping_column()');
+}
+
+=head2 _grouping_clause
+
+This method is provided as an override of the method in
+L<DBIx::Class::Ordered>. This method is what provides the
+glue between AdjacencyList and Ordered.
+
+=cut
+
+sub _grouping_clause {
+ my( $self ) = @_;
+ my $col = $self->_parent_column();
+ return (
+ $col => $self->get_column( $col )
+ );
+}
+
+1;
+__END__
+
+=head1 AUTHOR
+
+Aran Clary Deltac <bluefeet@cpan.org>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
projects / dbsrgits/DBIx-Class-Tree.git / blobdiff