is_* methods and primary key validation
[dbsrgits/DBIx-Class-Tree.git] / lib / DBIx / Class / Tree / AdjacencyList.pm
CommitLineData
87427fdb 1package DBIx::Class::Tree::AdjacencyList;
bb17efa0 2# vim: ts=8:sw=4:sts=4:et
3
87427fdb 4use strict;
5use warnings;
bb17efa0 6
87427fdb 7use base qw( DBIx::Class );
8use Carp qw( croak );
9
10=head1 NAME
11
12DBIx::Class::Tree::AdjacencyList - Manage a tree of data using the common adjacency list model. (EXPERIMENTAL)
13
14=head1 SYNOPSIS
15
16Create a table for your tree data.
17
18 CREATE TABLE employees (
19 employee_id INTEGER PRIMARY KEY AUTOINCREMENT,
82958127 20 parent_id INTEGER NOT NULL DEFAULT 0,
87427fdb 21 name TEXT NOT NULL
22 );
23
24In your Schema or DB class add Tree::AdjacencyList to the top
25of the component list.
26
27 __PACKAGE__->load_components(qw( Tree::AdjacencyList ... ));
87427fdb 28
57f04bd5 29Specify the column that contains the parent ID of each row.
87427fdb 30
31 package My::Employee;
32 __PACKAGE__->parent_column('parent_id');
33
34Thats it, now you can modify and analyze the tree.
35
82958127 36 #!/usr/bin/perl
87427fdb 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
49This module provides methods for working with adjacency lists. The
50adjacency list model is a very common way of representing a tree structure.
51In this model each row in a table has a prent ID column that references the
52primary key of another row in the same table. Because of this the primary
53key must only be one column and is usually some sort of integer. The row
9717d3ca 54with a parent ID of 0 is the root node and is usually the parent of all
55other rows. Although, there is no limitation in this module that would
56stop you from having multiple root nodes.
87427fdb 57
58=head1 METHODS
59
60=head2 parent_column
61
62 __PACKAGE__->parent_column('parent_id');
63
64Declares the name of the column that contains the self-referential
82958127 65ID which defines the parent row. Defaults to "parent_id". This
66will create a has_many (children) and belongs_to (parent)
67relationship.
87427fdb 68
bb17efa0 69This method also setups an additional has_many relationship called
70parents which is useful when you want to treat an adjacency list
71as a DAG.
72
87427fdb 73=cut
74
82958127 75__PACKAGE__->mk_classdata( '_parent_column' => 'parent_id' );
76
77sub parent_column {
78 my $class = shift;
79 if (@_) {
80 my $parent_col = shift;
81 my $primary_col = ($class->primary_columns())[0];
82 $class->belongs_to( '_parent' => $class => { "foreign.$primary_col" => "self.$parent_col" } );
83 $class->has_many( 'children' => $class => { "foreign.$parent_col" => "self.$primary_col" } );
bb17efa0 84 $class->has_many( 'parents' => $class => { "foreign.$primary_col" => "self.$parent_col" } );
82958127 85 $class->_parent_column( $parent_col );
86 return 1;
87 }
88 return $class->_parent_column();
89}
87427fdb 90
91=head2 parent
92
93 my $parent = $employee->parent();
94 $employee->parent( $parent_obj );
95 $employee->parent( $parent_id );
96
82958127 97Retrieves the object's parent object, or changes the object's
9717d3ca 98parent to the specified parent or parent ID. If you would like
99to make the object the root node, just set the parent to 0.
100
101If you are setting the parent then 0 will be returned if the
102specified parent is already the object's parent and 1 on
103success.
87427fdb 104
87427fdb 105=cut
106
107sub parent {
82958127 108 my $self = shift;
109 if (@_) {
110 my $new_parent = shift;
111 my $parent_col = $self->_parent_column();
87427fdb 112 if (ref($new_parent)) {
82958127 113 $new_parent = $new_parent->id() || croak('Parent object does not have an ID');;
87427fdb 114 }
82958127 115 return 0 if ($new_parent == ($self->get_column($parent_col)||0));
116 $self->set_column( $parent_col => $new_parent );
87427fdb 117 $self->update();
118 return 1;
119 }
82958127 120 return $self->_parent();
87427fdb 121}
122
bb17efa0 123=head2 parents
124
125 my $parents = $node->parents();
126 my @parents = $node->parents();
127
128This has_many relationship is not that useful as it will
129never return more than one parent due to the one-to-many
130structure of adjacency lists. The reason this relationship
131is defined is so that this tree type may be treated as if
132it was a DAG.
133
87427fdb 134=head2 children
135
136 my $children_rs = $employee->children();
137 my @children = $employee->children();
138
139Returns a list or record set, depending on context, of all
82958127 140the objects one level below the current one. This method
141is created when parent_column() is called, which sets up a
142has_many relationship called children.
87427fdb 143
144=head2 attach_child
145
146 $parent->attach_child( $child );
9717d3ca 147 $parent->attach_child( $child, $child, ... );
87427fdb 148
9717d3ca 149Sets the child, or children, to the new parent. Returns 1
150on success and returns 0 if the parent object already has
151the child.
87427fdb 152
153=cut
154
155sub attach_child {
9717d3ca 156 my $self = shift;
157 my $return = 1;
158 foreach my $child (@_) {
159 $child->parent( $self );
160 }
161 return $return;
87427fdb 162}
163
82958127 164=head2 siblings
165
166 my $rs = $node->siblings();
167 my @siblings = $node->siblings();
168
169Returns either a result set or an array of all other objects
170with the same parent as the calling object.
171
172=cut
173
174sub siblings {
175 my( $self ) = @_;
176 my $parent_col = $self->_parent_column;
177 my $primary_col = ($self->primary_columns())[0];
178 my $rs = $self->result_source->resultset->search(
179 {
180 $parent_col => $self->get_column($parent_col),
181 $primary_col => { '!=' => $self->get_column($primary_col) },
182 },
183 );
184 return $rs->all() if (wantarray());
185 return $rs;
186}
187
188=cut
189
87427fdb 190=head2 attach_sibling
191
9717d3ca 192 $obj->attach_sibling( $sibling );
193 $obj->attach_sibling( $sibling, $sibling, ... );
87427fdb 194
9717d3ca 195Sets the passed in object(s) to have the same parent
196as the calling object. Returns 1 on success and
1970 if the sibling already has the same parent.
87427fdb 198
199=cut
200
201sub attach_sibling {
9717d3ca 202 my $self = shift;
203 my $return = 1;
204 foreach my $node (@_) {
205 $return = 0 if (!$node->parent( $self->parent() ));
206 }
207 return $return;
87427fdb 208}
209
74d97bdc 210=head2 is_leaf
211
212 if ($obj->is_leaf()) { ... }
213
214Returns 1 if the object has no children, and 0 otherwise.
215
216=cut
217
218sub is_leaf {
219 my( $self ) = @_;
220 return $self->result_source->resultset->search(
221 { $self->_parent_column => $self->id() },
222 { limit => 1 }
223 )->count();
224}
225
226=head2 is_root
227
228 if ($obj->is_root()) { ... }
229
230Returns 1 if the object has no parent, and 0 otherwise.
231
232=cut
233
234sub is_root {
235 my( $self ) = @_;
236 return ( $self->get_column( $self->_parent_column ) ? 1 : 0 );
237}
238
239=head2 is_branch
240
241 if ($obj->is_branch()) { ... }
242
243Returns 1 if the object has a parent and has children.
244Returns 0 otherwise.
245
246=cut
247
248sub is_branch {
249 my( $self ) = @_;
250 return ( ($self->is_leaf() or $self->is_root()) ? 0 : 1 );
251}
252
253=head2 set_primary_key
254
255This method is an override of DBIx::Class' method for setting the
256class' primary key column(s). This method passes control right on
257to the normal method after first validating that only one column is
258being selected as a primary key. If more than one column is then
259an error will be thrown.
260
261=cut
262
263sub set_primary_ley {
264 my $self = shift;
265 if (@_>1) {
266 croak('You may only specify a single column as the primary key for adjacency tree classes');
267 }
268 return $self->next::method( @_ );
269}
270
87427fdb 2711;
272__END__
273
4b44af23 274=head1 INHERITED METHODS
275
276=head2 DBIx::Class
277
278=over 4
279
280=item *
281
282L<mk_classdata|DBIx::Class/mk_classdata>
283
284=item *
285
286L<component_base_class|DBIx::Class/component_base_class>
287
288=back
289
290=head2 DBIx::Class::Componentised
291
292=over 4
293
294=item *
295
296L<inject_base|DBIx::Class::Componentised/inject_base>
297
298=item *
299
300L<load_components|DBIx::Class::Componentised/load_components>
301
302=item *
303
304L<load_own_components|DBIx::Class::Componentised/load_own_components>
305
306=back
307
308=head2 Class::Data::Accessor
309
310=over 4
311
312=item *
313
314L<mk_classaccessor|Class::Data::Accessor/mk_classaccessor>
315
316=back
317
87427fdb 318=head1 AUTHOR
319
320Aran Clary Deltac <bluefeet@cpan.org>
321
322=head1 LICENSE
323
324You may distribute this code under the same terms as Perl itself.
325