--- db/prgsrc/dbchgk.pm	2001/10/31 03:07:18	1.2
+++ db/prgsrc/dbchgk.pm	2005/12/10 00:03:55	1.11
@@ -1,4 +1,23 @@
 #!/usr/bin/perl
+
+=head1 NAME
+
+dbchgk.pm - модуль для работы с базой
+
+=head1 SYNOPSIS
+
+  use chgkfiles.pm  
+
+=head1 DESCRIPTION
+
+  Работа с базой
+
+
+=head1 AUTHOR
+
+Роман Семизаров
+=cut
+
 package dbchgk;
 use DBI;
 use Exporter;
@@ -6,14 +25,15 @@ 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
+             &getequalto &forbidden &getquestion &checktable &addword2task &addnest &getwordkeys &getflag &addword2task 
              &updateword2question &knownword &incnf &searchmark &knownnf &getnests 
-             &packword &getnfnumbers &getword2question) ;
+             &packword &getnfnumbers &getword2question &addauthors) ;
 
 my $z;
 my $qbase;
 BEGIN {do "chgk.cnf"; 	
           $qbase = DBI -> connect ("DBI:mysql:$base",'piataev',undef);
+	  $qbase->do("SET NAMES koi8r");
       };
 
 
@@ -94,11 +114,42 @@ sub addword2task
   $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;
-  pack("CSC",$fieldnumber,$id,$wordnumber%256)
+  $r=pack("CSC",$fieldnumber|(($id >> 16) << 4),$id%65536,$wordnumber%256);
 }
 
 sub updateword2question
@@ -271,20 +322,26 @@ sub forbidden
 sub checktable # если $param='delete' удаляет существующую таблицу,
                # если $param='ask' спрашивает, не удалить ли
                # если $param не определено -- просто удаляет.
+               # если $param='deletedata' -- удаляет из таблицы данные
 {
 	my ($TabName,$param) = @_;
 	my ($ans);
-	if (scalar(grep(/^$TabName$/i, &tablelist))) {
+	if (scalar(grep(/\`$TabName$\`/i, &tablelist))) {
 	        return 1 unless $param;
-		if ($param eq 'delete') {$ans='y';}
+		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";
-			return 0;
+		    } else {
+			$qbase->do("DELETE FROM $TabName");
+			print "Deleted everything from $TabName\n";
+		    }
+		    return 0;
 		} else {
 			return 1
 		}
@@ -294,7 +351,7 @@ sub checktable # если $param='delete' уд
 
 sub tablelist
 {
-     $qbase->func( '_ListTables' );
+    return $qbase->func('_ListTables');
 }
 
 sub in2out