[BACK]Return to db.cgi CVS log [TXT] [DIR] Up to [Local Repository] / db / prgsrc

Diff for /db/prgsrc/db.cgi between versions 1.94 and 1.113

version 1.94, 2003/04/04 10:01:27 version 1.113, 2003/04/20 12:48:48
Line 6  use strict; Line 6  use strict;
 use Time::Local;  use Time::Local;
 use POSIX qw(locale_h);  use POSIX qw(locale_h);
 use locale;  use locale;
   use vars qw($opt_z);
   use Getopt::Std;
   getopts('z');
 open STDERR, ">/var/tmp/errors1";  open STDERR, ">/var/tmp/errors1";
 my $newsurl='http://news.chgk.info/';  my $newsurl='http://news.chgk.info/';
   my $reklama="../dimrub/db/reklama.html";
   $reklama="../reklama.html" if $opt_z;
   my $HTMLDIR="/znatoki/dimrub/db/baza/";
   my $realHTMLDIR;
   if ($^O =~ /win/i) {
    $realHTMLDIR="/html/znatoki/baza/";
   } else 
   {
     $realHTMLDIR="/home/znatoki/public_html/dimrub/db/baza/";
   }
   my $usehtml=1;
   my $usewas=0;
 my $cashednumber=500;  my $cashednumber=500;
 my $outputbumber=10;  my $outputnumber=10;
 my ($proxyptext,$proxysstr);  my ($proxyptext,$proxysstr);
 my $printqueries=0;  my $printqueries=0;
   my $url=url||'';
   my $qs=query_string;
   my $globaloutput;
 my %forbidden=();  my %forbidden=();
 my $debug=0; #added by R7  my $debug=0; #added by R7
   my $outputkvo=param('kvo') ||$outputnumber;
   $outputkvo=100 if $outputkvo>100;
   
 if (param('debug')) {$debug=1; $printqueries=1}  if (param('debug')) {$debug=1; $printqueries=1}
 *STDERR=*STDOUT if $debug;  *STDERR=*STDOUT if $debug;
   if ($url !~ /db\.chgk\.info/ && $url !~ /localhost/ && $url !~ /bilbo/) {
      my $u="http://db.chgk.info/cgi-bin/db.cgi?$qs";
      Redirect ($u);
      exit;
   }
   if (!param('sstr') && param('all')) {
              my $destination='http://db.chgk.info/all.html';
                   Redirect($destination);
                   exit;
   }
 my $thislocale;  my $thislocale;
 if ($^O =~ /win/i) {  if ($^O =~ /win/i) {
         $thislocale = "Russian_Russia.20866";          $thislocale = "Russian_Russia.20866";
Line 52  my %TypeName=('children'=>'Д', 'game'=>' Line 83  my %TypeName=('children'=>'Д', 'game'=>'
   
 my $all=param('all');  my $all=param('all');
 $all=0 if lc $all eq 'no';  $all=0 if lc $all eq 'no';
 my ($PWD) = `pwd`;  my ($PWD) = `pwd` if $^O!~/win/i;
 chomp $PWD;  chomp $PWD if $PWD;
 my ($SRCPATH) = "/home/piataev/public_html/dimrub/src";  my ($SRCPATH) = "/home/piataev/public_html/dimrub/src";
 my ($ZIP) = "/usr/local/bin/zip";  my ($ZIP) = "/usr/local/bin/zip";
 my $DUMPFILE = "/tmp/chgkdump";  my $DUMPFILE = "/tmp/chgkdump";
Line 75  my @months=('000','Jan',"Feb","Mar","Apr Line 106  my @months=('000','Jan',"Feb","Mar","Apr
 sub NewEnough {  sub NewEnough {
         my ($a) = @_;          my ($a) = @_;
         my ($year, $month, $day) = split('-', $a);          my ($year, $month, $day) = split('-', $a);
           $month=1 if ($month<=0);
           $day=1 if ($day<=0);
         return (time - timelocal(0, 0, 0, $day, $month -1, $year) < $TMSECS);          return (time - timelocal(0, 0, 0, $day, $month -1, $year) < $TMSECS);
 }  }
   
 # Reads one question from the DB. Gets DB handler and Question ID.  # Reads one question from the DB. Gets DB handler and Question ID.
   
   sub Redirect {
   my ($destination) = @_;
   print <<EndOfHTML;
   Content-type: text/html
   Location: $destination
   
   <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
   <HTML><HEAD><TITLE>Redirection</TITLE></HEAD>
   <BODY BGCOLOR="#FFFFFF">
   <H1>Redirection</H1>
   <P>It appears that your browser cannot handle redirections
   automatically. You can proceed to the randomly-selected page 
   by clicking <A HREF="$destination">here</A>.</P>
   </BODY>
   </HTML>
   EndOfHTML
   ;
   }
   
   
   
   
 sub GetTournament {  sub GetTournament {
         my ($dbh, $Id) = @_;          my ($dbh, $Id) = @_;
         my (%Tournament, $field, @arr);          my (%Tournament, $field, @arr);
Line 98  sub GetTournament { Line 153  sub GetTournament {
         return %Tournament;          return %Tournament;
 }  }
   
   sub fetchquestion {
           my ($sth,$q,$WithTour)=@_;
           if ($WithTour) {
                   ($$q{'Question'},$$q{'Answer'},$$q{'Comments'},$$q{'Authors'},
                   $$q{'Number'}, 
                   $$q{'Title'}, $$q{'TourTitle'}, $$q{'FileName'},$$q{'PlayedAt'},$$q{'TourNumber'}) = 
                   $sth->fetchrow;
           } else {
                   ($$q{'Question'},$$q{'Answer'},$$q{'Comments'},$$q{'Authors'},
                   $$q{'Number'})= 
                   $sth->fetchrow;
           }
   }
   
   
   
   sub SelectQuestions {
           my ($dbh,$q,$WithTour) = @_;
           my %q=();
           $_ = "QuestionId=$_" foreach @$q;
           my $where=join " OR ",@$q;
           $where||=1;
           $where="($where) AND Questions.ParentId=t1.Id AND t1.ParentId=t2.Id" 
                   if $WithTour;
   
           my $query;
           if ($WithTour) {
                   $query="SELECT Questions.Question, Answer, Comments, Authors,
                           Questions.Number
                           , t2.Title, t1.Title, t2.FileName,  t2.PlayedAt,t1.Number
                           from Questions,Tournaments as t1, Tournaments as t2 
                           WHERE $where";
           } else {
                   $query="SELECT Questions.Question, Answer, Comments, Authors,
                           Questions.Number from Questions 
                           WHERE $where";
           }
   
           my $sth;
           $sth=$dbh->prepare($query);
           $sth->execute;
           return $sth;
   }
   
   
 # Reads one question from the DB. Gets DB handler and Question ID.  # Reads one question from the DB. Gets DB handler and Question ID.
 sub GetQuestion {  sub GetQuestion {
         my ($dbh, $QuestionId) = @_;          my ($dbh, $QuestionId) = @_;
Line 119  sub GetQuestion { Line 219  sub GetQuestion {
         return %Question;          return %Question;
 }  }
   
   sub tourhref {
      my ($t,$a,$gr)=@_;
      my $res;
      if ($usehtml) {
           $res=$t;
           $res.=$a?"-a":"-q" unless $gr;
           $res.=".html";
           $res=~s/(\#\d+)(.*)$/$2$1/;
           $res="$HTMLDIR$res" unless $opt_z;
           return $res;
      } else {
           $res=$url;
           $res.="?tour=$t";
           $res.=$a?"?answers=1":"";
           return $res;
      }
   
   }
   
 # Gets numbers of all the questions from the given tour.  # Gets numbers of all the questions from the given tour.
 sub GetTourQuestions {  sub GetTourQuestions {
         my ($dbh, $ParentId) = @_;          my ($dbh, $ParentId) = @_;
         my (@arr, @Questions);          my (@arr, @Questions);
   
         my ($sth) = $dbh->prepare("SELECT QuestionId FROM Questions          my ($sth) = $dbh->prepare("SELECT QuestionId FROM Questions
                 WHERE ParentId=$ParentId order by Number");                  WHERE ParentId=$ParentId order by Number");
   
Line 170  sub count Line 288  sub count
 sub printform  sub printform
 {  {
   
   my $qnumber=("&nbsp;"x10)."Выводить по ". textfield(-name=>'kvo',    my $qnumber=("&nbsp;"x10)."Выводить по 
                          -default=>param('kvo')||$outputbumber,    <input type=\"text\" name=\"kvo\" value=$outputkvo size=\"3\" maxlength=\"5\">";
                          -size=>3,  #textfield(-name=>'kvo',
                          -maxlength=>5)." вопросов";  #                         -default=>6,
   #                         -size=>3,
   #                         -maxlength=>5)." вопросов";
   my $sstr=param('sstr');    my $sstr=param('sstr');
   my @df=keys %searchin;    my @df=keys %searchin;
   my %checked;    my %checked;
     $checked{lc $_}="" foreach ('Question','Answer','Comments','Authors','Sources','old','rus',
         'chgk','brain','igp','game','ehruditka','beskrylka');
   @df=('Question', 'Answer') unless @df;    @df=('Question', 'Answer') unless @df;
   $checked{lc $_}="checked" foreach @df;    $checked{lc $_}="checked" foreach @df;
   my $fields=checkbox_group('searchin',['Question','Answer','Comments','Authors','Sources'], [@df],    my $fields=checkbox_group('searchin',['Question','Answer','Comments','Authors','Sources'], [@df],
Line 189  sub printform Line 311  sub printform
   $checked{'all'}=$all?"checked":"";    $checked{'all'}=$all?"checked":"";
   $checked{'any'}=$all?"":"checked";    $checked{'any'}=$all?"":"checked";
   $checked{lc param('metod')}="checked";    $checked{lc param('metod')}="checked";
   $checked{'russian'}=1 unless $checked{'russian'} || $checked{'old'};    $checked{'rus'}=1 unless $checked{'rus'} || $checked{'old'};
   
 #################################################  #################################################
 return     return   
Line 323  $sstr=~tr/йцукенгшщзхъфывапролджэячсмить Line 445  $sstr=~tr/йцукенгшщзхъфывапролджэячсмить
                 $qw= $dbh->quote (uc $w[$i]);                  $qw= $dbh->quote (uc $w[$i]);
                 $query="  select distinct w2 from nests                  $query="  select distinct w2 from nests
                                 where w1=$qw";                                  where w1=$qw";
 print "$query",br if $printqueries;  
                 $sth=$dbh -> prepare($query);                  $sth=$dbh -> prepare($query);
                 $sth -> execute;                  $sth -> execute;
                 @{$nf[$i]}=();                  @{$nf[$i]}=();
Line 354  print "$query",br if $printqueries; Line 475  print "$query",br if $printqueries;
   
             my $kvo=0;              my $kvo=0;
             push @$allnf, @{$_} foreach @nf;              push @$allnf, @{$_} foreach @nf;
             print "nf=@$allnf" if $printqueries;  
   
             foreach $i (0..$#w) #запросы в базу...              foreach $i (0..$#w) #запросы в базу...
             {              {
Line 364  print "$query",br if $printqueries; Line 484  print "$query",br if $printqueries;
   
   
   
               $_= " word2question.word=".$_. ' ' foreach @arr;                $_= " word2question.word=$_" foreach @arr;
               $_= " nf.id=".$_. ' ' foreach @arr1;                $_= " nf.id=".$_. ' ' foreach @arr1;
 #              @arr=(0) unless @arr;  #              @arr=(0) unless @arr;
               $query="select questions from word2question where". (join ' OR ', @arr);                $query="select questions from word2question where (". (join ' OR ', @arr).") AND length(questions)<80000";
 print STDERR "!$query\n",br if $printqueries;  
   
               $sth=$dbh -> prepare($query);                $sth=$dbh -> prepare($query);
               $sth->execute;                $sth->execute;
Line 380  print STDERR "!$query\n",br if $printque Line 499  print STDERR "!$query\n",br if $printque
               }                }
               $sth->finish;                $sth->finish;
               $query="select number from nf where ".(join ' OR ', @arr1);                $query="select number from nf where ".(join ' OR ', @arr1);
 print "$query\n",br if $printqueries;  
               $sth=$dbh -> prepare($query);                $sth=$dbh -> prepare($query);
               $sth->execute;                $sth->execute;
   
Line 428  print "$query\n",br if $printqueries; Line 546  print "$query\n",br if $printqueries;
                }                 }
             }    #foreach $i              }    #foreach $i
   
 #print "keys tasksof", join ' ', keys %{$tasksof{0}};  
 #Ищем пересечение или объединение списков вопросов (значений %tasksof)  #Ищем пересечение или объединение списков вопросов (значений %tasksof)
             foreach $sf (keys %tasksof)              foreach $sf (keys %tasksof)
            {             {
Line 438  print "$query\n",br if $printqueries; Line 555  print "$query\n",br if $printqueries;
                              keys %count) ;                               keys %count) ;
   
   
 print "\n\$#tasks=",$#tasks,br if $printqueries;  
 ############ Сортировка найденных вопросов  ############ Сортировка найденных вопросов
   
 foreach (keys %wordsof)  foreach (keys %wordsof)
Line 451  foreach (keys %wordsof) Line 567  foreach (keys %wordsof)
   
 ############  ############
   
 print "tasks=@tasks" if $printqueries;  
   
 #print "$_ $relevance{$_} | " foreach @tasks;  
 #print br;  
 print "allnf=@$allnf",br if $printqueries;  
         return  @tasks;          return  @tasks;
 }  }
   
Line 544  sub Search { Line 656  sub Search {
            $where=      $$q{'matchexp'};             $where=      $$q{'matchexp'};
            $query= "SELECT Questionid FROM Questions             $query= "SELECT Questionid FROM Questions
                 WHERE $where";                  WHERE $where";
            print br."Query is: $query".br if $debug;  
   
            $sth = $dbh->prepare($query);             $sth = $dbh->prepare($query);
          } else           } else
Line 576  sub Search { Line 687  sub Search {
                 WHERE ($f LIKE $sstr) AND (".&makewhere.") ORDER BY QuestionId";                  WHERE ($f LIKE $sstr) AND (".&makewhere.") ORDER BY QuestionId";
   
   
 print $query if $printqueries;  
           $sth = $dbh->prepare($query)            $sth = $dbh->prepare($query)
         } #else -- processing old-style query (R7)          } #else -- processing old-style query (R7)
   
Line 585  print $query if $printqueries; Line 695  print $query if $printqueries;
                 push @Questions, $arr[0] unless $forbidden{$arr[0]};                  push @Questions, $arr[0] unless $forbidden{$arr[0]};
         }          }
         $sth->finish;          $sth->finish;
 print "@Questions" if $printqueries;  
                   
         return @Questions;          return @Questions;
 }  }
Line 620  sub NoCase { Line 729  sub NoCase {
   
 sub PrintList {  sub PrintList {
    my ($dbh,$Questions,$shablon,$was)=@_;     my ($dbh,$Questions,$shablon,$was)=@_;
           my $Output;
         my $first=param('first') ||1;          my $first=param('first') ||1;
         my $kvo=param('kvo') ||$outputbumber;  
   
         $first=$first-($first-1)%$kvo;          $first=$first-($first-1)%$outputkvo;
         my $fkvo=param('fkvo')||($#$Questions+1);          my $fkvo=param('fkvo')||($#$Questions+1);
         my $last=$first+$kvo-1;          my $last=$first+$outputkvo-1;
         $last=$fkvo if $fkvo<$last;          $last=$fkvo if $fkvo<$last;
         my($f,$l);          my($f,$l);
         my $nav='';          my $nav='';
Line 635  sub PrintList { Line 743  sub PrintList {
         $qs=~s/\&first\=[^\&]+//g;          $qs=~s/\&first\=[^\&]+//g;
         my $sstr=param('sstr')||'';          my $sstr=param('sstr')||'';
         $qs=~s/sstr=[^\&]+/sstr=$sstr/;          $qs=~s/sstr=[^\&]+/sstr=$sstr/;
         $qs=~s/\&was=[^\&]+//;          if ($usewas) {
         $qs.="&was=$was" if $was;                  $qs=~s/\&was=[^\&]+//;
         $qs.="&fkvo=$fkvo" if $was;                  $qs.="&was=$was" if $was;
         if ($first>$kvo*3+1)                  $qs.="&fkvo=$fkvo" if $was;
           }
           if ($first>$outputkvo*3+1)
         {          {
            $nav.=             $nav.=
             ("&nbsp;"x4).              ("&nbsp;"x4).
             a({href=>url."?".$qs."\&first=1"},"<<").("&nbsp;"x4).              a({href=>$url."?".$qs."\&first=1"},"<<").("&nbsp;"x4).
             a({href=>(url."?".$qs."\&first=".($first-$kvo))},"<").("&nbsp;"x4)              a({href=>($url."?".$qs."\&first=".($first-$outputkvo))},"<").("&nbsp;"x4)
         }          }
         else {$nav.='&nbsp;'x15;}          else {$nav.='&nbsp;'x15;}
   
      my ($fprint,$lprint);       my ($fprint,$lprint);
      my $llprint=$fkvo- ($fkvo)%$kvo+1; #       my $llprint=$fkvo- ($fkvo)%$outputkvo+1; #
      if ($fkvo<=$kvo*7)       if ($fkvo<=$outputkvo*7)
      {         $fprint=1;       {         $fprint=1;
                $lprint=$llprint;                 $lprint=$llprint;
      }       }
      elsif ($first>$kvo*3 && $fkvo-$first>$kvo*3)       elsif ($first>$outputkvo*3 && $fkvo-$first>$outputkvo*3)
      {       {
        $fprint=$first-$kvo*3;         $fprint=$first-$outputkvo*3;
        $lprint=$first+$kvo*3;         $lprint=$first+$outputkvo*3;
      }        } 
      elsif  ($first<=$kvo*3)       elsif  ($first<=$outputkvo*3)
      {       {
         $fprint=1; $lprint=6*$kvo+1;          $fprint=1; $lprint=6*$outputkvo+1;
      }       }
      else       else
      {        { 
            $lprint=$llprint;             $lprint=$llprint;
            $fprint=$lprint-$kvo*6             $fprint=$lprint-$outputkvo*6
      }       }
                     
 #        my $fprint=($first>$kvo*3) ? $first-$kvo*3 : 1;  #        my $fprint=($first>$outputkvo*3) ? $first-$outputkvo*3 : 1;
 #        my $lprint=$#$Questions+1-$fprint>$kvo*7 ? $kvo*7 :$#$Questions+1;  #        my $lprint=$#$Questions+1-$fprint>$outputkvo*7 ? $outputkvo*7 :$#$Questions+1;
 #        if ($lprint-$fprint<$kvo*6 && $fprint>1)  #        if ($lprint-$fprint<$outputkvo*6 && $fprint>1)
 #        {  #        {
 #            $fprint=$lprint-$kvo*6;  #            $fprint=$lprint-$outputkvo*6;
 #            $fprint=1 if ($fprint<=0)   #            $fprint=1 if ($fprint<=0) 
 #        }  #        }
   
   
   
         for($f=$fprint; $f<=$lprint; $f+=$kvo)          for($f=$fprint; $f<=$lprint; $f+=$outputkvo)
         {          {
 #         next if $first-$f>$kvo*3;  #         next if $first-$f>$outputkvo*3;
           $l=$f+$kvo-1;            $l=$f+$outputkvo-1;
           $l=$fkvo if $l>$fkvo+1;            $l=$fkvo if $l>$fkvo+1;
           if ($f==$first) {$nav.="[$f-$l] ";}            if ($f==$first) {$nav.="[$f-$l] ";}
           else {            else {
                   $nav.= "[".a({href=>(url."?".$qs."\&first=$f")},"$f-$l")."] ";}                    $nav.= "[".a({href=>($url."?".$qs."\&first=$f")},"$f-$l")."] ";}
         }          }
         if ($lprint+$kvo<$fkvo)          if ($lprint+$outputkvo<$fkvo)
         {          {
            $nav.=             $nav.=
             ("&nbsp;"x4).              ("&nbsp;"x4).
             a({href=>(url."?".$qs."\&first=".($first+$kvo))},">").("&nbsp;"x4).              a({href=>($url."?".$qs."\&first=".($first+$outputkvo))},">").("&nbsp;"x4).
             a({href=>url."?".$qs."\&first=$llprint"},">>").("&nbsp;"x4)              a({href=>$url."?".$qs."\&first=$llprint"},">>").("&nbsp;"x4)
         }          }
           $Output.= "$nav".br."\n";
           my @q=@$Questions[$first-1..$last-1];
         print "$nav".br."\n";          my %q=();
           my $sth=SelectQuestions($dbh,\@q,1);
         for (my $i = $first; $i <= $last; $i++) {          for (my $i = $first; $i <= $last; $i++) {
                 my $output = &PrintQuestion($dbh, $$Questions[$i-1], 1, 0, 1);                  fetchquestion($sth,\%q,1);
                   my $output;
                   $output = &PrintQuestion($dbh, \%q, 1, 0, 1,0,1  );
                 if (param('metod') && (param('metod') eq 'rus' || param('metod') eq 'proxy'))                  if (param('metod') && (param('metod') eq 'rus' || param('metod') eq 'proxy'))
                 {                  {
                      $output=~s/\b($shablon)\b/\<strong\>$1\<\/strong\>/gi;                       $output=~s/\b($shablon)\b/\<strong\>$1\<\/strong\>/gi;
                 } else {                  } else {
                      $output=~s/($shablon)/\<strong\>$1\<\/strong\>/gi;                       $output=~s/($shablon)/\<strong\>$1\<\/strong\>/gi;
                 }                  }
                 print $output;                  $Output.= $output;
         }          }
           $sth->finish;
   
           $Output.= "$nav".br."\n";
         print "$nav".br."\n";          return $Output;
   
 }  }
   
 sub PrintSearch {  sub PrintSearch {
           my $Output='';
         my ($dbh, $sstr, $metod,$was) = @_;          my ($dbh, $sstr, $metod,$was) = @_;
         my $t=time;          my $t=time;
 #       print h2("Поиск в базе вопросов");          $Output.= printform;
         print printform;  
         my @allnf;          my @allnf;
         my @Questions;          my @Questions;
         $was=0 if $metod eq 'proxy';          $was=0 if $metod eq 'proxy';
         if ($was && ($metod ne 'proxy'))          if ($usewas && $was && ($metod ne 'proxy'))
         {          {
           my $sth=$dbh->prepare ("select sstr,questions,allnf from lastqueries where id=".param('was'));            my $sth=$dbh->prepare ("select sstr,questions,allnf from lastqueries where id=".param('was'));
           $sth->execute;            $sth->execute;
Line 731  sub PrintSearch { Line 844  sub PrintSearch {
           @allnf=unpack 'L*',$nf;                    @allnf=unpack 'L*',$nf;        
           $sth->finish;            $sth->finish;
         }            }  
         if (!$was || ($metod eq 'proxy') || (param('first')+param('kvo')>$cashednumber))          if (!$was || ($metod eq 'proxy') || (param('first')+$outputkvo>$cashednumber))
         {          {
              @Questions=&Search($dbh, \$sstr,$metod,$all,\@allnf);               @Questions=&Search($dbh, \$sstr,$metod,$all,\@allnf);
                $cashednumber=$#Questions if $cashednumber>$#Questions;
              my $tmp=$dbh->quote(pack("L*",@Questions[0..$cashednumber]));               my $tmp=$dbh->quote(pack("L*",@Questions[0..$cashednumber]));
              my $qsstr=$dbh->quote($sstr);               my $qsstr=$dbh->quote($sstr);
              my $nf=$dbh->quote(pack("L*", @allnf));               my $nf=$dbh->quote(pack("L*", @allnf));
              my $ss=200;               my $ss=200;
              do                if ($usewas) {
              {                  do 
                $was=int rand(32000);                          {
              }                                  $was=int rand(32000);
              while (--$ss && (!$dbh->do ("insert into lastqueries (id,sstr,questions,allnf)                           }
                   while (--$ss && (!$dbh->do ("insert into lastqueries (id,sstr,questions,allnf) 
                          values ($was, $qsstr,$tmp,$nf)")));                           values ($was, $qsstr,$tmp,$nf)")));
              print "Something is wrong...".br unless $ss;                  $Output.= "Something is wrong...".br unless $ss;
                 }
         }          }
   
   
   
         print p. "Время поиска: " . (time-$t) ." сек.".p;          $Output.= p. "Время поиска: " . (time-$t) ." сек.".p;
         my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1);          my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1);
   
         my $shablon;          my $shablon;
Line 760  sub PrintSearch { Line 876  sub PrintSearch {
            $where.= " or w2=$_ " foreach @allnf;             $where.= " or w2=$_ " foreach @allnf;
            my $query="select w1 from nests where $where";             my $query="select w1 from nests where $where";
            my $sth=$dbh->prepare($query);             my $sth=$dbh->prepare($query);
 print "$query" if $printqueries;  
   
            $sth->execute;             $sth->execute;
            my @shablon;             my @shablon;
Line 773  print "$query" if $printqueries; Line 888  print "$query" if $printqueries;
            $shablon=~s/[её]/\[ЕЁ\]/gi;             $shablon=~s/[её]/\[ЕЁ\]/gi;
 #           $shablon=~s/([йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ])/&NoCase($1)/ge;  #           $shablon=~s/([йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ])/&NoCase($1)/ge;
            $shablon=qr/$shablon/i;             $shablon=qr/$shablon/i;
            print "!$shablon!",br if $printqueries;  
   
         }          }
   
Line 787  print "$query" if $printqueries; Line 901  print "$query" if $printqueries;
                 $suffix = 'я';                  $suffix = 'я';
         }          }
   
         print p({align=>"center"}, "Результаты поиска на " . strong($sstr)          $Output.= p({align=>"center"}, "Результаты поиска на " . strong($sstr)
         . " : $hits попадани$suffix.");          . " : $hits попадани$suffix.");
   
         if (param('word')) {          if (param('word')) {
Line 804  print "$query" if $printqueries; Line 918  print "$query" if $printqueries;
           s/(\W)/\\$1/g foreach (@sar);            s/(\W)/\\$1/g foreach (@sar);
           $shablon=join "|",@sar;            $shablon=join "|",@sar;
         }          }
         PrintList($dbh,\@Questions,$shablon,$was);          $Output.=PrintList($dbh,\@Questions,$shablon,$was);
           return $Output;
 }  }
   
 sub PrintRandom {  sub PrintRandom {
    my ($dbh, $type, $num, $text) = @_;     my ($dbh, $type, $num, $text) = @_;
    my $razd=param('razd');     my $razd=param('razd');
      my %q;
    my $answer=$razd?0:1;     my $answer=$razd?0:1;
      my @answers;
    my (@Questions) = &Get12Random($dbh, $type, $num);     my (@Questions) = &Get12Random($dbh, $type, $num);
         my ($output, $i) = ('', 0);          my ($output, $i) = ('', 0);
   
Line 820  sub PrintRandom { Line 937  sub PrintRandom {
                 $output .=                  $output .=
                         h2({align=>"center"}, "$num случайных вопросов.");                          h2({align=>"center"}, "$num случайных вопросов.");
         }          }
           my $sth=SelectQuestions($dbh,\@Questions,0);
         for ($i = 0; $i <= $#Questions; $i++) {          for ($i = 0; $i <= $#Questions; $i++) {
                 # Passing DB handler, question ID, print answer, question                  fetchquestion($sth,\%q,0);
                 # number, print title, print text/html  
                 $output .=                  $output .=
                         &PrintQuestion($dbh, $Questions[$i], $answer, $i + 1, 0, $text);                          &PrintQuestion($dbh, \%q, $answer, $i + 1, 0, $text,1);
                           push @answers, $q{'Answer'};
         }          }
           $sth->finish;
         unless ($answer )          unless ($answer )
         {           { 
          $output.=$text?"\n".('-'x 20)."\nОтветы\n~~~~~~\n\n":h2('Ответы');           $output.=$text?"\n".('-'x 20)."\nОтветы\n~~~~~~\n\n":h2('Ответы');
            $sth=SelectQuestions($dbh,\@Questions,0);
          for ($i = 0; $i <= $#Questions; $i++) {           for ($i = 0; $i <= $#Questions; $i++) {
                 $output .=  #                fetchquestion($sth,\%q,0);
                         &PrintQuestion($dbh, $Questions[$i], -1, $i + 1, 0, $text);  #               $output .=
   #                       &PrintQuestion($dbh, \%q, -1, $i + 1, 0, $text,1);
                   $output.=$text?("Ответ ". ($i+1).": $answers[$i]\n\n"):
                           b("Ответ ". ($i+1).": "). $answers[$i].p;
          }           }
         }          }
   
Line 855  sub PrintTournament { Line 977  sub PrintTournament {
         %Tournament = &GetTournament($dbh, $Id) if ($Id);          %Tournament = &GetTournament($dbh, $Id) if ($Id);
   
         my ($URL) = $Tournament{'URL'};          my ($URL) = $Tournament{'URL'};
         $URL=~s/http:\/znatoki\/boris\/reports\//$newsurl/ if url=~/kulichki/;          $URL=~s/http:\/znatoki\/boris\/reports\//$newsurl/ if $url=~/kulichki/;
         $URL=~s/\/znatoki\/boris\/reports\//$newsurl/ if url=~/kulichki/;;          $URL=~s/\/znatoki\/boris\/reports\//$newsurl/ if url=~/kulichki/;;
         my ($Info) = $Tournament{'Info'};          my ($Info) = $Tournament{'Info'};
         my ($Copyright) = $Tournament{'Copyright'};          my ($Copyright) = $Tournament{'Copyright'};
Line 910  sub PrintTournament { Line 1032  sub PrintTournament {
                 } else {                  } else {
                         $qnum = '';                          $qnum = '';
                 }                  }
                 if ($Tournament{'Type'} =~ /Г/) {                  if ($Tournament{'Type'} !~ /[ТЧ]/) {
                     $SingleTour=0;                      $SingleTour=0;
                         $imgsrc = "/icons/folder.gif";                          $imgsrc = "/icons/folder.gif";
                         $alt = "[*]";                          $alt = "[*]";
Line 932  sub PrintTournament { Line 1054  sub PrintTournament {
                else {$textid=$Tournament{'Id'}};                 else {$textid=$Tournament{'Id'}};
                                   
   
                 if ($SingleTour or $Tournament{'Type'} =~ /Т/) {                  if ($SingleTour or ($Tournament{'Type'} =~ /Т/)) {
                         $list .= dd(img({src=>$imgsrc, alt=>$alt})                          $list .= dd(img({src=>$imgsrc, alt=>$alt})
                                 . " " . $Tournament{'Title'} . " " .                                  . " " . $Tournament{'Title'} . " " .
                                     $Tournament{'PlayedAt'} . $qnum) .                                      ($Tournament{'PlayedAt'}||"") . $qnum) .
                                 dl(                                  dl(
                                         dd("["                                          dd("["
                                                 . a({href=>url .  "?tour=$textid&answer=0"},                                                  . a({href=>tourhref($textid,0)},
                                                 "вопросы") . "] ["                                                  "вопросы") . "] ["
                   . a({href=>url .  "?tour=$textid&answer=1"},                    . a({href=>tourhref($textid,1)},
                   "вопросы + ответы") . "]")                    "вопросы + ответы") . "]")
                                 );                                  );
                 } else {                  } else {
                         $list .= dd(a({href=>url . "?tour=$textid&comp=1"},                          $list .= dd(a({href=>
                                 img({src=>'/icons/compressed.gif', alt=>'[ZIP]', border=>1})). " " .                                    $url . "?tour=$textid&comp=1"},
                                   img({src=>'/icons/compressed.gif', alt=>'[ZIP]', border=>1})). 
                                   " " . 
                                 img({src=>$imgsrc, alt=>$alt})                                  img({src=>$imgsrc, alt=>$alt})
                                 . " " . a({href=>url . "?tour=$textid&answer=0"},                                  . " " . a({href=>tourhref($textid,0,1)},
                                 $Tournament{'Title'}. " ".                                  $Tournament{'Title'}. " ".
                                           $Tournament{'PlayedAt'}||'') . $qnum);                                            ($Tournament{'PlayedAt'}||'')) . $qnum); 
                 }                  }
         }          }
         $output .= dl($list);          $output .= dl($list);
   
         if ($URL) {          if ($URL) {
                 if (url=~/zaba\.ru/ && $URL=~/^\//){$URL="http://info.chgk.info$URL"}                  if ($url=~/zaba\.ru/ && $URL=~/^\//){$URL="http://info.chgk.info$URL"}
                 $output .=                  $output .=
                 p("Дополнительная информация об этом турнире - по адресу " .                  p("Дополнительная информация об этом турнире - по адресу " .
                         a({-'href'=>$URL}, $URL));                          a({-'href'=>$URL}, $URL));
Line 1010  sub PrintTour { Line 1134  sub PrintTour {
         my (%Tour) = &GetTournament($dbh, $Id);          my (%Tour) = &GetTournament($dbh, $Id);
         my (@Tours) = &GetTours($dbh, $Tour{'ParentId'});          my (@Tours) = &GetTours($dbh, $Tour{'ParentId'});
         my (%Tournament) = &GetTournament($dbh, $Tour{'ParentId'});          my (%Tournament) = &GetTournament($dbh, $Tour{'ParentId'});
           my %q;
   
         return 0          return 0
                 if ($Tour{'Type'} !~ /Т/);                  if ($Tour{'Type'} !~ /Т/);
Line 1026  sub PrintTour { Line 1151  sub PrintTour {
         $output .=&PrintEditor(\%Tour);          $output .=&PrintEditor(\%Tour);
   
         my (@Questions) = &GetTourQuestions($dbh, $Id);          my (@Questions) = &GetTourQuestions($dbh, $Id);
           my $sth=SelectQuestions($dbh,\@Questions,0);
         for ($q = 0; $q <= $#Questions; $q++) {          for ($q = 0; $q <= $#Questions; $q++) {
                 $output .= &PrintQuestion($dbh, $Questions[$q], $answer, 0);                  fetchquestion($sth,\%q,0);
                   $output .= &PrintQuestion($dbh, \%q, $answer, 0,0,0,1);
         }          }
           $sth->finish;
         $output .= hr({-'align'=>'center', -'width'=>'80%'});          $output .= hr({-'align'=>'center', -'width'=>'80%'});
   
         if ($Tournament{'URL'}) {          if ($Tournament{'URL'}) {
Line 1049  sub PrintTour { Line 1176  sub PrintTour {
         my $n=$Tour{'Number'};          my $n=$Tour{'Number'};
         if ($answer == 0) {          if ($answer == 0) {
                 $bottom .=                  $bottom .=
                         "[" . a({href=>url . "?tour=$fname.$n&answer=1"}, "ответы") .  "] " . br;                          "[" . a({href=>tourhref($fname,1)}, 
                            "ответы") .  "] " . br;
         }          }
         if ($n>1) {          if ($n>1) {
                 $bottom .=                  $bottom .=
                         "[" . a({href=>url . "?tour=$fname." . ($n - 1) . "&answer=0"},                          "[" . a({href=>tourhref("$fname.".($n-1),0)},
                         "предыдущий тур") . "] ";                          "предыдущий тур") . "] ";
                 $bottom .=                  $bottom .=
                         "[" . a({href=>url . "?tour=$fname." . ($n - 1) . "&answer=1"},                          "[" . a({href=>tourhref("$fname.".($n-1),1)},
                         "предыдущий тур с ответами") . "] " . br;                          "предыдущий тур с ответами") . "] " . br;
         }          }
         if (&IsTour($dbh, $Tour{'ParentId'}, $n + 1)) {          if (&IsTour($dbh, $Tour{'ParentId'}, $n + 1)) {
                 $bottom .=                  $bottom .=
                         "[" . a({href=>url . "?tour=$fname." . ($n + 1) . "&answer=0"},                          "[" . a({href=>tourhref("$fname.".($n+1),0)},
                         "следующий тур") . "] ";                          "следующий тур") . "] ";
                 $bottom .=                  $bottom .=
                         "[" . a({href=>url . "?tour=$fname." . ($n + 1) . "&answer=1"},                          "[" . a({href=>tourhref("$fname.".($n+1),1)},
                         "следующий тур с ответами") . "] ";                          "следующий тур с ответами") . "] ";
         }          }
   
Line 1097  sub PrintField { Line 1225  sub PrintField {
 # Gets a DB handler (ofcourse) and a question Id. Prints  # Gets a DB handler (ofcourse) and a question Id. Prints
 # that question, according to the options.  # that question, according to the options.
 sub PrintQuestion {  sub PrintQuestion {
         my ($dbh, $Id, $answer, $qnum, $title, $text) = @_;          my ($dbh, $Id, $answer, $qnum, $title, $text,$h) = @_;
         my ($output, $titles) = ('', '');          my ($output, $titles) = ('', '');
         my (%Question) = &GetQuestion($dbh, $Id);          my (%Question);
         $qnum = $Question{'Number'}          if ($h) {
             %Question=%$Id;
           } else {
                   %Question = &GetQuestion($dbh, $Id);
                   if ($title) {
                           my (%Tour) = GetTournament($dbh, $Question{'ParentId'});
                           my (%Tournament) = GetTournament($dbh, $Tour{'ParentId'});
                           $Question{'FileName'}=$Tournament{'FileName'};
                           $Question{'Title'}=$Tournament{'Title'};
                           $Question{'PlayedAt'}=$Tournament{'PlayedAt'};
                           $Question{'TourNumber'}=$Tour{'Number'};
                           $Question{'TourTitle'}=$Tour{'Title'};
                   }
   
           }
                   $qnum = $Question{'Number'}
                 if ($qnum == 0);                  if ($qnum == 0);
         if (!$text) {          if (!$text) {
                 $output .= hr({width=>"50%"}) if $answer>=0;                  $output .= hr({width=>"50%"}) if $answer>=0;
                 if ($title) {                  if ($title) {
                         my (%Tour) = GetTournament($dbh, $Question{'ParentId'});                          my $fname=$Question{'FileName'};
                         my (%Tournament) = GetTournament($dbh, $Tour{'ParentId'});  
                         my $fname=$Tournament{'FileName'};  
                         $fname=~s/\.txt//;                          $fname=~s/\.txt//;
                         $titles .=                          $titles .=
                                 dd(img({src=>"/icons/folder.open.gif"}) . " " .                                  dd(img({src=>"/icons/folder.open.gif"}) . " " .
                                          a({href=>url . "?tour=$fname"}, $Tournament{'Title'}, $Tournament{'PlayedAt'}||''));                                           a({href=>tourhref($fname,0,1)}, 
                                  $Question{'Title'}, $Question{'PlayedAt'}||''));
                         $titles .=                          $titles .=
                                 dl(dd(img({src=>"/icons/folder.open.gif"}) . " " .                                  dl(dd(img({src=>"/icons/folder.open.gif"}) . " " .
                                         a({href=>url . "?tour=$fname.$Tour{Number}#$qnum"}, $Tour{'Title'})));                                          a({href=>tourhref("$fname.$Question{'TourNumber'}#$qnum",1)}, 
                             $Question{'TourTitle'})));
                 }                  }
                 $output .= dl(strong($titles));                  $output .= dl(strong($titles));
         }          }
Line 1132  sub PrintQuestion { Line 1275  sub PrintQuestion {
                 if ($Question{'Authors'} ) {                  if ($Question{'Authors'} ) {
                       my $q=$Question{'Authors'};                        my $q=$Question{'Authors'};
 ###АВТОРА!!  ###АВТОРА!!
                       my $sth=$dbh->prepare("select Authors.CharId,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");  #                                  where Authors.Id=Author And Question=$Id");
                        $sth->execute;  #                       $sth->execute;
                        my ($AuthorId,$Name, $Surname,$other,$Nicks);  #                       my ($AuthorId,$Name, $Surname,$other,$Nicks);
                       if (!$text) {  #                      if (!$text) {
                        while ((($AuthorId,$Name, $Surname,$Nicks)=$sth->fetchrow),$AuthorId)  #                       while ((($AuthorId,$Name, $Surname,$Nicks)=$sth->fetchrow),$AuthorId)
                        {  #                       {
                           my ($firstletter)=$Name=~m/^./g;  #                          my ($firstletter)=$Name=~m/^./g;
                           $Name=~s/\./\\\./g;  #                          $Name=~s/\./\\\./g;
                           $Name=~s/ё/[её]/g;  #                          $Name=~s/ё/[её]/g;
                           $Surname=~s/ё/[её]/g;  #                          $Surname=~s/ё/[её]/g;
                            my $sha="(?:$Name\\s+$Surname)|(?:$Surname\\s+$Name)|(?:$firstletter\\.\\s*$Surname)|(?:$Surname\\s+$firstletter\\.)|(?:$Surname)";  #                           my $sha="(?:$Name\\s+$Surname)|(?:$Surname\\s+$Name)|(?:$firstletter\\.\\s*$Surname)|(?:$Surname\\s+$firstletter\\.)|(?:$Surname)";
                            if ($Nicks)  #                           if ($Nicks)
                            {  #                           {
                              $Nicks=~s/^\|//;  #                             $Nicks=~s/^\|//;
                              foreach (split /\|/, $Nicks)  #                             foreach (split /\|/, $Nicks)
                              {  #                             {
                                s/\s+/ /g;  #                               s/\s+/ /g;
                                s/\s+$//;  #                               s/\s+$//;
                                s/ /\\s+/g;  #                               s/ /\\s+/g;
                                s/\./\\\./g;  #                               s/\./\\\./g;
                                if (s/>$//) {$sha="$sha|(?:$_)"}  #                               if (s/>$//) {$sha="$sha|(?:$_)"}
                                else        {$sha="(?:$_)|$sha"}  #                               else        {$sha="(?:$_)|$sha"}
                              }  #                             }
                            }  #                           }
                            $q=~s/($sha)/a({href=>url."?qofauthor=$AuthorId"},$1)/ei;  #                           $q=~s/($sha)/a({href=>url."?qofauthor=$AuthorId"},$1)/ei;
                            unless ($1)   #                           unless ($1) 
                              {     #                             {   
                                  $q=~s/$Name/a({href=>url."?qofauthor=$AuthorId"},$1)/ei;  #                                 $q=~s/$Name/a({href=>url."?qofauthor=$AuthorId"},$1)/ei;
                              }  #                             }
                        }  #                       }
                       }  #                      }
                         $output .= &PrintField("Автор(ы)", $q, $text);                          $output .= &PrintField("Автор(ы)", $q, $text);
   
                 }                  }
Line 1212  $output.="</span>" Line 1355  $output.="</span>"
         $output=~s/\(pic: ([^\)]*)\)/<p><img src="\/znatoki\/images\/db\/$1"><p>/g unless $text;          $output=~s/\(pic: ([^\)]*)\)/<p><img src="\/znatoki\/images\/db\/$1"><p>/g unless $text;
         my $qid=param('tour') ? (param('tour').".$Question{'Number'}" ): '';          my $qid=param('tour') ? (param('tour').".$Question{'Number'}" ): '';
   
         $output.=br.a({href=> url."?metod=proxy&          $output.=br.a({href=> $url."?metod=proxy&
 qid=$qid"}, 'Близкие вопросы').p  qid=$qid"}, 'Близкие вопросы').p
              if $answer>0 && !$text && $qid;               if $answer>0 && !$text && $qid;
         return $output;          return $output;
Line 1253  sub Get12Random { Line 1396  sub Get12Random {
         }          }
         $where.= "OR (Type='ЧБ')" if ($type=~/Ч|Б/);          $where.= "OR (Type='ЧБ')" if ($type=~/Ч|Б/);
   
    $q="select QuestionId, QuestionId/$r-floor(QuestionId/$r) as val   #   $q="select QuestionId, QuestionId/$r-floor(QuestionId/$r) as val 
        from Questions where $where order by val limit $num";  #       from Questions where $where order by val limit $num";
 # Когда на куличках появится mysql >=3.23 надо заменить на order by rand();  # Когда на куличках появится mysql >=3.23 надо заменить на order by rand();
      $q="select QuestionId from Questions where $where order by rand() limit $num";
   
   
    $sth=$dbh->prepare($q);     $sth=$dbh->prepare($q);
    $sth->execute;     $sth->execute;
Line 1273  sub Get12Random { Line 1418  sub Get12Random {
   
 sub Include_virtual {  sub Include_virtual {
         my ($fn, $output) = (@_, '');          my ($fn, $output) = (@_, '');
           return "<!--#include virtual=\"$fn\"-->" if ($opt_z);
         open F , $fn          open F , $fn
                 or return; #die "Can't open the file $fn: $!\n";                  or return ""; #die "Can't open the file $fn: $!\n";
   
         while (<F>) {          while (<F>) {
                 if (/<!--#include/o) {                  if (/<!--#include/o) {
Line 1286  sub Include_virtual { Line 1431  sub Include_virtual {
                 }                  }
                 $output .= $_;                  $output .= $_;
         }          }
         return $output;          return $output||"";
 }  }
   
 sub PrintArchive {  sub PrintArchive {
Line 1311  sub PrintAll { Line 1456  sub PrintAll {
   
         my (%Tournament) = &GetTournament($dbh, $Id);          my (%Tournament) = &GetTournament($dbh, $Id);
         my (@Tours) = &GetTours($dbh, $Id);          my (@Tours) = &GetTours($dbh, $Id);
           my $SingleTour = $#Tours == 0;
   
         my ($New) = ($Id and $Tournament{'Type'} eq 'Ч' and          my ($New) = ($Id and $Tournament{'Type'} eq 'Ч' and
                 &NewEnough($Tournament{"CreatedAt"})) ?                  &NewEnough($Tournament{"CreatedAt"})) ?
                 img({src=>"/znatoki/dimrub/db/new-sml.gif", alt=>"NEW!"}) : "";                  img({src=>"/znatoki/dimrub/db/new-sml.gif", alt=>"NEW!"}) : "";
Line 1332  sub PrintAll { Line 1479  sub PrintAll {
   
   
                 $output .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .                  $output .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .
       " " . a({href=>url . "?tour=$textid&answer=0"},        " " . a({href=>tourhref($textid,0,!$SingleTour)},
       $Tournament{'Title'}) ." " . ($Tournament{'PlayedAt'}||'') . " $New");        $Tournament{'Title'}) ." " . ($Tournament{'PlayedAt'}||'') . " $New");
         }          }
         if ($Id == 0 or $Tournament{'Type'} =~ /Г/ or $Tournament{'Type'} eq '') {          if ($Id == 0 or $Tournament{'Type'} =~ /Г/ or $Tournament{'Type'} eq '') {
Line 1366  sub PrintDates { Line 1513  sub PrintDates {
                         if (!$array[0]);                          if (!$array[0]);
                 %Tournament = &GetTournament($dbh, $array[0]);                  %Tournament = &GetTournament($dbh, $array[0]);
       $list .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .        $list .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .
       " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},        " " . a({href=>tourhref($Tournament{'FileName'},0,1)},
       $Tournament{'Title'}, $Tournament{'PlayedAt'}||''));        $Tournament{'Title'}, $Tournament{'PlayedAt'}||''));
         }          }
         $sth->finish;          $sth->finish;
Line 1378  sub PrintQOfAuthor Line 1525  sub PrintQOfAuthor
 {  {
   
     my ($dbh, $id) = @_;      my ($dbh, $id) = @_;
       my $Output='';
     unless ($id=~/^\d+$/) {      unless ($id=~/^\d+$/) {
       $id=$dbh->quote($id);        $id=$dbh->quote($id);
       my $sth =  $dbh->prepare("SELECT Id FROM Authors WHERE CharId=$id");        my $sth =  $dbh->prepare("SELECT Id FROM Authors WHERE CharId=$id");
Line 1408  sub PrintQOfAuthor Line 1556  sub PrintQOfAuthor
         } else {          } else {
                 $suffix = 'я';                  $suffix = 'я';
         }          }
 #       print h2("Поиск в базе вопросов");          $Output.= printform;
         print printform;          $Output.= p({align=>"center"}, "Автор ".strong("$name $surname. ")
         print p({align=>"center"}, "Автор ".strong("$name $surname. ")  
         . " : $hits попадани$suffix.");          . " : $hits попадани$suffix.");
   
   
Line 1418  sub PrintQOfAuthor Line 1565  sub PrintQOfAuthor
 #               $output = &PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 1);  #               $output = &PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 1);
 #               print $output;  #               print $output;
 #       }  #       }
         PrintList($dbh,\@Questions,'gdfgdfgdfgdfg');          $Output.=PrintList($dbh,\@Questions,'gdfgdfgdfgdfg');
 }  }
   
   
Line 1447  sub PrintAuthors Line 1594  sub PrintAuthors
   
   
      $sth->execute;       $sth->execute;
      $output.=Tr(th[a({href=>url."?authors=name"},"Имя")       $output.=Tr(th[a({href=>$url."?authors=name"},"Имя")
 .", ".  .", ".
 a({href=>url."?authors=surname"},"фамилия")  a({href=>$url."?authors=surname"},"фамилия")
      , a({href=>url."?authors=kvo"},"Количество вопросов")]);       , a({href=>$url."?authors=kvo"},"Количество вопросов")]);
   
      $out1='';       $out1='';
   
Line 1463  a({href=>url."?authors=surname"},"фамили Line 1610  a({href=>url."?authors=surname"},"фамили
      {       {
   
            my ($id,$name,$surname,$kvo)=@$arr;             my ($id,$name,$surname,$kvo)=@$arr;
            if (!$name || !$surname) {#print "Opanki at $id\n"             if (!$name || !$surname) {
               } else                } else
            {             {
              my $add=Tr(td([a({href=>url."?qofauthor=$id"},"$name $surname"), $kvo]))."\n";               my $add=Tr(td([a({href=>$url."?qofauthor=$id"},"$name $surname"), $kvo]))."\n";
              print STDERR $add;  
              $output.=$add;               $output.=$add;
            }             }
      }       }
Line 1627  sub WriteFile { Line 1773  sub WriteFile {
   
 }  }
   
   sub Bottom
   {
           my $output.=&Include_virtual("../dimrub/db/footer.html")||"";
           $output.=p."<center><font size=-2>Обновление: ".&Include_virtual("../dimrub/db/date")."</center></font>";
           $output.=<<EEE
   <SCRIPT LANGUAGE="JavaScript">
   function toggle(e) {
     if (e.style.display == "none") {
        e.style.display="";
     } else {
        e.style.display = "none";
    }
   }
   </SCRIPT>
   EEE
   ;
           $output.=end_html;
           return $output;
   }
   
   
 MAIN:  MAIN:
 {  {
Line 1634  MAIN: Line 1800  MAIN:
         setlocale(LC_CTYPE,'russian');          setlocale(LC_CTYPE,'russian');
         my($i, $tour);          my($i, $tour);
         my($text) = (param('text')) ? 1 : 0;          my($text) = (param('text')) ? 1 : 0;
           if (param('qid') && (param('qid')=~/^\d+$/)) {
              my $destination='http://db.chgk.info/search.html';
   #               print header (-'Content-Type' => 'text/html',
   #                -'Location:'=> 'http:\\db.chgk.info');
                   Redirect($destination);
                   exit
           }
   
         if ($text) {          if ($text) {
                 print header('text/plain');                  print header('text/plain');
         } else {print header;}          } else {print header;}
   
         my($dbh) = DBI->connect("DBI:mysql:chgk", "piataev", "")          my($dbh) = DBI->connect("DBI:mysql:chgk", "piataev", "")
                 or do {                  or do {
                         print h1("Временные проблемы") . "База вопросов временно не                          print h1("Временные проблемы") . "База вопросов временно не
                         работает. Заходите попозже.";                          работает. Заходите попозже.";
                         print &Include_virtual("../dimrub/db/reklama.html");                          print &Include_virtual("$reklama") if $url!~/localhost/;
                     print end_html;                      print end_html;
                         die "Can't connect to DB chgk\n";                          die "Can't connect to DB chgk\n";
                 };                  };
Line 1650  MAIN: Line 1823  MAIN:
           if (param('qid')) {            if (param('qid')) {
               my $sth;                my $sth;
               my $qid=param('qid');                my $qid=param('qid');
                 if ($qid !~ /^[0-9]*$/) {  #               if ($qid !~ /^[0-9]+$/) 
                   {
                     my ($fname,$t,$n)= split /\./ , $qid;                      my ($fname,$t,$n)= split /\./ , $qid;
                     $n=$t,$t='' unless $n;                      $n=$t,$t='' unless $n;
                     if ($n)                      if ($t)
                     {                      {
                         $sth = $dbh->prepare(                          $sth = $dbh->prepare(
                        "SELECT t2.Id FROM Tournaments as t1,                          "SELECT t2.Id FROM Tournaments as t1, 
Line 1676  MAIN: Line 1850  MAIN:
                         Questions.Number=$n");                          Questions.Number=$n");
                         $sth->execute;                          $sth->execute;
                         $qid = ($sth->fetchrow)[0];                          $qid = ($sth->fetchrow)[0];
                 }                       my $query="SELECT Question, Answer from Questions where QuestionId=$qid";
               my $query="SELECT Question, Answer from Questions where QuestionId=$qid";                       $sth=$dbh->prepare($query);
               $sth=$dbh->prepare($query);                       $sth->execute;
               $sth->execute;                       $sstr= join ' ',$sth->fetchrow;
               $sstr= join ' ',$sth->fetchrow;                       $sth->finish;
               $sth->finish;                       $searchin{'Question'}=1;
               $searchin{'Question'}=1;                       $searchin{'Answer'}=1;
               $searchin{'Answer'}=1;                       $sstr=~tr/ёЁ/еЕ/;
               $sstr=~tr/ёЁ/еЕ/;                       $sstr=~s/[^йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮa-zA-Z0-9]/ /gi;
               $sstr=~s/[^йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮa-zA-Z0-9]/ /gi;                       $proxysstr=$sstr;
               $proxysstr=$sstr;                       $proxysstr=makeproxysstr($dbh,\$proxysstr);
               $proxysstr=makeproxysstr($dbh,\$proxysstr);                } 
                 
         }          }
   
   
Line 1696  MAIN: Line 1871  MAIN:
                                                     if ($proxysstr||$sstr);                                                      if ($proxysstr||$sstr);
            $title||="База вопросов";             $title||="База вопросов";
   
            print start_html(-"title"=>$title,             $globaloutput.=start_html(-"title"=>$title,
                    -author=>'dimrub@icomverse.com',                     -author=>'dimrub@icomverse.com',
                    -bgcolor=>'#fff0e0',                     -bgcolor=>'#fff0e0',
                                   -vlink=>'#800020');                                    -vlink=>'#800020');
 print "<style>  $globaloutput.="<style>
 td      {font-size: x-small; font-family : sans-serif}  td      {font-size: x-small; font-family : sans-serif}
 th      {font-size: x-small; font-family : sans-serif}  th      {font-size: x-small; font-family : sans-serif}
 </style>\n";  </style>\n";
   
                 print &Include_virtual("../dimrub/db/reklama.html");                  $globaloutput.=&Include_virtual("$reklama")||'';
         }          }
   
          if (length ($qs)<=255 && $qs !~ /(sstr)|(rand)|(comp)|(all=)/i) {
                   my $sth=$dbh->prepare("SELECT page,times,t from hash where query=".$dbh->quote($qs));
                   $sth->execute();
                   my ($p,$times,$t)=$sth->fetchrow();
                   $sth->finish;
                   if ($p) {
                           print ".$p";
                           $dbh->disconnect;
                           exit ;
                   }
          }
   
   
   
   
Line 1736  th {font-size: x-small; font-family : sa Line 1923  th {font-size: x-small; font-family : sa
                     else                       else 
                         {                          {
                           $sth = $dbh->prepare("SELECT Id FROM Tournaments                            $sth = $dbh->prepare("SELECT Id FROM Tournaments
                                      WHERE FileName = '$tour.txt'");                                       WHERE FileName = '$tour.txt' OR 
                                          FileName = '$tour'");
                         }                          }
                     $sth->execute;                      $sth->execute;
                     $tour = ($sth->fetchrow)[0];                      $tour = ($sth->fetchrow)[0];
Line 1765  Content-type: text/$mime_type; charset=" Line 1953  Content-type: text/$mime_type; charset="
 EOT  EOT
                         print F &PrintRandom($dbh, $type, $qnum, $text);                          print F &PrintRandom($dbh, $type, $qnum, $text);
                         close F;                          close F;
                         print "Пакет случайно выбранных вопросов послан по адресу $Email. Нажмите                          $globaloutput.= "Пакет случайно выбранных вопросов послан по адресу $Email. Нажмите
                         на <B>Reload</B> для получения еще одного пакета";                          на <B>Reload</B> для получения еще одного пакета";
                 } else {                  } else {
                         print &PrintRandom($dbh, $type, $qnum, $text);                          $globaloutput.= &PrintRandom($dbh, $type, $qnum, $text);
                 }                  }
         }          }
           elsif (param('authors')){            elsif (param('authors')){
                 print &PrintAuthors($dbh,param('authors'));                  $globaloutput.= &PrintAuthors($dbh,param('authors'));
         }          }
           elsif (param('qofauthor')){            elsif (param('qofauthor')){
                 &PrintQOfAuthor($dbh,param('qofauthor'));                  $globaloutput.= &PrintQOfAuthor($dbh,param('qofauthor'));
         }          }
           elsif (param('sstr')||param('was')) {            elsif (param('sstr')||param('was')) {
                 &PrintSearch($dbh, $sstr||' ', param('metod')||'',param('was'));                  $globaloutput.=&PrintSearch($dbh, $sstr||' ', param('metod')||'',param('was'));
                 $dbh->do("delete from lastqueries where                  $dbh->do("delete from lastqueries where
                       (TO_DAYS(NOW()) - TO_DAYS(t) >= 2) OR                        (TO_DAYS(NOW()) - TO_DAYS(t) >= 2) OR
                            (time_to_sec(now())-time_to_sec(t) >3600)")                             (time_to_sec(now())-time_to_sec(t) >3600)") if $usewas && random(30)==0;
         }           } 
           elsif (param('qid')) {            elsif (param('qid')) {
               &PrintSearch($dbh, $sstr||'', 'proxy');                $globaloutput.=&PrintSearch($dbh, $sstr||'', 'proxy');
         }          }
         elsif (param('getfile')){          elsif (param('getfile')){
           print &writefile             $globaloutput.=&writefile
         } elsif (param('all')) {          } elsif (param('all')) {
                 print &PrintAll($dbh, 0);             my $destination='http://db.chgk.info/all.html';
                   Redirect($destination);
                   exit;
   #               $globaloutput.=&PrintAll($dbh, 0);
         } elsif (param('from_year') && param('to_year')) {          } elsif (param('from_year') && param('to_year')) {
                 print &PrintDates($dbh);                  $globaloutput.=&PrintDates($dbh);
         } elsif (param('comp')) {          } elsif (param('comp')) {
             print "Content-Type: application/octet-stream\n";              $globaloutput.="Content-Type: application/octet-stream\n";
             print "Content-Type: application/force-download\n";              $globaloutput.="Content-Type: application/force-download\n";
             print "Content-Type: application/download\n";              $globaloutput.="Content-Type: application/download\n";
             print "Content-Type: application/x-zip-compressed; name=db.zip\n";              $globaloutput.="Content-Type: application/x-zip-compressed; name=db.zip\n";
             print "Content-Disposition: attachment; filename=db.zip \n\n";              $globaloutput.="Content-Disposition: attachment; filename=db.zip \n\n";
 #           print header(  
 #                        -'Content-Type' => 'application/x-zip-compressed; name="db.zip"',  
 #                        -'Content-Type' => 'application/zip',  
 #                        -'Content-Disposition' => 'attachment; filename="db.zip"'  
 #                        );  
             $tour ||= 0;              $tour ||= 0;
             my (@files) = &PrintArchive($dbh, $tour);              my (@files) = &PrintArchive($dbh, $tour);
             WriteFile($dbh,$_) foreach @files;              WriteFile($dbh,$_) foreach @files;
 #           open F, "$ZIP -j - $SRCPATH/COPYRIGHT @files |";  
             open F, "$ZIP -j - @files |";              open F, "$ZIP -j - @files |";
             binmode(F);              binmode(F);
             binmode(STDOUT);              binmode(STDOUT);
             print (<F>);              $globaloutput.= join "",<F>;
             close F;              close F;
             $dbh->disconnect;              $dbh->disconnect;
             exit;              exit;
Line 1825  EOT Line 2010  EOT
             $dbh->disconnect;              $dbh->disconnect;
             exit;              exit;
   
         } else {          } 
           elsif (!$opt_z) {
                 my $QuestionNumber=0;                  my $QuestionNumber=0;
                 my $qnum;                  my $qnum;
                 if ($qnum=param('qnumber')){                  if ($qnum=param('qnumber')){
Line 1835  EOT Line 2021  EOT
                   $QuestionNumber=($sth->fetchrow)[0]||0;                    $QuestionNumber=($sth->fetchrow)[0]||0;
                 }                  }
                 if ($QuestionNumber) {                  if ($QuestionNumber) {
                   print &PrintQuestion($dbh, $QuestionNumber, param('answer')||0, $qnum, 1);                    $globaloutput.= &PrintQuestion($dbh, $QuestionNumber, param('answer')||0, $qnum, 1,0,0);
 #                                        $dbh, $Id, $answer, $qnum, $title, $text  #                                        $dbh, $Id, $answer, $qnum, $title, $text
                 } else  {                  } else  {
                    print &PrintTournament($dbh, $tour, param('answer'));                     $globaloutput.=&PrintTournament($dbh, $tour, param('answer'));
                 }                  }
         }          }
           else {
                     open TS, "timestamp";
                     my $d=$dbh->quote(<TS>);
                     close TS;
                     open FF, ">${realHTMLDIR}index.html" or die "ERROR! - ${HTMLDIR}index.html\n";
                          my $o=$globaloutput;
                          $o.=&PrintTournament($dbh, 0, 0);
                          $o.=&Bottom;
                          print FF $o;
                     close FF;
                     open FF, ">${realHTMLDIR}all.html" or die "ERROR! - ${HTMLDIR}all.html\n";
                          $o=$globaloutput;
                          $o.=&PrintAll($dbh,0);
                          $o.=&Bottom;
                          print FF $o;
                          close FF;
   
   
   #                 my ($sth) = $dbh->prepare("SELECT t1.Id, t1.FileName, t1.Type, 
   #                       count(t2.Id) 
   #                     FROM Tournaments as t1, Tournaments as t2
   #                    WHERE t1.CreatedAt>$d AND t2.ParentId=t1.Id GROUP BY t1.Id");
   my ($sth) = $dbh->prepare("SELECT t1.Id, t1.FileName, t1.Type, count(t2.Id)  FROM Tournaments as t1  LEFT JOIN Tournaments as t2 
    ON t2.ParentId=t1.id WHERE t1.CreatedAt>$d GROUP BY t1.Id");
                     $sth->execute;
                     my ($Id,$fname,$type,$c);
                     while (($Id,$fname,$type,$c)=$sth->fetchrow,$Id) {
                        next unless $fname;
                        print "$fname\n";
                        $fname=~s/\.txt$//;
                        if ($type=~/Т/ || $c<=1)
                        {
                          open FF, ">$realHTMLDIR$fname-q.html" or die "ERROR! - $fname-q.html\n";
                          my $o=$globaloutput;
                          $o.=&PrintTournament($dbh, $Id, 0);
                          $o.=&Bottom;
                          print FF $o;
                          close FF;
                          open FF, ">$realHTMLDIR$fname-a.html";
                          $o=$globaloutput;
                          $o.=&PrintTournament($dbh, $Id, 1);
                          $o.=&Bottom;
                          print FF $o;
                          close FF;
                        }
                        else {
                          open FF, ">$realHTMLDIR$fname.html" or die "ERROR! - $fname-q.html\n";
                          my $o=$globaloutput;
                          $o.=&PrintTournament($dbh, $Id, 0);
                          $o.=&Bottom;
                          print FF $o;
                          close FF;
   
                        }
                     }
           }
         if (!$text) {          if (!$text) {
                 print &Include_virtual("../dimrub/db/footer.html");                  $globaloutput.=&Bottom;
                 print p."<center><font size=-2>Обновление: ".&Include_virtual("../dimrub/db/date")."</center></font>";  
 print <<EEE  
   <SCRIPT LANGUAGE="JavaScript">  
 function toggle(e) {  
   if (e.style.display == "none") {  
      e.style.display="";  
   } else {  
      e.style.display = "none";  
  }  
 }  
 </SCRIPT>  
 EEE  
 ;  
 #               print end_html;  
         }          }
           if (!$opt_z){ 
             print $globaloutput;
             if (($qs!~ /(rand)|(sstr)|(comp)/i) && (length $qs<=255)) {
                   $globaloutput=  $dbh->quote($globaloutput);
                   $dbh->do("insert into hash (query,page) values (".
                   $dbh->quote($qs).
                       ",$globaloutput)");
             }
           }
   
         $dbh->disconnect;          $dbh->disconnect;
 }  }
Removed from v.1.94  
changed lines
  Added in v.1.113

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>