version 1.9, 2002/01/13 00:32:12
|
version 1.13, 2010/04/24 17:21:54
|
Line 26 use vars qw(@ISA @EXPORT);
|
Line 26 use vars qw(@ISA @EXPORT);
|
|
|
@EXPORT = qw(&getbase &getquestions &closebase &getrow $z &in2out &getall &addnf &out2in &mydo |
@EXPORT = qw(&getbase &getquestions &closebase &getrow $z &in2out &getall &addnf &out2in &mydo |
&getequalto &forbidden &getquestion &checktable &addword2task &addnest &getwordkeys &getflag &addword2task |
&getequalto &forbidden &getquestion &checktable &addword2task &addnest &getwordkeys &getflag &addword2task |
&updateword2question &knownword &incnf &searchmark &knownnf &getnests |
&updateword2question &updatew2q &knownword &incnf &searchmark &knownnf &getnests |
&packword &getnfnumbers &getword2question &addauthors) ; |
&packword &getnfnumbers &getword2question &addauthors &addquestions2author &addtours2author &getalltours &tableexists) ; |
|
|
my $z; |
my $z; |
my $qbase; |
my $qbase; |
BEGIN {do "chgk.cnf"; |
BEGIN {do "chgk.cnf"; |
$qbase = DBI -> connect ("DBI:mysql:$base",'piataev',undef); |
$qbase = DBI -> connect ("DBI:mysql:$base",'piataev',undef); |
|
$qbase->do("SET NAMES koi8r"); |
}; |
}; |
|
|
|
|
Line 83 sub getbase
|
Line 84 sub getbase
|
my $select="select $a FROM Questions WHERE QuestionId<=$qnumber"; |
my $select="select $a FROM Questions WHERE QuestionId<=$qnumber"; |
print "$select\n" if $debug; |
print "$select\n" if $debug; |
$z= $qbase -> prepare($select); |
$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; |
$z -> execute; |
} |
} |
|
|
Line 113 sub addword2task
|
Line 126 sub addword2task
|
$qbase -> do("insert into word2question (word,questions) values ($w1,$w2)"); |
$qbase -> do("insert into word2question (word,questions) values ($w1,$w2)"); |
} |
} |
|
|
sub addauthors |
sub authorexists |
{ |
{ |
my ($charid,$name,$surname,$questions,$nicks,$forbidden)=@_; |
$textid = shift; |
$_=$qbase -> |
$sql = "select 1 from People Where CharId = ".$qbase->quote($textid); |
quote($_) foreach ($charid,$name,$surname,$nicks); |
$z = $qbase ->prepare($sql); |
my $kvo=scalar grep {!$$forbidden{$_}} @$questions; |
$z->execute; |
my $query="insert into Authors (CharId,name,surname,QNumber,Nicks) |
return $z->rows; |
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}) |
sub addauthor |
{ |
{ |
$query="insert into A2Q (Author,Question) |
my ($charid,$name,$surname,$nicks)=@_; |
values ($id,$q)"; |
if (authorexists($charid)) { |
print $query if $debug; |
return; |
$qbase -> do($query) ; |
} 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 |
sub packword |
{ |
{ |
Line 151 die "packword: fieldnumber is $fieldnumb
|
Line 186 die "packword: fieldnumber is $fieldnumb
|
$r=pack("CSC",$fieldnumber|(($id >> 16) << 4),$id%65536,$wordnumber%256); |
$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 |
sub updateword2question |
{ |
{ |
my ($n,$addstring,$was)=@_; |
my ($n,$addstring,$was)=@_; |
Line 318 sub forbidden
|
Line 362 sub forbidden
|
keys %getequalto |
keys %getequalto |
} |
} |
|
|
|
sub tableexists { |
|
$TabName = shift; |
|
return grep(/\`$TabName\`/i, &tablelist); |
|
} |
|
|
sub checktable # если $param='delete' удаляет существующую таблицу, |
sub checktable # если $param='delete' удаляет существующую таблицу, |
# если $param='ask' спрашивает, не удалить ли |
# если $param='ask' спрашивает, не удалить ли |
# если $param не определено -- просто удаляет. |
# если $param не определено -- просто удаляет. |
# если $param='deletedata' -- удаляет из таблицы данные |
# если $param='deletedata' -- удаляет из таблицы данные |
{ |
{ |
|
print "!"; |
my ($TabName,$param) = @_; |
my ($TabName,$param) = @_; |
my ($ans); |
my ($ans); |
if (scalar(grep(/^$TabName$/i, &tablelist))) { |
print STDERR "!$TabName!\n"; |
|
if (grep(/\`$TabName$\`/i, &tablelist)) { |
return 1 unless $param; |
return 1 unless $param; |
if ($param =~ /delete/) {$ans='y';} |
if ($param =~ /delete/) {$ans='y';} |
else { |
else { |
Line 350 sub checktable # если $param='delete' уд
|
Line 401 sub checktable # если $param='delete' уд
|
|
|
sub tablelist |
sub tablelist |
{ |
{ |
$qbase->func( '_ListTables' ); |
return $qbase->tables(); |
} |
} |
|
|
sub in2out |
sub in2out |