autogenerated makefile.pl == bad

[dbsrgits/DBIx-Class-Tree.git] / lib / DBIx / Class / Tree / AdjacencyList / Positional.pm

# 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.