Return to makeeditors.pl CVS log

Up to [Local Repository] / db / prgsrc

Vozmozhnost' dvojnykh imen u redaktorov

    1: #!/usr/bin/perl -w
    2: 
    3: =head1 NAME
    4: 
    5: makeeditors.pl - скрипт для создания таблиц авторов
    6: 
    7: =head1 SYNOPSIS
    8: 
    9: makeeditors.pl
   10: 
   11: =head1 DESCRIPTION
   12: 
   13: Скрипт создаёт и заполняет таблицу E2T и апдейтит таблицу Authors, используя 
   14: информацию из файлов authors,nicks,ssnicks
   15: 
   16: =head1 AUTHOR
   17: 
   18: Роман Семизаров
   19: 
   20: 
   21: =cut
   22: 
   23: 
   24: use dbchgk;
   25: use Data::Dumper;
   26: 
   27: my $DUMPDIR = $ENV{DUMPDIR} || "../dump";
   28: 
   29: do "chgk.cnf";
   30: use locale;
   31: use POSIX qw (locale_h);
   32: open NICKS, "<$nicksfile" or die "Can not open nicks";
   33: open SSNICKS, "<$ssnicksfile" or die "Can not open ssnicks";
   34: open UNKNOWN, ">$DUMPDIR/ueditors";
   35: open UNICKS, ">$DUMPDIR/uenicks";
   36: open STDERR, ">$DUMPDIR/errors";
   37:   my ($thislocale);
   38:   if ($^O =~ /win/i) {
   39: 	$thislocale = "Russian_Russia.20866";
   40:   } else {
   41: 	$thislocale = "ru_RU.KOI8-R"; 
   42:   }
   43:   POSIX::setlocale( &POSIX::LC_ALL, $thislocale );
   44:   if ((uc 'а') ne 'А') {die "!Koi8-r locale not installed!\n"};
   45: 
   46: 
   47: 
   48: while (<NICKS>)
   49: {
   50: 
   51:    ($number,$nick)=split;   
   52:    next unless $number;   
   53:    next unless $number=~/^\d+$/;
   54:    @parts = split ' ',<NICKS>;
   55:    $_ = ucfirst lc $_ foreach  @parts;
   56:    $surname = pop @parts;
   57:    $name{$nick}= join ' ', @parts;
   58:    $surname=~s/\-(.)/"-". uc $1/ge;
   59:    $surname=~s/\'(.)/"'". uc $1/ge;
   60:    $surname{$nick}= $surname;
   61:    $sn = "$name $surname";
   62:    $sn =~ tr/Ёё/Ее/;
   63:    $nickfromname{uc $sn} = $nick;   
   64: }
   65: $surname{'error'}='Глюков';
   66: $name{'error'}='Очепят';
   67: $surname{'unknown'}='Неизвестный';
   68: $name{'unknown'}='Псевдоним';
   69: $surname{'team'}='Авторов';
   70: $name{'team'}='Коллектив';
   71: 
   72: 
   73: while (<SSNICKS>)
   74: {
   75:    $str=$_;
   76:    ($number,$n)=split ' ',$str;
   77:    if ($number=~/\d+/) {$nick=$n;next}
   78:    $str=~s/^\s+//;
   79:    $str=~s/\s+$//;   
   80:    $str=~s/\s+/ /;
   81:    $ssnick{$nick}.="|$str";
   82: }
   83: 
   84: 
   85: close (NICKS);
   86: close (SSNICKS);
   87: 
   88: 
   89: 
   90: open EDITORS,"<$editorsfile" or die "Can not open editors";
   91: 
   92: while (<EDITORS>)
   93: {
   94:    ($nick,$number,$descr)=m/^([a-zA-Z][a-zA-Z\s]+)(\d+)\s+(.*)$/g;
   95:    if (!$nick) 
   96:    {
   97:       ($number,$descr)=m/^(\d+)\s+(.*)$/g;
   98:       $nick='unknown';
   99:    }
  100: #   if ($nick=~s/\s*$//)
  101:    $descr=~s/([\.\,\:\!\?])/$1 /g;
  102:    $descr=~s/\\n/ /g;
  103:    $descr=~s/^\s+//g;
  104:    $descr=~s/\s+$//g;
  105:    $descr=~s/\s+/ /g;
  106:    $descr=uc $descr;
  107: # die "$descr" unless $descr;
  108: #   die "Duplicated description \"$descr\"" if ($nick{$descr});
  109:    $nick{$descr}=$nick;
  110:    foreach (split ' ', $nick)
  111:    {
  112:       $unknick{$_}=1  unless $name{$_}
  113:    }
  114: }
  115: 
  116: 
  117: foreach $as(keys %unknick)
  118: {
  119:     print UNICKS "$as \n ", (join "\n ", (grep {$nick{$_}=~/$as/} keys %nick));
  120:     print UNICKS "\n";
  121: }
  122: 
  123: getalltours('Id','Editors', 'ParentId', 'Type');
  124: my $Tours;
  125: while (($TournamentId, $editor, $parent, $type)=getrow,$TournamentId) {
  126:   $Tours{$TournamentId}->{editor} = $editor;
  127:   $Tours{$TournamentId}->{parent} = $parent;  
  128:   $Tours{$TournamentId}->{type}   = $type;
  129:   push @{$Tours{$parent}->{children}}, $TournamentId;
  130: }
  131: 
  132: foreach $t(keys %Tours) {
  133:   %tour = %{$Tours{$t}};
  134:   if (
  135:   
  136:     (exists $tour{'children'}) && 
  137:     ($tour{'type'} eq 'Ч')
  138:   ) {
  139:   $childrenSameAuthor = 1;
  140:     foreach (@{$tour{children}}) {
  141:       if ($Tours{$_} -> {editor} ne $tour{editor}) {
  142:         $childrenSameAuthor = 0;
  143:       } else {
  144:         $Tours{$_} -> {editor} = '';
  145:       }
  146:     }
  147:   }
  148: }
  149: 
  150: foreach  (keys %Tours)
  151: {
  152:    $editor = $Tours{$_}->{editor};
  153:    $TournamentId = $_;
  154:    next unless $editor;
  155:    $editor=~s/([\.\,\:\!\?])/$1 /gm;
  156:    $editor=~s/^\s+//mg;
  157:    $editor=~s/\\n/ /g;
  158:    $editor=~s/\s+$//mg;
  159:    $editor=~s/\s+/ /mg;
  160:    $editor=uc $editor;
  161:    $e4split = $editor;
  162:    $e4split=~s/\(.*?\)//mg;   
  163:    $e4split=~s/Ё/Е/mg;
  164:    $e4split=~s/^\s*//;
  165:    $e4split=~s/\s*$//;
  166:    $e4split=~s/\.$//;
  167:    $e4split=~s/ - ТОП-РЕДАКТОР//;
  168:    
  169:    @editors = split /\s*[,;]\s+|\s+[иИ]\s+/, $e4split;
  170:    $ok = 1;
  171:    @nicks = ();
  172:    foreach $ed(@editors) {
  173:      if ($nickfromname{$ed}) {
  174:        push @nicks, $nickfromname{$ed};
  175:      } else {
  176:        @nicks=();
  177:        $ok = 0;
  178:        last;
  179:      }
  180:    }
  181:    if (!@nicks && ($nick = $nick{$editor})) {
  182:      @nicks = split ' ',$nick;
  183:    }
  184:    if (@nicks) 
  185:    { 
  186:       push @{$tours{$_}},$TournamentId foreach @nicks;
  187:    }
  188:    else 
  189:    {
  190:       $unknown{$editor}=1;
  191:    }
  192: }
  193: 
  194: 
  195: 
  196: print scalar keys %nick , " editors found\n";
  197: 
  198: 
  199: #print STDERR "$_ ".$name{$_}."!\n" foreach keys %name;
  200: 
  201: addtours2author($_,$name{$_},$surname{$_},$tours{$_},$ssnick{$_}) foreach keys %tours;
  202: 
  203: print UNKNOWN "$_\n" foreach sort keys %unknown;