#!/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 &updatew2q &knownword &incnf &searchmark &knownnf &getnests &packword &getnfnumbers &getword2question &addauthors &addquestions2author &addtours2author &getalltours &tableexists) ; my $z; my $qbase; BEGIN {do "chgk.cnf"; $qbase = DBI -> connect ("DBI:mysql:$base",'piataev',undef); $qbase->do("SET NAMES koi8r"); }; 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); print "prepared\n" if $debug; $result = $z -> execute; print "executed\n" if $debug; return $result; } sub getalltours { my $a=join(", ",@_); my $select="select $a FROM Tournaments -- WHERE Type='Ч'"; 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 authorexists { $textid = shift; $sql = "select 1 from People Where CharId = ".$qbase->quote($textid); $z = $qbase ->prepare($sql); $z->execute; return $z->rows; } sub addauthor { my ($charid,$name,$surname,$nicks)=@_; if (authorexists($charid)) { return; } else { $_=$qbase ->quote($_) foreach ($charid,$name,$surname,$nicks); my $query= "insert into People (CharId,name,surname,Nicks) values ($charid,$name,$surname,$nicks)"; mydo($query); } } sub addquestions2author { my ($charid,$name,$surname,$questions,$nicks,$forbidden)=@_; my $kvo=scalar grep {!$$forbidden{$_}} @$questions; addauthor($charid, $name, $surname, $nicks); $qbase->do("UPDATE People SET QNumber=$kvo WHERE CharId=".$qbase->quote($charid)); foreach my $q (@{$questions}) { $query="insert into P2Q (Author,Question) values (".$qbase->quote($charid).",$q)"; $qbase -> do($query) ; } } sub addtours2author { my ($charid,$name,$surname,$tours,$nicks)=@_; my $kvo= @$tours; addauthor($charid, $name, $surname, $nicks); $qbase->do("UPDATE People SET TNumber=$kvo WHERE CharId=".$qbase->quote($charid)); foreach my $t (@{$tours}) { $query="insert into P2T (Author,Tour) values (".$qbase->quote($charid).",$t)"; $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 updatew2q { my ($n,$fieldnumber, $id,$wordnumber)=@_; my ($z,@a); $query="replace into w2q (wordId,questionId,fieldNumber,wordNumber) values ($n,$id,$fieldnumber,$wordnumber)"; print "$query\n" if $debug; $qbase->do($query); } 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 tableexists { $TabName = shift; return grep(/\`$TabName\`/i, &tablelist); } sub checktable # если $param='delete' удаляет существующую таблицу, # если $param='ask' спрашивает, не удалить ли # если $param не определено -- просто удаляет. # если $param='deletedata' -- удаляет из таблицы данные { print "!"; my ($TabName,$param) = @_; my ($ans); print STDERR "!$TabName!\n"; if (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 = } 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->tables(); } 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;