File:  [Local Repository] / db / prgsrc / db.cgi
Revision 1.15: download - view: text, annotated - select for diffs - revision graph
Thu May 17 01:33:59 2001 UTC (23 years ago) by roma7
Branches: MAIN
CVS tags: HEAD
use 'Text::query' added

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

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