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

Diff for /db/prgsrc/db.cgi between versions 1.127 and 1.145

version 1.127, 2003/12/19 08:05:01 version 1.145, 2006/09/30 22:16:48
Line 2 Line 2
   
 use DBI;  use DBI;
 use CGI ':all';  use CGI ':all';
 use strict;  #use strict;
   my @softfields=("От Олега Степанова");
 use Time::Local;  use Time::Local;
   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);
   eval {require "dbdefs.pl";} ;
   my $url=url||'';
   my @used_stop=();
   my $showNearQuestions=0;
   $dbuser||="piataev";
   $dbname||="chgk";
   $dbpass||="";
   $dbhost||="localhost";
 getopts('z');  getopts('z');
 $opt_z||=param("makehtml");  $opt_z||=param("makehtml");
 my $timestamp="_timestamp.tmp";  my $timestamp="_timestamp.tmp";
   my $usehash=0;
 my $paramtour;  my $paramtour;
 my $withanswers=param('answer')||param('answers');  my $withanswers=param('answer')||param('answers');
 open STDERR, ">/var/tmp/errors1";  open STDERR, ">/var/tmp/errors1";
 my $newsurl='http://news.chgk.info/';  my $newsurl='http://news.chgk.info/';
 my $reklama="../dimrub/db/reklama.html";  my $reklama="../dimrub/db/reklama.html";
 my $footer="../dimrub/db/footer.html";  my $footer="../dimrub/db/footer.html";
   $footer="../../chgk/footer.html" if $url=~/zaba/;
   $reklama="../../chgk/reklama.html" if $url=~/zaba/;
 my $datefooter="../dimrub/db/date";  my $datefooter="../dimrub/db/date";
   $datefooter="../../chgk/date" if $url=~/zaba/;
   
 my $fname;  my $fname;
 $reklama="../reklama.html" if $opt_z;  $reklama="../reklama.html" if $opt_z;
Line 31  if ($^O =~ /win/i) { Line 45  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/";
 }  }
   
   
 my $usehtml=$opt_z||0;  my $usehtml=$opt_z||0;
 $usehtml=1;  $usehtml=1;
   $usehtml=0 if $url=~/zaba/ || $url=~/localhost/;
   
 my $usewas=0;  my $usewas=0;
 my $cashednumber=500;  my $cashednumber=500;
 my $outputnumber=10;  my $outputnumber=10;
 my ($proxyptext,$proxysstr);  my ($proxyptext,$proxysstr);
 my $printqueries=0;  my $printqueries=0;
 my $url=url||'';  
 my $qs=query_string;  my $qs=query_string;
 my $globaloutput;  my $globaloutput;
 my %forbidden=();  my %forbidden=();
 my $debug=0; #added by R7  my $debug=0; #added by R7
   my $metod=param('metod')||'';
 my $outputkvo=param('kvo') ||$outputnumber;  my $outputkvo=param('kvo') ||$outputnumber;
 $outputkvo=100 if $outputkvo>100;  $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/) {  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;
 }  }
   
   if ($proxyredirect && $metod=~/proxy/ && $url !~ /localhost/ && $url !~ /bilbo/ && $url !~ /zaba/) {
      my $u="http://chgk.zaba.ru/cgi-bin/db.cgi?$qs";
      Redirect ($u);
      exit;
   }
   
 #if (!param('sstr') && param('all')) {  #if (!param('sstr') && param('all')) {
 #          my $destination='http://db.chgk.info/all.html';  #          my $destination='http://db.chgk.info/all.html';
 #               Redirect($destination);  #               Redirect($destination);
Line 70  POSIX::setlocale( &POSIX::LC_ALL, $thisl Line 95  POSIX::setlocale( &POSIX::LC_ALL, $thisl
   
 if ((uc 'а') ne 'А') {print STDERR "Koi8-r locale not installed!\n"};  if ((uc 'а') ne 'А') {print STDERR "Koi8-r locale not installed!\n"};
   
 my %fieldname= (0,'Question', 1, 'Answer', 2, 'Comments', 3, 'Authors', 4, 'Sources');  my %fieldname= (0,'Question', 1, 'Answer', 2, 'PassCriteria', 3, 'Comments', 4, 'Authors', 5, 'Sources');
 my %rusfieldname=('Question','Вопрос', 'Answer', 'Ответ',   my %rusfieldname=('Question','Вопрос', 'Answer', 'Ответ', 'PassCriteria','Зачёт',
                   'Comments', 'Комментарии', 'Authors', 'Автор',                     'Comments', 'Комментарии', 'Authors', 'Автор', 
                   'Sources', 'Источник','old','Старый','rus','Новый',                    'Sources', 'Источник','old','Старый','rus','Новый',
                   'chgk', 'ЧГК', 'brain', 'Брейн-ринг','game', 'Своя игра',                     'chgk', 'ЧГК', 'brain', 'Брейн-ринг','game', 'Своя игра', 
Line 106  my $all=param('all'); Line 131  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 184  sub GetTournament { Line 209  sub GetTournament {
 sub fetchquestion {  sub fetchquestion {
         my ($sth,$q,$WithTour)=@_;          my ($sth,$q,$WithTour)=@_;
         if ($WithTour) {          if ($WithTour) {
                 ($$q{'QuestionId'}, $$q{'Question'},$$q{'Answer'},$$q{'Comments'},$$q{'Authors'},$$q{'Sources'},                  ($$q{'QuestionId'}, $$q{'Question'},$$q{'Answer'},$$q{'PassCriteria'},$$q{'Comments'},$$q{'Authors'},$$q{'Sources'},
                 $$q{'Number'},                   $$q{'Number'}, 
                 $$q{'Title'}, $$q{'TourTitle'}, $$q{'FileName'},$$q{'PlayedAt'},$$q{'TourNumber'}) =                   $$q{'Title'}, $$q{'TourTitle'}, $$q{'FileName'},$$q{'PlayedAt'},$$q{'TourNumber'}) = 
                 $sth->fetchrow;                  $sth->fetchrow;
         } else {          } else {
                 ($$q{'QuestionId'}, $$q{'Question'},$$q{'Answer'},$$q{'Comments'},$$q{'Authors'},$$q{'Sources'},                  ($$q{'QuestionId'}, $$q{'Question'},$$q{'Answer'},$$q{'PassCriteria'},$$q{'Comments'},$$q{'Authors'},$$q{'Sources'},
                 $$q{'Number'})=                   $$q{'Number'})= 
                 $sth->fetchrow;                  $sth->fetchrow;
         }          }
Line 211  sub SelectQuestions { Line 236  sub SelectQuestions {
   
         my $query;          my $query;
         if ($WithTour) {          if ($WithTour) {
                 $query="SELECT QuestionId, Questions.Question, Answer, Comments, Authors, Sources,                  $query="SELECT QuestionId, Questions.Question, Answer, PassCriteria, Comments, Authors, Sources,
                         Questions.Number                          Questions.Number
                         , t2.Title, t1.Title, t2.FileName,  t2.PlayedAt,t1.Number                          , t2.Title, t1.Title, t2.FileName,  t2.PlayedAt,t1.Number
                         from Questions,Tournaments as t1, Tournaments as t2                           from Questions,Tournaments as t1, Tournaments as t2 
                         WHERE $where";                          WHERE $where";
         } else {          } else {
                 $query="SELECT QuestionId, Questions.Question, Answer, Comments, Authors, Sources,                  $query="SELECT QuestionId, Questions.Question, Answer, PassCriteria, Comments, Authors, Sources,
                         Questions.Number from Questions                           Questions.Number from Questions 
                         WHERE $where";                          WHERE $where";
         }          }
Line 255  sub tourhref { Line 280  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/;
Line 263  sub tourhref { Line 290  sub tourhref {
         $res=~s/\.1// unless -e "$realHTMLDIR$t";          $res=~s/\.1// unless -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 {
         $res=$url;          $res=$url;
         $res.="?tour=$t";          $res.=$a?"?answers=1&":"?";
         $res.=$a?"&answers=1":"";          $res.="tour=$t";
   
         return $res;          return $res;
    }     }
   
Line 334  sub printform Line 362  sub printform
   my $sstr=param('sstr');    my $sstr=param('sstr');
   my @df=keys %searchin;    my @df=keys %searchin;
   my %checked;    my %checked;
   $checked{lc $_}="" foreach ('Question','Answer','Comments','Authors','Sources','old','rus',    $checked{lc $_}="" foreach ('Question','Answer','PassCriteria','Comments','Authors','Sources','old','rus',
       'chgk','brain','igp','game','ehruditka','beskrylka');        'chgk','brain','igp','game','ehruditka','beskrylka');
   @df=('Question', 'Answer') unless @df;    @df=('Question', 'Answer') unless @df;
   $checked{lc $_}="checked" foreach @df;    $checked{lc $_}="checked" foreach @df;
   my $fields=checkbox_group('searchin',['Question','Answer','Comments','Authors','Sources'], [@df],    my $fields=checkbox_group('searchin',['Question','Answer','PassCriteria','Comments','Authors','Sources'], [@df],
              'false',\%rusfieldname);               'false',\%rusfieldname);
   @df=param('type');    @df=param('type');
   @df=('chgk','brain','igp','game','ehruditka','beskrylka') unless @df;    @df=('chgk','brain','igp','game','ehruditka','beskrylka') unless @df;
Line 364  action="/znatoki/cgi-bin/db.cgi"> Line 392  action="/znatoki/cgi-bin/db.cgi">
 <table border="1" cellpadding=4 cellspacing=0>  <table border="1" cellpadding=4 cellspacing=0>
 <tr>  <tr>
 <th align="left" rowspan=3 width="20%"> Вариант поиска:  <th align="left" rowspan=3 width="20%"> Вариант поиска:
 </td><td rowspan=2 colspan=2>  </td><td rowspan=2 colspan=3>
 <input type="radio" $checked{'old'} name="metod" value="old"> Простой (старый)  <input type="radio" $checked{'old'} name="metod" value="old"> Простой (старый)
 </td><td>  </td><td>
 <input type="checkbox" $checked{'chgk'} name="type" value="chgk">&nbsp;"Что?&nbsp;Где?&nbsp;Когда?"  <input type="checkbox" $checked{'chgk'} name="type" value="chgk">&nbsp;"Что?&nbsp;Где?&nbsp;Когда?"
Line 382  action="/znatoki/cgi-bin/db.cgi"> Line 410  action="/znatoki/cgi-bin/db.cgi">
 <input type="checkbox" $checked{'beskrylka'} name="type" value="beskrylka">&nbsp;"Бескрылка"  <input type="checkbox" $checked{'beskrylka'} name="type" value="beskrylka">&nbsp;"Бескрылка"
 </td>  </td>
 </tr><tr>  </tr><tr>
 <td colspan=5><input type="radio" $checked{'rus'} name="metod" value="rus"> Расширенный (с учетом грамматики, в вопросах всех типов)  <td colspan=6><input type="radio" $checked{'rus'} name="metod" value="rus"> Расширенный (с учетом грамматики, в вопросах всех типов)
 </td>  </td>
 </tr><tr>  </tr><tr>
 <th align="left">Искать:  <th align="left">Искать:
 </td><td colspan=2>  </td><td colspan=3>
 <input type="radio" $checked{'all'} name="all" value="yes">Все слова  <input type="radio" $checked{'all'} name="all" value="yes">Все слова
 </td><td colspan=3>  </td><td colspan=3>
 <input type="radio" $checked{'any'} name="all" value="no">Любое слово  <input type="radio" $checked{'any'} name="all" value="no">Любое слово
Line 398  action="/znatoki/cgi-bin/db.cgi"> Line 426  action="/znatoki/cgi-bin/db.cgi">
 </td><td width="15%">  </td><td width="15%">
 <input type="checkbox" name="searchin" value="Answer" $checked{'answer'}>Ответ<br>   <input type="checkbox" name="searchin" value="Answer" $checked{'answer'}>Ответ<br> 
 </td><td width="15%">  </td><td width="15%">
   <input type="checkbox" name="searchin" value="PassCriteria" $checked{'passcriteria'}>Зачёт<br> 
   </td><td width="15%">
 <input type="checkbox" name="searchin" value="Comments" $checked{'comments'}>Комментарии<br>   <input type="checkbox" name="searchin" value="Comments" $checked{'comments'}>Комментарии<br> 
 </td><td width="15%">  </td><td width="15%">
 <input type="checkbox" name="searchin" value="Authors" $checked{'authors'}>Автор<br>  <input type="checkbox" name="searchin" value="Authors" $checked{'authors'}>Автор<br>
Line 406  action="/znatoki/cgi-bin/db.cgi"> Line 436  action="/znatoki/cgi-bin/db.cgi">
 </td>  </td>
 </tr>  </tr>
 </table>  </table>
   <!--p><i>Если при попытке поиска выдаётся сообщение об ошибке, 
   попробуйте воспользоваться 
   <a href="http://chgk.zaba.ru/search.html">зеркалом базы</a></i-->
 </center>  </center>
   
 EOT  EOT
Line 444  sub makeproxysstr { Line 477  sub makeproxysstr {
 #      $good{$words[$_]}=1 foreach 0..4;  #      $good{$words[$_]}=1 foreach 0..4;
       foreach (@words)        foreach (@words)
       {        {
          $good{$_}=1 if $c{$_}<200;           $good{$_}=1 if $c{$_}<200 && length $_>2;
       }        }
   
       $good{$words[$_]}=0 foreach 16..$#words;        $good{$words[$_]}=0 foreach 16..$#words;
Line 471  sub russearch { Line 504  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 528  $sstr=~tr/йцукенгшщзхъфывапролджэячсмить Line 573  $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 590  $sstr=~tr/йцукенгшщзхъфывапролджэячсмить Line 635  $sstr=~tr/йцукенгшщзхъфывапролджэячсмить
 #Ищем пересечение или объединение списков вопросов (значений %tasksof)  #Ищем пересечение или объединение списков вопросов (значений %tasksof)
             foreach $sf (keys %tasksof)              foreach $sf (keys %tasksof)
            {             {
               $count{$_}++ foreach keys %{$tasksof{$sf}};                  foreach (keys %{$tasksof{$sf}})
                   {
                        next if $forbidden{$_};
                        $count{$_}++ 
                   }
   
            }             }
              @tasks= ($all ? (grep {$count{$_}==$kvo} keys %count) :               @tasks= ($all ? (grep {$count{$_}==$kvo} keys %count) :
                              keys %count) ;                               keys %count) ;
Line 678  sub Search { Line 728  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 PassCriteria 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 PassCriteria Sources Authors Comments/) unless scalar @fields;
            my $fields=join ",", @fields;             my $fields=join ",", @fields;
            my $q=new Text::Query($sstr,             my $q=new Text::Query($sstr,
                  -parse => 'Text::Query::'.                   -parse => 'Text::Query::'.
Line 702  sub Search { Line 752  sub Search {
 ######  ######
          {           {
   
 #         foreach (qw/Question Answer Sources Authors Comments/) {  
           foreach (param('searchin')) {            foreach (param('searchin')) {
 #               if (param($_)) {  #               if (param($_)) {
                         push @fields, "IFNULL($_, '')";                          push @fields, "IFNULL($_, '')";
Line 746  sub makewhere { Line 795  sub makewhere {
       $type .= ($_=$TypeName{$_}) foreach @type;        $type .= ($_=$TypeName{$_}) foreach @type;
       my $where=' 0 ';        my $where=' 0 ';
       foreach (@type) {        foreach (@type) {
              $where.= " OR (Type ='$_') OR (Type ='$_Д') ";               $where.= " OR (Type ='$_') OR (Type ='$_Д') OR (Type ='Д$_') ";
       }         } 
       $where.= "OR (Type='ЧБ')" if ($type=~/Ч|Б/);        $where.= "OR (Type='ЧБ')" if ($type=~/Ч|Б/);
       return $where;        return $where;
Line 858  sub PrintList { Line 907  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;
Line 912  sub PrintSearch { Line 961  sub PrintSearch {
   
   
         $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 974  sub PrintRandom { Line 1025  sub PrintRandom {
    my %q;     my %q;
    my $answer=$razd?0:1;     my $answer=$razd?0:1;
    my @answers;     my @answers;
   #my $t=time;
    my (@Questions) = &Get12Random($dbh, $type, $num);     my (@Questions) = &Get12Random($dbh, $type, $num);
         my ($output, $i) = ('', 0);  
   
           my ($output, $i) = ('', 0);
   #$output.="time=".(time-$t).p;
         if ($text) {          if ($text) {
                 $output .= "    $num случайных вопросов.\n\n";                  $output .= "    $num случайных вопросов.\n\n";
         } else {          } else {
Line 1228  sub PrintTour { Line 1281  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%'});
Line 1284  sub PrintField { Line 1337  sub PrintField {
         if ($text) {          if ($text) {
             $value =~ s/<[\/\w]*?>//sg;              $value =~ s/<[\/\w]*?>//sg;
         } else {          } else {
               if ($header=~/Комментар/)
               {
                   $value=~s/^\s*$_[\.:]/p."\n".strong("$_").":"/me foreach @softfields;
               }
   
             $value =~ s/^\s+/<br>&nbsp;&nbsp;&nbsp;&nbsp;/mg;              $value =~ s/^\s+/<br>&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 
Line 1296  sub PrintField { Line 1354  sub PrintField {
 #           $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: ") . $value . p . "\n";
 }  }
Line 1306  sub PrintField { Line 1367  sub PrintField {
 sub PrintQuestion {  sub PrintQuestion {
         my ($dbh, $Id, $answer, $qnum, $title, $text,$h) = @_;          my ($dbh, $Id, $answer, $qnum, $title, $text,$h) = @_;
         my ($output, $titles) = ('', '');          my ($output, $titles) = ('', '');
           my $fname;
         my (%Question);          my (%Question);
         if ($h) {          if ($h) {
           %Question=%$Id;            %Question=%$Id;
Line 1327  sub PrintQuestion { Line 1389  sub PrintQuestion {
         if (!$text) {          if (!$text) {
                 $output .= hr({width=>"50%"}) if $answer>=0;                  $output .= hr({width=>"50%"}) if $answer>=0;
                 if ($title) {                  if ($title) {
                         my $fname=$Question{'FileName'};                          $fname=$Question{'FileName'};
                         $fname=~s/\.txt//;                          $fname=~s/\.txt//;
                         $titles .=                          $titles .=
                                 dd(img({src=>"/icons/folder.open.gif"}) . " " .                                  dd(img({src=>"/icons/folder.open.gif"}) . " " .
Line 1350  sub PrintQuestion { Line 1412  sub PrintQuestion {
         if ($answer==1|| $answer==-1) {          if ($answer==1|| $answer==-1) {
                 $output .=                  $output .=
                         &PrintField("Ответ", $Question{'Answer'}, $text);                          &PrintField("Ответ", $Question{'Answer'}, $text);
                   if ($Question{'PassCriteria'} ) {
                     $output .=
                           &PrintField("Зачёт", $Question{'PassCriteria'}, $text);
                   }
   
                 if ($Question{'Authors'} ) {                  if ($Question{'Authors'} ) {
                       my $q=$Question{'Authors'};                        my $q=$Question{'Authors'};
Line 1418  EOTT Line 1484  EOTT
                 if ($Question{'Authors'}) {                  if ($Question{'Authors'}) {
                         $output .= &PrintField("Автор(ы)", $Question{'Authors'}, $text);                          $output .= &PrintField("Автор(ы)", $Question{'Authors'}, $text);
                 }                  }
                   if ($Question{'PassCriteria'}) {
                           $output .= &PrintField("Зачёт", $Question{'PassCriteria'}, $text);
                   }
   
                 if ($Question{'Sources'}) {                  if ($Question{'Sources'}) {
                         $output .= &PrintField("Источник(и)", $Question{'Sources'}, $text);                          $output .= &PrintField("Источник(и)", $Question{'Sources'}, $text);
                 }                  }
Line 1432  $output.="</span>" Line 1502  $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");
         my $qid=$paramtour ? ($paramtour.".$Question{'Number'}" ): '';          $fname=$fname.".$Question{'TourNumber'}" if $fname && $Question{'TourNumber'};
   $fname||=param('tour');
           my $qid=$fname ? ($fname.".$Question{'Number'}" ): '';
   
         $output.=br.a({href=> $url."?metod=proxy&          $output.=br.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 1479  sub Get12Random { Line 1554  sub Get12Random {
         srand;          srand;
         my $where=0;          my $where=0;
         my $r=int (rand(10000));          my $r=int (rand(10000));
           my $w1=$r<5000? "QuestionId<50000 ":"QuestionId>=50000";
           $w1=1 if $url=~/zaba/;
           $w1=1 if $type!~/Ч/;
         foreach (split '', $type)          foreach (split '', $type)
         {          {
            $where.= " OR (Type ='$_') OR (Type ='$_Д') ";             $where.= " OR (Type ='$_') OR (Type ='$_Д') ";
Line 1489  sub Get12Random { Line 1566  sub Get12Random {
 #   $q="select QuestionId, QuestionId/$r-floor(QuestionId/$r) as val   #   $q="select QuestionId, QuestionId/$r-floor(QuestionId/$r) as val 
 #       from Questions where $where order by val limit $num";  #       from Questions where $where order by val limit $num";
 # Когда на куличках появится mysql >=3.23 надо заменить на order by rand();  # Когда на куличках появится mysql >=3.23 надо заменить на order by rand();
    $q="select QuestionId from Questions where $where order by rand() limit $num";     $q="select QuestionId from Questions where ($w1) AND ($where) order by rand() limit $num";
   
   
    $sth=$dbh->prepare($q);     $sth=$dbh->prepare($q);
Line 1658  sub PrintQOfAuthor Line 1735  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 1857  sub WriteFile { Line 1934  sub WriteFile {
      {       {
         print OUT "Вопрос $q:\n".$Question{$tour}[$q]{'Question'}."\n\n";          print OUT "Вопрос $q:\n".$Question{$tour}[$q]{'Question'}."\n\n";
         print OUT  "Ответ:\n".$Question{$tour}[$q]{'Answer'}."\n\n";          print OUT  "Ответ:\n".$Question{$tour}[$q]{'Answer'}."\n\n";
           print OUT  "Зачёт:\n".$Question{$tour}[$q]{'PassCriteria'}."\n\n";
         print OUT  "Автор:\n".$Question{$tour}[$q]{'Authors'}."\n\n"           print OUT  "Автор:\n".$Question{$tour}[$q]{'Authors'}."\n\n" 
                if !$tourauthor && !$eqauthor && $Question{$tour}[$q]{'Authors'};                 if !$tourauthor && !$eqauthor && $Question{$tour}[$q]{'Authors'};
         print OUT  "Комментарий:\n".$Question{$tour}[$q]{'Comments'}."\n\n"           print OUT  "Комментарий:\n".$Question{$tour}[$q]{'Comments'}."\n\n" 
Line 1906  MAIN: Line 1984  MAIN:
         $tour = (param('tour')) ? param('tour') : 0;          $tour = (param('tour')) ? param('tour') : 0;
         my $texttour=$tour;          my $texttour=$tour;
         my ($sth,$dbh);          my ($sth,$dbh);
         $dbh = DBI->connect("DBI:mysql:chgk", "piataev", "")          my($dsn) = "DBI:mysql:database=$dbname;host=$dbhost";
           $dbh = DBI->connect($dsn, $dbuser, $dbpass)
   #       $dbh = DBI->connect("DBI:mysql:$dbname", $username, $dbpass)
                 or do {                  or do {
                         print h1("Временные проблемы") . "База вопросов временно не                          print header.h1("Временные проблемы") . "База вопросов временно не
                         работает. Заходите попозже.";                          работает. Заходите попозже.";
                         print &Include_virtual("$reklama") if $url!~/localhost/;                          print &Include_virtual("$reklama") if $url!~/localhost/;
                     print end_html;                      print end_html;
Line 1917  MAIN: Line 1997  MAIN:
   
   
         if (param('qid') && (param('qid')=~/^\d+$/) || $tour && $tour=~/^\d+$/) {          if (param('qid') && (param('qid')=~/^\d+$/) || $tour && $tour=~/^\d+$/) {
            my $destination='http://db.chgk.info/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 1933  MAIN: Line 2013  MAIN:
                 my $d=$destination;                  my $d=$destination;
                 $d=~s/$HTMLDIR/$realHTMLDIR/;                  $d=~s/$HTMLDIR/$realHTMLDIR/;
 #               print header.$destination;  #               print header.$destination;
                 print header."$d|".(-e "$realHTMLDIR$n.html");  #                print header."$d|".(-e "$realHTMLDIR$n.html");
                 if (-e $d) {                  if (-e $d) {
                         Redirect($destination);                          Redirect($destination);
                         exit                          exit
                 }                  }
                 $d=~s/\.\d+//;                  $d=~s/\.\d+//;
                 $destination=~s/\.\d+//;                  $destination=~s/\.\d+//;
 print br.br.$d;  
                 if (-e $d) {                  if (-e $d) {
                         Redirect($destination);                          Redirect($destination);
                         exit                          exit
Line 1973  print br.br.$d; Line 2052  print br.br.$d;
   
         if ($text && !param ('comp')) {          if ($text && !param ('comp')) {
                 print header('text/plain');                  print header('text/plain');
         } elsif (!param('comp')) {print header;}          } elsif (!param('comp')) {
                   print header(-charset =>'koi8-r')}
           my $sstr=param('sstr');            my $sstr=param('sstr');
           $opt_z||=param("makehtml");            $opt_z||=param("makehtml");
           if (param('qid')) {            if (param('qid')) {
Line 2027  print br.br.$d; Line 2107  print br.br.$d;
            my $title="Результаты поиска на \"". ($proxysstr||$sstr) .'"'              my $title="Результаты поиска на \"". ($proxysstr||$sstr) .'"' 
                                                     if ($proxysstr||$sstr);                                                      if ($proxysstr||$sstr);
            $title||="База вопросов";             $title||="База вопросов";
   
            $globaloutput.=start_html(-"title"=>$title,             $globaloutput.=start_html(-"title"=>$title,
                    -author=>'dimrub@icomverse.com',                     -author=>'dimrub@icomverse.com',
                    -bgcolor=>'#fff0e0',                     -bgcolor=>'#fff0e0',
                                   -vlink=>'#800020');                                    -vlink=>'#800020');#}
 $globaloutput.="<style>  $globaloutput.="<style>
 td      {font-size: x-small; font-family : sans-serif}  td      {font-size: x-small; font-family : sans-serif}
 th      {font-size: x-small; font-family : sans-serif}  th      {font-size: x-small; font-family : sans-serif}
Line 2040  th {font-size: x-small; font-family : sa Line 2119  th {font-size: x-small; font-family : sa
                 $globaloutput.=&Include_virtual("$reklama")||'';                  $globaloutput.=&Include_virtual("$reklama")||'';
         }          }
   
        if (!$opt_z && length ($qs)<=255 && $qs !~ /(sstr)|(rand)|(comp)|(all=)/i) {         if ($usehash && !$opt_z && length ($qs)<=255 && $qs !~ /(sstr)|(rand)|(comp)|(all=)/i) {
                 my $sth=$dbh->prepare("SELECT page,times,t from hash where query=".$dbh->quote($qs));                  my $sth=$dbh->prepare("SELECT page,times,t from hash where query=".$dbh->quote($qs));
                 $sth->execute();                  $sth->execute();
                 my ($p,$times,$t)=$sth->fetchrow();                  my ($p,$times,$t)=$sth->fetchrow();
Line 2066  th {font-size: x-small; font-family : sa Line 2145  th {font-size: x-small; font-family : sa
         }          }
   
   
   
         if (param('rand')) {          if (param('rand')) {
                 my ($type, $qnum) = ('', 12);                  my ($type, $qnum) = ('', 12);
                 $type.=$TypeName{$_} foreach param('type');                  $type.=$TypeName{$_} foreach param('type');
Line 2155  EOT Line 2235  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);
Line 2225  my ($sth) = $dbh->prepare("SELECT t1.Id, Line 2305  my ($sth) = $dbh->prepare("SELECT t1.Id,
         }          }
         if (!$opt_z){           if (!$opt_z){ 
           print $globaloutput;            print $globaloutput;
           if (($qs!~ /(rand)|(sstr)|(comp)/i) && (length $qs<=255)) {            if (($qs!~ /(rand)|(sstr)|(comp)/i) && (length $qs<=255) && $usehash) {
                 $globaloutput=  $dbh->quote($globaloutput);                  $globaloutput=  $dbh->quote($globaloutput);
                 $dbh->do("insert into hash (query,page) values (".                  $dbh->do("insert into hash (query,page) values (".
                 $dbh->quote($qs).                  $dbh->quote($qs).
Removed from v.1.127  
changed lines
  Added in v.1.145

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