Return to makeauthors.pl CVS log

Up to [Local Repository] / db / prgsrc

Made makefile a little bit more friendly

#!/usr/local/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"};



	mydo("DROP TABLE IF EXISTS Authors");
mydo("CREATE TABLE Authors
(
                Id     INT NOT NULL PRIMARY KEY AUTO_INCREMENT,
                            KEY idkey (Id),
		CharId     CHAR(20),
		Name   CHAR(50),
		Surname CHAR(50),
		Nicks TEXT,
		QNumber INT
)");

mydo ("DROP TABLE IF EXISTS A2Q");
mydo("CREATE TABLE A2Q
(
                Id  INT NOT NULL PRIMARY KEY AUTO_INCREMENT,
                Author INT UNSIGNED ,
                Question INT UNSIGNED 
)

	     "
            );


while (<NICKS>)
{
   ($number,$nick)=split;
   next unless $number=~/^\d+$/;
   ($name,$surname)=split ' ',<NICKS>;
   $name{$nick}= ucfirst lc $name;
   $surname=ucfirst lc $surname;
   $surname=~s/\-(.)/"-". uc $1/ge;
   $surname{$nick}= $surname;
   
}
$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";

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';
   }
   $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{$_}
   }
}


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

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

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

getbase('QuestionId','Authors');

while (($QuestionId, $author)=getrow,$QuestionId)
{
   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;

   if ($nick = $nick{$author}) 
   { 
      my @a=split ' ',$nick;
      push @{$questions{$_}},$QuestionId foreach @a;
   }
   else 
   {
      $unknown{$author}=1;
   }
}



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


#print STDERR "$_ ".$name{$_}."!\n" foreach keys %name;

addauthors($_,$name{$_},$surname{$_},$questions{$_},$ssnick{$_},\%forbidden) foreach keys %questions;

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