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