Return to dbchgk.pm CVS log

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

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

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