#!/usr/bin/perl -w =head1 NAME makeeditors.pl - скрипт для создания таблиц авторов =head1 SYNOPSIS makeeditors.pl =head1 DESCRIPTION Скрипт создаёт и заполняет таблицу E2T и апдейтит таблицу Authors, используя информацию из файлов authors,nicks,ssnicks =head1 AUTHOR Роман Семизаров =cut use dbchgk; use Data::Dumper; 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/ueditors"; open UNICKS, ">$DUMPDIR/uenicks"; 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 () { ($number,$nick)=split; next unless $number; next unless $number=~/^\d+$/; @parts = split ' ',; $_ = ucfirst lc $_ foreach @parts; $surname = pop @parts; $name{$nick}= join ' ', @parts; $surname=~s/\-(.)/"-". uc $1/ge; $surname=~s/\'(.)/"'". uc $1/ge; $surname{$nick}= $surname; $sn = "$name $surname"; $sn =~ tr/Ёё/Ее/; $nickfromname{uc $sn} = $nick; } $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 EDITORS,"<$editorsfile" or die "Can not open editors"; 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'; } # 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{$_} } } foreach $as(keys %unknick) { print UNICKS "$as \n ", (join "\n ", (grep {$nick{$_}=~/$as/} keys %nick)); print UNICKS "\n"; } getalltours('Id','Editors', 'ParentId', 'Type'); my $Tours; while (($TournamentId, $editor, $parent, $type)=getrow,$TournamentId) { $Tours{$TournamentId}->{editor} = $editor; $Tours{$TournamentId}->{parent} = $parent; $Tours{$TournamentId}->{type} = $type; push @{$Tours{$parent}->{children}}, $TournamentId; } foreach $t(keys %Tours) { %tour = %{$Tours{$t}}; if ( (exists $tour{'children'}) && ($tour{'type'} eq 'Ч') ) { $childrenSameAuthor = 1; foreach (@{$tour{children}}) { if ($Tours{$_} -> {editor} ne $tour{editor}) { $childrenSameAuthor = 0; } else { $Tours{$_} -> {editor} = ''; } } } } foreach (keys %Tours) { $editor = $Tours{$_}->{editor}; $TournamentId = $_; next unless $editor; $editor=~s/([\.\,\:\!\?])/$1 /gm; $editor=~s/^\s+//mg; $editor=~s/\\n/ /g; $editor=~s/\s+$//mg; $editor=~s/\s+/ /mg; $editor=uc $editor; $e4split = $editor; $e4split=~s/\(.*?\)//mg; $e4split=~s/Ё/Е/mg; $e4split=~s/^\s*//; $e4split=~s/\s*$//; $e4split=~s/\.$//; $e4split=~s/ - ТОП-РЕДАКТОР//; @editors = split /\s*[,;]\s+|\s+[иИ]\s+/, $e4split; $ok = 1; @nicks = (); foreach $ed(@editors) { if ($nickfromname{$ed}) { push @nicks, $nickfromname{$ed}; } else { @nicks=(); $ok = 0; last; } } if (!@nicks && ($nick = $nick{$editor})) { @nicks = split ' ',$nick; } if (@nicks) { push @{$tours{$_}},$TournamentId foreach @nicks; } else { $unknown{$editor}=1; } } print scalar keys %nick , " editors found\n"; #print STDERR "$_ ".$name{$_}."!\n" foreach keys %name; addtours2author($_,$name{$_},$surname{$_},$tours{$_},$ssnick{$_}) foreach keys %tours; print UNKNOWN "$_\n" foreach sort keys %unknown;