#!/usr/bin/perl -w
# Example front-end CGI script for Sherlock
# Written by Martin Mares <mj@ucw.cz> and declared public domain
use strict;
use warnings;
use lib 'lib/perl5';
use Sherlock::Query();
use Sherlock::CGI;
# Options (parsed by the CGI module)
my $query; # User's query
my $magic; # Magic debugging switch
my $show_first; # First item to show
my $how_many; # How many items to show
my %option_table = (
'query' => { 'var' => \$query },
'magic' => { 'var' => \$magic, 'check' => '\d+', 'default' => 0 },
'first' => { 'var' => \$show_first, 'check' => '\d+', 'default' => 1 },
'count' => { 'var' => \$how_many, 'check' => '\d+', 'default' => 10 }
);
# Prototypes of functions
sub page_top();
sub page_bottom();
sub page_error($);
sub page_result_top($);
sub page_result_card($$);
sub page_result_bottom($);
sub construct_query();
# The heart of the script
print "Content-type: text/html\n\n";
Sherlock::CGI::parse_args(\%option_table);
page_top();
if ($query ne "") {
my $full_query = construct_query();
print "<h3>Sending query:</h3><p><code>", html_escape($full_query), "</code>\n" if $magic;
my $q = new Sherlock::Query('localhost:8195');
my $res = $full_query ? $q->query($full_query) : "-999 Bad query syntax";
if ($res =~ /^-/) {
page_error($res);
} else {
page_result_top($q);
foreach my $c (@{$q->{CARDS}}) {
page_result_card($q, $c);
}
page_result_bottom($q);
}
}
page_bottom();
exit 0;
# Print page header, style sheet and pre-filled query form
sub page_top() {
print <<EOF
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html40/loose.dtd">
<html><head>
<title>BeautySalons.com - $query</title>
<LINK HREF="../scrap.css" REL="stylesheet" TYPE="text/css">
</head><body>
<TABLE WIDTH="100%" BORDER="0" CELLPADDING="0" CELLSPACING="0" BGCOLOR="#F22D4D">
<TR>
<TD WIDTH="243"><A HREF="http://www.beautysalons.com"><IMG SRC="../images/beautysalons-logo.gif" WIDTH="243" HEIGHT="126" BORDER="0"></TD>
<TD><CENTER></CENTER></TD>
<TD WIDTH="110"><A HREF="http://www.beautysalons.com/ultimate/ultimate.html"><IMG SRC="http://beautysalons.com/images/ui.jpg" WIDTH="105" HEIGHT="94" BORDER="0" align="right"></A></center></TD>
</TR>
</TABLE>
<TABLE WIDTH="100%" HEIGHT="1" BORDER="0" CELLPADDING="0" CELLSPACING="0" BGCOLOR="#666666">
<TR>
<TD><IMG SRC="images/spacer.gif" WIDTH="1" HEIGHT="1"></TD>
</TR>
</TABLE>
<!--start results-->
<TABLE WIDTH= "100%" CLASS="results" BORDER="1" ALIGN="CENTER"><TR><TD valign="top">
<br><center><form action="http://www.beautysalons.com
/search/salons.cgi">
EOF
;
print "<p><b>Search:</b> <input name=query type=text maxlength=256 SIZE= 45 value='", html_escape($query), "'>\n";
print self_form('query' => undef, 'first' => undef);
print "<input type=submit value= search></form></center><br>\n";
}
# Print page footer
sub page_bottom() {
print <<EOF
</html>
EOF
;
}
# Print search server error message
sub page_error($) {
my ($err) = @_;
my ($code,$msg) = $err =~ /^-(\d+)\s+(.*)/;
print "<h2>Error: $msg</h2>\n";
}
# Print debugging output if requested
sub debug($$$) {
my ($q, $what, $title) = @_;
if ($magic) {
print "<h3>$title</h3>" if $title;
print "<pre>\n";
$q->format(sub { print html_escape($_[0]); }, $what);
print "</pre>\n";
}
}
# Print header of query results
sub page_result_top($) {
my ($q) = @_;
my $hdr = $q->{HEADER};
debug($q, $hdr, "Response header:");
my $ftr = $q->{FOOTER};
debug($q, $ftr, "Response footer:");
my $db = ${$hdr->{'(D'}}[0]; # expecting a single database
print "<p><b>We Found ", $db->{'T'}, " documents in ", $ftr->{'t'}/1000, "s. For - <font color=red> <u>", html_escape($query), "</u></font></b>\n";
print "<ol start=$show_first>\n";
}
# find meta-information tagged with a given tag
sub find_meta($$) {
my ($c, $meta) = @_;
foreach my $m (@{$c->{'M'}}) {
return $m if $m =~ /$meta/;
}
return "";
}
# format text snippet
sub format_snippet($) {
my ($snip) = @_;
$snip =~ s/<(\/?)([^>]*)>/
"$1$2" eq "\/block" ? " ... " :
$2 eq "best" ? "<$1b>" :
$2 eq "found" ? "<$1b>" :
""
/ge;
$snip =~ s/\s+\.\.\.\s*$//;
$snip =~ s/\s\s+/ /g;
return $snip;
}
# Print a single card of result
sub page_result_card($$) {
my ($q, $c) = @_;
my $url = ${$c->{'(U'}}[0]; # use only the first URL block, ignore the rest
my $URL = html_escape($url->{'U'}); # the URL itself, HTML-escaped
my $title = find_meta($c, '<title>'); # page title (if any)
print "<li><strong><a href='$URL'>", $title ne "" ? format_snippet($title) : $URL, "</strong></a>\n";
if (@{$c->{'X'}}) { # context (if any)
print "<br>";
print format_snippet(join(" ", @{$c->{'X'}}));
print "\n";
}
print "<br><a href='$URL'>$URL</a>"; # URL
print " , Document Size: ", $url->{'s'}, " bytes"; # size
print ", Type: ", $url->{'T'}; # content-type
print " (", $url->{'c'}, ")" if defined $url->{'c'}; # content-type and charset
#print ", Q=", $c->{'Q'}, "\n"; # quality
print "<br><br>"; # URL
debug($q, $c, "");
}
# Print footer of query results
sub page_result_bottom($) {
my ($q) = @_;
print "</ol>\n";
# navigation buttons
print "<p> <!--end resluts-->";
my $num_replies = $q->{HEADER}->{'N'};
print "<center>";
print "<a href='", self_ref('first' => $show_first-$how_many), "'><font size=4> [Prev] </h1></font>\n" if $show_first > $how_many;
print "<a href='", self_ref('first' => $show_first+$how_many), "'><font size=4> [Next] <h1></font>\n" if $show_first+$how_many <= $num_replies;
#print "<a href='", self_ref('magic' => 1), "'>Debug</a>\n" if !$magic;
#print "<a href='", self_ref('magic' => 0), "'>bugeD</a>\n" if $magic;
print "</center>";
print "<br><br></TD><TD width=200 align=center valign=TOP>";
print "<script>\n";
print "listings = new Array ();\n";
print "</script>\n";
print "<script src=\"http://www.searchfeed.com/rd/feed/JavaScriptFeed.jsp?cat=$query&trackID=F2326158308&pID=8062&nl=5&excID=\"></script>\n";
print "<script>\n";
print "if (listings != null && listings.length > 0) {\n";
print "document.write(\"<table border=0 cellpadding=4 cellspacing=0 width=100%>\");\n";
print "document.write(\"<tr><td colspan=3><img src='http://www.searchfeed.com/rd/Images/pixel.gif' height=4></td></tr>\");\n";
print "document.write(\"<tr>\");\n";
print "document.write(\"<td><img src='http://www.searchfeed.com/rd/Images/pixel.gif' width=4></td>\");\n";
print "\n";
print "document.write(\"<td width='100%' BGCOLOR=#EDFDF7>\");\n";
print "document.write(\"<center><b><u>Sponsored Listings</u></b></center><br>\");\n";
print "for (i = 0; i < listings.length; i++) {\n";
print "var title = listings[i].title;\n";
print "if (listings[i].title.length > 150)\n";
print "title = listings[i].title.substring(0, 150) + \"...\";\n";
print "\n";
print "document.write(\"<a href='\" + listings[i].uri +\"'><font face='verdana,sans-serif' size='2'>\" + title + \"</font></a><br>\");\n";
print "\n";
print "\n";
print "var desc = listings[i].description;\n";
print "if (listings[i].description.length > 550)\n";
print "desc = listings[i].description.substring(0, 550) + \"...\";\n";
print "document.write(\"<font face='verdana,sans-serif' size='1'> \" + desc + \"</font><br>\");\n";
print "\n";
print "\n";
print "\n";
print "\n";
print "if (i < listings.length-1)\n";
print "document.write(\"<br>\");\n";
print "}\n";
print "document.write(\"</td>\");\n";
print "document.write(\"<td><img src='http://www.searchfeed.com/rd/Images/pixel.gif' width=1 height=1></td>\");\n";
print "document.write(\"</tr>\");\n";
print "document.write(\"<tr><td colspan=3><img src='http://www.searchfeed.com/rd/Images/pixel.gif' height=4></td></tr>\");\n";
print "document.write(\"</table>\");\n";
print "}\n";
print "</script>\n";
print "</TD></TR></TABLE>";
}
# Transform user input to full query (see doc/search for syntax)
sub construct_query() {
my $qry = "SHOW $show_first.." . ($show_first+$how_many-1) . " ";
if ($query =~ /^\s*\?\s*(.*)/) {
# "?" starts advanced queries
$qry .= $1;
} else {
# Transform simple query to advanced query
my @adv = ();
$_ = $query;
while (/^\s*(\+|-)?(("[^"]*")|[^" ]+)(.*)/) {
$_ = $4;
push @adv, ($1 ? ($1 eq "+" ? "" : "NOT ") : "MAYBE ") .
($3 ? $3 : "\"$2\"");
}
if (!/^\s*$/) { return undef; }
$qry .= join(" . ", @adv);
}
return $qry;
}