Diff for /db/prgsrc/db.cgi between versions 1.50 and 1.53

version 1.50, 2001/12/11 12:30:23 version 1.53, 2001/12/21 11:54:37
Line 12  my $printqueries=0; Line 12  my $printqueries=0;
 my %forbidden=();  my %forbidden=();
 my $debug=0; #added by R7  my $debug=0; #added by R7
 if (param('debug')) {$debug=1; $printqueries=1}  if (param('debug')) {$debug=1; $printqueries=1}
   *STDERR=*STDOUT if $debug;
 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 %rusfieldname=('Question','Вопрос', 'Answer', 'Ответ',   my %rusfieldname=('Question','Вопрос', 'Answer', 'Ответ', 
                   'Comments', 'Комментарии', 'Authors', 'Автор',                     'Comments', 'Комментарии', 'Authors', 'Автор', 
Line 29  my $Ll=qr/(?:[A-Z])|(?:${RL})/; Line 30  my $Ll=qr/(?:[A-Z])|(?:${RL})/;
 my $thislocale;  my $thislocale;
   
 $searchin{$_}=1 foreach param('searchin');  $searchin{$_}=1 foreach param('searchin');
 #$searchin{'Question'}=param('Question');  my %TypeName=('children'=>'Д', 'game'=>'И',
 #$searchin{'Answer'}=param('Answer');                'chgk'=>'Ч', 'brain'=>'Б', 'beskrylka'=>'Л','ehruditka'=>'Э');
 #$searchin{'Comments'}=param('Comments');  
 #$searchin{'Authors'}=param('Authors');  
 #$searchin{'Sources'}=param('Sources');  
 my $all=param('all');  my $all=param('all');
 $all=0 if lc $all eq 'no';  $all=0 if lc $all eq 'no';
 my ($PWD) = `pwd`;  my ($PWD) = `pwd`;
Line 105  sub GetTourQuestions { Line 106  sub GetTourQuestions {
         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");
   
         $sth->execute;          $sth->execute;
   
Line 157  sub printform Line 158  sub printform
                          -default=>param('sstr')||'',                           -default=>param('sstr')||'',
                          -size=>30,                           -size=>30,
                          -maxlength=>30);                           -maxlength=>30);
     my $qnumber="Выводить по".br. textfield(-name=>'kvo',
                            -default=>param('kvo')||'150',
                            -size=>3,
                            -maxlength=>5). br."вопросов";
   
   my @df=keys %searchin;    my @df=keys %searchin;
   @df=('Question', 'Answer') unless @df;    @df=('Question', 'Answer') unless @df;
   my $fields=checkbox_group('searchin',['Question','Answer','Comments','Authors','Sources'], [@df],    my $fields=checkbox_group('searchin',['Question','Answer','Comments','Authors','Sources'], [@df],
Line 179  table(Tr Line 185  table(Tr
 (  (
   td({-valign=>'TOP'},$inputstring.$submit.p."Метод: $metod".p."Слова: $all"),    td({-valign=>'TOP'},$inputstring.$submit.p."Метод: $metod".p."Слова: $all"),
   td({-valign=>'TOP'},(' 'x 8).'Поля:'),    td({-valign=>'TOP'},(' 'x 8).'Поля:'),
   td({-valign=>'TOP'},$fields)    td({-valign=>'TOP'},$fields), td(" "x5),
     td({-valign=>'TOP'},$qnumber)
 )   ) 
 )  )
     
Line 558  sub PrintList { Line 565  sub PrintList {
    my ($dbh,$Questions,$shablon)=@_;     my ($dbh,$Questions,$shablon)=@_;
   
         my $first=param('first') ||1;          my $first=param('first') ||1;
         my $kvo=param('kvo') ||30;          my $kvo=param('kvo') ||150;
   
         $first=$first-($first-1)%$kvo;          $first=$first-($first-1)%$kvo;
         my $last=$first+$kvo-1;          my $last=$first+$kvo-1;
Line 568  sub PrintList { Line 575  sub PrintList {
         my $qs=query_string;          my $qs=query_string;
         $qs=~s/\;/\&/g;          $qs=~s/\;/\&/g;
         $qs=~s/\&first\=[^\&]+//g;          $qs=~s/\&first\=[^\&]+//g;
           my $sstr=param('sstr');
           $qs=~s/sstr=[^\&]+/sstr=$sstr/;
         if ($first>$kvo*3+1)          if ($first>$kvo*3+1)
         {          {
            $nav.=             $nav.=
Line 726  sub PrintRandom { Line 733  sub PrintRandom {
         return $output;          return $output;
 }  }
   
   sub PrintEditor {
          my $t=shift; #ссылка на Хэш с полями
          my $ed=$$t{'Editors'};
          my $edname=($ed=~/\,/ ) ? "Редакторы"  : "Редактор" ;
          return h4({align=>"center"},"$edname: $ed" );
   }
   
 sub PrintTournament {  sub PrintTournament {
    my ($dbh, $Id, $answer) = @_;     my ($dbh, $Id, $answer) = @_;
         my (%Tournament, @Tours, $i, $list, $qnum, $imgsrc, $alt,          my (%Tournament, @Tours, $i, $list, $qnum, $imgsrc, $alt,
Line 739  sub PrintTournament { Line 753  sub PrintTournament {
         my ($Copyright) = $Tournament{'Copyright'};          my ($Copyright) = $Tournament{'Copyright'};
   
         @Tours = &GetTours($dbh, $Id);          @Tours = &GetTours($dbh, $Id);
           $list='';
         if ($Id) {          if ($Id) {
                 for ($Tournament{'Type'}) {                  for ($Tournament{'Type'}) {
                         /Г/ && do {                          /Г/ && do {
Line 759  sub PrintTournament { Line 773  sub PrintTournament {
   
                                 $output .= h2({align=>"center"},                                  $output .= h2({align=>"center"},
                                         "$title") . p . "\n";                                          "$title") . p . "\n";
                                  $output.=&PrintEditor(\%Tournament);
                                 last;                                  last;
                         };                          };
                         /Т/ && do {                          /Т/ && do {
Line 825  sub PrintTournament { Line 840  sub PrintTournament {
                 $output .= p("Копирайт: " .   $Copyright);                  $output .= p("Копирайт: " .   $Copyright);
         }          }
   
   
   
         if ($Info) {          if ($Info) {
                 $output .= p($Info);                  $output .= p($Info);
         }          }
   
         return $output;          return $output;
 }  }
   
Line 868  sub PrintTour { Line 884  sub PrintTour {
                       $Tournament{'PlayedAt'},                        $Tournament{'PlayedAt'},
                       "<br>", $Tour{"Title"} .                        "<br>", $Tour{"Title"} .
                 " ($qnum вопрос$suffix)\n") . p;                  " ($qnum вопрос$suffix)\n") . p;
           $output .=&PrintEditor(\%Tour);
   
         my (@Questions) = &GetTourQuestions($dbh, $Id);          my (@Questions) = &GetTourQuestions($dbh, $Id);
         for ($q = 0; $q <= $#Questions; $q++) {          for ($q = 0; $q <= $#Questions; $q++) {
Line 1031  sub Get12Random { Line 1048  sub Get12Random {
         my (%chosen);          my (%chosen);
         srand;          srand;
   
    for ($i = 0; $i < $num; $i++) {          my $where=0;
        do {          my $r=int (rand(10000));
            $q = int(rand($qnum));  
            $sth = $dbh->prepare("SELECT Type FROM Questions          foreach (split '', $type)
                                 WHERE QuestionId=$q");          {
            $sth->execute;             $where.= " OR (Type ='$_') OR (Type ='$_Д') ";
            $t = ($sth->fetchrow)[0];          }
        } until !$chosen{$q} && $t && $type =~ /[$t]/;          $where.= "OR (Type='ЧБ')" if ($type=~/Ч|Б/);
        $sth->finish;  
        $chosen{$q} = 'y';     $q="select QuestionId, QuestionId/$r-floor(QuestionId/$r) as val 
        push @questions, $q;         from Questions where $where order by val limit $num";
   
   # Когда на куличках появится mysql >=3.23 надо заменить на order by rand();
   
      $sth=$dbh->prepare($q);
      $sth->execute;
      while (($i)=$sth->fetchrow)
      {
         push @questions,$i;
    }     }
   
       for ($i=@questions; --$i;){ 
          my $j=rand ($i+1); 
          @questions[$i,$j]=@questions[$j,$i] unless $i==$j;
       }
    return @questions;     return @questions;
 }  }
   
Line 1282  if ((uc 'а') ne 'А') {print "Koi8-r loca Line 1312  if ((uc 'а') ne 'А') {print "Koi8-r loca
   
         if (param('rand')) {          if (param('rand')) {
                 my ($type, $qnum) = ('', 12);                  my ($type, $qnum) = ('', 12);
                 $type .= 'Б' if (param('brain'));                  $type.=$TypeName{$_} foreach param('type');
                 $type .= 'Ч' if (param('chgk'));  #               $type .= 'Б' if (param('brain'));
   #               $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 &&                  my $Email;
                 open(F, "| $SENDMAIL -t -n")) {                  if (($Email=param('email')) && -x $SENDMAIL &&
                         my ($Email) = param('email');                  open(F, "| $SENDMAIL $Email")) {
                         my ($mime_type) = $text ? "plain" : "html";                          my ($mime_type) = $text ? "plain" : "html";
                         print F <<EOT;                          print F <<EOT;
 To: $Email  To: $Email
 From: olegstemanov\@mail.ru  From: olegstepanov\@mail.ru
 Subject: Sluchajnij Paket Voprosov "Chto? Gde? Kogda?"  Subject: Sluchajnij Paket Voprosov "Chto? Gde? Kogda?"
 MIME-Version: 1.0  MIME-Version: 1.0
 Content-type: text/$mime_type; charset="koi8-r"  Content-type: text/$mime_type; charset="koi8-r"
Line 1300  Content-type: text/$mime_type; charset=" Line 1331  Content-type: text/$mime_type; charset="
 EOT  EOT
                         print F &PrintRandom($dbh, $type, $qnum, $text);                          print F &PrintRandom($dbh, $type, $qnum, $text);
                         close F;                          close F;
                         print "Пакет случайно выбранных вопросов послан. Нажмите                          print "Пакет случайно выбранных вопросов послан по адресу $Email. Нажмите
                         на <B>Reload</B> для получения еще одного пакета";                          на <B>Reload</B> для получения еще одного пакета";
                 } else {                  } else {
                         print &PrintRandom($dbh, $type, $qnum, $text);                          print &PrintRandom($dbh, $type, $qnum, $text);

Removed from v.1.50  
changed lines
  Added in v.1.53


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