Return to dbchgk.pm CVS log

Up to [Local Repository] / db / prgsrc / eq

*** empty log message ***

    1: package dbchgk;
    2: use DBI;
    3: use Exporter;
    4: use vars qw(@ISA @EXPORT);
    5: @ISA=qw(Exporter);
    6: 
    7: @EXPORT = qw(&getbase &closebase &getrow $z &in2out &getall &out2in &mydo
    8:              &getequalto &forbidden &getquestion &checktable);
    9: 
   10: my $z;
   11: my $qbase;
   12: BEGIN {do "chgk.cnf"; 	
   13:           $qbase = DBI -> connect ("DBI:mysql:$base",'piataev','');
   14:       };
   15: 
   16: 
   17: 
   18: sub getbase
   19: {    
   20:         my $a=join(", ",@_);
   21: 	$z=  $qbase -> prepare("select $a FROM Questions WHERE QuestionId<=$qnumber");
   22: 	$z -> execute;
   23: }
   24: 
   25: 
   26: sub getquestion
   27: {    
   28:         my $a=shift;
   29: 	$z=  $qbase -> prepare("select Question, Answer, Comments FROM Questions WHERE QuestionId=$a");
   30: 	$z -> execute;
   31:           $z -> fetchrow;
   32: }
   33: 
   34: sub getequalto
   35: {    
   36: 	$z=  $qbase -> prepare("select first, second FROM equalto");
   37: 	$z -> execute;
   38: 	my %h;
   39: 	while ( my  ($first, $second)=$z -> fetchrow)
   40:         {
   41:             $h{$first}=$second;
   42:         }
   43:         $z -> finish;
   44:         %h;
   45: }
   46: 
   47: 
   48: 
   49: sub closebase
   50: {
   51:     $z -> finish;
   52:     $qbase -> disconnect;
   53: }
   54: 
   55: sub getrow
   56: {
   57:   $z -> fetchrow
   58: }
   59: 
   60: sub mydo
   61: {
   62:   $qbase -> do (shift);
   63: }
   64: 
   65: sub getall
   66: {
   67:   $z -> fetchall_arrayref;
   68: }
   69: 
   70: sub in2out
   71: {
   72:    $qid=shift;
   73: 
   74: 
   75:    $z=  $qbase -> prepare ( "select t2.Id, t2.Number, t3.FileName 
   76:                 from Questions AS t1, Tournaments AS t2 ,  Tournaments AS t3
   77:                 where (t1.QuestionId = $qid)  && (t1.ParentId = t2.Id) && (t2.ParentId = t3.Id) ");
   78: 
   79:    $z -> execute;
   80:   ($tourid, $tourname, $filename)= $z -> fetchrow;
   81: 
   82: 
   83:    $z=  $qbase -> prepare("select QuestionId  from Questions  WHERE ParentId = $tourid");
   84: 
   85:     $z -> execute;
   86:     my $i;
   87:     for ($i=1;  ($q= $z->fetchrow) && $q!=$qid; $i++){};
   88: 
   89:    $_=lc $_;
   90:    $filename=~s/\.txt$//i;
   91:    "$filename\.$tourname\.$i";
   92: }
   93: 
   94: 
   95: 
   96: sub out2in
   97: {
   98:    @q= split(/\./, lc shift);
   99: 
  100:    $q[0].='.txt';
  101: 
  102: # 
  103: 
  104: 
  105:    $z=  $qbase -> prepare ( "select q.QuestionId  from Questions as q, 
  106:                 Tournaments as t1, Tournaments as t2
  107:                 where (t2.FileName= \"$q[0]\")  && 
  108:                       (t1.ParentId = t2.Id) && 
  109:                       (q.ParentId = t1.Id)  && 
  110:                       (t1.Number=\"$q[1]\")
  111:             ");
  112: 
  113:    $z -> execute;
  114: #   ($tourid)=$z -> fetchrow or die "Bad identifier". join (".", @q);
  115: 
  116: #   print "--$tourid--";
  117: 
  118: #   $z=  $qbase -> prepare("select QuestionId  from questions  WHERE ParentId = $tourid");
  119: 
  120:     my $i;
  121:     $z -> execute;
  122:     for ($i=1;  $i <= $q[2]; $i++){@qq= $z->fetchrow};
  123: 
  124:     $z -> finish;
  125:     $qq[0];
  126: }
  127: 
  128: sub forbidden
  129: {
  130:    keys %getequalto
  131: }
  132: 
  133: sub checktable
  134: {
  135: 	my ($TabName) = @_;
  136: 	my ($ans);
  137: 	if (scalar(grep(/^$TabName$/, &tablelist))) {
  138: 		print "Table $TabName exists. Do you want to delete it? ";
  139: 		$ans = <STDIN>;
  140: 		if ($ans =~ /[yY]/) {
  141: 			$qbase->do("DROP TABLE $TabName");
  142: 			print "deleted table $TabName\n";
  143: 			return 0;
  144: 		} else {
  145: 			return 1
  146: 		}
  147: 	}
  148:  0	
  149: }
  150: 
  151: sub tablelist
  152: {
  153:      $qbase->func( '_ListTables' );
  154: }
  155: 
  156: 1;