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     Ordered
  10     Tree::AdjacencyList
  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 front 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     my $position_col = $class->position_column() || croak('You must call position_column() before calling parent_column()');
  77     if (@_) {
  78         $class->grouping_column( @_ );
  79         $class->next::method( @_ );
  80         $class->relationship_info('children')->{attrs}->{order_by} = $position_col;
  81         return 1;
  82     }
  83     return $class->grouping_column;
  84 }
  85
  86 =head2 parent
  87
  88   my $parent = $item->parent();
  89   $item->parent( $parent_obj );
  90   $item->parent( $parent_id );
  91
  92 This method overrides AdjacencyList's parent() method but
  93 modifies it so that the object is moved to the last position,
  94 then the parent is changed, and then it is moved to the last
  95 position of the new list, thus maintaining the intergrity of
  96 the ordered lists.
  97
  98 =cut
  99
 100 sub parent {
 101     my $self = shift;
 102     if (@_) {
 103         my $new_parent = shift;
 104         my $parent_col = $self->_parent_column();
 105         if (ref($new_parent)) {
 106             $new_parent = $new_parent->id() || croak('Parent object does not have an ID');;
 107         }
 108         return 0 if ($new_parent == ($self->get_column($parent_col)||0));
 109         $self->move_last;
 110         $self->set_column( $parent_col => $new_parent );
 111         $self->set_column(
 112             $self->position_column() =>
 113                 $self->result_source->resultset->search(
 114                     {$self->_grouping_clause()}
 115                 )->count() + 1
 116         );
 117         $self->update();
 118         return 1;
 119     }
 120     return $self->_parent();
 121 }
 122
 123 =head2 children
 124
 125   my $children_rs = $item->children();
 126   my @children = $item->children();
 127
 128 This method works just like it does in the
 129 DBIx::Class::Tree::AdjacencyList module except it
 130 orders the children by there position.
 131
 132 =head2 append_child
 133
 134   $parent->append_child( $child );
 135
 136 Sets the child to have the specified parent and moves the
 137 child to the last position.
 138
 139 =cut
 140
 141 sub append_child {
 142     my( $self, $child ) = @_;
 143     $child->parent( $self );
 144 }
 145
 146 =head2 prepend_child
 147
 148   $parent->prepend_child( $child );
 149
 150 Sets the child to have the specified parent and moves the
 151 child to the first position.
 152
 153 =cut
 154
 155 sub prepend_child {
 156     my( $self, $child ) = @_;
 157     $child->parent( $self );
 158     $child->move_first();
 159 }
 160
 161 =head2 attach_before
 162
 163   $this->attach_before( $that );
 164
 165 Attaches the object at the position just before the
 166 calling object's position.
 167
 168 =cut
 169
 170 sub attach_before {
 171     my( $self, $sibling ) = @_;
 172     $sibling->parent( $self->parent() );
 173     $sibling->move_to( $self->get_column($self->position_column()) );
 174 }
 175
 176 =head2 attach_after
 177
 178   $this->attach_after( $that );
 179
 180 Attaches the object at the position just after the
 181 calling object's position.
 182
 183 =cut
 184
 185 sub attach_after {
 186     my( $self, $sibling ) = @_;
 187     $sibling->parent( $self->parent() );
 188     $sibling->move_to( $self->get_column($self->position_column()) + 1 );
 189 }
 190
 191 1;
 192 __END__
 193
 194 =head1 INHERITED METHODS
 195
 196 =head2 DBIx::Class::Ordered
 197
 198 =over 4
 199
 200 =item *
 201
 202 L<siblings|DBIx::Class::Ordered/siblings>
 203
 204 =item *
 205
 206 L<first_sibling|DBIx::Class::Ordered/first_sibling>
 207
 208 =item *
 209
 210 L<last_sibling|DBIx::Class::Ordered/last_sibling>
 211
 212 =item *
 213
 214 L<previous_sibling|DBIx::Class::Ordered/previous_sibling>
 215
 216 =item *
 217
 218 L<next_sibling|DBIx::Class::Ordered/next_sibling>
 219
 220 =item *
 221
 222 L<move_previous|DBIx::Class::Ordered/move_previous>
 223
 224 =item *
 225
 226 L<move_next|DBIx::Class::Ordered/move_next>
 227
 228 =item *
 229
 230 L<move_first|DBIx::Class::Ordered/move_first>
 231
 232 =item *
 233
 234 L<move_last|DBIx::Class::Ordered/move_last>
 235
 236 =item *
 237
 238 L<move_to|DBIx::Class::Ordered/move_to>
 239
 240 =item *
 241
 242 L<insert|DBIx::Class::Ordered/insert>
 243
 244 =item *
 245
 246 L<delete|DBIx::Class::Ordered/delete>
 247
 248 =back
 249
 250 =head2 DBIx::Class::Tree::AdjacencyList
 251
 252 =over 4
 253
 254 =item *
 255
 256 L<parent_column|DBIx::Class::Tree::AdjacencyList/parent_column>
 257
 258 =item *
 259
 260 L<parent|DBIx::Class::Tree::AdjacencyList/parent>
 261
 262 =item *
 263
 264 L<attach_child|DBIx::Class::Tree::AdjacencyList/attach_child>
 265
 266 =item *
 267
 268 L<siblings|DBIx::Class::Tree::AdjacencyList/siblings>
 269
 270 =item *
 271
 272 L<attach_sibling|DBIx::Class::Tree::AdjacencyList/attach_sibling>
 273
 274 =back
 275
 276 =head2 DBIx::Class
 277
 278 =over 4
 279
 280 =item *
 281
 282 L<mk_classdata|DBIx::Class/mk_classdata>
 283
 284 =item *
 285
 286 L<component_base_class|DBIx::Class/component_base_class>
 287
 288 =back
 289
 290 =head2 DBIx::Class::Componentised
 291
 292 =over 4
 293
 294 =item *
 295
 296 L<inject_base|DBIx::Class::Componentised/inject_base>
 297
 298 =item *
 299
 300 L<load_components|DBIx::Class::Componentised/load_components>
 301
 302 =item *
 303
 304 L<load_own_components|DBIx::Class::Componentised/load_own_components>
 305
 306 =back
 307
 308 =head2 Class::Data::Accessor
 309
 310 =over 4
 311
 312 =item *
 313
 314 L<mk_classaccessor|Class::Data::Accessor/mk_classaccessor>
 315
 316 =back
 317
 318 =head1 AUTHOR
 319
 320 Aran Clary Deltac <bluefeet@cpan.org>
 321
 322 =head1 LICENSE
 323
 324 You may distribute this code under the same terms as Perl itself.
 325