[BACK]Return to dbchgk.pm CVS log [TXT] [DIR] Up to [Local Repository] / db / prgsrc

Diff for /db/prgsrc/dbchgk.pm between versions 1.1 and 1.2

version 1.1, 2001/10/31 03:00:07 version 1.2, 2001/10/31 03:07:18
Line 1 Line 1
 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;  
   
   #!/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;
Removed from v.1.1  
changed lines
  Added in v.1.2

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>