lib/DBIx/Class/Tree/AdjacencyList.pm

   1 # vim: ts=8:sw=4:sts=4:et
   2 package DBIx::Class::Tree::AdjacencyList;
   3 use strict;
   4 use warnings;
   5 use base qw( DBIx::Class );
   6 use Carp qw( croak );
   7
   8 =head1 NAME
   9
  10 DBIx::Class::Tree::AdjacencyList - Manage a tree of data using the common adjacency list model. (EXPERIMENTAL)
  11
  12 =head1 SYNOPSIS
  13
  14 Create a table for your tree data.
  15
  16   CREATE TABLE employees (
  17     employee_id INTEGER PRIMARY KEY AUTOINCREMENT,
  18     parent_id INTEGER NOT NULL,
  19     name TEXT NOT NULL
  20   );
  21
  22 In your Schema or DB class add Tree::AdjacencyList to the top
  23 of the component list.
  24
  25   __PACKAGE__->load_components(qw( Tree::AdjacencyList ... ));
  26
  27 Specify the column that contains the parent ID of each row.
  28
  29   package My::Employee;
  30   __PACKAGE__->parent_column('parent_id');
  31
  32 Thats it, now you can modify and analyze the tree.
  33
  34   #!/use/bin/perl
  35   use My::Employee;
  36
  37   my $employee = My::Employee->create({ name=>'Matt S. Trout' });
  38
  39   my $rs = $employee->children();
  40   my @siblings = $employee->children();
  41
  42   my $parent = $employee->parent();
  43   $employee->parent( 7 );
  44
  45 =head1 DESCRIPTION
  46
  47 This module provides methods for working with adjacency lists.  The
  48 adjacency list model is a very common way of representing a tree structure.
  49 In this model each row in a table has a prent ID column that references the
  50 primary key of another row in the same table.  Because of this the primary
  51 key must only be one column and is usually some sort of integer.  The row
  52 with a parent ID of 0 is the root row and is usually the parent of all
  53 other rows.
  54
  55 =head1 METHODS
  56
  57 =head2 parent_column
  58
  59   __PACKAGE__->parent_column('parent_id');
  60
  61 Declares the name of the column that contains the self-referential
  62 ID which defines the parent row.  Defaults to "parent_id".
  63
  64 =cut
  65
  66 __PACKAGE__->mk_classdata( 'parent_column' => 'parent_id' );
  67
  68 =head2 parent
  69
  70   my $parent = $employee->parent();
  71   $employee->parent( $parent_obj );
  72   $employee->parent( $parent_id );
  73
  74 Retrieves the object's parent ID, or sets the object's
  75 parent ID.  If setting the parent ID then 0 will be returned
  76 if the object already has the specified parent, and 1 on
  77 success.
  78
  79 =cut
  80
  81 sub parent {
  82     my( $self, $new_parent ) = @_;
  83     my $parent_column = $self->parent_column();
  84     if ($new_parent) {
  85         if (ref($new_parent)) {
  86             $new_parent = $new_parent->id() || 0;
  87         }
  88         return 0 if ($new_parent == ($self->get_column($parent_column)||0));
  89         $self->set_column( $parent_column => $new_parent );
  90         $self->update();
  91         return 1;
  92     }
  93     else {
  94         return $self->find( $self->get_column( $parent_column ) );
  95     }
  96 }
  97
  98 =head2 children
  99
 100   my $children_rs = $employee->children();
 101   my @children = $employee->children();
 102
 103 Returns a list or record set, depending on context, of all
 104 the objects one level below the current one.
 105
 106 =cut
 107
 108 sub children {
 109     my( $self ) = @_;
 110     my $rs = $self->result_source->resultset->search(
 111         { $self->parent_column()=>$self->id() }
 112     );
 113     return $rs->all() if (wantarray());
 114     return $rs;
 115 }
 116
 117 =head2 attach_child
 118
 119   $parent->attach_child( $child );
 120
 121 Sets (or moves) the child to the new parent.
 122
 123 =cut
 124
 125 sub attach_child {
 126     my( $self, $child ) = @_;
 127     $child->parent( $self );
 128 }
 129
 130 =head2 attach_sibling
 131
 132   $this->attach_sibling( $that );
 133
 134 Sets the passed in object to have the same parent
 135 as the calling object.
 136
 137 =cut
 138
 139 sub attach_sibling {
 140     my( $self, $child ) = @_;
 141     $child->parent( $self->parent() );
 142 }
 143
 144 1;
 145 __END__
 146
 147 =head1 AUTHOR
 148
 149 Aran Clary Deltac <bluefeet@cpan.org>
 150
 151 =head1 LICENSE
 152
 153 You may distribute this code under the same terms as Perl itself.
 154