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

Diff for /db/prgsrc/db.cgi between versions 1.39 and 1.40

version 1.39, 2001/12/03 02:28:56 version 1.40, 2001/12/03 13:57:20
Line 1 Line 1
 #!/usr/bin/perl -w  #!/perl/bin/perl -w
   
 use DBI;  use DBI;
 use CGI ':all';  use CGI ':all';
Line 13  my %forbidden=(); Line 13  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 %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})/;
   
   
   
Line 122  sub GetTours { Line 127  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 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;
         }
   
   #      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 330  if $$words{$first}; Line 391  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,$query);          my (@sar, $i, $sth,$where,$query);
         my $ip=$ENV{'REMOTE_ADDR'};          my $ip=$ENV{'REMOTE_ADDR'};
Line 344  sub Search { Line 406  sub Search {
               ", $ip)";                ", $ip)";
 print $query if $printqueries;  print $query if $printqueries;
         $dbh -> do ($query);          $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 404  print $query if $printqueries; Line 474  print $query if $printqueries;
   
 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 412  print $query if $printqueries; Line 481  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 430  sub NoCase { Line 500  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='';
   
           for($f=1; $f<=@$Questions; $f+=$kvo)
           {
             $l=$f+$kvo-1;
             $l=$#$Questions+1 if $l>$#$Questions+1;
             if ($f==$first) {$nav.="[$f-$l] ";}
             else {
                     my $qs=query_string;
                     $qs=~s/\;/\&/g;
                     $qs=~s/\&first\=[^\&]+//g;
                     $qs.="\&first=$f";
   
                     $nav.= "[".a({href=>(url."?".$qs)},"$f-$l")."] ";}
           }
           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) = @_;
   
         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 478  print "$query" if $printqueries; Line 589  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 723  sub PrintField { Line 829  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 761  sub PrintQuestion { Line 866  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 793  sub PrintQuestion { Line 897  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 950  sub PrintQOfAuthor Line 1056  sub PrintQOfAuthor
         . " : $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 1093  EOT Line 1200  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=~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.39  
changed lines
  Added in v.1.40

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