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

Diff for /db/prgsrc/db.cgi between versions 1.135 and 1.151

version 1.135, 2004/08/28 23:47:41 version 1.151, 2008/11/29 08:51:29
Line 3 Line 3
 use DBI;  use DBI;
 use CGI ':all';  use CGI ':all';
 #use strict;  #use strict;
   use Encode;
   my @softfields=("От Олега Степанова");
 use Time::Local;  use Time::Local;
   use Data::Dumper "Dumper";
   use URI::Escape;
 my $proxyredirect=1;  my $proxyredirect=1;
 use POSIX qw(locale_h);  use POSIX qw(locale_h);
 use locale;  use locale;
 use vars qw($opt_z);  use vars qw($opt_z);
 use Getopt::Std;  use Getopt::Std;
 #my ($dbuser,$dbname,$dbpass,$dbhost);  #my ($dbuser,$dbname,$dbpass,$dbhost);
 require "dbdefs.pl";  eval {require "dbdefs.pl";} ;
 my $url=url||'';  my $url=url||'';
   my @used_stop=();
   my $showNearQuestions=0;
 $dbuser||="piataev";  $dbuser||="piataev";
 $dbname||="chgk";  $dbname||="chgk";
 $dbpass||="";  $dbpass||="";
Line 42  if ($^O =~ /win/i) { Line 48  if ($^O =~ /win/i) {
  $realHTMLDIR="/html/znatoki/baza/";   $realHTMLDIR="/html/znatoki/baza/";
 } else   } else 
 {  {
   $realHTMLDIR="/home/piataev/public_html/dimrub/db/files/";    $realHTMLDIR="/home/znatoki/chgk-db/public_html/dimrub/db/files/";
 }  }
   
   
Line 65  $outputkvo=100 if $outputkvo>100; Line 71  $outputkvo=100 if $outputkvo>100;
   
 if (param('debug')) {$debug=1; $printqueries=1}  if (param('debug')) {$debug=1; $printqueries=1}
 *STDERR=*STDOUT if $debug;  *STDERR=*STDOUT if $debug;
 if ($url !~ /db\.chgk\.info/ && $url !~ /localhost/ && $url !~ /bilbo/ && $url !~ /zaba/) {  if ($url !~ /db\.chgk\.info/ && $url !~ /localhost/ && $url !~ /bilbo/ && $url !~ /zaba/ && $url !~ /question\.chgk\.info/ ) {
    my $u="http://db.chgk.info/cgi-bin/db.cgi?$qs";     my $u="http://db.chgk.info/cgi-bin/db.cgi?$qs";
    Redirect ($u);     Redirect ($u);
    exit;     exit;
Line 128  my $all=param('all'); Line 134  my $all=param('all');
 $all=0 if lc $all eq 'no';  $all=0 if lc $all eq 'no';
 my ($PWD) = `pwd` if $^O!~/win/i;  my ($PWD) = `pwd` if $^O!~/win/i;
 chomp $PWD if $PWD;  chomp $PWD if $PWD;
 my ($SRCPATH) = "/home/piataev/public_html/dimrub/src";  my ($SRCPATH) = "/home/db-chgk/public_html/dimrub/src";
 my ($ZIP) = "/usr/local/bin/zip";  my ($ZIP) = "/usr/bin/zip";
 my $DUMPFILE = "/tmp/chgkdump";  my $DUMPFILE = "/tmp/chgkdump";
 my ($SENDMAIL) = "/usr/sbin/sendmail";  my ($SENDMAIL) = "/usr/sbin/sendmail";
 my ($TMPDIR) = "/var/tmp";  my ($TMPDIR) = "/var/tmp";
Line 277  sub tourhref { Line 283  sub tourhref {
    my $res;     my $res;
    if ($usehtml) {     if ($usehtml) {
         $res=$t;          $res=$t;
           $res=~s/\-q$//;
           $res=~s/\-a$//;
         $res.=$a?"-a":"-q" unless $gr;          $res.=$a?"-a":"-q" unless $gr;
         $res.=".html";          $res.=".html";
         $res=~s/(\#\d+)(.*)$/$2$1/;          $res=~s/(\#\d+)(.*)$/$2$1/;
         my $t=$res;          my $t=$res;
         $t=~s/\#.*$//;          $t=~s/\#.*$//;
         $res=~s/\.1// unless -e "$realHTMLDIR$t";  #       $res=~s/\.1// unless $gr ||$res=~/\.\d+$/;#-e "$realHTMLDIR$t";
         $t=$res;          $t=$res;
         $t=~s/\#.*$//;          $t=~s/\#.*$//;
         $res=~s/\.html/-q\.html/ unless -e "$realHTMLDIR$t";  #       $res=~s/\.html/-q\.html/ unless -e "$realHTMLDIR$t";
         $res="$HTMLDIR$res" unless $opt_z;          $res="$HTMLDIR$res" unless $opt_z;
         return $res;          return $res;
    } else {     } else {
Line 431  action="/znatoki/cgi-bin/db.cgi"> Line 439  action="/znatoki/cgi-bin/db.cgi">
 </td>  </td>
 </tr>  </tr>
 </table>  </table>
 <p><i>Если при попытке поиска выдаётся сообщение об ошибке,   <!--p><i>Если при попытке поиска выдаётся сообщение об ошибке, 
 попробуйте воспользоваться   попробуйте воспользоваться 
 <a href="http://chgk.zaba.ru/search.html">зеркалом базы</a></i>  <a href="http://chgk.zaba.ru/search.html">зеркалом базы</a></i-->
 </center>  </center>
   
 EOT  EOT
Line 499  sub russearch { Line 507  sub russearch {
             my %relevance;              my %relevance;
             my @blob;              my @blob;
             my %count;              my %count;
               my %stop_word;
         POSIX::setlocale( &POSIX::LC_ALL, $thislocale );          POSIX::setlocale( &POSIX::LC_ALL, $thislocale );
 $sstr=~tr/йцукенгшщзхъфывапролджэячсмитьбю/ЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ/;  $sstr=~tr/йцукенгшщзхъфывапролджэячсмитьбю/ЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ/;
 #           @qw=@w =split (' ', uc $sstr);  #           @qw=@w =split (' ', uc $sstr);
             my $ts=uc $sstr;              my $ts=uc $sstr;
             @qw=@w= $ts=~m/(?:(?:${RLrl})+)|(?:[A-Za-z0-9]+)/gom;              @qw=@w= $ts=~m/(?:(?:${RLrl})+)|(?:[A-Za-z0-9]+)/gom;
               $query="select nf.word from nf  where number>=50000";
               $sth=$dbh->prepare($query);
               $sth->execute();
               %stop_word=();
               while (@arr = $sth->fetchrow)
                   {
                      $stop_word{$arr[0]}=1;
                   }
                   $sth->finish;
               
   
 #-----------  #-----------
             foreach $i (0..$#w) # заполняем массив @nf начальных форм              foreach $i (0..$#w) # заполняем массив @nf начальных форм
                            # $nf[$i] -- ссылка на массив возможных                             # $nf[$i] -- ссылка на массив возможных
                            # начальных форм словоформы $i                             # начальных форм словоформы $i
             {              {
                   (push @used_stop, uc $w[$i]),next if $stop_word{uc $w[$i]};
                 $qw= $dbh->quote (uc $w[$i]);                  $qw= $dbh->quote (uc $w[$i]);
   
                 $query="  select distinct w2 from nests                  $query="  select distinct w2 from nests
                                 where w1=$qw";                                  where w1=$qw";
                 $sth=$dbh -> prepare($query);                  $sth=$dbh -> prepare($query);
Line 556  $sstr=~tr/йцукенгшщзхъфывапролджэячсмить Line 576  $sstr=~tr/йцукенгшщзхъфывапролджэячсмить
               $_= " word2question.word=$_" foreach @arr;                $_= " word2question.word=$_" foreach @arr;
               $_= " nf.id=".$_. ' ' foreach @arr1;                $_= " nf.id=".$_. ' ' foreach @arr1;
 #              @arr=(0) unless @arr;  #              @arr=(0) unless @arr;
               $query="select questions from word2question where (". (join ' OR ', @arr).") AND length(questions)<80000";                $query="select questions from word2question where (". (join ' OR ', @arr).") ";
   
               $sth=$dbh -> prepare($query);                $sth=$dbh -> prepare($query);
               $sth->execute;                $sth->execute;
Line 697  sub Search { Line 717  sub Search {
         my (@sar, $i, $sth,$where,$query);          my (@sar, $i, $sth,$where,$query);
         if ($metod eq 'rus')          if ($metod eq 'rus')
         {          {
              my @tasks=russearch($dbh,$sstr,$all,$allnf);               my @tasks;
                @tasks = russearch($dbh,$sstr,$all,$allnf);
                
               
              return @tasks               return @tasks
         }          }
         elsif ($metod eq 'proxy')          elsif ($metod eq 'proxy')
Line 890  sub PrintList { Line 913  sub PrintList {
         for (my $i = $first; $i <= $last; $i++) {          for (my $i = $first; $i <= $last; $i++) {
                 my $q=$q{$$Questions[$i-1]};                  my $q=$q{$$Questions[$i-1]};
                 my $output;                  my $output;
                 $output = &PrintQuestion($dbh, $q, 1, 0, 1,0,1  );                  $output = &PrintQuestion($dbh, $q, 1, 0, 1,$text,1  );
 #                if (param('metod') && (param('metod') eq 'rus' || param('metod') eq 'proxy'))  #                if (param('metod') && (param('metod') eq 'rus' || param('metod') eq 'proxy'))
                 {                  {
                      $output=~s/\b($shablon)\b/\<strong\>$1\<\/strong\>/gi;                       $output=~s/\b($shablon)\b/\<strong\>$1\<\/strong\>/gi;
                      $output=~s/($shablon)/\<strong\>$1\<\/strong\>/gi;                       $output=~s/($shablon)/\<strong\>$1\<\/strong\>/gi;
                        $output=~s/(href="[^"]*?)(?:<.*?>)+([^"]*?)(?:<\/.*?>)+([^"]*?")/!1 $1$2$3 2!/g;#!!!!
                 }                  }
   
                 $Output.= $output;                  $Output.= $output;
         }          }
         $sth->finish;          $sth->finish;
Line 937  sub PrintSearch { Line 962  sub PrintSearch {
                         }                          }
                 while (--$ss && (!$dbh->do ("insert into lastqueries (id,sstr,questions,allnf)                   while (--$ss && (!$dbh->do ("insert into lastqueries (id,sstr,questions,allnf) 
                          values ($was, $qsstr,$tmp,$nf)")));                           values ($was, $qsstr,$tmp,$nf)")));
                 $Output.= "Something is wrong...".br unless $ss;                  $Output.= "Something is wrong...".br."\n" unless $ss;
               }                }
         }          }
   
   
   
         $Output.= p. "Время поиска: " . (time-$t) ." сек.".p;          $Output.= p. "Время поиска: " . (time-$t) ." сек.".p;
           $_="\"$_\"" foreach @used_stop;
           $Output.= p. (join ', ',@used_stop) ." ignored".p if @used_stop;
         my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1);          my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1);
   
         my $shablon;          my $shablon;
Line 1175  sub PrintTournament { Line 1202  sub PrintTournament {
                 p("Дополнительная информация об этом турнире - по адресу " .                  p("Дополнительная информация об этом турнире - по адресу " .
                         a({-'href'=>$URL}, $URL));                          a({-'href'=>$URL}, $URL));
         }          }
   
         if ($Copyright) {          if ($Copyright) {
                 $output .= p("Копирайт: " .   $Copyright);                  $output .= p("Копирайт: " .   $Copyright);
         }          }
Line 1185  sub PrintTournament { Line 1211  sub PrintTournament {
         if ($Info) {          if ($Info) {
                 $output .= p($Info);                  $output .= p($Info);
         }          }
   
           $output.=p("<a href='/dbxml.php?tour=".param('tour')."'>XML</a>");
           
           
         return $output;          return $output;
 }  }
   
Line 1254  sub PrintTour { Line 1284  sub PrintTour {
   
         $output .= h2({align=>"center"}, $Tournament{"Title"},          $output .= h2({align=>"center"}, $Tournament{"Title"},
                       $Tournament{'PlayedAt'}||'',                        $Tournament{'PlayedAt'}||'',
                       "<br>", $Tour{"Title"} .                        "<br>\n", $Tour{"Title"} .
                 " ($qnum вопрос$suffix)\n") . p;                  " ($qnum вопрос$suffix)\n") . p;
         $output .=&PrintEditor(\%Tour);          $output .=&PrintEditor(\%Tour);
   
Line 1262  sub PrintTour { Line 1292  sub PrintTour {
         my $sth=SelectQuestions($dbh,\@Questions,0);          my $sth=SelectQuestions($dbh,\@Questions,0);
         for ($q = 0; $q <= $#Questions; $q++) {          for ($q = 0; $q <= $#Questions; $q++) {
                 fetchquestion($sth,\%q,0);                  fetchquestion($sth,\%q,0);
                 $output .= &PrintQuestion($dbh, \%q, $answer, 0,0,0,1);                  $output .= &PrintQuestion($dbh, \%q, $answer, 0,0,$text,1);
         }          }
         $sth->finish;          $sth->finish;
         $output .= hr({-'align'=>'center', -'width'=>'80%'});          $output .= hr({-'align'=>'center', -'width'=>'80%'});
   
         if ($Tournament{'URL'}) {          if ($Tournament{'URL'}) {
                 $output .=              $URL = $Tournament{'URL'};
                 p("Дополнительная информация об этом турнире - по адресу " .              $URL=~s/http:\/znatoki\/boris\/reports\//$newsurl/ if $url=~/kulichki/ || $url=~/db.chgk.info/;
                         a({-'href'=>$Tournament{'URL'}}, $Tournament{'URL'}));              $URL=~s/\/znatoki\/boris\/reports\//$newsurl/ if url=~/kulichki/ || $url=~/db.chgk.info/;
   
               $output .=
               p("Дополнительная информация об этом турнире - по адресу " .
                           a({-'href'=>$URL}, $URL));
         }          }
   
         if ($Tournament{'Copyright'}) {          if ($Tournament{'Copyright'}) {
                 $output .= p("Копирайт: " .   $Tournament{'Copyright'});                  $output .= p("Копирайт: " .   $Tournament{'Copyright'});
         }          }
   
         if ($Tournament{'Info'}) {          if ($Tournament{'Info'}  ) {
                 $output .= p($Tournament{'Info'});                  $output .= p($Tournament{'Info'});
         }          }
   
           if ($Tour{'Info'} && ($Tournament{'Info'} ne $Tour{'Info'})) {
                   $output .= "!!".p($Tour{'Info'});
           }
   
           $output.=p("<a href='/dbxml.php?tour=".param('tour')."'>XML</a>");
   
         my $n=$Tour{'Number'};          my $n=$Tour{'Number'};
         if ($answer == 0) {          if ($answer == 0) {
                 my $nn=".$n";                  my $nn=".$n";
Line 1288  sub PrintTour { Line 1328  sub PrintTour {
                                   
                 $bottom .=                  $bottom .=
                         "[" . a({href=>tourhref("$fname$nn",1)},                           "[" . a({href=>tourhref("$fname$nn",1)}, 
                          "ответы") .  "] " . br;                           "ответы") .  "] " . br."\n";
         }          }
         if ($n>1) {          if ($n>1) {
                 $bottom .=                  $bottom .=
Line 1296  sub PrintTour { Line 1336  sub PrintTour {
                         "предыдущий тур") . "] ";                          "предыдущий тур") . "] ";
                 $bottom .=                  $bottom .=
                         "[" . a({href=>tourhref("$fname.".($n-1),1)},                          "[" . a({href=>tourhref("$fname.".($n-1),1)},
                         "предыдущий тур с ответами") . "] " . br;                          "предыдущий тур с ответами") . "] " . br."\n";
         }          }
         if (&IsTour($dbh, $Tour{'ParentId'}, $n + 1)) {          if (&IsTour($dbh, $Tour{'ParentId'}, $n + 1)) {
                 $bottom .=                  $bottom .=
Line 1313  sub PrintTour { Line 1353  sub PrintTour {
         return $output;          return $output;
 }  }
   
   
   sub escapeUrl {
           my $uri = shift;
           $uri=~s/<.*?>//g;
           $uri =~ s/([Ю-Ъю-ъ]+)/URI::Escape::uri_escape_utf8(decode("koi8-r",$1))/eg;
           return $uri;    
   }
   
 sub PrintField {  sub PrintField {
         my ($header, $value, $text) = @_;          my ($header, $value, $text) = @_;
         if ($text) {          if ($text) {
             $value =~ s/<[\/\w]*?>//sg;              $value =~ s/<[\/\w]*?>//sg;
         } else {          } else {
             $value =~ s/^\s+/<br>&nbsp;&nbsp;&nbsp;&nbsp;/mg;              if ($header=~/Комментар/)
               {
                   $value=~s/^\s*$_[\.:]/p."\n".strong("$_").":\n"/me foreach @softfields;
               }
   
               $value =~ s/^\s+/<br>\n&nbsp;&nbsp;&nbsp;&nbsp;/mg;
             $value =~ s/(\s+)-+(\s+)/$1&#0150;$2/mg;              $value =~ s/(\s+)-+(\s+)/$1&#0150;$2/mg;
             $value =~ s/\s+\&#0150/&nbsp;\&#0150/mg               $value =~ s/\s+\&#0150/&nbsp;\&#0150/mg 
                         if $value !~ /^\|/;                          if $value !~ /^\|/;
             $value =~ s/^\|([^\n]*)/<pre>$1<\/pre>/mg;              $value =~ s/^\|([^\n]*)/<pre>$1<\/pre>/mg;
             $value =~ s/(http:\/\/\S+[^\s\)\(\,\.])/<a href="$1">$1<\/a>/g if $header !~ /^Авто/;  
               $value =~ s/(http:\/\/\S+[^\s\)\(\,\.])/a({href=>escapeUrl($1)},$1)/egm if $header !~ /^Авто/;#!!!
   
   
   #           $value =~ s/(http:\/\/\S+[^\s\)\(\,\.])/make/eg if $header !~ /^Авто/;#!!!
   #           $value =~ s/(http:\/\/\S+[^\s\)\(\,\.])/<a href="$1">$1<\/a>/g if $header !~ /^Авто/;
 #           $value =~ s/(http:\/\/(?:\w+.)+[\w\\\~]+(\?[^\s.]+)?)/<a href="$1">$1<\/a>/g if $header !~ /^Авто/;  #           $value =~ s/(http:\/\/(?:\w+.)+[\w\\\~]+(\?[^\s.]+)?)/<a href="$1">$1<\/a>/g if $header !~ /^Авто/;
 #           $value =~ s/(\s)"/$1&#147;/mg;  #           $value =~ s/(\s)"/$1&#147;/mg;
 #           $value =~ s/^"/&#147;/mg;  #           $value =~ s/^"/&#147;/mg;
 #           $value =~ s/"/&#148;/mg;  #           $value =~ s/"/&#148;/mg;
         }          }
   
           if ($value=~/^\s*(<p.*?>)?\s*<strong/) {
                   return $text ? "$value\n\n" :
                           $value . p . "\n";
           }
         return $text ? "$header:\n$value\n\n" :          return $text ? "$header:\n$value\n\n" :
                 strong("$header: ") . $value . p . "\n";                  strong("$header: ") . "\n".$value . p . "\n";
 }  }
   
 # Gets a DB handler (ofcourse) and a question Id. Prints  # Gets a DB handler (ofcourse) and a question Id. Prints
Line 1475  $output.="</span>" Line 1536  $output.="</span>"
   
         }          }
         $output=~s/\(pic: ([^\)]*)\)/<p><img src="\/znatoki\/images\/db\/$1"><p>/g unless $text;          $output=~s/\(pic: ([^\)]*)\)/<p><img src="\/znatoki\/images\/db\/$1"><p>/g unless $text;
           $output=~s/⌡/\&iuml;/g;
           $output=~s/⌠/\&Iuml;/g;
   
         $paramtour||=param("tour");          $paramtour||=param("tour");
         $fname=$fname.".$Question{'TourNumber'}" if $fname && $Question{'TourNumber'};          $fname=$fname.".$Question{'TourNumber'}" if $fname && $Question{'TourNumber'};
 $fname||=param('tour');  $fname||=param('tour');
         my $qid=$fname ? ($fname.".$Question{'Number'}" ): '';          my $qid=$fname ? ($fname.".$Question{'Number'}" ): '';
   
         $output.=br.a({href=> $url."?metod=proxy&          $output.=br."\n".a({href=> "/search/"."?metod=proxy&
 qid=$qid"}, 'Близкие вопросы').p  qid=$qid"}, 'Близкие вопросы').p
              if $answer>0 && !$text && $qid;               if $answer>0 && !$text && $qid && $showNearQuestions;
         return $output;          return $output;
 }  }
   
Line 1705  sub PrintQOfAuthor Line 1769  sub PrintQOfAuthor
                 $suffix = 'я';                  $suffix = 'я';
         }          }
         $Output.= printform;          $Output.= printform;
         $Output.= p({align=>"center"}, "Автор ".strong("$name $surname. ")          $Output.= p({align=>"center"}, "Автор ".strong("$name $surname ")
         . " : $hits попадани$suffix.");          . " : $hits попадани$suffix.");
   
   
Line 1955  MAIN: Line 2019  MAIN:
         my $texttour=$tour;          my $texttour=$tour;
         my ($sth,$dbh);          my ($sth,$dbh);
         my($dsn) = "DBI:mysql:database=$dbname;host=$dbhost";          my($dsn) = "DBI:mysql:database=$dbname;host=$dbhost";
         $dbh = DBI->connect($dsn, $dbuser, $dbpass)           $dbh = DBI->connect($dsn, $dbuser, $dbpass)
 #       $dbh = DBI->connect("DBI:mysql:$dbname", $username, $dbpass)  #       $dbh = DBI->connect("DBI:mysql:$dbname", $username, $dbpass)
                 or do {                  or do {
                         print header.h1("Временные проблемы") . "База вопросов временно не                          print header.h1("Временные проблемы") . "База вопросов временно не
Line 1964  MAIN: Line 2028  MAIN:
                     print end_html;                      print end_html;
                         die "Can't connect to DB chgk\n";                          die "Can't connect to DB chgk\n";
                 };                  };
           $dbh->do("set names koi8r");
   
         if (param('qid') && (param('qid')=~/^\d+$/) || $tour && $tour=~/^\d+$/) {          if (param('qid') && (param('qid')=~/^\d+$/) || $tour && $tour=~/^\d+$/) {
            my $destination='http://chgk.zaba.ru/search.html';  #          my $destination='http://chgk.zaba.ru/search.html';
 #               print header (-'Content-Type' => 'text/html',  #               print header (-'Content-Type' => 'text/html',
 #                -'Location:'=> 'http:\\db.chgk.info');  #                -'Location:'=> 'http:\\db.chgk.info');
                 Redirect($destination);                  Redirect($destination);
                 exit                  exit
         }          }
   
         if ($tour && !param('qnumber') && (!param('answers')||(param('answers')<=1)))          if (0 && $tour && !param('qnumber') && (!param('answers')||(param('answers')<=1)))
         {                 {       
                 my $n=param('tour');                  my $n=param('tour');
                 $n=~s/.txt$//;                          $n=~s/.txt$//;        
Line 2205  EOT Line 2269  EOT
                   $QuestionNumber=($sth->fetchrow)[0]||0;                    $QuestionNumber=($sth->fetchrow)[0]||0;
                 }                  }
                 if ($QuestionNumber) {                  if ($QuestionNumber) {
                   $globaloutput.= &PrintQuestion($dbh, $QuestionNumber, $withanswers||0, $qnum, 1,0,0);                    $globaloutput.= &PrintQuestion($dbh, $QuestionNumber, $withanswers||0, $qnum, 1,$text,0);
 #                                        $dbh, $Id, $answer, $qnum, $title, $text  #                                        $dbh, $Id, $answer, $qnum, $title, $text
                 } else  {                  } else  {
                    $globaloutput.=&PrintTournament($dbh, $tour, $withanswers);                     $globaloutput.=&PrintTournament($dbh, $tour, $withanswers);
Removed from v.1.135  
changed lines
  Added in v.1.151

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