#!/usr/bin/perl # # This script searches the SwissTerm database and displays the results # Copyright (C) 1999 by Didier Frick (dfrick@dial.eunet.ch) # All rights reserved. use strict; use CGI; my $pagesDir="../SwissTerms"; my $logDir="../log"; my $dataDir="data"; my $imgDir="../Images"; my $dataFile="$dataDir/swissterm.txt"; my $noResults="$pagesDir/noresults"; my $noQuery="$pagesDir/noquery"; my $resultsPage="$pagesDir/results"; my $searchPage="$pagesDir/search"; my $newPage="$pagesDir/newterm"; my $newTermFile="$logDir/newterms.txt"; my $updatePage="$pagesDir/update"; my $updatedTermFile="$logDir/updates.txt"; my $failedQueryFile="$logDir/notfound.txt"; my $commentsPage="$pagesDir/comments"; my $commentsFile="$logDir/comments.txt"; my $registerFile="$logDir/registered.txt"; my $thanksPage="$pagesDir/thanks"; my $matchColor="blue"; my $openTag=""; my $closeTag=""; my $fileExtension=".html"; my $defLang="en"; my $errMsg="Error - page not found". "

Error - page not found

"; my @lang; my $realLang; my $cgi; sub getLanguage { my ($cgi)=@_; my @result; my $lang=$cgi->param('lang'); if(!defined($lang)) { my $temp=$cgi->http("ACCEPT_LANGUAGE"); if(defined($temp)) { $temp=~y/-/_/; $temp=~s/ +//g; my @tmplist=split(/,/,$temp,30); my $item; foreach $item (@tmplist) { do { push(@result,$item); } while(($item=~s/_[^_]+$//)>0); } } } else { push(@result,$lang); } push(@result,$defLang); return @result; } sub makeRegexp { my ($cgi)=@_; my $query=$cgi->param('query'); my $result; if(defined($query)&&(length($query)>1)&&!($query=~m/^ +$/)){ $query=~s/\s+/\\s+/g; $query=~s/\*/\\S\*/g; $result="\\b".$query."\\b"; } return $result; } sub getPage { my ($file,@lang)=@_; my $result; my $IN; my $name; my $l; foreach $l (@lang) { $name=$file.".".$l.$fileExtension; open(IN,$name); if(!eof(IN)) { $realLang=$l; last; } } if(eof(IN)) { $result=$errMsg; } else { undef $/; while () { $result.=$_; } $/ = "\n"; close(IN); } return $result; } sub sendUpdatePage { my ($file,$id)=@_; my $text=getPage($file,@lang); my @list= ("") x 80; if(defined($id)) { undef $/; open(IN,$dataFile); $_=; my @records=m/^($id\t.*)\015$/gm; close(IN); $/ = "\n"; if($#records>=0) { @list=split(/\t/,$records[0],30); } } my $i; for($i=0;$text=~s/===/$list[$i]/;$i++) { } print $cgi->header(); print $text; } sub checkInfo() { print $cgi->header("text/plain"); my $key; my @keys=keys %ENV; print "ENVIRONMENT:\r\n\r\n"; foreach $key (@keys) { my $val=$ENV{$key}; print "$key\t$val\r\n"; } print "UID:\t$<\r\nEUID:\t$>\r\nGID:\t$(\r\nEGID:\t$)\r\n"; open (OUT,">>$failedQueryFile"); print "open:$!\r\n"; print OUT "Test\r\n"; print "print:$!\r\n"; close OUT; print "close:$!\r\n"; } sub sendPage { my $text=getPage @_; print $cgi->header(); print $text; } sub searchTerms { my ($regExp)=@_; my ($IN,@seen); undef $/; if (!open(IN,$dataFile)) { die "Can't open $dataFile: $!"; }; while () { push @seen,m/^(.*$regExp.*)$/gim; } close(IN); $/ = "\n"; return @seen; } sub logQuery { my ($cgi,$fileName)=@_; my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); $mon++; my @keys=$cgi->param; my $key; open (OUT,">>$fileName"); print OUT "Date\t$mday.$mon.$year $hour:$min\r\n"; foreach $key (@keys) { my $val=$cgi->param($key); print OUT "$key\t$val\r\n"; } print OUT "\r\n"; close OUT; } sub processResults { my ($regexp,@lines)=@_; my $row; my $col; $_=getPage($resultsPage,@lang); undef $/; my @parts=m/(.*)($openTag *)[\001-\040]*(.*)[\001-\040]*($closeTag *)(.*)/is; $/ = "\n"; my @headers=split(/\#/,$parts[2]); print $cgi->header(); print $parts[0]; print ""; #print ""; my $separator=""; print $separator; for($row=0;$row<=$#lines;$row++){ my $str=$lines[$row]; $str=~s!($regexp)!$1!gio; my @current=split(/\t/,$str,30); my $id=shift @current; my $rows=0; for($col=0;$col<=$#current;$col++){ if($current[$col]) { $rows++; } } my $done=0; for($col=0;$col<=$#current;$col++){ if(!($current[$col]=~m/^[\000-\040]*$/)) { print ""; if(!$done) { $done=1; print "\n"; } } } print $separator; } print "


\n"; print "$headers[$col]"; print "	\n"; print "$current[$col]"; print "	"; print ""; print ""; print "

\n"; print $parts[4]; } sub main { my $method; if(defined($ENV{GATEWAY_INTERFACE})) { $cgi = new CGI(); $method=$cgi->request_method(); } elsif($#ARGV>=0) { $cgi = new CGI($ARGV[0]); } else { $cgi = new CGI(""); } @lang=getLanguage($cgi); my $action=$cgi->param('action'); my $logFile; if($action eq "search") { if(!defined($method)||($method eq "POST")) { my $regexp=makeRegexp($cgi); if(defined($regexp)) { my @lines=searchTerms($regexp); if($#lines>=0) { processResults($regexp,@lines); } else { sendPage($noResults,@lang); $logFile=$failedQueryFile; } } else { sendPage($noQuery,@lang); } } else { sendPage($searchPage,@lang); } } elsif($action eq "new") { if(!defined($method)||($method eq "POST")) { $logFile=$newTermFile; sendPage($thanksPage,@lang); } else { sendPage($newPage,@lang); } } elsif($action eq "update") { if(defined($method)&&($method eq "POST")) { $logFile=$updatedTermFile; sendPage($thanksPage,@lang); } else { sendUpdatePage($updatePage,$cgi->param('id')); } } elsif($action eq "comments") { if(!defined($method)||($method eq "POST")) { $logFile=$commentsFile; sendPage($thanksPage,@lang); } else { sendPage($commentsPage,@lang); } } elsif($action eq "register") { $logFile=$registerFile; print $cgi->redirect($cgi->referer()); } elsif($action eq "check") { checkInfo(); } else { sendPage($searchPage,@lang); } if(defined($logFile)) { $cgi->delete('action'); $cgi->delete('lang'); $cgi->delete('submit'); logQuery($cgi,$logFile); } } main; # Local Variables: # executable-command:"./search.cgi \"action=search&query=toto&lang=en\" " # End: