File:  [Local Repository] / db / prgsrc / db.cgi
Revision 1.21: download - view: text, annotated - select for diffs - revision graph
Fri May 18 20:16:33 2001 UTC (23 years ago) by roma7
Branches: MAIN
CVS tags: HEAD
Preventing showing equal questions

    1: #!/usr/bin/perl -w
    2: 
    3: use DBI;
    4: use CGI ':all';
    5: use Text::Query;
    6: use strict;
    7: use Time::Local;
    8: use POSIX qw(locale_h);
    9: my $debug=1; #added by R7
   10: open STDERR, ">/tmp/errors" if $debug;
   11: my ($PWD) = `pwd`;
   12: chomp $PWD;
   13: my ($SRCPATH) = "$PWD/../dimrub/src";
   14: my ($ZIP) = "/home/piataev/bin/zip";
   15: my $DUMPFILE = "/tmp/chgkdump";
   16: my ($SENDMAIL) = "/usr/sbin/sendmail";
   17: my ($TMSECS) = 30*24*60*60;
   18: my (%RevMonths) = 
   19: 	('Jan', '0', 'Feb', '1', 'Mar', '2', 'Apr', '3', 'May', '4', 'Jun', '5',
   20: 	'Jul', '6', 'Aug', '7', 'Sep', '8', 'Oct', '9', 'Nov', '10',
   21: 	'Dec', '11',
   22: 	 'Янв', '0', 'Фев', 1, 'Мар', 2, 'Апр', 3, 'Май', '4',
   23: 	 'Июн', '5', 'Июл', 6, 'Авг', '7', 'Сен', '8', 
   24: 	 'Окт', '9', 'Ноя', '19', 'Дек', '11');
   25: 
   26: # Determine whether the given time is within 2 months from now.
   27: sub NewEnough {
   28: 	my ($a) = @_;
   29: 	my ($year, $month, $day) = split('-', $a);
   30: 
   31: 	return (time - timelocal(0, 0, 0, $day, $month -1, $year) < $TMSECS);
   32: }
   33: 
   34: # Reads one question from the DB. Gets DB handler and Question ID.
   35: sub GetTournament {
   36: 	my ($dbh, $Id) = @_;
   37: 	my (%Tournament, $field, @arr);
   38: 
   39: 	return %Tournament if ($Id == 0);
   40: 
   41: 	my ($sth) = $dbh->prepare("SELECT * FROM Tournaments WHERE Id=$Id");
   42: 	$sth->execute;
   43: 
   44: 	@arr = $sth->fetchrow;
   45: 	my($i, $name) = 0;
   46: 	foreach $name (@{$sth->{NAME}}) {
   47: 		$Tournament{$name} = $arr[$i++];
   48: 	}
   49: 
   50: 	return %Tournament;
   51: }
   52: 
   53: # Reads one question from the DB. Gets DB handler and Question ID.
   54: sub GetQuestion {
   55: 	my ($dbh, $QuestionId) = @_;
   56: 	my (%Question, $field, @arr);
   57: 
   58: 	my($sth) = $dbh->prepare("
   59: 		SELECT * FROM Questions WHERE QuestionId=$QuestionId
   60: 	");
   61: 
   62: 	$sth->execute;
   63: 
   64: 	@arr = $sth->fetchrow;
   65: 	my($i, $name) = 0;
   66: 	foreach $name (@{$sth->{NAME}}) {
   67: 		$Question{$name} = $arr[$i++];
   68: 	}
   69: 
   70: 	return %Question;
   71: }
   72: 
   73: # Gets numbers of all the questions from the given tour.
   74: sub GetTourQuestions {
   75: 	my ($dbh, $ParentId) = @_;
   76: 	my (@arr, @Questions);
   77: 
   78: 	my ($sth) = $dbh->prepare("SELECT QuestionId FROM Questions 
   79: 		WHERE ParentId=$ParentId ORDER BY QuestionId");
   80: 
   81: 	$sth->execute;
   82: 
   83: 	while (@arr = $sth->fetchrow) {
   84: 		push @Questions, $arr[0];
   85: 	}
   86: 
   87: 	return @Questions;
   88: }
   89: 
   90: # Returns list of children of the given tournament.
   91: sub GetTours {
   92: 	my ($dbh, $ParentId) = @_;
   93: 	my (@arr, @Tours);
   94: 
   95: 	my ($sth) = $dbh->prepare("SELECT Id FROM Tournaments
   96: 		WHERE ParentId=$ParentId ORDER BY Id");
   97: 
   98: 	$sth->execute;
   99: 
  100: 	while (@arr = $sth->fetchrow) {
  101: 		push @Tours, $arr[0];
  102: 	}
  103: 
  104: 	return @Tours;
  105: }
  106: 
  107: 
  108: # Returns list of QuestionId's, that have the search string in them.
  109: sub Search {
  110: 	my ($dbh, $sstr, $metod) = @_;
  111: 	my (@arr, @Questions, @fields);
  112: 	my (@sar, $i, $sth,$where);
  113:         my $btime=time;	
  114: 
  115: #	push @fields, 'Question';
  116: 
  117: ###Simple and advanced query processing. Added by R7
  118: 	if ($metod eq 'simple' || $metod eq 'advanced') 
  119: 	{
  120:         foreach (qw/Question Answer Sources Authors Comments/) {
  121: 		if (param($_)) {
  122: 			push @fields, $_; 
  123: 		}
  124: 	}
  125: 
  126: 	   @fields=(qw/Question Answer Sources Authors Comments/) unless scalar @fields;
  127: 	   my $fields=join ",", @fields;
  128:            my $q=new Text::Query($sstr,
  129:                  -parse => 'Text::Query::'. 
  130:                    (($metod eq 'simple') ? 'ParseSimple':'ParseAdvanced'),
  131:                  -solve => 'Text::Query::SolveSQL',
  132:                  -build => 'Text::Query::BuildSQLMySQL',
  133:                  -fields_searched => $fields);
  134: 
  135:            $where=	$$q{'matchexp'};
  136:            my $query= "SELECT Questionid FROM Questions
  137:                 WHERE $where";
  138:            print br."Query is: $query".br if $debug;
  139: 
  140:            $sth = $dbh->prepare($query);
  141:          } else
  142: ######   
  143:          {
  144: 
  145: 
  146: 	  foreach (qw/Question Answer Sources Authors Comments/) {
  147: 		if (param($_)) {
  148: 			push @fields, "IFNULL($_, '')";
  149: 		}
  150: 	  }
  151: 
  152: 	  @sar = split " ", $sstr;
  153: 	  for $i (0 .. $#sar) {
  154: 		$sar[$i] = $dbh->quote("%${sar[$i]}%");
  155: 	  }
  156: 
  157: 	  my($f) = "CONCAT(" . join(',', @fields) . ")";
  158: 	  if (param('all') eq 'yes') {
  159: 		$sstr = join " AND $f LIKE ", @sar;
  160: 	  } else {
  161: 		$sstr = join " OR $f LIKE ", @sar;
  162:     	  }
  163: 
  164: ### Changed by R7 to prevent showing similar questions#########
  165: 
  166:            if (param('showequal') eq 'yes') {
  167:  	     $sth = $dbh->prepare("SELECT QuestionId FROM Questions
  168:  		WHERE $f LIKE $sstr ORDER BY QuestionId");
  169:            } else {
  170:   	     $sth = $dbh->prepare("SELECT QuestionId FROM Questions LEFT JOIN equalto
  171:   		ON equalto.First=QuestionId WHERE (First IS NULL) AND 
  172:                 ($f LIKE $sstr) ORDER BY QuestionId");
  173:            }
  174: 
  175: 
  176: 	} #else -- processing old-style query (R7)
  177: 
  178: 	$sth->execute;
  179: 	while (@arr = $sth->fetchrow) {
  180: 		push @Questions, $arr[0];
  181: 	}
  182: 	print br, "Search time: ",time-$btime," sec",br if $debug;
  183: 	return @Questions;
  184: }
  185: 
  186:  # Substitute every letter by a pair (for case insensitive search).
  187:  my (@letters) = qw/аА бБ вВ гГ дД еЕ жЖ зЗ иИ йЙ кК лЛ мМ нН оО 
  188:  пП рР сС тТ уУ фФ хХ цЦ чЧ шШ щЩ ьЬ ыЫ эЭ юЮ яЯ/;
  189:  
  190: sub NoCase {
  191: 	my ($sstr) = shift;
  192: 	my ($res);
  193: 
  194: 	if (($res) = grep(/$sstr/, @letters)) {
  195: 		return "[$res]";
  196: 	} else {
  197: 		return $sstr;
  198: 	}
  199: }
  200: 
  201: sub PrintSearch {
  202: 	my ($dbh, $sstr, $metod) = @_;
  203:         my (@Questions) = &Search($dbh, $sstr,$metod);
  204: 	my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1);
  205: 
  206: 	if ($hits =~ /1.$/  || $hits =~ /[5-90]$/) {
  207: 		$suffix = 'й';
  208: 	} elsif ($hits =~ /1$/) {
  209: 		$suffix = 'е';
  210: 	} else {
  211: 		$suffix = 'я'; 
  212: 	}
  213: 	
  214: 	print p({align=>"center"}, "Результаты поиска на " . strong($sstr)
  215: 	. " : $hits попадани$suffix.");
  216: 
  217: 	if (param('word')) {
  218: 		$sstr = '[ 	\.\,:;]' . $sstr . '[  \.\,:\;]';
  219: 	}
  220: 
  221: 	$sstr =~ s/(.)/&NoCase($1)/ge;
  222: 
  223: 	my(@sar) = split(' ', $sstr);
  224: 	for ($i = 0; $i <= $#Questions; $i++) {
  225: 		$output = &PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 1);
  226: 		foreach  (@sar) {
  227: 			$output =~ s/$_/<strong>$&<\/strong>/gs;
  228: 		}
  229: 		print $output;
  230: 	}
  231: }
  232: 
  233: sub PrintRandom {
  234:    my ($dbh, $type, $num, $text) = @_;
  235:    my (@Questions) = &Get12Random($dbh, $type, $num);
  236: 	my ($output, $i) = ('', 0);
  237: 
  238: 	if ($text) {
  239: 		$output .= "	$num случайных вопросов.\n\n";
  240: 	} else {
  241: 		$output .=
  242: 			h2({align=>"center"}, "$num случайных вопросов.");
  243: 	}
  244: 
  245: 	for ($i = 0; $i <= $#Questions; $i++) {
  246: 		# Passing DB handler, question ID, print answer, question
  247: 		# number, print title, print text/html
  248: 		$output .= 
  249: 			&PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 0, $text);
  250: 	}
  251: 	return $output; 
  252: }
  253: 
  254: sub PrintTournament {
  255:    my ($dbh, $Id, $answer) = @_;
  256: 	my (%Tournament, @Tours, $i, $list, $qnum, $imgsrc, $alt,
  257: 		$SingleTour);
  258: 	my ($output) = '';
  259: 
  260: 	%Tournament = &GetTournament($dbh, $Id) if ($Id);
  261: 	
  262: 	my ($URL) = $Tournament{'URL'};
  263: 	my ($Info) = $Tournament{'Info'};
  264: 	my ($Copyright) = $Tournament{'Copyright'};
  265: 
  266: 	@Tours = &GetTours($dbh, $Id);
  267: 
  268: 	if ($Id) {
  269: 		for ($Tournament{'Type'}) {
  270: 			/Г/ && do {
  271: 				$output .= h2({align=>"center"}, 
  272: 					      "Группа: $Tournament{'Title'} ",
  273: 					      "$Tournament{'PlayedAt'}") . p . "\n";
  274: 				last;
  275: 			};
  276: 			/Ч/ && do {
  277: 				return &PrintTour($dbh, $Tours[0], $answer)
  278: 					if ($#Tours == 0);
  279: 				
  280: 				my $title="Пакет: $Tournament{'Title'}";
  281: 				if ($Tournament{'PlayedAt'}) {
  282: 				    $title .= " $Tournament{'PlayedAt'}";
  283: 				}
  284: 
  285: 				$output .= h2({align=>"center"}, 
  286: 					"$title") . p . "\n";
  287: 				last;
  288: 			};
  289: 			/Т/ && do {
  290: 				return &PrintTour($dbh, $Id, $answer);
  291: 			};
  292: 		}
  293: 	} else {
  294: 		my ($qnum) = GetQNum($dbh);
  295: 		$output .= h2("Банк Вопросов: $qnum вопросов") . p . "\n";
  296: 	}
  297: 
  298: 	for ($i = 0; $i <= $#Tours; $i++) { 
  299: 		%Tournament = &GetTournament($dbh, $Tours[$i]);
  300: 		
  301: 		if ($Tournament{'Type'} =~ /Ч/) {
  302: 			$SingleTour = 0;
  303: 			my (@Tours) = &GetTours($dbh, $Tournament{'Id'});
  304: 			$SingleTour = 1
  305: 				if ($#Tours == 0);
  306: 		}
  307: 		if ($Tournament{'QuestionsNum'} > 0) {
  308: 			$qnum = " ($Tournament{'QuestionsNum'} вопрос" .
  309: 				&Suffix($Tournament{'QuestionsNum'}) . ")\n";
  310: 		} else {
  311: 			$qnum = '';
  312: 		}
  313: 		if ($Tournament{'Type'} =~ /Г/) {
  314: 			$imgsrc = "/icons/folder.gif";
  315: 			$alt = "[*]";
  316: 		} else {
  317: 			$imgsrc = "/icons/folder.gif";
  318: 			$alt = "[-]";
  319: 		}
  320: 
  321: 		if ($SingleTour or $Tournament{'Type'} =~ /Т/) {
  322: 			$list .= dd(img({src=>$imgsrc, alt=>$alt})
  323: 				. " " . $Tournament{'Title'} . " " .
  324: 				    $Tournament{'PlayedAt'} . $qnum) . 
  325: 				dl(
  326: 					dd("["
  327: 						. a({href=>url .  "?tour=$Tournament{'Id'}&answer=0"},
  328: 						"вопросы") . "] ["
  329:                   . a({href=>url .  "?tour=$Tournament{'Id'}&answer=1"},
  330:                   "вопросы + ответы") . "]")
  331: 				);
  332: 		} else {
  333: 			$list .= dd(a({href=>url . "?tour=$Tournament{'Id'}&comp=1"}, 
  334: 				img({src=>'/icons/compressed.gif', alt=>'[ZIP]', border=>1}))
  335: 				. " " . img({src=>$imgsrc, alt=>$alt}) 
  336: 				. " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"}, 
  337: 				$Tournament{'Title'}. " ". 
  338: 					  $Tournament{'PlayedAt'}) . $qnum);
  339: 		}
  340: 	}
  341: 	$output .= dl($list);
  342: 
  343: 	if ($URL) {
  344: 		$output .=
  345: 		p("Дополнительная информация об этом турнире - по адресу " . 
  346: 			a({-'href'=>$URL}, $URL));
  347: 	}
  348: 
  349: 	if ($Copyright) {
  350: 		$output .= p("Копирайт: " .   $Copyright);
  351: 	}
  352: 
  353: 	if ($Info) {
  354: 		$output .= p($Info);
  355: 	}
  356: 	
  357: 	return $output;
  358: }
  359: 
  360: sub Suffix {
  361: 	my ($qnum) = @_;
  362: 	my ($suffix) = 'а' if $qnum =~ /[234]$/;
  363:    $suffix = '' if $qnum =~ /1$/;
  364:    $suffix = 'ов' if $qnum =~ /[567890]$/ || $qnum =~ /1.$/;
  365: 	return $suffix;
  366: }
  367: 
  368: sub IsTour {
  369: 	my ($dbh, $Id) = @_;
  370: 	my ($sth) = $dbh->prepare("SELECT Type FROM Tournaments 
  371: 		WHERE Id=$Id");
  372: 	$sth->execute;
  373: 	return ($sth->fetchrow)[0] =~ /Т/;
  374: }
  375: 
  376: # Gets a DB handler (ofcourse) and a tour Id. Prints all the
  377: # question of that tour, according to the options.
  378: sub PrintTour {
  379: 	my ($dbh, $Id, $answer) = @_;
  380: 	my ($output, $q, $bottom, $field) = ('', 0, '', '');
  381: 
  382: 	my (%Tour) = &GetTournament($dbh, $Id);
  383: 	my (@Tours) = &GetTours($dbh, $Tour{'ParentId'});
  384: 	my (%Tournament) = &GetTournament($dbh, $Tour{'ParentId'});
  385: 
  386: 	return 0
  387: 		if ($Tour{'Type'} !~ /Т/);
  388: 
  389: 	my ($qnum) = $Tour{'QuestionsNum'};
  390: 	my ($suffix) = &Suffix($qnum); 
  391: 	
  392: 	$output .= h2({align=>"center"}, $Tournament{"Title"}, 
  393: 		      $Tournament{'PlayedAt'},
  394: 		      "<br>", $Tour{"Title"} . 
  395: 		" ($qnum вопрос$suffix)\n") . p;
  396: 
  397: 	my (@Questions) = &GetTourQuestions($dbh, $Id);
  398: 	for ($q = 0; $q <= $#Questions; $q++) {
  399: 		$output .= &PrintQuestion($dbh, $Questions[$q], $answer, 0);
  400: 	} 
  401: 
  402: 	$output .= hr({-'align'=>'center', -'width'=>'80%'});
  403: 
  404: 	if ($Tournament{'URL'}) {
  405: 		$output .=
  406: 		p("Дополнительная информация об этом турнире - по адресу " . 
  407: 			a({-'href'=>$Tournament{'URL'}}, $Tournament{'URL'}));
  408: 	}
  409: 
  410: 	if ($Tournament{'Copyright'}) {
  411: 		$output .= p("Копирайт: " .   $Tournament{'Copyright'});
  412: 	}
  413: 
  414: 	if ($Tournament{'Info'}) {
  415: 		$output .= p($Tournament{'Info'});
  416: 	}
  417: 	
  418: 
  419: 	if ($answer == 0) {
  420: 		$bottom .= 
  421: 			"[" . a({href=>url . "?tour=$Id&answer=1"}, "ответы") .  "] " . br;
  422: 	}
  423: 	if (&IsTour($dbh, $Id - 1)) {
  424: 		$bottom .= 
  425: 			"[" . a({href=>url . "?tour=" . ($Id - 1) . "&answer=0"}, 
  426: 			"предыдущий тур") . "] ";
  427: 		$bottom .= 
  428: 			"[" . a({href=>url . "?tour=" . ($Id - 1) . "&answer=1"}, 
  429: 			"предыдущий тур с ответами") . "] " . br;
  430: 	}
  431: 	if (&IsTour($dbh, $Id + 1)) {
  432: 		$bottom .= 
  433: 			"[" . a({href=>url . "?tour=" . ($Id + 1) . "&answer=0"}, 
  434: 			"следующий тур") . "] ";
  435: 		$bottom .= 
  436: 			"[" . a({href=>url . "?tour=" . ($Id + 1) . "&answer=1"}, 
  437: 			"следующий тур с ответами") . "] ";
  438: 	}
  439: 
  440: 	$output .=
  441: 		p({align=>"center"}, font({size=>-1}, $bottom));
  442: 
  443: 	return $output;
  444: }
  445: 
  446: sub PrintField {
  447: 	my ($header, $value, $text) = @_;
  448: 	if ($text) {
  449: 	    $value =~ s/<[\/\w]*>//sg;
  450: 	} else {
  451: 	    $value =~ s/^\s+/<br>&nbsp;&nbsp;&nbsp;&nbsp;/mg;
  452: 	    $value =~ s/^\|([^\n]*)/<pre>$1<\/pre>/mg;
  453: 	}
  454: 	return $text ? "$header:\n$value\n\n" : 
  455: 		strong("$header: ") . $value . p . "\n";
  456: }
  457: 
  458: # Gets a DB handler (ofcourse) and a question Id. Prints 
  459: # that question, according to the options.
  460: sub PrintQuestion {
  461: 	my ($dbh, $Id, $answer, $qnum, $title, $text) = @_;
  462: 	my ($output, $titles) = ('', '');
  463: 
  464: 	my (%Question) = &GetQuestion($dbh, $Id);
  465: 	if (!$text) {
  466: 		$output .= hr({width=>"50%"});
  467: 		if ($title) {
  468: 			my (%Tour) = GetTournament($dbh, $Question{'ParentId'});
  469: 			my (%Tournament) = GetTournament($dbh, $Tour{'ParentId'});
  470: 			$titles .=
  471: 				dd(img({src=>"/icons/folder.open.gif"}) . " " .
  472: 					 a({href=>url . "?tour=$Tournament{'Id'}"}, $Tournament{'Title'}, $Tournament{'PlayedAt'}));
  473: 			$titles .=
  474: 				dl(dd(img({src=>"/icons/folder.open.gif"}) . " " .
  475: 					a({href=>url . "?tour=$Tour{'Id'}"}, $Tour{'Title'})));
  476: 		}
  477: 		$output .= dl(strong($titles));
  478: 	}
  479: 	
  480: 	$qnum = $Question{'Number'}
  481: 		if ($qnum == 0);
  482: 
  483: 	$output .= 
  484: 		&PrintField("Вопрос $qnum", $Question{'Question'}, $text);
  485: 
  486: 	if ($answer) {
  487: 		$output .= 
  488: 			&PrintField("Ответ", $Question{'Answer'}, $text);
  489: 
  490: 		if ($Question{'Authors'}) {
  491: 			$output .= &PrintField("Автор(ы)", $Question{'Authors'}, $text);
  492: 		}
  493: 
  494: 		if ($Question{'Sources'}) {
  495: 			$output .= &PrintField("Источник(и)", $Question{'Sources'}, $text);
  496: 		}
  497: 
  498: 		if ($Question{'Comments'}) {
  499: 			$output .= &PrintField("Комментарии", $Question{'Comments'}, $text);
  500: 		}
  501: 	}
  502: 	return $output;
  503: }
  504: 
  505: # Returns the total number of questions currently in the DB.
  506: sub GetQNum {
  507: 	my ($dbh) = @_;
  508: 	my ($sth) = $dbh->prepare("SELECT COUNT(*) FROM Questions");
  509: 	$sth->execute;
  510:  	return ($sth->fetchrow)[0];
  511: }
  512: sub GetMaxQId {
  513: 	my ($dbh) = @_;
  514: 	my ($sth) = $dbh->prepare("SELECT MAX(QuestionId) FROM Questions");
  515: 	$sth->execute;
  516:  	return ($sth->fetchrow)[0];
  517: }
  518: 
  519: # Returns Id's of 12 random questions
  520: sub Get12Random {
  521:    my ($dbh, $type, $num) = @_;
  522: 	my ($i, @questions, $q, $t, $sth);
  523: 	my ($qnum) = &GetMaxQId($dbh);
  524: 	my (%chosen);
  525: 	srand;
  526: 	
  527:    for ($i = 0; $i < $num; $i++) {
  528:        do {
  529: 	   $q = int(rand($qnum));
  530: 	   $sth = $dbh->prepare("SELECT Type FROM Questions
  531: 				WHERE QuestionId=$q");
  532: 	   $sth->execute;
  533: 	   $t = ($sth->fetchrow)[0];
  534:        } until !$chosen{$q} && $t && $type =~ /[$t]/;
  535:        $chosen{$q} = 'y';
  536:        push @questions, $q;
  537:    }
  538:    return @questions;
  539: }
  540: 
  541: sub Include_virtual {
  542: 	my ($fn, $output) = (@_, '');
  543: 
  544: 	open F , $fn
  545: 		or return; #die "Can't open the file $fn: $!\n";
  546: 	
  547: 	while (<F>) {
  548: 		if (/<!--#include/o) {
  549: 			s/<!--#include virtual="\/(.*)" -->/&Include_virtual($1)/e;
  550: 		}
  551: 		if (/<!--#exec/o) {
  552: 			s/<!--#exec.*cmd\s*=\s*"([^"]*)".*-->/`$1`/e;
  553: 		}
  554: 		$output .= $_;
  555: 	}
  556: 	return $output;
  557: }
  558: 
  559: sub PrintArchive {
  560: 	my($dbh, $Id) = @_;
  561: 	my ($output, @list, $i);
  562: 
  563: 	my (%Tournament) = &GetTournament($dbh, $Id);
  564: 	my (@Tours) = &GetTours($dbh, $Id);
  565: 	
  566: 	if ($Tournament{'Type'} =~ /Г/ || $Id == 0) {
  567: 		for ($i = 0; $i <= $#Tours; $i++) {
  568: 			push(@list ,&PrintArchive($dbh, $Tours[$i]));
  569: 		}
  570: 		return @list;
  571: 	}
  572: 	return "$SRCPATH/$Tournament{'FileName'} ";
  573: }
  574: 
  575: sub PrintAll {
  576: 	my ($dbh, $Id) = @_;
  577: 	my ($output, $list, $i);
  578: 
  579: 	my (%Tournament) = &GetTournament($dbh, $Id);
  580: 	my (@Tours) = &GetTours($dbh, $Id);
  581: 	my ($New) = ($Id and $Tournament{'Type'} eq 'Ч' and 
  582: 		&NewEnough($Tournament{"CreatedAt"})) ?
  583: 		img({src=>"/znatoki/dimrub/db/new-sml.gif", alt=>"NEW!"}) : "";
  584: 
  585: 	if ($Id == 0) {
  586: 		$output = h3("Все турниры");
  587: 	} else {
  588: 		$output .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .
  589:       " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},
  590:       $Tournament{'Title'}) ." " . $Tournament{'PlayedAt'} . " $New");
  591: 	}
  592: 	if ($Id == 0 or $Tournament{'Type'} =~ /Г/) {
  593: 		for ($i = 0; $i <= $#Tours; $i++) {
  594: 			$list .= &PrintAll($dbh, $Tours[$i]);
  595: 		}
  596: 		$output .= dl($list);
  597: 	}
  598: 	return $output;
  599: }
  600: 
  601: sub PrintDates {
  602: 	my ($dbh) = @_;
  603: 	my ($from) = param('from_year') . "-" . param('from_month') . 
  604: 		"-" .  param('from_day');
  605: 	my ($to) = param('to_year') . "-" . param('to_month') . "-" .  param('to_day');
  606: 	$from = $dbh->quote($from);
  607: 	$to = $dbh->quote($to);
  608: 	my ($sth) = $dbh->prepare("
  609: 		SELECT DISTINCT Id
  610: 		FROM Tournaments
  611: 		WHERE PlayedAt >= $from AND PlayedAt <= $to
  612: 		AND Type = 'Ч'
  613: 	");
  614: 	$sth->execute;
  615: 	my (%Tournament, @array, $output, $list);
  616: 
  617: 	$output = h3("Список турниров, проходивших между $from и $to.");
  618: 	while (@array = $sth->fetchrow) {
  619: 		next
  620: 			if (!$array[0]);
  621: 		%Tournament = &GetTournament($dbh, $array[0]);
  622:       $list .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .
  623:       " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},
  624:       $Tournament{'Title'}, $Tournament{'PlayedAt'}));
  625: 	}
  626: 	$output .= dl($list);
  627: 	return $output;
  628: }
  629: 
  630: MAIN:
  631: {
  632: 	setlocale(LC_CTYPE,'russian');
  633: 	my($i, $tour);
  634: 	my($text) = (param('text')) ? 1 : 0;
  635: 	my($dbh) = DBI->connect("DBI:mysql:chgk", "piataev", "")
  636: 		or do {
  637: 			print h1("Временные проблемы") . "База данных временно не
  638: 			работает. Заходите попозже.";
  639: 			print &Include_virtual("../dimrub/db/reklama.html");
  640: 		    print end_html;
  641: 			die "Can't connect to DB chgk\n";
  642: 		};
  643: 	if (!param('comp') and !param('sqldump') and !$text) {
  644: 	   print header;
  645: 	   print start_html(-"title"=>'Database of the questions',
  646: 	           -author=>'dimrub@icomverse.com',
  647: 	           -bgcolor=>'#fff0e0',
  648: 				  -vlink=>'#800020');
  649: 		print &Include_virtual("../dimrub/db/reklama.html");
  650: 	}
  651: 
  652: 	if ($text) {
  653: 		print header('text/plain');
  654: 	}
  655: 
  656: 	if (param('rand')) {
  657: 		my ($type, $qnum) = ('', 12);
  658: 		$type .= 'Б' if (param('brain'));
  659: 		$type .= 'Ч' if (param('chgk'));
  660: 		$qnum = param('qnum') if (param('qnum') =~ /^\d+$/);	
  661: 		$qnum = 0 if (!$type);
  662: 		if (param('email') && -x $SENDMAIL && 
  663: 		open(F, "| $SENDMAIL -t -n")) {
  664: 			my ($Email) = param('email');
  665: 			my ($mime_type) = $text ? "plain" : "html";
  666: 			print F <<EOT;
  667: To: $Email
  668: From: olegstemanov\@mail.ru
  669: Subject: Sluchajnij Paket Voprosov "Chto? Gde? Kogda?"
  670: MIME-Version: 1.0
  671: Content-type: text/$mime_type; charset="koi8-r"
  672: 
  673: EOT
  674: 			print F &PrintRandom($dbh, $type, $qnum, $text);
  675: 			close F;
  676: 			print "Пакет случайно выбранных вопросов послан. Нажмите
  677: 			на <B>Reload</B> для получения еще одного пакета";
  678: 		} else {
  679: 			print &PrintRandom($dbh, $type, $qnum, $text);
  680: 		}
  681: 	} elsif (param('sstr')) {
  682: 		&PrintSearch($dbh, param('sstr'), param('metod'));
  683: 	} elsif (param('all')) {
  684: 		print &PrintAll($dbh, 0);
  685: 	} elsif (param('from_year') && param('to_year')) {
  686: 		print &PrintDates($dbh);	
  687: 	} elsif (param('comp')) {
  688: 	    print header(
  689: 			 -'Content-Type' => 'application/x-zip-compressed; name="db.zip"',
  690: 			 -'Content-Disposition' => 'attachment; filename="db.zip"'
  691: 			 );
  692: 	    $tour = (param('tour')) ? param('tour') : 0;
  693: 	    my (@files) = &PrintArchive($dbh, $tour);
  694: 	    open F, "$ZIP -j - $SRCPATH/COPYRIGHT @files |";
  695: 	    print (<F>);
  696: 	    close F;
  697: 	    $dbh->disconnect;
  698: 	    exit;
  699: 	} elsif (param('sqldump')) {
  700: 	    print header(
  701: 			 -'Content-Type' => 'application/x-zip-compressed; name="dump.zip"',
  702: 			 -'Content-Disposition' => 'attachment; filename="dump.zip"'
  703: 			 );
  704: 	    open F, "$ZIP -j - $DUMPFILE |";
  705: 	    print (<F>);
  706: 	    close F;
  707: 	    $dbh->disconnect;
  708: 	    exit;
  709: 
  710: 	} else {
  711: 		$tour = (param('tour')) ? param('tour') : 0;
  712: 		if ($tour !~ /^[0-9]*$/) {
  713: 			my ($sth) = $dbh->prepare("SELECT Id FROM Tournaments
  714: 			WHERE FileName = '$tour.txt'");
  715: 			$sth->execute;
  716: 			$tour = ($sth->fetchrow)[0];
  717: 		}
  718: 		print &PrintTournament($dbh, $tour, param('answer'));
  719: 	}
  720: 	if (!$text) {
  721: 		print &Include_virtual("../dimrub/db/footer.html");
  722: 		print end_html;
  723: 	}
  724: 	$dbh->disconnect;
  725: }

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