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;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>