#!/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;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>