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: while (<NICKS>)
48: {
49: next unless /\S/;
50: ($number,$nick)=split;
51: next unless $number=~/^\d+$/;
52: ($name,$surname)=split ' ',<NICKS>;
53: $name{$nick}= ucfirst lc $name;
54: $surname||='';
55: $surname=ucfirst lc $surname;
56: $surname=~s/\-(.)/"-". uc $1/ge;
57: $surname=~s/\'(.)/"'". uc $1/ge;
58: $surname{$nick}= $surname;
59: }
60:
61: $surname{'error'}='Глюков';
62: $name{'error'}='Очепят';
63: $surname{'unknown'}='Неизвестный';
64: $name{'unknown'}='Псевдоним';
65: $surname{'team'}='Авторов';
66: $name{'team'}='Коллектив';
67:
68:
69: while (<SSNICKS>)
70: {
71: $str=$_;
72: ($number,$n)=split ' ',$str;
73: if ($number=~/\d+/) {$nick=$n;next}
74: $str=~s/^\s+//;
75: $str=~s/\s+$//;
76: $str=~s/\s+/ /;
77: $ssnick{$nick}.="|$str";
78: }
79:
80: close (NICKS);
81: close (SSNICKS);
82:
83: open AUTHORS,"<$authorsfile" or die "Can not open authors";
84: print "REading authors...\n";
85: while (<AUTHORS>)
86: {
87:
88: ($nick,$number,$descr)=m/^([a-zA-Z][a-zA-Z\s]+)(\d+)\s+(.*)$/g;
89: if (!$nick)
90: {
91: ($number,$descr)=m/^(\d+)\s+(.*)$/g;
92: $nick='unknown';
93: }
94: # if ($nick=~s/\s*$//)
95: $descr=~s/([\.\,\:\!\?])/$1 /g;
96: $descr=~s/\\n/ /g;
97: $descr=~s/^\s+//g;
98: $descr=~s/\s+$//g;
99: $descr=~s/\s+/ /g;
100: $descr=uc $descr;
101: # die "$descr" unless $descr;
102: # die "Duplicated description \"$descr\"" if ($nick{$descr});
103: $nick{$descr}=$nick;
104: foreach (split ' ', $nick)
105: {
106: $unknick{$_}=1 unless $name{$_}
107: }
108: }
109:
110: print "printing unknown...\n";
111: foreach $as(keys %unknick)
112: {
113: print UNICKS "$as \n ", (join "\n ", (grep {$nick{$_}=~/$as/} keys %nick));
114: print UNICKS "\n";
115: }
116:
117: %forbidden=tableexists('equalto')? getequalto : ();
118:
119: #print scalar keys %forbidden, "forbidden questions\n";
120:
121: getbase('QuestionId','Authors');
122: while (($QuestionId, $author)=getrow,$QuestionId)
123: {
124: print "." unless $i++ % 100;
125: next unless $author;
126: $author=~s/([\.\,\:\!\?])/$1 /gm;
127: $author=~s/^\s+//mg;
128: $author=~s/\\n/ /g;
129: $author=~s/\s+$//mg;
130: $author=~s/\s+/ /mg;
131: $author=uc $author;
132: $author=~s/ё/е/mg;
133: if ($nick = $nick{$author})
134: {
135: my @a=split ' ',$nick;
136: foreach $tmp(@a) {
137: if ($tmp eq '!!!') {
138: print STDERR "!$author!".$QuestionId."\n";
139: }
140: }
141: push @{$questions{$_}},$QuestionId foreach @a;
142: }
143: else
144: {
145: $unknown{$author}=1;
146: }
147: }
148:
149:
150:
151: print scalar keys %nick , " authors found\n";
152:
153:
154: #print STDERR "$_ ".$name{$_}."!\n" foreach keys %name;
155: addquestions2author($_,$name{$_},$surname{$_},$questions{$_},$ssnick{$_},\%forbidden) foreach keys %questions;
156:
157: print UNKNOWN "$_\n" foreach sort keys %unknown;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>