File:  [Local Repository] / db / prgsrc / db.cgi
Revision 1.20: download - view: text, annotated - select for diffs - revision graph
Thu May 17 23:31:08 2001 UTC (23 years ago) by roma7
Branches: MAIN
CVS tags: HEAD
Debug printing of search time

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

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