Return to findequal.pl CVS log

Up to [Local Repository] / db / prgsrc / eq

Annotation of db/prgsrc/eq/findequal.pl, revision 1.8

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