--- db/prgsrc/dbchgk.pm	2001/10/31 03:00:07	1.1
+++ db/prgsrc/dbchgk.pm	2001/10/31 03:07:18	1.2
@@ -1,357 +1,358 @@
-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 = <STDIN>
-                        }
-		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;
\ No newline at end of file
+#!/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 = <STDIN>
+                        }
+		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;