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
   7 =head1 NAME
   8
   9 DBIx::Class::Tree::AdjacencyList - Manage a tree of data using the common adjacency list model.
  10
  11 =head1 SYNOPSIS
  12
  13 Create a table for your tree data.
  14
  15   CREATE TABLE employees (
  16     employee_id INTEGER PRIMARY KEY AUTOINCREMENT,
  17     parent_id INTEGER NOT NULL,
  18     name TEXT NOT NULL
  19   );
  20
  21 In your Schema or DB class add Tree::AdjacencyList to the top
  22 of the component list.
  23
  24   __PACKAGE__->load_components(qw( Tree::AdjacencyList ... ));
  25   # If you want positionable data make sure this
  26   # module comes first, as in:
  27   __PACKAGE__->load_components(qw( Tree::AdjacencyList Positioned ... ));
  28
  29 Specify the column that contains the parent ID each row.
  30
  31   package My::Employee;
  32   __PACKAGE__->parent_column('parent_id');
  33
  34 Thats it, now you can modify and analyze the tree.
  35
  36   #!/use/bin/perl
  37   use My::Employee;
  38
  39   my $employee = My::Employee->create({ name=>'Matt S. Trout' });
  40
  41   my $rs = $employee->children();
  42   my @siblings = $employee->children();
  43
  44   my $parent = $employee->parent();
  45   $employee->parent( 7 );
  46
  47 =head1 DESCRIPTION
  48
  49 This module provides methods for working with adjacency lists.  The
  50 adjacency list model is a very common way of representing a tree structure.
  51 In this model each row in a table has a prent ID column that references the
  52 primary key of another row in the same table.  Because of this the primary
  53 key must only be one column and is usually some sort of integer.  The row
  54 with a parent ID of 0 is the root row and is usually the parent of all
  55 other rows.
  56
  57 =head1 METHODS
  58
  59 =head2 parent_column
  60
  61   __PACKAGE__->parent_column('parent_id');
  62
  63 Declares the name of the column that contains the self-referential
  64 ID which defines the parent row.  Defaults to "parent_id".
  65
  66 =cut
  67
  68 __PACKAGE__->mk_classdata( 'parent_column' => 'parent_id' );
  69
  70 =head2 parent
  71
  72   my $parent = $employee->parent();
  73   $employee->parent( $parent_obj );
  74   $employee->parent( $parent_id );
  75
  76 Retrieves the object's parent ID, or sets the object's
  77 parent ID.  If setting the parent ID then 0 will be returned
  78 if the object already has the specified parent, and 1 on
  79 success.
  80
  81 If you are using the Positioned component this
  82 module will first move the object to the last position of
  83 the list, change the parent ID, then move the object to the
  84 last position of the new list.  This ensures the intergrity
  85 of the positions.
  86
  87 =cut
  88
  89 sub parent {
  90     my( $self, $new_parent ) = @_;
  91     my $parent_column = $self->parent_column();
  92     if ($new_parent) {
  93         if (ref($new_parent)) {
  94             $new_parent = $new_parent->id();
  95         }
  96         return 0 if ($new_parent == $self->get_column($parent_column));
  97         my $positioned = $self->can('position_column');
  98         $self->move_last if ($positioned);
  99         $self->set_column( $parent_column => $new_parent );
 100         if ($positioned) {
 101             $self->set_column(
 102                 $self->position_column() => $self->search( {$self->_parent_clause()} )->count() + 1
 103             );
 104         }
 105         $self->update();
 106         return 1;
 107     }
 108     else {
 109         return $self->find( $self->get_column( $parent_column ) );
 110     }
 111 }
 112
 113 =head2 children
 114
 115   my $children_rs = $employee->children();
 116   my @children = $employee->children();
 117
 118 Returns a list or record set, depending on context, of all
 119 the objects one level below the current one.
 120
 121 If you are using the Positioned component then this method
 122 will return the children sorted by the position column.
 123
 124 =cut
 125
 126 sub children {
 127     my( $self ) = @_;
 128     my $rs = $self->search(
 129         { $self->parent_column()=>$self->id() },
 130         ( $self->can('position_column') ? {order_by=>$self->position_column()} : () )
 131     );
 132     return $rs->all() if (wantarray());
 133     return $rs;
 134 }
 135
 136 =head2 descendents
 137
 138 Same as children.  Declared so that this module is
 139 compatible with the Tree::NestedSet module.
 140
 141 =cut
 142
 143 #*descendants = \&children;
 144
 145 =head1 PRIVATE METHODS
 146
 147 These methods are used internally.  You should never have the
 148 need to use them.
 149
 150 =head2 _parent_clause
 151
 152 This method is provided as an override of the method in
 153 DBIC::Positioned.  This way Positioned and Tree::AdjacencyList
 154 may be used together without conflict.  Make sure that in
 155 you component list that you load Tree::AdjacencyList before you
 156 load Positioned.
 157
 158 This method assumes a parent ID of 0 if none is defined.  This
 159 usually comes in to play if you are just createing the object
 160 and it has not yet been assigned a parent.
 161
 162 =cut
 163
 164 sub _parent_clause {
 165     my( $self ) = @_;
 166     return (
 167         $self->parent_column() =>
 168         $self->get_column($self->parent_column()) || 0
 169     );
 170 }
 171
 172 1;
 173 __END__
 174
 175 =head1 AUTHOR
 176
 177 Aran Deltac <bluefeet@cpan.org>
 178
 179 =head1 LICENSE
 180
 181 You may distribute this code under the same terms as Perl itself.
 182