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