Annotation of db/prgsrc/eq/findequal.pl, revision 1.7
1.1 roma7 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:
1.7 ! roma7 35: if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};
! 36:
! 37: print "before checktable";
! 38:
! 39:
1.1 roma7 40: if (checktable('equalto')) {die "The table equalto exists. You must delete it first!\n"};
41:
1.6 roma7 42: if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};
43:
44: print "before mydo";
45:
46:
1.1 roma7 47: print "Creating equalto table...\n";
48:
49: mydo("CREATE TABLE equalto (
50: First INT UNSIGNED NOT NULL PRIMARY KEY, KEY FirstKey (First),
51: Second INT UNSIGNED NOT NULL, KEY SecondKey (Second)
52: )")
53:
54: or die "Can't create equalto table: $!\n";
55:
56:
1.5 roma7 57: if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};
58: print "before getbase";
1.1 roma7 59:
60: getbase(QuestionId,Question);
61:
62:
1.5 roma7 63: print "after getbase";
1.1 roma7 64:
65: print "Loading questions...\n";
66:
1.4 roma7 67: if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};
1.1 roma7 68:
69: while ((($id, $a) = getrow), $id)
70: {
71: if (!($id%1000)) {print "$id questions loaded...\n"}
72:
73: $a=~s/³£pPHXxAaBEe3KMoOT/åÅÒòîèÈáÁ÷åÅúëíÏïô/;
74: $a=uc $a;
75:
1.3 roma7 76: $a=~s/[^êãõëåîçûýúèÿüöäìïòðá÷ùæñþóíéôøâàÊÃÕËÅÎÇÛÝÚÈßÆÙ×ÁÐÒÏÌÄÖÜÑÞÓÍÉÔØÂÀ]//g;
1.1 roma7 77: $ar[$id]=$a;
78: $last=$id;
79: }
80:
81:
82:
83: print "Checking...\n";
84:
85: $cur=0;
86: $ar[0]="\0";
87: foreach $q (sort {($ar[$a] cmp $ar[$b])} 1..$last)
88: {
89: if ($ar[$q] eq $ar[$cur]) {$equal{$q}=$cur} else {$cur=$q}
90: }
91:
92: print scalar keys %equal, " pairs found\n";
93:
94: print("Updating the DB...\n");
95:
96: foreach $a (keys %equal)
97: {
98: mydo("INSERT INTO equalto (First,Second) VALUES ($a,$equal{$a})");
99: }
100:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>