Diff for /db/prgsrc/db.cgi between versions 1.2 and 1.21

version 1.2, 2000/10/15 22:22:26 version 1.21, 2001/05/18 20:16:33
Line 2 Line 2
   
 use DBI;  use DBI;
 use CGI ':all';  use CGI ':all';
   use Text::Query;
 use strict;  use strict;
 use Time::Local;  use Time::Local;
 use POSIX qw(locale_h);  use POSIX qw(locale_h);
   my $debug=1; #added by R7
   open STDERR, ">/tmp/errors" if $debug;
 my ($PWD) = `pwd`;  my ($PWD) = `pwd`;
 chomp $PWD;  chomp $PWD;
 my ($SRCPATH) = "/home/stepanov/baza";  my ($SRCPATH) = "$PWD/../dimrub/src";
 my ($ZIP) = "/usr/bin/zip";  my ($ZIP) = "/home/piataev/bin/zip";
   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',
            'éÀÎ', '5', 'éÀÌ', 6, 'á×Ç', '7', 'óÅÎ', '8', 
            'ïËÔ', '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.
 sub NewEnough {  sub NewEnough {
Line 101  sub GetTours { Line 107  sub GetTours {
   
 # Returns list of QuestionId's, that have the search string in them.  # Returns list of QuestionId's, that have the search string in them.
 sub Search {  sub Search {
         my ($dbh, $sstr) = @_;          my ($dbh, $sstr, $metod) = @_;
         my (@arr, @Questions, @fields);          my (@arr, @Questions, @fields);
         my (@sar, $i, $sth);          my (@sar, $i, $sth,$where);
           my $btime=time; 
   
   #       push @fields, 'Question';
   
         push @fields, 'Question';  ###Simple and advanced query processing. Added by R7
         foreach (qw/Answer Sources Authors Comments/) {          if ($metod eq 'simple' || $metod eq 'advanced') 
           {
           foreach (qw/Question Answer Sources Authors Comments/) {
                 if (param($_)) {                  if (param($_)) {
                         push @fields, "IFNULL($_, '')";                          push @fields, $_; 
                 }                  }
         }          }
   
         @sar = split " ", $sstr;             @fields=(qw/Question Answer Sources Authors Comments/) unless scalar @fields;
         for $i (0 .. $#sar) {             my $fields=join ",", @fields;
              my $q=new Text::Query($sstr,
                    -parse => 'Text::Query::'. 
                      (($metod eq 'simple') ? 'ParseSimple':'ParseAdvanced'),
                    -solve => 'Text::Query::SolveSQL',
                    -build => 'Text::Query::BuildSQLMySQL',
                    -fields_searched => $fields);
   
              $where=      $$q{'matchexp'};
              my $query= "SELECT Questionid FROM Questions
                   WHERE $where";
              print br."Query is: $query".br if $debug;
   
              $sth = $dbh->prepare($query);
            } else
   ######   
            {
   
   
             foreach (qw/Question Answer Sources Authors Comments/) {
                   if (param($_)) {
                           push @fields, "IFNULL($_, '')";
                   }
             }
   
             @sar = split " ", $sstr;
             for $i (0 .. $#sar) {
                 $sar[$i] = $dbh->quote("%${sar[$i]}%");                  $sar[$i] = $dbh->quote("%${sar[$i]}%");
         }            }
   
         my($f) = "CONCAT(" . join(',', @fields) . ")";            my($f) = "CONCAT(" . join(',', @fields) . ")";
         if (param('all') eq 'yes') {            if (param('all') eq 'yes') {
                 $sstr = join " AND $f LIKE ", @sar;                  $sstr = join " AND $f LIKE ", @sar;
         } else {            } else {
                 $sstr = join " OR $f LIKE ", @sar;                  $sstr = join " OR $f LIKE ", @sar;
         }            }
           
         $sth = $dbh->prepare("SELECT QuestionId FROM Questions  ### Changed by R7 to prevent showing similar questions#########
                 WHERE $f LIKE $sstr ORDER BY QuestionId");  
              if (param('showequal') eq 'yes') {
                $sth = $dbh->prepare("SELECT QuestionId FROM Questions
                   WHERE $f LIKE $sstr ORDER BY QuestionId");
              } else {
                $sth = $dbh->prepare("SELECT QuestionId FROM Questions LEFT JOIN equalto
                   ON equalto.First=QuestionId WHERE (First IS NULL) AND 
                   ($f LIKE $sstr) ORDER BY QuestionId");
              }
   
   
           } #else -- processing old-style query (R7)
   
         $sth->execute;          $sth->execute;
         while (@arr = $sth->fetchrow) {          while (@arr = $sth->fetchrow) {
                 push @Questions, $arr[0];                  push @Questions, $arr[0];
         }          }
                   print br, "Search time: ",time-$btime," sec",br if $debug;
         return @Questions;          return @Questions;
 }  }
   
Line 151  sub NoCase { Line 199  sub NoCase {
 }  }
   
 sub PrintSearch {  sub PrintSearch {
         my ($dbh, $sstr) = @_;          my ($dbh, $sstr, $metod) = @_;
    my (@Questions) = &Search($dbh, $sstr);          my (@Questions) = &Search($dbh, $sstr,$metod);
         my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1);          my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1);
   
         if ($hits =~ /1.$/  || $hits =~ /[5-90]$/) {          if ($hits =~ /1.$/  || $hits =~ /[5-90]$/) {
Line 172  sub PrintSearch { Line 220  sub PrintSearch {
   
         $sstr =~ s/(.)/&NoCase($1)/ge;          $sstr =~ s/(.)/&NoCase($1)/ge;
   
         my(@sar) = split(/\s/, $sstr);          my(@sar) = split(' ', $sstr);
         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);
                 foreach  (@sar) {                  foreach  (@sar) {
Line 221  sub PrintTournament { Line 269  sub PrintTournament {
                 for ($Tournament{'Type'}) {                  for ($Tournament{'Type'}) {
                         /ç/ && do {                          /ç/ && do {
                                 $output .= h2({align=>"center"},                                   $output .= h2({align=>"center"}, 
                                         "çÒÕÐÐÁ: $Tournament{'Title'}") . p . "\n";                                                "çÒÕÐÐÁ: $Tournament{'Title'} ",
                                                 "$Tournament{'PlayedAt'}") . p . "\n";
                                 last;                                  last;
                         };                          };
                         /þ/ && do {                          /þ/ && do {
                                 return &PrintTour($dbh, $Tours[0], $answer)                                  return &PrintTour($dbh, $Tours[0], $answer)
                                         if ($#Tours == 0);                                          if ($#Tours == 0);
                                   
                                   my $title="ðÁËÅÔ: $Tournament{'Title'}";
                                   if ($Tournament{'PlayedAt'}) {
                                       $title .= " $Tournament{'PlayedAt'}";
                                   }
   
                                 $output .= h2({align=>"center"},                                   $output .= h2({align=>"center"}, 
                                         "þÅÍÐÉÏÎÁÔ: $Tournament{'Title'}") . p . "\n";                                          "$title") . p . "\n";
                                 last;                                  last;
                         };                          };
                         /ô/ && do {                          /ô/ && do {
Line 266  sub PrintTournament { Line 320  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'} . $qnum) .                                   . " " . $Tournament{'Title'} . " " .
                                       $Tournament{'PlayedAt'} . $qnum) . 
                                 dl(                                  dl(
                                         dd("["                                          dd("["
                                                 . a({href=>url .  "?tour=$Tournament{'Id'}&answer=0"},                                                  . a({href=>url .  "?tour=$Tournament{'Id'}&answer=0"},
Line 279  sub PrintTournament { Line 334  sub PrintTournament {
                                 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'}) . $qnum);                                  $Tournament{'Title'}. " ". 
                                             $Tournament{'PlayedAt'}) . $qnum);
                 }                  }
         }          }
         $output .= dl($list);          $output .= dl($list);
Line 333  sub PrintTour { Line 389  sub PrintTour {
         my ($qnum) = $Tour{'QuestionsNum'};          my ($qnum) = $Tour{'QuestionsNum'};
         my ($suffix) = &Suffix($qnum);           my ($suffix) = &Suffix($qnum); 
                   
         $output .= h2({align=>"center"}, $Tour{"Title"} .           $output .= h2({align=>"center"}, $Tournament{"Title"}, 
                         $Tournament{'PlayedAt'},
                         "<br>", $Tour{"Title"} . 
                 " ($qnum ×ÏÐÒÏÓ$suffix)\n") . p;                  " ($qnum ×ÏÐÒÏÓ$suffix)\n") . p;
   
         my (@Questions) = &GetTourQuestions($dbh, $Id);          my (@Questions) = &GetTourQuestions($dbh, $Id);
Line 388  sub PrintTour { Line 446  sub PrintTour {
 sub PrintField {  sub PrintField {
         my ($header, $value, $text) = @_;          my ($header, $value, $text) = @_;
         if ($text) {          if ($text) {
                 $value =~ s/<[\/\w]*>//sg;              $value =~ s/<[\/\w]*>//sg;
           } else {
               $value =~ s/^\s+/<br>&nbsp;&nbsp;&nbsp;&nbsp;/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";
Line 408  sub PrintQuestion { Line 469  sub PrintQuestion {
                         my (%Tournament) = GetTournament($dbh, $Tour{'ParentId'});                          my (%Tournament) = GetTournament($dbh, $Tour{'ParentId'});
                         $titles .=                          $titles .=
                                 dd(img({src=>"/icons/folder.open.gif"}) . " " .                                  dd(img({src=>"/icons/folder.open.gif"}) . " " .
                                          a({href=>url . "?tour=$Tournament{'Id'}"}, $Tournament{'Title'}));                                           a({href=>url . "?tour=$Tournament{'Id'}"}, $Tournament{'Title'}, $Tournament{'PlayedAt'}));
                         $titles .=                          $titles .=
                                 dl(dd(img({src=>"/icons/folder.open.gif"}) . " " .                                  dl(dd(img({src=>"/icons/folder.open.gif"}) . " " .
                                         a({href=>url . "?tour=$Tour{'Id'}"}, $Tour{'Title'})));                                          a({href=>url . "?tour=$Tour{'Id'}"}, $Tour{'Title'})));
Line 448  sub GetQNum { Line 509  sub GetQNum {
         $sth->execute;          $sth->execute;
         return ($sth->fetchrow)[0];          return ($sth->fetchrow)[0];
 }  }
   sub GetMaxQId {
           my ($dbh) = @_;
           my ($sth) = $dbh->prepare("SELECT MAX(QuestionId) FROM Questions");
           $sth->execute;
           return ($sth->fetchrow)[0];
   }
   
 # Returns Id's of 12 random questions  # Returns Id's of 12 random questions
 sub Get12Random {  sub Get12Random {
    my ($dbh, $type, $num) = @_;     my ($dbh, $type, $num) = @_;
         my ($i, @questions, $q, $t, $sth);          my ($i, @questions, $q, $t, $sth);
         my ($qnum) = &GetQNum($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));
                         $sth = $dbh->prepare("SELECT Type FROM Questions             $sth = $dbh->prepare("SELECT Type FROM Questions
                                 WHERE QuestionId=$q");                                  WHERE QuestionId=$q");
                         $sth->execute;             $sth->execute;
                         $t = ($sth->fetchrow)[0];             $t = ($sth->fetchrow)[0];
                 } until !$chosen{$q} && $t =~ /$type/;         } until !$chosen{$q} && $t && $type =~ /[$t]/;
                 $chosen{$q} = 'y';         $chosen{$q} = 'y';
                 push @questions, $q;         push @questions, $q;
         }     }
         return @questions;     return @questions;
 }  }
   
 sub Include_virtual {  sub Include_virtual {
Line 520  sub PrintAll { Line 587  sub PrintAll {
         } else {          } else {
                 $output .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .                  $output .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .
       " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},        " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},
       $Tournament{'Title'}) . " $New");        $Tournament{'Title'}) ." " . $Tournament{'PlayedAt'} . " $New");
         }          }
         if ($Id == 0 or $Tournament{'Type'} =~ /ç/) {          if ($Id == 0 or $Tournament{'Type'} =~ /ç/) {
                 for ($i = 0; $i <= $#Tours; $i++) {                  for ($i = 0; $i <= $#Tours; $i++) {
Line 554  sub PrintDates { Line 621  sub PrintDates {
                 %Tournament = &GetTournament($dbh, $array[0]);                  %Tournament = &GetTournament($dbh, $array[0]);
       $list .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .        $list .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .
       " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},        " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},
       $Tournament{'Title'}));        $Tournament{'Title'}, $Tournament{'PlayedAt'}));
         }          }
         $output .= dl($list);          $output .= dl($list);
         return $output;          return $output;
Line 573  MAIN: Line 640  MAIN:
                     print end_html;                      print end_html;
                         die "Can't connect to DB chgk\n";                          die "Can't connect to DB chgk\n";
                 };                  };
         if (!param('comp') and !$text) {          if (!param('comp') and !param('sqldump') and !$text) {
            print header;             print header;
            print start_html(-"title"=>'Database of the questions',             print start_html(-"title"=>'Database of the questions',
                    -author=>'dimrub@icomverse.com',                     -author=>'dimrub@icomverse.com',
Line 587  MAIN: Line 654  MAIN:
         }          }
   
         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'));
                 $qnum = param('qnum') if (param('qnum') =~ /^\d+$/);                      $qnum = param('qnum') if (param('qnum') =~ /^\d+$/);    
                   $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";
                         print F <<EOT;                          print F <<EOT;
 To: $Email  To: $Email
 From: dimrub\@icomverse.com  From: olegstemanov\@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 610  EOT Line 679  EOT
                         print &PrintRandom($dbh, $type, $qnum, $text);                          print &PrintRandom($dbh, $type, $qnum, $text);
                 }                  }
         } elsif (param('sstr')) {          } elsif (param('sstr')) {
                 &PrintSearch($dbh, param('sstr'));                  &PrintSearch($dbh, param('sstr'), param('metod'));
         } 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"',
                         -'Content-Disposition' => 'attachment; filename="db.zip"'                           -'Content-Disposition' => 'attachment; filename="db.zip"'
                 );                           );
                 $tour = (param('tour')) ? param('tour') : 0;              $tour = (param('tour')) ? param('tour') : 0;
                 my (@files) = &PrintArchive($dbh, $tour);              my (@files) = &PrintArchive($dbh, $tour);
                 open F, "$ZIP -j - $SRCPATH/COPYRIGHT @files |";              open F, "$ZIP -j - $SRCPATH/COPYRIGHT @files |";
                 print (<F>);              print (<F>);
                 close F;              close F;
                 $dbh->disconnect;              $dbh->disconnect;
                 exit;              exit;
           } elsif (param('sqldump')) {
               print header(
                            -'Content-Type' => 'application/x-zip-compressed; name="dump.zip"',
                            -'Content-Disposition' => 'attachment; filename="dump.zip"'
                            );
               open F, "$ZIP -j - $DUMPFILE |";
               print (<F>);
               close F;
               $dbh->disconnect;
               exit;
   
         } else {          } else {
                 $tour = (param('tour')) ? param('tour') : 0;                  $tour = (param('tour')) ? param('tour') : 0;
                 if ($tour !~ /^[0-9]*$/) {                  if ($tour !~ /^[0-9]*$/) {

Removed from v.1.2  
changed lines
  Added in v.1.21


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