1package DBIx::Class::Tree::AdjacencyList::Ordered;
2# vim: ts=8:sw=4:sts=4:et
3
4use strict;
5use warnings;
6
7use base qw( DBIx::Class );
8use Carp qw( croak );
9
10__PACKAGE__->load_components(qw(
11    Ordered
12    Tree::AdjacencyList
13));
14
15=head1 NAME
16
17DBIx::Class::Tree::AdjacencyList::Ordered - Glue DBIx::Class::Ordered and DBIx::Class::Tree::AdjacencyList together.
18
19=head1 SYNOPSIS
20
21Create a table for your tree data.
22
23  CREATE TABLE items (
24    item_id INTEGER PRIMARY KEY AUTOINCREMENT,
25    parent_id INTEGER NOT NULL DEFAULT 0,
26    position INTEGER NOT NULL,
27    name TEXT NOT NULL
28  );
29
30In your Schema or DB class add Tree::AdjacencyList::Ordered
31to the front of the component list.
32
33  __PACKAGE__->load_components(qw( Tree::AdjacencyList::Ordered ... ));
34
35Specify the column that contains the parent ID and position of each row.
36
37  package My::Employee;
38  __PACKAGE__->position_column('position');
39  __PACKAGE__->parent_column('parent_id');
40
41This module provides a few extra methods beyond what
42L<DBIx::Class::Ordered> and L<DBIx::Class::Tree::AdjacencyList>
43already provide.
44
45  my $parent = $item->parent();
46  $item->parent( $parent_obj );
47  $item->parent( $parent_id );
48
49  my $children_rs = $item->children();
50  my @children = $item->children();
51
52  $parent->append_child( $child );
53  $parent->prepend_child( $child );
54
55  $this->attach_before( $that );
56  $this->attach_after( $that );
57
58=head1 DESCRIPTION
59
60This module provides methods for working with adjacency lists and ordered
61rows.  All of the methods that L<DBIx::Class::Ordered> and
62L<DBIx::Class::Tree::AdjacencyList> provide are available with this module.
63
64=head1 METHODS
65
66=head2 parent_column
67
68  __PACKAGE__->parent_column('parent_id');
69
70Works the same as AdjacencyList's parent_column() method, but it
71declares the children() has many relationship to be ordered by the
72position column.
73
74=cut
75
76sub parent_column {
77    my $class = shift;
78    my $position_col = $class->position_column() || croak('You must call position_column() before calling parent_column()');
79    if (@_) {
80        $class->grouping_column( @_ );
81        $class->next::method( @_ );
82        $class->relationship_info('children')->{attrs}->{order_by} = $position_col;
83        return 1;
84    }
85    return $class->grouping_column;
86}
87
88=head2 parent
89
90  my $parent = $item->parent();
91  $item->parent( $parent_obj );
92  $item->parent( $parent_id );
93
94This method overrides AdjacencyList's parent() method but
95modifies it so that the object is moved to the last position,
96then the parent is changed, and then it is moved to the last
97position of the new list, thus maintaining the intergrity of
98the ordered lists.
99
100=cut
101
102sub parent {
103    my $self = shift;
104    if (@_) {
105        my $new_parent = shift;
106        my $parent_col = $self->_parent_column();
107        if (ref($new_parent)) {
108            $new_parent = $new_parent->id() || croak('Parent object does not have an ID');;
109        }
110        return 0 if ($new_parent == ($self->get_column($parent_col)||0));
111        $self->move_last;
112        $self->set_column( $parent_col => $new_parent );
113        $self->set_column(
114            $self->position_column() =>
115                $self->result_source->resultset->search(
116                    {$self->_grouping_clause()}
117                )->count() + 1
118        );
119        $self->update();
120        return 1;
121    }
122    return $self->_parent();
123}
124
125=head2 children
126
127  my $children_rs = $item->children();
128  my @children = $item->children();
129
130This method works just like it does in the
131DBIx::Class::Tree::AdjacencyList module except it
132orders the children by there position.
133
134=head2 append_child
135
136  $parent->append_child( $child );
137
138Sets the child to have the specified parent and moves the
139child to the last position.
140
141=cut
142
143sub append_child {
144    my( $self, $child ) = @_;
145    $child->parent( $self );
146}
147
148=head2 prepend_child
149
150  $parent->prepend_child( $child );
151
152Sets the child to have the specified parent and moves the
153child to the first position.
154
155=cut
156
157sub prepend_child {
158    my( $self, $child ) = @_;
159    $child->parent( $self );
160    $child->move_first();
161}
162
163=head2 attach_before
164
165  $this->attach_before( $that );
166
167Attaches the object at the position just before the
168calling object's position.
169
170=cut
171
172sub attach_before {
173    my( $self, $sibling ) = @_;
174    $sibling->parent( $self->parent() );
175    $sibling->move_to( $self->get_column($self->position_column()) );
176}
177
178=head2 attach_after
179
180  $this->attach_after( $that );
181
182Attaches the object at the position just after the
183calling object's position.
184
185=cut
186
187sub attach_after {
188    my( $self, $sibling ) = @_;
189    $sibling->parent( $self->parent() );
190    $sibling->move_to( $self->get_column($self->position_column()) + 1 );
191}
192
1931;
194__END__
195
196=head1 INHERITED METHODS
197
198=head2 DBIx::Class::Ordered
199
200=over 4
201
202=item *
203
204L<siblings|DBIx::Class::Ordered/siblings>
205
206=item *
207
208L<first_sibling|DBIx::Class::Ordered/first_sibling>
209
210=item *
211
212L<last_sibling|DBIx::Class::Ordered/last_sibling>
213
214=item *
215
216L<previous_sibling|DBIx::Class::Ordered/previous_sibling>
217
218=item *
219
220L<next_sibling|DBIx::Class::Ordered/next_sibling>
221
222=item *
223
224L<move_previous|DBIx::Class::Ordered/move_previous>
225
226=item *
227
228L<move_next|DBIx::Class::Ordered/move_next>
229
230=item *
231
232L<move_first|DBIx::Class::Ordered/move_first>
233
234=item *
235
236L<move_last|DBIx::Class::Ordered/move_last>
237
238=item *
239
240L<move_to|DBIx::Class::Ordered/move_to>
241
242=item *
243
244L<insert|DBIx::Class::Ordered/insert>
245
246=item *
247
248L<delete|DBIx::Class::Ordered/delete>
249
250=back
251
252=head2 DBIx::Class::Tree::AdjacencyList
253
254=over 4
255
256=item *
257
258L<parent_column|DBIx::Class::Tree::AdjacencyList/parent_column>
259
260=item *
261
262L<parent|DBIx::Class::Tree::AdjacencyList/parent>
263
264=item *
265
266L<attach_child|DBIx::Class::Tree::AdjacencyList/attach_child>
267
268=item *
269
270L<siblings|DBIx::Class::Tree::AdjacencyList/siblings>
271
272=item *
273
274L<attach_sibling|DBIx::Class::Tree::AdjacencyList/attach_sibling>
275
276=back
277
278=head2 DBIx::Class
279
280=over 4
281
282=item *
283
284L<mk_classdata|DBIx::Class/mk_classdata>
285
286=item *
287
288L<component_base_class|DBIx::Class/component_base_class>
289
290=back
291
292=head2 DBIx::Class::Componentised
293
294=over 4
295
296=item *
297
298L<inject_base|DBIx::Class::Componentised/inject_base>
299
300=item *
301
302L<load_components|DBIx::Class::Componentised/load_components>
303
304=item *
305
306L<load_own_components|DBIx::Class::Componentised/load_own_components>
307
308=back
309
310=head2 Class::Data::Accessor
311
312=over 4
313
314=item *
315
316L<mk_classaccessor|Class::Data::Accessor/mk_classaccessor>
317
318=back
319
320=head1 AUTHOR
321
322Aran Clary Deltac <bluefeet@cpan.org>
323
324=head1 LICENSE
325
326You may distribute this code under the same terms as Perl itself.
327
328