CREATE TABLE employees (
employee_id INTEGER PRIMARY KEY AUTOINCREMENT,
- parent_id INTEGER NOT NULL,
+ parent_id INTEGER NOT NULL DEFAULT 0,
name TEXT NOT NULL
);
Thats it, now you can modify and analyze the tree.
- #!/use/bin/perl
+ #!/usr/bin/perl
use My::Employee;
my $employee = My::Employee->create({ name=>'Matt S. Trout' });
In this model each row in a table has a prent ID column that references the
primary key of another row in the same table. Because of this the primary
key must only be one column and is usually some sort of integer. The row
-with a parent ID of 0 is the root row and is usually the parent of all
-other rows.
+with a parent ID of 0 is the root node and is usually the parent of all
+other rows. Although, there is no limitation in this module that would
+stop you from having multiple root nodes.
=head1 METHODS
__PACKAGE__->parent_column('parent_id');
Declares the name of the column that contains the self-referential
-ID which defines the parent row. Defaults to "parent_id".
+ID which defines the parent row. Defaults to "parent_id". This
+will create a has_many (children) and belongs_to (parent)
+relationship.
=cut
-__PACKAGE__->mk_classdata( 'parent_column' => 'parent_id' );
+__PACKAGE__->mk_classdata( '_parent_column' => 'parent_id' );
+
+sub parent_column {
+ my $class = shift;
+ if (@_) {
+ my $parent_col = shift;
+ my $primary_col = ($class->primary_columns())[0];
+ $class->belongs_to( '_parent' => $class => { "foreign.$primary_col" => "self.$parent_col" } );
+ $class->has_many( 'children' => $class => { "foreign.$parent_col" => "self.$primary_col" } );
+ $class->_parent_column( $parent_col );
+ return 1;
+ }
+ return $class->_parent_column();
+}
=head2 parent
$employee->parent( $parent_obj );
$employee->parent( $parent_id );
-Retrieves the object's parent ID, or sets the object's
-parent ID. If setting the parent ID then 0 will be returned
-if the object already has the specified parent, and 1 on
+Retrieves the object's parent object, or changes the object's
+parent to the specified parent or parent ID. If you would like
+to make the object the root node, just set the parent to 0.
+
+If you are setting the parent then 0 will be returned if the
+specified parent is already the object's parent and 1 on
success.
=cut
sub parent {
- my( $self, $new_parent ) = @_;
- my $parent_column = $self->parent_column();
- if ($new_parent) {
+ my $self = shift;
+ if (@_) {
+ my $new_parent = shift;
+ my $parent_col = $self->_parent_column();
if (ref($new_parent)) {
- $new_parent = $new_parent->id() || 0;
+ $new_parent = $new_parent->id() || croak('Parent object does not have an ID');;
}
- return 0 if ($new_parent == ($self->get_column($parent_column)||0));
- $self->set_column( $parent_column => $new_parent );
+ return 0 if ($new_parent == ($self->get_column($parent_col)||0));
+ $self->set_column( $parent_col => $new_parent );
$self->update();
return 1;
}
- else {
- return $self->find( $self->get_column( $parent_column ) );
- }
+ return $self->_parent();
}
=head2 children
my @children = $employee->children();
Returns a list or record set, depending on context, of all
-the objects one level below the current one.
+the objects one level below the current one. This method
+is created when parent_column() is called, which sets up a
+has_many relationship called children.
+
+=head2 attach_child
+
+ $parent->attach_child( $child );
+ $parent->attach_child( $child, $child, ... );
+
+Sets the child, or children, to the new parent. Returns 1
+on success and returns 0 if the parent object already has
+the child.
=cut
-sub children {
- my( $self ) = @_;
- my $rs = $self->result_source->resultset->search(
- { $self->parent_column()=>$self->id() }
- );
- return $rs->all() if (wantarray());
- return $rs;
+sub attach_child {
+ my $self = shift;
+ my $return = 1;
+ foreach my $child (@_) {
+ $child->parent( $self );
+ }
+ return $return;
}
-=head2 attach_child
+=head2 siblings
- $parent->attach_child( $child );
+ my $rs = $node->siblings();
+ my @siblings = $node->siblings();
-Sets (or moves) the child to the new parent.
+Returns either a result set or an array of all other objects
+with the same parent as the calling object.
=cut
-sub attach_child {
- my( $self, $child ) = @_;
- $child->parent( $self );
+sub siblings {
+ my( $self ) = @_;
+ my $parent_col = $self->_parent_column;
+ my $primary_col = ($self->primary_columns())[0];
+ my $rs = $self->result_source->resultset->search(
+ {
+ $parent_col => $self->get_column($parent_col),
+ $primary_col => { '!=' => $self->get_column($primary_col) },
+ },
+ );
+ return $rs->all() if (wantarray());
+ return $rs;
}
+=cut
+
=head2 attach_sibling
- $this->attach_sibling( $that );
+ $obj->attach_sibling( $sibling );
+ $obj->attach_sibling( $sibling, $sibling, ... );
-Sets the passed in object to have the same parent
-as the calling object.
+Sets the passed in object(s) to have the same parent
+as the calling object. Returns 1 on success and
+0 if the sibling already has the same parent.
=cut
sub attach_sibling {
- my( $self, $child ) = @_;
- $child->parent( $self->parent() );
+ my $self = shift;
+ my $return = 1;
+ foreach my $node (@_) {
+ $return = 0 if (!$node->parent( $self->parent() ));
+ }
+ return $return;
}
1;
__END__
+=head1 INHERITED METHODS
+
+=head2 DBIx::Class
+
+=over 4
+
+=item *
+
+L<mk_classdata|DBIx::Class/mk_classdata>
+
+=item *
+
+L<component_base_class|DBIx::Class/component_base_class>
+
+=back
+
+=head2 DBIx::Class::Componentised
+
+=over 4
+
+=item *
+
+L<inject_base|DBIx::Class::Componentised/inject_base>
+
+=item *
+
+L<load_components|DBIx::Class::Componentised/load_components>
+
+=item *
+
+L<load_own_components|DBIx::Class::Componentised/load_own_components>
+
+=back
+
+=head2 Class::Data::Accessor
+
+=over 4
+
+=item *
+
+L<mk_classaccessor|Class::Data::Accessor/mk_classaccessor>
+
+=back
+
=head1 AUTHOR
Aran Clary Deltac <bluefeet@cpan.org>
projects / dbsrgits/DBIx-Class-Tree.git / blobdiff