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;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>