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

   1 package DBIx::Class::Tree::AdjacencyList::Ordered;
   2 # vim: ts=8:sw=4:sts=4:et
   3
   4 use strict;
   5 use warnings;
   6
   7 use base qw( DBIx::Class );
   8 use Carp qw( croak );
   9
  10 __PACKAGE__->load_components(qw(
  11     Ordered
  12     Tree::AdjacencyList
  13 ));
  14
  15 =head1 NAME
  16
  17 DBIx::Class::Tree::AdjacencyList::Ordered - Glue DBIx::Class::Ordered and DBIx::Class::Tree::AdjacencyList together. (EXPERIMENTAL)
  18
  19 =head1 SYNOPSIS
  20
  21 Create a table for your tree data.
  22
  23   CREATE TABLE items (
  24     item_id INTEGER PRIMARY KEY AUTOINCREMENT,
  25     parent_id INTEGER NOT NULL DEFAULT 0,
  26     position INTEGER NOT NULL,
  27     name TEXT NOT NULL
  28   );
  29
  30 In your Schema or DB class add Tree::AdjacencyList::Ordered
  31 to the front of the component list.
  32
  33   __PACKAGE__->load_components(qw( Tree::AdjacencyList::Ordered ... ));
  34
  35 Specify the column that contains the parent ID and position of each row.
  36
  37   package My::Employee;
  38   __PACKAGE__->position_column('position');
  39   __PACKAGE__->parent_column('parent_id');
  40
  41 This module provides a few extra methods beyond what
  42 L<DBIx::Class::Ordered> and L<DBIx::Class::Tree::AdjacencyList>
  43 already provide.
  44
  45   my $parent = $item->parent();
  46   $item->parent( $parent_obj );
  47   $item->parent( $parent_id );
  48
  49   my $children_rs = $item->children();
  50   my @children = $item->children();
  51
  52   $parent->append_child( $child );
  53   $parent->prepend_child( $child );
  54
  55   $this->attach_before( $that );
  56   $this->attach_after( $that );
  57
  58 =head1 DESCRIPTION
  59
  60 This module provides methods for working with adjacency lists and ordered
  61 rows.  All of the methods that L<DBIx::Class::Ordered> and
  62 L<DBIx::Class::Tree::AdjacencyList> provide are available with this module.
  63
  64 =head1 METHODS
  65
  66 =head2 parent_column
  67
  68   __PACKAGE__->parent_column('parent_id');
  69
  70 Works the same as AdjacencyList's parent_column() method, but it
  71 declares the children() has many relationship to be ordered by the
  72 position column.
  73
  74 =cut
  75
  76 sub parent_column {
  77     my $class = shift;
  78     my $position_col = $class->position_column() || croak('You must call position_column() before calling parent_column()');
  79     if (@_) {
  80         $class->grouping_column( @_ );
  81         $class->next::method( @_ );
  82         $class->relationship_info('children')->{attrs}->{order_by} = $position_col;
  83         return 1;
  84     }
  85     return $class->grouping_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 1;
 194 __END__
 195
 196 =head1 INHERITED METHODS
 197
 198 =head2 DBIx::Class::Ordered
 199
 200 =over 4
 201
 202 =item *
 203
 204 L<siblings|DBIx::Class::Ordered/siblings>
 205
 206 =item *
 207
 208 L<first_sibling|DBIx::Class::Ordered/first_sibling>
 209
 210 =item *
 211
 212 L<last_sibling|DBIx::Class::Ordered/last_sibling>
 213
 214 =item *
 215
 216 L<previous_sibling|DBIx::Class::Ordered/previous_sibling>
 217
 218 =item *
 219
 220 L<next_sibling|DBIx::Class::Ordered/next_sibling>
 221
 222 =item *
 223
 224 L<move_previous|DBIx::Class::Ordered/move_previous>
 225
 226 =item *
 227
 228 L<move_next|DBIx::Class::Ordered/move_next>
 229
 230 =item *
 231
 232 L<move_first|DBIx::Class::Ordered/move_first>
 233
 234 =item *
 235
 236 L<move_last|DBIx::Class::Ordered/move_last>
 237
 238 =item *
 239
 240 L<move_to|DBIx::Class::Ordered/move_to>
 241
 242 =item *
 243
 244 L<insert|DBIx::Class::Ordered/insert>
 245
 246 =item *
 247
 248 L<delete|DBIx::Class::Ordered/delete>
 249
 250 =back
 251
 252 =head2 DBIx::Class::Tree::AdjacencyList
 253
 254 =over 4
 255
 256 =item *
 257
 258 L<parent_column|DBIx::Class::Tree::AdjacencyList/parent_column>
 259
 260 =item *
 261
 262 L<parent|DBIx::Class::Tree::AdjacencyList/parent>
 263
 264 =item *
 265
 266 L<attach_child|DBIx::Class::Tree::AdjacencyList/attach_child>
 267
 268 =item *
 269
 270 L<siblings|DBIx::Class::Tree::AdjacencyList/siblings>
 271
 272 =item *
 273
 274 L<attach_sibling|DBIx::Class::Tree::AdjacencyList/attach_sibling>
 275
 276 =back
 277
 278 =head2 DBIx::Class
 279
 280 =over 4
 281
 282 =item *
 283
 284 L<mk_classdata|DBIx::Class/mk_classdata>
 285
 286 =item *
 287
 288 L<component_base_class|DBIx::Class/component_base_class>
 289
 290 =back
 291
 292 =head2 DBIx::Class::Componentised
 293
 294 =over 4
 295
 296 =item *
 297
 298 L<inject_base|DBIx::Class::Componentised/inject_base>
 299
 300 =item *
 301
 302 L<load_components|DBIx::Class::Componentised/load_components>
 303
 304 =item *
 305
 306 L<load_own_components|DBIx::Class::Componentised/load_own_components>
 307
 308 =back
 309
 310 =head2 Class::Data::Accessor
 311
 312 =over 4
 313
 314 =item *
 315
 316 L<mk_classaccessor|Class::Data::Accessor/mk_classaccessor>
 317
 318 =back
 319
 320 =head1 AUTHOR
 321
 322 Aran Clary Deltac <bluefeet@cpan.org>
 323
 324 =head1 LICENSE
 325
 326 You may distribute this code under the same terms as Perl itself.
 327