<%@ LANGUAGE = PerlScript %> ImageBank Search
Digby Neck logo

Pictures


<% # 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(""); $Response->write(""); } $Response->write("
"); $Response->write(""); $Response->write("Title: $Found[$i]{'Title'}"); $Response->write("Location: $Found[$i]{'Location'}:"); $Response->write("Number: $Found[$i]{'Number'}"); $Response->write("Source: $Found[$i]{'Source'}
Notes: $Found[$i]{'Description'}"); $Response->write("

"); } sub BotBar { $phraselook = ""; for $x (0..$#look) { $phraselook .= $look[$x]."+"; } chop $phraselook; if ($ShowPrev) { $LastPage=$pg_req-1; $Response->write(""); } if ($ShowNext) { $Response->write(""); } $TotPgs = ($#Found/$Rec_on_Page); if ($TotPgs >0) { $Response->write("
Page: "); for $t (0..$TotPgs) { $Response->write("  $t "); } } $Response->write("
"); } %>