File Coverage

blib/lib/Tree/Persist/DB/SelfReferential.pm

Criterion	Covered	Total	%
statement	101	101	100.0
branch	15	16	93.7
condition			n/a
subroutine	10	10	100.0
pod			n/a
total	126	127	99.2

package Tree::Persist::DB::SelfReferential;

use strict;
use warnings;

use base qw( Tree::Persist::DB );

use Module::Runtime;

use Scalar::Util qw( blessed refaddr );

our $VERSION = '1.12';

my(%defaults) =
(
	id_col        => 'id',
	parent_id_col => 'parent_id',
	value_col     => 'value',
#	class_col     => 'class',
);

# ----------------------------------------------

sub _init
{
	my($class)   = shift;
	my($opts)    = @_;
	my($self)    = $class -> SUPER::_init( $opts );
	$self->{_id} = $opts->{id};

	while ( my ($name, $val) = each %defaults )
	{
		$self->{ "_${name}" } = $opts->{ $name } ? $opts->{ $name } : $val;
	}

	if ( exists $opts->{class_col} )
	{
		$self->{_class_col} = $opts->{class_col};
	}

	return $self;

} # End of _init.

# ----------------------------------------------

sub _reload
{
	my($self) = shift;
	my(%sql)  = $self->_build_sql;
	my($sth)  = $self->{_dbh} -> prepare( $sql{ fetch } );

	$sth -> execute( $self->{_id} );

	my ($id, $parent_id, $value, $class) = $sth -> fetchrow_array();

	$sth -> finish;

	my($tree)     = Module::Runtime::use_module($class) -> new( $value );
	my($ref_addr) = refaddr $self;

	$tree->meta->{$ref_addr}{id}        = $id;
	$tree->meta->{$ref_addr}{parent_id} = $parent_id;

	my(@parents) = ( $tree );

	my($node);
	my($sth_child);

	while ( my $parent = shift @parents )
	{
		$sth_child = $self->{_dbh} -> prepare( $sql{ fetch_children } );

		$sth_child -> execute( $parent -> meta->{$ref_addr}{id} );

		$sth_child -> bind_columns( \my ($id, $value, $class) );

		while ($sth_child -> fetch)
		{
			$node = Module::Runtime::use_module($class) -> new( $value );

			$parent -> add_child( $node );

			$node->meta->{$ref_addr}{id}        = $id;
			$node->meta->{$ref_addr}{parent_id} = $parent_id;

			push @parents, $node;
		}

		$sth_child -> finish;
	}

	$self -> _set_tree( $tree );

	return $self;

} # End of _reload.

# ----------------------------------------------

sub _create
{
	my($self)    = shift;
	my($tree)    = shift;
	$tree        = $self -> tree if (! $tree);
	my($dbh)     = $self->{_dbh};
	my(%sql)     = $self->_build_sql;
	my($next_id) = do
	{
		my($sth) = $dbh->prepare( $sql{next_id} );

		$sth->execute;
		$sth->fetchrow_array;
	};
	my($ref_addr) = refaddr $self;
	my($sth)      = $dbh->prepare( $sql{create_node} );
	my $traversal = $tree -> traverse( $tree -> LEVEL_ORDER );

	my($node_id);
	my($parent_id);

	while ( my $node = $traversal->() )
	{
		$node_id
			= $node -> meta->{$ref_addr}{id}
			= $next_id++;

		$parent_id
			= $node -> meta->{$ref_addr}{parent_id}
			= eval { $node -> parent -> meta->{$ref_addr}{id} };

		if ( $self->{_class_col} )
		{
			$sth->execute($node_id, $parent_id, $node->value, blessed( $node ) );
		}
		else {
			$sth->execute($node_id, $parent_id, $node->value);
		}
	}

	$sth -> finish;

	return $self;

} # End of _create.

# ----------------------------------------------

sub _commit
{
	my($self)     = shift;
	my($dbh)      = $self->{_dbh};
	my(%sql)      = $self -> _build_sql;
	my($ref_addr) = refaddr $self;

	my($sth);

	for my $change ( @{$self->{_changes}} )
	{
		if ( $change->{action} eq 'change_value' )
		{
			$sth = $dbh->prepare_cached( $sql{set_value} );

			$sth -> execute($change->{new_value}, $change->{node}->meta->{$ref_addr}{id});
			$sth -> finish;
		}
		elsif ( $change->{action} eq 'add_child' )
		{
			for my $child ( @{$change->{children}} )
			{
				$self -> _create( $child );
			}
		}
		elsif ( $change->{action} eq 'remove_child' )
		{
			for my $child ( @{$change->{children}} )
			{
				$sth = $dbh -> prepare_cached( $sql{set_parent} );

				$sth -> execute(undef, $child -> meta->{$ref_addr}{id});
				$sth -> finish;
			}
		}
	}

	return $self;

} # End of _commit.

# ----------------------------------------------

sub _build_sql
{
	my($self) = shift;
	my(%sql)  =
	(
		next_id => <<"__END_SQL__",
SELECT coalesce(MAX($self->{_id_col}),0) + 1
  FROM $self->{_table}
__END_SQL__
		set_value => <<"__END_SQL__",
UPDATE $self->{_table}
   SET $self->{_value_col} = ?
 WHERE $self->{_id_col} = ?
__END_SQL__
		set_parent => <<"__END_SQL__",
UPDATE $self->{_table}
   SET $self->{_parent_id_col} = ?
 WHERE $self->{_id_col} = ?
__END_SQL__
	);

	if ( $self->{_class_col} )
	{
		$sql{fetch} = <<"__END_SQL__";
SELECT $self->{_id_col}		AS id
	  ,$self->{_parent_id_col} AS parent_id
	  ,$self->{_value_col}	 AS value
	  ,$self->{_class_col}	 AS class
  FROM $self->{_table} AS tree
 WHERE tree.$self->{_id_col} = ?
__END_SQL__

		$sql{fetch_children} = <<"__END_SQL__";
SELECT $self->{_id_col}		AS id
	  ,$self->{_value_col}	 AS value
	  ,$self->{_class_col}	 AS class
  FROM $self->{_table} AS tree
 WHERE tree.$self->{_parent_id_col} = ?
__END_SQL__

		$sql{create_node} = <<"__END_SQL__";
INSERT INTO $self->{_table} (
	$self->{_id_col}
   ,$self->{_parent_id_col}
   ,$self->{_value_col}
   ,$self->{_class_col}
) VALUES ( ?, ?, ?, ? )
__END_SQL__
	}
	else
	{
		$sql{fetch} = <<"__END_SQL__";
SELECT $self->{_id_col}		AS id
	  ,$self->{_parent_id_col} AS parent_id
	  ,$self->{_value_col}	 AS value
	  ,'$self->{_class}'	   AS class
  FROM $self->{_table} AS tree
 WHERE tree.$self->{_id_col} = ?
__END_SQL__

		$sql{fetch_children} = <<"__END_SQL__";
SELECT $self->{_id_col}		AS id
	  ,$self->{_value_col}	 AS value
	  ,'$self->{_class}'	   AS class
  FROM $self->{_table} AS tree
 WHERE tree.$self->{_parent_id_col} = ?
__END_SQL__

		$sql{create_node} = <<"__END_SQL__";
INSERT INTO $self->{_table} (
	$self->{_id_col}
   ,$self->{_parent_id_col}
   ,$self->{_value_col}
) VALUES ( ?, ?, ? )
__END_SQL__
	}

	return %sql;

} # End of _build_sq.

# ----------------------------------------------

1;

__END__