Return to findequal.pl CVS log

Up to [Local Repository] / db / prgsrc

Annotation of db/prgsrc/findequal.pl, revision 1.3

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