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