#!/usr/bin/perl 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 &cformula &updateword2question &knownword &incnf &searchmark &knownnf &getnests &packword &getnfnumbers &getword2question) ; 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 packword { my ($fieldnumber,$id,$wordnumber)=@_; die "packword: fieldnumber is $fieldnumber! -- id=$id, word=$wordnumber\n" if $fieldnumber>6; pack("CSC",$fieldnumber,$id,$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 не определено -- просто удаляет. { my ($TabName,$param) = @_; my ($ans); if (scalar(grep(/^$TabName$/i, &tablelist))) { return 1 unless $param; if ($param eq 'delete') {$ans='y';} else { print "Table $TabName exists. Do you want to delete it? "; $ans = } if ($ans =~ /[yY]/) { $qbase->do("DROP TABLE $TabName"); print "deleted table $TabName\n"; return 0; } else { return 1 } } 0 } sub tablelist { $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;