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>