Return to makeauthors.pl CVS log

Up to [Local Repository] / db / prgsrc

authors fix

#!/usr/bin/perl -w

=head1 NAME

makeauthors.pl - скрипт для создания таблиц авторов

=head1 SYNOPSIS

makeauthors.pl

=head1 DESCRIPTION

Скрипт создаёт и заполянет таблицы authors и A2Q, используя 
информацию из файлов authors,nicks,ssnicks

=head1 AUTHOR

Роман Семизаров


=cut


use dbchgk;

my $DUMPDIR = $ENV{DUMPDIR} || "../dump";

do "chgk.cnf";
use locale;
use POSIX qw (locale_h);
open NICKS, "<$nicksfile" or die "Can not open nicks";
open SSNICKS, "<$ssnicksfile" or die "Can not open ssnicks";
open UNKNOWN, ">$DUMPDIR/uauthors";
open UNICKS, ">$DUMPDIR/unicks";
open STDERR, ">$DUMPDIR/errors";
  my ($thislocale);
  if ($^O =~ /win/i) {
	$thislocale = "Russian_Russia.20866";
  } else {
	$thislocale = "ru_RU.KOI8-R"; 
  }
  POSIX::setlocale( &POSIX::LC_ALL, $thislocale );
  if ((uc 'а') ne 'А') {die "!Koi8-r locale not installed!\n"};



while (<NICKS>)
{
   ($number,$nick)=split;   
   next unless $number;   
   next unless $number=~/^\d+$/;
   @parts = split ' ',<NICKS>;
   $_ = ucfirst lc $_ foreach  @parts;
   $surname = pop @parts;
   my $name;
   $name = $name{$nick}= join ' ', @parts;
   $surname=~s/\-(.)/"-". uc $1/ge;
   $surname=~s/\'(.)/"'". uc $1/ge;
   $surname{$nick}= $surname;
   $sn = "$name $surname";
print "$name!$surname\n";
   $sn =~ tr/Ёё/Ее/;
   $nickfromname{uc $sn} = $nick;   
}

$surname{'error'}='Глюков';
$name{'error'}='Очепят';
$surname{'unknown'}='Неизвестный';
$name{'unknown'}='Псевдоним';
$surname{'team'}='Авторов';
$name{'team'}='Коллектив';


while (<SSNICKS>)
{
   $str=$_;
   ($number,$n)=split ' ',$str;
   if ($number=~/\d+/) {$nick=$n;next}
   $str=~s/^\s+//;
   $str=~s/\s+$//;   
   $str=~s/\s+/ /;
   $ssnick{$nick}.="|$str";
}

close (NICKS);
close (SSNICKS);

open AUTHORS,"<$authorsfile" or die "Can not open authors";
print "REading authors...\n";
while (<AUTHORS>)
{

   ($nick,$number,$descr)=m/^([a-zA-Z][a-zA-Z\s]+)(\d+)\s+(.*)$/g;
   if (!$nick) 
   {
      ($number,$descr)=m/^(\d+)\s+(.*)$/g;
      $nick='unknown';
   }
#   if ($nick=~s/\s*$//)
   $descr=~s/([\.\,\:\!\?])/$1 /g;
   $descr=~s/\\n/ /g;
   $descr=~s/^\s+//g;
   $descr=~s/\s+$//g;
   $descr=~s/\s+/ /g;
   $descr=uc $descr;
# die "$descr" unless $descr;
#   die "Duplicated description \"$descr\"" if ($nick{$descr});
   $nick{$descr}=$nick;
   foreach (split ' ', $nick)
   {
      $unknick{$_}=1  unless $name{$_}
   }
}

print "printing unknown...\n";
foreach $as(keys %unknick)
{
    print UNICKS "$as \n ", (join "\n ", (grep {$nick{$_}=~/$as/} keys %nick));
    print UNICKS "\n";
}

%forbidden=tableexists('equalto')? getequalto : ();

#print scalar keys %forbidden, "forbidden questions\n";

getbase('QuestionId','Authors');
while (($QuestionId, $author)=getrow,$QuestionId)
{
   print "." unless $i++ % 100;
   next unless $author;
   $author=~s/([\.\,\:\!\?])/$1 /gm;
   $author=~s/^\s+//mg;
   $author=~s/\\n/ /g;
   $author=~s/\s+$//mg;
   $author=~s/\s+/ /mg;
   $author=uc $author;
   $author=~s/ё/е/mg;
   if ($nick = $nick{$author}) 
   { 
      my @a=split ' ',$nick;
 foreach $tmp(@a) {
   if ($tmp eq '!!!') {
     print STDERR "!$author!".$QuestionId."\n";
   }
 }
      push @{$questions{$_}},$QuestionId foreach @a;
   }
   else 
   {
      $unknown{$author}=1;
   }
}



print scalar keys %nick , " authors found\n";


#print STDERR "$_ ".$name{$_}."!\n" foreach keys %name;
addquestions2author($_,$name{$_},$surname{$_},$questions{$_},$ssnick{$_},\%forbidden) foreach keys %questions;

print UNKNOWN "$_\n" foreach sort keys %unknown;