Return to makeauthors.pl CVS log

Up to [Local Repository] / db / prgsrc

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

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: 
1.3     ! boris      27: my $DUMPDIR = $ENV{DUMPDIR} || "../dump";
        !            28: 
1.1       roma7      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";
1.3     ! boris      34: open UNKNOWN, ">$DUMPDIR/uauthors";
        !            35: open UNICKS, ">$DUMPDIR/unicks";
        !            36: open STDERR, ">$DUMPDIR/errors";
1.1       roma7      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:        mydo("DROP TABLE IF EXISTS Authors");
                     49: mydo("CREATE TABLE Authors
                     50: (
                     51:                 Id     INT NOT NULL PRIMARY KEY AUTO_INCREMENT,
                     52:                             KEY idkey (Id),
                     53:                CharId     CHAR(20),
                     54:                Name   CHAR(50),
                     55:                Surname CHAR(50),
                     56:                Nicks TEXT,
                     57:                QNumber INT
                     58: )");
                     59: 
                     60: mydo ("DROP TABLE IF EXISTS A2Q");
                     61: mydo("CREATE TABLE A2Q
                     62: (
                     63:                 Id  INT NOT NULL PRIMARY KEY AUTO_INCREMENT,
                     64:                 Author INT UNSIGNED ,
                     65:                 Question INT UNSIGNED 
                     66: )
                     67: 
                     68:             "
                     69:             );
                     70: 
                     71: 
                     72: while (<NICKS>)
                     73: {
                     74:    ($number,$nick)=split;
                     75:    next unless $number=~/^\d+$/;
                     76:    ($name,$surname)=split ' ',<NICKS>;
                     77:    $name{$nick}= ucfirst lc $name;
                     78:    $surname=ucfirst lc $surname;
                     79:    $surname=~s/\-(.)/"-". uc $1/ge;
                     80:    $surname{$nick}= $surname;
                     81:    
                     82: }
                     83: $surname{'error'}='Глюков';
                     84: $name{'error'}='Очепят';
                     85: $surname{'unknown'}='Неизвестный';
                     86: $name{'unknown'}='Псевдоним';
                     87: $surname{'team'}='Капитанова';
                     88: $name{'team'}='Команда_';
                     89: 
                     90: 
                     91: while (<SSNICKS>)
                     92: {
                     93:    $str=$_;
                     94:    ($number,$n)=split ' ',$str;
                     95:    if ($number=~/\d+/) {$nick=$n;next}
                     96:    $str=~s/^\s+//;
                     97:    $str=~s/\s+$//;   
                     98:    $str=~s/\s+/ /;
                     99:    $ssnick{$nick}.="|$str";
                    100: }
                    101: 
                    102: 
                    103: close (NICKS);
                    104: close (SSNICKS);
                    105: 
                    106: 
                    107: 
                    108: open AUTHORS,"<$authorsfile" or die "Can not open authors";
                    109: 
                    110: while (<AUTHORS>)
                    111: {
                    112:    ($nick,$number,$descr)=m/^([a-zA-Z][a-zA-Z\s]+)(\d+)\s+(.*)$/g;
                    113:    if (!$nick) 
                    114:    {
                    115:       ($number,$descr)=m/^(\d+)\s+(.*)$/g;
                    116:       $nick='unknown';
                    117:    }
                    118:    $nick=~s/\s*$//;
                    119:    $descr=~s/([\.\,\:\!\?])/$1 /g;
                    120:    $descr=~s/\\n/ /g;
                    121:    $descr=~s/^\s+//g;
                    122:    $descr=~s/\s+$//g;
                    123:    $descr=~s/\s+/ /g;
                    124:    $descr=uc $descr;
                    125: # die "$descr" unless $descr;
                    126: #   die "Duplicated description \"$descr\"" if ($nick{$descr});
                    127:    $nick{$descr}=$nick;
                    128:    foreach (split ' ', $nick)
                    129:    {
                    130:       $unknick{$_}=1  unless $name{$_}
                    131:    }
                    132: }
                    133: 
                    134: 
                    135: foreach $as(keys %unknick)
                    136: {
1.2       roma7     137:     print UNICKS "$as \n ", (join "\n ", (grep {$nick{$_}=~/$as/} keys %nick));
                    138:     print UNICKS "\n";
1.1       roma7     139: }
                    140: 
                    141: %forbidden=checktable('equalto')? getequalto : ();
                    142: 
                    143: #print scalar keys %forbidden, "forbidden questions\n";
                    144: 
                    145: getbase('QuestionId','Authors');
                    146: 
                    147: while (($QuestionId, $author)=getrow,$QuestionId)
                    148: {
                    149:    next unless $author;
                    150:    $author=~s/([\.\,\:\!\?])/$1 /gm;
                    151:    $author=~s/^\s+//mg;
                    152:    $author=~s/\\n/ /g;
                    153:    $author=~s/\s+$//mg;
                    154:    $author=~s/\s+/ /mg;
                    155:    $author=uc $author;
                    156: 
                    157:    if ($nick = $nick{$author}) 
                    158:    { 
                    159:       my @a=split ' ',$nick;
                    160:       push @{$questions{$_}},$QuestionId foreach @a;
                    161:    }
                    162:    else 
                    163:    {
                    164:       $unknown{$author}=1;
                    165:    }
                    166: }
                    167: 
                    168: 
                    169: 
                    170: print scalar keys %nick , " authors found\n";
                    171: 
                    172: 
                    173: #print STDERR "$_ ".$name{$_}."!\n" foreach keys %name;
                    174: 
                    175: addauthors($_,$name{$_},$surname{$_},$questions{$_},$ssnick{$_},\%forbidden) foreach keys %questions;
                    176: 
                    177: print UNKNOWN "$_\n" foreach sort keys %unknown;