Return to dbchgk.pm CVS log

Up to [Local Repository] / db / prgsrc

Changed to the new syntac of mysql

#!/usr/bin/perl

=head1 NAME

dbchgk.pm - модуль для работы с базой

=head1 SYNOPSIS

  use chgkfiles.pm  

=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 
             &updateword2question &knownword &incnf &searchmark &knownnf &getnests 
             &packword &getnfnumbers &getword2question &addauthors) ;

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 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;
  $r=pack("CSC",$fieldnumber|(($id >> 16) << 4),$id%65536,$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 не определено -- просто удаляет.
               # если $param='deletedata' -- удаляет из таблицы данные
{
	my ($TabName,$param) = @_;
	my ($ans);
	if (scalar(grep(/\`$TabName$\`/i, &tablelist))) {
	        return 1 unless $param;
		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";
		    } else {
			$qbase->do("DELETE FROM $TabName");
			print "Deleted everything from $TabName\n";
		    }
		    return 0;
		} else {
			return 1
		}
	}
 0	
}

sub tablelist
{
    return $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;