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

   1 # vim: ts=8:sw=4:sts=4:et
   2 package DBIx::Class::Tree::AdjacencyList::Ordered;
   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     Ordered
  11 ));
  12
  13 =head1 NAME
  14
  15 DBIx::Class::Tree::AdjacencyList::Ordered - Glue DBIx::Class::Ordered and DBIx::Class::Tree::AdjacencyList together. (EXPERIMENTAL)
  16
  17 =head1 SYNOPSIS
  18
  19 Create a table for your tree data.
  20
  21   CREATE TABLE items (
  22     item_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::Ordered
  29 to the top of the component list.
  30
  31   __PACKAGE__->load_components(qw( Tree::AdjacencyList::Ordered ... ));
  32
  33 Specify the column that contains the parent ID and position of each row.
  34
  35   package My::Employee;
  36   __PACKAGE__->position_column('position');
  37   __PACKAGE__->parent_column('parent_id');
  38
  39 This module provides a few extra methods beyond what
  40 L<DBIx::Class::Ordered> and L<DBIx::Class::Tree::AdjacencyList>
  41 already provide.
  42
  43   my $parent = $item->parent();
  44   $item->parent( $parent_obj );
  45   $item->parent( $parent_id );
  46
  47   my $children_rs = $item->children();
  48   my @children = $item->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 ordered
  59 rows.  All of the methods that L<DBIx::Class::Ordered> and
  60 L<DBIx::Class::Tree::AdjacencyList> provide are available with this module.
  61
  62 =head1 METHODS
  63
  64 =head2 parent_column
  65
  66   __PACKAGE__->parent_column('parent_id');
  67
  68 Works the same as AdjacencyList's parent_column() method, but it
  69 declares the children() has many relationship to be ordered by the
  70 position column.
  71
  72 =cut
  73
  74 sub parent_column {
  75     my $class = shift;
  76     if (@_) {
  77         my $parent_col = shift;
  78         my $primary_col = ($class->primary_columns())[0];
  79         my $position_col = $class->position_column() || croak('You must call position_column() before calling parent_column()');
  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=>$position_col } );
  82         $class->_parent_column( $parent_col );
  83         return 1;
  84     }
  85     return $class->_parent_column();
  86 }
  87
  88 =head2 parent
  89
  90   my $parent = $item->parent();
  91   $item->parent( $parent_obj );
  92   $item->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, thus maintaining the intergrity of
  98 the ordered lists.
  99
 100 =cut
 101
 102 sub 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
 130 This method works just like it does in the
 131 DBIx::Class::Tree::AdjacencyList module except it
 132 orders the children by there position.
 133
 134 =head2 append_child
 135
 136   $parent->append_child( $child );
 137
 138 Sets the child to have the specified parent and moves the
 139 child to the last position.
 140
 141 =cut
 142
 143 sub append_child {
 144     my( $self, $child ) = @_;
 145     $child->parent( $self );
 146 }
 147
 148 =head2 prepend_child
 149
 150   $parent->prepend_child( $child );
 151
 152 Sets the child to have the specified parent and moves the
 153 child to the first position.
 154
 155 =cut
 156
 157 sub 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
 167 Attaches the object at the position just before the
 168 calling object's position.
 169
 170 =cut
 171
 172 sub 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
 182 Attaches the object at the position just after the
 183 calling object's position.
 184
 185 =cut
 186
 187 sub attach_after {
 188     my( $self, $sibling ) = @_;
 189     $sibling->parent( $self->parent() );
 190     $sibling->move_to( $self->get_column($self->position_column()) + 1 );
 191 }
 192
 193 =head1 PRIVATE METHODS
 194
 195 These methods are used internally.  You should never have the
 196 need to use them.
 197
 198 =head2 grouping_column
 199
 200 Postional's grouping_column method does not, and should not, be
 201 defined when using this module.  This method just throws out an
 202 error if you try to use it.
 203
 204 =cut
 205
 206 sub grouping_column {
 207     croak('Use parent_column() instead of grouping_column()');
 208 }
 209
 210 =head2 _grouping_clause
 211
 212 This method is provided as an override of the method in
 213 L<DBIx::Class::Ordered>.  This method is what provides the
 214 glue between AdjacencyList and Ordered.
 215
 216 =cut
 217
 218 sub _grouping_clause {
 219     my( $self ) = @_;
 220     my $col = $self->_parent_column();
 221     return (
 222         $col => $self->get_column( $col )
 223     );
 224 }
 225
 226 1;
 227 __END__
 228
 229 =head1 AUTHOR
 230
 231 Aran Clary Deltac <bluefeet@cpan.org>
 232
 233 =head1 LICENSE
 234
 235 You may distribute this code under the same terms as Perl itself.
 236