Return to findequal.pl CVS log

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

Annotation of db/prgsrc/eq/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: if (checktable('equalto')) {die "The table equalto exists. You must delete it first!\n"};
        !            36: 
        !            37: print "Creating equalto table...\n";
        !            38: 
        !            39:        mydo("CREATE TABLE equalto (
        !            40:                First   INT UNSIGNED NOT NULL PRIMARY KEY, KEY FirstKey (First),
        !            41:                Second  INT UNSIGNED NOT NULL, KEY SecondKey (Second)
        !            42:        )")
        !            43: 
        !            44:        or die "Can't create equalto table: $!\n";
        !            45: 
        !            46: 
        !            47: 
        !            48: getbase(QuestionId,Question);
        !            49: 
        !            50: 
        !            51: 
        !            52: print "Loading questions...\n";
        !            53: 
        !            54: if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};
        !            55: 
        !            56: while ((($id, $a) = getrow), $id) 
        !            57: {
        !            58:         if (!($id%1000)) {print "$id questions loaded...\n"}
        !            59: 
        !            60:         $a=~s/³£pPHXxAaBEe3KMoOT/åÅÒòîèÈáÁ÷åÅúëíÏïô/;
        !            61:         $a=uc $a;
        !            62: 
        !            63:        $a=~s/[^êãõëåîçûýúèÿüöäìïòðá÷ùæñþóíéôøâà]//g;
        !            64:        $ar[$id]=$a;
        !            65:        $last=$id;
        !            66: }
        !            67: 
        !            68: 
        !            69: 
        !            70: print "Checking...\n";
        !            71: 
        !            72: $cur=0;
        !            73: $ar[0]="\0";
        !            74: foreach $q (sort {($ar[$a] cmp $ar[$b])} 1..$last)
        !            75: {
        !            76:   if ($ar[$q] eq $ar[$cur]) {$equal{$q}=$cur} else {$cur=$q} 
        !            77: }
        !            78: 
        !            79: print scalar keys %equal, " pairs found\n";
        !            80: 
        !            81: print("Updating the DB...\n");
        !            82: 
        !            83: foreach $a (keys %equal)
        !            84: {
        !            85:   mydo("INSERT INTO equalto (First,Second) VALUES ($a,$equal{$a})");
        !            86: }
        !            87: