Diff for /db/prgsrc/db.cgi between versions 1.134 and 1.136

version 1.134, 2004/05/02 20:48:30 version 1.136, 2004/09/05 14:57:05
Line 3 Line 3
 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;  my $proxyredirect=1;
 use POSIX qw(locale_h);  use POSIX qw(locale_h);
Line 48  if ($^O =~ /win/i) { Line 49  if ($^O =~ /win/i) {
   
 my $usehtml=$opt_z||0;  my $usehtml=$opt_z||0;
 $usehtml=1;  $usehtml=1;
 $usehtml=0 if $url=~/zaba/;  $usehtml=0 if $url=~/zaba/ || $url=~/localhost/;
   
 my $usewas=0;  my $usewas=0;
 my $cashednumber=500;  my $cashednumber=500;
Line 92  POSIX::setlocale( &POSIX::LC_ALL, $thisl Line 93  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 206  sub GetTournament { Line 207  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 233  sub SelectQuestions { Line 234  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 357  sub printform Line 358  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 387  action="/znatoki/cgi-bin/db.cgi"> Line 388  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 405  action="/znatoki/cgi-bin/db.cgi"> Line 406  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 421  action="/znatoki/cgi-bin/db.cgi"> Line 422  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 709  sub Search { Line 712  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 733  sub Search { Line 736  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 1317  sub PrintField { Line 1319  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 1329  sub PrintField { Line 1336  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 1384  sub PrintQuestion { Line 1394  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 1452  EOTT Line 1466  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 1696  sub PrintQOfAuthor Line 1714  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 1895  sub WriteFile { Line 1913  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" 

Removed from v.1.134  
changed lines
  Added in v.1.136


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