#! perl -w
# Code to allow TWiki to use Microsoft Index Server
# Contact Main.MartinCleaver
# but all credit goes to Adam.
#
# 20011017 Adam Kolbert : Search.pm t used as basis for integration with
# MS Index Server.
package TWiki::IISSearch;
use strict;
use Win32::OLE;
use Win32::OLE::Const 'Microsoft ActiveX Data Objects';
use Win32::OLE::Variant; # support for OLE data types
# =========================
sub searchWeb
{
## 0501 kk : vvv Added params
my ( $doInline, $theWebName, $theSearchVal, $theScope, $theOrder,
$theRegex, $theLimit, $revSort, $caseSensitive, $noSummary,
$noSearch, $noHeader, $noTotal, $doBookView, $doRenameView,
$doShowLock, $noEmpty, $template, @junk ) = @_;
my $topic=$TWiki::mainTopicname;
my $tmpl;
my $searchResult;
my $searchMessage ="";
#read in search template
$tmpl = &TWiki::Store::readTemplate( "iissearch" );
#split template into constituent parts
my( $tmplHead, $tmplSearch,
$tmplTable, $tmplNumber, $tmplTail ) = split( /%SPLIT%/, $tmpl );
$tmplHead = &TWiki::handleCommonTags( $tmplHead, $topic );
$tmplSearch = &TWiki::handleCommonTags( $tmplSearch, $topic );
$tmplNumber = &TWiki::handleCommonTags( $tmplNumber, $topic );
$tmplTail = &TWiki::handleCommonTags( $tmplTail, $topic );
if( ! $tmplTail ) {
print "
";
print "TWiki Installation Error
";
# Might not be search.tmpl FIXME
print "Incorrect format of search.tmpl (missing %SPLIT% parts)";
print "";
return;
}
if( ! $doInline ) { #don't print if inline results wanted
# print first part of full HTML page
$tmplHead = &TWiki::getRenderedVersion( $tmplHead );
$tmplHead =~ s|*nop/*>||goi; # remove tags (PTh 06 Nov 2000)
print $tmplHead;
}
if( ! $noSearch ) {
# print "Search:" part
$theSearchVal =~ s/&/&/go;
$theSearchVal =~ s/</go;
$theSearchVal =~ s/>/>/go;
$theSearchVal =~ s/^\.\*$/Index/go;
$tmplSearch =~ s/%SEARCHSTRING%/$theSearchVal/go;
if( $doInline ) {
$searchResult .= $tmplSearch;
} else {
$tmplSearch = &TWiki::getRenderedVersion( $tmplSearch );
$tmplSearch =~ s|*nop/*>||goi; # remove tag
print $tmplSearch;
}
}
# Get results from IIS
# Setup references to Index Server Com objects
my $ISQ = Win32::OLE->new('IXSSO.Query'); # creates an index server object
my $ISU = Win32::OLE->new('IXSSO.util'); # creates an index server utility object
# Set parameters for search
$ISQ->Reset();
$ISQ->{Query}=$theSearchVal;
$ISQ->{SortBy}="rank[d]";
$ISQ->{Catalog}=$TWiki::searchCatDir; #"d:\\twikisearch";
$ISQ->{Columns} = "DocTitle, DocAuthor, path, write, characterization";
$ISQ->{MaxRecords} = $theLimit;
$ISQ->{OptimizeFor} = "x"; #optimise for performance
# Add scope (equivalent to the web name in twiki)
# A value of 'all' or 'on' by itself gets all webs,
# otherwise ignored (unless there is a web called "All".)
my $scopeDataDir = $TWiki::dataDir;
$scopeDataDir =~ s!/!\\\\!g;
my $scopePubDir = $TWiki::pubDir;
$scopePubDir =~ s!/!\\\\!g;
if($theWebName && ($theWebName =~ /^(([Aa][Ll][Ll])||([Oo][Nn]))$/ )) { #all webs specified
#search all webs
#$ISU->AddScopeToQuery ($ISQ, $scopePubDir, "deep");
$ISU->AddScopeToQuery ($ISQ, "$scopeDataDir", "deep");
$searchMessage = "Searching all webs:";
} else {
$ISU->AddScopeToQuery ($ISQ, "$scopePubDir\\$TWiki::webName", "deep");
$ISU->AddScopeToQuery ($ISQ, "$scopeDataDir\\$TWiki::webName", "deep");
$searchMessage = "Searching $TWiki::webName web:";
}
# Let Index Server do it's stuff and then return an ADO recordset
my $RS = $ISQ->CreateRecordSet("nonsequential");
if (Win32::OLE->LastError()){
if( $doInline ) {
$searchResult .= "Error: ". Win32::OLE->LastError(). "
";
} else {
print "Error: ", Win32::OLE->LastError(), "
";
}
} else {
my $backslashdatadir;
my $backslashpubdir;
my $thisWebName;
my $thisWebBGColor;
my $result;
my $ntopics = "0";
# process results
$RS->{PageSize} = 10 ;
# Get path to data directory and pub directory from Twiki.cfg
$backslashdatadir = $TWiki::dataDir."/";
$backslashpubdir = $TWiki::pubDir."/";
$backslashdatadir =~ s!/!\\\\!g; #swap direction of slashes
$backslashpubdir =~ s!/!\\\\!g;
# Set up parameters for results
$thisWebName = $TWiki::webName;
$thisWebBGColor = &TWiki::Prefs::getPreferencesValue("WEBBGCOLOR", $thisWebName) || "\#FF00FF";
# Parse html for results table
my($beforeText, $repeatText, $afterText) = split( /%REPEAT%/, $tmplTable);
$beforeText =~ s/%WEBBGCOLOR%/$thisWebBGColor/o;
$beforeText =~ s/%SEARCHTITLE%/$searchMessage/o;
$beforeText = &TWiki::handleCommonTags($beforeText, $topic);
$afterText = &TWiki::handleCommonTags($afterText, $topic);
#print before text
if( $doInline ) {
$searchResult .= $beforeText;
} else {
$beforeText = &TWiki::getRenderedVersion($beforeText, $thisWebName);
$beforeText =~ s|*nop/*>||goi; #remove tag
print $beforeText;
}
# Create Hash of hashes for fixTopicCaps sub
my %WebsOfFiles;
my %Webs;
# Loop through results
while ( !$RS->EOF ) {
my $path = $RS->Fields("path")->value;
my $docTitle = $RS->Fields("DocTitle")->value;
my $docAuthor = $RS->Fields("DocAuthor")->value;
my $write = $RS->Fields("write")->value;
my $characterization = $RS->Fields("characterization")->value;
my @locator;
my $web;
my $webURL;
my $item;
my $itemURL;
my $linkedItemHTML;
my $tempVal;
my $image; # used to store image for attachments
# clean $characterisation so html is not interpreted
# if 'noSummary' do not print characterization
if($noSummary){
$characterization ="";
} else {
$characterization =~ s/<.*>//go;
}
#check if topic found, obtain web and topic directory
if ($path =~ s!$backslashdatadir!!) { # topic
# Split path and put into array
@locator = split(/\\/, $path);
# Next term popped off array will be topic
$item = pop(@locator);
# Remaining terms on locator denote the web.
$web = join("",@locator);
$web = fixWebCaps($web,%Webs);
$webURL = TWiki::getViewUrl($web);
$item = fixTopicCaps($web,$item,%WebsOfFiles);
# generate URL
$itemURL = TWiki::getViewUrl($web,$item);
$image=" ";
} else { # attachment
my $linkedItem;
my $linkedItemURL;
$path =~ s!$backslashpubdir!!; #strip path from front
# Split path and put into array
@locator = split(/\\/, $path);
# next term popped off array will be attachment name
$item = pop(@locator);
# next term popped off array will be topic
$linkedItem=pop(@locator);
# remaining terms on locator denote the web.
$web = join("",@locator);
$web = fixWebCaps($web,%Webs);
$webURL = TWiki::getViewUrl($web);
#$item = fixTopicCaps($web,$item);
$linkedItem = fixTopicCaps($web,$linkedItem.".txt",%WebsOfFiles);
# url to attachment
$itemURL = "%SCRIPTURLPATH%/viewfile%SCRIPTSUFFIX%/$web/$linkedItem?rev=&filename=$item";
# url to topic
$linkedItemURL = TWiki::getViewUrl($web,$linkedItem);
$linkedItemHTML = "| | Associated topic: $web.$linkedItem | | |
";
# image generation for attachments
$image = TWiki::Attach::filenameToIcon( $item );
# Uncomment following line to turn file type icon into hyperlink
#$image = "$image";
}
# Start presentation of results
$tempVal = $repeatText;
$tempVal =~ s/%LINKEDITEMHTML%/$linkedItemHTML/o;
$tempVal =~ s/%WEB%/$web/go;
$tempVal =~ s/%WEBURL%/$webURL/go;
$tempVal =~ s/%TIME%/$write/o;
$tempVal =~ s/%AUTHOR%/$docAuthor/o;
$tempVal =~ s/%TEXTHEAD%/$characterization/o;
$tempVal =~ s/%ITEMURL%/$itemURL/o;
$tempVal =~ s/%ITEM%/$item/o;
$tempVal =~ s/%IMG%/$image/o;
$tempVal = &TWiki::handleCommonTags( $tempVal, $topic );
$tempVal = &TWiki::getRenderedVersion( $tempVal );
$result = $result.$tempVal;
# move to next record
$ntopics++;
$RS->MoveNext;
}
# close record set
$RS->Close;
# print results
if( $doInline ) {
$searchResult .= $result;
} else {
$result =~ s|*nop/*>||goi; #remove tag
print $result;
}
#print after text
if( $doInline ) {
$searchResult .= $afterText;
} else {
$afterText = &TWiki::getRenderedVersion($afterText, $thisWebName);
$afterText =~ s|*nop/*>||goi; #remove tag
print $afterText;
}
if( ! $noTotal ) {
# print "Number of topics:" part
my $thisNumber = $tmplNumber;
$thisNumber =~ s/%NTOPICS%/$ntopics/go;
if( $doInline ) {
$searchResult .= $thisNumber;
} else {
$thisNumber = &TWiki::getRenderedVersion( $thisNumber, $thisWebName );
$thisNumber =~ s|*nop/*>||goi; # remove tag
print $thisNumber;
}
}
}
if(! $doInline ) {
# print last part of full HTML page
$tmplTail = &TWiki::getRenderedVersion( $tmplTail );
$tmplTail =~ s|*nop/*>||goi; # remove tag
print $tmplTail;
}
return $searchResult;
}
sub fixTopicCaps {
my( $web, $name, %WebsOfFiles ) = @_;
if (! $WebsOfFiles{$web}){#directory has not been cached
# caching of results is not currently working
# this should be investigated and fixed before production use.
#print "Caching $web. ";
$WebsOfFiles{$web} = {readDirectory($web)};
}
my $returnedName = $WebsOfFiles{$web}{$name};
$returnedName =~ s!.txt!!; #strip.txt from end
return $returnedName;
}
sub fixWebCaps {
my( $web, %WebHash ) = @_;
if (! %WebHash){#directory has not been cached
# caching of results is not currently working
# this should be investigated and fixed before production use.
#print "caching";
%WebHash = readDirectory();
}
my $returnedName = $WebHash{$web};
return $returnedName;
}
sub readDirectory {
my( $web ) = @_;
opendir(DIR, "$TWiki::dataDir/$web") || die print "error";
my @files = readdir(DIR);
closedir(DIR);
#Define new hash
my %fileNameHash = map { lowerCase($_) => $_ } @files;
return %fileNameHash;
}
sub lowerCase {
# Convert passed string to lower case
my($mixedcase) =@_;
$mixedcase =~ tr/[A-Z]/[a-z]/;
return $mixedcase;
}
1;
# EOF