version 1.5, 2001/11/19 01:13:41
|
version 1.8, 2001/12/05 01:29:09
|
Line 2
|
Line 2
|
|
|
=head1 NAME |
=head1 NAME |
|
|
dbchgk.pm |
dbchgk.pm - модуль для работы с базой |
|
|
=head1 SYNOPSIS |
=head1 SYNOPSIS |
|
|
Line 25 use vars qw(@ISA @EXPORT);
|
Line 25 use vars qw(@ISA @EXPORT);
|
@ISA=qw(Exporter); |
@ISA=qw(Exporter); |
|
|
@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 &cformula |
&getequalto &forbidden &getquestion &checktable &addword2task &addnest &getwordkeys &getflag &addword2task |
&updateword2question &knownword &incnf &searchmark &knownnf &getnests |
&updateword2question &knownword &incnf &searchmark &knownnf &getnests |
&packword &getnfnumbers &getword2question) ; |
&packword &getnfnumbers &getword2question &addauthors) ; |
|
|
my $z; |
my $z; |
my $qbase; |
my $qbase; |
Line 113 sub addword2task
|
Line 113 sub addword2task
|
$qbase -> do("insert into word2question (word,questions) values ($w1,$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 |
sub packword |
{ |
{ |
my ($fieldnumber,$id,$wordnumber)=@_; |
my ($fieldnumber,$id,$wordnumber)=@_; |
Line 290 sub forbidden
|
Line 321 sub forbidden
|
sub checktable # если $param='delete' удаляет существующую таблицу, |
sub checktable # если $param='delete' удаляет существующую таблицу, |
# если $param='ask' спрашивает, не удалить ли |
# если $param='ask' спрашивает, не удалить ли |
# если $param не определено -- просто удаляет. |
# если $param не определено -- просто удаляет. |
|
# если $param='deletedata' -- удаляет из таблицы данные |
{ |
{ |
my ($TabName,$param) = @_; |
my ($TabName,$param) = @_; |
my ($ans); |
my ($ans); |
if (scalar(grep(/^$TabName$/i, &tablelist))) { |
if (scalar(grep(/^$TabName$/i, &tablelist))) { |
return 1 unless $param; |
return 1 unless $param; |
if ($param eq 'delete') {$ans='y';} |
if ($param =~ /delete/) {$ans='y';} |
else { |
else { |
print "Table $TabName exists. Do you want to delete it? "; |
print "Table $TabName exists. Do you want to delete it? "; |
$ans = <STDIN> |
$ans = <STDIN> |
} |
} |
if ($ans =~ /[yY]/) { |
if ($ans =~ /[yY]/) { |
|
if ($param eq 'delete') { |
$qbase->do("DROP TABLE $TabName"); |
$qbase->do("DROP TABLE $TabName"); |
print "deleted table $TabName\n"; |
print "deleted table $TabName\n"; |
return 0; |
} else { |
|
$qbase->do("DELETE FROM $TabName"); |
|
print "Deleted everything from $TabName\n"; |
|
} |
|
return 0; |
} else { |
} else { |
return 1 |
return 1 |
} |
} |