File:  [Local Repository] / db / prgsrc / db.cgi
Revision 1.9: download - view: text, annotated - select for diffs - revision graph
Mon Oct 23 01:23:35 2000 UTC (23 years, 7 months ago) by boris
Branches: MAIN
CVS tags: HEAD
Added sqldump option

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

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