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() || 0;
  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() => $self->search( {$self->_collection_clause()} )->count() + 1
  93         );
  94         $self->update();
  95         return 1;
  96     }
  97     else {
  98         return $self->next::method();
  99     }
 100 }
 101
 102 =head2 children
 103
 104   my $children_rs = $employee->children();
 105   my @children = $employee->children();
 106
 107 This method works just like it does in the
 108 DBIx::Class::Tree::AdjacencyList module except it
 109 orders the children by there position.
 110
 111 =cut
 112
 113 sub children {
 114     my( $self ) = @_;
 115     my $rs = $self->search(
 116         { $self->parent_column() => $self->id() },
 117         { order_by => $self->position_column() }
 118     );
 119     return $rs->all() if (wantarray());
 120     return $rs;
 121 }
 122
 123 =head2 append_child
 124
 125   $parent->append_child( $child );
 126
 127 Sets the child to have the specified parent and moves the
 128 child to the last position.
 129
 130 =cut
 131
 132 sub append_child {
 133     my( $self, $child ) = @_;
 134     $child->parent( $self );
 135 }
 136
 137 =head2 prepend_child
 138
 139   $parent->prepend_child( $child );
 140
 141 Sets the child to have the specified parent and moves the
 142 child to the first position.
 143
 144 =cut
 145
 146 sub prepend_child {
 147     my( $self, $child ) = @_;
 148     $child->parent( $self );
 149     $child->move_first();
 150 }
 151
 152 =head2 attach_before
 153
 154   $this->attach_before( $that );
 155
 156 Attaches the object at the position just before the
 157 calling object's position.
 158
 159 =cut
 160
 161 sub attach_before {
 162     my( $self, $sibling ) = @_;
 163     $sibling->parent( $self->parent() );
 164     $sibling->move_to( $self->get_column($self->position_column()) );
 165 }
 166
 167 =head2 attach_after
 168
 169   $this->attach_after( $that );
 170
 171 Attaches the object at the position just after the
 172 calling object's position.
 173
 174 =cut
 175
 176 sub attach_after {
 177     my( $self, $sibling ) = @_;
 178     $sibling->parent( $self->parent() );
 179     $sibling->move_to( $self->get_column($self->position_column()) + 1 );
 180 }
 181
 182 =head1 PRIVATE METHODS
 183
 184 These methods are used internally.  You should never have the
 185 need to use them.
 186
 187 =head2 _collection_clause
 188
 189 This method is provided as an override of the method in
 190 L<DBIx::Class::Positional>.  This method is what provides the
 191 glue between AdjacencyList and Positional.
 192
 193 =cut
 194
 195 sub _collection_clause {
 196     my( $self ) = @_;
 197     return (
 198         $self->parent_column() =>
 199         $self->get_column($self->parent_column())
 200     );
 201 }
 202
 203 1;
 204 __END__
 205
 206 =head1 AUTHOR
 207
 208 Aran Clary Deltac <bluefeet@cpan.org>
 209
 210 =head1 LICENSE
 211
 212 You may distribute this code under the same terms as Perl itself.
 213