1: #!/usr/bin/perl
2: package dbchgk;
3: use DBI;
4: use Exporter;
5: use vars qw(@ISA @EXPORT);
6: @ISA=qw(Exporter);
7:
8: @EXPORT = qw(&getbase &getquestions &closebase &getrow $z &in2out &getall &addnf &out2in &mydo
9: &getequalto &forbidden &getquestion &checktable &addword2task &addnest &getwordkeys &getflag &addword2task &cformula
10: &updateword2question &knownword &incnf &searchmark &knownnf &getnests
11: &packword &getnfnumbers &getword2question) ;
12:
13: my $z;
14: my $qbase;
15: BEGIN {do "chgk.cnf";
16: $qbase = DBI -> connect ("DBI:mysql:$base",'piataev',undef);
17: };
18:
19:
20:
21: sub searchmark
22: {
23: my $a=$_[0];
24: $qbase->do ("UPDATE Questions SET ProcessedBySearch=1 WHERE QuestionId=$a")
25: }
26:
27: sub knownword
28: {
29: my $a=$qbase ->quote (uc $_[0]);
30: my $select = "select distinct w2 from nests where w1=$a";
31: print "$select\n" if $debug;
32: my $z= $qbase -> prepare($select);
33: $z -> execute;
34: my @res;
35: while ( my @ar=$z -> fetchrow)
36: {
37: push (@res,$ar[0])
38: }
39: return @res;
40:
41: }
42:
43: sub knownnf
44: {
45: my $a=$qbase ->quote (uc $_[0]);
46: my $select = "select id from nf where word=$a";
47: print "$select\n" if $debug;
48: my $z= $qbase -> prepare($select);
49: $z -> execute;
50: my @ar=$z -> fetchrow;
51: return $ar[0];
52: }
53:
54: sub incnf
55: {
56: my $a=$_[0];
57: my $b=$_[1]||1;
58: $qbase -> do ("UPDATE nf SET number=number+$b WHERE id=$a")
59: }
60:
61: sub getbase
62: {
63: my $a=join(", ",@_);
64: my $select="select $a FROM Questions WHERE QuestionId<=$qnumber";
65: print "$select\n" if $debug;
66: $z= $qbase -> prepare($select);
67: $z -> execute;
68: }
69:
70: sub getquestions
71: {
72: my $cond=pop @_;
73: my $a=join(", ",@_);
74: my $select="select $a FROM Questions WHERE QuestionId<=$qnumber AND ($cond)";
75: print "$select\n" if $debug;
76: $z= $qbase -> prepare($select);
77: $z -> execute;
78: }
79:
80:
81: sub getword2question
82: {
83: my $select='select word, questions FROM word2question';
84: print "$select\n";
85: $z= $qbase -> prepare($select);
86: $z -> execute;
87: }
88:
89:
90: sub addword2task
91: {
92: ($w1,$w2)=@_;
93: $w2=$qbase -> quote ($w2);
94: $qbase -> do("insert into word2question (word,questions) values ($w1,$w2)");
95: }
96:
97: sub packword
98: {
99: my ($fieldnumber,$id,$wordnumber)=@_;
100: die "packword: fieldnumber is $fieldnumber! -- id=$id, word=$wordnumber\n" if $fieldnumber>6;
101: pack("CSC",$fieldnumber,$id,$wordnumber%256)
102: }
103:
104: sub updateword2question
105: {
106: my ($n,$addstring,$was)=@_;
107: $addstring=$qbase->quote($addstring);
108: my ($z,@a);
109:
110: if (!(defined $was))
111: {
112: $query="select word from word2question where word=$n";
113: print "$query\n" if $debug;
114: $z=$qbase->prepare($query);
115: $z->execute;
116: @a=$z->fetchrow;
117: $was=$a[0];
118: }
119: my $select=$was ? "UPDATE word2question set questions = CONCAT(questions,$addstring)
120: where word=$n"
121: :
122: "insert into word2question (word,questions) values
123: ($n,$addstring)";
124: print "$select\n" if $debug;
125: $qbase->do ($select);
126:
127: }
128:
129:
130:
131: sub addnest
132: {
133: my ($w1,$w2)=@_;
134: $w1=$qbase -> quote($w1);
135: my $query="insert into nests (w1,w2) values ($w1,$w2)";
136: print $query if $debug;
137: $qbase -> do($query);
138: }
139:
140: sub addnf
141: {
142: my ($w0,$w1,$w2,$w3)=@_;
143: $w1=$qbase -> quote($w1);
144: $w2=$qbase -> quote($w2);
145: my $query;
146: my $z= $qbase -> prepare("select flag,id FROM nf WHERE word=$w1");
147: $z -> execute;
148: my @a=$z->fetchrow;
149: my $id;
150: if ($a[0])
151: {
152: $query="update nf set flag=$w2, number=$w3 WHERE word=$w1";
153: print "$query\n" if $debug;
154: $qbase -> do($query);
155: return $a[1];
156: }
157: else
158: {
159: if ($w0)
160: {
161: $query="insert into nf (id,word,flag,number) values ($w0,$w1,$w2,$w3)";
162: $qbase -> do($query);
163: return $w0;
164: }
165: else
166: {
167: $query="insert into nf (word,flag,number) values ($w1,$w2,$w3)";
168: $qbase -> do($query);
169: $query="select id from nf where word=$w1";
170: print "$query\n" if $debug;
171: $z=$qbase->prepare($query);
172: $z->execute;
173: ($id)=$z->fetchrow;
174: return $id;
175: }
176: }
177: }
178:
179: sub getwordkeys
180: {
181: $z= $qbase -> prepare("select word, flag FROM nf");
182: $z -> execute;
183: my %h;
184: while ( my ($first, $second)=$z -> fetchrow)
185: {
186: $h{$first}=$second;
187: }
188: $z -> finish;
189: %h;
190: }
191:
192:
193: sub getequalto
194: {
195: $z= $qbase -> prepare("select first, second FROM equalto");
196: $z -> execute;
197: my %h;
198: while ( my ($first, $second)=$z -> fetchrow)
199: {
200: $h{$first}=$second;
201: }
202: $z -> finish;
203: %h;
204: }
205:
206: sub getnfnumbers
207: {
208: $z= $qbase -> prepare("select word, id FROM nf");
209: $z -> execute;
210: my %h;
211: while ( my ($first, $second)=$z -> fetchrow)
212: {
213: $h{$first}=$second;
214: }
215: $z -> finish;
216: %h;
217: }
218:
219:
220: sub getnests
221: {
222: $z= $qbase -> prepare("select w1, w2 FROM nests");
223: $z -> execute;
224: my %h;
225: while ( my ($first, $second)=$z -> fetchrow)
226: {
227: $h{$first}.=" $second";
228: }
229: $z -> finish;
230: %h;
231: }
232:
233:
234: sub getflag
235: {
236: $w=$qbase->quote($_[0]);
237: $z= $qbase -> prepare("select flag, id from nf where word=$w");
238: $z -> execute;
239: @res=$z->fetchrow();
240:
241: @res;
242: }
243:
244:
245: sub closebase
246: {
247: $z -> finish;
248: $qbase -> disconnect;
249: }
250:
251: sub getrow
252: {
253: $z -> fetchrow
254: }
255:
256: sub mydo
257: {
258: $qbase -> do (shift);
259: }
260:
261: sub getall
262: {
263: $z -> fetchall_arrayref;
264: }
265:
266: sub forbidden
267: {
268: keys %getequalto
269: }
270:
271: sub checktable # если $param='delete' удаляет существующую таблицу,
272: # если $param='ask' спрашивает, не удалить ли
273: # если $param не определено -- просто удаляет.
274: {
275: my ($TabName,$param) = @_;
276: my ($ans);
277: if (scalar(grep(/^$TabName$/i, &tablelist))) {
278: return 1 unless $param;
279: if ($param eq 'delete') {$ans='y';}
280: else {
281: print "Table $TabName exists. Do you want to delete it? ";
282: $ans = <STDIN>
283: }
284: if ($ans =~ /[yY]/) {
285: $qbase->do("DROP TABLE $TabName");
286: print "deleted table $TabName\n";
287: return 0;
288: } else {
289: return 1
290: }
291: }
292: 0
293: }
294:
295: sub tablelist
296: {
297: $qbase->func( '_ListTables' );
298: }
299:
300: sub in2out
301: {
302: $qid=shift;
303:
304: my $z= $qbase -> prepare ( "select t2.Id, t2.Number, t3.FileName
305: from Questions AS t1, Tournaments AS t2 , Tournaments AS t3
306: where (t1.QuestionId = $qid) && (t1.ParentId = t2.Id) && (t2.ParentId = t3.Id) ");
307:
308: $z -> execute;
309: ($tourid, $tourname, $filename)= $z -> fetchrow;
310:
311:
312: $z= $qbase -> prepare("select QuestionId from Questions WHERE ParentId = $tourid");
313:
314: $z -> execute;
315: my $i;
316: for ($i=1; ($q= $z->fetchrow) && $q!=$qid; $i++){};
317:
318: $_=lc $_;
319: $filename=~s/\.txt$//i;
320: "$filename\.$tourname\.$i";
321: }
322:
323:
324:
325: sub out2in
326: {
327: @q= split(/\./, lc shift);
328:
329: $q[0].='.txt';
330:
331: #
332:
333:
334: $z= $qbase -> prepare ( "select q.QuestionId from Questions as q,
335: Tournaments as t1, Tournaments as t2
336: where (t2.FileName= \"$q[0]\") &&
337: (t1.ParentId = t2.Id) &&
338: (q.ParentId = t1.Id) &&
339: (t1.Number=\"$q[1]\")
340: ");
341:
342: $z -> execute;
343: # ($tourid)=$z -> fetchrow or die "Bad identifier". join (".", @q);
344:
345: # print "--$tourid--";
346:
347: # $z= $qbase -> prepare("select QuestionId from questions WHERE ParentId = $tourid");
348:
349: my $i;
350: $z -> execute;
351: for ($i=1; $i <= $q[2]; $i++){@qq= $z->fetchrow};
352:
353: $z -> finish;
354: $qq[0];
355: }
356:
357:
358: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dbchgk.pm CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Local Repository] / db / prgsrc