File:  [Local Repository] / db / prgsrc / findequal.pl
Revision 1.3: download - view: text, annotated - select for diffs - revision graph
Sun Feb 2 22:02:03 2003 UTC (21 years, 3 months ago) by roma7
Branches: MAIN
CVS tags: HEAD
*** empty log message ***

    1: #!/usr/bin/perl -w
    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: 
   48: #if (checktable('equalto')) {die "The table equalto exists. You must delete it first!\n"};
   49: 
   50: if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};
   51: 
   52: 
   53: 
   54: print "Creating equalto table...\n";
   55: 	mydo("DROP TABLE IF EXISTS equalto");
   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: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>