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

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

version 1.28, 2001/10/23 00:01:03 version 1.29, 2001/11/19 00:59:44
Line 1 Line 1
 #!/usr/local/bin/perl -w  #!/usr/bin/perl -w
   
 use DBI;  use DBI;
 use CGI ':all';  use CGI ':all';
Line 8  use Time::Local; Line 8  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=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 22  $searchin{'answer'}=param('Answer'); Line 23  $searchin{'answer'}=param('Answer');
 $searchin{'comment'}=param('Comment');  $searchin{'comment'}=param('Comment');
 $searchin{'authors'}=param('Authors');  $searchin{'authors'}=param('Authors');
 $searchin{'sources'}=param('Sources');  $searchin{'sources'}=param('Sources');
 $printqueries||=param('debug');  
 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 159  print "$query",br if $printqueries; Line 159  print "$query",br if $printqueries;
                 }                  }
             }              }
   
   
             my @bad=grep {!$nf[$_]} 0..$#w; # @bad -- номера словоформ,              my @bad=grep {!$nf[$_]} 0..$#w; # @bad -- номера словоформ,
                                            # которых нет в словаре                                             # которых нет в словаре
   
Line 175  print "$query",br if $printqueries; Line 176  print "$query",br if $printqueries;
             }              }
             return () if ($all && @verybad);              return () if ($all && @verybad);
   
   
             my $kvo=0;              my $kvo=0;
             push @$allnf, @{$_} foreach @nf;              push @$allnf, @{$_} foreach @nf;
 print "allnf=@$allnf\n".br if $printqueries;  print "nf=@$allnf";
   
             foreach $i (0..$#w) #запросы в базу...              foreach $i (0..$#w) #запросы в базу...
             {              {
Line 232  print "$query\n",br if $printqueries; Line 234  print "$query\n",br if $printqueries;
   
   
   
   
               if (@blob < 4)                if (@blob < 4)
               {                {
                  $tasksof{$i}=undef;                   $tasksof{$i}=undef;
Line 254  print "$query\n",br if $printqueries; Line 255  print "$query\n",br if $printqueries;
                     $field=$fieldname{$field};                      $field=$fieldname{$field};
                     if ($searchin{lc $field})                      if ($searchin{lc $field})
                     {                      {
   
                       push @{$tasksof{$i}{$number}}, $wordnumber;                        push @{$tasksof{$i}{$number}}, $wordnumber;
                                       # дополнили в хэше, висящем на                                        # дополнили в хэше, висящем на
                                       # словоформе $i в %tasksof список                                        # словоформе $i в %tasksof список
Line 270  print "$query\n",br if $printqueries; Line 270  print "$query\n",br if $printqueries;
                }                 }
             }    #foreach $i              }    #foreach $i
   
 print "keys tasksof", keys %tasksof if $printqueries;  #print "keys tasksof", join ' ', keys %{$tasksof{0}};
 #Ищем пересечение или объединение списков вопросов (значений %tasksof)  #Ищем пересечение или объединение списков вопросов (значений %tasksof)
            foreach $sf (keys %tasksof)              foreach $sf (keys %tasksof)
            {             {
               $count{$_}++ foreach keys %{$tasksof{$sf}};                $count{$_}++ foreach keys %{$tasksof{$sf}};
            }             }
Line 280  print "keys tasksof", keys %tasksof if $ Line 280  print "keys tasksof", keys %tasksof if $
                              keys %count) ;                               keys %count) ;
   
   
 #print "\n\$#tasks=",$#tasks,br;  print "\n\$#tasks=",$#tasks,br if $printqueries;
 ############ Сортировка найденных вопросов  ############ Сортировка найденных вопросов
   
 foreach (keys %wordsof)  foreach (keys %wordsof)
Line 293  foreach (keys %wordsof) Line 293  foreach (keys %wordsof)
   
 ############  ############
   
 print "tasks=@tasks" if $printqueries;;  print "tasks=@tasks";
   
 #print "$_ $relevance{$_} | " foreach @tasks;  #print "$_ $relevance{$_} | " foreach @tasks;
 #print br;  #print br;
Line 364  sub Search { Line 364  sub Search {
 ###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;
Line 383  sub Search { Line 382  sub Search {
            $where=      $$q{'matchexp'};             $where=      $$q{'matchexp'};
            my $query= "SELECT Questionid FROM Questions             my $query= "SELECT Questionid FROM Questions
                 WHERE $where";                  WHERE $where";
            print br."Query is: $query".br if $printqueries;             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($_)) {                  if (param($_)) {
                         push @fields, "IFNULL($_, '')";                          push @fields, "IFNULL($_, '')";
                 }                  }
           }            }
   
           @sar = split " ", $sstr;            @sar = split " ", $sstr;
           for $i (0 .. $#sar) {            for $i (0 .. $#sar) {
                 $sar[$i] = $dbh->quote("%${sar[$i]}%");                  $sar[$i] = $dbh->quote("%${sar[$i]}%");
Line 447  sub PrintSearch { Line 444  sub PrintSearch {
   
         my $shablon;          my $shablon;
   
   
         if ($metod eq 'rus')          if ($metod eq 'rus')
         {          {
            my $where='0';             my $where='0';
Line 723  sub PrintField { Line 719  sub PrintField {
             $value =~ s/^\s+/<br>&nbsp;&nbsp;&nbsp;&nbsp;/mg;              $value =~ s/^\s+/<br>&nbsp;&nbsp;&nbsp;&nbsp;/mg;
             $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";
 }  }
Line 760  sub PrintQuestion { Line 757  sub PrintQuestion {
                         &PrintField("Ответ", $Question{'Answer'}, $text);                          &PrintField("Ответ", $Question{'Answer'}, $text);
   
                 if ($Question{'Authors'}) {                  if ($Question{'Authors'}) {
                         $output .= &PrintField("Автор(ы)", $Question{'Authors'}, $text);                        my $q=$Question{'Authors'};
   
                         my $sth=$dbh->prepare("select Authors.Id,Name, Surname, Nicks from Authors, A2Q
                                    where Authors.Id=Author And Question=$Id");
                         $sth->execute;
                         my ($AuthorId,$Name, $Surname,$other,$Nicks);
   
                         while ((($AuthorId,$Name, $Surname,$Nicks)=$sth->fetchrow),$AuthorId)
                         {
                           my ($firstletter)=$Name=~m/^./g;
   #                       $other.=a({href=>url."?qofauthor=$AuthorId"},"$Name $Surname").". ";
                             my $sha="(?:$Name\\s+$Surname)|(?:$Surname\\s+$Name)|(?:$firstletter\\.\\s*$Surname)|(?:$Surname\\s+$firstletter\\.)|(?:$Surname)|(?:$Name)";
                             $Nicks=~s/^\|//;
                             foreach (split /\|/, $Nicks)
                             {
                                 s/ /\\s+/;
                                 if (s/>$//) {$sha="$sha|(?:$_)"}
                                 else        {$sha="(?:$_)|$sha"}
                             }
   #$output.=br."sha=$sha".br;
                             $q=~s/($sha)/a({href=>url."?qofauthor=$AuthorId"},$1)/ei;
                         }
   
                           $output .= &PrintField("Автор(ы)", $q, $text);
   
   #                        $output.= &PrintField("Другие вопросы", $other);
                 }                  }
   
                 if ($Question{'Sources'}) {                  if ($Question{'Sources'}) {
Line 899  sub PrintDates { Line 921  sub PrintDates {
         return $output;          return $output;
 }  }
   
   sub PrintQOfAuthor
   {
       my ($dbh, $id) = @_;
      $id=$dbh->quote($id);
       my $sth =  $dbh->prepare("SELECT  Name, Surname FROM Authors WHERE Id=$id");    
       $sth->execute;
       my ($name,$surname)=$sth->fetchrow;
   
       $sth =  $dbh->prepare("SELECT Question FROM A2Q WHERE Author=$id");    
       $sth->execute;
       my $q;
       my @Questions;      
       while (($q)=$sth->fetchrow,$q)
        {push @Questions,$q;}
   
       my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1);
   
       if ($hits =~ /1.$/  || $hits =~ /[5-90]$/) {
                   $suffix = 'й';
           } elsif ($hits =~ /1$/) {
                   $suffix = 'е';
           } else {
                   $suffix = 'я'; 
           }
           
           print p({align=>"center"}, "Автор ".strong("$name $surname. ") 
           . " : $hits попадани$suffix.");
   
   
           for ($i = 0; $i <= $#Questions; $i++) {
                   $output = &PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 1);
                   print $output;
           }
   }
   
   
   sub PrintAuthors
   {
        my ($dbh,$sort)=@_;
        my($output,$out1,@array,$sth);
        if ($sort eq 'surname') 
        {
           $sth = 
                $dbh->prepare("SELECT Id, Name, Surname, QNumber FROM Authors order by Surname");
           
           $output.="<TABLE><CAPTION>Алфавитный список авторов</CAPTION>";
        }
        else
        {
           $sth = 
                $dbh->prepare("SELECT Id, Name, Surname, QNumber FROM Authors Order by QNumber DESC");      
           $output.="<TABLE>";
        }
   
        $sth->execute;
        $output.=Tr(th["Фамилия, имя", "Количество вопросов"]);
   
        $out1='';
   
        my $ar=$sth->fetchall_arrayref;
   
   
       
       foreach my $arr(@$ar)
        {
             
              my ($id,$name,$surname,$kvo)=@$arr;
              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";
                print STDERR $add;
                $output.=$add;
              }
        }
        $output.="</TABLE>";
        return $output;
   }
   
   
      
 MAIN:  MAIN:
 {  {
         setlocale(LC_CTYPE,'russian');          setlocale(LC_CTYPE,'russian');
Line 960  EOT Line 1062  EOT
                 } else {                  } else {
                         print &PrintRandom($dbh, $type, $qnum, $text);                          print &PrintRandom($dbh, $type, $qnum, $text);
                 }                  }
         } elsif (param('sstr')) {          } 
             elsif (param('authors')){
                   print &PrintAuthors($dbh,param('authors'));
           }
             elsif (param('qofauthor')){
                   &PrintQOfAuthor($dbh,param('qofauthor'));
           }
             elsif (param('sstr')) {
                 &PrintSearch($dbh, param('sstr'), param('metod'));                  &PrintSearch($dbh, param('sstr'), param('metod'));
         } elsif (param('all')) {          } elsif (param('all')) {
                 print &PrintAll($dbh, 0);                  print &PrintAll($dbh, 0);
Removed from v.1.28  
changed lines
  Added in v.1.29

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