# ==================================================================
# Links SQL - enhanced directory management system
#
#   Website  : http://gossamer-threads.com/
#   Support  : http://gossamer-threads.com/scripts/support/
#   Revision : $Id: Category.pm,v 1.62 2002/03/13 20:37:03 alex Exp $
#
# Copyright (c) 2001 Gossamer Threads Inc.  All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================

package Links::Category;
# ==================================================================
    use strict;
    use Links qw/$DB $CFG/;
    use GT::SQL;
    use GT::SQL::Table;
    use vars qw /@ISA $VERSION $DEBUG $ERRORS $ERROR_MESSAGE/;

    @ISA = qw/GT::SQL::Table/;
    $VERSION        = substr(q$Revision: 1.62 $,10);
    $DEBUG          = 0;
    $ERROR_MESSAGE  = 'GT::SQL';
    $ERRORS = {
                'NOSQL'         => "No SQL object was initilized",
                'BADCATNAME'    => "Invalid category name: %s",
                'BADCATID'      => "Invalid category id: %s",
                'BADCATSUG'     => "There is no category with that name. Perhaps you meant: %s",
                'CATEXISTS'     => "A category with the name '%s' already exists.",
                'CORRUPTCAT'    => "Loop detected! Category ID %s is a subcategory of itself!",
            };

sub add {
# -------------------------------------------------------------------
# Adds a category, but passes it through the plugin system.
#
    my $self = shift;
    my $p    = (ref $_[0] eq 'HASH') ? shift : {@_};

    GT::Plugins->dispatch ( $CFG->{admin_root_path} . '/Plugins', 'add_category', sub { return $self->_plg_add (@_); }, $p );
}

sub _plg_add {
# -------------------------------------------------------------------
# Add a category.
#
    my ($self, $p) = @_;

    $self->can_add($p) or return;

# If successful, we need to update timestamps of parents to denote a change.
    if (my $id = $self->SUPER::add($p)) {
        if ($p->{FatherID}) {
            my $parents = $self->parents ($id);
            foreach my $parent (@$parents) {
                $self->SUPER::update ( { Timestmp => \"NOW()" }, { ID => $parent }, { GT_SQL_SKIP_CHECK => 1, GT_SQL_SKIP_INDEX => 1 } );
            }
        }
        return $id;
    }
    else {
        return;
    }
}

sub can_add {
# -------------------------------------------------------------------
# Confirms that a category can be added.
#
    my $self  = shift;
    my $p;
    if (ref $_[0] eq 'HASH') { $p = $_[0]; }
    else                     { $p = {@_};  }

# Checks that the FatherID exists and set the full name.
    $p->{FatherID}    ||= 0;
    if ($p->{FatherID} !~ /^\d*$/) {
        my $sth = $self->select ( { Full_Name => $p->{FatherID} }, ['ID', 'Full_Name'] );
        if ($sth->rows) {
            ($p->{FatherID}, $p->{Full_Name}) = $sth->fetchrow_array;
            $p->{Full_Name} .= "/" . $p->{Name};
        }
        else {
            my $names = $self->suggestions ($p->{FatherID});
            @$names ?
                return $self->error ('BADCATSUG', 'WARN', "<ul><li>" . join ("<LI>", @$names) . "</ul>") :
                return $self->error ('BADCATNAME', 'WARN', $p->{FatherID});
        }
    }
    elsif ($p->{FatherID} != 0) {
        my $full_name   = $self->get_name_from_id ($p->{FatherID}) or return $self->error('BADCATID', 'WARN', $p->{FatherID});
        $p->{Full_Name} = $full_name . "/" . $p->{Name};
    }
    else {
        $p->{Full_Name} = $p->{Name};
    }

# Checks that there is no other category with the same (Name, FatherID)
    my $sth = $self->select ( { Name => $p->{Name}, FatherID => $p->{FatherID} }, ['ID'] );
    if ($sth->rows) {
        return $self->error('CATEXISTS', 'WARN', $p->{Name});
    }
    return 1;
}

sub delete {
# -------------------------------------------------------------------
# Deletes a category, but passes through the plugin system.
#
    my ($self, $id) = @_;
    $id or return $self->error ("BADARGS", "FATAL", "Usage: \$cat->delete( id_number ).");
    ref $id or ($id = { ID => $id });

    GT::Plugins->dispatch ( $CFG->{admin_root_path} . '/Plugins', 'delete_category', sub { return $self->_plg_delete (@_); }, $id );
}

sub _plg_delete {
# -------------------------------------------------------------------
# Delete one or more categories based on category ID.
#
    my ($self, $p) = @_;
    my $id = $p->{ID} or return $self->error ("BADARGS", "FATAL", "Usage: \$cat->delete( id_number ).");

# Get the record.
    my $sth     = $self->select ({ ID => $id },  ['Number_of_Links', 'FatherID']);
    if (!$sth or !$sth->rows) {
        return $self->error ("BADCATID", "WARN", $id);
    }
    my ($nol, $fid) = $sth->fetchrow_array;

# Recursively delete all the subcategories and the original category.
    my $catlnk_db = $DB->table ('CatLinks');
    my $link_db   = $DB->table ('Links');
    my $count     = 0;

# Remove all the categories.
    my $children = $self->children ($id);
    push @$children, $id;
    foreach my $child (@$children) {
        my $sth = $catlnk_db->select ( ['LinkID'], { CategoryID => $child } );
        if ($sth->rows) {
            while (my ($link) = $sth->fetchrow_array) {
                if ($catlnk_db->count ( { LinkID => $link }) == 1) {
                    $link_db->delete ($link);
                    $nol--; # Counts get handled in link module.
                }
            }
        }
        $self->SUPER::delete ($child) and $count++;
    }

# Clear out the cache as the heiarchy has changed.
    $self->_clear_cache;

# Update the NumberOfLinks field on all parents.
    $self->link_count ($fid, $nol * -1) if ($fid and $nol);

    return $count;
}

sub modify {
# -------------------------------------------------------------------
# Modifies a category, but passes through the plugin system.
#
    my ($self, $cat) = @_;
    GT::Plugins->dispatch ( $CFG->{admin_root_path} . '/Plugins', 'modify_category', sub { return $self->_plg_modify (@_); }, $cat );
}

sub _plg_modify {
# -------------------------------------------------------------------
# Modify a single category.
#
    my $self = shift;
    my $set  = shift        or return $self->error ('BADARGS', 'FATAL', "Usage: \$cat->modify( { col => value ... } ).");
    my $id   = $set->{ID}   or return $self->error ('BADARGS', 'FATAL', "No primary key passed to modify!");

# Get the original info.
    my $sth    = $self->select ( { ID => $id }, ['ID', 'FatherID', 'Full_Name', 'Name', 'Number_of_Links'] );
    my ($orig) = $sth->fetchrow_hashref;
    $orig or return $self->error ("BADCATID", "WARN", $id);

# Fix up the father ID.
    $set->{FatherID} ||= 0;
    if ($set->{FatherID} !~ /^\d+$/) {
        my $new_id = $self->get_id_from_name($set->{FatherID});
        if (! $new_id) {
            my $names = $self->suggestions ($set->{FatherID});
            @$names ?
                return $self->error ('BADCATSUG', 'WARN', "<ul><li>" . join ("<LI>", @$names) . "</ul>") :
                return $self->error ('BADCATNAME', 'WARN', $set->{FatherID});
        }
        $set->{FatherID} = $new_id;
    }

# Make sure we can modify the category.
    $self->can_modify($set, $orig) or return;

# Just do an update if the Name or Parent hasn't changed.
    if (($orig->{Name} eq $set->{Name}) and ($orig->{FatherID} == $set->{FatherID})) {
        return $self->SUPER::modify ($set);
    }
# Name has changed, but parent is the same, just update parents timestamp and change the full name
# Also need to update subcategory names.
    elsif ($orig->{FatherID} == $set->{FatherID}) {
        $set->{Full_Name} = $orig->{Full_Name};
        $set->{Full_Name} =~ s/\Q$orig->{Name}\E$/$set->{Name}/;
        my $ret = $self->SUPER::modify ($set);
        if ($ret) {
# Clear out the cache immediately as the tree has moved.
            $self->_clear_cache;

# Update was successful, now update the timestamp of the parent.
            if ($orig->{FatherID} != 0) {
                $self->SUPER::update ( { Timestmp => \"NOW()" }, { ID => $orig->{FatherID} }, { GT_SQL_SKIP_CHECK => 1 });
            }
# And update the Full_Name of all children.
            my $old_name = $self->quote ($orig->{Full_Name} . '/');
            my $new_name = $self->quote ($set->{Full_Name} . '/');
            $old_name =~ s,^'(.*?)'$,$1,;
            if ( lc $self->{connect}->{driver} eq 'pg' ) {
                $self->update_pg(GT::SQL::Condition->new ('Full_Name', 'LIKE', "$old_name%"), $old_name, $set->{Full_Name}.'/');
            }
            else { 
                $self->SUPER::update (
                                   { Full_Name => \"REPLACE(Full_Name, '$old_name', $new_name)" },
                                   GT::SQL::Condition->new ('Full_Name', 'LIKE', "$old_name%"),
                                   { GT_SQL_SKIP_CHECK => 1 }
                               );
            }                               
        }
# Clear out the cache.
        $self->_clear_cache;

        return $ret;
    }
# The category has moved! Ack! Get the New parents full name and update/
    else {
        my $sth = $self->select ({ ID => $set->{FatherID} }, ['Full_Name']);
        my ($fn)= $sth->fetchrow_array;
        $set->{Full_Name} = ($fn ? "$fn/" : '') . $set->{Name};


        my $ret = $self->SUPER::modify ($set);
        if ($ret) {
# Clear out the cache immediately as the tree has moved.
            $self->_clear_cache;

# Update the children.
            my $old_name = $self->quote ($orig->{Full_Name} . '/');
            my $new_name = $self->quote ($set->{Full_Name} . '/');
            $old_name =~ s,^'(.*?)'$,$1,;
            if ( lc $self->{connect}->{driver} eq 'pg' ) {
                $self->update_pg(GT::SQL::Condition->new ('Full_Name', 'LIKE', "$old_name%"), $old_name, $set->{Full_Name}.'/');
            }
            else {            
                $self->SUPER::update (
                                   { Full_Name => \"REPLACE(Full_Name, '$old_name', $new_name)" },
                                   GT::SQL::Condition->new ('Full_Name', 'LIKE', "$old_name%"),
                                   { GT_SQL_SKIP_CHECK => 1 }
                               );
            }                               

# Now update counters on the above parents.
# Clear out the cache as otherwise we get our old parents.
            if ($orig->{Number_of_Links} != 0) {
                $self->link_count ($orig->{FatherID}, $orig->{Number_of_Links} * -1);
                $self->link_count ($set->{FatherID}, $orig->{Number_of_Links});
            }
        }
# Clear out the cache.
        $self->_clear_cache;
        return $ret;
    }
}

sub update_pg {
#--------------------------------------------------------------------
# Update the children
#
    my ($self, $cond, $old_name, $new_name) = @_;
    my $sth = $self->select($cond, ['Full_Name']);
    while (my ($full_name) = $sth->fetchrow_array) {
        $full_name =~ s/$old_name/$new_name/g; 
        $self->SUPER::update({ Full_Name => $full_name }, $cond, { GT_SQL_SKIP_CHECK => 1 });
    }
}

sub can_modify {
# -------------------------------------------------------------------
# Returns 1 if a record can be modified, undef otherwise.
#
    my ($self, $new, $orig) = @_;

# If the FatherID has changed, make sure the new father exists. If it's 0, then
# it's the root category and we don't worry about it.
    if (($orig->{FatherID} ne $new->{FatherID}) or ($orig->{Name} ne $new->{Name})) {
        if ($orig->{FatherID} ne $new->{FatherID}) {
            if ($new->{FatherID}) {
                $self->count ( { ID => $new->{FatherID} }) or return $self->error('BADCATID', 'WARN', $new->{FatherID});
            }
        }
# Now make sure the new FatherID,Name doesn't exist as it must be unique.
        $self->count ( { FatherID => $new->{FatherID}, Name => $new->{Name} } ) and return $self->error('CATEXISTS', 'WARN', $new->{Name});
    }
    return 1;
}

sub children {
# -------------------------------------------------------------------
# Return a list of subcategories for a given category id.
#
    my $self  = shift;
    my $id    = shift        or return $self->error ('BADARGS', 'FATAL', "Must pass category id to children");
    my $res   = [];
    my $fn    = $self->get_name_from_id ($id) or return $self->error ('BADCATID', 'FATAL', $id);
    my $sth   = $self->select ( GT::SQL::Condition->new('Full_Name', 'LIKE', "$fn/%"), ['ID'] )
                    or return $self->error ('BADCATNAME', 'FATAL', $fn);
    my @res   = $sth->fetchall_list;
    return \@res;
}

sub template_set {
# -------------------------------------------------------------------
# Return the value of template set to use for a given category.
#
    my $self = shift;
    my $id   = shift or return $self->error ('BADARGS', 'FATAL', "Must pass category id to template_set");
    return '' unless (exists $self->{schema}->{cols}->{Category_Template});

    return $self->{_template_cache}->{$id} if (exists $self->{_template_cache}->{$id});

# If this category has a template set, use it.
    my ($cat_info) = $self->select ( ['Category_Template'], { ID => $id })->fetchrow_array;

# Otherwise look at it's parents.
    unless ($cat_info) {
        my $parents = $self->parents ($id);
        foreach my $parent (@$parents) {
            ($cat_info) = $self->select ( ['Category_Template'], { ID => $parent })->fetchrow_array;
            if ($cat_info) {
                last;
            }
        }
    }
    $self->{_template_cache}->{$id} = $cat_info || '';
    return $self->{_template_cache}->{$id};
}

sub parents {
# -------------------------------------------------------------------
# Return an array ref of id's for a categories parents.
#
    my $self  = shift;
    my $id    = shift or return $self->error ('BADARGS', 'FATAL', "Must pass category id to parents");

    $self->{_parent_cache}->{$id} = $self->_parents($id) unless (exists $self->{_parent_cache}->{$id});
    return ref $self->{_parent_cache}->{$id} ? [ @{$self->{_parent_cache}->{$id}} ] : [];
}

sub _parents {
# -------------------------------------------------------------------
# Recursive function to find parents.
#
    my $self = shift;
    my $id   = shift or return $self->error ('BADARGS', 'FATAL', "Must pass category id to parents");
    my $res  = shift || [];
    my $sth  = $self->select ( { ID => $id }, ['FatherID','ID'] ) or return $res;
    if (my ($f_id, $c_id) = $sth->fetchrow_array) {
        if ($f_id != 0 and ($f_id != $c_id)) {
            push (@$res, $f_id);
            return $self->_parents($f_id, $res);
        }
    }
    return $res;
}

sub suggestions {
# -------------------------------------------------------------------
# Returns a list of suggested category names. Takes a name and optional
# limit.
#
    my $self  = shift;
    my $name  = shift;
    my $limit = shift || 10;
    $name    =~ s/\r?\n?//g;
    $name    =~ /^\s*$/ and return [];

    $self->select_options("LIMIT 10");
    my $sth  = $self->select (GT::SQL::Condition->new('Full_Name', 'LIKE', '%' . $name . '%'), ['Full_Name']);
    my @name = ();
    while (my ($name) = $sth->fetchrow_array) {
        push @name, $name;
    }
    return \@name;
}

sub link_count {
# -------------------------------------------------------------------
# Change the link count by n for specified id, and all parents.
#
    my ($self, $id, $change) = @_;
    if (! $id or (ref $id and !@$id)) {
        return;
    }

    $change = int $change;
    if    ($change > 0) { $change = "+ $change"; }
    elsif ($change < 0) { $change = "- " . abs($change); }
    else  { return; }

    my $cond;
    ref $id or ($id = [ $id ]);
    foreach (@$id) {
        my $parents = $self->parents($_);
        my $str = '(' . join (',', $_, @$parents) . ')';
        $cond = GT::SQL::Condition->new ('ID', 'IN', \$str);
        $self->SUPER::update ( { Number_of_Links => \"Number_of_Links $change" }, $cond, { GT_SQL_SKIP_CHECK => 1, GT_SQL_SKIP_INDEX => 1 } );
    }
}

sub changed {
# -------------------------------------------------------------------
# Returns a statement handle that can be looped through to get a list
# of changed categories.
#
    Links::init_date();

    my $self = shift;
    my $date = GT::Date::date_get (defined $_[0] ? $_[0] : time);
    my $sth  = $self->select ( GT::SQL::Condition->new('Timestmp', '>=', $date ) );
    return $sth;
}

sub get_id_from_name {
# -------------------------------------------------------------------
# Returns the category id based on the name.
#
    my ($self, $name) = @_;
    $name =~ s/\r?\n?//;
    $name =~ /^\s*$/ and return;

    return $self->{_id_cache}->{$name} if (exists $self->{_id_cache}->{$name});
    $self->{_id_cache}->{$name} = $self->select ( { Full_Name => $name }, ['ID'] )->fetchrow_array;
    return $self->{_id_cache}->{$name};
}

sub get_name_from_id {
# -------------------------------------------------------------------
# Returns the category full name based on the id.
#
    my ($self, $id) = @_;
    return $self->{_name_cache}->{$id} if (exists $self->{_name_cache}->{$id});
    $self->{_name_cache}->{$id} = $self->select ( { ID => $id }, ['Full_Name'] )->fetchrow_array;
    return $self->{_name_cache}->{$id};
}

sub as_url {
# -------------------------------------------------------------------
# Return the passed in category name as something that can be used in a
# URL.
#
    my $self = shift;
    my $name = shift;

    if ($CFG->{foreign_char}) {
        my $id      = $self->get_id_from_name($name);
        if (! $id) { return _clean($name); }
        my $parents = $self->parents($id);
        my $output  = join ("/", reverse (@$parents), $id);
        return $output;
    }
    elsif ($CFG->{build_directory_field}) {
        my $id      = $self->get_id_from_name($name);
        my $sth     = $self->select ( { ID => $id }, [$CFG->{build_directory_field}] );
        if (! $sth->rows) { return _clean($name); }
        my ($dir)   = $sth->fetchrow_array;
        if ($dir) { return $dir; }
        else      { return _clean($name); }
    }
    else {
        return _clean($name);
    }
}

sub set_new {
# -------------------------------------------------------------------
# Sets the new flag for a given category id (or list).
#
    my $self = shift;
    my $ids  = ref $_[0] eq 'ARRAY' ? shift : [ shift ];
    my $rel  = $DB->table ('Links', 'CatLinks', 'Category');
    foreach my $id (@$ids) {
        my $parents  = $self->parents ($id);
        my @pids     = reverse @$parents;
        push @pids, $id;

# We start with the top level and go down, we can quit if any top level parent
# doesn't have any new links.
        PARENT: for my $i (0 .. $#pids) {
            my $pid      = $pids[$i];
            my $children = $self->children ($pid);
            my $str      = '(' . join (',', $pid, @$children) . ')';
            my $cond     = GT::SQL::Condition->new ('isNew', '=', 'Yes', 'CategoryID', 'IN', \$str);
            $rel->select_options ('GROUP BY Add_Date');
            my $sth      = $rel->select (['MAX(Add_Date)'], $cond);
            if ($sth->rows) {
                my ($date) = $sth->fetchrow;
                $self->update ( { 'Has_New_Links' => 'Yes', Newest_Link => $date }, { 'ID' => $pid }, { GT_SQL_SKIP_CHECK => 1, GT_SQL_SKIP_INDEX => 1 } );
            }
            else {
                $str = '(' . join (',', @pids[$i .. $#pids]) . ')';
                $self->update ( { 'Has_New_Links' => 'No' }, GT::SQL::Condition->new('ID', 'IN', \$str), { GT_SQL_SKIP_CHECK => 1, GT_SQL_SKIP_INDEX => 1 } );
                last PARENT;
            }
        }
    }
}

sub _clear_cache {
# -------------------------------------------------------------------
# Clear out cache results whenever a category is added/deleted/changed.
#
    my $self = shift;
    $self->{_parent_cache}   = {};
    $self->{_name_cache}     = {};
    $self->{_id_cache}       = {};
    $self->{_template_cache} = {};
    return 1;
}

sub _clean {
# -------------------------------------------------------------------
# Cleans up a name.
#
    my $name = shift;
    $name =~ s/\s/_/g;
    $name =~ s/[^\w\d_\-\/]/_/g;
    return $name;
}

package Links::Category::HTML;
# ==================================================================
# Handles displaying of forms and HTML.
#
    use strict;
    use vars  qw/@ISA/;
    use Links qw/$DB $CFG/;
    use GT::SQL::Display::HTML::Table;

    @ISA = qw/GT::SQL::Display::HTML::Table/;

    my $FORM_HIDE = 'add_form|modify_form|modify_multi_search_results|modify_multi_result_changed|modify_multi_results_err';
    my $FORM_HIDE_FIELDS = [qw/Full_Name Number_of_Links Has_New_Links Has_Changed_Links Newest_Link Timestmp/];

sub display {
# -------------------------------------------------------------------
# Displays a category, but passes through the plugin system.
#
    my $self = shift;
    my $p    = (ref $_[0] eq 'HASH') ? shift : {@_};

    GT::Plugins->dispatch ( $CFG->{admin_root_path} . '/Plugins', 'display_category', sub { return $self->_plg_display (@_); }, $p );
}

sub form {
# -------------------------------------------------------------------
# Displays a category form, but passes through the plugin system.
#
    my $self = shift;
    my $p    = (ref $_[0] eq 'HASH') ? shift : {@_};

    GT::Plugins->dispatch ( $CFG->{admin_root_path} . '/Plugins', 'form_category', sub { return $self->_plg_form (@_); }, $p );
}

sub _plg_display {
# -------------------------------------------------------------------
# Displays a record.
#
    my ($self, $opts) = @_;
    $self->{code}->{FatherID}  = \&disp_fatherid_html;
    $opts->{hide} ||= [];
    push @{$opts->{hide}}, qw/Full_Name/;

    return $self->SUPER::display($opts);
}

sub _plg_form {
# -------------------------------------------------------------------
# Displays a form.
#
    my ($self, $opts) = @_;
    $self->{code}->{FatherID} = \&disp_fatherid_form;
    if ($opts->{mode} =~ /$FORM_HIDE/o) {
        $opts->{hide} ||= [];
        push @{$opts->{hide}}, @{$FORM_HIDE_FIELDS};
    }
    return $self->SUPER::form($opts);
}

sub disp_fatherid_form {
# -------------------------------------------------------------------
# Display the list of subcategories as either a drop down list of a text box.
#
    my ($self, $col, $rec) = @_;
    my $font = $self->{font};
    my $out;
    my $form_name = $self->{multiple} ? "$self->{multiple}-FatherID" : 'FatherID';

    if ($CFG->{db_gen_category_list}) {
        my $sth = $self->{db}->select ( ["DISTINCT Full_Name, ID"] );
        my %names;
        if ($sth) {
            while (my ($name, $id) = $sth->fetchrow_array) {
                $names{$id} = $name;
            }
        }
        $names{0} = '--Root--';
        my $select = $self->select ( { name => $form_name, values => \%names, blank => 1, sort => sub { lc $_[0] cmp lc $_[1] }, value => defined $rec->{FatherID} ? $rec->{FatherID} : "" });
        $out = qq~
<tr><td valign=top><font $font>Subcategory of</font></td><td><font $font>$select<input type=hidden name="FatherID-opt" value="="></td></tr>
        ~;
    }
    else {
        my $value = $rec->{FatherID} || '';
        if ($value =~ /^\d+$/) {
            my $sth = $self->{db}->select( { ID => $value }, ["Full_Name"] );
            if ($sth) {
                ($value) = $sth->fetchrow_array;
            }
        }
        $out = qq~
<tr><td><font $font>Full Sub Category<br><font size=1>Separated with /'s</font></font></td><td><input type=text size="40" name="$form_name" value="$value"></td></tr>
        ~;
    }
    return $out;
}

sub disp_fatherid_html {
# -------------------------------------------------------------------
# Display the father.
#
    my ($self, $col, $rec) = @_;
    my ($parent) = $rec->{Full_Name} =~ m,^(.*)/[^/]+$,;
    my $font = $self->{font};
    $parent    ||= 'Root';
    return qq~
<tr><td><font $font>Subcategory of</font></td><td><font $font>$parent</td></tr>
    ~;
}

1;