view release on metacpan or  search on metacpan

lib/DBIx/Class/Tree/NestedSet.pm  view on Meta::CPAN

package DBIx::Class::Tree::NestedSet;

use strict;
use warnings;

use Carp qw/croak/;
use base 'DBIx::Class';

our $VERSION = '0.10';
$VERSION = eval $VERSION;

__PACKAGE__->mk_classdata( _tree_columns => {} );

# specify the tree columns and define the relationships
#
sub tree_columns {
    my ($class, $args) = @_;

    if (defined $args) {

        my ($root, $left, $right, $level) = map {
            my $col = $args->{"${_}_column"};
            croak("required param $_ not specified") if !defined $col;
            $col;
        } qw/root left right level/;

        my $table        = $class->table;
        my %join_cond    = ( "foreign.$root" => "self.$root" );

        $class->belongs_to(
            'root' => $class,
            \%join_cond,{
                where    => \"me.$left = 1",                              #"
            },
        );

        $class->belongs_to(
            'parent' => $class,
            \%join_cond,{
                where    => \"child.$left > me.$left AND child.$right < me.$right AND me.$level = child.$level - 1",       #"
                from     => "$table me, $table child",
            },
        );

        $class->has_many(
            'nodes' => $class,
            \%join_cond,{
                order_by        => "me.$left",
                cascade_delete  => 0,
            },
        );

        $class->has_many(
            'descendants' => $class,
            \%join_cond, {
                where           => \"me.$left > parent.$left AND me.$right < parent.$right",     #"
                order_by        =>  "me.$left",
                from            =>  "$table me, $table parent",
                cascade_delete  => 0,
            },
        );

        $class->has_many(
            'children' => $class,
            \%join_cond, {
                where           => \"me.$left > parent.$left AND me.$right < parent.$right AND me.$level = parent.$level + 1",     #"
                order_by        =>  "me.$left",
                from            =>  "$table me, $table parent",
                cascade_delete  => 0,
            },
        );

        $class->has_many(
            'ancestors' => $class,
            \%join_cond, {
                where           => \"child.$left > me.$left AND child.$right < me.$right",       #"
                order_by        =>  "me.$right",
                from            =>  "$table me, $table child",
                cascade_delete  => 0,
            },
        );

        $class->_tree_columns($args);
    }

    return $class->_tree_columns;
}

# Insert a new node.
#
# If the 'right' column is not defined it assumes that we are inserting a root
# node.
#
sub insert {
    my ($self, @args) = @_;

    my ($root, $left, $right, $level) = $self->_get_columns;

    if (!$self->$right) {
        $self->set_columns({
            $left  => 1,
            $right => 2,
            $level => 0,
        });
    }

    my $row;
    my $get_row = $self->next::can;
    $self->result_source->schema->txn_do(sub {
        $row = $get_row->($self, @args);

        # If the root column is not defined, it uses the primary key so long as it is a
        # single column primary key
        if (!defined $row->$root) {
            my @primary_columns = $row->result_source->primary_columns;
            if (scalar @primary_columns > 1) {
                croak('Only single column primary keys are supported for default root selection in nested set tree classes');
            }

            $row->update({
                $root => \"$primary_columns[0]",            #"
            });

            $row->discard_changes;
        }
    });

    return $row;
}

# Delete the current node, and all sub-nodes.
#
sub delete {
    my ($self) = shift;

    my ($root, $left, $right, $level) = $self->_get_columns;

    my $p_lft = $self->$left;
    my $p_rgt = $self->$right;