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