#!/usr/bin/perl -w
############################################################################
#This will be my second attempt at writing a .html text
#database search script. Much for the following is owed to
#the authors and contributors to the Webpage search protocol
#Webglimpse, by Michael Smith, which was used as a starting
#point for this program. Without it I don't think I could have
#ever gotten this thing to work (these lines said in hopeful
#anticipation).
#
#This program is brought to you by the letters G and L and I and M and P
#and S and E. =)
############################################################################
#/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\#
############################################################################
# **** Global Varriables ****
# **** Default Settings ****
############################################################################
# **** System Configuration *****
############################################################################
#Tells the search where everything is at.
$glimpse_loc = "/usr/local/bin/glimpse";
$index_loc = "/home/hep/drschuet/public_html";
$cgi_url = "http://hep.uchicago.edu/cgi-bin";
$web_base = "http://hep.uchicago.edu/~drschuet/public_html";
$dir_base = "/home/hep/drschuet/public_html";
############################################################################
# **** No More Configuration Needed ****
# **** Below this line ****
############################################################################
#According to those who know greater things glimpse will sometimes need
#to evoke system programs such as cat, sort, mv, and what not. Hence we
#need to set up a path so it can find them.
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
#Here we set the defaults values for the user inputs (yes I am borrowing a
#lot here from Michael Smith's webglimpse).
$query = ' ';
$qs_case = ' '; # Case sensitive when 'on'.
$qs_errors = ' '; # Number of spelling errors allowed in a match.
$qs_query = ' '; # The actual search querry.
$qs_whole = ' '; # Whole or partial word search.
$opt_case = "-i";
$opt_errors = ' ';
$opt_whole = ' ';
#It appears that as glimpse is indexing a direcotry it creates a file called
#indexing in process. Since a query cannot be run while an index is being
#constructed we need a way to lock out query attempts during indexing.
$lockfile = "indexing-in-progress";
$rslts_a = ' ';
$rslts_b = "\n";
############################################################################
#/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\#
############################################################################
# **** The Program ****
############################################################################
$| = 1;
#Initial response to server.
print "Content-type: text/html\n\n";
print "\n";
print "\n";
#Unsuprisingly we shall take the same approach as webglimpse and use this#
#cgi to construct a page for retrieval by the client using the GET method.#
#Thus we first need to results of the clients querry. Since the method we#
#are using is GET these results we recieve are sent in the QUERY_STRING#
#portion of the ENV our cgi recieves from the server. Here we get the#
#results if they exist or run the error no query subroutine if they do not.#
($query = $ENV{'QUERY_STRING'}) or &err_noquery ;
#These results are currently encoded in a nasty URL encoding. query is now#
#a set of namevalue pairs in string form each pair seperated from the#
#others by an and all non alphaneumeric characters have been replaced#
#by their hexadecimal equivilnts. So we need to break up the $query string#
#into namevalue pairs and the divide these namevalue pairs into the name#
#value elements appending a qs_ to the name element to make referencing#
#easier decode the code then set the name and varriable again equal to#
#each other though this time not as a string.#
foreach $bitowork (split (m/\&/, $query)) {
$bitoname = '';
$bitovalue = '';
($bitoname, $bitovalue) = (split( m/=/, $bitowork));
#Run a subroutine to decode the URL encoding.#
$bitovalue = url_decoding($bitovalue);
$bitoname = url_decoding($bitoname);
#Anouther bit of code whose purpose I am a little unsure of.#
#I belive that it ensures that the line contains only#
#certian acceptible characters, some sort of security.#
if ($bitoname =~ /^[a-zA-Z0-9_]*$/ ) {
$varname = "qs_$bitoname";
$$varname = "$bitovalue";
}
}
#Make sure that glimpse isn't running an index.
if (-e "$index_loc/$lockfile"){
&err_locked;
}
#Check to make sure that glimpse is on the machine.#
-x $glimpse_loc || &err_noglimpse($glimpse_loc);
#Check to make sure that the index is available.
#-r "$index_loc/.glimpse_index" || &err_noindex($index_loc);
#Now we use these new variables to construct the users options.
$opt_errors = "-$qs_errors" if $qs_errors =~ /^[0-8]$/;
$opt_case = " " if $qs_case =~ /^on$/;
$opt_whole = "-w" unless $qs_whole =~ /^on$/;
#Here is where we prepare the query before we give it to glimpse. We need
#to remove the everything which is not a word and replace it with a |;
#except where the query begins with something which is not a word then we
#must remove but not replace that non-word.
$prepared_query = prepare_query($qs_query);
#Check to make sure that the query is not empty.
if (!(defined($prepared_query))) {
&err_badquery;
}
#$prepared_query = '\b(' . $prepared_query . ')\b' if opt_whole;
#Here's where the real work occurs. We define the command for glimpse
#and then hopefully get glimpse to run. Yet anouther result of
#Webglimpses inspirational tutoring.
$cmd = "glimpse -l -O -y -H $index_loc $opt_case $opt_whole $opt_errors"
. " \'$prepared_query\' > tmp_srch_rslts";
`$cmd`;
#print "
-*- Glimpse command: $cmd -*-
\n";
#Open the termprary results search file as OUTLAND
if (!(open OUTLAND, "tmp_srch_rslts")) {
print "
Danger, Will Robinson. Danger!
";
&err_noglimpse;
}
#Check the return code
$rc = $? >> 8;
if ($rc!=0) {
&err_badglimpse();
}
#If it gets to this point it should be working. . .
#We begin our response now.
$rslts_a .= "Results for query \"$qs_query\"\n";
$rslts_a .= "\n";
$rslts_a .= "\n\n";
$rslts_a .= "\n";
$rslts_a .= "
\n";
$rslts_a .= "Results for query \`\`$qs_query\'\'\n";
$rslts_a .= "
\n\n";
#Now we want to take this and use it to construct the final part of our
#web.
$rslts_b .= " \n \n \n";
#Publish a.
print "$rslts_a";
#Publish b.
print "$rslts_b";
#Put away all our toys.
close(OUTLAND);
`rm tmp_srch_rslts`;
############################################################################
#/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\#
############################################################################
# <--> Subroutines <-->
############################################################################
#The script was called without a query.
sub err_noquery {
print "No Querry\n";
print "\n\n";
print "\n";
print "