1: #!perl
2:
3: #!/usr/local/bin/perl -w
4:
5: =head1 NAME
6:
7: findequal.pl - a script for filling the equalto tablee.
8:
9: =head1 SYNOPSIS
10:
11: findequal.pl
12:
13:
14: =head1 DESCRIPTION
15:
16: This script will create a table B<equalto>
17: in the B<chgk> database and fill it with pairs of
18: equal questions. If the tables exist, it will ask user whether
19: new table should be created.
20:
21: =head1 AUTHOR
22:
23: Roman Semizarov
24:
25: =cut
26:
27:
28: use DBI;
29: use locale;
30: use dbchgk;
31: use POSIX qw (locale_h);
32:
33: do "common.pl";
34:
35: my ($thislocale);
36: if ($^O =~ /win/i) {
37: $thislocale = "Russian_Russia.20866";
38: } else {
39: $thislocale = "ru_RU.KOI8-R";
40: }
41: POSIX::setlocale( &POSIX::LC_ALL, $thislocale );
42: if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};
43:
44:
45:
46: if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};
47:
48:
49:
50: if (checktable('equalto')) {die "The table equalto exists. You must delete it first!\n"};
51:
52: if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};
53:
54:
55:
56: print "Creating equalto table...\n";
57:
58: mydo("CREATE TABLE equalto (
59: First INT UNSIGNED NOT NULL PRIMARY KEY, KEY FirstKey (First),
60: Second INT UNSIGNED NOT NULL, KEY SecondKey (Second)
61: )")
62:
63: or die "Can't create equalto table: $!\n";
64:
65:
66: if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};
67: print "before getbase";
68:
69: getbase(QuestionId,Question,Authors,Comments);
70:
71:
72: print "after getbase";
73:
74: print "Loading questions...\n";
75:
76: if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};
77:
78: while ((($id, $a,$author,$comment) = getrow), $id)
79: {
80: if (!($id%1000)) {print "$id questions loaded...\n"}
81:
82: $a=~s/³£pPHXxAaBEe3KMoOT/åÅÒòîèÈáÁ÷åÅúëíÏïô/;
83: $a=uc $a;
84:
85: $a=~s/[^êãõëåîçûýúèÿüöäìïòðá÷ùæñþóíéôøâàÊÃÕËÅÎÇÛÝÚÈßÆÙ×ÁÐÒÏÌÄÖÜÑÞÓÍÉÔØÂÀ]//g;
86: $ar[$id]=$a;
87: $dop[$id]= ($author ? 2 : 0) + ($comment ? 1 : 0);
88: $last=$id;
89: }
90:
91:
92:
93: print "Checking...\n";
94:
95: $cur=0;
96: $ar[0]="\0";
97: foreach $q (sort {($ar[$a] cmp $ar[$b]) || ($dop[$b]<=>$dop[$a])} 1..$last)
98: {
99: if ($ar[$q] eq $ar[$cur]) {$equal{$q}=$cur} else {$cur=$q}
100: }
101:
102: print scalar keys %equal, " pairs found\n";
103:
104: print("Updating the DB...\n");
105:
106: foreach $a (keys %equal)
107: {
108: mydo("INSERT INTO equalto (First,Second) VALUES ($a,$equal{$a})");
109: }
110:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>