Return to makeauthors.pl CVS log

Up to [Local Repository] / db / prgsrc

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

1.1     ! roma7       1: 
        !             2: #!/usr/local/bin/perl -w
        !             3: 
        !             4: =head1 NAME
        !             5: 
        !             6: makeauthors.pl - скрипт для создания таблиц авторов
        !             7: 
        !             8: =head1 SYNOPSIS
        !             9: 
        !            10: makeauthors.pl
        !            11: 
        !            12: =head1 DESCRIPTION
        !            13: 
        !            14: Скрипт создаёт и заполянет таблицы authors и A2Q, используя 
        !            15: информацию из файлов authors,nicks,ssnicks
        !            16: 
        !            17: =head1 AUTHOR
        !            18: 
        !            19: Роман Семизаров
        !            20: 
        !            21: 
        !            22: =cut
        !            23: 
        !            24: 
        !            25: use dbchgk;
        !            26: 
        !            27: do "chgk.cnf";
        !            28: use locale;
        !            29: use POSIX qw (locale_h);
        !            30: open NICKS, "<$nicksfile" or die "Can not open nicks";
        !            31: open SSNICKS, "<$ssnicksfile" or die "Can not open ssnicks";
        !            32: open UNKNOWN, ">uauthors";
        !            33: open STDERR, ">errors";
        !            34:   my ($thislocale);
        !            35:   if ($^O =~ /win/i) {
        !            36:        $thislocale = "Russian_Russia.20866";
        !            37:   } else {
        !            38:        $thislocale = "ru_RU.KOI8-R"; 
        !            39:   }
        !            40:   POSIX::setlocale( &POSIX::LC_ALL, $thislocale );
        !            41:   if ((uc 'а') ne 'А') {die "!Koi8-r locale not installed!\n"};
        !            42: 
        !            43: 
        !            44: 
        !            45:        mydo("DROP TABLE IF EXISTS Authors");
        !            46: mydo("CREATE TABLE Authors
        !            47: (
        !            48:                 Id     INT NOT NULL PRIMARY KEY AUTO_INCREMENT,
        !            49:                             KEY idkey (Id),
        !            50:                CharId     CHAR(20),
        !            51:                Name   CHAR(50),
        !            52:                Surname CHAR(50),
        !            53:                Nicks TEXT,
        !            54:                QNumber INT
        !            55: )");
        !            56: 
        !            57: mydo ("DROP TABLE IF EXISTS A2Q");
        !            58: mydo("CREATE TABLE A2Q
        !            59: (
        !            60:                 Id  INT NOT NULL PRIMARY KEY AUTO_INCREMENT,
        !            61:                 Author INT UNSIGNED ,
        !            62:                 Question INT UNSIGNED 
        !            63: )
        !            64: 
        !            65:             "
        !            66:             );
        !            67: 
        !            68: 
        !            69: while (<NICKS>)
        !            70: {
        !            71:    ($number,$nick)=split;
        !            72:    next unless $number=~/^\d+$/;
        !            73:    ($name,$surname)=split ' ',<NICKS>;
        !            74:    $name{$nick}= ucfirst lc $name;
        !            75:    $surname=ucfirst lc $surname;
        !            76:    $surname=~s/\-(.)/"-". uc $1/ge;
        !            77:    $surname{$nick}= $surname;
        !            78:    
        !            79: }
        !            80: $surname{'error'}='Глюков';
        !            81: $name{'error'}='Очепят';
        !            82: $surname{'unknown'}='Неизвестный';
        !            83: $name{'unknown'}='Псевдоним';
        !            84: $surname{'team'}='Капитанова';
        !            85: $name{'team'}='Команда_';
        !            86: 
        !            87: 
        !            88: while (<SSNICKS>)
        !            89: {
        !            90:    $str=$_;
        !            91:    ($number,$n)=split ' ',$str;
        !            92:    if ($number=~/\d+/) {$nick=$n;next}
        !            93:    $str=~s/^\s+//;
        !            94:    $str=~s/\s+$//;   
        !            95:    $str=~s/\s+/ /;
        !            96:    $ssnick{$nick}.="|$str";
        !            97: }
        !            98: 
        !            99: 
        !           100: close (NICKS);
        !           101: close (SSNICKS);
        !           102: 
        !           103: 
        !           104: 
        !           105: open AUTHORS,"<$authorsfile" or die "Can not open authors";
        !           106: 
        !           107: while (<AUTHORS>)
        !           108: {
        !           109:    ($nick,$number,$descr)=m/^([a-zA-Z][a-zA-Z\s]+)(\d+)\s+(.*)$/g;
        !           110:    if (!$nick) 
        !           111:    {
        !           112:       ($number,$descr)=m/^(\d+)\s+(.*)$/g;
        !           113:       $nick='unknown';
        !           114:    }
        !           115:    $nick=~s/\s*$//;
        !           116:    $descr=~s/([\.\,\:\!\?])/$1 /g;
        !           117:    $descr=~s/\\n/ /g;
        !           118:    $descr=~s/^\s+//g;
        !           119:    $descr=~s/\s+$//g;
        !           120:    $descr=~s/\s+/ /g;
        !           121:    $descr=uc $descr;
        !           122: # die "$descr" unless $descr;
        !           123: #   die "Duplicated description \"$descr\"" if ($nick{$descr});
        !           124:    $nick{$descr}=$nick;
        !           125:    foreach (split ' ', $nick)
        !           126:    {
        !           127:       $unknick{$_}=1  unless $name{$_}
        !           128:    }
        !           129: }
        !           130: 
        !           131: 
        !           132: foreach $as(keys %unknick)
        !           133: {
        !           134:     print "$as \n ", (join "\n ", (grep {$nick{$_}=~/$as/} keys %nick));
        !           135:     print "\n";
        !           136: }
        !           137: 
        !           138: %forbidden=checktable('equalto')? getequalto : ();
        !           139: 
        !           140: #print scalar keys %forbidden, "forbidden questions\n";
        !           141: 
        !           142: getbase('QuestionId','Authors');
        !           143: 
        !           144: while (($QuestionId, $author)=getrow,$QuestionId)
        !           145: {
        !           146:    next unless $author;
        !           147:    $author=~s/([\.\,\:\!\?])/$1 /gm;
        !           148:    $author=~s/^\s+//mg;
        !           149:    $author=~s/\\n/ /g;
        !           150:    $author=~s/\s+$//mg;
        !           151:    $author=~s/\s+/ /mg;
        !           152:    $author=uc $author;
        !           153: 
        !           154:    if ($nick = $nick{$author}) 
        !           155:    { 
        !           156:       my @a=split ' ',$nick;
        !           157:       push @{$questions{$_}},$QuestionId foreach @a;
        !           158:    }
        !           159:    else 
        !           160:    {
        !           161:       $unknown{$author}=1;
        !           162:    }
        !           163: }
        !           164: 
        !           165: 
        !           166: 
        !           167: print scalar keys %nick , " authors found\n";
        !           168: 
        !           169: 
        !           170: #print STDERR "$_ ".$name{$_}."!\n" foreach keys %name;
        !           171: 
        !           172: addauthors($_,$name{$_},$surname{$_},$questions{$_},$ssnick{$_},\%forbidden) foreach keys %questions;
        !           173: 
        !           174: print UNKNOWN "$_\n" foreach sort keys %unknown;