# -------------------------------------------------------------------------------------
# lib::sql::Category
# -------------------------------------------------------------------------------------
#
#       Author : Jean-Michel Hiver (jhiver@cisedi.com).
#    Copyright : (c) Jean-Michel Hiver, 2000.
#
#      Unauthorized modification, use, reuse, distribution or redistribution
#      of this module is stricly forbidden.
#
#    Description:
#
#      A unique interface that is designed to get rid of SQL as much as possible.
#      Performs necessary checks on the database and throw Exceptions for operations
#      that would undoubtely fail but uses a driver system for all database SQL
#      accesses.
#
#      By sub-classing lib::sql::IndexedTable, lib::sql::Category provide proper
#      mechanisms to transparently manage categories.
#
# -------------------------------------------------------------------------------------
package lib::sql::Category;
use lib::Exception;
use lib::sql::IndexedTable;
use strict;
use vars qw /@ISA/;
@ISA = qw /lib::sql::IndexedTable/;


##
# __PACKAGE__->new ( name     => $table_name,
#                    pk       => [ $name1 ],
#                    cols     => [ { name => $name1, type => $type1 },
#                                  { name => $name2, type => $type2 } ],
#                    unique   => { $name1 => [ $col1, $col2 ] }
#                    index    => { $name2 => [ $col2 ] }
#                    fk       => { foreign_table => { source_col => target_col } }
#                    ai       => TRUE / FALSE
#                   -----------------------------------
#                    category_id       => "ID",
#                    category_path     => "Path",
#                    category_name     => "Name",
#                    category_parent   => "Father" );
##
sub new
{
    my $class = shift;
    $class = ref $class || $class;
    
    my $args = { @_ };
    my $self = $class->SUPER::new ( @_ );
    $self->{category_id}       = $args->{category_id}       || "ID";
    $self->{category_parent}   = $args->{category_parent}   || "Parent_ID";
    $self->{category_name}     = $args->{category_name}     || "Name";
    $self->{category_path}     = $args->{category_path}     || "Full_Path";
    $self->{category_position} = $args->{category_position} || "Sibling_Position";
    return bless $self, $class;
}


##
# $obj->modify ($category);
# -------------------------
#   Modifies $category, making any changes that would be
# necessary on the categories beneath this one.
##
sub modify
{
    my $self = shift;

    my $ID = $self->{category_id};
    my $Parent_ID = $self->{category_parent};
    my $Name = $self->{category_name};
    my $Full_Path = $self->{category_path};
    my $Position = $self->{category_position};

    my $new_category = undef;
    if (ref $_[0])
    {
	if (ref $_[0] eq 'CGI') { $new_category = $self->_to_hash (shift) }
	else                    { $new_category = shift }
    }
    else { $new_category = { @_ } }
    
    # build the condition to search for the old record
    # by copying primary key values into a hashref.
    my @pk = $self->pk;
    @pk or throw (new lib::Exception ( code => "NO_PRIMARY_KEY",
				       info => "The current record cannot be modified because " .
				               "its table has no pk." ) );
    
    # builds the condition from the record and changes
    # the values.
    my $condition = { map { $_ => $new_category->{$_} } @pk };
    
    # make sure that all the values in $condition are defined,
    # throw an exception otherwise.
    foreach my $field (keys %{$condition})
    {
        unless (defined $condition->{$field})
        {
            throw (new lib::Exception ( code => "INCOMPLETE_PK",
					info => "One of the condition value is not defined for this modify.") );
        }
    }
    
    my $old_category = $self->search ($condition)->next;

    unless (defined $old_category)
    {
	throw (new lib::Exception ( code => "RECORD_DOES_NOT_EXIST",
				    info => "The category that you want to modify does not exist." ) );
    }
    
    # if the category has to move elsewhere than the root
    # then we should perform a few checks
    if (defined $new_category->{$Parent_ID})
    {
	# if the father is the category itself, throw an exception
	if ( $new_category->{$Parent_ID} == $new_category->{$ID} )
	{
	    throw (new lib::Exception ( code => "ILLEGAL_MODIFICATION",
					info => {
					    msg => "It is not possible to move a category into itself",
					    category_id => $new_category->{$ID},
					    category_parent => $new_category->{$ID}
					} ) );
	}
	
	# let us grab the category in which we want to move
	my $move_to = $self->search ( $ID => $new_category->{$Parent_ID} )->next;
	unless (defined $move_to)
	{
	    throw (new lib::Exception ( code => "ILLEGAL_MODIFICATION",
					info => "The category to move into does not exist" ) );
	}

	my $qold = quotemeta ($old_category->{$Full_Path});
	if ($move_to->{$self->{category_path}} =~ /^$qold.*/)
	{
	    throw (new lib::Exception ( code => "ILLEGAL_MODIFICATION",
					info => {
					    msg => "Cannot move a category into one of its sub-categories",
					    category => $old_category->{$Full_Path},
					    move_to  => $move_to->{$Full_Path}
					} ) );
	}
    }
    
    # updates the category attributes, provided that it changed
    try {
	$self->_modify_position ($new_category, $old_category);
    }
    catch {
	my $exception = shift;
	if ($exception->{code} eq 'CANNOT_GET_SWITCH_CATEGORY')
	{
	    $self->_stack_children_position ($new_category->{$Parent_ID});
	}
    };
    
    # updates the category name, provided that it has changed
    $self->_modify_name ($new_category, $old_category);
    
    # updates the category location, provided that it has changed
    $self->_modify_location ($new_category, $old_category);
    
    # updates the category path
    $self->_compute_path ($new_category);
    
    # updates all the other attributes
    $self->SUPER::modify ($new_category);
    
    # stacks this category's children, just in case
    $self->_stack_children_position ($new_category->{$ID});    
}


##
# $obj->_modify_name ($new_category, $old_category);
# --------------------------------------------------
#   When the position of a Category changes, it has to
# update the category it's going to be swapped with.
##
sub _modify_position
{
    my $self = shift;
    my $new  = shift;
    my $old  = shift;
    
    my $ID = $self->{category_id};
    my $Parent_ID = $self->{category_parent};
    my $Name = $self->{category_name};
    my $Full_Path = $self->{category_path};
    my $Position = $self->{category_position};
    
    # if the category has to be positioned elsewhere
    if ($new->{$Position} ne $old->{$Position})
    {
	# gets the category which has the same parent and the desired position
	my $switch = $self->get (
				 $Parent_ID => $new->{$Parent_ID},
				 $Position  => $new->{$Position}
				 );
	
	# complain if there's no category to switch with
	throw ( new lib::Exception ( code => 'CANNOT_GET_SWITCH_CATEGORY', info => $new ) ) unless (defined $switch);
	
	$switch->{$Position} = $old->{$Position};
	$self->SUPER::modify ($switch);
    }
}


##
# $obj->_modify_name ($new_category, $old_category);
# --------------------------------------------------
#   When the name of a Category changes, its path
# changes too. This means that by the same time, the
# path of all the categories beneath it changes as
# well.
##
sub _modify_name
{
    my $self = shift;
    my $new  = shift;
    my $old  = shift;
    
    my $ID = $self->{category_id};
    my $Parent_ID = $self->{category_parent};
    my $Name = $self->{category_name};
    my $Full_Path = $self->{category_path};
    my $Position = $self->{category_position};
    
    my $new_name = $new->{$Name};
    my $old_name = $old->{$Name};
    if ($new_name ne $old_name)
    {
	# if the name has changed, then the path must change as well.
	# not only for this category, but also for all the sub-categories
	my $old_path = $old->{$Full_Path};
	my $new_path = $old_path;
	
	# replace /blah/blah.../old_name by /blah/blah.../new_name
	$new_path =~ s/\Q$old_name\/\E$/$new_name\//;
	
	# select all the categories beneath the current category,
	# i.e. the path of which starts by $old_path/
	my $condition = new lib::sql::Condition;
	$condition->add ($self->{category_path}, 'LIKE', $old_path . "_%");
	my $query = $self->search ($condition);
	
	# for each category, modify the path
	while (my $beneath_category = $query->next)
	{
	    $beneath_category->{$Full_Path} =~ s/^\Q$old_path\E/$new_path/;  
	    $self->SUPER::modify ($beneath_category);
	}
	
	$new->{$self->{category_path}} = $new_path;
	$self->SUPER::modify ($new);
    }
}


##
# $obj->_modify_location ($new_category, $old_category);
# ------------------------------------------------------
#   When the location of a category changes, its path
# changes too. This means that the path of all the
# categories underneath it has to be updated too.
#
#   This also means that we need to update the 'location'
#   fields.
##
sub _modify_location
{
    my $self = shift;
    my $new  = shift;
    my $old  = shift;
    
    my $ID = $self->{category_id};
    my $Parent_ID = $self->{category_parent};
    my $Name = $self->{category_name};
    my $Full_Path = $self->{category_path};
    my $Position = $self->{category_position};
    
    my $new_parent = $new->{$Parent_ID};
    my $old_parent = $old->{$Parent_ID};
    
    if ($new_parent != $old_parent)
    {
	my $old_path = $old->{$Full_Path};
	my $new_path = $new->{$Name};
	if ($new_parent != 0)
	{
	    my $new_parent_path = $self->search ( $ID => $new_parent )->next->{$Full_Path};
	    $new_path = $new_parent_path . $new_path . "/";
	}
	
	# select all the categories beneath the current category,
	# i.e. the path of which starts by $old_path/
	my $condition = new lib::sql::Condition;
	$condition->add ($Full_Path, 'LIKE', $old_path . "_%");
	my $query = $self->search ($condition);
	
	# for each category, modify the path
	while (my $beneath_category = $query->next)
	{
	    $beneath_category->{$Full_Path} =~ s/^\Q$old_path\E/$new_path/;
	    $self->SUPER::modify ($beneath_category);
	}
	
	# the category has to be the last of the new parent's children,
	# thus we need to recompute the 'Position' field
	$new->{$Position} = $self->select ( cols  => 'count(*)',
					    where => { $Parent_ID => $new_parent } )->next->{'count(*)'} + 1;
	
	$new->{$Full_Path} = $new_path;
	$self->SUPER::modify ($new);
	
	# the old parent's children needs to be stacked
	$self->_stack_children_position ($old_parent);
    }
}


##
# $obj->insert ($hash, $hashref or CGI);
# --------------------------------------
#   Inserts a category into the database.
##
sub insert
{
    my $self = shift;

    my $ID = $self->{category_id};
    my $Parent_ID = $self->{category_parent};
    my $Name = $self->{category_name};
    my $Full_Path = $self->{category_path};
    my $Position = $self->{category_position};
    
    my $insert = undef;
    if (ref $_[0]) { $insert = shift  }
    else           { $insert = { @_ } }
    
    $insert = $self->_to_hash ($insert);
    
    $self->_compute_path ($insert);
    $self->_insert_compute_position ($insert);
    return $self->SUPER::insert ($insert);
}


##
# $obj->_compute_position;
# ------------------------
#   Alters category so that it has the proper position.
##
sub _insert_compute_position
{
    my $self = shift;    
    my $insert = shift;
    
    my $ID = $self->{category_id};
    my $Parent_ID = $self->{category_parent};
    my $Name = $self->{category_name};
    my $Full_Path = $self->{category_path};
    my $Position = $self->{category_position};
    
    my $position = $self->select ( cols  => "max($Position)",
				   where => { $Parent_ID => $insert->{$Parent_ID} } )->next;
    
    if (defined $position) { $position = $position->{"max($Position)"} }
    else                   { $position = 0                             }
    $insert->{$Position} = $position + 1;
}


##
# $obj->delete_cascade ($hash, $hashref or CGI);
# ----------------------------------------------
#   Deletes a category and all it's sub-categories,
#   and cascade on any referencing tables.
##
sub delete_cascade
{
    my $self  = shift;
    my $class = ref $self;
    my $condition = undef;
    if (ref $_[0] eq "CGI") { $condition = new lib::sql::Condition ($self->_to_hash (shift)) }
    else                    { $condition = new lib::sql::Condition ( @_ ) };
    my $condition_sql = $condition->to_sql;

    my $ID = $self->{category_id};
    my $Parent_ID = $self->{category_parent};
    my $Name = $self->{category_name};
    my $Full_Path = $self->{category_path};
    my $Position = $self->{category_position};
        
    unless ($condition_sql) { $self->SUPER::delete_cascade }
    
    # stores all IDs of categories the children of which will need to be stacked
    my %parent_id = ();
    
    # for each category to delete
    my $query = $self->search ($condition);
    while (my $category = $query->next)
    {
	# select all the categories that are directly
	# beneath that category
	my $q = $self->search ( $Parent_ID => $category->{$ID} );
	
	# for each of these categories
	while (my $cat = $q->next)
	{
	    # compute the primary key of this category
	    my $cond = {};
	    foreach my $pk ($self->pk)
	    {
		$cond->{$pk} = $cat->{$pk};
	    }

	    # and delete it
	    $self->delete_cascade ($cond);
	}
	
	# when all the sub-categories have been removed,
	# compute the primary key for that current category
	# and remove it
	my $cond = {};
	foreach my $pk ($self->pk)
	{
	    $cond->{$pk} = $category->{$pk};
	}
	
	# save the parent ID for later cleanup
	$parent_id{$category->{$Parent_ID}} = 1;
	$self->SUPER::delete_cascade ($cond);
    }
    
    # reorders childrens which needs to
    foreach my $parent_id (keys %parent_id)
    {
	$self->_stack_children_position ($parent_id);
    }
}


##
# $obj->delete_cascade ($hash, $hashref or CGI);
# ----------------------------------------------
#   Deletes a category and all its sub-categories.
##
sub delete
{
    my $self  = shift;
    my $class = ref $self;
    my $condition = undef;
    if (ref $_[0] eq "CGI") { $condition = new lib::sql::Condition ($self->_to_hash (shift)) }
    else                    { $condition = new lib::sql::Condition ( @_ ) };
    my $condition_sql = $condition->to_sql;
    
    unless ($condition_sql) { $self->SUPER::delete }

    my $ID = $self->{category_id};
    my $Parent_ID = $self->{category_parent};
    my $Name = $self->{category_name};
    my $Full_Path = $self->{category_path};
    my $Position = $self->{category_position};

    # stores all IDs of categories the children of which will need to be stacked
    my %parent_id = ();
    
    # for each category to delete
    my $query = $self->search ($condition);
    while (my $category = $query->next)
    {
	# select all the categories that are directly
	# beneath that category.
	my $q = $self->search ( $Parent_ID => $category->{$ID} );
	
	# for each of these categories
	while (my $cat = $q->next)
	{
	    # compute the primary key of this category
	    my $cond = {};
	    foreach my $pk ($self->pk)
	    {
		$cond->{$pk} = $cat->{$pk};
	    }
	    
	    # and delete it
	    $self->delete ($cond);
	}
	
	# when all the sub-categories have been removed,
	# compute the primary key for that current category
	# and remove it.
	my $cond = {};
	foreach my $pk ($self->pk)
	{
	    $cond->{$pk} = $category->{$pk};
	}
	# save the parent ID for later cleanup
	$parent_id{$category->{$Parent_ID}} = 1;
	$self->SUPER::delete ($cond);
    }
    
    # reorders childrens which needs to
    foreach my $parent_id (keys %parent_id)
    {
	$self->_stack_children_position ($parent_id);
    }
}


##
# $obj->_stack_children_position ($parent_id);
# -------------------------------------------
#   Reorders the children of the parent category which
#   is determined by $parent_id.
##
sub _stack_children_position
{
    my $self = shift;
    my $parent_id = shift;
    
    my $parent = $self->get ($parent_id) or return;
    
    my $ID = $self->{category_id};
    my $Parent_ID = $self->{category_parent};
    my $Name = $self->{category_name};
    my $Full_Path = $self->{category_path};
    my $Position = $self->{category_position};
    
    my $query = $self->select ( cols => '*',
				where => { $Parent_ID => $parent->{$ID} },
				sort => [ $Position ] );
    my $count = 0;
    while (my $category = $query->next)
    {
	$category->{$Position} = ++$count;
	$self->SUPER::modify ($category);
    }
}


##
# $obj->_compute_path ($category);
# --------------------------------
#   Alters category so that it has the proper path.
##
sub _compute_path
{
    my $self = shift;
    my $cat  = shift;
    
    my $ID = $self->{category_id};
    my $Parent_ID = $self->{category_parent};
    my $Name = $self->{category_name};
    my $Full_Path = $self->{category_path};
    my $Position = $self->{category_position};
    
    # if the parent category is root, then the path is the same
    # as the category name.
    if ((not defined $cat->{$Parent_ID}) or $cat->{$Parent_ID} == 0)
    {
	$cat->{$Full_Path} = "/" . $cat->{$Name};
    }
    
    # else, we must find the parent category in order to compute
    # the path.
    else
    {
	my $parent_cat = $self->search ( $ID => $cat->{$Parent_ID} )->next;
	unless (defined $parent_cat)
	{
	    throw (new lib::Exception ( code => "PARENT_DOES_NOT_EXIST",
					info => "This parent category does not exist." ) );	
	}
	$cat->{$Full_Path} = $parent_cat->{$Full_Path} . $cat->{$Name} . '/';
    }
}


1;





