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

Diff for /db/prgsrc/db.cgi between versions 1.38 and 1.43

version 1.38, 2001/11/30 23:48:53 version 1.43, 2001/12/05 01:49:26
Line 7  use strict; Line 7  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
 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{'comments'}=param('Comments');  #$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 122  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/[^ÊÃÕËÅÎÇÛÝÚÈßÆÙ×ÁÐÒÏÌÄÖÜÑÞÓÍÉÔØÂÀêãõëåîçûýúèÿæù÷áðòïìäöüñþóíéôøâàQWERTYUIOPASDFGHJKLZXCVBNM]/ /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 192  print "$query",br if $printqueries; Line 299  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 235  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 330  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
Line 362  sub Search { Line 487  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 496  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 521  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;
Line 403  print $query if $printqueries; Line 528  print $query if $printqueries;
                 push @Questions, $arr[0] unless $forbidden{$arr[0]};                  push @Questions, $arr[0] unless $forbidden{$arr[0]};
         }          }
   
   print "@Questions" if $printqueries;
         return @Questions;          return @Questions;
 }  }
   
Line 421  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 469  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 714  sub PrintField { Line 929  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 752  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;                           $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)
Line 784  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 914  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");
Line 936  sub PrintQOfAuthor Line 1152  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 1025  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 1084  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);
Removed from v.1.38  
changed lines
  Added in v.1.43

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