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

Diff for /db/prgsrc/db.cgi between versions 1.35 and 1.36

version 1.35, 2001/11/21 02:02:09 version 1.36, 2001/11/25 23:40:27
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, ">errors";
 my $printqueries=0;  my $printqueries=1;
 my $debug=0; #added by R7  my %forbidden=();
   my $debug=1; #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;
   
Line 192  print "$query",br if $printqueries; Line 193  print "$query",br if $printqueries;
               $_= " word2question.word=".$_. ' ' foreach @arr;                $_= " word2question.word=".$_. ' ' foreach @arr;
               $_= " nf.id=".$_. ' ' foreach @arr1;                $_= " nf.id=".$_. ' ' foreach @arr1;
   
 #              $_= " 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 "$query\n",br if $printqueries;
   
Line 405  sub Search { Line 387  sub Search {
           } else {            } else {
                 $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)
   
Line 415  print $query if $printqueries; Line 400  print $query if $printqueries;
   
         $sth->execute;          $sth->execute;
         while (@arr = $sth->fetchrow) {          while (@arr = $sth->fetchrow) {
                 push @Questions, $arr[0];                  push @Questions, $arr[0] unless $forbidden{$arr[0]};
         }          }
                   
         return @Questions;          return @Questions;
Line 768  sub PrintQuestion { Line 753  sub PrintQuestion {
                       {                        {
                         my ($firstletter)=$Name=~m/^./g;                          my ($firstletter)=$Name=~m/^./g;
 #                       $other.=a({href=>url."?qofauthor=$AuthorId"},"$Name $Surname").". ";  #                       $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/^\|//;                            $Nicks=~s/^\|//;
                           foreach (split /\|/, $Nicks)                            foreach (split /\|/, $Nicks)
                           {                            {
                               s/ /\\s+/;                                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 934  sub PrintQOfAuthor Line 922  sub PrintQOfAuthor
     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 1026  MAIN: Line 1014  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 1057  if ((uc 'а') ne 'А') {print "Koi8-r loca Line 1046  if ((uc 'а') ne 'А') {print "Koi8-r loca
                 print header('text/plain');                  print header('text/plain');
         }          }
   
           if (param('showequal')) {
                      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'));
Removed from v.1.35  
changed lines
  Added in v.1.36

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