Return to dbchgk.pm CVS log

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

Annotation of db/prgsrc/eq/dbchgk.pm, revision 1.4

1.1       roma7       1: package dbchgk;
                      2: use DBI;
                      3: use Exporter;
1.2       roma7       4: use vars qw(@ISA @EXPORT);
1.1       roma7       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";  
1.3       roma7      13:           $qbase = DBI -> connect ("DBI:mysql:$base",'piataev','');
1.1       roma7      14:       };
                     15: 
                     16: 
                     17: 
                     18: sub getbase
                     19: {    
                     20:         my $a=join(", ",@_);
1.4     ! roma7      21:        $z=  $qbase -> prepare("select $a FROM Questions WHERE QuestionId<=$qnumber");
1.1       roma7      22:        $z -> execute;
                     23: }
                     24: 
                     25: 
                     26: sub getquestion
                     27: {    
                     28:         my $a=shift;
1.4     ! roma7      29:        $z=  $qbase -> prepare("select Question, Answer, Comments FROM Questions WHERE QuestionId=$a");
1.1       roma7      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 
1.4     ! roma7      76:                 from Questions AS t1, tournaments AS t2 ,  tournaments AS t3
1.1       roma7      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: 
1.4     ! roma7      83:    $z=  $qbase -> prepare("select QuestionId  from Questions  WHERE ParentId = $tourid");
1.1       roma7      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: 
1.4     ! roma7     105:    $z=  $qbase -> prepare ( "select q.QuestionId  from Questions as q, 
1.1       roma7     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;