Return to findequal.pl CVS log

Up to [Local Repository] / db / prgsrc

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

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: 
        !            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: