Return to makeeditors.pl CVS log

Up to [Local Repository] / db / prgsrc

Annotation of db/prgsrc/makeeditors.pl, revision 1.4

1.1       roma7       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+$/;
1.4     ! roma7      54:    @parts = split ' ',<NICKS>;
        !            55:    $_ = ucfirst lc $_ foreach  @parts;
        !            56:    $surname = pop @parts;
        !            57:    $name{$nick}= join ' ', @parts;
1.1       roma7      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'}='Псевдоним';
1.3       roma7      69: $surname{'team'}='Авторов';
                     70: $name{'team'}='Коллектив';
1.1       roma7      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;