File Coverage

blib/lib/DBIx/Tree/NestedSet.pm

Criterion	Covered	Total	%
statement	9	303	2.9
branch	0	74	0.0
condition	0	64	0.0
subroutine	3	38	7.8
pod	18	26	69.2
total	30	505	5.9

package DBIx::Tree::NestedSet;

use strict;
use warnings;
use Carp;
$DBIx::Tree::NestedSet::VERSION='0.16';

#POD Below!!

################################################################################
sub new{
    my $class=shift;
    $class=ref($class)||$class;
    my %params=@_;
    my $self={
	      dbh		=>	$params{dbh},
	      left_column_name	=>	$params{left_column_name}	|| 'lft',
	      right_column_name	=>	$params{right_column_name}	|| 'rght',
	      no_id_creation    =>      $params{no_id_creation}         || '',
	      table_name	=>	$params{table_name}		|| 'nested_set',
	      id_name		=>	$params{id_name}		|| 'id',
	      no_alter_table	=>	$params{no_alter_table}		|| undef,
	      db_type		=>	$params{db_type}		|| 'MySQL',
	      no_locking	=>	$params{no_locking}		|| undef
	     };
    bless $self, $class;
    croak("Not a DBI connection")
      unless($params{dbh}->isa('DBI::db'));

    foreach('left_column_name','right_column_name','table_name','id_name'){
	croak('"'.$self->{$_}."\" doesn't look like a valid SQL table or column name to me")
	  unless ($self->{$_} =~ m/^[_A-Za-z\d]+$/);
    }

    my $db_type=$self->{db_type};

    my $driver = "DBIx::Tree::NestedSet::$db_type";
    eval "require $driver;" or
      croak("That DBD source doesn't have a driver implemented yet");

    my $db_obj=$driver->new(
			    dbh			=>	$self->{dbh},
			    left_column_name	=>	$self->{left_column_name},
			    right_column_name	=>	$self->{right_column_name},
			    table_name		=>	$self->{table_name},
			    no_alter_table	=>	$self->{no_alter_table},
			    id_name		=>	$self->{id_name},
			    no_locking		=>	$self->{no_locking}
			   );
    $self->{_db_obj}=$db_obj;
    #$self->{start_id}=$params{start_id}|| scalar $self->{dbh}->selectrow_array('select min('.$self->{left_column_name}.')  from '.$self->{table_name} );
    $params{dbh}->{RaiseError} = 1 if(not defined $params{No_RaiseError});
    $params{dbh}->trace($params{trace}) if($params{trace});
    return $self;
}
########################################


################################################################################
sub get_table_name{
    return $_[0]->{table_name};
}
########################################


################################################################################
sub get_left_column_name{
    return $_[0]->{left_column_name};
}
########################################


################################################################################
sub get_right_column_name{
    return $_[0]->{right_column_name};
}
########################################


################################################################################
sub get_id_name{
    return $_[0]->{id_name};
}
########################################


################################################################################
sub get_dbh{
    return $_[0]->{dbh};
}
########################################


################################################################################
sub get_db_type{
    return $_[0]->{db_type};
}
########################################


################################################################################
sub get_no_alter_table{
    return $_[0]->{no_alter_table};
}
########################################


################################################################################
sub get_no_locking{
    return $_[0]->{no_locking};
}
########################################


################################################################################
sub get_root{
    my $self=shift;
    my $left=$self->{left_column_name};
    my $table=$self->{table_name};
    my $id_name=$self->{id_name};
    my ($min_left)=$self->{dbh}->selectrow_array("select min($left) from $table");
    return scalar $self->{dbh}->selectrow_array("select $id_name from ".$self->{table_name}." where $left=?",undef,($min_left));
}
########################################


################################################################################
sub _lock_tables{
    my $self=shift;
    $self->{_db_obj}->_lock_tables;
}
########################################


################################################################################
sub _unlock_tables{
    my $self=shift;
    $self->{_db_obj}->_unlock_tables;
}
########################################


################################################################################
sub add_child_to_right{
    my($self,%params)=@_;
    my $dbh=$self->{dbh};
    my $left=$self->{left_column_name};
    my $right=$self->{right_column_name};
    my $table=$self->{table_name};
    my $id_name=$self->{id_name};
    if((defined $params{id}) and ($id_name ne 'id')){
	#If they have changed the id_name but still pass in the id to act upon via the "id" parameter,
	#fix it here. This is for backwards compatibility
	$params{$id_name}=$params{id}
    }
    $self->_lock_tables();
    if(!$params{$id_name} && scalar $dbh->selectrow_array("select count(*) from $table")){
	#They haven't given us an id for this child.  Assume they want to add a child DIRECTLY
	#under the parent, as they can't have more than one root.
	$params{$id_name}=$self->get_root();
    }
    my $prepared_rightmost_SQL_statement=
      $dbh->prepare_cached("SELECT $right FROM $table WHERE $id_name=?",
			   {dbi_dummy=>__FILE__.__LINE__}
			  );

    my ($rightmost)=$dbh->selectrow_array($prepared_rightmost_SQL_statement,undef,($params{$id_name}));
    my $prepared_rightmost_SQL_tree_fix_statement=
      $dbh->prepare_cached(
		    "UPDATE $table SET $left = CASE WHEN $left > ? THEN $left + 2 ELSE $left END,
$right = CASE WHEN $right >= ? THEN $right + 2  ELSE $right END WHERE $right >= ?",
		    {dbi_dummy=>__FILE__.__LINE__}
		   );
    $prepared_rightmost_SQL_tree_fix_statement->execute($rightmost,$rightmost,$rightmost);
    $prepared_rightmost_SQL_tree_fix_statement->finish();
    my ($params,$values)=$self->_get_params_and_values(\%params,$left,$right,$id_name);
    my ($columns,$placeholders)=_prepare_columns_and_placeholders_for_adding_child_to_right($params,$left,$right);
    $self->_alter_table_if_needed($params);
    if ($self->{no_id_creation}) {
	#We are manually passing in IDs.  This is kinda a kludge to make the WebGUI folks happy.
	$self->_alter_sql_for_provided_primary_key_edits(\$columns,\$placeholders,$values,\%params);
    }
    my $insert=$dbh->prepare_cached("INSERT INTO $table ($columns) VALUES($placeholders)",{dbi_dummy=>__FILE__.__LINE__});
    $insert->execute($rightmost||1,$rightmost||1,@$values);
    $insert->finish();
    my $new_id;
    if ($self->{no_id_creation}) {
	$new_id=$params{provided_primary_key};
    } else {
	($new_id)=$dbh->selectrow_array("select max($id_name) from $table");
    }
    $self->_unlock_tables();
    return $new_id;
}
########################################


################################################################################
sub add_child_to_left{
    my($self,%params)=@_;
    my $dbh=$self->{dbh};

    my $left=$self->{left_column_name};
    my $right=$self->{right_column_name};
    my $table=$self->{table_name};
    my $id_name=$self->{id_name};
    if((defined $params{id}) and ($id_name ne 'id')){
	#If they have changed the id_name but still pass in the id to act upon via the "id" parameter,
	#fix it here. This is for backwards compatibility
	$params{$id_name}=$params{id}
    }
    $self->_lock_tables();
    if(!$params{$id_name} && scalar $dbh->selectrow_array("select count(*) from $table")){
	#They haven't given us an id for this child.  Assume they want to add a child DIRECTLY
	#under the parent, as they can't have more than one root.
	$params{$id_name}=$self->get_root();
    }

    my $prepared_leftmost_SQL_statement=$dbh->prepare_cached("SELECT $left FROM $table WHERE $id_name=?",{dbi_dummy=>__FILE__.__LINE__});

    my ($leftmost)=$dbh->selectrow_array($prepared_leftmost_SQL_statement,undef,($params{$id_name}));
    $prepared_leftmost_SQL_statement->finish();
    my $prepared_leftmost_SQL_tree_fix_statement=
      $dbh->prepare_cached(
			   qq|UPDATE $table
			SET $right =
			CASE WHEN $right > ?
			THEN $right + 2
			ELSE $right END,
			$left =
			CASE WHEN $left > ?
			THEN $left + 2
			ELSE $left
			END
			|,
			   {dbi_dummy=>__FILE__.__LINE__}
			  );

    $prepared_leftmost_SQL_tree_fix_statement->execute($leftmost,$leftmost);
    $prepared_leftmost_SQL_tree_fix_statement->finish();
    my ($params,$values)=$self->_get_params_and_values(\%params,$left,$right,$id_name);
    my ($columns,$placeholders)=_prepare_columns_and_placeholders_for_adding_child_to_left($params,$left,$right);
    $self->_alter_table_if_needed($params);
    if ($self->{no_id_creation}) {
	#We are manually passing in IDs.  This is kinda a kludge to make the WebGUI folks happy.
	$self->_alter_sql_for_provided_primary_key_edits(\$columns,\$placeholders,$values,\%params);
    }
    my $insert=$dbh->prepare_cached("INSERT INTO $table ($columns) VALUES($placeholders)",{dbi_dummy=>__FILE__.__LINE__});
    $insert->execute($leftmost||1,$leftmost||1,@$values);
    $insert->finish();
    my $new_id;
    if ($self->{no_id_creation}) {
	$new_id=$params{provided_primary_key};
    } else {
	($new_id)=$dbh->selectrow_array("select max($id_name) from $table");
    }
    $self->_unlock_tables();
    return $new_id;
}
########################################


################################################################################
sub _alter_sql_for_provided_primary_key_edits{
    my($self,$columns,$placeholders,$values,$params)=@_;
    my $id_name=$self->{id_name};
    $$columns.=",$id_name";
    $$placeholders.=',?';
    push @$values, $params->{provided_primary_key};
}
########################################


################################################################################
sub _alter_table_if_needed{
    #$params is an arrayref with all the proper columns in order.
    my ($self,$params)=@_;

    #We don't want to invoke the "automagical" table altering behavior
    return if(defined $self->{no_alter_table});

    my $left=$self->{left_column_name};
    my $right=$self->{right_column_name};
    my $table=$self->{table_name};
    my $dbh=$self->{dbh};
    my $id_name=$self->{id_name};

    #my %columns_we_are_requesting=map{$_=>1} @$params;
    my @columns_we_need_to_create;
    #With MySQL I could use "Explain $table" but I'd like this to be a bit more cross-RDBMS
    my $get_columns=$dbh->prepare_cached("select *,count(*) as _ignore_me_sdfas from $table group by $id_name",
					{dbi_dummy=>__FILE__.__LINE__});
    $get_columns->execute();
    my %columns_that_we_have=();
    foreach(@{$get_columns->{NAME}}){
	$columns_that_we_have{$_}=1 if($_ ne '_ignore_me_sdfas');
    }
    $get_columns->finish();
    foreach(@$params){
	push @columns_we_need_to_create, $_ if(not defined $columns_that_we_have{$_});
    }
    my $db_obj=$self->{_db_obj};
    foreach(@columns_we_need_to_create){
	croak('"'.$_."\" doesn't look like a valid SQL table or column name to me")
	  unless ($_ =~ m/^[_A-Za-z\d]+$/);
	$db_obj->_alter_table($_);
	$dbh->do("create index $_ on  $table($_)");
    }
}
########################################


################################################################################
sub _get_params_and_values{
    my ($self,$params,$left,$right,$id_name,$no_left_or_right)=@_;
    my %ignore=(
		$left=>1,
		$right=>1,
		$id_name=>1,
		provided_primary_key=>1
	       );
    my @params=($no_left_or_right) ? () :($left,$right); #Keep in order. . .
    my @values;
    foreach my $column (keys %$params){
	if (not defined $ignore{$column}){
	    push @params, $column;
	    push @values, $params->{$column}||''
	}
    }
    return (\@params,\@values);
}
########################################


################################################################################
sub edit_node{
    my ($self,%params)=@_;
    my $dbh=$self->{dbh};

    my $left=$self->{left_column_name};
    my $right=$self->{right_column_name};
    my $table=$self->{table_name};
    my $id_name=$self->{id_name};
    if((defined $params{id}) and ($id_name ne 'id')){
	#If they have changed the id_name but still pass in the id to act upon via the "id" parameter,
	#fix it here. This is for backwards compatibility
	$params{$id_name}=$params{id};
    }
    $self->_lock_tables();
    my ($params,$values)=$self->_get_params_and_values(\%params,$left,$right,$id_name,1);
    my ($columns)=_prepare_columns_and_placeholders_for_edit($params);
    $self->_alter_table_if_needed($params);
    my $update=$dbh->prepare_cached(
				    "update $table set $columns where $id_name=?",
				    {dbi_dummy=>__FILE__.__LINE__}
				   );
    my $id_value=$params{$id_name};
    $update->execute(@$values,$id_value);
    $update->finish();
    $self->_unlock_tables();
}
########################################


################################################################################
sub _prepare_columns_and_placeholders_for_edit{
    my ($params)=@_;
    my $columns=join('=? ,',(@$params)).'=?';
    return ($columns);
}
########################################


################################################################################
sub _prepare_columns_and_placeholders_for_adding_child_to_right{
    my ($params,$left,$right)=@_;
    my $columns=join(',',(@$params));
    my $placeholders=join(',',('?','? + 1')).
      ((scalar @$params -2 > 0) ? ',':''). #If there isn't more than 2 params, don't put in a comma
	substr(('?,' x (scalar @$params -2 )),0,-1);
    return ($columns,$placeholders);
}
########################################


################################################################################
sub _prepare_columns_and_placeholders_for_adding_child_to_left{
    my ($params,$left,$right)=@_;
    my $columns=join(',',(@$params));
    my $placeholders=join(',',('? + 1','? + 2')).
      ((scalar @$params -2 > 0) ? ',':''). #If there isn't more than 2 params, don't put in a comma
	substr(('?,' x (scalar @$params -2 )),0,-1);
    return ($columns,$placeholders);
}
########################################


################################################################################
sub get_id_by_key{
    my($self,%params)=@_;
    my $left=$self->{left_column_name};
    my $right=$self->{right_column_name};
    my $table=$self->{table_name};
    my $key_name=$params{key_name};
    my $id_name=$self->{id_name};
    if((defined $params{id}) and ($id_name ne 'id')){
	#If they have changed the id_name but still pass in the id to act upon via the "id" parameter,
	#fix it here. This is for backwards compatibility
	$params{$id_name}=$params{id};
    }
    my $ids=$self->{dbh}->selectcol_arrayref("select $id_name from $table where $key_name = ?",undef,($params{key_value}));
    return (@$ids > 1) ? $ids : $ids->[0] ;
}
########################################


################################################################################
sub get_self_and_parents_flat{
    my($self,%params)=@_;
    my $dbh=$self->{dbh};
    my $left=$self->{left_column_name};
    my $right=$self->{right_column_name};
    my $table=$self->{table_name};
    my $id_name=$self->{id_name};
    if((defined $params{id}) and ($id_name ne 'id')){
	#If they have changed the id_name but still pass in the id to act upon via the "id" parameter,
	#fix it here. This is for backwards compatibility
	$params{$id_name}=$params{id};
    }
    my $prepared_get_self_and_parents_flat_SQL_statement=
      $dbh->prepare_cached(
			   "select n2.* from $table as n1, $table as n2 where (n1.$left between n2.$left and n2.$right) and (n1.$id_name=?) order by n2.$left",
			   {dbi_dummy=>__FILE__.__LINE__}
			  );

    my $tree_structure=$dbh->selectall_arrayref($prepared_get_self_and_parents_flat_SQL_statement,
						{Columns=>{}},
						($params{$id_name} || 1)
					       );
    my $level=1;
    foreach(@$tree_structure){
	$_->{level}=$level;
	$level++;
    }
    return $tree_structure;
}
########################################


################################################################################
sub get_parents_flat{
    my $self=shift;
    my $tree=$self->get_self_and_parents_flat(@_);
    my $poo=pop @$tree if(@$tree);
    return $tree;
}
########################################


################################################################################
sub delete_self_and_children{
    my ($self,%params)=@_;
    my $dbh=$self->{dbh};
    my $left=$self->{left_column_name};
    my $right=$self->{right_column_name};
    my $table=$self->{table_name};
    my $id_name=$self->{id_name};
    if((defined $params{id}) and ($id_name ne 'id')){
	# If they have changed the name of the id field
	# but still pass in IDs with the old "id" moniker, fix it here.

	$params{$id_name}=$params{id};
    }
    if(!$params{$id_name}){
	carp("You didn't give us an ID that we could start the delete from");
	return [];
    } else {
	$self->_lock_tables();
	my $ids;
	if($params{not_self}){
	    #We don't want to delete the starting node.
	    #Start with the next level and go through them.

	    my $outer_tree=$self->get_children_flat(id=>$params{$id_name},depth=>1);
	    foreach my $outer_node(@$outer_tree){
		my $temp_tree=$self->get_self_and_children_flat(id=>$outer_node->{$id_name});
		$self->_delete_node(id=>$outer_node->{$id_name});
		foreach my $inner_node (@$temp_tree){
		    push @$ids,$inner_node->{$id_name};
		}
	    }

	} else {
	    #Delete it all. Hasta la bye-bye!
	    my $tree=$self->get_self_and_children_flat(id=>$params{$id_name});
	    $self->_delete_node(%params);
	    foreach my $node (@$tree){
		push @$ids,$node->{$id_name};
	    }
	}
	$self->_unlock_tables();
	return $ids;
    }
}
########################################


################################################################################
sub delete_children{
    my $self=shift;
    $self->delete_self_and_children(@_,not_self=>1);
}
########################################


################################################################################
sub _delete_node{
    my($self,%params)=@_;
    my $left=$self->{left_column_name};
    my $right=$self->{right_column_name};
    my $table=$self->{table_name};
    my $id_name=$self->{id_name};
    my $dbh=$self->{dbh};
    my $node_info=$self->get_hashref_of_info_by_id($params{$id_name});

    my $prepared_delete_node_delete_statement=
      $dbh->prepare_cached(
			   "delete from $table where $left between ? and ?",
			   {dbi_dummy=>__FILE__.__LINE__}
			  );

    $prepared_delete_node_delete_statement->execute($node_info->{$left},$node_info->{$right});
    $prepared_delete_node_delete_statement->finish();

    my $prepared_delete_node_fix_nodes=
      $dbh->prepare_cached(
    "UPDATE $table
     SET $left = CASE
                 WHEN $left > ? THEN $left - (? - ? + 1)
                 ELSE $left
               END,
         $right = CASE
                 WHEN $right > ? THEN $right - (? - ? + 1)
                 ELSE $right
               END
   WHERE $right > ?",
			   {dbi_dummy=>__FILE__.__LINE__}
			  );

    $prepared_delete_node_fix_nodes->execute(
					     $node_info->{$left},
					     $node_info->{$right},
					     $node_info->{$left},
					     $node_info->{$right},
					     $node_info->{$right},
					     $node_info->{$left},
					     $node_info->{$left},
					    );
    $prepared_delete_node_fix_nodes->finish();
}
########################################


################################################################################
sub get_self_and_children_flat{
    my($self,%params)=@_;
    my $dbh=$self->{dbh};
    my $left=$self->{left_column_name};
    my $right=$self->{right_column_name};
    my $table=$self->{table_name};
    my $id_name=$self->{id_name};
    if((defined $params{id}) and ($id_name ne 'id')){
	# If they have changed the id name but still pass in the ID value in the id parameter, fix it.
	$params{$id_name}=$params{id}
    }
    my $id_SQL='';
    my $start_node_info={};
    if (defined $params{$id_name}) {
	$start_node_info=$self->get_hashref_of_info_by_id_with_level($params{$id_name});
	$id_SQL="and (n1.$left between " . $dbh->quote($start_node_info->{$left})." and ".$dbh->quote($start_node_info->{$right}).") ";
    }
    my $depth_having_SQL='';
    if($params{depth}){
	$depth_having_SQL='having level <= '.$dbh->quote(($params{depth} + $start_node_info->{level}));
    }
    my $tree_structure=$dbh->selectall_arrayref("select count(n2.${id_name}) as level,n1.* from $table as n1, $table as n2 where (n1.$left between n2.$left and n2.$right) $id_SQL group by n1.${id_name} $depth_having_SQL order by n1.$left",{Columns=>{}});
    return $tree_structure;
}
########################################


################################################################################
sub get_children_flat{
    my $self=shift;
    my $tree=$self->get_self_and_children_flat(@_);
    my $poo=shift @$tree if(@$tree);
    return $tree;
}
########################################


################################################################################
sub swap_nodes{
    my($self,%params)=@_;
    my $dbh=$self->{dbh};
    my $left=$self->{left_column_name};
    my $right=$self->{right_column_name};
    my $table=$self->{table_name};

    my $first_id=$params{first_id};
    my $second_id=$params{second_id};
    croak("You didn't give me valid IDs to swap!\n") if(! $first_id || ! $second_id);
    #This is an "eq" below because we can now have non-numeric IDs.
    croak("You can't switch a node with itself!\n") if($first_id eq $second_id);

    $self->_lock_tables();
    my $first_id_info=$self->get_hashref_of_info_by_id($first_id);
    my $second_id_info=$self->get_hashref_of_info_by_id($second_id);

    my ($left_node,$right_node);
    if($first_id_info->{$left} < $second_id_info->{$left}){
	$left_node=$first_id_info;
	$right_node=$second_id_info;
    } else {
	$left_node=$second_id_info;
	$right_node=$first_id_info;
    }
    $dbh->do(qq|update $table set
	     $left =
	     CASE WHEN $left between $left_node->{$left} and $left_node->{$right}
	     THEN $right_node->{$right} + $left - $left_node->{$right}
	     WHEN $left between $right_node->{$left} and $right_node->{$right}
	     THEN $left_node->{$left} + $left - $right_node->{$left}
	     ELSE $left_node->{$left} + $right_node->{$right} + $left - $left_node->{$right} - $right_node->{$left} END,
	     $right =
	     CASE WHEN $right between $left_node->{$left} and $left_node->{$right}
	     THEN $right_node->{$right} + $right - $left_node->{$right}
	     WHEN $right between $right_node->{$left} and $right_node->{$right}
	     THEN $left_node->{$left} + $right - $right_node->{$left}
	     ELSE $left_node->{$left} + $right_node->{$right} + $right - $left_node->{$right} - $right_node->{$left} END
	     WHERE ($left between $left_node->{$left} and $right_node->{$right})
	     AND $left_node->{$left} < $left_node->{$right}
	     AND $left_node->{$right} < $right_node->{$left}
	     AND $right_node->{$left} < $right_node->{$right}|);

    $self->_unlock_tables();
}
########################################


################################################################################
sub get_hashref_of_info_by_id{
    my ($self,$value)=@_;
    my $dbh=$self->{dbh};
    my $id_name=$self->{id_name};
    #This excessively explicit quoting is to work around the buggy Mandrake 10.0 version of DBD::mysql
    return $dbh->selectrow_hashref("select * from ".$self->{table_name}." where $id_name = ".$dbh->quote($value));
}
########################################


################################################################################
sub get_hashref_of_info_by_id_with_level{
    my $self=shift;
    my $wanted_id=shift;
    my $left=$self->{left_column_name};
    my $right=$self->{right_column_name};
    my $table=$self->{table_name};
    my $id_name=$self->{id_name};
    return $self->{dbh}->selectrow_hashref("select count(n2.$id_name) as level,n1.* from $table as n1, $table as n2 where (n1.$left between n2.$left and n2.$right) and n1.$id_name=? group by n1.$id_name",undef,($wanted_id));
}
########################################


################################################################################
sub create_report{
    my ($self,%params)=@_;
    my $id_name=$self->{id_name};
    my $ancestors=$self->get_self_and_children_flat(id => $params{$id_name}||$self->get_root);
    my $report;
    foreach (@$ancestors) {
	$report.= (($_->{level} > 1) ? ((" " x ($params{indent_level} || 2)) x ($_->{level} - 1)) :'');
	$report.= $_->{name}." (".$_->{$id_name}.")(".$_->{level}.")\n";
    }
    return $report;
}
########################################


################################################################################
sub create_default_table{
    my $self=shift;
    $self->{_db_obj}->_create_default_table();
}
########################################


################################################################################
sub get_default_create_table_statement{
    my $self=shift;
    $self->{_db_obj}->_get_default_create_table_statement();
}
########################################


1;

__END__