File:  [Local Repository] / db / prgsrc / db.cgi
Revision 1.18: download - view: text, annotated - select for diffs - revision graph
Thu May 17 03:54:35 2001 UTC (23 years ago) by roma7
Branches: MAIN
CVS tags: HEAD
Trying...

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

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