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

Diff for /db/prgsrc/db.cgi between versions 1.37 and 1.51

version 1.37, 2001/11/26 10:31:49 version 1.51, 2001/12/13 00:01:58
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=0;  my $printqueries=0;
 my %forbidden=();  my %forbidden=();
 my $debug=0; #added by R7  my $debug=0; #added by R7
   if (param('debug')) {$debug=1; $printqueries=1}
 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 64  sub GetTournament { Line 74  sub GetTournament {
         foreach $name (@{$sth->{NAME}}) {          foreach $name (@{$sth->{NAME}}) {
                 $Tournament{$name} = $arr[$i++];                  $Tournament{$name} = $arr[$i++];
         }          }
           $sth->finish;
         return %Tournament;          return %Tournament;
 }  }
   
Line 85  sub GetQuestion { Line 95  sub GetQuestion {
                 $Question{$name} = $arr[$i++];                  $Question{$name} = $arr[$i++];
         }          }
   
           $sth->finish;
         return %Question;          return %Question;
 }  }
   
Line 94  sub GetTourQuestions { Line 105  sub GetTourQuestions {
         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");
   
         $sth->execute;          $sth->execute;
   
Line 102  sub GetTourQuestions { Line 113  sub GetTourQuestions {
                 push @Questions, $arr[0];                  push @Questions, $arr[0];
         }          }
   
           $sth->finish;
         return @Questions;          return @Questions;
 }  }
   
Line 118  sub GetTours { Line 130  sub GetTours {
         while (@arr = $sth->fetchrow) {          while (@arr = $sth->fetchrow) {
                 push @Tours, $arr[0];                  push @Tours, $arr[0];
         }          }
           $sth->finish;
         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;
     $sth->finish;
     $a[0]||0;
   }
   
   
   sub printform
   {
   
     my $submit=submit(-value=>'ðÏÉÓË');
     my $inputstring=textfield(-name=>'sstr',
                            -default=>param('sstr')||'',
                            -size=>30,
                            -maxlength=>30);
     my $qnumber="÷Ù×ÏÄÉÔØ ÐÏ".br. textfield(-name=>'kvo',
                            -default=>param('kvo')||'150',
                            -size=>3,
                            -maxlength=>5). br."×ÏÐÒÏÓÏ×";
   
     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), td(" "x5),
     td({-valign=>'TOP'},$qnumber)
   ) 
   )
    
   #$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 158  print "$query",br if $printqueries; Line 276  print "$query",br if $printqueries;
                 {                  {
                    push (@{$nf[$i]},$arr[0])                     push (@{$nf[$i]},$arr[0])
                 }                  }
                   $sth->finish;
             }              }
   
   
             my @bad=grep {!$nf[$_]} 0..$#w; # @bad -- ÎÏÍÅÒÁ ÓÌÏ×ÏÆÏÒÍ,              my @bad=grep {!@{$nf[$_]}} 0..$#w; # @bad -- ÎÏÍÅÒÁ ÓÌÏ×ÏÆÏÒÍ,
                                            # ËÏÔÏÒÙÈ ÎÅÔ × ÓÌÏ×ÁÒÅ                                             # ËÏÔÏÒÙÈ ÎÅÔ × ÓÌÏ×ÁÒÅ
   
             if (@bad) #ÅÓÔØ ÎÅÏÐÏÚÎÁÎÎÙÅ ÓÌÏ×ÏÆÏÒÍÙ              if (@bad) #ÅÓÔØ ÎÅÏÐÏÚÎÁÎÎÙÅ ÓÌÏ×ÏÆÏÒÍÙ
Line 192  print "$query",br if $printqueries; Line 311  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;
               $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 204  print "$query\n",br if $printqueries; Line 323  print "$query\n",br if $printqueries;
               {                {
                 @blob=(@blob,unpack 'C*',$arr[0]);                  @blob=(@blob,unpack 'C*',$arr[0]);
               }                }
                 $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;  print "$query\n",br if $printqueries;
               $sth=$dbh -> prepare($query);                $sth=$dbh -> prepare($query);
Line 213  print "$query\n",br if $printqueries; Line 333  print "$query\n",br if $printqueries;
               {                {
                 $frequence[$i]+=$arr[0];                  $frequence[$i]+=$arr[0];
               }                }
                 $sth->finish;
   
   
               if (@blob < 4)                if (@blob < 4)
Line 235  print "$query\n",br if $printqueries; Line 355  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 330  if $$words{$first}; Line 450  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
Line 362  sub Search { Line 500  sub Search {
                  -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;
   
Line 371  sub Search { Line 509  sub Search {
 ######  ######
          {           {
   
           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 395  sub Search { Line 534  sub Search {
   
 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] unless $forbidden{$arr[0]};                  push @Questions, $arr[0] unless $forbidden{$arr[0]};
         }          }
           $sth->finish;
   print "@Questions" if $printqueries;
         return @Questions;          return @Questions;
 }  }
   
Line 411  print $query if $printqueries; Line 550  print $query if $printqueries;
  Ðð Òò Óó Ôô Õõ Ææ Èè Ãã Þþ Ûû Ýý Øø Ùù Üü Àà Ññ/;   Ðð Òò Óó Ôô Õõ Ææ Èè Ãã Þþ Ûû Ýý Øø Ùù Üü Àà Ññ/;
   
 sub NoCase {  sub NoCase {
         my ($sstr) = shift;          my ($sstr) = shift;                     
         my ($res);          my ($res);
   
         if (($res) = grep(/$sstr/, @letters)) {          if (($res) = grep(/$sstr/, @letters)) {
Line 421  sub NoCase { Line 560  sub NoCase {
         }          }
 }  }
   
   sub PrintList {
      my ($dbh,$Questions,$shablon)=@_;
   
           my $first=param('first') ||1;
           my $kvo=param('kvo') ||150;
   
           $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;
           my $sstr=param('sstr');
           $qs=~s/sstr=[^\&]+/sstr=$sstr/;
           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 469  print "$query" if $printqueries; Line 702  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 714  sub PrintField { Line 942  sub PrintField {
 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 744  sub PrintQuestion { Line 971  sub PrintQuestion {
                 if ($Question{'Authors'}) {                  if ($Question{'Authors'}) {
                       my $q=$Question{'Authors'};                        my $q=$Question{'Authors'};
   
                       my $sth=$dbh->prepare("select Authors.Id,Name, Surname, Nicks from Authors, A2Q  #                     my $sth=$dbh->prepare("select Authors.Id,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);
   
                       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;
                          $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)";  #                          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;  #                      }
                       }  
   
                         $output .= &PrintField("á×ÔÏÒ(Ù)", $q, $text);                          $output .= &PrintField("á×ÔÏÒ(Ù)", $q, $text);
   
Line 784  sub PrintQuestion { Line 1010  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 1045  sub Get12Random {
            $sth->execute;             $sth->execute;
            $t = ($sth->fetchrow)[0];             $t = ($sth->fetchrow)[0];
        } until !$chosen{$q} && $t && $type =~ /[$t]/;         } until !$chosen{$q} && $t && $type =~ /[$t]/;
          $sth->finish;
        $chosen{$q} = 'y';         $chosen{$q} = 'y';
        push @questions, $q;         push @questions, $q;
    }     }
Line 908  sub PrintDates { Line 1137  sub PrintDates {
       " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},        " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},
       $Tournament{'Title'}, $Tournament{'PlayedAt'}));        $Tournament{'Title'}, $Tournament{'PlayedAt'}));
         }          }
           $sth->finish;
         $output .= dl($list);          $output .= dl($list);
         return $output;          return $output;
 }  }
   
 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");
Line 926  sub PrintQOfAuthor Line 1157  sub PrintQOfAuthor
     my @Questions;      my @Questions;
     while (($q)=$sth->fetchrow,$q)      while (($q)=$sth->fetchrow,$q)
      {push @Questions,$q unless $forbidden{$q}}       {push @Questions,$q unless $forbidden{$q}}
       $sth->finish;
   
     my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1);      my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1);
   
Line 936  sub PrintQOfAuthor Line 1168  sub PrintQOfAuthor
         } else {          } else {
                 $suffix = 'Ñ';                  $suffix = 'Ñ';
         }          }
           print h2("ðÏÉÓË × ÂÁÚÅ ×ÏÐÒÏÓÏ×");
           print printform;
         print p({align=>"center"}, "á×ÔÏÒ ".strong("$name $surname. ")          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 997  a({href=>url."?authors=surname"},"ÆÁÍÉÌÉ Line 1231  a({href=>url."?authors=surname"},"ÆÁÍÉÌÉ
            }             }
      }       }
      $output.="</TABLE>";       $output.="</TABLE>";
        $sth->finish;
      return $output;       return $output;
 }  }
   
Line 1025  MAIN: Line 1260  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 1084  EOT Line 1320  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;
                 $sth->finish;
                 $searchin{'Question'}=1;
                 $searchin{'Answer'}=1;
         $sstr=~tr/£³/Åå/;
   $sstr=~s/[^ÊÃÕËÅÎÇÛÝÚÈßÆÙ×ÁÐÒÏÌÄÖÜÑÞÓÍÉÔØÂÀêãõëåîçûýúèÿæù÷áðòïìäöüñþóíéôøâàa-zA-Z0-9]/ /gi;
   #              print &PrintQuestion($dbh,$qid, 1, '!');
                 &PrintSearch($dbh, $sstr, 'proxy');
           }
   
             elsif (param('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);
Line 1118  EOT Line 1371  EOT
                         WHERE FileName = '$tour.txt'");                          WHERE FileName = '$tour.txt'");
                         $sth->execute;                          $sth->execute;
                         $tour = ($sth->fetchrow)[0];                          $tour = ($sth->fetchrow)[0];
                           $sth->finish;
                 }                  }
                 print &PrintTournament($dbh, $tour, param('answer'));                  print &PrintTournament($dbh, $tour, param('answer'));
         }          }
Removed from v.1.37  
changed lines
  Added in v.1.51

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