#!/usr/local/bin/perl # # $Id: show-dict,v 1.10 1999/02/20 23:16:25 msh Exp $ # # Show dictionary article # # (C) 1998 Mike Shoyher # Configuration do './dict-conf'; die "No config file!" unless ($dbfile); my ($param, $key, $val, %d, %w); my $maxinstat=5000; sub LOCK_SH { 1 } sub LOCK_EX { 2 } sub LOCK_NB { 4 } sub LOCK_UN { 8 } use CGI; $Q1=new CGI; $param=$Q1->param('_query'); use Fcntl; use DB_File; use strict; use vars qw ($debug $dbfile $adminadr $statfile $showurl) ; #Parsing parameters (CGI GET or commandline) #$param=lc($ARGV[0]); #if ($param && ($param!~/_/o)){ # $param=~s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge; #} else { # for (split(/[&;]/,$ENV{'QUERY_STRING'})){ # s/\+/ /g; # ($key, $val) = split(/=/,$_,2); # # Convert %XX from hex numbers to alphanumeric # $key =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge; # $val =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge; # $param=$val if ($key eq '_query'); # } #} #$param=~s/\\&/&/og; # Dequote & print "Content-type: text/html\n\n"; print ' Англо-русский компьютерный словарь '; print '
Контакты

7600 статей, (С) Эдуард Пройдаков, Леонид Теплицкий, 1999 г

'; tie(%w, 'DB_File', "$dbfile-w", O_RDONLY,0644) || die "Cannot open database"; showTop(); print '

Наиболее популярные термины


Введите слово

'; if ((length($param)>0) && ($param !~ /^_/o)){ tie(%d, 'DB_File', "$dbfile-d", O_RDONLY,0644) || die "Cannot open database"; if ($d{lc($param)}) { showWord($param); saveStat($param); } else { missedWord($param); } untie(%d); untie(%w); print '

'; } print '
 

С авторами можно свяаться по адресу chief@pcweek.ru 

На первую страницу '; # Shows one word. Here must go all design sub showWord() { my $key=lc(shift()); print "

"; print '

Искомое слово: "'; print $w{$key}; print '"

'."
\n"; print "

\n"; print $d{$key},"\n"; } # No such word in the dict sub missedWord { my (%m,$db); my $key=lc(shift()); print '

Искомое слово: "'.$key.'"'; print " не найдено
\n"; open(FLAG,">>$statfile-mis-flag"); # Safe writing, FLAG - mutex if (doLock()){ tie(%m, 'DB_File', "$statfile-mis", O_RDWR|O_CREAT, 0666) || die "Cannot open statistics database"; $m{$key}++; untie(%m); } doUnLock(); close(FLAG); showNear($key); } sub showNear { my (@words,$l,$r,$m,$word,$i,$origword,$key); $origword=shift; $key=lc($origword); print "

Похожие слова

\n"; $#words=0; open(IN,"$dbfile-list"); for $word (){ chomp($word); push(@words,$word); } close(IN); # bsearch, nothing more. $l=0;$r=$#words; while ($r-$l > 1) { $m=int(($r-$l)/2) + $l; if ($key lt $words[$m]){ $r=$m; } else { $l=$m; } } for ($i=($m>0?$m-5:0);($i<$m+5)&&($i<$#words);$i++){ # print "",$w{$words[$i]}; # print "",$words[$i]; print "",$words[$i]; print " \n"; } print "


\n"; print "

Вы можете добавить письмо в словарь "; print "написав письмо составителю.\n"; } sub saveStat($) { my $word=lc(shift); my (%s,@list,$i); open(FLAG,">>$statfile-hit-flag"); # Safe writing, FLAG - mutex if (doLock()){ tie(%s, 'DB_File', "$statfile-hit", O_RDWR|O_CREAT, 0666) || die "Cannot open statistics database"; $s{$word}++; @list = sort {$s{$b} <=> $s{$a}} keys(%s); delete($s{$list[$#list]}) if $#list > $maxinstat; #Remove last word in top open(LIST,">$statfile-list"); for($i=0;$i<10;$i++){ print LIST $list[$i],"\n"; } close(LIST); untie(%s); } doUnLock(); close(FLAG); } sub escape { my($toencode) = @_; $toencode=~s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg; return $toencode; } sub doLock { my($i); for($i=0;$i<10;$i++){ return 1 if flock(FLAG,LOCK_EX | LOCK_NB); } } sub doUnLock { flock(FLAG, LOCK_UN); } sub showTop { open(LIST,"$statfile-list"); for (){ chomp; print '

'; print ""; print $w{$_}; print ""; print "\n"; } close(LIST); }