view release on metacpan or  search on metacpan

lib/DBIx/Class/Tree/AdjacencyList.pm  view on Meta::CPAN

  __PACKAGE__->load_components(qw( Tree::AdjacencyList ... ));

Specify the column that contains the parent ID of each row.

  package My::Employee;
  __PACKAGE__->parent_column('parent_id');

Optionally, automatically maintane a consistent tree structure.

  __PACKAGE__->repair_tree( 1 );

Thats it, now you can modify and analyze the tree.

  #!/usr/bin/perl
  use My::Employee;

  my $employee = My::Employee->create({ name=>'Matt S. Trout' });

  my $rs = $employee->children();
  my @siblings = $employee->children();

  my $parent = $employee->parent();
  $employee->parent( 7 );

=head1 DESCRIPTION

This module provides methods for working with adjacency lists.  The
adjacency list model is a very common way of representing a tree structure.
In this model each row in a table has a prent ID column that references the
primary key of another row in the same table.  Because of this the primary
key must only be one column and is usually some sort of integer.  The row
with a parent ID of 0 is the root node and is usually the parent of all
other rows.  Although, there is no limitation in this module that would
stop you from having multiple root nodes.

=head1 METHODS

=head2 parent_column

  __PACKAGE__->parent_column('parent_id');

Declares the name of the column that contains the self-referential
ID which defines the parent row.  This will create a has_many (children) 
and belongs_to (parent) relationship.

This method also sets up an additional has_many relationship called
parents which is useful when you want to treat an adjacency list
as a DAG.

=cut

__PACKAGE__->mk_classdata( '_parent_column' => 'parent_id' );

sub parent_column {
    my $class = shift;
    if (@_) {
        my $parent_col = shift;
        my $primary_col = ($class->primary_columns())[0];
        $class->belongs_to( '_parent' => $class => { "foreign.$primary_col" => "self.$parent_col" } );
        $class->has_many( 'children' => $class => { "foreign.$parent_col" => "self.$primary_col" } );
        $class->has_many( 'parents' => $class => { "foreign.$primary_col" => "self.$parent_col" }, { cascade_delete => 0, cascade_copy => 0 } );
        $class->_parent_column( $parent_col );
        return 1;
    }
    return $class->_parent_column();
}

=head2 repair_tree

  __PACKAGE__->repair_tree( 1 );

When set a true value this flag causes all changes to a node's parent to
trigger an integrity check on the tree.  If, when changing a node's parent
to one of it's descendents then all its children will first be moved to have
the same current parent, and then the node's parent is changed.

So, for example, if the tree is like this:

  A
    B
      C
      D
        E
    F

And you execute:

  $b->parent( $d );

Since D is a descendant of B then all of D's siblings get their parent
changed to A.  Then B's parent is set to D.

  A
    C
    D
      B
      E
    F

=cut

__PACKAGE__->mk_classdata( 'repair_tree' => 0 );

=head2 parent

  my $parent = $employee->parent();
  $employee->parent( $parent_obj );
  $employee->parent( $parent_id );

Retrieves the object's parent object, or changes the object's
parent to the specified parent or parent ID.  If you would like
to make the object the root node, just set the parent to 0.

If you are setting the parent then 0 will be returned if the
specified parent is already the object's parent and 1 on
success.

=cut

sub parent {
    my $self = shift;