File:  [Local Repository] / db / prgsrc / makeauthors.pl
Revision 1.3: download - view: text, annotated - select for diffs - revision graph
Thu Jan 9 01:43:21 2003 UTC (21 years, 4 months ago) by boris
Branches: MAIN
CVS tags: HEAD
Made makefile a little bit more friendly

    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: 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/uauthors";
   35: open UNICKS, ">$DUMPDIR/unicks";
   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: 	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: {
  137:     print UNICKS "$as \n ", (join "\n ", (grep {$nick{$_}=~/$as/} keys %nick));
  138:     print UNICKS "\n";
  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;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>