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