631 lines
24 KiB
Perl
631 lines
24 KiB
Perl
# ==================================================================
|
|
# 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;
|