File Coverage

blib/lib/DBICx/MaterializedPath.pm

Criterion	Covered	Total	%
statement	65	69	94.2
branch	6	8	75.0
condition	2	7	28.5
subroutine	13	14	92.8
pod	8	8	100.0
total	94	106	88.6

package DBICx::MaterializedPath;
use warnings;
use strict;
use parent "DBIx::Class";
use Carp;

our $VERSION = "0.03";
our $AUTHORITY = "cpan:ASHLEY";

__PACKAGE__->mk_classdata( parent_column => "parent" );
__PACKAGE__->mk_classdata( path_column => "materialized_path" );
__PACKAGE__->mk_classdata( path_separator => "/" );
__PACKAGE__->mk_classdata( max_depth => 500 );

# Max depth setting? See notes on sanity check inline below.

sub _compute_ancestors :method {
    my ( $self, @ancestors ) = @_;
    my $parent_column = $self->parent_column;
    my $parent = $self->$parent_column;
    return @ancestors unless $parent;
    unshift @ancestors, $parent;
    croak "Circular lineage loop in $self suspected!" if @ancestors > $self->max_depth;
    $parent->_compute_ancestors(@ancestors);
}

sub ancestors :method {
    my $self = shift;
    my ( $pk_name ) = $self->primary_columns;
    my $path_column = $self->path_column;
    my @path = $self->_nodelist;
    pop @path;
    return unless @path;
    $self->result_source
        ->resultset
        ->search({ $pk_name => { -in => \@path } },
                 { order_by => \"LENGTH($path_column)" }); # "
}

sub node_depth :method {
    scalar(+shift->_nodelist);
}

sub _nodelist :method {
    my $self = shift;
    my $path_column = $self->path_column || "";
    my $separator = quotemeta( $self->path_separator );
    split($separator, $self->$path_column || "");
}

sub root_node :method {
    my $self = shift;
    my ( $root_id ) = $self->_nodelist;
    $self->result_source->resultset->find($root_id);
}

# Note caveat, instructions about children method.

# How can order_by get into this mix?
sub grandchildren {
    my $self = shift;

    my $path_separator = $self->path_separator;
    my $path_column    = $self->path_column;
    my $id             = $self->id;

    # Example: 1/2/3
    # to find descendants of 1, use LIKE "1/%"
    # to find descendants of 2, use LIKE "%/2/%"
    my $like_if_root  = "${id}${path_separator}\%";
    my $like_not_root = "\%${path_separator}${id}${path_separator}\%";

    my @grandkids = $self->result_source->resultset->search(
        {
            -or => [
                $path_column => { 'like', $like_if_root  },
                $path_column => { 'like', $like_not_root },
            ]
        },
        {
            order_by => \"LENGTH($path_column)"
        },
    );
    return @grandkids;
}

sub set_materialized_path :method {
    my $self = shift;
    my $parent_column = $self->parent_column;
    my $path_column = $self->path_column;
    my @path_parts = map { $_->id } $self->_compute_ancestors;
    push @path_parts, $self->id;
    my $materialized_path = join( $self->path_separator, @path_parts );
    $self->$path_column( $materialized_path );
    return $materialized_path; # For good measure.
}

sub insert :method {
    my $self = shift;
    $self->next::method(@_);
    $self->set_materialized_path;
    $self->update;
}

sub update :method {
    my $self = shift;
    my %to_update = $self->get_dirty_columns;
    my $parent_column = $self->parent_column;
    $self->next::method(@_);
    return $self unless $to_update{$parent_column};
    # This should be configurable as a transaction I think. 321
    $self->set_materialized_path;
    for my $descendant ( $self->grandchildren )
    {
        $descendant->set_materialized_path;
        $descendant->update;
    }
    return $self;
}

# Previous and next support here.

sub siblings :method {
    my $self = shift;
    my $parent_column = $self->parent_column;
    my $sort = [ $self->_sibling_order || $self->primary_columns ];
    $self->result_source
        ->resultset
        ->search({ $parent_column => $self->$parent_column },
                 { order_by => $sort });
}

1;

__END__