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