File:  [Local Repository] / db / prgsrc / db.cgi
Revision 1.93: download - view: text, annotated - select for diffs - revision graph
Wed Feb 26 00:07:55 2003 UTC (21 years, 2 months ago) by roma7
Branches: MAIN
CVS tags: HEAD
fixing list navigation

    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: use locale;
    9: open STDERR, ">/var/tmp/errors1";
   10: my $newsurl='http://news.chgk.info/';
   11: my $cashednumber=500;
   12: my ($proxyptext,$proxysstr);
   13: my $printqueries=0;
   14: my %forbidden=();
   15: my $debug=0; #added by R7
   16: if (param('debug')) {$debug=1; $printqueries=1}
   17: *STDERR=*STDOUT if $debug;
   18: my $thislocale;
   19: if ($^O =~ /win/i) {
   20: 	$thislocale = "Russian_Russia.20866";
   21: } else {
   22: 	$thislocale = "ru_RU.KOI8-R";
   23: }
   24: POSIX::setlocale( &POSIX::LC_ALL, $thislocale );
   25: 
   26: if ((uc 'а') ne 'А') {print STDERR "Koi8-r locale not installed!\n"};
   27: 
   28: my %fieldname= (0,'Question', 1, 'Answer', 2, 'Comments', 3, 'Authors', 4, 'Sources');
   29: my %rusfieldname=('Question','Вопрос', 'Answer', 'Ответ', 
   30:                   'Comments', 'Комментарии', 'Authors', 'Автор', 
   31:                   'Sources', 'Источник','old','Старый','rus','Новый',
   32:                   'chgk', 'ЧГК', 'brain', 'Брейн-ринг','game', 'Своя игра', 
   33:                   'ehruditka', 'Эрудитка', 'beskrylka', 'Бескрылка', 'igp', 'Интернет'
   34: );
   35: my %searchin;
   36: my $rl=qr/[йцукенгшщзхъфывапролджэячсмитьбюё]/;
   37: my $RL=qr/[ЙЦУКЕНГШЩЗХЪЭЖДЛОРПАВЫФЯЧСМИТЬБЮЁ]/;
   38: my $RLrl=qr/(?:(?:${rl})|(?:${RL}))+/;
   39: my $l=qr/(?:(?:${RLrl})|(?:[\w\-]))+/;
   40: my $Ll=qr/(?:[A-Z])|(?:${RL})/;
   41: my %metodchar=('rus',1,'old',2);
   42: 
   43: 
   44: 
   45: 
   46: $searchin{$_}=1 foreach param('searchin');
   47: my %TypeName=('children'=>'Д', 'game'=>'Я', 'igp'=>'И',
   48:               'chgk'=>'Ч', 'brain'=>'Б', 'beskrylka'=>'Л','ehruditka'=>'Э');
   49: 
   50: 
   51: 
   52: my $all=param('all');
   53: $all=0 if lc $all eq 'no';
   54: my ($PWD) = `pwd`;
   55: chomp $PWD;
   56: my ($SRCPATH) = "/home/piataev/public_html/dimrub/src";
   57: my ($ZIP) = "/usr/local/bin/zip";
   58: my $DUMPFILE = "/tmp/chgkdump";
   59: my ($SENDMAIL) = "/usr/sbin/sendmail";
   60: my ($TMPDIR) = "/var/tmp";
   61: my ($TMSECS) = 30*24*60*60;
   62: my (%RevMonths) =
   63: 	('Jan', '0', 'Feb', '1', 'Mar', '2', 'Apr', '3', 'May', '4', 'Jun', '5',
   64: 	'Jul', '6', 'Aug', '7', 'Sep', '8', 'Oct', '9', 'Nov', '10',
   65: 	'Dec', '11',
   66: 	 'Янв', '0', 'Фев', 1, 'Мар', 2, 'Апр', 3, 'Май', '4',
   67: 	 'Июн', '5', 'Июл', 6, 'Авг', '7', 'Сен', '8',
   68: 	 'Окт', '9', 'Ноя', '19', 'Дек', '11');
   69: my @months=('000','Jan',"Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct",
   70:           "Nov","Dec");
   71: 
   72: 
   73: # Determine whether the given time is within 2 months from now.
   74: sub NewEnough {
   75: 	my ($a) = @_;
   76: 	my ($year, $month, $day) = split('-', $a);
   77: 
   78: 	return (time - timelocal(0, 0, 0, $day, $month -1, $year) < $TMSECS);
   79: }
   80: 
   81: # Reads one question from the DB. Gets DB handler and Question ID.
   82: sub GetTournament {
   83: 	my ($dbh, $Id) = @_;
   84: 	my (%Tournament, $field, @arr);
   85: 
   86: 	return %Tournament if ($Id == 0);
   87: 
   88: 	my ($sth) = $dbh->prepare("SELECT * FROM Tournaments WHERE Id=$Id");
   89: 	$sth->execute;
   90: 
   91: 	@arr = $sth->fetchrow;
   92: 	my($i, $name) = 0;
   93: 	foreach $name (@{$sth->{NAME}}) {
   94: 		$Tournament{$name} = $arr[$i++];
   95: 	}
   96:         $sth->finish;
   97: 	return %Tournament;
   98: }
   99: 
  100: # Reads one question from the DB. Gets DB handler and Question ID.
  101: sub GetQuestion {
  102: 	my ($dbh, $QuestionId) = @_;
  103: 	my (%Question, $field, @arr);
  104: 
  105: 	my($sth) = $dbh->prepare("
  106: 		SELECT * FROM Questions WHERE QuestionId=$QuestionId
  107: 	");
  108: 
  109: 	$sth->execute;
  110: 
  111: 	@arr = $sth->fetchrow;
  112: 	my($i, $name) = 0;
  113: 	foreach $name (@{$sth->{NAME}}) {
  114: 		$Question{$name} = $arr[$i++];
  115: 	}
  116: 
  117:         $sth->finish;
  118: 	return %Question;
  119: }
  120: 
  121: # Gets numbers of all the questions from the given tour.
  122: sub GetTourQuestions {
  123: 	my ($dbh, $ParentId) = @_;
  124: 	my (@arr, @Questions);
  125: 
  126: 	my ($sth) = $dbh->prepare("SELECT QuestionId FROM Questions
  127: 		WHERE ParentId=$ParentId order by Number");
  128: 
  129: 	$sth->execute;
  130: 
  131: 	while (@arr = $sth->fetchrow) {
  132: 		push @Questions, $arr[0];
  133: 	}
  134: 
  135:         $sth->finish;
  136: 	return @Questions;
  137: }
  138: 
  139: # Returns list of children of the given tournament.
  140: sub GetTours {
  141: 	my ($dbh, $ParentId) = @_;
  142: 	my (@arr, @Tours);
  143: 
  144: 	my ($sth) = $dbh->prepare("SELECT Id FROM Tournaments
  145: 		WHERE ParentId=$ParentId ORDER BY Id");
  146: 
  147: 	$sth->execute;
  148: 
  149: 	while (@arr = $sth->fetchrow) {
  150: 		push @Tours, $arr[0];
  151: 	}
  152:         $sth->finish;
  153: 	return @Tours;
  154: }
  155: 
  156: sub count
  157: {
  158:   my ($dbh,$word)=@_; 
  159:   $word=$dbh->quote(uc $word);
  160:   my $query="SELECT number from nests,nf where $word=w1 AND w2=nf.id";
  161:   my $sth=$dbh->prepare($query);
  162:   $sth->execute;
  163:   my @a=$sth->fetchrow;
  164:   $sth->finish;
  165:   $a[0]||0;
  166: }
  167: 
  168: 
  169: sub printform
  170: {
  171: 
  172:   my $qnumber=("&nbsp;"x10)."Выводить по ". textfield(-name=>'kvo',
  173:                          -default=>param('kvo')||'150',
  174:                          -size=>3,
  175:                          -maxlength=>5)." вопросов";
  176:   my $sstr=param('sstr');
  177:   my @df=keys %searchin;
  178:   my %checked;
  179:   @df=('Question', 'Answer') unless @df;
  180:   $checked{lc $_}="checked" foreach @df;
  181:   my $fields=checkbox_group('searchin',['Question','Answer','Comments','Authors','Sources'], [@df],
  182:              'false',\%rusfieldname);
  183:   @df=param('type');
  184:   @df=('chgk','brain','igp','game','ehruditka','beskrylka') unless @df;
  185:   $checked{lc $_}="checked" foreach @df;
  186:   my $all=param('all') && param('all') eq 'yes';
  187: 
  188:   $checked{'all'}=$all?"checked":"";
  189:   $checked{'any'}=$all?"":"checked";
  190:   $checked{lc param('metod')}="checked";
  191:   $checked{'russian'}=1 unless $checked{'russian'} || $checked{'old'};
  192: 
  193: #################################################
  194: return   
  195: <<EOT
  196: <form method="get" enctype="application/x-www-form-urlencoded"
  197: action="/znatoki/cgi-bin/db.cgi">
  198: <h2>Поиск в базе вопросов</h2>
  199: 
  200: <input type="text" name="sstr" value="$sstr" size="30" maxlength="50"> 
  201: <input type="submit" value="Поиск"> $qnumber
  202: <p>
  203: 
  204: <table border="1" cellpadding=4 cellspacing=0>
  205: <tr>
  206: <th align="left" rowspan=3 width="20%"> Вариант поиска:
  207: </td><td rowspan=2 colspan=2>
  208: <input type="radio" $checked{'old'} name="metod" value="old"> Простой (старый)
  209: </td><td>
  210: <input type="checkbox" $checked{'chgk'} name="type" value="chgk">&nbsp;"Что?&nbsp;Где?&nbsp;Когда?"
  211: </td><td><nobr>
  212: <input type="checkbox" $checked{'brain'} name="type" value="brain">&nbsp;"Брейн-Ринг"</nobr>
  213: </td><td>
  214: <input type="checkbox" $checked{'igp'} name="type" value="igp">&nbsp;"Интернет"
  215: </td>
  216: </tr><tr>
  217: <td>
  218: <input type="checkbox" $checked{'game'} name="type" value="game">&nbsp;"Своя&nbsp;игра"
  219: </td><td>
  220: <input type="checkbox"  $checked{'ehruditka'} name="type" value="ehruditka">&nbsp;"Эрудитка"
  221: </td><td>
  222: <input type="checkbox" $checked{'beskrylka'} name="type" value="beskrylka">&nbsp;"Бескрылка"
  223: </td>
  224: </tr><tr>
  225: <td colspan=5><input type="radio" $checked{'rus'} name="metod" value="rus"> Расширенный (с учетом грамматики, в вопросах всех типов)
  226: </td>
  227: </tr><tr>
  228: <th align="left">Искать:
  229: </td><td colspan=2>
  230: <input type="radio" $checked{'all'} name="all" value="yes">Все слова
  231: </td><td colspan=3>
  232: <input type="radio" $checked{'any'} name="all" value="no">Любое слово
  233: </td>
  234: </tr><tr>
  235: <th align="left">Поля для поиска:
  236: </td><td width="15%">
  237: <input type="checkbox" name="searchin" value="Question" $checked{'question'}>Вопрос
  238: </td><td width="15%">
  239: <input type="checkbox" name="searchin" value="Answer" $checked{'answer'}>Ответ<br> 
  240: </td><td width="15%">
  241: <input type="checkbox" name="searchin" value="Comments" $checked{'comments'}>Комментарии<br> 
  242: </td><td width="15%">
  243: <input type="checkbox" name="searchin" value="Authors" $checked{'authors'}>Автор<br>
  244: </td><td width="15%">
  245: <input type="checkbox" name="searchin" value="Sources" $checked{'sources'}>Источник<br>
  246: </td>
  247: </tr>
  248: </table>
  249: </center>
  250: 
  251: EOT
  252: .endform
  253: .hr
  254: 
  255: }
  256: 
  257: sub proxy
  258: {     
  259:       my ($dbh,$ptext,$allnf)=@_;
  260:       my $sstr=makeproxysstr($dbh,$ptext,$allnf);
  261:       return russearch($dbh,$sstr,0,$allnf);
  262: }
  263: 
  264: sub makeproxysstr {
  265:       my ($dbh,$ptext)=@_;
  266:       my $text=$$ptext;
  267:       $text=~tr/ёЁ/еЕ/;
  268:       $text=~s/(${RLrl})p(${RLrl})/$1p$2/gom;
  269:       $text=~s/p(${RLrl})/р$1/gom;
  270:       $text=~s/(${RLrl})p/$1р/gom;
  271:       $text=~s/\s+/ /gmo;
  272:       $text=~s/[^йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮQWERTYUIOPASDFGHJKLZXCVBNM0-9]/ /g;
  273:       $text=uc $text;
  274:       my @list= $text=~m/(?:(?:${RLrl})+)|(?:[A-Za-z0-9]+)/gom;
  275:       my (%c, %good,$sstr);
  276:       foreach (@list)
  277:       {
  278:            $c{$_}=count($dbh,$_)||10000;
  279:       }
  280:       my @words=sort {$c{$a}<=> $c{$b}} @list;
  281: 
  282: #      $good{$words[$_]}=1 foreach 0..4;
  283: 
  284:       foreach (@words)
  285:       {
  286:          $good{$_}=1 if $c{$_}<200;
  287:       }
  288: 
  289:       $good{$words[$_]}=0 foreach 16..$#words;
  290: 
  291:       $sstr.=" $_" foreach grep {$good{$_}} @list;
  292:       $$ptext=$sstr;
  293:       return $sstr;
  294: }
  295: 
  296: 
  297: sub russearch {
  298:             my ($dbh, $sstr, $all,$allnf)=@_;
  299:             my (@qw,@w,@tasks,$qw,@arr,$nf,$sth,@nf,$w,$where,$e,@where,%good,$i,%where,$from);
  300:             my($number,@good,$t,$task,@rho,$rank,%rank,$r2,$r1,$word,$n,@last,$good,@words,%number,$taskid);
  301:             my ($hi, $lo, $wordnumber,$query,$blob,$field,$sf,$ii);
  302:             my @frequence;
  303:             my (@arr1,@ar,@sf,@arr2);
  304: 	    my %tasks;
  305: 	    my $tasks;
  306: 	    my @verybad;
  307: 	    my %nf;
  308:             my %tasksof;
  309:             my %wordsof;
  310:             my %relevance;
  311:             my @blob;
  312:             my %count;
  313: 
  314: $sstr=~tr/йцукенгшщзхъфывапролджэячсмитьбю/ЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ/;
  315:     	    @qw=@w =split (' ', uc $sstr);
  316: 
  317: #-----------
  318:             foreach $i (0..$#w) # заполняем массив @nf начальных форм
  319:                            # $nf[$i] -- ссылка на массив возможных
  320:                            # начальных форм словоформы $i
  321:             {
  322:                 $qw= $dbh->quote (uc $w[$i]);
  323:                 $query="  select distinct w2 from nests
  324:                                 where w1=$qw";
  325: print "$query",br if $printqueries;
  326:                 $sth=$dbh -> prepare($query);
  327: 	        $sth -> execute;
  328: 	        @{$nf[$i]}=();
  329: 	        while (@arr = $sth->fetchrow)
  330: 	        {
  331: 	           push (@{$nf[$i]},$arr[0])
  332: 	        }
  333:                 $sth->finish;
  334:             }
  335: 
  336: 
  337:             my @bad=grep {!@{$nf[$_]}} 0..$#w; # @bad -- номера словоформ,
  338:                                            # которых нет в словаре
  339: 
  340:             if (@bad) #есть неопознанные словоформы
  341:             {
  342:                require  "cw.pl";
  343:                foreach $i(@bad)
  344:                {
  345:                  if (@arr=checkword($dbh,$w[$i]))
  346:                    {push (@{$nf[$i]}, @arr);}
  347:                  else
  348:                    {push (@verybad,$i);}
  349:                }
  350:             }
  351:             return () if ($all && @verybad);
  352: 
  353: 
  354:             my $kvo=0;
  355:             push @$allnf, @{$_} foreach @nf;
  356: 	    print "nf=@$allnf" if $printqueries;
  357: 
  358:             foreach $i (0..$#w) #запросы в базу...
  359:             {
  360:               @arr=@{$nf[$i]} if $nf[$i];
  361:               @arr2=@arr1=@arr;
  362: 
  363: 
  364: 
  365: 
  366:               $_= " word2question.word=".$_. ' ' foreach @arr;
  367:               $_= " nf.id=".$_. ' ' foreach @arr1;
  368: #              @arr=(0) unless @arr;
  369:               $query="select questions from word2question where". (join ' OR ', @arr);
  370: print STDERR "!$query\n",br if $printqueries;
  371: 
  372:     	      $sth=$dbh -> prepare($query);
  373:               $sth->execute;
  374: 
  375:               @blob=();
  376:               while (@arr=$sth->fetchrow)
  377:               {
  378:                 @blob=(@blob,unpack 'C*',$arr[0]);
  379:               }
  380:               $sth->finish;
  381:               $query="select number from nf where ".(join ' OR ', @arr1);
  382: print "$query\n",br if $printqueries;
  383:     	      $sth=$dbh -> prepare($query);
  384:               $sth->execute;
  385: 
  386:               while (@arr=$sth->fetchrow)
  387:               {
  388:                 $frequence[$i]+=$arr[0];
  389:               }
  390:               $sth->finish;
  391: 
  392: 
  393:               if (@blob < 4)
  394:               {
  395:                  $tasksof{$i}=undef;
  396:               } else
  397:               {
  398:                  $kvo++;
  399:                  $ii=0;
  400:                  while ($ii<$#blob)  # создаём хэш %tasksof, ключи которого --
  401:                              # номера искомых словоформ, а значения --
  402:                              # списки вопросов, в которых есть соответствующа
  403:                              # словоформа.
  404:                              # Каждый список в свою очередь также оформлен в
  405:                              # виде хэша, ключи которого -- номера вопросов,
  406:                              # а значения -- списки номеров вхождений. Вот.
  407:                  {
  408:                     ($field,$lo,$hi,$wordnumber)=@blob[$ii..($ii+3)];
  409:                     $ii+=4;
  410:                     my $addnumber=($field >> 4) << 16;
  411:                     $number=(($field >> 4) << 16)+($hi << 8) + $lo;
  412:                     $field=$fieldname{$field & 0xF};
  413:                     if ($searchin{$field})
  414:                     {
  415:                       push @{$tasksof{$i}{$number}}, $wordnumber;
  416:                                       # дополнили в хэше, висящем на
  417:                                       # словоформе $i в %tasksof список
  418:                                       # вхождений $i в вопрос $number.
  419:                       push @{$wordsof{$number}{$i}}, $wordnumber;
  420:                                       # дополнили в хэше, висящем на
  421:                                       # вопросе $number в %wordsof список
  422:                                       # вхождений $i в вопрос $number.
  423: 
  424: 
  425:                     }
  426:                  }  #while ($ii<$#blob)
  427:                }
  428:             }    #foreach $i
  429: 
  430: #print "keys tasksof", join ' ', keys %{$tasksof{0}};
  431: #Ищем пересечение или объединение списков вопросов (значений %tasksof)
  432:        	    foreach $sf (keys %tasksof)
  433:            {
  434:               $count{$_}++ foreach keys %{$tasksof{$sf}};
  435:            }
  436:              @tasks= ($all ? (grep {$count{$_}==$kvo} keys %count) :
  437:                              keys %count) ;
  438: 
  439: 
  440: print "\n\$#tasks=",$#tasks,br if $printqueries;
  441: ############ Сортировка найденных вопросов
  442: 
  443: foreach (keys %wordsof)
  444: {
  445:   $relevance{$_}=&relevance($#w,$wordsof{$_},\@frequence) if $_
  446: }
  447: 
  448: @tasks=sort {$relevance{$b}<=>$relevance{$a}} @tasks;
  449: 
  450: 
  451: ############
  452: 
  453: print "tasks=@tasks" if $printqueries;
  454: 
  455: #print "$_ $relevance{$_} | " foreach @tasks;
  456: #print br;
  457: print "allnf=@$allnf",br if $printqueries;
  458:         return  @tasks;
  459: }
  460: 
  461: 
  462: sub distance  {
  463:                  # на входе -- номера словоформ и ссылки на
  464:                  # списки вхождений. На выходе -- расстояние,
  465:                  # вычисляемое по формуле min(|b-a-pb+pa|)
  466:                  #                       pb,pa
  467:                  # (pb и pa -- позиции слов b и a)
  468:    my ($a,$b,$lista,$listb)=@_;
  469:    my ($pa,$pb,$min,$curmin);
  470:    $min=10000;
  471:    foreach $pa (@$lista)
  472:    {
  473:      foreach $pb (@$listb)
  474:      {
  475:         $curmin=abs($b-$a-$pb+$pa);
  476:         $min= $curmin if $curmin<$min;
  477:      }
  478:    }
  479:    return $min;
  480: 
  481: }
  482: 
  483: sub relevance {
  484:               # На входе -- количество искомых словоформ -1 и
  485:               # ссылка на hash, ключи которого --
  486:               # номера словоформ, а значения -- списки вхождений
  487: 
  488:        my ($n,$words,$frequence)=@_;
  489:        my $relevance=0;
  490:        my ($first,$second,$d);
  491:        foreach $first (0..$n)
  492:        {
  493:          $relevance+=scalar @{$$words{$first}}+1000+1000/$$frequence[$first]
  494: if $$words{$first};
  495:          foreach $second ($first+1..$n)
  496:          {
  497:             $d=&distance($first,$second,$$words{$first},$$words{$second});
  498:             $relevance+=($d>10?0:10-$d)*10;
  499:          }
  500:        }
  501:        return $relevance;
  502: }
  503: 
  504: 
  505: 
  506: # Returns list of QuestionId's, that have the search string in them.
  507: sub Search {
  508: 	my ($dbh, $s,$metod,$all,$allnf) = @_;
  509: 	my $sstr=$$s;
  510: 	my (@arr, @Questions, @fields);
  511: 	my (@sar, $i, $sth,$where,$query);
  512: 	if ($metod eq 'rus')
  513: 	{
  514: 	     my @tasks=russearch($dbh,$sstr,$all,$allnf);
  515: 	     return @tasks
  516: 	}
  517: 	elsif ($metod eq 'proxy')
  518: 	{
  519: 	  my @task=proxy($dbh,$s,$allnf);
  520: 	  return @task
  521: 	}
  522: 
  523: 
  524: 
  525: ###Simple and advanced query processing. Added by R7
  526: 	if ($metod eq 'simple' || $metod eq 'advanced')
  527: 	{
  528:           foreach (qw/Question Answer Sources Authors Comments/) {
  529: 		if (param($_)) {
  530: 			push @fields, $_;
  531: 		}
  532: 	   }
  533: 
  534: 	   @fields=(qw/Question Answer Sources Authors Comments/) unless scalar @fields;
  535: 	   my $fields=join ",", @fields;
  536:            my $q=new Text::Query($sstr,
  537:                  -parse => 'Text::Query::'.
  538:                    (($metod eq 'simple') ? 'ParseSimple':'ParseAdvanced'),
  539:                  -solve => 'Text::Query::SolveSQL',
  540:                  -build => 'Text::Query::BuildSQLMySQL',
  541:                  -fields_searched => $fields);
  542: 
  543:            $where=	$$q{'matchexp'};
  544:            $query= "SELECT Questionid FROM Questions
  545:                 WHERE $where";
  546:            print br."Query is: $query".br if $debug;
  547: 
  548:            $sth = $dbh->prepare($query);
  549:          } else
  550: ######
  551:          {
  552: 
  553: #	  foreach (qw/Question Answer Sources Authors Comments/) {
  554: 	  foreach (param('searchin')) {
  555: #		if (param($_)) {
  556: 			push @fields, "IFNULL($_, '')";
  557: #		}
  558: 	  }
  559: 	  @sar = split " ", $sstr;
  560: 	  for $i (0 .. $#sar) {
  561: 		$sar[$i] = $dbh->quote("%${sar[$i]}%");
  562: 	  }
  563: 	  $_.=' ' foreach (@fields); # Это чтобы последнее слово поля
  564: 	                             # не сливалось с первым словом
  565: 	                             # следующего поля, R7
  566: 	  my($f) = "CONCAT(" . join(',', @fields) . ")";
  567: 	  if (param('all') eq 'yes') {
  568: 		$sstr = join " AND $f LIKE ", @sar;
  569: 	  } else {
  570: 		$sstr = join " OR $f LIKE ", @sar;
  571:     	  }
  572:     	  
  573:    my $query;
  574:                $query="SELECT QuestionId FROM Questions
  575: 		WHERE ($f LIKE $sstr) AND (".&makewhere.") ORDER BY QuestionId";
  576: 
  577: 
  578: print $query if $printqueries;
  579: 	  $sth = $dbh->prepare($query)
  580: 	} #else -- processing old-style query (R7)
  581: 
  582: 	$sth->execute;
  583: 	while (@arr = $sth->fetchrow) {
  584: 		push @Questions, $arr[0] unless $forbidden{$arr[0]};
  585: 	}
  586:         $sth->finish;
  587: print "@Questions" if $printqueries;
  588:         
  589: 	return @Questions;
  590: }
  591: 
  592: sub makewhere {
  593:       my @type=param('type');    
  594:       my $type='';
  595: 
  596:       $type .= ($_=$TypeName{$_}) foreach @type;
  597:       my $where=' 0 ';
  598:       foreach (@type) {
  599:  	     $where.= " OR (Type ='$_') OR (Type ='$_Д') ";
  600:       } 
  601:       $where.= "OR (Type='ЧБ')" if ($type=~/Ч|Б/);
  602:       return $where;
  603: }
  604: 
  605:  # Substitute every letter by a pair (for case insensitive search).
  606:  my (@letters) = qw/аА бБ вВ гГ дД еЕ жЖ зЗ иИ йЙ кК лЛ мМ нН оО
  607:  пП рР сС тТ уУ фФ хХ цЦ чЧ шШ щЩ ьЬ ыЫ эЭ юЮ яЯ/;
  608: 
  609: sub NoCase {
  610: 	my ($sstr) = shift;                   	
  611: 	my ($res);
  612: 
  613: 	if (($res) = grep(/$sstr/, @letters)) {
  614: 		return "[$res]";
  615: 	} else {
  616: 		return $sstr;
  617: 	}
  618: }
  619: 
  620: sub PrintList {
  621:    my ($dbh,$Questions,$shablon,$was)=@_;
  622: 
  623: 	my $first=param('first') ||1;
  624: 	my $kvo=param('kvo') ||150;
  625: 
  626: 	$first=$first-($first-1)%$kvo;
  627:         my $fkvo=param('fkvo')||($#$Questions+1);
  628: 	my $last=$first+$kvo-1;
  629: 	$last=$fkvo if $fkvo<$last;
  630:         my($f,$l);
  631:         my $nav='';
  632:         my $qs=query_string;
  633: 	$qs=~s/\;/\&/g;
  634:         $qs=~s/\&first\=[^\&]+//g;
  635:         my $sstr=param('sstr')||'';
  636:         $qs=~s/sstr=[^\&]+/sstr=$sstr/;
  637:         $qs=~s/\&was=[^\&]+//;
  638:         $qs.="&was=$was" if $was;
  639:         $qs.="&fkvo=$fkvo" if $was;
  640:         if ($first>$kvo*3+1)
  641:         {
  642:            $nav.=
  643:             ("&nbsp;"x4).
  644:             a({href=>url."?".$qs."\&first=1"},"<<").("&nbsp;"x4).
  645:             a({href=>(url."?".$qs."\&first=".($first-$kvo))},"<").("&nbsp;"x4)
  646: 	}
  647:         else {$nav.='&nbsp;'x15;}
  648: 
  649:      my ($fprint,$lprint);
  650:      my $llprint=$fkvo- ($fkvo)%$kvo+1; #
  651:      if ($fkvo<=$kvo*7)
  652:      {         $fprint=1;
  653:                $lprint=$llprint;
  654:      }
  655:      elsif ($first>$kvo*3 && $fkvo-$first>$kvo*3)
  656:      {
  657:        $fprint=$first-$kvo*3;
  658:        $lprint=$first+$kvo*3;
  659:      } 
  660:      elsif  ($first<=$kvo*3)
  661:      {
  662:         $fprint=1; $lprint=6*$kvo+1;
  663:      }
  664:      else
  665:      { 
  666:            $lprint=$llprint;
  667:            $fprint=$lprint-$kvo*6
  668:      }
  669:          
  670: #        my $fprint=($first>$kvo*3) ? $first-$kvo*3 : 1;
  671: #        my $lprint=$#$Questions+1-$fprint>$kvo*7 ? $kvo*7 :$#$Questions+1;
  672: #        if ($lprint-$fprint<$kvo*6 && $fprint>1)
  673: #        {
  674: #            $fprint=$lprint-$kvo*6;
  675: #            $fprint=1 if ($fprint<=0) 
  676: #        }
  677: 
  678: 
  679: 
  680:         for($f=$fprint; $f<=$lprint; $f+=$kvo)
  681: 	{
  682: #	  next if $first-$f>$kvo*3;
  683: 	  $l=$f+$kvo-1;
  684: 	  $l=$fkvo if $l>$fkvo+1;
  685: 	  if ($f==$first) {$nav.="[$f-$l] ";}
  686: 	  else {
  687:                   $nav.= "[".a({href=>(url."?".$qs."\&first=$f")},"$f-$l")."] ";}
  688: 	}
  689:         if ($lprint+$kvo<$fkvo)
  690:         {
  691:            $nav.=
  692:             ("&nbsp;"x4).
  693:             a({href=>(url."?".$qs."\&first=".($first+$kvo))},">").("&nbsp;"x4).
  694:             a({href=>url."?".$qs."\&first=$llprint"},">>").("&nbsp;"x4)
  695:         }
  696: 
  697: 
  698: 	print "$nav".br."\n";
  699: 	for (my $i = $first; $i <= $last; $i++) {
  700: 		my $output = &PrintQuestion($dbh, $$Questions[$i-1], 1, 0, 1);
  701:                 if (param('metod') && (param('metod') eq 'rus' || param('metod') eq 'proxy'))
  702:                 {
  703: 	             $output=~s/\b($shablon)\b/\<strong\>$1\<\/strong\>/gi;
  704: 	        } else {
  705: 	             $output=~s/($shablon)/\<strong\>$1\<\/strong\>/gi;
  706: 		}
  707: 		print $output;
  708: 	}
  709: 
  710: 
  711: 	print "$nav".br."\n";
  712: 
  713: }
  714: 
  715: sub PrintSearch {
  716: 	my ($dbh, $sstr, $metod,$was) = @_;
  717: 	my $t=time;
  718: #	print h2("Поиск в базе вопросов");
  719: 	print printform;
  720: 	my @allnf;
  721: 	my @Questions;
  722: 	$was=0 if $metod eq 'proxy';
  723: 	if ($was && ($metod ne 'proxy'))
  724: 	{
  725: 	  my $sth=$dbh->prepare ("select sstr,questions,allnf from lastqueries where id=".param('was'));
  726:           $sth->execute;
  727:           my ($q,$nf);
  728: 	  ($sstr, $q,$nf)=($sth->fetchrow);
  729:           @Questions=unpack 'L*',$q; 
  730:           @allnf=unpack 'L*',$nf;        
  731:           $sth->finish;
  732:         }  
  733:         if (!$was || ($metod eq 'proxy') || (param('first')+param('kvo')>$cashednumber))
  734:         {
  735:              @Questions=&Search($dbh, \$sstr,$metod,$all,\@allnf);
  736:              my $tmp=$dbh->quote(pack("L*",@Questions[0..$cashednumber]));
  737:              my $qsstr=$dbh->quote($sstr);
  738:              my $nf=$dbh->quote(pack("L*", @allnf));
  739:              my $ss=200;
  740:              do 
  741:              {
  742:                $was=int rand(32000);
  743:              }
  744:              while (--$ss && (!$dbh->do ("insert into lastqueries (id,sstr,questions,allnf) 
  745:                          values ($was, $qsstr,$tmp,$nf)")));
  746:              print "Something is wrong...".br unless $ss;
  747:         }
  748: 
  749: 
  750: 
  751: 	print p. "Время поиска: " . (time-$t) ." сек.".p;
  752: 	my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1);
  753: 
  754:         my $shablon;
  755:         $metod='rus' if $metod eq 'proxy';
  756:         if ($metod eq 'rus')
  757:         {
  758:            my $where='0';
  759:            $where.= " or w2=$_ " foreach @allnf;
  760:            my $query="select w1 from nests where $where";
  761:            my $sth=$dbh->prepare($query);
  762: print "$query" if $printqueries;
  763: 
  764: 	   $sth->execute;
  765: 	   my @shablon;
  766: 	   while (my @arr = $sth->fetchrow)
  767: 	   {
  768: 	     push @shablon,"(?:$arr[0])";
  769: 	   }
  770: 	   $sth->finish;
  771:            $shablon= join "|", @shablon;
  772:            $shablon=~s/[её]/\[ЕЁ\]/gi;
  773: #           $shablon=~s/([йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ])/&NoCase($1)/ge;
  774:            $shablon=qr/$shablon/i;
  775:            print "!$shablon!",br if $printqueries;
  776: 
  777:         }
  778: 
  779:         $hits=param("fkvo")||$hits;
  780: 
  781: 	if ($hits =~ /1.$/  || $hits =~ /[5-90]$/) {
  782: 		$suffix = 'й';
  783: 	} elsif ($hits =~ /1$/) {
  784: 		$suffix = 'е';
  785: 	} else {
  786: 		$suffix = 'я';
  787: 	}
  788: 
  789: 	print p({align=>"center"}, "Результаты поиска на " . strong($sstr)
  790: 	. " : $hits попадани$suffix.");
  791: 
  792: 	if (param('word')) {
  793: 		$sstr = '[ 	\.\,:;]' . $sstr . '[  \.\,:\;]';
  794: 	}
  795: 
  796: #	$sstr =~ s/(.)/&NoCase($1)/ge;
  797: 
  798: 	my @sar;
  799: 	if ($metod ne 'rus') 
  800: 	{
  801: 	  my $ss=$sstr;
  802: 	  (@sar) = split(' ', $ss);
  803: 	  s/(\W)/\\$1/g foreach (@sar);
  804: 	  $shablon=join "|",@sar;
  805: 	}
  806: 	PrintList($dbh,\@Questions,$shablon,$was);
  807: }
  808: 
  809: sub PrintRandom {
  810:    my ($dbh, $type, $num, $text) = @_;
  811:    my $razd=param('razd');
  812:    my $answer=$razd?0:1;
  813:    my (@Questions) = &Get12Random($dbh, $type, $num);
  814: 	my ($output, $i) = ('', 0);
  815: 
  816: 	if ($text) {
  817: 		$output .= "	$num случайных вопросов.\n\n";
  818: 	} else {
  819: 		$output .=
  820: 			h2({align=>"center"}, "$num случайных вопросов.");
  821: 	}
  822: 
  823: 	for ($i = 0; $i <= $#Questions; $i++) {
  824: 		# Passing DB handler, question ID, print answer, question
  825: 		# number, print title, print text/html
  826: 		$output .=
  827: 			&PrintQuestion($dbh, $Questions[$i], $answer, $i + 1, 0, $text);
  828: 	}
  829: 	unless ($answer )
  830:         { 
  831:          $output.=$text?"\n".('-'x 20)."\nОтветы\n~~~~~~\n\n":h2('Ответы');
  832:          for ($i = 0; $i <= $#Questions; $i++) {
  833: 		$output .=
  834: 			&PrintQuestion($dbh, $Questions[$i], -1, $i + 1, 0, $text);
  835: 	 }
  836:         }
  837: 
  838: 	return $output;
  839: }
  840: 
  841: sub PrintEditor {
  842:        my $t=shift; #ссылка на Хэш с полями
  843:        my $ed=$$t{'Editors'}||'';
  844:        my $edname=($ed=~/\,/ ) ? "Редакторы"  : "Редактор" ;
  845:        return $ed? h4({align=>"center"},"$edname: $ed" ): '';
  846: }
  847: 
  848: sub PrintTournament {
  849:    my ($dbh, $Id, $answer) = @_;
  850: 	my (%Tournament, @Tours, $i, $list, $qnum, $imgsrc, $alt,
  851: 		$SingleTour);
  852: 	my ($output) = '';
  853: 
  854: 	%Tournament = &GetTournament($dbh, $Id) if ($Id);
  855: 
  856: 	my ($URL) = $Tournament{'URL'};
  857: 	$URL=~s/http:\/znatoki\/boris\/reports\//$newsurl/ if url=~/kulichki/;
  858: 	$URL=~s/\/znatoki\/boris\/reports\//$newsurl/ if url=~/kulichki/;;
  859: 	my ($Info) = $Tournament{'Info'};
  860: 	my ($Copyright) = $Tournament{'Copyright'};
  861: 	my $fname=$Tournament{'FileName'};
  862: 	@Tours = &GetTours($dbh, $Id);
  863: 	$list='';
  864: 	my $textid;
  865: 	if ($Id) {
  866: 		for ($Tournament{'Type'}) {
  867: 			/Г/ && do {
  868: 				$output .= h2({align=>"center"},
  869: 					      "Группа: $Tournament{'Title'} ",
  870: 					      $Tournament{'PlayedAt'}||'') . p . "\n";
  871: 				last;
  872: 			};
  873: 			/Ч/ && do {
  874: 				return &PrintTour($dbh, $Tours[0], $answer)
  875: 					if ($#Tours == 0);
  876: 
  877: 				my $title="Пакет: $Tournament{'Title'}";
  878: 				if ($Tournament{'PlayedAt'}) {
  879: 				    $title .= " $Tournament{'PlayedAt'}";
  880: 				}
  881: 
  882: 				$output .= h2({align=>"center"},
  883: 					"$title") . p . "\n";
  884: 			       $output.=&PrintEditor(\%Tournament);
  885: 				last;
  886: 			};
  887: 			/Т/ && do {
  888: 				return &PrintTour($dbh, $Id, $answer);
  889: 			};
  890: 		}
  891: 	} else {
  892: 		my ($qnum) = GetQNum($dbh);
  893: 		$output .= h2("Банк Вопросов: $qnum вопрос".&Suffix($qnum)) 
  894:                           . p . "\n";
  895: 	}
  896: 
  897: 	for ($i = 0; $i <= $#Tours; $i++) {
  898: 		%Tournament = &GetTournament($dbh, $Tours[$i]);
  899: 
  900: 		if ($Tournament{'Type'} =~ /Ч/) {
  901: 			$SingleTour = 0;
  902: 			my (@Tours) = &GetTours($dbh, $Tournament{'Id'});
  903: 			$SingleTour = 1
  904: 				if ($#Tours == 0);
  905: 		}
  906: 		if ($Tournament{'QuestionsNum'} > 0) {
  907: 			$qnum = " ($Tournament{'QuestionsNum'} вопрос" .
  908: 				&Suffix($Tournament{'QuestionsNum'}) . ")\n";
  909: 		} else {
  910: 			$qnum = '';
  911: 		}
  912: 		if ($Tournament{'Type'} =~ /Г/) {
  913: 		    $SingleTour=0;
  914: 			$imgsrc = "/icons/folder.gif";
  915: 			$alt = "[*]";
  916: 		} else {
  917: 			$imgsrc = "/icons/folder.gif";
  918: 			$alt = "[-]";
  919: 		}
  920: 
  921: 		my $textid;
  922: 		if ($textid=$Tournament{'FileName'})
  923: 		{
  924: 		   $textid=~s/\.txt//;
  925: 		}
  926: 		elsif ($textid=$Tournament{'Number'})
  927: 		  {
  928: 		      $fname=~s/\.txt//;
  929: 		      $textid="$fname.$textid";
  930: 		  }
  931: 	       else {$textid=$Tournament{'Id'}};
  932: 		
  933: 
  934: 		if ($SingleTour or $Tournament{'Type'} =~ /Т/) {
  935: 			$list .= dd(img({src=>$imgsrc, alt=>$alt})
  936: 				. " " . $Tournament{'Title'} . " " .
  937: 				    $Tournament{'PlayedAt'} . $qnum) .
  938: 				dl(
  939: 					dd("["
  940: 						. a({href=>url .  "?tour=$textid&answer=0"},
  941: 						"вопросы") . "] ["
  942:                   . a({href=>url .  "?tour=$textid&answer=1"},
  943:                   "вопросы + ответы") . "]")
  944: 				);
  945: 		} else {
  946: 			$list .= dd(a({href=>url . "?tour=$textid&comp=1"},
  947: 				img({src=>'/icons/compressed.gif', alt=>'[ZIP]', border=>1})). " " . 
  948:                                 img({src=>$imgsrc, alt=>$alt})
  949: 				. " " . a({href=>url . "?tour=$textid&answer=0"},
  950: 				$Tournament{'Title'}. " ".
  951: 					  $Tournament{'PlayedAt'}||'') . $qnum);
  952: 		}
  953: 	}
  954: 	$output .= dl($list);
  955: 
  956: 	if ($URL) {
  957: 	        if (url=~/zaba\.ru/ && $URL=~/^\//){$URL="http://info.chgk.info$URL"}
  958: 		$output .=
  959: 		p("Дополнительная информация об этом турнире - по адресу " .
  960: 			a({-'href'=>$URL}, $URL));
  961: 	}
  962: 
  963: 	if ($Copyright) {
  964: 		$output .= p("Копирайт: " .   $Copyright);
  965: 	}
  966: 
  967: 
  968: 
  969: 	if ($Info) {
  970: 		$output .= p($Info);
  971: 	}
  972: 	return $output;
  973: }
  974: 
  975: sub Suffix {
  976: 	my ($qnum) = @_;
  977: 	my ($suffix) = 'а' if $qnum =~ /[234]$/;
  978:    $suffix = '' if $qnum =~ /1$/;
  979:    $suffix = 'ов' if $qnum =~ /[567890]$/ || $qnum =~ /1.$/;
  980: 	return $suffix;
  981: }
  982: 
  983: sub IsTour {
  984: 	my ($dbh, $Id,$n) = @_;
  985: 
  986: 	my ($sth) ;
  987:         
  988:         if (defined $n) 
  989:         { $sth=$dbh->prepare ("select Id FROM Tournaments
  990:                            WHERE ParentId=$Id AND Number=$n");
  991:         }
  992:         else
  993:         {
  994:           $sth=$dbh->prepare("SELECT Id FROM Tournaments
  995: 		WHERE Id=$Id");
  996: 	}
  997: 	$sth->execute;
  998:         my $a=($sth->fetchrow)[0];
  999: 	$sth->finish;
 1000:  	return $a;
 1001: }
 1002: 
 1003: # Gets a DB handler (ofcourse) and a tour Id. Prints all the
 1004: # question of that tour, according to the options.
 1005: sub PrintTour {
 1006: 	my ($dbh, $Id, $answer) = @_;
 1007: 	my ($output, $q, $bottom, $field) = ('', 0, '', '');
 1008: 
 1009: 	my (%Tour) = &GetTournament($dbh, $Id);
 1010: 	my (@Tours) = &GetTours($dbh, $Tour{'ParentId'});
 1011: 	my (%Tournament) = &GetTournament($dbh, $Tour{'ParentId'});
 1012: 
 1013: 	return 0
 1014: 		if ($Tour{'Type'} !~ /Т/);
 1015: 
 1016: 	my ($fname)=$Tournament{'FileName'};
 1017: 	$fname=~s/\.txt//;
 1018: 	my ($qnum) = $Tour{'QuestionsNum'};
 1019: 	my ($suffix) = &Suffix($qnum);
 1020: 
 1021: 	$output .= h2({align=>"center"}, $Tournament{"Title"},
 1022: 		      $Tournament{'PlayedAt'}||'',
 1023: 		      "<br>", $Tour{"Title"} .
 1024: 		" ($qnum вопрос$suffix)\n") . p;
 1025: 	$output .=&PrintEditor(\%Tour);
 1026: 
 1027: 	my (@Questions) = &GetTourQuestions($dbh, $Id);
 1028: 	for ($q = 0; $q <= $#Questions; $q++) {
 1029: 		$output .= &PrintQuestion($dbh, $Questions[$q], $answer, 0);
 1030: 	}
 1031: 
 1032: 	$output .= hr({-'align'=>'center', -'width'=>'80%'});
 1033: 
 1034: 	if ($Tournament{'URL'}) {
 1035: 		$output .=
 1036: 		p("Дополнительная информация об этом турнире - по адресу " .
 1037: 			a({-'href'=>$Tournament{'URL'}}, $Tournament{'URL'}));
 1038: 	}
 1039: 
 1040: 	if ($Tournament{'Copyright'}) {
 1041: 		$output .= p("Копирайт: " .   $Tournament{'Copyright'});
 1042: 	}
 1043: 
 1044: 	if ($Tournament{'Info'}) {
 1045: 		$output .= p($Tournament{'Info'});
 1046: 	}
 1047: 
 1048: 	my $n=$Tour{'Number'};
 1049: 	if ($answer == 0) {
 1050: 		$bottom .=
 1051: 			"[" . a({href=>url . "?tour=$fname.$n&answer=1"}, "ответы") .  "] " . br;
 1052: 	}
 1053: 	if ($n>1) {
 1054: 		$bottom .=
 1055: 			"[" . a({href=>url . "?tour=$fname." . ($n - 1) . "&answer=0"},
 1056: 			"предыдущий тур") . "] ";
 1057: 		$bottom .=
 1058: 			"[" . a({href=>url . "?tour=$fname." . ($n - 1) . "&answer=1"},
 1059: 			"предыдущий тур с ответами") . "] " . br;
 1060: 	}
 1061: 	if (&IsTour($dbh, $Tour{'ParentId'}, $n + 1)) {
 1062: 		$bottom .=
 1063: 			"[" . a({href=>url . "?tour=$fname." . ($n + 1) . "&answer=0"},
 1064: 			"следующий тур") . "] ";
 1065: 		$bottom .=
 1066: 			"[" . a({href=>url . "?tour=$fname." . ($n + 1) . "&answer=1"},
 1067: 			"следующий тур с ответами") . "] ";
 1068: 	}
 1069: 
 1070: 	$output .=
 1071: 		p({align=>"center"}, font({size=>-1}, $bottom));
 1072: 
 1073: 	return $output;
 1074: }
 1075: 
 1076: sub PrintField {
 1077: 	my ($header, $value, $text) = @_;
 1078: 	if ($text) {
 1079: 	    $value =~ s/<[\/\w]*?>//sg;
 1080: 	} else {
 1081: 	    $value =~ s/^\s+/<br>&nbsp;&nbsp;&nbsp;&nbsp;/mg;
 1082: 	    $value =~ s/^\|([^\n]*)/<pre>$1<\/pre>/mg;
 1083: 	    $value =~ s/\s+-+\s+/&nbsp;&#0150; /mg;
 1084: 	    $value =~ s/(http:\/\/\S+[^\s\)\(\,\.])/<a href="$1">$1<\/a>/g if $header !~ /^Авто/;
 1085: #	    $value =~ s/(http:\/\/(?:\w+.)+[\w\\\~]+(\?[^\s.]+)?)/<a href="$1">$1<\/a>/g if $header !~ /^Авто/;
 1086: #	    $value =~ s/(\s)"/$1&#147;/mg;
 1087: #	    $value =~ s/^"/&#147;/mg;
 1088: #	    $value =~ s/"/&#148;/mg;
 1089: 	}
 1090: 
 1091: 
 1092: 	return $text ? "$header:\n$value\n\n" :
 1093: 		strong("$header: ") . $value . p . "\n";
 1094: }
 1095: 
 1096: # Gets a DB handler (ofcourse) and a question Id. Prints
 1097: # that question, according to the options.
 1098: sub PrintQuestion {
 1099: 	my ($dbh, $Id, $answer, $qnum, $title, $text) = @_;
 1100: 	my ($output, $titles) = ('', '');
 1101: 	my (%Question) = &GetQuestion($dbh, $Id);
 1102: 	$qnum = $Question{'Number'}
 1103: 		if ($qnum == 0);
 1104: 	if (!$text) {
 1105: 		$output .= hr({width=>"50%"}) if $answer>=0;
 1106: 		if ($title) {
 1107: 			my (%Tour) = GetTournament($dbh, $Question{'ParentId'});
 1108: 			my (%Tournament) = GetTournament($dbh, $Tour{'ParentId'});
 1109: 			my $fname=$Tournament{'FileName'};
 1110: 			$fname=~s/\.txt//;
 1111: 			$titles .=
 1112: 				dd(img({src=>"/icons/folder.open.gif"}) . " " .
 1113: 					 a({href=>url . "?tour=$fname"}, $Tournament{'Title'}, $Tournament{'PlayedAt'}||''));
 1114: 			$titles .=
 1115: 				dl(dd(img({src=>"/icons/folder.open.gif"}) . " " .
 1116: 					a({href=>url . "?tour=$fname.$Tour{Number}#$qnum"}, $Tour{'Title'})));
 1117: 		}
 1118: 		$output .= dl(strong($titles));
 1119: 	}
 1120: 
 1121: 
 1122: 	$output.= "<a NAME=\"$qnum\">" unless $text;
 1123: 
 1124: 	if ($answer>=0) {$output .=
 1125: 		&PrintField("Вопрос $qnum", $Question{'Question'}, $text);}
 1126: 	else {$output .="$qnum. "}
 1127: 	if ($answer==1|| $answer==-1) {
 1128: 		$output .=
 1129: 			&PrintField("Ответ", $Question{'Answer'}, $text);
 1130: 
 1131: 		if ($Question{'Authors'} ) {
 1132:                       my $q=$Question{'Authors'};
 1133: ###АВТОРА!!
 1134:  		      my $sth=$dbh->prepare("select Authors.CharId,Name, Surname, Nicks from Authors, A2Q
 1135:                                   where Authors.Id=Author And Question=$Id");
 1136:                        $sth->execute;
 1137:                        my ($AuthorId,$Name, $Surname,$other,$Nicks);
 1138:                       if (!$text) {
 1139:                        while ((($AuthorId,$Name, $Surname,$Nicks)=$sth->fetchrow),$AuthorId)
 1140:                        {
 1141:                           my ($firstletter)=$Name=~m/^./g;
 1142:                           $Name=~s/\./\\\./g;
 1143:                           $Name=~s/ё/[её]/g;
 1144:                           $Surname=~s/ё/[её]/g;
 1145:                            my $sha="(?:$Name\\s+$Surname)|(?:$Surname\\s+$Name)|(?:$firstletter\\.\\s*$Surname)|(?:$Surname\\s+$firstletter\\.)|(?:$Surname)";
 1146:                            if ($Nicks)
 1147:                            {
 1148:                              $Nicks=~s/^\|//;
 1149:                              foreach (split /\|/, $Nicks)
 1150:                              {
 1151:                                s/\s+/ /g;
 1152:                                s/\s+$//;
 1153:                                s/ /\\s+/g;
 1154:                                s/\./\\\./g;
 1155:                                if (s/>$//) {$sha="$sha|(?:$_)"}
 1156:                                else        {$sha="(?:$_)|$sha"}
 1157:                              }
 1158:                            }
 1159:                            $q=~s/($sha)/a({href=>url."?qofauthor=$AuthorId"},$1)/ei;
 1160:                            unless ($1) 
 1161:                              {   
 1162:                                  $q=~s/$Name/a({href=>url."?qofauthor=$AuthorId"},$1)/ei;
 1163:                              }
 1164:                        }
 1165:                       }
 1166: 			$output .= &PrintField("Автор(ы)", $q, $text);
 1167: 
 1168: 		}
 1169: 
 1170: 		if ($Question{'Sources'}) {
 1171: 			$output .= &PrintField("Источник(и)", $Question{'Sources'}, $text);
 1172: 		}
 1173: 
 1174: 		if ($Question{'Comments'}) {
 1175: 			$output .= &PrintField("Комментарии", $Question{'Comments'}, $text);
 1176: 		}
 1177: 	}
 1178: 	elsif ($answer==2) {
 1179: 	  my $text=$Question{'Answer'};
 1180: 	  $text=~s/\n/<option>/mg;
 1181: 	  $output.="<select><option selected>Ответ:<option>$text</select>";
 1182: 	  $text=$Question{'Comments'}||'';
 1183: 	  if ($text) {
 1184:              $text=~s/\n/<option>/mg;
 1185: 	     $output.="<select><option selected>Комментарий:<option>$text</select>"
 1186: 	  }
 1187: 	} 
 1188: 	elsif ($answer==3) {
 1189:         $output.=  <<EOTT
 1190: 	  <div align=right STYLE="cursor:hand;" OnStart="toggle(document.all.HideShow$qnum);" OnClick="toggle(document.all.HideShow$qnum);">
 1191: 	  <font size=-2 color=red> Показать/убрать ответ</font></div>
 1192: 	  <span style="display:none" id=HideShow$qnum>
 1193: EOTT
 1194:           .&PrintField("Ответ", $Question{'Answer'}, $text);
 1195: 		if ($Question{'Authors'}) {
 1196: 			$output .= &PrintField("Автор(ы)", $Question{'Authors'}, $text);
 1197: 		}
 1198: 		if ($Question{'Sources'}) {
 1199: 			$output .= &PrintField("Источник(и)", $Question{'Sources'}, $text);
 1200: 		}
 1201: 
 1202: 		if ($Question{'Comments'}) {
 1203: 			$output .= &PrintField("Комментарии", $Question{'Comments'}, $text);
 1204: 		}
 1205: 
 1206: 
 1207: 
 1208: $output.="</span>"
 1209: 
 1210: 	}
 1211: 	$output=~s/\(pic: ([^\)]*)\)/<p><img src="\/znatoki\/images\/db\/$1"><p>/g unless $text;
 1212: 	my $qid=param('tour') ? (param('tour').".$Question{'Number'}" ): '';
 1213: 
 1214: 	$output.=br.a({href=> url."?metod=proxy&
 1215: qid=$qid"}, 'Близкие вопросы').p
 1216:              if $answer>0 && !$text && $qid;
 1217: 	return $output;
 1218: }
 1219: 
 1220: # Returns the total number of questions currently in the DB.
 1221: sub GetQNum {
 1222: 	my ($dbh) = @_;
 1223: 	my ($sth) = $dbh->prepare("SELECT COUNT(*) FROM Questions");
 1224: 	$sth->execute;
 1225: 	my $tmp=($sth->fetchrow)[0];
 1226:         $sth->finish;
 1227:  	return $tmp;
 1228: }
 1229: sub GetMaxQId {
 1230: 	my ($dbh) = @_;
 1231: 	my ($sth) = $dbh->prepare("SELECT MAX(QuestionId) FROM Questions");
 1232: 	$sth->execute;
 1233: 	my $tmp=($sth->fetchrow)[0];
 1234:         $sth->finish;
 1235:  	return $tmp;
 1236: 
 1237: }
 1238: 
 1239: # Returns Id's of 12 random questions
 1240: sub Get12Random {
 1241:    my ($dbh, $type, $num) = @_;
 1242: 	my ($i, @questions, $q, $t, $sth);
 1243: 	my ($qnum) = &GetMaxQId($dbh);
 1244: 	my (%chosen);
 1245: 	srand;
 1246: 	my $where=0;
 1247: 	my $r=int (rand(10000));
 1248: 
 1249: 	foreach (split '', $type)
 1250:         {
 1251:  	   $where.= " OR (Type ='$_') OR (Type ='$_Д') ";
 1252:  	}
 1253:         $where.= "OR (Type='ЧБ')" if ($type=~/Ч|Б/);
 1254: 
 1255:    $q="select QuestionId, QuestionId/$r-floor(QuestionId/$r) as val 
 1256:        from Questions where $where order by val limit $num";
 1257: # Когда на куличках появится mysql >=3.23 надо заменить на order by rand();
 1258: 
 1259:    $sth=$dbh->prepare($q);
 1260:    $sth->execute;
 1261:    while (($i)=$sth->fetchrow)
 1262:    {
 1263:       push @questions,$i;
 1264:    }
 1265:    $sth->finish;
 1266:     for ($i=@questions; --$i;){ 
 1267:        my $j=rand ($i+1); 
 1268:        @questions[$i,$j]=@questions[$j,$i] unless $i==$j;
 1269:     }
 1270:    return @questions;
 1271: }
 1272: 
 1273: sub Include_virtual {
 1274: 	my ($fn, $output) = (@_, '');
 1275: 
 1276: 	open F , $fn
 1277: 		or return; #die "Can't open the file $fn: $!\n";
 1278: 
 1279: 	while (<F>) {
 1280: 		if (/<!--#include/o) {
 1281: 			s/<!--#include virtual="\/(.*)" -->/&Include_virtual($1)/e;
 1282: 		}
 1283: 		if (/<!--#exec/o) {
 1284: 			s/<!--#exec.*cmd\s*=\s*"([^"]*)".*-->/`$1`/e;
 1285: 		}
 1286: 		$output .= $_;
 1287: 	}
 1288: 	return $output;
 1289: }
 1290: 
 1291: sub PrintArchive {
 1292: 	my($dbh, $Id) = @_;
 1293: 	my ($output, @list, $i);
 1294: 
 1295: 	my (%Tournament) = &GetTournament($dbh, $Id);
 1296: 	my (@Tours) = &GetTours($dbh, $Id);
 1297: 	if ($Tournament{'Type'} =~ /Г/ || $Id == 0) {
 1298: 		for ($i = 0; $i <= $#Tours; $i++) {
 1299: 			push(@list ,&PrintArchive($dbh, $Tours[$i]));
 1300: 		}
 1301: 		return @list;
 1302: 	}
 1303: #	return "$SRCPATH/$Tournament{'FileName'} ";
 1304: 	return "$TMPDIR/$Tournament{'FileName'} ";
 1305: }
 1306: 
 1307: sub PrintAll {
 1308: 	my ($dbh, $Id,$fname) = @_;
 1309: 	my ($output, $list, $i);
 1310: 
 1311: 	my (%Tournament) = &GetTournament($dbh, $Id);
 1312: 	my (@Tours) = &GetTours($dbh, $Id);
 1313: 	my ($New) = ($Id and $Tournament{'Type'} eq 'Ч' and
 1314: 		&NewEnough($Tournament{"CreatedAt"})) ?
 1315: 		img({src=>"/znatoki/dimrub/db/new-sml.gif", alt=>"NEW!"}) : "";
 1316: 
 1317: 	if ($Id == 0) {
 1318: 		$output = h3("Все турниры");
 1319: 	} else {
 1320: 	         my $textid;
 1321: 		 if ($textid=$Tournament{'FileName'})
 1322: 		 {
 1323: 		   $textid=~s/\.txt//;
 1324: 		 }
 1325: 		 elsif ($textid=$Tournament{'Number'})
 1326: 		 {
 1327: 		      $fname=~s/\.txt//;
 1328: 		      $textid="$fname.$textid";
 1329: 		 }
 1330: 	         else {$textid=$Tournament{'Id'}};
 1331: 
 1332: 
 1333: 		$output .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .
 1334:       " " . a({href=>url . "?tour=$textid&answer=0"},
 1335:       $Tournament{'Title'}) ." " . ($Tournament{'PlayedAt'}||'') . " $New");
 1336: 	}
 1337: 	if ($Id == 0 or $Tournament{'Type'} =~ /Г/ or $Tournament{'Type'} eq '') {
 1338: 		for ($i = 0; $i <= $#Tours; $i++) {
 1339: 			$list .= &PrintAll($dbh, $Tours[$i],$Tournament{'FileName'});
 1340: 		}
 1341: 		$output .= dl($list);
 1342: 	}
 1343: 	return $output;
 1344: }
 1345: 
 1346: sub PrintDates {
 1347: 	my ($dbh) = @_;
 1348: 	my ($from) = param('from_year') . "-" . param('from_month') .
 1349: 		"-" .  param('from_day');
 1350: 	my ($to) = param('to_year') . "-" . param('to_month') . "-" .  param('to_day');
 1351: 	$from = $dbh->quote($from);
 1352: 	$to = $dbh->quote($to);
 1353: 	my ($sth) = $dbh->prepare("
 1354: 		SELECT DISTINCT Id
 1355: 		FROM Tournaments
 1356: 		WHERE PlayedAt >= $from AND PlayedAt <= $to
 1357: 		AND Type = 'Ч'
 1358: 	");
 1359: 	$sth->execute;
 1360: 	my (%Tournament, @array, $output, $list);
 1361: 
 1362: 	$output = h3("Список турниров, проходивших между $from и $to.");
 1363: 	while (@array = $sth->fetchrow) {
 1364: 		next
 1365: 			if (!$array[0]);
 1366: 		%Tournament = &GetTournament($dbh, $array[0]);
 1367:       $list .= dd(img({src=>"/icons/folder.gif", alt=>"[*]"}) .
 1368:       " " . a({href=>url . "?tour=$Tournament{'Id'}&answer=0"},
 1369:       $Tournament{'Title'}, $Tournament{'PlayedAt'}||''));
 1370: 	}
 1371:         $sth->finish;
 1372: 	$output .= dl($list);
 1373: 	return $output;
 1374: }
 1375: 
 1376: sub PrintQOfAuthor
 1377: {
 1378: 
 1379:     my ($dbh, $id) = @_;
 1380:     unless ($id=~/^\d+$/) {
 1381:       $id=$dbh->quote($id);
 1382:       my $sth =  $dbh->prepare("SELECT Id FROM Authors WHERE CharId=$id");
 1383:       $sth->execute;
 1384:       ($id)=$sth->fetchrow;
 1385:       $sth->finish;
 1386:     }
 1387:     $id=$dbh->quote($id);
 1388: 
 1389:     my $sth =  $dbh->prepare("SELECT  Name, Surname FROM Authors WHERE Id=$id");
 1390:     $sth->execute;
 1391:     my ($name,$surname)=$sth->fetchrow;
 1392: 
 1393:     $sth =  $dbh->prepare("SELECT Question FROM A2Q WHERE Author=$id");
 1394:     $sth->execute;
 1395:     my $q;
 1396:     my @Questions;
 1397:     while (($q)=$sth->fetchrow,$q)
 1398:      {push @Questions,$q unless $forbidden{$q}}
 1399:     $sth->finish;
 1400: 
 1401:     my ($output, $i, $suffix, $hits) = ('', 0, '', $#Questions + 1);
 1402: 
 1403:     if ($hits =~ /1.$/  || $hits =~ /[5-90]$/) {
 1404: 		$suffix = 'й';
 1405: 	} elsif ($hits =~ /1$/) {
 1406: 		$suffix = 'е';
 1407: 	} else {
 1408: 		$suffix = 'я';
 1409: 	}
 1410: #	print h2("Поиск в базе вопросов");
 1411: 	print printform;
 1412: 	print p({align=>"center"}, "Автор ".strong("$name $surname. ")
 1413: 	. " : $hits попадани$suffix.");
 1414: 
 1415: 
 1416: #	for ($i = 0; $i <= $#Questions; $i++) {
 1417: #		$output = &PrintQuestion($dbh, $Questions[$i], 1, $i + 1, 1);
 1418: #		print $output;
 1419: #	}
 1420:         PrintList($dbh,\@Questions,'gdfgdfgdfgdfg');
 1421: }
 1422: 
 1423: 
 1424: sub PrintAuthors
 1425: {
 1426:      my ($dbh,$sort)=@_;
 1427:      my($output,$out1,@array,$sth);
 1428:      if ($sort eq 'surname')
 1429:      {
 1430:         $sth =
 1431:              $dbh->prepare("SELECT Id, Name, Surname, QNumber FROM Authors order by Surname, Name");
 1432:      }
 1433:      elsif($sort eq 'name')
 1434:      {
 1435:         $sth =
 1436:              $dbh->prepare("SELECT Id, Name, Surname, QNumber FROM Authors order by Name, Surname");
 1437:      }
 1438:      else
 1439:      {
 1440:         $sth =
 1441:              $dbh->prepare("SELECT Id, Name, Surname, QNumber FROM Authors Order by QNumber DESC, Surname");
 1442:      }
 1443: 
 1444:      $output.=h2("Авторы вопросов")."\n";
 1445:      $output.="<TABLE>";
 1446: 
 1447: 
 1448:      $sth->execute;
 1449:      $output.=Tr(th[a({href=>url."?authors=name"},"Имя")
 1450: .", ".
 1451: a({href=>url."?authors=surname"},"фамилия")
 1452:      , a({href=>url."?authors=kvo"},"Количество вопросов")]);
 1453: 
 1454:      $out1='';
 1455: 
 1456:      my $ar=$sth->fetchall_arrayref;
 1457: 
 1458:      $sth->finish;
 1459: 
 1460: 
 1461:     foreach my $arr(@$ar)
 1462:      {
 1463: 
 1464:            my ($id,$name,$surname,$kvo)=@$arr;
 1465:            if (!$name || !$surname) {#print "Opanki at $id\n"
 1466:               } else
 1467:            {
 1468:              my $add=Tr(td([a({href=>url."?qofauthor=$id"},"$name $surname"), $kvo]))."\n";
 1469:              print STDERR $add;
 1470:              $output.=$add;
 1471:            }
 1472:      }
 1473:      $output.="</TABLE>";
 1474:      $sth->finish;
 1475:      return $output;
 1476: }
 1477: 
 1478: 
 1479: sub WriteFile {
 1480:   my ($dbh,$fname) = @_;
 1481:   $fname=~s/\s+$//;
 1482:   $fname=~s/^\s+//;
 1483:   $fname=~s/\.txt$//;
 1484:   $fname=~s/.*\/(\w+)/$1/;
 1485: 
 1486:   my $query= "SELECT Id, Title, Copyright, Info, URL, 
 1487:                       Editors, EnteredBy, PlayedAt, CreatedAt 
 1488:                      from Tournaments where FileName=".$dbh->quote("$fname.txt");
 1489:   my $sth=$dbh->prepare($query);
 1490:   my (%Question,%editor,%qnumber,%copyright,%author,%vid,%tourtitle);
 1491:   $sth->execute;
 1492:   my ($Id, $Title, $Copyright, $Info, $URL, 
 1493:    $Editors, $EnteredBy, $PlayedAt, $CreatedAt)=
 1494:       $sth->fetchrow;
 1495:   return -1 unless $Id;
 1496:   open (OUT, ">$TMPDIR/$fname.txt") || print STDERR "Error in $fname.txt\n";
 1497:   print OUT "Чемпионат:\n$Title\n\n";
 1498:   my $date=$PlayedAt||'00-00-00';
 1499:   my ($year,$month,$day)=split /-/, $date;
 1500: #  $month=0,$date=0 if $year && $month==1 && $day==1;
 1501:   my $pdate=sprintf("%02d-%3s-%4d",$day,$months[$month],$year);
 1502: 
 1503:   print OUT "Дата:\n$pdate\n\n" if $date;
 1504: 
 1505:   print OUT "URL:\n$URL\n\n" if $URL;
 1506: 
 1507:   print OUT "Инфо:\n$Info\n\n" if $Info;
 1508: 
 1509:   print OUT "Копирайт:\n$Copyright\n\n" if $Copyright;
 1510: 
 1511:   print OUT "Редактор:\n$Editors\n\n" if $Editors;
 1512: 
 1513: 
 1514:   $query= "SELECT Id, Title, Copyright, Editors from Tournaments where ParentId=$Id order by Id";
 1515:   $sth=$dbh->prepare($query);
 1516:   $sth->execute;
 1517:   my ($tourid,$tourtitle,$cright,$editor,@tours,$vid,$author,$tourauthor);
 1518: 
 1519: 
 1520:   while (($tourid,$tourtitle,$cright,$editor)=$sth->fetchrow,$tourid)
 1521:   {
 1522: #    $text{$tourid}="Тур:\n$tourtitle\n\n";
 1523:     $query= "SELECT * from Questions where ParentId=$tourid order by QuestionId";
 1524:     my $sth1=$dbh->prepare($query);
 1525:     $sth1->execute;
 1526:     push(@tours,$tourid);
 1527:     $tourtitle{$tourid}=$tourtitle;
 1528:     $copyright{$tourid}=$cright;
 1529:     $editor{$tourid}=$editor;
 1530:     $vid='';
 1531:     my $author='';
 1532:     my $eqauthor=1;
 1533:     my $qnumber=0;
 1534:     my @arr;
 1535:     while ( (@arr=$sth1->fetchrow), $arr[0])
 1536:     {
 1537: 	my($i, $name);
 1538: 	$i=0;
 1539: 	$qnumber++;
 1540: 	foreach $name (@{$sth1->{NAME}}) {
 1541: 	        if ($arr[$i]) {
 1542:   	           $arr[$i]=~s/^(.*?)\s*$/$1/;
 1543: 		   $Question{$tourid}[$qnumber]{$name} = $arr[$i];
 1544: 		} else {
 1545:   	            $Question{$tourid}[$qnumber]{$name} = 
 1546:                    ''}
 1547:                 $i++;
 1548: 	}
 1549: 	if ($vid)
 1550:         {
 1551:           if ($vid ne $Question{$tourid}[$qnumber]{'Type'}) {print STDERR "Warning: Different types for Tournament $tourid\n"}
 1552:         } else 
 1553:         {
 1554:             $vid=$Question{$tourid}[$qnumber]{'Type'};
 1555:         } 
 1556: 
 1557: 	if ($author)
 1558:         {
 1559:           if ($author ne $Question{$tourid}[$qnumber]{'Authors'})  
 1560:           {
 1561:              $eqauthor=0;
 1562:           }
 1563:         } else 
 1564:         {
 1565:             $author=$Question{$tourid}[$qnumber]{'Authors'};
 1566:             $eqauthor=0 unless $author;
 1567:         } 
 1568:     }
 1569:     $vid{$tourid}=$vid;
 1570:     $qnumber{$tourid}=$qnumber;
 1571:     $author{$tourid}=$eqauthor ? $author : '';
 1572:   }
 1573: 
 1574: 
 1575:   $vid='';
 1576:   my $eqvid=1;
 1577:   my $eqauthor=1;
 1578:   foreach (@tours)
 1579:   {
 1580:      $vid||=$vid{$_};
 1581:      if ($vid{$_} ne $vid)
 1582:      {
 1583:         $eqvid=0;
 1584:      }
 1585:      $author||=$author{$_};
 1586:      if (!$author{$_} || ($author{$_} ne $author))
 1587:      {
 1588:         $eqauthor=0;
 1589:      }
 1590:   }
 1591:   
 1592:   print OUT "Вид:\n$vid\n\n" if $eqvid;
 1593:   print OUT "Автор:\n$author\n\n" if $eqauthor;
 1594: 
 1595:   foreach my $tour(@tours)
 1596:   {
 1597:      print OUT "Тур:\n$tourtitle{$tour}\n\n";
 1598:      print OUT "Вид:\n$vid{$tour}\n\n" if  !$eqvid;
 1599:      print OUT "Копирайт:\n$copyright{$tour}\n\n" if $copyright{$tour} && ($copyright{$tour} ne $Copyright);
 1600:      print OUT "Редактор:\n$editor{$tour}\n\n" if $editor{$tour} && ($editor{$tour} ne $Editors);
 1601:      $tourauthor=0;
 1602:      if (!$eqauthor && $author{$tour})
 1603:      { 
 1604:        print OUT "Автор:\n$author{$tour}\n\n";
 1605:        $tourauthor=1;
 1606:      }
 1607:      foreach my $q(1..$qnumber{$tour})
 1608:      {
 1609:         print OUT "Вопрос $q:\n".$Question{$tour}[$q]{'Question'}."\n\n";
 1610: 	print OUT  "Ответ:\n".$Question{$tour}[$q]{'Answer'}."\n\n";
 1611: 	print OUT  "Автор:\n".$Question{$tour}[$q]{'Authors'}."\n\n" 
 1612:                if !$tourauthor && !$eqauthor && $Question{$tour}[$q]{'Authors'};
 1613: 	print OUT  "Комментарий:\n".$Question{$tour}[$q]{'Comments'}."\n\n" 
 1614:                if $Question{$tour}[$q]{'Comments'};
 1615: 	print OUT "Источник:\n".$Question{$tour}[$q]{'Sources'}."\n\n" 
 1616:                if $Question{$tour}[$q]{'Sources'};
 1617: 	print OUT "Рейтинг:\n".$Question{$tour}[$q]{'Rating'}."\n\n" 
 1618:                if $Question{$tour}[$q]{'Rating'};
 1619: 
 1620:      }
 1621:   }
 1622: 
 1623:   close OUT;
 1624: 
 1625: 
 1626: 
 1627: }
 1628: 
 1629: 
 1630: MAIN:
 1631: {
 1632:         
 1633: 	setlocale(LC_CTYPE,'russian');
 1634: 	my($i, $tour);
 1635: 	my($text) = (param('text')) ? 1 : 0;
 1636: 	if ($text) {
 1637: 		print header('text/plain');
 1638: 	} else {print header;}
 1639: 
 1640: 	my($dbh) = DBI->connect("DBI:mysql:chgk", "piataev", "")
 1641: 		or do {
 1642: 			print h1("Временные проблемы") . "База вопросов временно не
 1643: 			работает. Заходите попозже.";
 1644: 			print &Include_virtual("../dimrub/db/reklama.html");
 1645: 		    print end_html;
 1646: 			die "Can't connect to DB chgk\n";
 1647: 		};
 1648: 	  my $sstr=param('sstr');
 1649: 	  if (param('qid')) {
 1650: 	      my $sth;
 1651: 	      my $qid=param('qid');
 1652: 		if ($qid !~ /^[0-9]*$/) {
 1653:                     my ($fname,$t,$n)= split /\./ , $qid;
 1654:                     $n=$t,$t='' unless $n;
 1655: 		    if ($n)
 1656: 		    {
 1657: 	                $sth = $dbh->prepare(
 1658:                        "SELECT t2.Id FROM Tournaments as t1, 
 1659:                         Tournaments as t2 
 1660: 			WHERE t1.FileName = '$fname.txt'
 1661:                         AND t1.Id=t2.ParentId AND t2.Number=$t");
 1662: 		    }	
 1663: 		    else 
 1664: 		        {
 1665:                           $sth = $dbh->prepare("SELECT Id FROM Tournaments
 1666: 			             WHERE FileName = '$fname.txt'");
 1667: 			}
 1668: 		    $sth->execute;
 1669: 	            $tour = ($sth->fetchrow)[0];
 1670:                     $sth->finish;
 1671: 	            $sth = $dbh->prepare(
 1672:                        "SELECT QuestionId FROM 
 1673:                         Questions 
 1674: 			WHERE ParentId=$tour AND 
 1675:                         Questions.Number=$n");
 1676: 		        $sth->execute;
 1677: 	                $qid = ($sth->fetchrow)[0];
 1678: 		}
 1679:               my $query="SELECT Question, Answer from Questions where QuestionId=$qid";
 1680: 	      $sth=$dbh->prepare($query);
 1681: 	      $sth->execute;
 1682: 	      $sstr= join ' ',$sth->fetchrow;
 1683:               $sth->finish;
 1684: 	      $searchin{'Question'}=1;
 1685: 	      $searchin{'Answer'}=1;
 1686:               $sstr=~tr/ёЁ/еЕ/;
 1687:               $sstr=~s/[^йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮa-zA-Z0-9]/ /gi;
 1688:               $proxysstr=$sstr;
 1689:               $proxysstr=makeproxysstr($dbh,\$proxysstr);
 1690:  	}
 1691: 
 1692: 
 1693: 	if (!param('comp') and !param('sqldump') and !$text) {
 1694: 	   my $title="Результаты поиска на \"". ($proxysstr||$sstr) .'"' 
 1695:                                                     if ($proxysstr||$sstr);
 1696:            $title||="База вопросов";
 1697: 
 1698: 	   print start_html(-"title"=>$title,
 1699: 	           -author=>'dimrub@icomverse.com',
 1700: 	           -bgcolor=>'#fff0e0',
 1701: 				  -vlink=>'#800020');
 1702: print "<style>
 1703: td	{font-size: x-small; font-family : sans-serif}
 1704: th	{font-size: x-small; font-family : sans-serif}
 1705: </style>\n";
 1706: 
 1707: 		print &Include_virtual("../dimrub/db/reklama.html");
 1708: 	}
 1709: 
 1710: 
 1711: 
 1712: 
 1713:         if (param('hideequal')) {
 1714: 	           my ($sth)=  $dbh -> prepare("select first, second FROM equalto");
 1715: 	           $sth -> execute;
 1716: 	           while ( my  ($first, $second)=$sth -> fetchrow)
 1717:                   {
 1718:                        $forbidden{$first}=1;
 1719:                   }
 1720:                   $sth->finish;
 1721:         }
 1722: 		$tour = (param('tour')) ? param('tour') : 0;
 1723: 		my $sth;
 1724: 		if ($tour !~ /^[0-9]*$/) {
 1725: 		    if ($tour=~/\./)
 1726: 		    {
 1727: 		        my ($fname,$n)= split /\./ , $tour;
 1728: 
 1729: 	                $sth = $dbh->prepare(
 1730:                        "SELECT t2.Id FROM Tournaments as t1, 
 1731:                         Tournaments as t2 
 1732: 			WHERE t1.FileName = '$fname.txt'
 1733:                         AND t1.Id=t2.ParentId AND t2.Number=$n");
 1734: 		    }	
 1735: 		    else 
 1736: 		        {
 1737:                           $sth = $dbh->prepare("SELECT Id FROM Tournaments
 1738: 			             WHERE FileName = '$tour.txt'");
 1739: 			}
 1740: 		    $sth->execute;
 1741: 	            $tour = ($sth->fetchrow)[0];
 1742:                     $sth->finish;
 1743: 		}
 1744: 
 1745: 
 1746: 	if (param('rand')) {
 1747: 		my ($type, $qnum) = ('', 12);
 1748: 		$type.=$TypeName{$_} foreach param('type');
 1749: #		$type .= 'Б' if (param('brain'));
 1750: #		$type .= 'Ч' if (param('chgk'));
 1751: 		$qnum = param('qnum') if (param('qnum') =~ /^\d+$/);
 1752: 		$qnum = 0 if (!$type);
 1753: 		my $Email;
 1754: 		if (($Email=param('email')) && -x $SENDMAIL &&
 1755: 		open(F, "| $SENDMAIL $Email")) {
 1756: 			my ($mime_type) = $text ? "plain" : "html";
 1757: 			print F <<EOT;
 1758: To: $Email
 1759: From: olegstepanov\@mail.ru
 1760: Subject: Sluchajnij Paket Voprosov "Chto? Gde? Kogda?"
 1761: MIME-Version: 1.0
 1762: Content-type: text/$mime_type; charset="koi8-r"
 1763: 
 1764: EOT
 1765: 			print F &PrintRandom($dbh, $type, $qnum, $text);
 1766: 			close F;
 1767: 			print "Пакет случайно выбранных вопросов послан по адресу $Email. Нажмите
 1768: 			на <B>Reload</B> для получения еще одного пакета";
 1769: 		} else {
 1770: 			print &PrintRandom($dbh, $type, $qnum, $text);
 1771: 		}
 1772: 	}
 1773: 	  elsif (param('authors')){
 1774:                 print &PrintAuthors($dbh,param('authors'));
 1775:         }
 1776:           elsif (param('qofauthor')){
 1777:                 &PrintQOfAuthor($dbh,param('qofauthor'));
 1778:         }
 1779:           elsif (param('sstr')||param('was')) {
 1780: 		&PrintSearch($dbh, $sstr||' ', param('metod')||'',param('was'));
 1781: 		$dbh->do("delete from lastqueries where
 1782:                       (TO_DAYS(NOW()) - TO_DAYS(t) >= 2) OR
 1783: 		           (time_to_sec(now())-time_to_sec(t) >3600)")
 1784: 	} 
 1785: 	  elsif (param('qid')) {
 1786:  	      &PrintSearch($dbh, $sstr||'', 'proxy');
 1787:  	}
 1788:  	elsif (param('getfile')){
 1789:           print &writefile
 1790:  	} elsif (param('all')) {
 1791: 		print &PrintAll($dbh, 0);
 1792: 	} elsif (param('from_year') && param('to_year')) {
 1793: 		print &PrintDates($dbh);
 1794: 	} elsif (param('comp')) {
 1795:             print "Content-Type: application/octet-stream\n";
 1796:             print "Content-Type: application/force-download\n";
 1797:             print "Content-Type: application/download\n";
 1798:             print "Content-Type: application/x-zip-compressed; name=db.zip\n";
 1799:             print "Content-Disposition: attachment; filename=db.zip \n\n";
 1800: #	    print header(
 1801: #			 -'Content-Type' => 'application/x-zip-compressed; name="db.zip"',
 1802: #			 -'Content-Type' => 'application/zip',
 1803: #			 -'Content-Disposition' => 'attachment; filename="db.zip"'
 1804: #			 );
 1805: 	    $tour ||= 0;
 1806: 	    my (@files) = &PrintArchive($dbh, $tour);
 1807: 	    WriteFile($dbh,$_) foreach @files;
 1808: #	    open F, "$ZIP -j - $SRCPATH/COPYRIGHT @files |";
 1809: 	    open F, "$ZIP -j - @files |";
 1810: 	    binmode(F);
 1811: 	    binmode(STDOUT);
 1812: 	    print (<F>);
 1813: 	    close F;
 1814: 	    $dbh->disconnect;
 1815: 	    exit;
 1816: 	} elsif (param('sqldump')) {
 1817: 	    print header(
 1818: 			 -'Content-Type' => 'application/x-zip-compressed; name="dump.zip"',
 1819: 			 -'Content-Disposition' => 'attachment; filename="dump.zip"'
 1820: 			 );
 1821: 	    open F, "$ZIP -j - $DUMPFILE |";
 1822: 	    print (<F>);
 1823: 	    close F;
 1824: 	    $dbh->disconnect;
 1825: 	    exit;
 1826: 
 1827: 	} else {
 1828: 		my $QuestionNumber=0;
 1829: 		my $qnum;
 1830: 		if ($qnum=param('qnumber')){
 1831:       	          my ($sth) = $dbh->prepare("SELECT QuestionId FROM Questions
 1832: 		     WHERE ParentId=$tour AND Number=$qnum");
 1833: 		  $sth->execute;
 1834: 		  $QuestionNumber=($sth->fetchrow)[0]||0;
 1835: 	        }
 1836: 	        if ($QuestionNumber) {
 1837: 		  print &PrintQuestion($dbh, $QuestionNumber, param('answer')||0, $qnum, 1);
 1838: #                                        $dbh, $Id, $answer, $qnum, $title, $text
 1839: 		} else  {
 1840:   		   print &PrintTournament($dbh, $tour, param('answer'));
 1841:   		}
 1842: 	}
 1843: 	if (!$text) {
 1844: 		print &Include_virtual("../dimrub/db/footer.html");
 1845: 		print p."<center><font size=-2>Обновление: ".&Include_virtual("../dimrub/db/date")."</center></font>";
 1846: print <<EEE
 1847:   <SCRIPT LANGUAGE="JavaScript">
 1848: function toggle(e) {
 1849:   if (e.style.display == "none") {
 1850:      e.style.display="";
 1851:   } else {
 1852:      e.style.display = "none";
 1853:  }
 1854: }
 1855: </SCRIPT>
 1856: EEE
 1857: ;
 1858: #		print end_html;
 1859: 	}
 1860: 	$dbh->disconnect;
 1861: }

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