--- db/prgsrc/db.cgi	2003/01/27 13:04:25	1.86
+++ db/prgsrc/db.cgi	2003/04/04 10:01:27	1.94
@@ -8,11 +8,24 @@ use POSIX qw(locale_h);
 use locale;
 open STDERR, ">/var/tmp/errors1";
 my $newsurl='http://news.chgk.info/';
+my $cashednumber=500;
+my $outputbumber=10;
+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', 'Автор', 
@@ -30,7 +43,6 @@ my %metodchar=('rus',1,'old',2);
 
 
 
-my $thislocale;
 
 $searchin{$_}=1 foreach param('searchin');
 my %TypeName=('children'=>'Д', 'game'=>'Я', 'igp'=>'И',
@@ -145,13 +157,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;
 }
@@ -161,7 +171,7 @@ sub printform
 {
 
   my $qnumber=(" "x10)."Выводить по ". textfield(-name=>'kvo',
-                         -default=>param('kvo')||'150',
+                         -default=>param('kvo')||$outputbumber,
                          -size=>3,
                          -maxlength=>5)." вопросов";
   my $sstr=param('sstr');
@@ -174,8 +184,10 @@ sub printform
   @df=param('type');
   @df=('chgk','brain','igp','game','ehruditka','beskrylka') unless @df;
   $checked{lc $_}="checked" foreach @df;
-  $checked{'all'}=param('all')?"checked":"";
-  $checked{'any'}=param('all')?"":"checked";
+  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'};
 
@@ -184,9 +196,9 @@ return
 <<EOT
 <form method="get" enctype="application/x-www-form-urlencoded"
 action="/znatoki/cgi-bin/db.cgi">
-<h2>Поиск в базе данных</h2>
+<h2>Поиск в базе вопросов</h2>
 
-<input type="text" name="sstr" value=$sstr size="30" maxlength="50"> 
+<input type="text" name="sstr" value="$sstr" size="30" maxlength="50"> 
 <input type="submit" value="Поиск"> $qnumber
 <p>
 
@@ -211,7 +223,7 @@ action="/znatoki/cgi-bin/db.cgi">
 <input type="checkbox" $checked{'beskrylka'} name="type" value="beskrylka">&nbsp;"Бескрылка"
 </td>
 </tr><tr>
-<td colspan=5><input type="radio" $checked{'russian'} name="metod" value="rus"> Расширенный (с учетом грамматики, в вопросах всех типов)
+<td colspan=5><input type="radio" $checked{'rus'} name="metod" value="rus"> Расширенный (с учетом грамматики, в вопросах всех типов)
 </td>
 </tr><tr>
 <th align="left">Искать:
@@ -244,9 +256,14 @@ EOT
 }
 
 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;
@@ -272,18 +289,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;
 }
 
 
@@ -502,17 +510,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);
@@ -520,10 +517,7 @@ sub Search {
 	}
 	elsif ($metod eq 'proxy')
 	{
-#	  $searchin{'question'}=1;
-#	  $searchin{'answer'}=1;
 	  my @task=proxy($dbh,$s,$allnf);
-#	  $$s=$sstr;
 	  return @task
 	}
 
@@ -628,11 +622,12 @@ sub PrintList {
    my ($dbh,$Questions,$shablon,$was)=@_;
 
 	my $first=param('first') ||1;
-	my $kvo=param('kvo') ||150;
+	my $kvo=param('kvo') ||$outputbumber;
 
 	$first=$first-($first-1)%$kvo;
+        my $fkvo=param('fkvo')||($#$Questions+1);
 	my $last=$first+$kvo-1;
-	$last=scalar @$Questions if scalar @$Questions <$last;
+	$last=$fkvo if $fkvo<$last;
         my($f,$l);
         my $nav='';
         my $qs=query_string;
@@ -641,24 +636,24 @@ sub PrintList {
         my $sstr=param('sstr')||'';
         $qs=~s/sstr=[^\&]+/sstr=$sstr/;
         $qs=~s/\&was=[^\&]+//;
-        $qs.="&was=$was"||'';
+        $qs.="&was=$was" if $was;
+        $qs.="&fkvo=$fkvo" if $was;
         if ($first>$kvo*3+1)
         {
            $nav.=
             ("&nbsp;"x4).
             a({href=>url."?".$qs."\&first=1"},"<<").("&nbsp;"x4).
             a({href=>(url."?".$qs."\&first=".($first-$kvo))},"<").("&nbsp;"x4)
-	        }
-
+	}
         else {$nav.='&nbsp;'x15;}
 
      my ($fprint,$lprint);
-     my $llprint=$#$Questions- ($#$Questions+1)%$kvo+2;
-     if ($#$Questions+1<=$kvo*7)
+     my $llprint=$fkvo- ($fkvo)%$kvo+1; #
+     if ($fkvo<=$kvo*7)
      {         $fprint=1;
                $lprint=$llprint;
      }
-     elsif ($first>$kvo*3 && $#$Questions+1-$first>$kvo*3)
+     elsif ($first>$kvo*3 && $fkvo-$first>$kvo*3)
      {
        $fprint=$first-$kvo*3;
        $lprint=$first+$kvo*3;
@@ -687,12 +682,12 @@ sub PrintList {
 	{
 #	  next if $first-$f>$kvo*3;
 	  $l=$f+$kvo-1;
-	  $l=$#$Questions+1 if $l>$#$Questions+1;
+	  $l=$fkvo if $l>$fkvo+1;
 	  if ($f==$first) {$nav.="[$f-$l] ";}
 	  else {
                   $nav.= "[".a({href=>(url."?".$qs."\&first=$f")},"$f-$l")."] ";}
 	}
-        if ($lprint+$kvo<$#$Questions)
+        if ($lprint+$kvo<$fkvo)
         {
            $nav.=
             ("&nbsp;"x4).
@@ -725,7 +720,8 @@ sub PrintSearch {
 	print printform;
 	my @allnf;
 	my @Questions;
-	if ($was)
+	$was=0 if $metod eq 'proxy';
+	if ($was && ($metod ne 'proxy'))
 	{
 	  my $sth=$dbh->prepare ("select sstr,questions,allnf from lastqueries where id=".param('was'));
           $sth->execute;
@@ -734,10 +730,11 @@ sub PrintSearch {
           @Questions=unpack 'L*',$q; 
           @allnf=unpack 'L*',$nf;        
           $sth->finish;
-        } else 
+        }  
+        if (!$was || ($metod eq 'proxy') || (param('first')+param('kvo')>$cashednumber))
         {
              @Questions=&Search($dbh, \$sstr,$metod,$all,\@allnf);
-             my $tmp=$dbh->quote(pack("L*",@Questions));
+             my $tmp=$dbh->quote(pack("L*",@Questions[0..$cashednumber]));
              my $qsstr=$dbh->quote($sstr);
              my $nf=$dbh->quote(pack("L*", @allnf));
              my $ss=200;
@@ -780,7 +777,7 @@ print "$query" if $printqueries;
 
         }
 
-
+        $hits=param("fkvo")||$hits;
 
 	if ($hits =~ /1.$/  || $hits =~ /[5-90]$/) {
 		$suffix = 'й';
@@ -1111,7 +1108,6 @@ sub PrintQuestion {
 			my (%Tour) = GetTournament($dbh, $Question{'ParentId'});
 			my (%Tournament) = GetTournament($dbh, $Tour{'ParentId'});
 			my $fname=$Tournament{'FileName'};
-#return "" if $fname=~/mgp0203/;
 			$fname=~s/\.txt//;
 			$titles .=
 				dd(img({src=>"/icons/folder.open.gif"}) . " " .
@@ -1136,16 +1132,18 @@ sub PrintQuestion {
 		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/^\|//;
@@ -1160,6 +1158,10 @@ 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);
@@ -1208,8 +1210,11 @@ $output.="</span>"
 
 	}
 	$output=~s/\(pic: ([^\)]*)\)/<p><img src="\/znatoki\/images\/db\/$1"><p>/g unless $text;
-	$output.=br.a({href=> url."?metod=proxy&qid=$Id"}, 'Близкие вопросы').p
-             if $answer>0 && !$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;
 }
 
@@ -1373,7 +1378,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;
@@ -1395,7 +1408,7 @@ sub PrintQOfAuthor
 	} else {
 		$suffix = 'я';
 	}
-	print h2("Поиск в базе вопросов");
+#	print h2("Поиск в базе вопросов");
 	print printform;
 	print p({align=>"center"}, "Автор ".strong("$name $surname. ")
 	. " : $hits попадани$suffix.");
@@ -1617,6 +1630,7 @@ sub WriteFile {
 
 MAIN:
 {
+        
 	setlocale(LC_CTYPE,'russian');
 	my($i, $tour);
 	my($text) = (param('text')) ? 1 : 0;
@@ -1624,17 +1638,65 @@ MAIN:
 		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 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');
@@ -1647,14 +1709,6 @@ th	{font-size: x-small; font-family : sa
 	}
 
 
-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 (param('hideequal')) {
@@ -1724,25 +1778,13 @@ EOT
                 &PrintQOfAuthor($dbh,param('qofauthor'));
         }
           elsif (param('sstr')||param('was')) {
-		&PrintSearch($dbh, param('sstr'), param('metod'),param('was'));
+		&PrintSearch($dbh, $sstr||' ', param('metod')||'',param('was'));
 		$dbh->do("delete from lastqueries where
                       (TO_DAYS(NOW()) - TO_DAYS(t) >= 2) OR
 		           (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');
+ 	      &PrintSearch($dbh, $sstr||'', 'proxy');
  	}
  	elsif (param('getfile')){
           print &writefile
@@ -1801,6 +1843,7 @@ $sstr=~s/[^йцукенгшщзхъфывапролджэячсмит
 	}
 	if (!$text) {
 		print &Include_virtual("../dimrub/db/footer.html");
+		print p."<center><font size=-2>Обновление: ".&Include_virtual("../dimrub/db/date")."</center></font>";
 print <<EEE
   <SCRIPT LANGUAGE="JavaScript">
 function toggle(e) {
@@ -1813,7 +1856,7 @@ function toggle(e) {
 </SCRIPT>
 EEE
 ;
-		print end_html;
+#		print end_html;
 	}
 	$dbh->disconnect;
 }