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

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

version 1.36, 2001/11/25 23:40:27 version 1.37, 2001/11/26 10:31:49
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=1;  my $printqueries=0;
 my %forbidden=();  my %forbidden=();
 my $debug=1; #added by R7  my $debug=0; #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 33  my ($ZIP) = "/home/piataev/bin/zip"; Line 33  my ($ZIP) = "/home/piataev/bin/zip";
 my $DUMPFILE = "/tmp/chgkdump";  my $DUMPFILE = "/tmp/chgkdump";
 my ($SENDMAIL) = "/usr/sbin/sendmail";  my ($SENDMAIL) = "/usr/sbin/sendmail";
 my ($TMSECS) = 30*24*60*60;  my ($TMSECS) = 30*24*60*60;
 my (%RevMonths) =   my (%RevMonths) =
         ('Jan', '0', 'Feb', '1', 'Mar', '2', 'Apr', '3', 'May', '4', 'Jun', '5',          ('Jan', '0', 'Feb', '1', 'Mar', '2', 'Apr', '3', 'May', '4', 'Jun', '5',
         'Jul', '6', 'Aug', '7', 'Sep', '8', 'Oct', '9', 'Nov', '10',          'Jul', '6', 'Aug', '7', 'Sep', '8', 'Oct', '9', 'Nov', '10',
         'Dec', '11',          'Dec', '11',
          'Янв', '0', 'Фев', 1, 'Мар', 2, 'Апр', 3, 'Май', '4',           'Янв', '0', 'Фев', 1, 'Мар', 2, 'Апр', 3, 'Май', '4',
          'Июн', '5', 'Июл', 6, 'Авг', '7', 'Сен', '8',            'Июн', '5', 'Июл', 6, 'Авг', '7', 'Сен', '8',
          'Окт', '9', 'Ноя', '19', 'Дек', '11');           'Окт', '9', 'Ноя', '19', 'Дек', '11');
   
 # Determine whether the given time is within 2 months from now.  # Determine whether the given time is within 2 months from now.
Line 93  sub GetTourQuestions { Line 93  sub GetTourQuestions {
         my ($dbh, $ParentId) = @_;          my ($dbh, $ParentId) = @_;
         my (@arr, @Questions);          my (@arr, @Questions);
   
         my ($sth) = $dbh->prepare("SELECT QuestionId FROM Questions           my ($sth) = $dbh->prepare("SELECT QuestionId FROM Questions
                 WHERE ParentId=$ParentId ORDER BY QuestionId");                  WHERE ParentId=$ParentId ORDER BY QuestionId");
   
         $sth->execute;          $sth->execute;
Line 146  $sstr=~tr/йцукенгшщзхъфывапролджэячсмить Line 146  $sstr=~tr/йцукенгшщзхъфывапролджэячсмить
             foreach $i (0..$#w) # заполняем массив @nf начальных форм              foreach $i (0..$#w) # заполняем массив @nf начальных форм
                            # $nf[$i] -- ссылка на массив возможных                             # $nf[$i] -- ссылка на массив возможных
                            # начальных форм словоформы $i                             # начальных форм словоформы $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";
Line 344  sub Search { Line 344  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;
            my $q=new Text::Query($sstr,             my $q=new Text::Query($sstr,
                  -parse => 'Text::Query::'.                    -parse => 'Text::Query::'.
                    (($metod eq 'simple') ? 'ParseSimple':'ParseAdvanced'),                     (($metod eq 'simple') ? 'ParseSimple':'ParseAdvanced'),
                  -solve => 'Text::Query::SolveSQL',                   -solve => 'Text::Query::SolveSQL',
                  -build => 'Text::Query::BuildSQLMySQL',                   -build => 'Text::Query::BuildSQLMySQL',
Line 368  sub Search { Line 368  sub Search {
   
            $sth = $dbh->prepare($query);             $sth = $dbh->prepare($query);
          } else           } else
 ######     ######
          {           {
   
           foreach (qw/Question Answer Sources Authors Comments/) {            foreach (qw/Question Answer Sources Authors Comments/) {
Line 387  sub Search { Line 387  sub Search {
           } else {            } else {
                 $sstr = join " OR $f LIKE ", @sar;                  $sstr = join " OR $f LIKE ", @sar;
           }            }
             
    my $query;     my $query;
                $query="SELECT QuestionId FROM Questions                 $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 402  print $query if $printqueries; Line 402  print $query if $printqueries;
         while (@arr = $sth->fetchrow) {          while (@arr = $sth->fetchrow) {
                 push @Questions, $arr[0] unless $forbidden{$arr[0]};                  push @Questions, $arr[0] unless $forbidden{$arr[0]};
         }          }
           
         return @Questions;          return @Questions;
 }  }
   
  # Substitute every letter by a pair (for case insensitive search).   # Substitute every letter by a pair (for case insensitive search).
  my (@letters) = qw/аА бБ вВ гГ дД еЕ жЖ зЗ иИ йЙ кК лЛ мМ нН оО    my (@letters) = qw/аА бБ вВ гГ дД еЕ жЖ зЗ иИ йЙ кК лЛ мМ нН оО
  пП рР сС тТ уУ фФ хХ цЦ чЧ шШ щЩ ьЬ ыЫ эЭ юЮ яЯ/;   пП рР сС тТ уУ фФ хХ цЦ чЧ шШ щЩ ьЬ ыЫ эЭ юЮ яЯ/;
    
 sub NoCase {  sub NoCase {
         my ($sstr) = shift;          my ($sstr) = shift;
         my ($res);          my ($res);
Line 443  print "$query" if $printqueries; Line 443  print "$query" if $printqueries;
            {             {
              push @shablon,"(?:$arr[0])";               push @shablon,"(?:$arr[0])";
            }             }
            $shablon= join "|", @shablon;              $shablon= join "|", @shablon;
            $shablon=~s/[её]/\[ЕЁ\]/gi;             $shablon=~s/[её]/\[ЕЁ\]/gi;
 #           $shablon=~s/([йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ])/&NoCase($1)/ge;  #           $shablon=~s/([йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ])/&NoCase($1)/ge;
            $shablon=qr/$shablon/i;             $shablon=qr/$shablon/i;
Line 457  print "$query" if $printqueries; Line 457  print "$query" if $printqueries;
         } elsif ($hits =~ /1$/) {          } elsif ($hits =~ /1$/) {
                 $suffix = 'е';                  $suffix = 'е';
         } else {          } else {
                 $suffix = 'я';                   $suffix = 'я';
         }          }
           
         print p({align=>"center"}, "Результаты поиска на " . strong($sstr)          print p({align=>"center"}, "Результаты поиска на " . strong($sstr)
         . " : $hits попадани$suffix.");          . " : $hits попадани$suffix.");
   
Line 473  print "$query" if $printqueries; Line 473  print "$query" if $printqueries;
         for ($i = 0; $i <= $#Questions; $i++) {          for ($i = 0; $i <= $#Questions; $i++) {
                 $output = &PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 1);                  $output = &PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 1);
                 if (param('metod') eq 'rus')                  if (param('metod') eq 'rus')
                 {                   {
                      $output=~s/\b($shablon)\b/\<strong\>$1\<\/strong\>/gi;                       $output=~s/\b($shablon)\b/\<strong\>$1\<\/strong\>/gi;
                 } else {                  } else {
                 foreach  (@sar) {                  foreach  (@sar) {
Line 498  sub PrintRandom { Line 498  sub PrintRandom {
         for ($i = 0; $i <= $#Questions; $i++) {          for ($i = 0; $i <= $#Questions; $i++) {
                 # Passing DB handler, question ID, print answer, question                  # Passing DB handler, question ID, print answer, question
                 # number, print title, print text/html                  # number, print title, print text/html
                 $output .=                   $output .=
                         &PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 0, $text);                          &PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 0, $text);
         }          }
         return $output;           return $output;
 }  }
   
 sub PrintTournament {  sub PrintTournament {
Line 511  sub PrintTournament { Line 511  sub PrintTournament {
         my ($output) = '';          my ($output) = '';
   
         %Tournament = &GetTournament($dbh, $Id) if ($Id);          %Tournament = &GetTournament($dbh, $Id) if ($Id);
           
         my ($URL) = $Tournament{'URL'};          my ($URL) = $Tournament{'URL'};
         my ($Info) = $Tournament{'Info'};          my ($Info) = $Tournament{'Info'};
         my ($Copyright) = $Tournament{'Copyright'};          my ($Copyright) = $Tournament{'Copyright'};
Line 521  sub PrintTournament { Line 521  sub PrintTournament {
         if ($Id) {          if ($Id) {
                 for ($Tournament{'Type'}) {                  for ($Tournament{'Type'}) {
                         /Г/ && do {                          /Г/ && do {
                                 $output .= h2({align=>"center"},                                   $output .= h2({align=>"center"},
                                               "Группа: $Tournament{'Title'} ",                                                "Группа: $Tournament{'Title'} ",
                                               "$Tournament{'PlayedAt'}") . p . "\n";                                                "$Tournament{'PlayedAt'}") . p . "\n";
                                 last;                                  last;
Line 529  sub PrintTournament { Line 529  sub PrintTournament {
                         /Ч/ && do {                          /Ч/ && do {
                                 return &PrintTour($dbh, $Tours[0], $answer)                                  return &PrintTour($dbh, $Tours[0], $answer)
                                         if ($#Tours == 0);                                          if ($#Tours == 0);
                                   
                                 my $title="Пакет: $Tournament{'Title'}";                                  my $title="Пакет: $Tournament{'Title'}";
                                 if ($Tournament{'PlayedAt'}) {                                  if ($Tournament{'PlayedAt'}) {
                                     $title .= " $Tournament{'PlayedAt'}";                                      $title .= " $Tournament{'PlayedAt'}";
                                 }                                  }
   
                                 $output .= h2({align=>"center"},                                   $output .= h2({align=>"center"},
                                         "$title") . p . "\n";                                          "$title") . p . "\n";
                                 last;                                  last;
                         };                          };
Line 548  sub PrintTournament { Line 548  sub PrintTournament {
                 $output .= h2("Банк Вопросов: $qnum вопросов") . p . "\n";                  $output .= h2("Банк Вопросов: $qnum вопросов") . p . "\n";
         }          }
   
         for ($i = 0; $i <= $#Tours; $i++) {           for ($i = 0; $i <= $#Tours; $i++) {
                 %Tournament = &GetTournament($dbh, $Tours[$i]);                  %Tournament = &GetTournament($dbh, $Tours[$i]);
                   
                 if ($Tournament{'Type'} =~ /Ч/) {                  if ($Tournament{'Type'} =~ /Ч/) {
                         $SingleTour = 0;                          $SingleTour = 0;
                         my (@Tours) = &GetTours($dbh, $Tournament{'Id'});                          my (@Tours) = &GetTours($dbh, $Tournament{'Id'});
Line 574  sub PrintTournament { Line 574  sub PrintTournament {
                 if ($SingleTour or $Tournament{'Type'} =~ /Т/) {                  if ($SingleTour or $Tournament{'Type'} =~ /Т/) {
                         $list .= dd(img({src=>$imgsrc, alt=>$alt})                          $list .= dd(img({src=>$imgsrc, alt=>$alt})
                                 . " " . $Tournament{'Title'} . " " .                                  . " " . $Tournament{'Title'} . " " .
                                     $Tournament{'PlayedAt'} . $qnum) .                                       $Tournament{'PlayedAt'} . $qnum) .
                                 dl(                                  dl(
                                         dd("["                                          dd("["
                                                 . a({href=>url .  "?tour=$Tournament{'Id'}&answer=0"},                                                  . a({href=>url .  "?tour=$Tournament{'Id'}&answer=0"},
Line 583  sub PrintTournament { Line 583  sub PrintTournament {
                   "вопросы + ответы") . "]")                    "вопросы + ответы") . "]")
                                 );                                  );
                 } else {                  } else {
                         $list .= dd(a({href=>url . "?tour=$Tournament{'Id'}&comp=1"},                           $list .= dd(a({href=>url . "?tour=$Tournament{'Id'}&comp=1"},
                                 img({src=>'/icons/compressed.gif', alt=>'[ZIP]', border=>1}))                                  img({src=>'/icons/compressed.gif', alt=>'[ZIP]', border=>1}))
                                 . " " . img({src=>$imgsrc, alt=>$alt})                                   . " " . img({src=>$imgsrc, alt=>$alt})
                                 . " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},                                   . " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},
                                 $Tournament{'Title'}. " ".                                   $Tournament{'Title'}. " ".
                                           $Tournament{'PlayedAt'}) . $qnum);                                            $Tournament{'PlayedAt'}) . $qnum);
                 }                  }
         }          }
Line 595  sub PrintTournament { Line 595  sub PrintTournament {
   
         if ($URL) {          if ($URL) {
                 $output .=                  $output .=
                 p("Дополнительная информация об этом турнире - по адресу " .                   p("Дополнительная информация об этом турнире - по адресу " .
                         a({-'href'=>$URL}, $URL));                          a({-'href'=>$URL}, $URL));
         }          }
   
Line 606  sub PrintTournament { Line 606  sub PrintTournament {
         if ($Info) {          if ($Info) {
                 $output .= p($Info);                  $output .= p($Info);
         }          }
           
         return $output;          return $output;
 }  }
   
Line 620  sub Suffix { Line 620  sub Suffix {
   
 sub IsTour {  sub IsTour {
         my ($dbh, $Id) = @_;          my ($dbh, $Id) = @_;
         my ($sth) = $dbh->prepare("SELECT Type FROM Tournaments           my ($sth) = $dbh->prepare("SELECT Type FROM Tournaments
                 WHERE Id=$Id");                  WHERE Id=$Id");
         $sth->execute;          $sth->execute;
         return ($sth->fetchrow)[0] =~ /Т/;          return ($sth->fetchrow)[0] =~ /Т/;
Line 640  sub PrintTour { Line 640  sub PrintTour {
                 if ($Tour{'Type'} !~ /Т/);                  if ($Tour{'Type'} !~ /Т/);
   
         my ($qnum) = $Tour{'QuestionsNum'};          my ($qnum) = $Tour{'QuestionsNum'};
         my ($suffix) = &Suffix($qnum);           my ($suffix) = &Suffix($qnum);
           
         $output .= h2({align=>"center"}, $Tournament{"Title"},           $output .= h2({align=>"center"}, $Tournament{"Title"},
                       $Tournament{'PlayedAt'},                        $Tournament{'PlayedAt'},
                       "<br>", $Tour{"Title"} .                         "<br>", $Tour{"Title"} .
                 " ($qnum вопрос$suffix)\n") . p;                  " ($qnum вопрос$suffix)\n") . p;
   
         my (@Questions) = &GetTourQuestions($dbh, $Id);          my (@Questions) = &GetTourQuestions($dbh, $Id);
         for ($q = 0; $q <= $#Questions; $q++) {          for ($q = 0; $q <= $#Questions; $q++) {
                 $output .= &PrintQuestion($dbh, $Questions[$q], $answer, 0);                  $output .= &PrintQuestion($dbh, $Questions[$q], $answer, 0);
         }           }
   
         $output .= hr({-'align'=>'center', -'width'=>'80%'});          $output .= hr({-'align'=>'center', -'width'=>'80%'});
   
         if ($Tournament{'URL'}) {          if ($Tournament{'URL'}) {
                 $output .=                  $output .=
                 p("Дополнительная информация об этом турнире - по адресу " .                   p("Дополнительная информация об этом турнире - по адресу " .
                         a({-'href'=>$Tournament{'URL'}}, $Tournament{'URL'}));                          a({-'href'=>$Tournament{'URL'}}, $Tournament{'URL'}));
         }          }
   
Line 667  sub PrintTour { Line 667  sub PrintTour {
         if ($Tournament{'Info'}) {          if ($Tournament{'Info'}) {
                 $output .= p($Tournament{'Info'});                  $output .= p($Tournament{'Info'});
         }          }
           
   
         if ($answer == 0) {          if ($answer == 0) {
                 $bottom .=                   $bottom .=
                         "[" . a({href=>url . "?tour=$Id&answer=1"}, "ответы") .  "] " . br;                          "[" . a({href=>url . "?tour=$Id&answer=1"}, "ответы") .  "] " . br;
         }          }
         if (&IsTour($dbh, $Id - 1)) {          if (&IsTour($dbh, $Id - 1)) {
                 $bottom .=                   $bottom .=
                         "[" . a({href=>url . "?tour=" . ($Id - 1) . "&answer=0"},                           "[" . a({href=>url . "?tour=" . ($Id - 1) . "&answer=0"},
                         "предыдущий тур") . "] ";                          "предыдущий тур") . "] ";
                 $bottom .=                   $bottom .=
                         "[" . a({href=>url . "?tour=" . ($Id - 1) . "&answer=1"},                           "[" . a({href=>url . "?tour=" . ($Id - 1) . "&answer=1"},
                         "предыдущий тур с ответами") . "] " . br;                          "предыдущий тур с ответами") . "] " . br;
         }          }
         if (&IsTour($dbh, $Id + 1)) {          if (&IsTour($dbh, $Id + 1)) {
                 $bottom .=                   $bottom .=
                         "[" . a({href=>url . "?tour=" . ($Id + 1) . "&answer=0"},                           "[" . a({href=>url . "?tour=" . ($Id + 1) . "&answer=0"},
                         "следующий тур") . "] ";                          "следующий тур") . "] ";
                 $bottom .=                   $bottom .=
                         "[" . a({href=>url . "?tour=" . ($Id + 1) . "&answer=1"},                           "[" . a({href=>url . "?tour=" . ($Id + 1) . "&answer=1"},
                         "следующий тур с ответами") . "] ";                          "следующий тур с ответами") . "] ";
         }          }
   
Line 705  sub PrintField { Line 705  sub PrintField {
             $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";
 }  }
   
 # Gets a DB handler (ofcourse) and a question Id. Prints   # Gets a DB handler (ofcourse) and a question Id. Prints
 # that question, according to the options.  # that question, according to the options.
 sub PrintQuestion {  sub PrintQuestion {
         my ($dbh, $Id, $answer, $qnum, $title, $text) = @_;          my ($dbh, $Id, $answer, $qnum, $title, $text) = @_;
Line 730  sub PrintQuestion { Line 730  sub PrintQuestion {
                 }                  }
                 $output .= dl(strong($titles));                  $output .= dl(strong($titles));
         }          }
           
         $qnum = $Question{'Number'}          $qnum = $Question{'Number'}
                 if ($qnum == 0);                  if ($qnum == 0);
   
         $output .=           $output .=
                 &PrintField("Вопрос $qnum", $Question{'Question'}, $text);                  &PrintField("Вопрос $qnum", $Question{'Question'}, $text);
   
         if ($answer) {          if ($answer) {
                 $output .=                   $output .=
                         &PrintField("Ответ", $Question{'Answer'}, $text);                          &PrintField("Ответ", $Question{'Answer'}, $text);
   
                 if ($Question{'Authors'}) {                  if ($Question{'Authors'}) {
Line 755  sub PrintQuestion { Line 755  sub PrintQuestion {
 #                       $other.=a({href=>url."?qofauthor=$AuthorId"},"$Name $Surname").". ";  #                       $other.=a({href=>url."?qofauthor=$AuthorId"},"$Name $Surname").". ";
                          $Name=~s/\./\\\./g;                           $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/^\|//;                            if ($Nicks)
                           foreach (split /\|/, $Nicks)  
                           {                            {
                               $Nicks=~s/^\|//;
                               foreach (split /\|/, $Nicks)
                               {
                               s/\s+/ /g;                                s/\s+/ /g;
                               s/\s+$//;                                s/\s+$//;
                               s/ /\\s+/g;                                s/ /\\s+/g;
                               s/\./\\\./g;                                s/\./\\\./g;
                               if (s/>$//) {$sha="$sha|(?:$_)"}                                if (s/>$//) {$sha="$sha|(?:$_)"}
                               else        {$sha="(?:$_)|$sha"}                                else        {$sha="(?:$_)|$sha"}
                               }
                           }                            }
                           $q=~s/($sha)/a({href=>url."?qofauthor=$AuthorId"},$1)/ei;                            $q=~s/($sha)/a({href=>url."?qofauthor=$AuthorId"},$1)/ei;
                       }                        }
Line 805  sub Get12Random { Line 808  sub Get12Random {
         my ($qnum) = &GetMaxQId($dbh);          my ($qnum) = &GetMaxQId($dbh);
         my (%chosen);          my (%chosen);
         srand;          srand;
           
    for ($i = 0; $i < $num; $i++) {     for ($i = 0; $i < $num; $i++) {
        do {         do {
            $q = int(rand($qnum));             $q = int(rand($qnum));
Line 825  sub Include_virtual { Line 828  sub Include_virtual {
   
         open F , $fn          open F , $fn
                 or return; #die "Can't open the file $fn: $!\n";                  or return; #die "Can't open the file $fn: $!\n";
           
         while (<F>) {          while (<F>) {
                 if (/<!--#include/o) {                  if (/<!--#include/o) {
                         s/<!--#include virtual="\/(.*)" -->/&Include_virtual($1)/e;                          s/<!--#include virtual="\/(.*)" -->/&Include_virtual($1)/e;
Line 844  sub PrintArchive { Line 847  sub PrintArchive {
   
         my (%Tournament) = &GetTournament($dbh, $Id);          my (%Tournament) = &GetTournament($dbh, $Id);
         my (@Tours) = &GetTours($dbh, $Id);          my (@Tours) = &GetTours($dbh, $Id);
           
         if ($Tournament{'Type'} =~ /Г/ || $Id == 0) {          if ($Tournament{'Type'} =~ /Г/ || $Id == 0) {
                 for ($i = 0; $i <= $#Tours; $i++) {                  for ($i = 0; $i <= $#Tours; $i++) {
                         push(@list ,&PrintArchive($dbh, $Tours[$i]));                          push(@list ,&PrintArchive($dbh, $Tours[$i]));
Line 860  sub PrintAll { Line 863  sub PrintAll {
   
         my (%Tournament) = &GetTournament($dbh, $Id);          my (%Tournament) = &GetTournament($dbh, $Id);
         my (@Tours) = &GetTours($dbh, $Id);          my (@Tours) = &GetTours($dbh, $Id);
         my ($New) = ($Id and $Tournament{'Type'} eq 'Ч' and           my ($New) = ($Id and $Tournament{'Type'} eq 'Ч' and
                 &NewEnough($Tournament{"CreatedAt"})) ?                  &NewEnough($Tournament{"CreatedAt"})) ?
                 img({src=>"/znatoki/dimrub/db/new-sml.gif", alt=>"NEW!"}) : "";                  img({src=>"/znatoki/dimrub/db/new-sml.gif", alt=>"NEW!"}) : "";
   
Line 882  sub PrintAll { Line 885  sub PrintAll {
   
 sub PrintDates {  sub PrintDates {
         my ($dbh) = @_;          my ($dbh) = @_;
         my ($from) = param('from_year') . "-" . param('from_month') .           my ($from) = param('from_year') . "-" . param('from_month') .
                 "-" .  param('from_day');                  "-" .  param('from_day');
         my ($to) = param('to_year') . "-" . param('to_month') . "-" .  param('to_day');          my ($to) = param('to_year') . "-" . param('to_month') . "-" .  param('to_day');
         $from = $dbh->quote($from);          $from = $dbh->quote($from);
Line 913  sub PrintQOfAuthor Line 916  sub PrintQOfAuthor
 {  {
     my ($dbh, $id) = @_;      my ($dbh, $id) = @_;
    $id=$dbh->quote($id);     $id=$dbh->quote($id);
     my $sth =  $dbh->prepare("SELECT  Name, Surname FROM Authors WHERE Id=$id");          my $sth =  $dbh->prepare("SELECT  Name, Surname FROM Authors WHERE Id=$id");
     $sth->execute;      $sth->execute;
     my ($name,$surname)=$sth->fetchrow;      my ($name,$surname)=$sth->fetchrow;
   
     $sth =  $dbh->prepare("SELECT Question FROM A2Q WHERE Author=$id");          $sth =  $dbh->prepare("SELECT Question FROM A2Q WHERE Author=$id");
     $sth->execute;      $sth->execute;
     my $q;      my $q;
     my @Questions;            my @Questions;
     while (($q)=$sth->fetchrow,$q)      while (($q)=$sth->fetchrow,$q)
      {push @Questions,$q unless $forbidden{$q}}       {push @Questions,$q unless $forbidden{$q}}
   
Line 931  sub PrintQOfAuthor Line 934  sub PrintQOfAuthor
         } elsif ($hits =~ /1$/) {          } elsif ($hits =~ /1$/) {
                 $suffix = 'е';                  $suffix = 'е';
         } else {          } else {
                 $suffix = 'я';                   $suffix = 'я';
         }          }
           
         print p({align=>"center"}, "Автор ".strong("$name $surname. ")           print p({align=>"center"}, "Автор ".strong("$name $surname. ")
         . " : $hits попадани$suffix.");          . " : $hits попадани$suffix.");
   
   
Line 949  sub PrintAuthors Line 952  sub PrintAuthors
 {  {
      my ($dbh,$sort)=@_;       my ($dbh,$sort)=@_;
      my($output,$out1,@array,$sth);       my($output,$out1,@array,$sth);
      if ($sort eq 'surname')        if ($sort eq 'surname')
      {       {
         $sth =           $sth =
              $dbh->prepare("SELECT Id, Name, Surname, QNumber FROM Authors order by Surname");               $dbh->prepare("SELECT Id, Name, Surname, QNumber FROM Authors order by Surname, Name");
                }
         $output.="<TABLE><CAPTION>Алфавитный список авторов</CAPTION>";       elsif($sort eq 'name')
        {
           $sth =
                $dbh->prepare("SELECT Id, Name, Surname, QNumber FROM Authors order by Name, Surname");
      }       }
      else       else
      {       {
         $sth =           $sth =
              $dbh->prepare("SELECT Id, Name, Surname, QNumber FROM Authors Order by QNumber DESC");                     $dbh->prepare("SELECT Id, Name, Surname, QNumber FROM Authors Order by QNumber DESC, Surname");
         $output.="<TABLE>";  
      }       }
   
        $output.=h2("Авторы вопросов")."\n";
        $output.="<TABLE>";
   
   
      $sth->execute;       $sth->execute;
      $output.=Tr(th["Фамилия, имя", "Количество вопросов"]);       $output.=Tr(th[a({href=>url."?authors=name"},"Имя")
   .", ".
   a({href=>url."?authors=surname"},"фамилия")
        , a({href=>url."?authors=kvo"},"Количество вопросов")]);
   
      $out1='';       $out1='';
   
      my $ar=$sth->fetchall_arrayref;       my $ar=$sth->fetchall_arrayref;
   
   
 =head  
      foreach my $arr(@$ar)  
      {  
         $sth =   
              $dbh->prepare("SELECT count(*) FROM A2Q where Author=".$$arr[0]);        
         $sth->execute;  
   
         my ($kvo)=$sth->fetchrow;  
   
   
   
         push @$arr, $kvo;  
      }  
   
 =cut  
     
   
 #     sort { }@{$ar}  
       
     foreach my $arr(@$ar)      foreach my $arr(@$ar)
      {       {
             
            my ($id,$name,$surname,$kvo)=@$arr;             my ($id,$name,$surname,$kvo)=@$arr;
            if (!$name || !$surname) {print "Opanki at $id\n"} else             if (!$name || !$surname) {#print "Opanki at $id\n"
                 } else
            {             {
             print  "!";               my $add=Tr(td([a({href=>url."?qofauthor=$id"},"$name $surname"), $kvo]))."\n";
   
              my $add=Tr(td([a({href=>"/cgi-bin/db.cgi?qofauthor=$id"},'[Q] ')."$name $surname", $kvo]))."\n";  
              print STDERR $add;               print STDERR $add;
              $output.=$add;               $output.=$add;
            }             }
Line 1008  sub PrintAuthors Line 1001  sub PrintAuthors
 }  }
   
   
      
 MAIN:  MAIN:
 {  {
         setlocale(LC_CTYPE,'russian');          setlocale(LC_CTYPE,'russian');
Line 1046  if ((uc 'а') ne 'А') {print "Koi8-r loca Line 1039  if ((uc 'а') ne 'А') {print "Koi8-r loca
                 print header('text/plain');                  print header('text/plain');
         }          }
   
         if (param('showequal')) {          if (param('hideequal')) {
                    my ($sth)=  $dbh -> prepare("select first, second FROM equalto");                     my ($sth)=  $dbh -> prepare("select first, second FROM equalto");
                    $sth -> execute;                     $sth -> execute;
                    while ( my  ($first, $second)=$sth -> fetchrow)                     while ( my  ($first, $second)=$sth -> fetchrow)
Line 1054  if ((uc 'а') ne 'А') {print "Koi8-r loca Line 1047  if ((uc 'а') ne 'А') {print "Koi8-r loca
                        $forbidden{$first}=1;                         $forbidden{$first}=1;
                   }                    }
                   $sth->finish;                    $sth->finish;
         }                       }
   
   
         if (param('rand')) {          if (param('rand')) {
                 my ($type, $qnum) = ('', 12);                  my ($type, $qnum) = ('', 12);
                 $type .= 'Б' if (param('brain'));                  $type .= 'Б' if (param('brain'));
                 $type .= 'Ч' if (param('chgk'));                  $type .= 'Ч' if (param('chgk'));
                 $qnum = param('qnum') if (param('qnum') =~ /^\d+$/);                      $qnum = param('qnum') if (param('qnum') =~ /^\d+$/);
                 $qnum = 0 if (!$type);                  $qnum = 0 if (!$type);
                 if (param('email') && -x $SENDMAIL &&                   if (param('email') && -x $SENDMAIL &&
                 open(F, "| $SENDMAIL -t -n")) {                  open(F, "| $SENDMAIL -t -n")) {
                         my ($Email) = param('email');                          my ($Email) = param('email');
                         my ($mime_type) = $text ? "plain" : "html";                          my ($mime_type) = $text ? "plain" : "html";
Line 1082  EOT Line 1075  EOT
                 } else {                  } else {
                         print &PrintRandom($dbh, $type, $qnum, $text);                          print &PrintRandom($dbh, $type, $qnum, $text);
                 }                  }
         }           }
           elsif (param('authors')){            elsif (param('authors')){
                 print &PrintAuthors($dbh,param('authors'));                  print &PrintAuthors($dbh,param('authors'));
         }          }
Line 1094  EOT Line 1087  EOT
         } elsif (param('all')) {          } elsif (param('all')) {
                 print &PrintAll($dbh, 0);                  print &PrintAll($dbh, 0);
         } elsif (param('from_year') && param('to_year')) {          } elsif (param('from_year') && param('to_year')) {
                 print &PrintDates($dbh);                          print &PrintDates($dbh);
         } elsif (param('comp')) {          } elsif (param('comp')) {
             print header(              print header(
                          -'Content-Type' => 'application/x-zip-compressed; name="db.zip"',                           -'Content-Type' => 'application/x-zip-compressed; name="db.zip"',
Removed from v.1.36  
changed lines
  Added in v.1.37

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