#!/usr/bin/perl
=head1 NAME
dbchgk.pm - модуль для работы с базой
=head1 SYNOPSIS
use chgkfiles.pm
=head1 DESCRIPTION
Работа с базой
=head1 AUTHOR
Роман Семизаров
=cut
package dbchgk;
use DBI;
use Exporter;
use vars qw(@ISA @EXPORT);
@ISA=qw(Exporter);
@EXPORT = qw(&getbase &getquestions &closebase &getrow $z &in2out &getall &addnf &out2in &mydo
&getequalto &forbidden &getquestion &checktable &addword2task &addnest &getwordkeys &getflag &addword2task
&updateword2question &knownword &incnf &searchmark &knownnf &getnests
&packword &getnfnumbers &getword2question &addauthors) ;
my $z;
my $qbase;
BEGIN {do "chgk.cnf";
$qbase = DBI -> connect ("DBI:mysql:$base",'piataev',undef);
};
sub searchmark
{
my $a=$_[0];
$qbase->do ("UPDATE Questions SET ProcessedBySearch=1 WHERE QuestionId=$a")
}
sub knownword
{
my $a=$qbase ->quote (uc $_[0]);
my $select = "select distinct w2 from nests where w1=$a";
print "$select\n" if $debug;
my $z= $qbase -> prepare($select);
$z -> execute;
my @res;
while ( my @ar=$z -> fetchrow)
{
push (@res,$ar[0])
}
return @res;
}
sub knownnf
{
my $a=$qbase ->quote (uc $_[0]);
my $select = "select id from nf where word=$a";
print "$select\n" if $debug;
my $z= $qbase -> prepare($select);
$z -> execute;
my @ar=$z -> fetchrow;
return $ar[0];
}
sub incnf
{
my $a=$_[0];
my $b=$_[1]||1;
$qbase -> do ("UPDATE nf SET number=number+$b WHERE id=$a")
}
sub getbase
{
my $a=join(", ",@_);
my $select="select $a FROM Questions WHERE QuestionId<=$qnumber";
print "$select\n" if $debug;
$z= $qbase -> prepare($select);
$z -> execute;
}
sub getquestions
{
my $cond=pop @_;
my $a=join(", ",@_);
my $select="select $a FROM Questions WHERE QuestionId<=$qnumber AND ($cond)";
print "$select\n" if $debug;
$z= $qbase -> prepare($select);
$z -> execute;
}
sub getword2question
{
my $select='select word, questions FROM word2question';
print "$select\n";
$z= $qbase -> prepare($select);
$z -> execute;
}
sub addword2task
{
($w1,$w2)=@_;
$w2=$qbase -> quote ($w2);
$qbase -> do("insert into word2question (word,questions) values ($w1,$w2)");
}
sub addauthors
{
my ($charid,$name,$surname,$questions,$nicks,$forbidden)=@_;
$_=$qbase ->
quote($_) foreach ($charid,$name,$surname,$nicks);
my $kvo=scalar grep {!$$forbidden{$_}} @$questions;
my $query="insert into Authors (CharId,name,surname,QNumber,Nicks)
values ($charid,$name,$surname,".$kvo.",$nicks)";
print $query if $debug;
$qbase -> do($query);
$query="select id from Authors where CharId=$charid";
print $query if $debug;
my $z= $qbase -> prepare($query);
$z -> execute;
my @ar=$z->fetchrow;
my $id=$ar[0];
foreach my $q (@{$questions})
{
$query="insert into A2Q (Author,Question)
values ($id,$q)";
print $query if $debug;
$qbase -> do($query) ;
}
}
sub packword
{
my ($fieldnumber,$id,$wordnumber)=@_;
die "packword: fieldnumber is $fieldnumber! -- id=$id, word=$wordnumber\n" if $fieldnumber>6;
$r=pack("CSC",$fieldnumber|(($id >> 16) << 4),$id%65536,$wordnumber%256);
}
sub updateword2question
{
my ($n,$addstring,$was)=@_;
$addstring=$qbase->quote($addstring);
my ($z,@a);
if (!(defined $was))
{
$query="select word from word2question where word=$n";
print "$query\n" if $debug;
$z=$qbase->prepare($query);
$z->execute;
@a=$z->fetchrow;
$was=$a[0];
}
my $select=$was ? "UPDATE word2question set questions = CONCAT(questions,$addstring)
where word=$n"
:
"insert into word2question (word,questions) values
($n,$addstring)";
print "$select\n" if $debug;
$qbase->do ($select);
}
sub addnest
{
my ($w1,$w2)=@_;
$w1=$qbase -> quote($w1);
my $query="insert into nests (w1,w2) values ($w1,$w2)";
print $query if $debug;
$qbase -> do($query);
}
sub addnf
{
my ($w0,$w1,$w2,$w3)=@_;
$w1=$qbase -> quote($w1);
$w2=$qbase -> quote($w2);
my $query;
my $z= $qbase -> prepare("select flag,id FROM nf WHERE word=$w1");
$z -> execute;
my @a=$z->fetchrow;
my $id;
if ($a[0])
{
$query="update nf set flag=$w2, number=$w3 WHERE word=$w1";
print "$query\n" if $debug;
$qbase -> do($query);
return $a[1];
}
else
{
if ($w0)
{
$query="insert into nf (id,word,flag,number) values ($w0,$w1,$w2,$w3)";
$qbase -> do($query);
return $w0;
}
else
{
$query="insert into nf (word,flag,number) values ($w1,$w2,$w3)";
$qbase -> do($query);
$query="select id from nf where word=$w1";
print "$query\n" if $debug;
$z=$qbase->prepare($query);
$z->execute;
($id)=$z->fetchrow;
return $id;
}
}
}
sub getwordkeys
{
$z= $qbase -> prepare("select word, flag FROM nf");
$z -> execute;
my %h;
while ( my ($first, $second)=$z -> fetchrow)
{
$h{$first}=$second;
}
$z -> finish;
%h;
}
sub getequalto
{
$z= $qbase -> prepare("select first, second FROM equalto");
$z -> execute;
my %h;
while ( my ($first, $second)=$z -> fetchrow)
{
$h{$first}=$second;
}
$z -> finish;
%h;
}
sub getnfnumbers
{
$z= $qbase -> prepare("select word, id FROM nf");
$z -> execute;
my %h;
while ( my ($first, $second)=$z -> fetchrow)
{
$h{$first}=$second;
}
$z -> finish;
%h;
}
sub getnests
{
$z= $qbase -> prepare("select w1, w2 FROM nests");
$z -> execute;
my %h;
while ( my ($first, $second)=$z -> fetchrow)
{
$h{$first}.=" $second";
}
$z -> finish;
%h;
}
sub getflag
{
$w=$qbase->quote($_[0]);
$z= $qbase -> prepare("select flag, id from nf where word=$w");
$z -> execute;
@res=$z->fetchrow();
@res;
}
sub closebase
{
$z -> finish;
$qbase -> disconnect;
}
sub getrow
{
$z -> fetchrow
}
sub mydo
{
$qbase -> do (shift);
}
sub getall
{
$z -> fetchall_arrayref;
}
sub forbidden
{
keys %getequalto
}
sub checktable # если $param='delete' удаляет существующую таблицу,
# если $param='ask' спрашивает, не удалить ли
# если $param не определено -- просто удаляет.
# если $param='deletedata' -- удаляет из таблицы данные
{
my ($TabName,$param) = @_;
my ($ans);
if (scalar(grep(/\`$TabName$\`/i, &tablelist))) {
return 1 unless $param;
if ($param =~ /delete/) {$ans='y';}
else {
print "Table $TabName exists. Do you want to delete it? ";
$ans = <STDIN>
}
if ($ans =~ /[yY]/) {
if ($param eq 'delete') {
$qbase->do("DROP TABLE $TabName");
print "deleted table $TabName\n";
} else {
$qbase->do("DELETE FROM $TabName");
print "Deleted everything from $TabName\n";
}
return 0;
} else {
return 1
}
}
0
}
sub tablelist
{
return $qbase->func('_ListTables');
}
sub in2out
{
$qid=shift;
my $z= $qbase -> prepare ( "select t2.Id, t2.Number, t3.FileName
from Questions AS t1, Tournaments AS t2 , Tournaments AS t3
where (t1.QuestionId = $qid) && (t1.ParentId = t2.Id) && (t2.ParentId = t3.Id) ");
$z -> execute;
($tourid, $tourname, $filename)= $z -> fetchrow;
$z= $qbase -> prepare("select QuestionId from Questions WHERE ParentId = $tourid");
$z -> execute;
my $i;
for ($i=1; ($q= $z->fetchrow) && $q!=$qid; $i++){};
$_=lc $_;
$filename=~s/\.txt$//i;
"$filename\.$tourname\.$i";
}
sub out2in
{
@q= split(/\./, lc shift);
$q[0].='.txt';
#
$z= $qbase -> prepare ( "select q.QuestionId from Questions as q,
Tournaments as t1, Tournaments as t2
where (t2.FileName= \"$q[0]\") &&
(t1.ParentId = t2.Id) &&
(q.ParentId = t1.Id) &&
(t1.Number=\"$q[1]\")
");
$z -> execute;
# ($tourid)=$z -> fetchrow or die "Bad identifier". join (".", @q);
# print "--$tourid--";
# $z= $qbase -> prepare("select QuestionId from questions WHERE ParentId = $tourid");
my $i;
$z -> execute;
for ($i=1; $i <= $q[2]; $i++){@qq= $z->fetchrow};
$z -> finish;
$qq[0];
}
1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>