<%
# This script is designed to allow a text search of fields in a WODA database on MS IIS
# Progammed by: Jeremy Rodgers, Bear River, NS, B0S 1B0, http://ethos.tsx.org
# Version: 1.1
# Done: 25 records per page - next,previous buttons, record listing to include thumbnail images
# Done: Table images 2 per row. w descriptions wrapped.
# To be done: multi-word search, and, or, not bool ops, URL encode/decode search parameters
# use strict;
use WIN32::OLE qw(in valof with OVERLOAD);
$Rec_on_Page = 18;
$what = $Request->QueryString("search");
$pg_req_IN= $Request->QueryString("page");
$pg_req = valof $pg_req_IN;
$phraselook = valof $what;
$dirtosearch = $Server->mappath($Request->ServerVariables("PATH_INFO"));
$findwhat = '\.rec';
# $Response->write("search: $phraselook directory: $dirtosearch page requested: $pg_req ");
$gone = chop $dirtosearch;
while ($gone ne "\\") {
$gone = chop $dirtosearch;
}
# --------- DECODE UNWANTED CHARACTERS
# $phraselook =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$phraselook =~ s/\)/ /g;
$phraselook =~ s/\(/ /g;
$phraselook =~ s/(\W)(\s)(\D)//g;
#
# $phraselook =~ s/&/ /g;
# $phraselook =~ s/\*/ /g;
#---------- END DECODE SECTION
@look = split / /,$phraselook;
# $Response->write("search: $phraselook directory: $dirtosearch page requested: $pg_req ");
### *** MAIN *** ###
if ($pg_req eq "0") {
&ReadRecords;
&PrintRecords;
}elsif ($pg_req gt "0") {
&ReadRecords;
&PrintRecords;
}else {
$Response->write("ERROR - This Page is Unavailable!");
}
exit;
### *** SUBS *** ###
sub ReadRecords {
opendir(DIR, $dirtosearch) or die $!;
# $Response->write("number of elements in look: $#look ");
@mydir = readdir(DIR);
for $i (0..$#mydir) {
if ($mydir[$i] =~ /$findwhat/ ) {
$dbfile = "$dirtosearch\\$mydir[$i]";
open(REC, "$dbfile");
@lines = ;
shift @lines;
$Rec = ();
%Rec = ();
for ($k=0 ; $k<=$#lines ; $k++){
chomp $lines[$k];
$Rec->{$lines[$k]}=$lines[$k+1];
$k++;
}
$Rec->{'Filename'}=$mydir[$i];
close (REC);
$lookin = ($Rec->{'Description'}).($Rec->{'Location'}).($Rec->{'Source'}).($Rec->{'Title'}).($Rec->{'Number'});
# search by phrase
if ($lookin =~ /$phraselook/io) {
push @Found,$Rec;
}
# search by words in phrase eliminating duplicates
for $t (0..$#look) {
if ($lookin =~ /$look[$t]/io) {
$addfile = 1;
for $x(0..$#Found) {
if ($Found[$x]{'Image'} eq $Rec->{'Image'}) {
$addfile = 0;
}
}
if ($addfile > 0) {
push @Found,$Rec;
}
}
}
$lookin = ();
}
}
closedir(DIR);
}
### *** PRINTRECORDS *** ###
sub PrintRecords {
if ($pg_req eq 0) {
$first = 0;
$last = ($Rec_on_Page-1);
}elsif ($pg_req =>1) {
$first = $pg_req*$Rec_on_Page;
$last = ($pg_req+1)*$Rec_on_Page-1;
}
$pg_req++;
$ShowNext=1;
$ShowPrev=1;
if ($last>$#Found) {
$last=$#Found;
$ShowNext=0;
$pg_req--
}
if ($last<$Rec_on_Page) {
$ShowPrev=0;
}
if ($last >=0) {
&BotBar;
&ShowPage;
&BotBar;
} else {
$Response->write("
No Records Match Your Search
");
$Response->write(" New Search");
}
}
sub ShowPage {
$Response->write("Showing $first to $last of $#Found for Search: $phraselook");
$Response->write("
");
for $i ($first..$last) {
$thmb="thumbs\\".($Found[$i]{'Image'});
chop $Found[$i]{'Image'};
$Response->write("