File:  [Local Repository] / db / prgsrc / makeeditors.pl
Revision 1.4: download - view: text, annotated - select for diffs - revision graph
Sat May 15 15:46:15 2010 UTC (13 years, 11 months ago) by roma7
Branches: MAIN
CVS tags: HEAD
Vozmozhnost' dvojnykh imen u redaktorov

#!/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 (<NICKS>)
{

   ($number,$nick)=split;   
   next unless $number;   
   next unless $number=~/^\d+$/;
   @parts = split ' ',<NICKS>;
   $_ = 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 (<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 EDITORS,"<$editorsfile" or die "Can not open editors";

while (<EDITORS>)
{
   ($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;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>