Return to dbchgk.pm CVS log

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

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

1.1     ! roma7       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",undef,undef);
        !            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;