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