#!/usr/local/bin/perl
#/usr/local/bin/perl
#
# ice-form.pl -- cgi compliant ICE search interface // Oct 12 1995
#
# (C) Christian Neuss 1995 (neuss@isa.informatik.th-darmstadt.de)
#--- start of configuration --- put your changes here ---
# Title or name of your server:
# Example: local($title)="ICE Indexing Gateway";
local($title)="Priory Lodge Education Search Engine";
# search directories to present in the search dialogue
# Example:
# local(@directories)=(
# "Image Communication Information Board (/icib)",
# "WISE (/some/where/wise)"
# );
# Original code commented out KHT
#local(@directories)=(
# "Image Communication Information Board (/icib)",
# "WISE (/www/projects/wise)",
# "Multimedia Survey (/www/projects/mms)",
# "Department A2 (/www/igd-a2)",
# "Department A8 (/www/igd-a8)",
# "Department A9 (/www/igd-a9)",
# "DZSIM (/www/projects/dzsim)",
# "CSCW Laboratory (/www/projects/cscw-lab)",
# "Software Catalog (/www/projects/sw-catalog)",
# "WWW-Schulung (/www/igd-a3/schulung)",
# "DZSIM (/www/projects/dzsim)",
# "ZGDV User Interface GROUP (/www/zgdv-uig)"
#);
local(@directories)=("");
# Location of the indexfile:
# Example: $indexfile="/usr/local/etc/httpd/index/index.idx";
$indexfile="../cgi-out/index.idx";
# Location of the thesaurus data file:
# Example: $thesfile="/igd/a3/home1/neuss/Perl/thes.dat";
$thesfile="../cgi-out/thes.dat";
# URL Mappings (a.k.a Aliases) that your server does
# map "/" to some path to reflect a "document root"
# Example
# %urltopath = (
# '/projects', '/usr/stud/proj',
# '/people', '/usr3/webstuff/staff',
# '/', '/usr3/webstuff/documents',
# );
#
#%urltopath = ('/journals', '/users/ad88',);
%urltopath = (
'/', '/'
);
#--- end of configuration --- don't change anything below ---
# if this script is called up "by hand", run a test
unless($ENV{"SCRIPT_NAME"}){
local($word) = ($#ARGV==-1) ? "the" : $ARGV[0] ;
print "You have called the Priory forms interface manually.\n";
print "Optionally, provide search word as an argument.\n";
print "Test mode: search for \"$word\"\n";
print "--------\n";
$orig="$word @ /";
$foo=&getquery($orig);
print $foo;
exit;
}
# do the real work, but trap any errors
eval '&main';
# if an error has occured, log it to stdout
if($@){
&send_header("Error in Script"); # just in case
print "$@\n
";
}
# print the CGI script header
sub send_header {
local($title)=@_;
print "Content-type: text/html\n\n";
print "\n", $title,"\n\n";
print "
\n";
print "
$title
\n";
print "
\n";
}
# display the Forms interface
#
Don't Show documents older than
# days,
# leave this empty to get all documents available.
sub send_index {
local($scriptname) = $ENV{"SCRIPT_NAME"};
print "
This is a version of the
ICE search engine
END
}
# parse data from CGI request and store it as name/value pairs
sub cgiparse {
if ($ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
} else {
$buffer = $ENV{'QUERY_STRING'};
}
local(@query_strings) = split("&", $buffer);
foreach $q (@query_strings) {
$q =~ s/\+/ /g;
($attr, $val) = split("=", $q);
$val =~ s/%/\n%/g;
local($tmpval);
foreach (split("\n",$val)){
if(m:%(\w\w):){
local($binval) = hex($1);
if(($binval>0)&&($binval<256)){
local($htmlval) = pack("C",$binval);
s/%$1/$htmlval/;
}
}
$tmpval .= $_;
}
$forms{$attr} = $tmpval;
}
%forms;
}
sub main {
# if content_length is zero and query string is empty
if (($ENV{CONTENT_LENGTH}==0) &&
(length($ENV{"QUERY_STRING"})==0)){
# we're not decoding a form yet => send the form
&send_header("$title");
&send_index();
return;
}
&send_header("$title Search Result");
# parse forms result and store it in an associative array
%forms=&cgiparse();
$pquery = $query = $forms{KEYWORDS};
$context = $forms{CONTEXT};
$context = $forms{CONTEXT};
if($context =~ m:\(([^)]*)\):) {
$context=$1;
}else{
$context="";
}
$thesaurus = $forms{THESAURUS};
$substring = $forms{SUBSTRING};
$days = $forms{DAYS};
if(length($days)>0){
$pquery.=" -D $days";
}
if(length($thesaurus)>0){
$pquery.=" -T";
}
if(length($substring)>0){
$pquery.=" -S";
}
if(length($context)>0){
$pquery.=" @ $context";
}
###print "query $pquery\n";
($err,$page) = &getquery($pquery);
if($err){
print "Query was: $query \n";
print "Problem: $err\n";
print "";
return undef;
}
print "Preferences set for this query:\n";
print "
\n";
if ($query) {
print "
query was \"$query\"\n";
}
if($context){
print "
context was set to $context.\n";
}
if($thesaurus){
print "
use of thesaurus turned on\n";
}
if($substring){
print "
![](\"http://www.priory.co.uk/line_gol.gif\")