Return to dbchgk.pm CVS log | Up to [Local Repository] / db / prgsrc / eq |
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;