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 DEFAULT 0,
  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   __PACKAGE__->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->set_parent( $parent_obj );
  45   $employee->set_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_column
  66
  67   __PACKAGE__->parent_column('parent_id');
  68
  69 Works the same as AdjacencyList's parent_column() method, but it
  70 declares the children() has many relationship to be ordered by the
  71 position column.
  72
  73 =cut
  74
  75 sub parent_column {
  76     my $class = shift;
  77     if (@_) {
  78         my $parent_col = shift;
  79         my $primary_col = ($class->primary_columns())[0];
  80         $class->belongs_to( '_parent' => $class => { "foreign.$primary_col" => "self.$parent_col" } );
  81         $class->has_many( 'children' => $class => { "foreign.$parent_col" => "self.$primary_col" }, { order_by=>$self->position_column() } );
  82         $class->_parent_column( $parent_col );
  83         return 1;
  84     }
  85     return $class->_parent_column();
  86 }
  87
  88 =head2 parent
  89
  90   my $parent = $employee->parent();
  91   $employee->parent( $parent_obj );
  92   $employee->parent( $parent_id );
  93
  94 This method overrides AdjacencyList's parent() method but
  95 modifies it so that the object is moved to the last position,
  96 then the parent is changed, and then it is moved to the last
  97 position of the new list.
  98
  99 =cut
 100
 101 sub parent {
 102     my $self = shift;
 103     if (@_) {
 104         my $new_parent = shift;
 105         my $parent_col = $self->_parent_column();
 106         if (ref($new_parent)) {
 107             $new_parent = $new_parent->id() || croak('Parent object does not have an ID');;
 108         }
 109         return 0 if ($new_parent == ($self->get_column($parent_col)||0));
 110         $self->move_last;
 111         $self->set_column( $parent_col => $new_parent );
 112         $self->set_column(
 113             $self->position_column() =>
 114                 $self->result_source->resultset->search(
 115                     {$self->_collection_clause()}
 116                 )->count() + 1
 117         );
 118         $self->update();
 119         return 1;
 120     }
 121     return $self->_parent();
 122 }
 123
 124 =head2 children
 125
 126   my $children_rs = $employee->children();
 127   my @children = $employee->children();
 128
 129 This method works just like it does in the
 130 DBIx::Class::Tree::AdjacencyList module except it
 131 orders the children by there position.
 132
 133 =head2 append_child
 134
 135   $parent->append_child( $child );
 136
 137 Sets the child to have the specified parent and moves the
 138 child to the last position.
 139
 140 =cut
 141
 142 sub append_child {
 143     my( $self, $child ) = @_;
 144     $child->parent( $self );
 145 }
 146
 147 =head2 prepend_child
 148
 149   $parent->prepend_child( $child );
 150
 151 Sets the child to have the specified parent and moves the
 152 child to the first position.
 153
 154 =cut
 155
 156 sub prepend_child {
 157     my( $self, $child ) = @_;
 158     $child->parent( $self );
 159     $child->move_first();
 160 }
 161
 162 =head2 attach_before
 163
 164   $this->attach_before( $that );
 165
 166 Attaches the object at the position just before the
 167 calling object's position.
 168
 169 =cut
 170
 171 sub attach_before {
 172     my( $self, $sibling ) = @_;
 173     $sibling->parent( $self->parent() );
 174     $sibling->move_to( $self->get_column($self->position_column()) );
 175 }
 176
 177 =head2 attach_after
 178
 179   $this->attach_after( $that );
 180
 181 Attaches the object at the position just after the
 182 calling object's position.
 183
 184 =cut
 185
 186 sub attach_after {
 187     my( $self, $sibling ) = @_;
 188     $sibling->parent( $self->parent() );
 189     $sibling->move_to( $self->get_column($self->position_column()) + 1 );
 190 }
 191
 192 =head1 PRIVATE METHODS
 193
 194 These methods are used internally.  You should never have the
 195 need to use them.
 196
 197 =head2 collection_column
 198
 199 Postional's collection_column method does not, and should not, be
 200 defined when using this module.  This method just throws out an
 201 error if you try to use it.
 202
 203 =cut
 204
 205 sub collection_column {
 206     croak('Use parent_column() instead of collection_column()');
 207 }
 208
 209 =head2 _collection_clause
 210
 211 This method is provided as an override of the method in
 212 L<DBIx::Class::Positional>.  This method is what provides the
 213 glue between AdjacencyList and Positional.
 214
 215 =cut
 216
 217 sub _collection_clause {
 218     my( $self ) = @_;
 219     return (
 220         $self->_parent_column() =>
 221         $self->get_column($self->_parent_column())
 222     );
 223 }
 224
 225 1;
 226 __END__
 227
 228 =head1 AUTHOR
 229
 230 Aran Clary Deltac <bluefeet@cpan.org>
 231
 232 =head1 LICENSE
 233
 234 You may distribute this code under the same terms as Perl itself.
 235