lib/DBIx/Class/Tree/AdjacencyList/Positional.pm

   1 # vim: ts=8:sw=4:sts=4:et
   2 package DBIx::Class::Tree::AdjacencyList::Positional;
   3 use strict;
   4 use warnings;
   5 use base qw( DBIx::Class );
   6 use Carp qw( croak );
   7
   8 __PACKAGE__->load_components(qw(
   9     Tree::AdjacencyList
  10     Positional
  11 ));
  12
  13 =head1 NAME
  14
  15 DBIx::Class::Tree::AdjacencyList::Positional - Glue DBIx::Class::Positional and DBIx::Class::Tree::AdjacencyList together. (EXPERIMENTAL)
  16
  17 =head1 SYNOPSIS
  18
  19 Create a table for your tree data.
  20
  21   CREATE TABLE employees (
  22     employee_id INTEGER PRIMARY KEY AUTOINCREMENT,
  23     parent_id INTEGER NOT NULL,
  24     position INTEGER NOT NULL,
  25     name TEXT NOT NULL
  26   );
  27
  28 In your Schema or DB class add Tree::AdjacencyList::Positional
  29 to the top of the component list.
  30
  31   __PACKAGE__->load_components(qw( Tree::AdjacencyList::Positional ... ));
  32
  33 Specify the column that contains the parent ID and position of each row.
  34
  35   package My::Employee;
  36   __PACKAGE__->parent_column('parent_id');
  37   __PACAKGE__->position_column('position');
  38
  39 This module provides a few extra methods beyond what
  40 L<DBIx::Class::Positional> and L<DBIx::Class::Tree::AdjacencyList>
  41 already provide.
  42
  43   my $parent = $employee->parent();
  44   $employee->parent( $parent_obj );
  45   $employee->parent( $parent_id );
  46
  47   my $children_rs = $employee->children();
  48   my @children = $employee->children();
  49
  50   $parent->append_child( $child );
  51   $parent->prepend_child( $child );
  52
  53   $this->attach_before( $that );
  54   $this->attach_after( $that );
  55
  56 =head1 DESCRIPTION
  57
  58 This module provides methods for working with adjacency lists and positional
  59 rows.  All of the methods that L<DBIx::Class::Positional> and
  60 L<DBIx::Class::Tree::AdjacencyList> provide are available with this module.
  61 If you
  62
  63 =head1 METHODS
  64
  65 =head2 parent
  66
  67   my $parent = $employee->parent();
  68   $employee->parent( $parent_obj );
  69   $employee->parent( $parent_id );
  70
  71   my $children_rs = $employee->children();
  72   my @children = $employee->children();
  73
  74 This method works exactly like it does in the
  75 DBIx::Class::Tree::AdjacencyList module except that it will
  76 first move the object to the last position of the list, change
  77 the parent ID, then move the object to the last position of
  78 the new list.  This ensures the intergrity of the positions.
  79
  80 =cut
  81
  82 sub parent {
  83     my( $self, $new_parent ) = @_;
  84     if ($new_parent) {
  85         if (ref($new_parent)) {
  86             $new_parent = $new_parent->id() || croak('Parent object does not have an id');
  87         }
  88         return 0 if ($new_parent == ($self->get_column($self->parent_column())||0));
  89         $self->move_last();
  90         return 0 if (!$self->next::method( $new_parent ));
  91         $self->set_column(
  92             $self->position_column() =>
  93                 $self->result_source->resultset->search(
  94                     {$self->_collection_clause()}
  95                 )->count() + 1
  96         );
  97         $self->update();
  98         return 1;
  99     }
 100     else {
 101         return $self->next::method();
 102     }
 103 }
 104
 105 =head2 children
 106
 107   my $children_rs = $employee->children();
 108   my @children = $employee->children();
 109
 110 This method works just like it does in the
 111 DBIx::Class::Tree::AdjacencyList module except it
 112 orders the children by there position.
 113
 114 =cut
 115
 116 sub children {
 117     my( $self ) = @_;
 118     my $rs = $self->result_source->resultset->search(
 119         { $self->parent_column() => $self->id() },
 120         { order_by => $self->position_column() }
 121     );
 122     return $rs->all() if (wantarray());
 123     return $rs;
 124 }
 125
 126 =head2 append_child
 127
 128   $parent->append_child( $child );
 129
 130 Sets the child to have the specified parent and moves the
 131 child to the last position.
 132
 133 =cut
 134
 135 sub append_child {
 136     my( $self, $child ) = @_;
 137     $child->parent( $self );
 138 }
 139
 140 =head2 prepend_child
 141
 142   $parent->prepend_child( $child );
 143
 144 Sets the child to have the specified parent and moves the
 145 child to the first position.
 146
 147 =cut
 148
 149 sub prepend_child {
 150     my( $self, $child ) = @_;
 151     $child->parent( $self );
 152     $child->move_first();
 153 }
 154
 155 =head2 attach_before
 156
 157   $this->attach_before( $that );
 158
 159 Attaches the object at the position just before the
 160 calling object's position.
 161
 162 =cut
 163
 164 sub attach_before {
 165     my( $self, $sibling ) = @_;
 166     $sibling->parent( $self->parent() );
 167     $sibling->move_to( $self->get_column($self->position_column()) );
 168 }
 169
 170 =head2 attach_after
 171
 172   $this->attach_after( $that );
 173
 174 Attaches the object at the position just after the
 175 calling object's position.
 176
 177 =cut
 178
 179 sub attach_after {
 180     my( $self, $sibling ) = @_;
 181     $sibling->parent( $self->parent() );
 182     $sibling->move_to( $self->get_column($self->position_column()) + 1 );
 183 }
 184
 185 =head1 PRIVATE METHODS
 186
 187 These methods are used internally.  You should never have the
 188 need to use them.
 189
 190 =head2 collection_column
 191
 192 Postional's collection_column method does not, and should not, be
 193 defined when using this module.  This method just throws out an
 194 error if you try to use it.
 195
 196 =cut
 197
 198 sub collection_column {
 199     croak('Use parent_column() instead of collection_column()');
 200 }
 201
 202 =head2 _collection_clause
 203
 204 This method is provided as an override of the method in
 205 L<DBIx::Class::Positional>.  This method is what provides the
 206 glue between AdjacencyList and Positional.
 207
 208 =cut
 209
 210 sub _collection_clause {
 211     my( $self ) = @_;
 212     return (
 213         $self->parent_column() =>
 214         $self->get_column($self->parent_column())
 215     );
 216 }
 217
 218 1;
 219 __END__
 220
 221 =head1 AUTHOR
 222
 223 Aran Clary Deltac <bluefeet@cpan.org>
 224
 225 =head1 LICENSE
 226
 227 You may distribute this code under the same terms as Perl itself.
 228