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

Diff for /db/prgsrc/db.cgi between versions 1.29 and 1.46

version 1.29, 2001/11/19 00:59:44 version 1.46, 2001/12/08 23:00:44
Line 2 Line 2
   
 use DBI;  use DBI;
 use CGI ':all';  use CGI ':all';
 use Text::Query;  #use Text::Query;
 use strict;  use strict;
 use Time::Local;  use Time::Local;
 use POSIX qw(locale_h);  use POSIX qw(locale_h);
 use locale;  use locale;
 open STDERR, ">errors";  #open STDERR, ">errors1";
 my $printqueries=1;  my $printqueries=0;
 my $debug=1; #added by R7  my %forbidden=();
   my $debug=0; #added by R7
 my %fieldname= (0,'Question', 1, 'Answer', 2, 'Comments', 3, 'Authors', 4, 'Sources');  my %fieldname= (0,'Question', 1, 'Answer', 2, 'Comments', 3, 'Authors', 4, 'Sources');
   my %rusfieldname=('Question','Вопрос', 'Answer', 'Ответ', 
                     'Comments', 'Комментарии', 'Authors', 'Автор', 
                     'Sources', 'Источник','old','Старый','rus','Новый');
 my %searchin;  my %searchin;
   my $rl=qr/[йцукенгшщзхъфывапролджэячсмитьбюё]/;
   my $RL=qr/[ЙЦУКЕНГШЩЗХЪЭЖДЛОРПАВЫФЯЧСМИТЬБЮЁ]/;
   my $RLrl=qr/(?:(?:${rl})|(?:${RL}))+/;
   my $l=qr/(?:(?:${RLrl})|(?:[\w\-]))+/;
   my $Ll=qr/(?:[A-Z])|(?:${RL})/;
   
   
   
 my $thislocale;  
   
   my $thislocale;
   
 $searchin{'question'}=param('Question');  $searchin{$_}=1 foreach param('searchin');
 $searchin{'answer'}=param('Answer');  #$searchin{'Question'}=param('Question');
 $searchin{'comment'}=param('Comment');  #$searchin{'Answer'}=param('Answer');
 $searchin{'authors'}=param('Authors');  #$searchin{'Comments'}=param('Comments');
 $searchin{'sources'}=param('Sources');  #$searchin{'Authors'}=param('Authors');
   #$searchin{'Sources'}=param('Sources');
 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`;
Line 32  my ($ZIP) = "/home/piataev/bin/zip"; Line 42  my ($ZIP) = "/home/piataev/bin/zip";
 my $DUMPFILE = "/tmp/chgkdump";  my $DUMPFILE = "/tmp/chgkdump";
 my ($SENDMAIL) = "/usr/sbin/sendmail";  my ($SENDMAIL) = "/usr/sbin/sendmail";
 my ($TMSECS) = 30*24*60*60;  my ($TMSECS) = 30*24*60*60;
 my (%RevMonths) =   my (%RevMonths) =
         ('Jan', '0', 'Feb', '1', 'Mar', '2', 'Apr', '3', 'May', '4', 'Jun', '5',          ('Jan', '0', 'Feb', '1', 'Mar', '2', 'Apr', '3', 'May', '4', 'Jun', '5',
         'Jul', '6', 'Aug', '7', 'Sep', '8', 'Oct', '9', 'Nov', '10',          'Jul', '6', 'Aug', '7', 'Sep', '8', 'Oct', '9', 'Nov', '10',
         'Dec', '11',          'Dec', '11',
          'Янв', '0', 'Фев', 1, 'Мар', 2, 'Апр', 3, 'Май', '4',           'Янв', '0', 'Фев', 1, 'Мар', 2, 'Апр', 3, 'Май', '4',
          'Июн', '5', 'Июл', 6, 'Авг', '7', 'Сен', '8',            'Июн', '5', 'Июл', 6, 'Авг', '7', 'Сен', '8',
          'Окт', '9', 'Ноя', '19', 'Дек', '11');           'Окт', '9', 'Ноя', '19', 'Дек', '11');
   
 # Determine whether the given time is within 2 months from now.  # Determine whether the given time is within 2 months from now.
Line 92  sub GetTourQuestions { Line 102  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 QuestionId");                  WHERE ParentId=$ParentId ORDER BY QuestionId");
   
         $sth->execute;          $sth->execute;
Line 121  sub GetTours { Line 131  sub GetTours {
         return @Tours;          return @Tours;
 }  }
   
   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;
     $a[0]||0;
   }
   
   
   sub printform
   {
   
     my $submit=submit(-value=>'Поиск');
     my $inputstring=textfield(-name=>'sstr',
                            -default=>param('sstr')||'',
                            -size=>50);
     my @df=keys %searchin;
     @df=('Question', 'Answer') unless @df;
     my $fields=checkbox_group('searchin',['Question','Answer','Comments','Authors','Sources'], [@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'=>'Любое'});
   
   #################################################
   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)
   ) 
   )
    
   #$fields.
   #$inputstring.$submit.br.$metod.$all
   .endform
   .hr
   
   }
   
   sub proxy
   {
   #print "time0=".time.br if $debug;
         my ($dbh,$ptext,$allnf)=@_;
         my $text=$$ptext;
         $text=~tr/ёЁ/еЕ/;
         $text=~s/(${RLrl})p(${RLrl})/$1p$2/gom;
         $text=~s/p(${RLrl})/р$1/gom;
         $text=~s/(${RLrl})p/$1р/gom;
         $text=~s/\s+/ /gmo;
         $text=~s/[^йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮQWERTYUIOPASDFGHJKLZXCVBNM0-9]/ /g;
         $text=uc $text;
         my @list= $text=~m/(?:(?:${RLrl})+)|(?:[A-Za-z0-9]+)/gom;
         my (%c, %good,$sstr);
         foreach (@list)
         {
              $c{$_}=count($dbh,$_)||10000;
         }
         my @words=sort {$c{$a}<=> $c{$b}} @list;
   
   #      $good{$words[$_]}=1 foreach 0..4;
   
         foreach (@words)
         {
            $good{$_}=1 if $c{$_}<200;
         }
   
         $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);
   }
   
   
 sub russearch {  sub russearch {
             my ($dbh, $sstr, $all,$allnf)=@_;              my ($dbh, $sstr, $all,$allnf)=@_;
             my (@qw,@w,@tasks,$qw,@arr,$nf,$sth,@nf,$w,$where,$e,@where,%good,$i,%where,$from);              my (@qw,@w,@tasks,$qw,@arr,$nf,$sth,@nf,$w,$where,$e,@where,%good,$i,%where,$from);
Line 145  $sstr=~tr/йцукенгшщзхъфывапролджэячсмить Line 253  $sstr=~tr/йцукенгшщзхъфывапролджэячсмить
             foreach $i (0..$#w) # заполняем массив @nf начальных форм              foreach $i (0..$#w) # заполняем массив @nf начальных форм
                            # $nf[$i] -- ссылка на массив возможных                             # $nf[$i] -- ссылка на массив возможных
                            # начальных форм словоформы $i                             # начальных форм словоформы $i
             {                            {
                 $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";
Line 160  print "$query",br if $printqueries; Line 268  print "$query",br if $printqueries;
             }              }
   
   
             my @bad=grep {!$nf[$_]} 0..$#w; # @bad -- номера словоформ,              my @bad=grep {!@{$nf[$_]}} 0..$#w; # @bad -- номера словоформ,
                                            # которых нет в словаре                                             # которых нет в словаре
   
             if (@bad) #есть неопознанные словоформы              if (@bad) #есть неопознанные словоформы
Line 179  print "$query",br if $printqueries; Line 287  print "$query",br if $printqueries;
   
             my $kvo=0;              my $kvo=0;
             push @$allnf, @{$_} foreach @nf;              push @$allnf, @{$_} foreach @nf;
 print "nf=@$allnf";              print "nf=@$allnf" if $printqueries;
   
             foreach $i (0..$#w) #запросы в базу...              foreach $i (0..$#w) #запросы в базу...
             {              {
Line 191  print "nf=@$allnf"; Line 299  print "nf=@$allnf";
   
               $_= " word2question.word=".$_. ' ' foreach @arr;                $_= " word2question.word=".$_. ' ' foreach @arr;
               $_= " nf.id=".$_. ' ' foreach @arr1;                $_= " nf.id=".$_. ' ' foreach @arr1;
   #              @arr=(0) unless @arr;
 #              $_= " nests.w2=".$_. ' ' foreach @arr2;  
 #              $query="select w1 from nests where". (join ' OR ', @arr2);  
 #print $query if $printqueries;  
 #             $sth=$dbh -> prepare($query);  
 #              $sth->execute;  
 #              while (@ar=$sth->fetchrow)  
 #              {  
 #                 $ar[0]=~s/(.)/&nocase($1)/ge;  
 #                 push(@sf,'(?:'.$ar[0].')');  
 #              }  
 #              $selectshablon=join '|',@sf;  
   
 #print $selectshablon,br if $printqueries;  
   
 #              $selectshablon=qr/$selectshablon/i;  
   
   
   
   
               $query="select questions from word2question where". (join ' OR ', @arr);                $query="select questions from word2question where". (join ' OR ', @arr);
 print "$query\n",br if $printqueries;  print STDERR "!$query\n",br if $printqueries;
   
               $sth=$dbh -> prepare($query);                $sth=$dbh -> prepare($query);
               $sth->execute;                $sth->execute;
Line 253  print "$query\n",br if $printqueries; Line 342  print "$query\n",br if $printqueries;
                     $ii+=4;                      $ii+=4;
                     $number=$lo+$hi*256;                      $number=$lo+$hi*256;
                     $field=$fieldname{$field};                      $field=$fieldname{$field};
                     if ($searchin{lc $field})                      if ($searchin{$field})
                     {                      {
                       push @{$tasksof{$i}{$number}}, $wordnumber;                        push @{$tasksof{$i}{$number}}, $wordnumber;
                                       # дополнили в хэше, висящем на                                        # дополнили в хэше, висящем на
Line 293  foreach (keys %wordsof) Line 382  foreach (keys %wordsof)
   
 ############  ############
   
 print "tasks=@tasks";  print "tasks=@tasks" if $printqueries;
   
 #print "$_ $relevance{$_} | " foreach @tasks;  #print "$_ $relevance{$_} | " foreach @tasks;
 #print br;  #print br;
Line 348  if $$words{$first}; Line 437  if $$words{$first};
   
 # Returns list of QuestionId's, that have the search string in them.  # Returns list of QuestionId's, that have the search string in them.
 sub Search {  sub Search {
         my ($dbh, $sstr,$metod,$all,$allnf) = @_;          my ($dbh, $s,$metod,$all,$allnf) = @_;
           my $sstr=$$s;
         my (@arr, @Questions, @fields);          my (@arr, @Questions, @fields);
         my (@sar, $i, $sth,$where);          my (@sar, $i, $sth,$where,$query);
   #       my $ip=$ENV{'REMOTE_ADDR'};
 #       push @fields, 'Question';  
   
   #        $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')          if ($metod eq 'rus')
         {          {
              my @tasks=russearch($dbh,$sstr,$all,$allnf);               my @tasks=russearch($dbh,$sstr,$all,$allnf);
              return @tasks               return @tasks
         }          }
           elsif ($metod eq 'proxy')
           {
   #         $searchin{'question'}=1;
   #         $searchin{'answer'}=1;
             my @task=proxy($dbh,$s,$allnf);
   #         $$s=$sstr;
             return @task
           }
   
   
   
 ###Simple and advanced query processing. Added by R7  ###Simple and advanced query processing. Added by R7
         if ($metod eq 'simple' || $metod eq 'advanced')           if ($metod eq 'simple' || $metod eq 'advanced')
         {          {
           foreach (qw/Question Answer Sources Authors Comments/) {            foreach (qw/Question Answer Sources Authors Comments/) {
                 if (param($_)) {                  if (param($_)) {
                         push @fields, $_;                           push @fields, $_;
                 }                  }
            }             }
   
            @fields=(qw/Question Answer Sources Authors Comments/) unless scalar @fields;             @fields=(qw/Question Answer Sources Authors Comments/) unless scalar @fields;
            my $fields=join ",", @fields;             my $fields=join ",", @fields;
            my $q=new Text::Query($sstr,             my $q=new Text::Query($sstr,
                  -parse => 'Text::Query::'.                    -parse => 'Text::Query::'.
                    (($metod eq 'simple') ? 'ParseSimple':'ParseAdvanced'),                     (($metod eq 'simple') ? 'ParseSimple':'ParseAdvanced'),
                  -solve => 'Text::Query::SolveSQL',                   -solve => 'Text::Query::SolveSQL',
                  -build => 'Text::Query::BuildSQLMySQL',                   -build => 'Text::Query::BuildSQLMySQL',
                  -fields_searched => $fields);                   -fields_searched => $fields);
   
            $where=      $$q{'matchexp'};             $where=      $$q{'matchexp'};
            my $query= "SELECT Questionid FROM Questions             $query= "SELECT Questionid FROM Questions
                 WHERE $where";                  WHERE $where";
            print br."Query is: $query".br if $debug;             print br."Query is: $query".br if $debug;
   
            $sth = $dbh->prepare($query);             $sth = $dbh->prepare($query);
          } else           } else
 ######     ######
          {           {
   
           foreach (qw/Question Answer Sources Authors Comments/) {  #         foreach (qw/Question Answer Sources Authors Comments/) {
                 if (param($_)) {            foreach (param('searchin')) {
   #               if (param($_)) {
                         push @fields, "IFNULL($_, '')";                          push @fields, "IFNULL($_, '')";
                 }  #               }
           }            }
           @sar = split " ", $sstr;            @sar = split " ", $sstr;
           for $i (0 .. $#sar) {            for $i (0 .. $#sar) {
Line 406  sub Search { Line 514  sub Search {
                 $sstr = join " OR $f LIKE ", @sar;                  $sstr = join " OR $f LIKE ", @sar;
           }            }
   
 my $query="SELECT QuestionId FROM Questions     my $query;
                  $query="SELECT QuestionId FROM Questions
                 WHERE $f LIKE $sstr ORDER BY QuestionId";                  WHERE $f LIKE $sstr ORDER BY QuestionId";
   
   
 print $query if $printqueries;  print $query if $printqueries;
           $sth = $dbh->prepare($query)            $sth = $dbh->prepare($query)
   
         } #else -- processing old-style query (R7)          } #else -- processing old-style query (R7)
   
         $sth->execute;          $sth->execute;
         while (@arr = $sth->fetchrow) {          while (@arr = $sth->fetchrow) {
                 push @Questions, $arr[0];                  push @Questions, $arr[0] unless $forbidden{$arr[0]};
         }          }
           
   print "@Questions" if $printqueries;
         return @Questions;          return @Questions;
 }  }
   
  # Substitute every letter by a pair (for case insensitive search).   # Substitute every letter by a pair (for case insensitive search).
  my (@letters) = qw/аА бБ вВ гГ дД еЕ жЖ зЗ иИ йЙ кК лЛ мМ нН оО    my (@letters) = qw/аА бБ вВ гГ дД еЕ жЖ зЗ иИ йЙ кК лЛ мМ нН оО
  пП рР сС тТ уУ фФ хХ цЦ чЧ шШ щЩ ьЬ ыЫ эЭ юЮ яЯ/;   пП рР сС тТ уУ фФ хХ цЦ чЧ шШ щЩ ьЬ ыЫ эЭ юЮ яЯ/;
    
 sub NoCase {  sub NoCase {
         my ($sstr) = shift;          my ($sstr) = shift;
         my ($res);          my ($res);
Line 436  sub NoCase { Line 547  sub NoCase {
         }          }
 }  }
   
   sub PrintList {
      my ($dbh,$Questions,$shablon)=@_;
   
           my $first=param('first') ||1;
           my $kvo=param('kvo') ||30;
   
           $first=$first-($first-1)%$kvo;
           my $last=$first+$kvo-1;
           $last=scalar @$Questions if scalar @$Questions <$last;
           my($f,$l);
           my $nav='';
           my $qs=query_string;
           $qs=~s/\;/\&/g;
           $qs=~s/\&first\=[^\&]+//g;
   
   
           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)
        {         $fprint=1;
                  $lprint=$llprint;
        }
        elsif ($first>$kvo*3 && $#$Questions+1-$first>$kvo*3)
        {
          $fprint=$first-$kvo*3;
          $lprint=$first+$kvo*3;
        } 
        elsif  ($first<=$kvo*3)
        {
           $fprint=1; $lprint=6*$kvo+1;
        }
        else
        { 
              $lprint=$llprint;
              $fprint=$lprint-$kvo*6
        }
            
   #        my $fprint=($first>$kvo*3) ? $first-$kvo*3 : 1;
   #        my $lprint=$#$Questions+1-$fprint>$kvo*7 ? $kvo*7 :$#$Questions+1;
   #        if ($lprint-$fprint<$kvo*6 && $fprint>1)
   #        {
   #            $fprint=$lprint-$kvo*6;
   #            $fprint=1 if ($fprint<=0) 
   #        }
   
   
   
           for($f=$fprint; $f<=$lprint; $f+=$kvo)
           {
   #         next if $first-$f>$kvo*3;
             $l=$f+$kvo-1;
             $l=$#$Questions+1 if $l>$#$Questions+1;
             if ($f==$first) {$nav.="[$f-$l] ";}
             else {
                     $nav.= "[".a({href=>(url."?".$qs."\&first=$f")},"$f-$l")."] ";}
           }
           if ($lprint+$kvo<$#$Questions)
           {
              $nav.=
               ("&nbsp;"x4).
               a({href=>(url."?".$qs."\&first=".($first+$kvo))},">").("&nbsp;"x4).
               a({href=>url."?".$qs."\&first=$llprint"},">>").("&nbsp;"x4)
           }
   
   
           print "$nav".br."\n";
           for (my $i = $first; $i <= $last; $i++) {
                   my $output = &PrintQuestion($dbh, $$Questions[$i-1], 1, $i, 1);
                   if (param('metod') eq 'rus' || param('metod') eq 'proxy')
                   {
                        $output=~s/\b($shablon)\b/\<strong\>$1\<\/strong\>/gi;
                   } else {
                        $output=~s/($shablon)/\<strong\>$1\<\/strong\>/gi;
                   }
                   print $output;
           }
   
   
           print "$nav".br."\n";
   
   }
   
 sub PrintSearch {  sub PrintSearch {
         my ($dbh, $sstr, $metod) = @_;          my ($dbh, $sstr, $metod) = @_;
           print h2("Поиск в базе вопросов");
           print printform;
         my @allnf;          my @allnf;
         my (@Questions) = &Search($dbh, $sstr,$metod,$all,\@allnf);          my (@Questions) = &Search($dbh, \$sstr,$metod,$all,\@allnf);
         my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1);          my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1);
   
         my $shablon;          my $shablon;
           $metod='rus' if $metod eq 'proxy';
         if ($metod eq 'rus')          if ($metod eq 'rus')
         {          {
            my $where='0';             my $where='0';
Line 458  print "$query" if $printqueries; Line 663  print "$query" if $printqueries;
            {             {
              push @shablon,"(?:$arr[0])";               push @shablon,"(?:$arr[0])";
            }             }
            $shablon= join "|", @shablon;              $shablon= join "|", @shablon;
            $shablon=~s/[её]/\[ЕЁ\]/gi;             $shablon=~s/[её]/\[ЕЁ\]/gi;
 #           $shablon=~s/([йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ])/&NoCase($1)/ge;  #           $shablon=~s/([йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ])/&NoCase($1)/ge;
            $shablon=qr/$shablon/i;             $shablon=qr/$shablon/i;
Line 472  print "$query" if $printqueries; Line 677  print "$query" if $printqueries;
         } elsif ($hits =~ /1$/) {          } elsif ($hits =~ /1$/) {
                 $suffix = 'е';                  $suffix = 'е';
         } else {          } else {
                 $suffix = 'я';                   $suffix = 'я';
         }          }
           
         print p({align=>"center"}, "Результаты поиска на " . strong($sstr)          print p({align=>"center"}, "Результаты поиска на " . strong($sstr)
         . " : $hits попадани$suffix.");          . " : $hits попадани$suffix.");
   
Line 484  print "$query" if $printqueries; Line 689  print "$query" if $printqueries;
   
         $sstr =~ s/(.)/&NoCase($1)/ge;          $sstr =~ s/(.)/&NoCase($1)/ge;
   
         my(@sar) = split(' ', $sstr);          my @sar;
         for ($i = 0; $i <= $#Questions; $i++) {          if ($metod ne 'rus') 
                 $output = &PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 1);          {
                 if (param('metod') eq 'rus')            (@sar) = split(' ', $sstr);
                 {             $shablon=join "|",@sar;
                      $output=~s/\b($shablon)\b/\<strong\>$1\<\/strong\>/gi;  
                 } else {  
                 foreach  (@sar) {  
                         $output =~ s/$_/<strong>$&<\/strong>/gs;  
                 }}  
                 print $output;  
         }          }
           PrintList($dbh,\@Questions,$shablon);
 }  }
   
 sub PrintRandom {  sub PrintRandom {
Line 513  sub PrintRandom { Line 713  sub PrintRandom {
         for ($i = 0; $i <= $#Questions; $i++) {          for ($i = 0; $i <= $#Questions; $i++) {
                 # Passing DB handler, question ID, print answer, question                  # Passing DB handler, question ID, print answer, question
                 # number, print title, print text/html                  # number, print title, print text/html
                 $output .=                   $output .=
                         &PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 0, $text);                          &PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 0, $text);
         }          }
         return $output;           return $output;
 }  }
   
 sub PrintTournament {  sub PrintTournament {
Line 526  sub PrintTournament { Line 726  sub PrintTournament {
         my ($output) = '';          my ($output) = '';
   
         %Tournament = &GetTournament($dbh, $Id) if ($Id);          %Tournament = &GetTournament($dbh, $Id) if ($Id);
           
         my ($URL) = $Tournament{'URL'};          my ($URL) = $Tournament{'URL'};
         my ($Info) = $Tournament{'Info'};          my ($Info) = $Tournament{'Info'};
         my ($Copyright) = $Tournament{'Copyright'};          my ($Copyright) = $Tournament{'Copyright'};
Line 536  sub PrintTournament { Line 736  sub PrintTournament {
         if ($Id) {          if ($Id) {
                 for ($Tournament{'Type'}) {                  for ($Tournament{'Type'}) {
                         /Г/ && do {                          /Г/ && do {
                                 $output .= h2({align=>"center"},                                   $output .= h2({align=>"center"},
                                               "Группа: $Tournament{'Title'} ",                                                "Группа: $Tournament{'Title'} ",
                                               "$Tournament{'PlayedAt'}") . p . "\n";                                                "$Tournament{'PlayedAt'}") . p . "\n";
                                 last;                                  last;
Line 544  sub PrintTournament { Line 744  sub PrintTournament {
                         /Ч/ && do {                          /Ч/ && do {
                                 return &PrintTour($dbh, $Tours[0], $answer)                                  return &PrintTour($dbh, $Tours[0], $answer)
                                         if ($#Tours == 0);                                          if ($#Tours == 0);
                                   
                                 my $title="Пакет: $Tournament{'Title'}";                                  my $title="Пакет: $Tournament{'Title'}";
                                 if ($Tournament{'PlayedAt'}) {                                  if ($Tournament{'PlayedAt'}) {
                                     $title .= " $Tournament{'PlayedAt'}";                                      $title .= " $Tournament{'PlayedAt'}";
                                 }                                  }
   
                                 $output .= h2({align=>"center"},                                   $output .= h2({align=>"center"},
                                         "$title") . p . "\n";                                          "$title") . p . "\n";
                                 last;                                  last;
                         };                          };
Line 563  sub PrintTournament { Line 763  sub PrintTournament {
                 $output .= h2("Банк Вопросов: $qnum вопросов") . p . "\n";                  $output .= h2("Банк Вопросов: $qnum вопросов") . p . "\n";
         }          }
   
         for ($i = 0; $i <= $#Tours; $i++) {           for ($i = 0; $i <= $#Tours; $i++) {
                 %Tournament = &GetTournament($dbh, $Tours[$i]);                  %Tournament = &GetTournament($dbh, $Tours[$i]);
                   
                 if ($Tournament{'Type'} =~ /Ч/) {                  if ($Tournament{'Type'} =~ /Ч/) {
                         $SingleTour = 0;                          $SingleTour = 0;
                         my (@Tours) = &GetTours($dbh, $Tournament{'Id'});                          my (@Tours) = &GetTours($dbh, $Tournament{'Id'});
Line 589  sub PrintTournament { Line 789  sub PrintTournament {
                 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=$Tournament{'Id'}&answer=0"},                                                  . a({href=>url .  "?tour=$Tournament{'Id'}&answer=0"},
Line 598  sub PrintTournament { Line 798  sub PrintTournament {
                   "вопросы + ответы") . "]")                    "вопросы + ответы") . "]")
                                 );                                  );
                 } else {                  } else {
                         $list .= dd(a({href=>url . "?tour=$Tournament{'Id'}&comp=1"},                           $list .= dd(a({href=>url . "?tour=$Tournament{'Id'}&comp=1"},
                                 img({src=>'/icons/compressed.gif', alt=>'[ZIP]', border=>1}))                                  img({src=>'/icons/compressed.gif', alt=>'[ZIP]', border=>1}))
                                 . " " . img({src=>$imgsrc, alt=>$alt})                                   . " " . img({src=>$imgsrc, alt=>$alt})
                                 . " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},                                   . " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},
                                 $Tournament{'Title'}. " ".                                   $Tournament{'Title'}. " ".
                                           $Tournament{'PlayedAt'}) . $qnum);                                            $Tournament{'PlayedAt'}) . $qnum);
                 }                  }
         }          }
Line 610  sub PrintTournament { Line 810  sub PrintTournament {
   
         if ($URL) {          if ($URL) {
                 $output .=                  $output .=
                 p("Дополнительная информация об этом турнире - по адресу " .                   p("Дополнительная информация об этом турнире - по адресу " .
                         a({-'href'=>$URL}, $URL));                          a({-'href'=>$URL}, $URL));
         }          }
   
Line 621  sub PrintTournament { Line 821  sub PrintTournament {
         if ($Info) {          if ($Info) {
                 $output .= p($Info);                  $output .= p($Info);
         }          }
           
         return $output;          return $output;
 }  }
   
Line 635  sub Suffix { Line 835  sub Suffix {
   
 sub IsTour {  sub IsTour {
         my ($dbh, $Id) = @_;          my ($dbh, $Id) = @_;
         my ($sth) = $dbh->prepare("SELECT Type FROM Tournaments           my ($sth) = $dbh->prepare("SELECT Type FROM Tournaments
                 WHERE Id=$Id");                  WHERE Id=$Id");
         $sth->execute;          $sth->execute;
         return ($sth->fetchrow)[0] =~ /Т/;          return ($sth->fetchrow)[0] =~ /Т/;
Line 655  sub PrintTour { Line 855  sub PrintTour {
                 if ($Tour{'Type'} !~ /Т/);                  if ($Tour{'Type'} !~ /Т/);
   
         my ($qnum) = $Tour{'QuestionsNum'};          my ($qnum) = $Tour{'QuestionsNum'};
         my ($suffix) = &Suffix($qnum);           my ($suffix) = &Suffix($qnum);
           
         $output .= h2({align=>"center"}, $Tournament{"Title"},           $output .= h2({align=>"center"}, $Tournament{"Title"},
                       $Tournament{'PlayedAt'},                        $Tournament{'PlayedAt'},
                       "<br>", $Tour{"Title"} .                         "<br>", $Tour{"Title"} .
                 " ($qnum вопрос$suffix)\n") . p;                  " ($qnum вопрос$suffix)\n") . p;
   
         my (@Questions) = &GetTourQuestions($dbh, $Id);          my (@Questions) = &GetTourQuestions($dbh, $Id);
         for ($q = 0; $q <= $#Questions; $q++) {          for ($q = 0; $q <= $#Questions; $q++) {
                 $output .= &PrintQuestion($dbh, $Questions[$q], $answer, 0);                  $output .= &PrintQuestion($dbh, $Questions[$q], $answer, 0);
         }           }
   
         $output .= hr({-'align'=>'center', -'width'=>'80%'});          $output .= hr({-'align'=>'center', -'width'=>'80%'});
   
         if ($Tournament{'URL'}) {          if ($Tournament{'URL'}) {
                 $output .=                  $output .=
                 p("Дополнительная информация об этом турнире - по адресу " .                   p("Дополнительная информация об этом турнире - по адресу " .
                         a({-'href'=>$Tournament{'URL'}}, $Tournament{'URL'}));                          a({-'href'=>$Tournament{'URL'}}, $Tournament{'URL'}));
         }          }
   
Line 682  sub PrintTour { Line 882  sub PrintTour {
         if ($Tournament{'Info'}) {          if ($Tournament{'Info'}) {
                 $output .= p($Tournament{'Info'});                  $output .= p($Tournament{'Info'});
         }          }
           
   
         if ($answer == 0) {          if ($answer == 0) {
                 $bottom .=                   $bottom .=
                         "[" . a({href=>url . "?tour=$Id&answer=1"}, "ответы") .  "] " . br;                          "[" . a({href=>url . "?tour=$Id&answer=1"}, "ответы") .  "] " . br;
         }          }
         if (&IsTour($dbh, $Id - 1)) {          if (&IsTour($dbh, $Id - 1)) {
                 $bottom .=                   $bottom .=
                         "[" . a({href=>url . "?tour=" . ($Id - 1) . "&answer=0"},                           "[" . a({href=>url . "?tour=" . ($Id - 1) . "&answer=0"},
                         "предыдущий тур") . "] ";                          "предыдущий тур") . "] ";
                 $bottom .=                   $bottom .=
                         "[" . a({href=>url . "?tour=" . ($Id - 1) . "&answer=1"},                           "[" . a({href=>url . "?tour=" . ($Id - 1) . "&answer=1"},
                         "предыдущий тур с ответами") . "] " . br;                          "предыдущий тур с ответами") . "] " . br;
         }          }
         if (&IsTour($dbh, $Id + 1)) {          if (&IsTour($dbh, $Id + 1)) {
                 $bottom .=                   $bottom .=
                         "[" . a({href=>url . "?tour=" . ($Id + 1) . "&answer=0"},                           "[" . a({href=>url . "?tour=" . ($Id + 1) . "&answer=0"},
                         "следующий тур") . "] ";                          "следующий тур") . "] ";
                 $bottom .=                   $bottom .=
                         "[" . a({href=>url . "?tour=" . ($Id + 1) . "&answer=1"},                           "[" . a({href=>url . "?tour=" . ($Id + 1) . "&answer=1"},
                         "следующий тур с ответами") . "] ";                          "следующий тур с ответами") . "] ";
         }          }
   
Line 720  sub PrintField { Line 920  sub PrintField {
             $value =~ s/^\|([^\n]*)/<pre>$1<\/pre>/mg;              $value =~ s/^\|([^\n]*)/<pre>$1<\/pre>/mg;
         }          }
   
         return $text ? "$header:\n$value\n\n" :           return $text ? "$header:\n$value\n\n" :
                 strong("$header: ") . $value . p . "\n";                  strong("$header: ") . $value . p . "\n";
 }  }
   
 # 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) = @_;
         my ($output, $titles) = ('', '');          my ($output, $titles) = ('', '');
   
         my (%Question) = &GetQuestion($dbh, $Id);          my (%Question) = &GetQuestion($dbh, $Id);
         if (!$text) {          if (!$text) {
                 $output .= hr({width=>"50%"});                  $output .= hr({width=>"50%"});
Line 745  sub PrintQuestion { Line 944  sub PrintQuestion {
                 }                  }
                 $output .= dl(strong($titles));                  $output .= dl(strong($titles));
         }          }
           
         $qnum = $Question{'Number'}          $qnum = $Question{'Number'}
                 if ($qnum == 0);                  if ($qnum == 0);
   
         $output .=           $output .=
                 &PrintField("Вопрос $qnum", $Question{'Question'}, $text);                  &PrintField("Вопрос $qnum", $Question{'Question'}, $text);
   
         if ($answer) {          if ($answer) {
                 $output .=                   $output .=
                         &PrintField("Ответ", $Question{'Answer'}, $text);                          &PrintField("Ответ", $Question{'Answer'}, $text);
   
                 if ($Question{'Authors'}) {                  if ($Question{'Authors'}) {
Line 767  sub PrintQuestion { Line 966  sub PrintQuestion {
                       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;
 #                       $other.=a({href=>url."?qofauthor=$AuthorId"},"$Name $Surname").". ";                           $Name=~s/\./\\\./g;
                           my $sha="(?:$Name\\s+$Surname)|(?:$Surname\\s+$Name)|(?:$firstletter\\.\\s*$Surname)|(?:$Surname\\s+$firstletter\\.)|(?:$Surname)|(?:$Name)";                            my $sha="(?:$Name\\s+$Surname)|(?:$Surname\\s+$Name)|(?:$firstletter\\.\\s*$Surname)|(?:$Surname\\s+$firstletter\\.)|(?:$Surname)|(?:$Name)";
                           $Nicks=~s/^\|//;                            if ($Nicks)
                           foreach (split /\|/, $Nicks)  
                           {                            {
                               s/ /\\s+/;                              $Nicks=~s/^\|//;
                               foreach (split /\|/, $Nicks)
                               {
                                 s/\s+/ /g;
                                 s/\s+$//;
                                 s/ /\\s+/g;
                                 s/\./\\\./g;
                               if (s/>$//) {$sha="$sha|(?:$_)"}                                if (s/>$//) {$sha="$sha|(?:$_)"}
                               else        {$sha="(?:$_)|$sha"}                                else        {$sha="(?:$_)|$sha"}
                               }
                           }                            }
 #$output.=br."sha=$sha".br;  
                           $q=~s/($sha)/a({href=>url."?qofauthor=$AuthorId"},$1)/ei;                            $q=~s/($sha)/a({href=>url."?qofauthor=$AuthorId"},$1)/ei;
                       }                        }
   
Line 793  sub PrintQuestion { Line 997  sub PrintQuestion {
                         $output .= &PrintField("Комментарии", $Question{'Comments'}, $text);                          $output .= &PrintField("Комментарии", $Question{'Comments'}, $text);
                 }                  }
         }          }
   #       $output.=br.a({href=> url."?metod=proxy&qid=$Id"}, 'Близкие вопросы').p
   #             if $answer;
         return $output;          return $output;
 }  }
   
Line 817  sub Get12Random { Line 1023  sub Get12Random {
         my ($qnum) = &GetMaxQId($dbh);          my ($qnum) = &GetMaxQId($dbh);
         my (%chosen);          my (%chosen);
         srand;          srand;
           
    for ($i = 0; $i < $num; $i++) {     for ($i = 0; $i < $num; $i++) {
        do {         do {
            $q = int(rand($qnum));             $q = int(rand($qnum));
Line 837  sub Include_virtual { Line 1043  sub Include_virtual {
   
         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) {
                         s/<!--#include virtual="\/(.*)" -->/&Include_virtual($1)/e;                          s/<!--#include virtual="\/(.*)" -->/&Include_virtual($1)/e;
Line 856  sub PrintArchive { Line 1062  sub PrintArchive {
   
         my (%Tournament) = &GetTournament($dbh, $Id);          my (%Tournament) = &GetTournament($dbh, $Id);
         my (@Tours) = &GetTours($dbh, $Id);          my (@Tours) = &GetTours($dbh, $Id);
           
         if ($Tournament{'Type'} =~ /Г/ || $Id == 0) {          if ($Tournament{'Type'} =~ /Г/ || $Id == 0) {
                 for ($i = 0; $i <= $#Tours; $i++) {                  for ($i = 0; $i <= $#Tours; $i++) {
                         push(@list ,&PrintArchive($dbh, $Tours[$i]));                          push(@list ,&PrintArchive($dbh, $Tours[$i]));
Line 872  sub PrintAll { Line 1078  sub PrintAll {
   
         my (%Tournament) = &GetTournament($dbh, $Id);          my (%Tournament) = &GetTournament($dbh, $Id);
         my (@Tours) = &GetTours($dbh, $Id);          my (@Tours) = &GetTours($dbh, $Id);
         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 894  sub PrintAll { Line 1100  sub PrintAll {
   
 sub PrintDates {  sub PrintDates {
         my ($dbh) = @_;          my ($dbh) = @_;
         my ($from) = param('from_year') . "-" . param('from_month') .           my ($from) = param('from_year') . "-" . param('from_month') .
                 "-" .  param('from_day');                  "-" .  param('from_day');
         my ($to) = param('to_year') . "-" . param('to_month') . "-" .  param('to_day');          my ($to) = param('to_year') . "-" . param('to_month') . "-" .  param('to_day');
         $from = $dbh->quote($from);          $from = $dbh->quote($from);
Line 923  sub PrintDates { Line 1129  sub PrintDates {
   
 sub PrintQOfAuthor  sub PrintQOfAuthor
 {  {
   
     my ($dbh, $id) = @_;      my ($dbh, $id) = @_;
    $id=$dbh->quote($id);     $id=$dbh->quote($id);
     my $sth =  $dbh->prepare("SELECT  Name, Surname FROM Authors WHERE Id=$id");          my $sth =  $dbh->prepare("SELECT  Name, Surname FROM Authors WHERE Id=$id");
     $sth->execute;      $sth->execute;
     my ($name,$surname)=$sth->fetchrow;      my ($name,$surname)=$sth->fetchrow;
   
     $sth =  $dbh->prepare("SELECT Question FROM A2Q WHERE Author=$id");          $sth =  $dbh->prepare("SELECT Question FROM A2Q WHERE Author=$id");
     $sth->execute;      $sth->execute;
     my $q;      my $q;
     my @Questions;            my @Questions;
     while (($q)=$sth->fetchrow,$q)      while (($q)=$sth->fetchrow,$q)
      {push @Questions,$q;}       {push @Questions,$q unless $forbidden{$q}}
   
     my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1);      my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1);
   
Line 943  sub PrintQOfAuthor Line 1150  sub PrintQOfAuthor
         } elsif ($hits =~ /1$/) {          } elsif ($hits =~ /1$/) {
                 $suffix = 'е';                  $suffix = 'е';
         } else {          } else {
                 $suffix = 'я';                   $suffix = 'я';
         }          }
                   print h2("Поиск в базе вопросов");
         print p({align=>"center"}, "Автор ".strong("$name $surname. ")           print printform;
           print p({align=>"center"}, "Автор ".strong("$name $surname. ")
         . " : $hits попадани$suffix.");          . " : $hits попадани$suffix.");
   
   
         for ($i = 0; $i <= $#Questions; $i++) {  #       for ($i = 0; $i <= $#Questions; $i++) {
                 $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');
 }  }
   
   
Line 961  sub PrintAuthors Line 1170  sub PrintAuthors
 {  {
      my ($dbh,$sort)=@_;       my ($dbh,$sort)=@_;
      my($output,$out1,@array,$sth);       my($output,$out1,@array,$sth);
      if ($sort eq 'surname')        if ($sort eq 'surname')
      {       {
         $sth =           $sth =
              $dbh->prepare("SELECT Id, Name, Surname, QNumber FROM Authors order by Surname");               $dbh->prepare("SELECT Id, Name, Surname, QNumber FROM Authors order by Surname, Name");
                }
         $output.="<TABLE><CAPTION>Алфавитный список авторов</CAPTION>";       elsif($sort eq 'name')
        {
           $sth =
                $dbh->prepare("SELECT Id, Name, Surname, QNumber FROM Authors order by Name, Surname");
      }       }
      else       else
      {       {
         $sth =           $sth =
              $dbh->prepare("SELECT Id, Name, Surname, QNumber FROM Authors Order by QNumber DESC");                     $dbh->prepare("SELECT Id, Name, Surname, QNumber FROM Authors Order by QNumber DESC, Surname");
         $output.="<TABLE>";  
      }       }
   
        $output.=h2("Авторы вопросов")."\n";
        $output.="<TABLE>";
   
   
      $sth->execute;       $sth->execute;
      $output.=Tr(th["Фамилия, имя", "Количество вопросов"]);       $output.=Tr(th[a({href=>url."?authors=name"},"Имя")
   .", ".
   a({href=>url."?authors=surname"},"фамилия")
        , a({href=>url."?authors=kvo"},"Количество вопросов")]);
   
      $out1='';       $out1='';
   
      my $ar=$sth->fetchall_arrayref;       my $ar=$sth->fetchall_arrayref;
   
   
       
     foreach my $arr(@$ar)      foreach my $arr(@$ar)
      {       {
             
            my ($id,$name,$surname,$kvo)=@$arr;             my ($id,$name,$surname,$kvo)=@$arr;
            if (!$name || !$surname) {print "Opanki at $id\n"} else             if (!$name || !$surname) {#print "Opanki at $id\n"
                 } else
            {             {
              my $add=Tr(td([a({href=>"/cgi-bin/db.cgi?qofauthor=$id"},'[Q] ')."$name $surname", $kvo]))."\n";               my $add=Tr(td([a({href=>url."?qofauthor=$id"},"$name $surname"), $kvo]))."\n";
              print STDERR $add;               print STDERR $add;
              $output.=$add;               $output.=$add;
            }             }
Line 1000  sub PrintAuthors Line 1219  sub PrintAuthors
 }  }
   
   
      
 MAIN:  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;
   
         my($dbh) = DBI->connect("DBI:mysql:chgk", "piataev", "")          my($dbh) = DBI->connect("DBI:mysql:chgk", "piataev", "")
                 or do {                  or do {
                         print h1("Временные проблемы") . "База данных временно не                          print h1("Временные проблемы") . "База данных временно не
Line 1023  MAIN: Line 1243  MAIN:
                 print &Include_virtual("../dimrub/db/reklama.html");                  print &Include_virtual("../dimrub/db/reklama.html");
         }          }
   
   
 if ($^O =~ /win/i) {  if ($^O =~ /win/i) {
         $thislocale = "Russian_Russia.20866";          $thislocale = "Russian_Russia.20866";
 } else {  } else {
Line 1037  if ((uc 'а') ne 'А') {print "Koi8-r loca Line 1258  if ((uc 'а') ne 'А') {print "Koi8-r loca
                 print header('text/plain');                  print header('text/plain');
         }          }
   
           if (param('hideequal')) {
                      my ($sth)=  $dbh -> prepare("select first, second FROM equalto");
                      $sth -> execute;
                      while ( my  ($first, $second)=$sth -> fetchrow)
                     {
                          $forbidden{$first}=1;
                     }
                     $sth->finish;
           }
   
   
         if (param('rand')) {          if (param('rand')) {
                 my ($type, $qnum) = ('', 12);                  my ($type, $qnum) = ('', 12);
                 $type .= 'Б' if (param('brain'));                  $type .= 'Б' if (param('brain'));
                 $type .= 'Ч' if (param('chgk'));                  $type .= 'Ч' if (param('chgk'));
                 $qnum = param('qnum') if (param('qnum') =~ /^\d+$/);                      $qnum = param('qnum') if (param('qnum') =~ /^\d+$/);
                 $qnum = 0 if (!$type);                  $qnum = 0 if (!$type);
                 if (param('email') && -x $SENDMAIL &&                   if (param('email') && -x $SENDMAIL &&
                 open(F, "| $SENDMAIL -t -n")) {                  open(F, "| $SENDMAIL -t -n")) {
                         my ($Email) = param('email');                          my ($Email) = param('email');
                         my ($mime_type) = $text ? "plain" : "html";                          my ($mime_type) = $text ? "plain" : "html";
Line 1062  EOT Line 1294  EOT
                 } else {                  } else {
                         print &PrintRandom($dbh, $type, $qnum, $text);                          print &PrintRandom($dbh, $type, $qnum, $text);
                 }                  }
         }           }
           elsif (param('authors')){            elsif (param('authors')){
                 print &PrintAuthors($dbh,param('authors'));                  print &PrintAuthors($dbh,param('authors'));
         }          }
Line 1071  EOT Line 1303  EOT
         }          }
           elsif (param('sstr')) {            elsif (param('sstr')) {
                 &PrintSearch($dbh, param('sstr'), param('metod'));                  &PrintSearch($dbh, param('sstr'), param('metod'));
         } elsif (param('all')) {          } 
             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;
                 $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('all')) {
                 print &PrintAll($dbh, 0);                  print &PrintAll($dbh, 0);
         } elsif (param('from_year') && param('to_year')) {          } elsif (param('from_year') && param('to_year')) {
                 print &PrintDates($dbh);                          print &PrintDates($dbh);
         } elsif (param('comp')) {          } elsif (param('comp')) {
             print header(              print header(
                          -'Content-Type' => 'application/x-zip-compressed; name="db.zip"',                           -'Content-Type' => 'application/x-zip-compressed; name="db.zip"',
Removed from v.1.29  
changed lines
  Added in v.1.46

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