Diff for /db/prgsrc/eq/Attic/findequal.pl between versions 1.8 and 1.11

version 1.8, 2001/05/18 22:53:03 version 1.11, 2001/11/25 23:40:27
Line 33  use POSIX qw (locale_h); Line 33  use POSIX qw (locale_h);
 do "common.pl";  do "common.pl";
   
 my ($thislocale);  my ($thislocale);
 if ($^O ~= /win/i) {  if ($^O =~ /win/i) {
         $thislocale = "Russian_Russia.20866";          $thislocale = "Russian_Russia.20866";
 } else {  } else {
         $thislocale = "ru_RU.KOI8-R";          $thislocale = "ru_RU.KOI8-R";
 }  }
 POSIX::setlocale( &POSIX::LC_ALL, $thislocale );  POSIX::setlocale( &POSIX::LC_ALL, $thislocale );
 if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};  if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};
 }  
   
   
 if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};  if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};
   
 print "before checktable";  
   
   
 if (checktable('equalto')) {die "The table equalto exists. You must delete it first!\n"};  if (checktable('equalto')) {die "The table equalto exists. You must delete it first!\n"};
   
 if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};  if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};
   
 print "before mydo";  
   
   
 print "Creating equalto table...\n";  print "Creating equalto table...\n";
Line 68  print "Creating equalto table...\n"; Line 66  print "Creating equalto table...\n";
 if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};  if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};
 print "before getbase";  print "before getbase";
   
 getbase(QuestionId,Question);  getbase(QuestionId,Question,Authors,Comments);
   
   
 print "after getbase";  print "after getbase";
Line 77  print "Loading questions...\n"; Line 75  print "Loading questions...\n";
   
 if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};  if ((uc 'Á') ne 'á') {die "!Koi8-r locale not installed!\n"};
   
 while ((($id, $a) = getrow), $id)   while ((($id, $a,$author,$comment) = getrow), $id) 
 {  {
         if (!($id%1000)) {print "$id questions loaded...\n"}          if (!($id%1000)) {print "$id questions loaded...\n"}
   
Line 86  while ((($id, $a) = getrow), $id) Line 84  while ((($id, $a) = getrow), $id)
   
         $a=~s/[^êãõëåîçûýúèÿüöäìïòðá÷ùæñþóíéôøâàÊÃÕËÅÎÇÛÝÚÈßÆÙ×ÁÐÒÏÌÄÖÜÑÞÓÍÉÔØÂÀ]//g;          $a=~s/[^êãõëåîçûýúèÿüöäìïòðá÷ùæñþóíéôøâàÊÃÕËÅÎÇÛÝÚÈßÆÙ×ÁÐÒÏÌÄÖÜÑÞÓÍÉÔØÂÀ]//g;
         $ar[$id]=$a;          $ar[$id]=$a;
           $dop[$id]= ($author ? 2 : 0) + ($comment ? 1 : 0);
         $last=$id;          $last=$id;
 }  }
   
Line 95  print "Checking...\n"; Line 94  print "Checking...\n";
   
 $cur=0;  $cur=0;
 $ar[0]="\0";  $ar[0]="\0";
 foreach $q (sort {($ar[$a] cmp $ar[$b])} 1..$last)  foreach $q (sort {($ar[$a] cmp $ar[$b]) || ($dop[$b]<=>$dop[$a])} 1..$last)
 {  {
   if ($ar[$q] eq $ar[$cur]) {$equal{$q}=$cur} else {$cur=$q}     if ($ar[$q] eq $ar[$cur]) {$equal{$q}=$cur} else {$cur=$q} 
 }  }

Removed from v.1.8  
changed lines
  Added in v.1.11


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