Return to dbchgk.pm CVS log

Up to [Local Repository] / db / prgsrc

nothing again

#!/usr/bin/perl

=head1 NAME

dbchgk.pm

=head1 SYNOPSIS
  :(

=head1 DESCRIPTION

  :(


=head1 AUTHOR

Роман Семизаров
=cut

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;