Return to findequal.pl CVS log

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

*** empty log message ***

    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: print "before checktable";
   49: 
   50: 
   51: if (checktable('equalto')) {die "The table equalto exists. You must delete it first!\n"};
   52: 
   53: if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};
   54: 
   55: print "before mydo";
   56: 
   57: 
   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: 
   68: if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};
   69: print "before getbase";
   70: 
   71: getbase(QuestionId,Question);
   72: 
   73: 
   74: print "after getbase";
   75: 
   76: print "Loading questions...\n";
   77: 
   78: if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};
   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: 
   87:  	$a=~s/[^êãõëåîçûýúèÿüöäìïòðá÷ùæñþóíéôøâàÊÃÕËÅÎÇÛÝÚÈßÆÙ×ÁÐÒÏÌÄÖÜÑÞÓÍÉÔØÂÀ]//g;
   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: