--- db/prgsrc/db.cgi 2002/10/06 23:12:22 1.75 +++ db/prgsrc/db.cgi 2003/02/08 23:37:42 1.90 @@ -1,23 +1,35 @@ #!/usr/bin/perl -w -use DBI; +use DBI; use CGI ':all'; use strict; use Time::Local; use POSIX qw(locale_h); use locale; open STDERR, ">/var/tmp/errors1"; +my $newsurl='http://news.chgk.info/'; +my ($proxyptext,$proxysstr); my $printqueries=0; my %forbidden=(); my $debug=0; #added by R7 if (param('debug')) {$debug=1; $printqueries=1} *STDERR=*STDOUT if $debug; +my $thislocale; +if ($^O =~ /win/i) { + $thislocale = "Russian_Russia.20866"; +} else { + $thislocale = "ru_RU.KOI8-R"; +} +POSIX::setlocale( &POSIX::LC_ALL, $thislocale ); + +if ((uc 'а') ne 'А') {print STDERR "Koi8-r locale not installed!\n"}; + my %fieldname= (0,'Question', 1, 'Answer', 2, 'Comments', 3, 'Authors', 4, 'Sources'); my %rusfieldname=('Question','Вопрос', 'Answer', 'Ответ', 'Comments', 'Комментарии', 'Authors', 'Автор', 'Sources', 'Источник','old','Старый','rus','Новый', 'chgk', 'ЧГК', 'brain', 'Брейн-ринг','game', 'Своя игра', - 'ehruditka', 'Эрудитка', 'beskrylka', 'Бескрылка' + 'ehruditka', 'Эрудитка', 'beskrylka', 'Бескрылка', 'igp', 'Интернет' ); my %searchin; my $rl=qr/[йцукенгшщзхъфывапролджэячсмитьбюё]/; @@ -29,10 +41,9 @@ my %metodchar=('rus',1,'old',2); -my $thislocale; $searchin{$_}=1 foreach param('searchin'); -my %TypeName=('children'=>'Д', 'game'=>'И', +my %TypeName=('children'=>'Д', 'game'=>'Я', 'igp'=>'И', 'chgk'=>'Ч', 'brain'=>'Б', 'beskrylka'=>'Л','ehruditka'=>'Э'); @@ -144,13 +155,11 @@ sub GetTours { sub count { my ($dbh,$word)=@_; -print "timeb=".time.br if $debug; $word=$dbh->quote(uc $word); my $query="SELECT number from nests,nf where $word=w1 AND w2=nf.id"; my $sth=$dbh->prepare($query); $sth->execute; my @a=$sth->fetchrow; -print "timee0=".time.br if $debug; $sth->finish; $a[0]||0; } @@ -159,60 +168,100 @@ print "timee0=".time.br if $debug; sub printform { - my $submit=submit(-value=>'Поиск'); - my $inputstring=textfield(-name=>'sstr', - -default=>param('sstr')||'', - -size=>30, - -maxlength=>50); - my $qnumber="Выводить по".br. textfield(-name=>'kvo', + my $qnumber=(" "x10)."Выводить по ". textfield(-name=>'kvo', -default=>param('kvo')||'150', -size=>3, - -maxlength=>5). br."вопросов"; - + -maxlength=>5)." вопросов"; + my $sstr=param('sstr'); my @df=keys %searchin; + my %checked; @df=('Question', 'Answer') unless @df; + $checked{lc $_}="checked" foreach @df; my $fields=checkbox_group('searchin',['Question','Answer','Comments','Authors','Sources'], [@df], 'false',\%rusfieldname); @df=param('type'); - @df=('chgk','brain','game','ehruditka','beskrylka') unless @df; - - my $types=checkbox_group('type',['chgk','brain','game','ehruditka','beskrylka'], [@df], - 'false',\%rusfieldname); - my $metod=radio_group(-name=>'metod',-values=>['old','rus'], - -default=>(param('metod')||'rus'), - -labels=>\%rusfieldname); - my $all=radio_group(-name=>'all',-values=>['yes','no'], - -default=>(param('all')||'no'), - -labels=>{'yes'=>'Все','no'=>'Любое'}); + @df=('chgk','brain','igp','game','ehruditka','beskrylka') unless @df; + $checked{lc $_}="checked" foreach @df; + my $all=param('all') && param('all') eq 'yes'; + + $checked{'all'}=$all?"checked":""; + $checked{'any'}=$all?"":"checked"; + $checked{lc param('metod')}="checked"; + $checked{'russian'}=1 unless $checked{'russian'} || $checked{'old'}; ################################################# -return start_form(-method=>'get', - -action=>url, - -enctype=> - "application/x-www-form-urlencoded" -).br. -table(Tr -( - td({-valign=>'TOP'},$inputstring.$submit.p."Метод: $metod".p."Слова: $all"), - td({-valign=>'TOP'},(' 'x 8).'Поля:'), - td({-valign=>'TOP'},$fields), - td({-valign=>'TOP'},(' 'x 1).'Типы:'), - td({-valign=>'TOP'},$types), td(" "x5), - td({-valign=>'TOP'},$qnumber) -) -) - -#$fields. -#$inputstring.$submit.br.$metod.$all +return +< +

Поиск в базе вопросов

+ + + $qnumber +

+ + + + + + + + + + + + + +
Вариант поиска: + + Простой (старый) + + "Что? Где? Когда?" + + "Брейн-Ринг" + + "Интернет" +
+ "Своя игра" + + "Эрудитка" + + "Бескрылка" +
Расширенный (с учетом грамматики, в вопросах всех типов) +
Искать: + +Все слова + +Любое слово +
Поля для поиска: + +Вопрос + +Ответ
+		 +Комментарии
+		 +Автор
+		 +Источник
+
+ + +EOT .endform .hr } sub proxy -{ -#print "time0=".time.br if $debug; +{ my ($dbh,$ptext,$allnf)=@_; + my $sstr=makeproxysstr($dbh,$ptext,$allnf); + return russearch($dbh,$sstr,0,$allnf); +} + +sub makeproxysstr { + my ($dbh,$ptext)=@_; my $text=$$ptext; $text=~tr/ёЁ/еЕ/; $text=~s/(${RLrl})p(${RLrl})/$1p$2/gom; @@ -238,18 +287,9 @@ sub proxy $good{$words[$_]}=0 foreach 16..$#words; -# foreach (@list) -# { -# if ($good{$_}) -# { -# $good{$_}=0; -# $sstr.=" $_"; -# } -# } $sstr.=" $_" foreach grep {$good{$_}} @list; -print "time05=".time.br if $debug; $$ptext=$sstr; - return russearch($dbh,$sstr,0,$allnf); + return $sstr; } @@ -468,17 +508,6 @@ sub Search { my $sstr=$$s; my (@arr, @Questions, @fields); my (@sar, $i, $sth,$where,$query); -# my $ip=$ENV{'REMOTE_ADDR'}; - -# $ip=$dbh->quote($ip); -# $query= -# "INSERT into queries (query,metod,searchin,ip) -# values (". $dbh->quote($sstr).', '. -# $dbh->quote($metod) . ', ' . -# $dbh->quote(join ' ', grep $searchin{$_}, keys %searchin) . -# ", $ip)"; -#print $query if $printqueries; -# $dbh -> do ($query); if ($metod eq 'rus') { my @tasks=russearch($dbh,$sstr,$all,$allnf); @@ -486,10 +515,7 @@ sub Search { } elsif ($metod eq 'proxy') { -# $searchin{'question'}=1; -# $searchin{'answer'}=1; my @task=proxy($dbh,$s,$allnf); -# $$s=$sstr; return @task } @@ -687,7 +713,7 @@ sub PrintList { sub PrintSearch { my ($dbh, $sstr, $metod,$was) = @_; my $t=time; - print h2("Поиск в базе вопросов"); +# print h2("Поиск в базе вопросов"); print printform; my @allnf; my @Questions; @@ -778,6 +804,8 @@ print "$query" if $printqueries; sub PrintRandom { my ($dbh, $type, $num, $text) = @_; + my $razd=param('razd'); + my $answer=$razd?0:1; my (@Questions) = &Get12Random($dbh, $type, $num); my ($output, $i) = ('', 0); @@ -792,8 +820,17 @@ sub PrintRandom { # Passing DB handler, question ID, print answer, question # number, print title, print text/html $output .= - &PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 0, $text); + &PrintQuestion($dbh, $Questions[$i], $answer, $i + 1, 0, $text); } + unless ($answer ) + { + $output.=$text?"\n".('-'x 20)."\nОтветы\n~~~~~~\n\n":h2('Ответы'); + for ($i = 0; $i <= $#Questions; $i++) { + $output .= + &PrintQuestion($dbh, $Questions[$i], -1, $i + 1, 0, $text); + } + } + return $output; } @@ -813,6 +850,8 @@ sub PrintTournament { %Tournament = &GetTournament($dbh, $Id) if ($Id); my ($URL) = $Tournament{'URL'}; + $URL=~s/http:\/znatoki\/boris\/reports\//$newsurl/ if url=~/kulichki/; + $URL=~s/\/znatoki\/boris\/reports\//$newsurl/ if url=~/kulichki/;; my ($Info) = $Tournament{'Info'}; my ($Copyright) = $Tournament{'Copyright'}; my $fname=$Tournament{'FileName'}; @@ -1038,6 +1077,8 @@ sub PrintField { $value =~ s/^\s+/
    /mg; $value =~ s/^\|([^\n]*)/

$1<\/pre>/mg;
 	    $value =~ s/\s+-+\s+/ – /mg;
+	    $value =~ s/(http:\/\/\S+[^\s\)\(\,\.])/$1<\/a>/g if $header !~ /^Авто/;
+#	    $value =~ s/(http:\/\/(?:\w+.)+[\w\\\~]+(\?[^\s.]+)?)/$1<\/a>/g if $header !~ /^Авто/;
 #	    $value =~ s/(\s)"/$1“/mg;
 #	    $value =~ s/^"/“/mg;
 #	    $value =~ s/"/”/mg;
@@ -1057,7 +1098,7 @@ sub PrintQuestion {
 	$qnum = $Question{'Number'}
 		if ($qnum == 0);
 	if (!$text) {
-		$output .= hr({width=>"50%"});
+		$output .= hr({width=>"50%"}) if $answer>=0;
 		if ($title) {
 			my (%Tour) = GetTournament($dbh, $Question{'ParentId'});
 			my (%Tournament) = GetTournament($dbh, $Tour{'ParentId'});
@@ -1074,28 +1115,30 @@ sub PrintQuestion {
 	}
 
 
-	$output.= "";
+	$output.= "" unless $text;
 
-	$output .=
-		&PrintField("Вопрос $qnum", $Question{'Question'}, $text);
-
-	if ($answer==1) {
+	if ($answer>=0) {$output .=
+		&PrintField("Вопрос $qnum", $Question{'Question'}, $text);}
+	else {$output .="$qnum. "}
+	if ($answer==1|| $answer==-1) {
 		$output .=
 			&PrintField("Ответ", $Question{'Answer'}, $text);
 
-		if ($Question{'Authors'}) {
+		if ($Question{'Authors'} ) {
                       my $q=$Question{'Authors'};
 ###АВТОРА!!
- 		      my $sth=$dbh->prepare("select Authors.Id,Name, Surname, Nicks from Authors, A2Q
+ 		      my $sth=$dbh->prepare("select Authors.CharId,Name, Surname, Nicks from Authors, A2Q
                                   where Authors.Id=Author And Question=$Id");
                        $sth->execute;
                        my ($AuthorId,$Name, $Surname,$other,$Nicks);
-
+                      if (!$text) {
                        while ((($AuthorId,$Name, $Surname,$Nicks)=$sth->fetchrow),$AuthorId)
                        {
-                         my ($firstletter)=$Name=~m/^./g;
+                          my ($firstletter)=$Name=~m/^./g;
                           $Name=~s/\./\\\./g;
-                           my $sha="(?:$Name\\s+$Surname)|(?:$Surname\\s+$Name)|(?:$firstletter\\.\\s*$Surname)|(?:$Surname\\s+$firstletter\\.)|(?:$Surname)|(?:$Name)";
+                          $Name=~s/ё/[её]/g;
+                          $Surname=~s/ё/[её]/g;
+                           my $sha="(?:$Name\\s+$Surname)|(?:$Surname\\s+$Name)|(?:$firstletter\\.\\s*$Surname)|(?:$Surname\\s+$firstletter\\.)|(?:$Surname)";
                            if ($Nicks)
                            {
                              $Nicks=~s/^\|//;
@@ -1110,8 +1153,12 @@ sub PrintQuestion {
                              }
                            }
                            $q=~s/($sha)/a({href=>url."?qofauthor=$AuthorId"},$1)/ei;
+                           unless ($1) 
+                             {   
+                                 $q=~s/$Name/a({href=>url."?qofauthor=$AuthorId"},$1)/ei;
+                             }
                        }
- 
+                      }
 			$output .= &PrintField("Автор(ы)", $q, $text);
 
 		}
@@ -1153,11 +1200,16 @@ EOTT
 		}
 
 
+
 $output.=""
 
 	}
-	$output.=br.a({href=> url."?metod=proxy&qid=$Id"}, 'Близкие вопросы').p
-             if $answer;
+	$output=~s/\(pic: ([^\)]*)\)/
/g unless $text;
+	my $qid=param('tour') ? (param('tour').".$Question{'Number'}" ): '';
+
+	$output.=br.a({href=> url."?metod=proxy&
+qid=$qid"}, 'Близкие вопросы').p
+             if $answer>0 && !$text && $qid;
 	return $output;
 }
 
@@ -1321,7 +1373,15 @@ sub PrintQOfAuthor
 {
 
     my ($dbh, $id) = @_;
-   $id=$dbh->quote($id);
+    unless ($id=~/^\d+$/) {
+      $id=$dbh->quote($id);
+      my $sth =  $dbh->prepare("SELECT Id FROM Authors WHERE CharId=$id");
+      $sth->execute;
+      ($id)=$sth->fetchrow;
+      $sth->finish;
+    }
+    $id=$dbh->quote($id);
+
     my $sth =  $dbh->prepare("SELECT  Name, Surname FROM Authors WHERE Id=$id");
     $sth->execute;
     my ($name,$surname)=$sth->fetchrow;
@@ -1343,7 +1403,7 @@ sub PrintQOfAuthor
 	} else {
 		$suffix = 'я';
 	}
-	print h2("Поиск в базе вопросов");
+#	print h2("Поиск в базе вопросов");
 	print printform;
 	print p({align=>"center"}, "Автор ".strong("$name $surname. ")
 	. " : $hits попадани$suffix.");
@@ -1565,41 +1625,86 @@ sub WriteFile {
 
 MAIN:
 {
+        
 	setlocale(LC_CTYPE,'russian');
 	my($i, $tour);
 	my($text) = (param('text')) ? 1 : 0;
+	if ($text) {
+		print header('text/plain');
+	} else {print header;}
 
 	my($dbh) = DBI->connect("DBI:mysql:chgk", "piataev", "")
 		or do {
-			print h1("Временные проблемы") . "База данных временно не
+			print h1("Временные проблемы") . "База вопросов временно не
 			работает. Заходите попозже.";
 			print &Include_virtual("../dimrub/db/reklama.html");
 		    print end_html;
 			die "Can't connect to DB chgk\n";
 		};
+	  my $sstr=param('sstr');
+	  if (param('qid')) {
+	      my $sth;
+	      my $qid=param('qid');
+		if ($qid !~ /^[0-9]*$/) {
+                    my ($fname,$t,$n)= split /\./ , $qid;
+                    $n=$t,$t='' unless $n;
+		    if ($n)
+		    {
+	                $sth = $dbh->prepare(
+                       "SELECT t2.Id FROM Tournaments as t1, 
+                        Tournaments as t2 
+			WHERE t1.FileName = '$fname.txt'
+                        AND t1.Id=t2.ParentId AND t2.Number=$t");
+		    }	
+		    else 
+		        {
+                          $sth = $dbh->prepare("SELECT Id FROM Tournaments
+			             WHERE FileName = '$fname.txt'");
+			}
+		    $sth->execute;
+	            $tour = ($sth->fetchrow)[0];
+                    $sth->finish;
+	            $sth = $dbh->prepare(
+                       "SELECT QuestionId FROM 
+                        Questions 
+			WHERE ParentId=$tour AND 
+                        Questions.Number=$n");
+		        $sth->execute;
+	                $qid = ($sth->fetchrow)[0];
+		}
+              my $query="SELECT Question, Answer from Questions where QuestionId=$qid";
+	      $sth=$dbh->prepare($query);
+	      $sth->execute;
+	      $sstr= join ' ',$sth->fetchrow;
+              $sth->finish;
+	      $searchin{'Question'}=1;
+	      $searchin{'Answer'}=1;
+              $sstr=~tr/ёЁ/еЕ/;
+              $sstr=~s/[^йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮa-zA-Z0-9]/ /gi;
+              $proxysstr=$sstr;
+              $proxysstr=makeproxysstr($dbh,\$proxysstr);
+ 	}
+
+
 	if (!param('comp') and !param('sqldump') and !$text) {
-	   print header;
-	   print start_html(-"title"=>'Database of the questions',
+	   my $title="Результаты поиска на \"". ($proxysstr||$sstr) .'"' 
+                                                    if ($proxysstr||$sstr);
+           $title||="База вопросов";
+
+	   print start_html(-"title"=>$title,
 	           -author=>'dimrub@icomverse.com',
 	           -bgcolor=>'#fff0e0',
 				  -vlink=>'#800020');
+print "\n";
+
 		print &Include_virtual("../dimrub/db/reklama.html");
 	}
 
 
-if ($^O =~ /win/i) {
-	$thislocale = "Russian_Russia.20866";
-} else {
-	$thislocale = "ru_RU.KOI8-R";
-}
-POSIX::setlocale( &POSIX::LC_ALL, $thislocale );
-
-if ((uc 'а') ne 'А') {print "Koi8-r locale not installed!\n"};
-
 
-	if ($text) {
-		print header('text/plain');
-	}
 
         if (param('hideequal')) {
 	           my ($sth)=  $dbh -> prepare("select first, second FROM equalto");
@@ -1674,18 +1779,6 @@ EOT
 		           (time_to_sec(now())-time_to_sec(t) >3600)")
 	} 
 	  elsif (param('qid')) {
-	      my $qid=param('qid');
-              my $query="SELECT Question, Answer from Questions where QuestionId=$qid";
-print $query if $printqueries;
-	      my $sth=$dbh->prepare($query);
-	      $sth->execute;
-	      my $sstr= join ' ',$sth->fetchrow;
-              $sth->finish;
-	      $searchin{'Question'}=1;
-	      $searchin{'Answer'}=1;
-      $sstr=~tr/ёЁ/еЕ/;
-$sstr=~s/[^йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮa-zA-Z0-9]/ /gi;
-#              print &PrintQuestion($dbh,$qid, 1, '!');
  	      &PrintSearch($dbh, $sstr, 'proxy');
  	}
  	elsif (param('getfile')){
@@ -1757,7 +1850,7 @@ function toggle(e) {
 
 EEE
 ;
-		print end_html;
+#		print end_html;
 	}
 	$dbh->disconnect;
 }