#!/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 () { ($number,$nick)=split; next unless $number=~/^\d+$/; ($name,$surname)=split ' ',; $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 () { $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 () { ($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;