# ==================================================================
# Gossamer Links - enhanced directory management system
#
#   Website  : http://gossamer-threads.com/
#   Support  : http://gossamer-threads.com/scripts/support/
#   CVS Info : 087,071,086,086,085      
#   Revision : $Id: Links.pm,v 1.33 2009/05/11 05:57:45 brewt 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::Table::Links;
# ==================================================================
use strict;
use Links qw/:payment :objects/;
use GT::SQL;
use GT::SQL::Table;
use vars qw /@ISA $DEBUG $ERRORS $ERROR_MESSAGE $CATLINK/;

@ISA = qw/GT::SQL::Table/;
$DEBUG = 0;
$ERROR_MESSAGE = 'GT::SQL';

$ERRORS = {
    NOCATEGORY  => "You did not specify a category for this link.",
    BADCATSUG   => "There is no category with that name. Perhaps you meant: %s",
    BADCATEGORY => "Invalid Category '%s', it does not exist.",
};

sub _query {
# -------------------------------------------------------------------
# Overrides the default query to allow searching on category values.
#
    my $self = shift;
    my $opts = $self->common_param(@_) or return $self->fatal(BADARGS => '$obj->insert(HASH or HASH_REF or CGI) only.');

# Parse date/time
    if ($opts->{ExpiryDate} and $opts->{ExpiryDate} !~ /^\s*-?\d+\s*$/) {
        my $converted = Links::date_to_time($opts->{ExpiryDate});
        $opts->{ExpiryDate} = $converted if defined $converted;
    }
    my $cat_id = $opts->{'CatLinks.CategoryID'} or return $self->SUPER::_query($opts);
    $cat_id    = $self->clean_category_ids($cat_id) or return;

# Strip out values that are empty or blank (as query is generally
# derived from cgi input).
    my %input = map { $_ => $opts->{$_} } grep { defined $opts->{$_} and $opts->{$_} !~ /^\s*$/ } keys %$opts;
    $opts = \%input;

# Create a CatLinks,Links table to do the search.
    my $db = $DB->table('CatLinks','Links');

# Now start handling the search
    my $cond = $self->build_query_cond($opts, $self->{schema}->{cols});
    if ( (ref $cond) =~ /::sth/i ) {
        return $cond;
    }

# Set the limit clause, defaults to 25, set to -1 for none.
    my $in       = $self->_get_search_opts($opts);
    my $offset   = ($in->{nh} - 1) * $in->{mh};
    $db->select_options("ORDER BY $in->{sb} $in->{so}") if $in->{sb};
    $db->select_options("LIMIT $in->{mh} OFFSET $offset") unless $in->{mh} == -1;

# Add to the condition the category clause.
    my $final = new GT::SQL::Condition;
    $final->add($cond) if $cond;
    $final->add('CatLinks.CategoryID', 'IN', $cat_id);

# Now do the select.
    my @sel;
    push @sel, $final if $final;
    push @sel, $opts->{rs} if $opts->{rs} and $final;
    my $sth = $db->select(@sel) or return;
    $self->{last_hits} = $db->hits;
    return $sth;
}

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

    $PLG->dispatch('add_link', sub { $self->_plg_add(@_) }, $p);
}

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

# Check to see if we can add a link, all errors get cascaded back.
    $p->{'CatLinks.CategoryID'} or return $self->warn('NOCATEGORY');
    $p->{'CatLinks.CategoryID'} = $self->clean_category_ids($p->{'CatLinks.CategoryID'}) or return;

    $self->set_date_flags($p);

    my $counted = ($p->{isValidated} eq 'Yes' and $p->{ExpiryDate} >= time);
    if ($p->{ExpiryDate} >= time) {
        $p->{ExpiryCounted} = 0;
    }
    else {
        $p->{ExpiryCounted} = 1;
    }

# Add the link, and return if there was an error, the error is propogated back.
    my $id = $self->SUPER::add($p) or return;

# Now add all the categories that the link belongs too.
    my $cat     = $DB->table('Category');
    my $cat_lnk = $DB->table('CatLinks');

    my @cat_ids = ref $p->{'CatLinks.CategoryID'} ? @{$p->{'CatLinks.CategoryID'}} : $p->{'CatLinks.CategoryID'};
    my %parents;

# Get a list of all the parents that this will affect.
    foreach my $cat_id (@cat_ids) {
        $cat_lnk->insert({ LinkID => $id, CategoryID => $cat_id }) or return;
        if ($counted) {
            for (@{$cat->parents($cat_id)}) { $parents{$_}++ }
            $parents{$cat_id}++;
        }
    }

# Now update those categories.
    if ($counted) {
        $cat->update(
            { Newest_Link => $p->{Add_Date}, Has_New_Links => 'Yes', Number_of_Links => \"Number_of_Links + 1" },
            { ID => [keys %parents] },
            { GT_SQL_SKIP_CHECK => 1, GT_SQL_SKIP_INDEX => 1 }
        );
        $cat->update({ Direct_Links => \"Direct_Links + 1" }, { ID => \@cat_ids });
    }
    return $id;
}

sub delete {
# -----------------------------------------------------------------------------
# Deletes one or more links; there is a 'delete_link' hook below that can be
# used by plugins.
#
    my ($self, $where) = @_;
    if (not ref $where or ref $where eq 'ARRAY') {
        $where = { ID => $where };
    }
    return $self->fatal(BADARGS => 'Usage: $links->delete(condition)')
        unless (ref $where eq 'HASH' and keys %$where) or (UNIVERSAL::isa($where, 'GT::SQL::Condition') and $where->sql);

    my $CatLinks = $DB->table('CatLinks');

    # Sometimes { ID => x, CatLinks.CategoryID => y } gets passed in; it is
    # wrong - CatLinks->delete should be used instead, which will recall this
    # subroutine if any links need to be deleted.
    if (ref $where eq 'HASH' and $where->{ID} and not ref $where->{ID}
        and $where->{'CatLinks.CategoryID'} and not ref $where->{'CatLinks.CategoryID'}) {
        return $CatLinks->delete({ LinkID => $where->{ID}, CategoryID => $where->{'CatLinks.CategoryID'} });
    }

    # Delete called with a normal condition
    my $links = $self->select(qw/ID isValidated Add_Date ExpiryDate ExpiryCounted/ => $where)->fetchall_hashref;
    @$links or return '0 but true';

    my $new_cutoff = GT::Date::timelocal(0, 0, 0, (localtime time - $CFG->{build_new_cutoff})[3 .. 5]);
    my (@counts, @new);
    for (@$links) {
        my $add_time = GT::Date::timelocal(GT::Date::parse_format($_->{Add_Date}, GT::Date::FORMAT_DATE));
        if ($_->{isValidated} eq 'Yes' and ($_->{ExpiryDate} >= time or not $_->{ExpiryCounted})) {
            push @counts, $_->{ID};
            push @new, $_->{ID} if $add_time >= $new_cutoff;
        }
    }

    # Figure out how much each category needs to be decremented
    $CatLinks->select_options("GROUP BY CategoryID");
    my %cats = $CatLinks->select(CategoryID => 'COUNT(*)' => { LinkID => \@counts })->fetchall_list;

    my %change;
    while (my ($catid, $count) = each %cats) {
        push @{$change{-$count}}, $catid;
    }

    my $ret;
    {
        # CatLinks, which has an fk to Links.ID, needs to know what we're
        # deleting so that it doesn't try to recall Links->delete
        local @Links::Table::CatLinks::DELETING;
        if ($PLG->active_plugins('delete_link')) {
            for (@$links) {
                @Links::Table::CatLinks::DELETING = $_->{ID};
                my $r = $PLG->dispatch('delete_link', sub { return $self->_plg_delete_link(@_) }, { ID => $_->{ID} });
                $ret += $r if defined $r;
            }
            $ret = '0 but true' if defined $ret and $ret == 0;
        }
        else {
            # delete_link plugin hook isn't being used, a single delete will do it
            my @lids = map $_->{ID}, @$links;
            @Links::Table::CatLinks::DELETING = @lids;
            $ret = $self->SUPER::delete({ ID => \@lids });
        }
    }

    my $Category = $DB->table('Category');
    $Category->link_count(\%change);

    while (my ($change, $ids) = each %change) {
        $Category->update({ Direct_Links => \("Direct_Links - " . abs $change) }, { ID => $ids });
    }

    $CatLinks->select_options("GROUP BY CategoryID");
    my @new_cats = $CatLinks->select(CategoryID => { LinkID => \@new })->fetchall_list;
# Now reset new flags on categories.
    if ($ret and @new_cats) {
        $Category->set_new(\@new_cats);
    }
    return $ret;
}

sub _plg_delete_link {
# -----------------------------------------------------------------------------
# Deletes a single link ID (plugin hook 'delete_link'.  The second argument,
# $link, will, for historic reasons, always be a hash reference containing an
# 'ID' key, the value of which is the ID of the link to be deleted.
#
    my ($self, $link) = @_;
    my $link_id = $link->{ID};

    return $self->SUPER::delete({ ID => $link_id });
}

sub modify {
# -------------------------------------------------------------------
# Modifies a link, but passes through the plugin system.
#
    my ($self, $link) = @_;
    $PLG->dispatch('modify_link', sub { return $self->_plg_modify(@_) }, $link);
}

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

# Let's set the changed date to right now.
    Links::init_date();
    $set->{Mod_Date} = GT::Date::date_get();

# Force it to uncounted so that category counts will be properly updated
    $set->{ExpiryCounted} = 0;

# Check to see if we can modify (makes sure valid category id's were set).
    $set->{'CatLinks.CategoryID'} or return $self->warn('NOCATEGORY');
    $set->{'CatLinks.CategoryID'} = $self->clean_category_ids($set->{'CatLinks.CategoryID'}) or return;

    $self->set_date_flags($set);

# Check to see if we are changing from not validated => validated.
    my ($old_validated, $old_expiry) = $self->select(qw/isValidated ExpiryDate/ => { ID => $set->{ID} })->fetchrow;

# Check that the ExpiryDate is valid for the categories the link is in.
    require Links::Payment;
    my $expiry = (exists $set->{ExpiryDate} and $set->{ExpiryDate}) ? $set->{ExpiryDate} : $old_expiry;
    $expiry = Links::Payment::check_expiry_date({ ExpiryDate => $expiry }, $set->{'CatLinks.CategoryID'});
    $set->{ExpiryDate} = $expiry if $expiry;

    my $new_validated = exists $set->{isValidated} ? $set->{isValidated} : $old_validated;
    my $new_expiry    = exists $set->{ExpiryDate}  ? $set->{ExpiryDate}  : $old_expiry;

    my $was_counted = $old_validated eq 'Yes' && $old_expiry >= time;
    my $now_counted = $new_validated eq 'Yes' && $new_expiry >= time;

    if (exists $set->{ExpiryDate}) {
        $set->{ExpiryCounted} = $set->{ExpiryDate} >= time ? 0 : 1;
    }

=for comment
Here are the various cases that the category count update code needs to handle and what to do in those cases:

add the link to a new category
    was counted, now_counted    increment new cat
    !was counted, now counted   increment new cat
    was counted, !now counted   nothing
    !was counted, !now counted  nothing

remove the link from a category
    was counted, now_counted    decrement old cat (CatLinks handles correctly)
    !was counted, now counted   nothing           (CatLinks handles incorrectly and decrements in some cases, we fix and increment)
    was counted, !now counted   decrement old cat (CatLinks handles correctly)
    !was counted, !now counted  nothing           (CatLinks handles correctly)

no category changes
    was counted, now_counted    nothing
    !was counted, now counted   increment cats
    was counted, !now counted   decrement cats
    !was counted, !now counted  nothing

the above combined (what the code needs to do)
    was counted, now_counted    increment new cats
    !was counted, now counted   increment curr cats, leave removed cats
    was counted, !now counted   decrement cats except removed and new cats (ie. decrement curr cats, except new cats)
    !was counted, !now counted  nothing
=cut

# Do the update.
    my $ret = $self->SUPER::modify($set);
# Check to see if the link has been moved into another category.
    if ($ret) {
        my $cat_lnk = $DB->table('CatLinks');
        my %orig_ids = map { $_ => 1 } $cat_lnk->select(CategoryID => { LinkID => $id })->fetchall_list;
        my %cat_ids = map { $_ => 1 } ref $set->{'CatLinks.CategoryID'} ? @{$set->{'CatLinks.CategoryID'}} : $set->{'CatLinks.CategoryID'};

# Categories that the link has just been added to
        my @new_cats = grep !$orig_ids{$_}, keys %cat_ids;
# Categories that the link has just been removed from
        my @old_cats = grep !$cat_ids{$_}, keys %orig_ids;

        my %link_adjustment;
        my $Category = $DB->table('Category');

# CatLinks doesn't update category counts on insert, so it's done further down in the code
        if (@new_cats) {
            $cat_lnk->insert_multiple([qw/LinkID CategoryID/], map [$id, $_], @new_cats);
        }

# However, deleting from CatLinks does result in updated category counts
        if (@old_cats) {
            $cat_lnk->delete({ LinkID => $id, CategoryID => \@old_cats });

# If the link has been modified from isValidated = No to Yes then the delete()
# from CatLinks will end up incorrectly decrementing the category count.  If
# this is the case, then the count needs to increment to comphensate for this
# bug.  This isn't !$was_counted && $now_counted because CatLinks delete
# currently does not take ExpiryDate into consideration.
            push @{$link_adjustment{1}}, @old_cats if $old_validated eq 'No' and $new_validated eq 'Yes';
        }

# The status hasn't changed: increment the new categories
        if ($was_counted and $now_counted) {
            push @{$link_adjustment{1}}, @new_cats if @new_cats;
        }
# It wasn't viewable, but is now: increment all the current categories
        elsif (not $was_counted and $now_counted) {
            push @{$link_adjustment{1}}, keys %cat_ids;
        }
# Was viewable, but now isn't: decrement all the current categories (except new ones)
        elsif ($was_counted and not $now_counted) {
# Don't decrement counts on new categories, since the addition of the link
# never incremented the count in the first place
            my %not_new = %cat_ids;
            for (@new_cats) {
                delete $not_new{$_};
            }
            push @{$link_adjustment{-1}}, keys %not_new;
        }
# Otherwise, it wasn't visible and still isn't, or it was visible but now
# isn't.  In both cases, the new categories don't need to be incremented.

# Actually adjust the link counts:
        $Category->link_count(\%link_adjustment);

        while (my ($change, $ids) = each %link_adjustment) {
            $Category->update({ Direct_Links => \("Direct_Links" . ($change > 0 ? ' + ' : ' - ') . abs $change) }, { ID => $ids });
        }

# If this link is now validated this link, let's update category counters and new flags.
# It also needs to be updated if a link has been added to new categories.
        if ((not $was_counted and $now_counted) or @new_cats) {
            foreach my $cat (keys %cat_ids) {
                my @cats = ($cat, @{$Category->parents($cat)});
                my $cond = GT::SQL::Condition->new(ID => '=', \@cats);
                if ($set->{isNew} eq 'Yes') {
                    $Category->update({ Has_New_Links => 'Yes' }, $cond, { GT_SQL_SKIP_CHECK => 1, GT_SQL_SKIP_INDEX => 1 });
                }
                $cond->add('Newest_Link', '<', $set->{Add_Date});
                $Category->update({ Newest_Link => $set->{Add_Date} }, $cond, { GT_SQL_SKIP_CHECK => 1, GT_SQL_SKIP_INDEX => 1 });
            }
        }

# Update the category timestamps to let people know that the page has changed.
        $Category->update({ Timestmp => \"NOW()" }, { ID => [keys %cat_ids, @old_cats] }, { GT_SQL_SKIP_CHECK => 1, GT_SQL_SKIP_INDEX => 1 });
    }
    return $ret;
}

sub update {
# -------------------------------------------------------------------
# Update a link.
#
    my ($self, $set, $where) = @_;

    my $ret = $self->SUPER::update($set, $where);

# Update the Category Timestmp of links which have certain columns updated
    for (split(/\s*,\s*/, $CFG->{links_cols_update_category})) {
        if (exists $set->{$_}) {
            my @cats = $DB->table('Links', 'CatLinks')->select('CategoryID', $where)->fetchall_list;
            $DB->table('Category')->update({ Timestmp => \'NOW()' }, { ID => \@cats });
            last;
        }
    }
    return $ret;
}

sub detailed_url {
# -----------------------------------------------------------------------------
# Takes one or more link ID's, returns one or more parsed detailed URL/paths in
# the same order and position the links were passed in, NOT prefixed with
# build_detail_url/build_detail_path.  If the ID passed in is actually a
# hashref, it is assumed that this hash ref includes a full set of Links and
# Category values for the link.
#
    my ($self, @ids) = @_;

    my (@links, @sel_links, $need_select);
    for (@ids) {
        if (ref) {
            push @links, $_;
            push @sel_links, undef;
        }
        else {
            push @links, undef;
            push @sel_links, $_;
            $need_select++;
        }
    }

    if ($need_select) {
        my %links_cols = %{$self->cols};
        # Only select Category columns that don't conflict with Links columns.
        my @cat_cols = grep !$links_cols{$_}, keys %{$DB->table('Category')->cols};

        my $rel = $DB->table(qw/Links CatLinks Category/);
        my %links = map { $_->{ID} => $_ } @{$rel->select(
            'Links.*', @cat_cols, 'CategoryID', { LinkID => [grep $_, @sel_links] }
        )->fetchall_hashref};

        for my $i (0 .. $#sel_links) {
            $links[$i] = $links{$sel_links[$i]} if $sel_links[$i];
        }
    }

    require Links::Tools;
    my $format;
    $format = $CFG->{build_detail_format} unless $IN->param('d');
    $format ||= '%ID%';
    $format .= '_%ID%' unless $format =~ /%ID%/;
    my @ret = $PLG->dispatch('detailed_url', sub {
        my ($format, @links) = @_;
        my @ret;
        for (@links) {
            my $parsed;
            if ($_) {
# Make Full_Name act the same for both category and detailed urls.  Set
# build_format_compat = 2 if you want the < 3.3 behaviour of coalesced _'s for
# Full_Name.
                if ($CFG->{build_format_compat} == 1) {
                    (my $fn = $_->{Full_Name}) =~ y|a-zA-Z0-9_/-|_|c;
                    $format =~ s/%Full_Name%/$fn/g;
                }

                $parsed = Links::Tools::parse_format(
                    $format,
                    %$_,
                    clean => 1
                );
                $parsed =~ s{(^|[/\\])index$}{${1}_index};
                $parsed .= $CFG->{build_extension};
            }
            push @ret, $parsed;
        }
        return @ret;
    }, $format, @links);
    return wantarray ? @ret : $ret[0];
}

sub category_detailed_url {
# -----------------------------------------------------------------------------
# A wrapper to detailed_url which will return url's which given a category id,
# will only return url's which take the category into consideration.  The only
# use for this is when a link is in multiple categories.
#
    my ($self, $cat_id, @ids) = @_;

    my %links_cols = %{$self->cols};
# Only select Category columns that don't conflict with Links columns.
    my @cat_cols = grep !$links_cols{$_}, keys %{$DB->table('Category')->cols};

    my @links;
    my $rel = $DB->table(qw/Links CatLinks Category/);
    for (@ids) {
        push @links, $rel->select('Links.*', @cat_cols, 'CategoryID', { LinkID => $_, CategoryID => $cat_id })->fetchrow_hashref;
    }
    my @ret = $self->detailed_url(@links);
    return wantarray ? @ret : $ret[0];
}

sub clean_category_ids {
# -------------------------------------------------------------------
# Takes an argument which could be a list of category names or ids
# and returns an array ref of ids.
#
    my ($self, $arg) = @_;
    my $cat = $DB->table('Category');

# Fix up Category Names => Id numbers and offer suggestions
# if name was not found.
    if (! ref $arg and $arg !~ /^\d*$/) {
        my @cat_names = split /\n\r?/, $arg;
        my @cat_ids   = ();
        foreach my $name (@cat_names) {
            $name =~ s/[\r\n]//g; # Textareas have a nasty habit of putting \r's on the results.
            my $id = ($name =~ /^\d+$/) ? $name : $cat->get_id_from_name($name);
            if ($id) {
                push(@cat_ids, $id);
            }
            else {
                my $names = $cat->suggestions($name);
                return $self->error(@$names
                    ? ('BADCATSUG', 'WARN', "<ul>" . join('', map "<li>$_</li>", @$names) . "</ul>")
                    : ('BADCATEGORY', 'WARN', $name)
                );
            }
        }
        return \@cat_ids;
    }
# We assume that if ID numbers are passed in, that they will
# be correct. This will get checked anyways by GT::SQL::Table,
# so no point doing it twice.
    else {
        my @ids = ref $arg ? @$arg : ($arg);
        return \@ids;
    }
}

sub get_categories {
# -------------------------------------------------------------------
# Takes a link id and returns a hash of category id => category name.
#
    my $self = shift;
    my $id   = shift;
    my $db   = $DB->table('Category', 'CatLinks');
    my $sth  = $db->select( { 'CatLinks.LinkID' => $id }, [ 'Category.ID', 'Category.Full_Name' ] );
    my %res  = ();
    while (my ($id, $name) = $sth->fetchrow_array) {
        $res{$id} = $name;
    }
    return \%res;
}

sub set_date_flags {
# -------------------------------------------------------------------
# Takes a link hash ref and sets the date flags properly.
#
    my ($self, $p) = @_;

    Links::init_date();
    my $today = GT::Date::date_get();
    if (GT::Date::date_diff($today, $p->{Add_Date}) <= $CFG->{build_new_cutoff}) {
        $p->{isNew} = 'Yes';
        $p->{isChanged} = 'No';
    }
    elsif (GT::Date::date_diff($today, $p->{Mod_Date}) <= $CFG->{build_new_cutoff}) {
        $p->{isChanged} = 'Yes';
        $p->{isNew} = 'No';
    }
    else {
        $p->{isNew} = 'No';
        $p->{isChanged} = 'No';
    }

# Possible ExpiryDate values that have to be handled here:
#       -1 (unpaid link) - leave it as is, does not need to be converted
#       \d (unixtime) - leave it as is, does not need to be converted
#       >=\d (doesn't actually occur here, but in _query) - leave it as is, does not need to be converted
#       YYYY-MM-DD
#       YYYY/MM/DD
#       YYYY/MM/DD HH::MM::SS
# The purpose of this bit of code is to convert any human readable dates into
# unixtime and leave everything else as is.
    if ($p->{ExpiryDate} and $p->{ExpiryDate} !~ /^\s*-?\d+\s*$/) {
        my $converted = Links::date_to_time($p->{ExpiryDate});
        $p->{ExpiryDate} = $converted if defined $converted;
    }
}

sub add_reviews {
# -------------------------------------------------------------------
# Adds review information, but passes through the plugin system.
#
    my ($self, $link) = @_;
    $PLG->dispatch('add_reviews', sub { return $self->_plg_add_reviews(@_) }, $link);
}

sub _plg_add_reviews {
# -------------------------------------------------------------------
# Adds review information to an array ref of hash refs of links passed in
# in one query.
#
    my $self      = shift;
    my $links     = shift;
    if (ref $links eq 'HASH') {
        $links = [ $links ];
    }
    my $review_db = $DB->table('Reviews');
    my @ids       = map { $_->{ID} } @$links;
    return unless (@ids);

    my $sth = $review_db->select({ Review_Validated => 'Yes' }, { Review_LinkID => \@ids });
    my %reviews;
    my %review_count;
    while (my $review = $sth->fetchrow_hashref) {
        push @{$reviews{$review->{Review_LinkID}}}, $review;
        $review_count{$review->{Review_LinkID}}++;
    }
    for my $link (@$links) {
        $link->{Review_Count} = $review_count{$link->{ID}};
        $link->{Review_Loop}  = $reviews{$link->{ID}};
    }
    return $links;
}

1;
