First pass at adding key files
This commit is contained in:
dsainty
359
site/slowtwitch.com/cgi-bin/articles/admin/Links/User/Search.pm
Normal file
359
site/slowtwitch.com/cgi-bin/articles/admin/Links/User/Search.pm
Normal file
@ -0,0 +1,359 @@
|
||||
# ==================================================================
|
||||
# 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;
|
||||
|
||||
Reference in New Issue
Block a user