360 lines
14 KiB
Perl
360 lines
14 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: Search.pm,v 1.48 2006/08/08 23:30:09 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::User::Search;
|
|
# ==================================================================
|
|
use strict;
|
|
use Links qw/:objects/;
|
|
use Links::SiteHTML;
|
|
use Links::Build;
|
|
|
|
my $time_hires;
|
|
|
|
sub handle {
|
|
#--------------------------------------------------------------------------------
|
|
# Determine whether we are displaying the search form, or doing a
|
|
# search.
|
|
#
|
|
my $db = $DB->table('Links');
|
|
my $results = {};
|
|
my $args = $IN->get_hash;
|
|
|
|
# Remove search fields we aren't allowed to search on.
|
|
my @bad = (@{$CFG->{search_blocked}}, qw/isValidated ExpiryDate/);
|
|
for my $col (@bad) {
|
|
$col =~ s/^\s*|\s*$//g;
|
|
if ($args->{$col}) {
|
|
delete $args->{$col};
|
|
$IN->delete($col);
|
|
}
|
|
for (qw(lt gt opt le ge ne)) {
|
|
delete $args->{"$col-$_"};
|
|
$IN->delete("$col-$_");
|
|
}
|
|
}
|
|
|
|
# If query is set we know we are searching.
|
|
return search() if defined $args->{query} and $args->{query} =~ /\S/;
|
|
|
|
# Otherwise, if we pass in a field name, we can search on that too.
|
|
foreach (keys %{$db->cols}) {
|
|
for my $opt ('', qw/-lt -gt -le -ge -ne/) {
|
|
return search() if defined $args->{"$_$opt"} and length $args->{"$_$opt"};
|
|
}
|
|
}
|
|
|
|
print $IN->header();
|
|
print Links::SiteHTML::display('search', { main_title_loop => Links::Build::build('title', Links::language('LINKS_SEARCH'), "$CFG->{db_cgi_url}/search.cgi") });
|
|
}
|
|
|
|
sub search {
|
|
# ------------------------------------------------------------------
|
|
# Do the search and print out the results.
|
|
#
|
|
my $results = $PLG->dispatch('search_results', \&query, {});
|
|
if (defined $results->{error}) {
|
|
print $IN->header();
|
|
$results->{main_title_loop} = Links::Build::build('title', Links::language('LINKS_SEARCH'), "$CFG->{db_cgi_url}/search.cgi");
|
|
print Links::SiteHTML::display('search', $results);
|
|
}
|
|
else {
|
|
print $IN->header();
|
|
$results->{main_title_loop} = Links::Build::build('title', Links::language('LINKS_SEARCH_RESULTS'), "$CFG->{db_cgi_url}/search.cgi");
|
|
print Links::SiteHTML::display('search_results', $results);
|
|
}
|
|
if ($CFG->{debug_level} > 1) {
|
|
print "<blockquote><pre>", GT::SQL->query_stack_disp , "</pre></blockquote>";
|
|
}
|
|
}
|
|
|
|
sub query {
|
|
# ------------------------------------------------------------------
|
|
# Query the database.
|
|
#
|
|
# First get our search options.
|
|
my $args = $IN->get_hash;
|
|
if ($args->{query}) {
|
|
$args->{query} =~ s/^\s+//;
|
|
$args->{query} =~ s/\s+$//;
|
|
}
|
|
$args->{bool} = (defined $args->{bool} and $args->{bool} =~ /^(and|or)$/i) ? uc $1 : $CFG->{search_bool};
|
|
$args->{nh} = (defined $args->{nh} and $args->{nh} =~ /^(\d+)$/) ? $1 : 1;
|
|
$args->{mh} = (defined $args->{mh} and $args->{mh} =~ /^\d+$/) ? $args->{mh} : $CFG->{search_maxhits};
|
|
$args->{mh} = 200 if $args->{mh} > 200; # Safety limit
|
|
$args->{substring} = defined $args->{substring} ? $args->{substring} : $CFG->{search_substring};
|
|
$args->{so} = (defined $args->{so} and $args->{so} =~ /^(asc|desc)$/i) ? $1 : '';
|
|
$args->{sb} and ($args->{sb} =~ /^[\w\s,]+$/ or ($args->{sb} = ''));
|
|
delete $args->{ma};
|
|
|
|
# Make sure we only search on validated links.
|
|
$args->{isValidated} = 'Yes';
|
|
$args->{ExpiryDate} = '>=' . time if $CFG->{payment}->{enabled};
|
|
|
|
my $query = $args->{query} || '';
|
|
my $term = $IN->escape($query);
|
|
|
|
my $links = $DB->table('Links');
|
|
my $categories = $DB->table('Category');
|
|
|
|
# We don't do a category search if we only have a filters.
|
|
my $filter = 0;
|
|
if (!defined $query or $query eq '') {
|
|
$filter = 1;
|
|
}
|
|
$args->{filter} = $filter;
|
|
|
|
# Note: if you use this or the search_set_link_callback, remember to $PLG->action(STOP) or your callback won't be used
|
|
$args->{callback} = $PLG->dispatch('search_set_cat_callback', sub { return \&_cat_search_subcat if shift }, $args->{catid});
|
|
my $orig_sb = $args->{sb};
|
|
my $orig_so = $args->{so};
|
|
$args->{sb} = $CFG->{build_sort_order_search_cat};
|
|
$args->{so} = '';
|
|
$filter and $args->{sb} =~ s/\s*,?\s*score//;
|
|
|
|
my $started;
|
|
if (length $query and $CFG->{search_logging} and $args->{nh} == 1) {
|
|
if (!defined $time_hires) {
|
|
$time_hires = eval { require Time::HiRes } || 0;
|
|
}
|
|
$started = $time_hires ? Time::HiRes::time() : time;
|
|
}
|
|
|
|
my $cat_sth;
|
|
$cat_sth = $categories->query_sth($args) unless $filter;
|
|
my $cat_count = $filter ? 0 : $categories->hits();
|
|
|
|
$args->{callback} = $PLG->dispatch('search_set_link_callback', sub { return \&_search_subcat if shift }, $args->{catid});
|
|
$args->{sb} = $orig_sb ? $orig_sb : $CFG->{build_sort_order_search} || '';
|
|
$args->{so} = (defined $orig_so and $orig_so =~ /^(asc|desc)$/i) ? $1 : 'ASC';
|
|
$filter and $args->{sb} =~ s/\s*,?\s*score//;
|
|
|
|
# Don't force sorting by whether or not a link is paid, as that would make
|
|
# searching almost useless w.r.t. unpaid links since a 1% paid match would be
|
|
# higher than a 99% unpaid match.
|
|
|
|
my $link_sth = $links->query_sth($args);
|
|
my $link_count = $links->hits;
|
|
|
|
# Log the search if it's a new query
|
|
if (length $query and $CFG->{search_logging} and $args->{nh} == 1) {
|
|
my $elapsed = ($time_hires ? Time::HiRes::time() : time) - $started;
|
|
my $results = $link_count || 0;
|
|
my $sl = $DB->table('SearchLogs');
|
|
my $q = lc $query;
|
|
substr($q, 255) = '' if length $q > 255;
|
|
if (my $row = $sl->select({ slog_query => $q })->fetchrow_hashref) {
|
|
my $slog_time = defined $row->{slog_time}
|
|
? ($row->{slog_time} * $row->{slog_count} + $elapsed) / ($row->{slog_count} + 1)
|
|
: $elapsed;
|
|
$sl->update({
|
|
slog_count => $row->{slog_count} + 1,
|
|
slog_time => sprintf('%.6f', $slog_time),
|
|
slog_last => time,
|
|
slog_hits => $results
|
|
}, {
|
|
slog_query => $q
|
|
});
|
|
}
|
|
else {
|
|
$sl->insert({
|
|
slog_query => $q,
|
|
slog_count => 1,
|
|
slog_time => sprintf('%.6f', $elapsed),
|
|
slog_last => time,
|
|
slog_hits => $results
|
|
}) or die "$GT::SQL::error";
|
|
}
|
|
}
|
|
|
|
# Return if no results.
|
|
unless ($link_count or $cat_count) {
|
|
return { error => Links::language('SEARCH_NOLINKS', $term), term => $term };
|
|
}
|
|
|
|
# Now format the category results.
|
|
my $count = 0;
|
|
my ($category_results, @category_results_loop);
|
|
if (!$filter and $cat_count) {
|
|
while (my $cat = $cat_sth->fetchrow_hashref) {
|
|
last if ($count++ > $args->{mh});
|
|
my $title = Links::Build::build('title_linked', { name => $cat->{Full_Name}, complete => 1, home => 0 });
|
|
$category_results .= "<li>$title\n";
|
|
$cat->{title_linked} = $title;
|
|
$cat->{title_loop} = Links::Build::build('title', $cat->{Full_Name});
|
|
push @category_results_loop, $cat;
|
|
}
|
|
}
|
|
|
|
# And format the link results.
|
|
my (@link_results_loop, $link_results, %link_output);
|
|
if ($link_count) {
|
|
my $results = $link_sth->fetchall_hashref;
|
|
$links->add_reviews($results);
|
|
@link_results_loop = map Links::SiteHTML::tags('link', $_) => @$results unless $CFG->{build_search_gb};
|
|
if ($CFG->{build_search_gb}) {
|
|
my @ids = map { $_->{ID} } @$results;
|
|
my $catlink = $DB->table('CatLinks','Category');
|
|
my %names = $catlink->select('LinkID', 'Full_Name', { LinkID => \@ids })->fetchall_list;
|
|
foreach my $link (@$results) {
|
|
push @{$link_output{$names{$link->{ID}}}}, Links::SiteHTML::tags('link', $link);
|
|
}
|
|
}
|
|
}
|
|
|
|
# Join the link results by category if we are grouping.
|
|
if ($CFG->{build_search_gb}) {
|
|
foreach my $cat (sort keys %link_output) {
|
|
$link_output{$cat}->[0]->{title_linked} = sub { Links::Build::build('title_linked', { name => $cat, complete => 1, home => 0 }) };
|
|
$link_output{$cat}->[0]->{title_loop} = Links::Build::build('title', $cat);
|
|
push @link_results_loop, @{$link_output{$cat}};
|
|
}
|
|
}
|
|
$link_results = sub {
|
|
my $links;
|
|
$CFG->{build_search_gb} or return join("", map { Links::SiteHTML::display('link', $_) } @link_results_loop);
|
|
foreach my $cat (sort keys %link_output) {
|
|
my $title = Links::Build::build('title_linked', { name => $cat, complete => 1, home => 0 });
|
|
$links .= "<p>$title" . join("", map { Links::SiteHTML::display('link', $_) } @{$link_output{$cat}});
|
|
}
|
|
return $links;
|
|
};
|
|
|
|
# Generate a toolbar if requested.
|
|
my ($toolbar, %paging);
|
|
if ($link_count > $args->{mh} or $cat_count > $args->{mh}) {
|
|
my $url = $CFG->{db_cgi_url} . "/" . $IN->url;
|
|
$url =~ s/([;&?]?)nh=(\d+)/($1 and $1 eq '?') ? '?' : ''/eg;
|
|
$toolbar = Links::Build::build(search_toolbar => {
|
|
url => $url,
|
|
numlinks => $link_count > $cat_count ? $link_count : $cat_count,
|
|
nh => $args->{nh},
|
|
mh => $args->{mh}
|
|
});
|
|
%paging = (
|
|
url => $url,
|
|
num_hits => $link_count > $cat_count ? $link_count : $cat_count,
|
|
max_hits => $args->{mh},
|
|
current_page => $args->{nh}
|
|
);
|
|
}
|
|
else {
|
|
$toolbar = '';
|
|
}
|
|
|
|
# Print the output.
|
|
my $results = {
|
|
link_results => $link_results,
|
|
link_results_loop => \@link_results_loop,
|
|
category_results => $category_results,
|
|
category_results_loop => \@category_results_loop,
|
|
link_hits => $link_count,
|
|
cat_hits => $cat_count,
|
|
next => $toolbar,
|
|
paging => \%paging,
|
|
term => $term,
|
|
highlight => $CFG->{search_highlighting}
|
|
};
|
|
return $results;
|
|
}
|
|
|
|
sub _search_subcat {
|
|
# -------------------------------------------------------------------
|
|
# First argument is the query/table object, second argument is the current
|
|
# result set (note: can be quite large). Must return a new result set.
|
|
#
|
|
my ($query, $results) = @_;
|
|
return $results unless (keys %$results); # No matches.
|
|
|
|
my $cat_db = $DB->table('Category');
|
|
my $catlink_db = $DB->table('CatLinks', 'Category');
|
|
|
|
# We need the full name of the category.
|
|
my @cat_ids = $IN->param('catid') or return $results;
|
|
my (@children, %seen);
|
|
foreach my $id (@cat_ids) {
|
|
next if ($id !~ /^\d+$/);
|
|
my $child = $cat_db->children($id) or next;
|
|
push @children, @$child, $id;
|
|
}
|
|
@children or return $results;
|
|
@children = grep !$seen{$_}++, @children;
|
|
|
|
# Now do the joined query.
|
|
my %filtered = map { $_ => $results->{$_} }
|
|
$catlink_db->select(LinkID => { CategoryID => \@children, LinkID => [keys %$results] })->fetchall_list;
|
|
|
|
return \%filtered;
|
|
}
|
|
|
|
sub _search_subcat_and {
|
|
# -------------------------------------------------------------------
|
|
# Search subcategories using AND.
|
|
#
|
|
my ($query, $results) = @_;
|
|
return $results unless (keys %$results); # No matches
|
|
|
|
my $cat_db = $DB->table('Category');
|
|
my $catlink_db = $DB->table('CatLinks', 'Category');
|
|
|
|
# We need the full name of the category.
|
|
my @cat_ids = $IN->param('catid') or return $results;
|
|
my %final = %$results;
|
|
foreach my $id (@cat_ids) {
|
|
next unless ($id =~ /^\d+$/);
|
|
my @children;
|
|
my $childs = $cat_db->children($id);
|
|
push @children, @$childs, $id;
|
|
my $cond = GT::SQL::Condition->new(
|
|
CategoryID => 'IN' => \@children,
|
|
LinkID => 'IN' => [ keys %final ]
|
|
);
|
|
%final = ();
|
|
my $sth = $catlink_db->select($cond, ['LinkID']);
|
|
while (my $link_id = $sth->fetchrow_array) {
|
|
$final{$link_id} = $results->{$link_id};
|
|
}
|
|
last unless keys %final;
|
|
}
|
|
return \%final;
|
|
}
|
|
|
|
sub _cat_search_subcat {
|
|
# -------------------------------------------------------------------
|
|
# First argument is the query/table object, second argument is the current
|
|
# result set (note: can be quite large). Must return a new result set.
|
|
#
|
|
my ($query, $results) = @_;
|
|
return $results unless (keys %$results); # No matches.
|
|
|
|
my $cat_db = $DB->table('Category');
|
|
my @cat_ids = $IN->param('catid') or return $results;
|
|
my (@children, %seen);
|
|
foreach my $id (@cat_ids) {
|
|
next if ($id !~ /^\d+$/);
|
|
my $child = $cat_db->children($id) or next;
|
|
push @children, @$child, $id;
|
|
}
|
|
@children or return $results;
|
|
@children = grep { ! $seen{$_}++ } @children;
|
|
|
|
my %subcats = map { $_ => 1 } @children;
|
|
my $filtered = {};
|
|
while (my ($k, $s) = each %$results) {
|
|
$filtered->{$k} = $s if (exists $subcats{$k});
|
|
}
|
|
return $filtered;
|
|
}
|
|
|
|
1;
|
|
|