#!/usr/bin/perl -w

# Copyright (C) 2003 Alexander Mikhailian (mikhailian@altern.org).
# This is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 2, or (at your option) any later
# version.

# This is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.

# You should have received a copy of the GNU General Public License
# along with GNU Emacs; see the file COPYING.  If not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
# MA 02111-1307, USA.

use CGI qw(:standard);
use Net::Dict;

my $webmaster="vle\@gmx.net";
#my $dict_server='cheusov.scnsoft.com';
#my $dict_server='dict.mova.org';
my $dict_server='dict.org';
#my $dict_server='127.0.0.1';
#my $dict_server='mova.org';
#my $dict_server='dict.org';
#my $download_url="http://$dict_server/dict/";
my $download_url="http://mova.org/~cheusov/dict/";
my $default_strategy='word';

my $message_first_match='First match';
my $message_all_databases='All databases';
my $message_return_definitions='Return definitions';
my $message_query_string='Query string:';
my $message_strategies='Strategies:';
my $message_databases='Databases:';
my $message_header='Slavic dictionaries on-line';
my $message_no_defs_found='No definitions found for the word';
my $message_no_matches_found='No matches found for the word';
my $message_information_about_dbs='Information about databases';
my $message_information_server='Information about server';
my $message_webmaster='webmaster';
my $message_server_runs="$dict_server runs DICT server.";
my $message_download="Download dictionaries from <a href=$download_url> here </a>.
<br> If you found bugs in the dictionaries or have suggestions, subscribe to
the mailing list
<a href=http://mova.org/lists/listinfo/dicts> here</a>.<br>
If you want to be notified about changes at dict://$dict_server, subscribe to this
mailing <a href=http://mova.org/lists/listinfo/dicts-announce> list </a><br>";
my $message_project_info='Read about DICT project <a href=http://www.dict.org> here </a>.';
my $message_related="Mozilla users can install
    <a href=\"/mova-0.0.3-xdsl.xpi\">this</a> XUL plugin for searching the
    dictionaries by selecting a word and choosing \"Lookup at $dict_server\"
    in the context menu. (install as root, close mozilla, restart it as
    root  again so that mozilla registers the new XUL plugin at startup).
   <!-- There is also an add-on for Internet Explorer with the same
    functionality <a href=\"/mova-0.0.2.exe\">here</a>.-->
    </p>
    <p>See a <a href=\"/mova-moz.png\">screenshot</a></p>";

my $message_footer=" <p>
   <b>Best</b> <i>viewed</i> <a>with</a> Lynx
   <p align=center>

   <!--Rating\@Mail.ru COUNTER-->
   <a target=_top
       href=\"http://top.mail.ru/jump?from=456868\">
       <img
         src=\"http://top.list.ru/counter?id=456868;t=30\"
         border=\"0\"
         alt=\"rating \@mail.ru\">
       </img>
   </a>

   <!--/COUNTERS-->


   <!--begin of Rambler's Top100 code -->
   <a href=\"http://top100.rambler.ru/top100/\">
      <img
         src=\"http://counter.rambler.ru/top100.cnt?412508\"
         alt=\"Rambler\"
         border=\"0\">
      </img>
   </a>
   <!--end of Top100 code-->


   <!-- SpyLOG f:0211 -->
   <a href=\"http://u4405.28.spylog.com/cnt?cid=440528&f=3&p=0\" target=\"_blank\">
      <img
         src=\"http://u4405.28.spylog.com/cnt?cid=440528&p=0\"
         alt='SpyLOG'
         border=\"0\">
      </img>
   </a>
   <!-- SpyLOG -->

   <!--end of Top100 logo -->
   </p>
   ";

my $dict = Net::Dict->new($dict_server, Port => 2628); # a dictionary object
my @databases = $dict->dbs_array();
my @strategies = $dict->strategies_array();
my $q = param("q"); # search
my @database = param("database");
my $strategy = param("strategy");
my $dbinfo = param("dbinfo");
my $serverinfo = param("serverinfo");
my $full_url = url();
my @dbid; # database ids
my @dbtitle; # database names
my @stid; # definition ids
my @sttitle; # definition names

# default database
unshift @databases, ['!', $message_first_match];
unshift @databases, ['*', $message_all_databases];

foreach (@databases){
    push(@dbid,    $_ -> [0]);
    push(@dbtitle, $_ -> [1]);

	$databases{$_ -> [0]} = $_ -> [1];
}

push @strategies, ['definitions', $message_return_definitions];

foreach (@strategies){
    push(@stid,    $_ -> [0]);
    push(@sttitle, $_ -> [1]);
	$strategies{$_ -> [0]} = $_ -> [1];
}

print header("text/html;charset=utf-8"),
    start_html(-title => "$message_header",-encoding => 'utf-8'),
    h1 ({-align=>'center'}, "$message_header");

print
     start_form(-method=>'GET'),
    '<table>',
    '<tr>',
    '<td>',
    $message_query_string,
    '</td>',
    '<td>',
     textfield('q','',40,80), 
    '</td>',
    '</tr>',
    '<td>', $message_strategies, '</td> <td>',
    popup_menu(-name=>'strategy',
               -default=>"$default_strategy",
               -values=>\@stid,
               -labels=>\%strategies),
     '</td> </tr>',
    '<tr> <td>', $message_databases, '</td> <td>',
    popup_menu(-name=>'database',
               -default=>'*',
               -values=>\@dbid,
               -labels=>\%databases),
    '</td>',
    '</tr>',
    '<tr> <td>', submit, '</td> </tr>',
    '</table>',
    '</form>',
    "<br />";

sub print_db_info
{
#    @_ == 2 or croak 'print_db_info () method expects one argument - DB name';

	my $dbname  = shift;
	my $dbdescr = shift;

	print p(b("<a href=\"$full_url?dbinfo=$dbname\">$dbdescr</a>"));
	print pre($dict->dbInfo($dbname));
}

# if database info is requested
#print "zzz: $dbinfo\n";
if ($dbinfo ne ""){
	if ($dbinfo ne '*'){
		my $dbdescr=$databases{$dbinfo};
		print_db_info ($dbinfo, $dbdescr);
	}else{
		foreach $h (@databases){
			my $dbname=$h -> [0];
			my $dbdescr=$h -> [1];
			if ($dbname ne '*' && $dbname ne '!'){
				print_db_info ($dbname, $dbdescr);
			}
		}
	}
}

# if server info is requested
if ($serverinfo){
    $h = $dict->serverInfo();
    print pre($h);
}

#if asked for definition
if ($strategy eq 'definitions'){
	undef $h;
	$h = $dict->define($q, @database);

	undef $dbid;
	undef $article;

	my $definitions_found = "";

	foreach $i (@$h){
		($dbid, $article) = @$i;
		print p(b(h3("<a href=\"$full_url?dbinfo=$dbid\">$databases{$dbid}</a>")));
		print pre("$article");

		$definitions_found = 1;
	}

	if (!$definitions_found){
		print pre("$message_no_defs_found '$q'");
	}
}elsif ($strategy ne ''){
	# if asked for a list of matches
	my $matches_found = "";

	$h = $dict->match($q, $strategy, @database);
	my $dbid_prev = "";
	foreach $i (@{$h}){
		($dbid, $head) = @{$i};
		if ($dbid_prev ne $dbid){
			print p(b(h3("<a href=\"$full_url?dbinfo=$dbid\">$databases{$dbid}</a>")));
		}
		print "<a href=\"$full_url?q=$head\&strategy=definitions\&database=$dbid\">\"$head\"</a> &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;";

		$dbid_prev = $dbid;

		$matches_found = 1;
	}

	if (!$matches_found){
		print pre("$message_no_matches_found '$q'");
	}
}

if (length @$h){
	print "<p>" . hr;
}

print div({-align=>'center'}, "<a href=\"$full_url?dbinfo=*\">
$message_information_about_dbs</a>");
print div({-align=>'center'}, "<a href=\"$full_url?serverinfo=1\">
$message_information_server</a>");
print div({-align=>'center'}, "<a href=mailto:$webmaster>$message_webmaster</a>");

print div("<br>" . hr . "$message_related");
print hr;

print div($message_server_runs . ' ' . "$message_project_info");
print div("$message_download");
#print div("Mailing list is <a href=\"http://lrn.ru/mailman/listinfo/dictd\"> here. </a>");
print div("$message_footer");

print end_form;
print end_html;