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