Return to makeeditors.pl CVS log

Up to [Local Repository] / db / prgsrc

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

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+$/;
        !            54:    ($name,$surname)=split ' ',<NICKS>;
        !            55:    $name{$nick}= ucfirst lc $name;
        !            56:    $surname=ucfirst lc $surname;
        !            57:    $surname=~s/\-(.)/"-". uc $1/ge;
        !            58:    $surname=~s/\'(.)/"'". uc $1/ge;
        !            59:    $surname{$nick}= $surname;
        !            60:    $sn = "$name $surname";
        !            61:    $sn =~ tr/Ёё/Ее/;
        !            62:    $nickfromname{uc $sn} = $nick;   
        !            63: }
        !            64: $surname{'error'}='Глюков';
        !            65: $name{'error'}='Очепят';
        !            66: $surname{'unknown'}='Неизвестный';
        !            67: $name{'unknown'}='Псевдоним';
        !            68: $surname{'team'}='Капитанова';
        !            69: $name{'team'}='Команда_';
        !            70: 
        !            71: 
        !            72: while (<SSNICKS>)
        !            73: {
        !            74:    $str=$_;
        !            75:    ($number,$n)=split ' ',$str;
        !            76:    if ($number=~/\d+/) {$nick=$n;next}
        !            77:    $str=~s/^\s+//;
        !            78:    $str=~s/\s+$//;   
        !            79:    $str=~s/\s+/ /;
        !            80:    $ssnick{$nick}.="|$str";
        !            81: }
        !            82: 
        !            83: 
        !            84: close (NICKS);
        !            85: close (SSNICKS);
        !            86: 
        !            87: 
        !            88: 
        !            89: open EDITORS,"<$editorsfile" or die "Can not open editors";
        !            90: 
        !            91: while (<EDITORS>)
        !            92: {
        !            93:    ($nick,$number,$descr)=m/^([a-zA-Z][a-zA-Z\s]+)(\d+)\s+(.*)$/g;
        !            94:    if (!$nick) 
        !            95:    {
        !            96:       ($number,$descr)=m/^(\d+)\s+(.*)$/g;
        !            97:       $nick='unknown';
        !            98:    }
        !            99: #   if ($nick=~s/\s*$//)
        !           100:    $descr=~s/([\.\,\:\!\?])/$1 /g;
        !           101:    $descr=~s/\\n/ /g;
        !           102:    $descr=~s/^\s+//g;
        !           103:    $descr=~s/\s+$//g;
        !           104:    $descr=~s/\s+/ /g;
        !           105:    $descr=uc $descr;
        !           106: # die "$descr" unless $descr;
        !           107: #   die "Duplicated description \"$descr\"" if ($nick{$descr});
        !           108:    $nick{$descr}=$nick;
        !           109:    foreach (split ' ', $nick)
        !           110:    {
        !           111:       $unknick{$_}=1  unless $name{$_}
        !           112:    }
        !           113: }
        !           114: 
        !           115: 
        !           116: foreach $as(keys %unknick)
        !           117: {
        !           118:     print UNICKS "$as \n ", (join "\n ", (grep {$nick{$_}=~/$as/} keys %nick));
        !           119:     print UNICKS "\n";
        !           120: }
        !           121: 
        !           122: getalltours('Id','Editors', 'ParentId', 'Type');
        !           123: my $Tours;
        !           124: while (($TournamentId, $editor, $parent, $type)=getrow,$TournamentId) {
        !           125:   $Tours{$TournamentId}->{editor} = $editor;
        !           126:   $Tours{$TournamentId}->{parent} = $parent;  
        !           127:   $Tours{$TournamentId}->{type}   = $type;
        !           128:   push @{$Tours{$parent}->{children}}, $TournamentId;
        !           129: }
        !           130: 
        !           131: foreach $t(keys %Tours) {
        !           132:   %tour = %{$Tours{$t}};
        !           133:   print Dumper(\%tour);
        !           134:   if (
        !           135:   
        !           136:     (exists $tour{'children'}) && 
        !           137:     ($tour{'type'} eq 'Ч')
        !           138:   ) {
        !           139:   $childrenSameAuthor = 1;
        !           140:     foreach (@{$tour{children}}) {
        !           141: print $Tours{$_} -> {editor}." ne ".$tour{editor}."\n";
        !           142:       if ($Tours{$_} -> {editor} ne $tour{editor}) {
        !           143:         $childrenSameAuthor = 0;
        !           144:       } else {
        !           145:       print "!";
        !           146:         $Tours{$_} -> {editor} = '';
        !           147:       }
        !           148:     }
        !           149:   }
        !           150: }
        !           151: 
        !           152: foreach  (keys %Tours)
        !           153: {
        !           154:    $editor = $Tours{$_}->{editor};
        !           155:    $TournamentId = $_;
        !           156:    next unless $editor;
        !           157:    $editor=~s/([\.\,\:\!\?])/$1 /gm;
        !           158:    $editor=~s/^\s+//mg;
        !           159:    $editor=~s/\\n/ /g;
        !           160:    $editor=~s/\s+$//mg;
        !           161:    $editor=~s/\s+/ /mg;
        !           162:    $editor=uc $editor;
        !           163:    $e4split = $editor;
        !           164:    $e4split=~s/\(.*?\)//mg;   
        !           165:    $e4split=~s/Ё/Е/mg;
        !           166:    $e4split=~s/^\s*//;
        !           167:    $e4split=~s/\s*$//;
        !           168:    $e4split=~s/\.$//;
        !           169:    $e4split=~s/ - ТОП-РЕДАКТОР//;
        !           170:    
        !           171:    @editors = split /\s*[,;]\s+|\s+[иИ]\s+/, $e4split;
        !           172:    $ok = 1;
        !           173:    @nicks = ();
        !           174:    foreach $ed(@editors) {
        !           175:      if ($nickfromname{$ed}) {
        !           176:        push @nicks, $nickfromname{$ed};
        !           177:      } else {
        !           178:        @nicks=();
        !           179:        $ok = 0;
        !           180:        last;
        !           181:      }
        !           182:    }
        !           183:    if (!@nicks && ($nick = $nick{$editor})) {
        !           184:      @nicks = split ' ',$nick;
        !           185:    }
        !           186:    if (@nicks) 
        !           187:    { 
        !           188:       push @{$tours{$_}},$TournamentId foreach @nicks;
        !           189:    }
        !           190:    else 
        !           191:    {
        !           192:       $unknown{$editor}=1;
        !           193:    }
        !           194: }
        !           195: 
        !           196: 
        !           197: 
        !           198: print scalar keys %nick , " editors found\n";
        !           199: 
        !           200: 
        !           201: #print STDERR "$_ ".$name{$_}."!\n" foreach keys %name;
        !           202: 
        !           203: addtours2author($_,$name{$_},$surname{$_},$tours{$_},$ssnick{$_}) foreach keys %tours;
        !           204: 
        !           205: print UNKNOWN "$_\n" foreach sort keys %unknown;