Annotation of db/prgsrc/makeeditors.pl, revision 1.4
1.1 roma7 1: #!/usr/bin/perl -w
2:
3: =head1 NAME
4:
5: makeeditors.pl - скрипт для создания таблиц авторов
6:
7: =head1 SYNOPSIS
8:
9: makeeditors.pl
10:
11: =head1 DESCRIPTION
12:
13: Скрипт создаёт и заполняет таблицу E2T и апдейтит таблицу Authors, используя
14: информацию из файлов authors,nicks,ssnicks
15:
16: =head1 AUTHOR
17:
18: Роман Семизаров
19:
20:
21: =cut
22:
23:
24: use dbchgk;
25: use Data::Dumper;
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/ueditors";
35: open UNICKS, ">$DUMPDIR/uenicks";
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: while (<NICKS>)
49: {
50:
51: ($number,$nick)=split;
52: next unless $number;
53: next unless $number=~/^\d+$/;
1.4 ! roma7 54: @parts = split ' ',<NICKS>;
! 55: $_ = ucfirst lc $_ foreach @parts;
! 56: $surname = pop @parts;
! 57: $name{$nick}= join ' ', @parts;
1.1 roma7 58: $surname=~s/\-(.)/"-". uc $1/ge;
59: $surname=~s/\'(.)/"'". uc $1/ge;
60: $surname{$nick}= $surname;
61: $sn = "$name $surname";
62: $sn =~ tr/Ёё/Ее/;
63: $nickfromname{uc $sn} = $nick;
64: }
65: $surname{'error'}='Глюков';
66: $name{'error'}='Очепят';
67: $surname{'unknown'}='Неизвестный';
68: $name{'unknown'}='Псевдоним';
1.3 roma7 69: $surname{'team'}='Авторов';
70: $name{'team'}='Коллектив';
1.1 roma7 71:
72:
73: while (<SSNICKS>)
74: {
75: $str=$_;
76: ($number,$n)=split ' ',$str;
77: if ($number=~/\d+/) {$nick=$n;next}
78: $str=~s/^\s+//;
79: $str=~s/\s+$//;
80: $str=~s/\s+/ /;
81: $ssnick{$nick}.="|$str";
82: }
83:
84:
85: close (NICKS);
86: close (SSNICKS);
87:
88:
89:
90: open EDITORS,"<$editorsfile" or die "Can not open editors";
91:
92: while (<EDITORS>)
93: {
94: ($nick,$number,$descr)=m/^([a-zA-Z][a-zA-Z\s]+)(\d+)\s+(.*)$/g;
95: if (!$nick)
96: {
97: ($number,$descr)=m/^(\d+)\s+(.*)$/g;
98: $nick='unknown';
99: }
100: # if ($nick=~s/\s*$//)
101: $descr=~s/([\.\,\:\!\?])/$1 /g;
102: $descr=~s/\\n/ /g;
103: $descr=~s/^\s+//g;
104: $descr=~s/\s+$//g;
105: $descr=~s/\s+/ /g;
106: $descr=uc $descr;
107: # die "$descr" unless $descr;
108: # die "Duplicated description \"$descr\"" if ($nick{$descr});
109: $nick{$descr}=$nick;
110: foreach (split ' ', $nick)
111: {
112: $unknick{$_}=1 unless $name{$_}
113: }
114: }
115:
116:
117: foreach $as(keys %unknick)
118: {
119: print UNICKS "$as \n ", (join "\n ", (grep {$nick{$_}=~/$as/} keys %nick));
120: print UNICKS "\n";
121: }
122:
123: getalltours('Id','Editors', 'ParentId', 'Type');
124: my $Tours;
125: while (($TournamentId, $editor, $parent, $type)=getrow,$TournamentId) {
126: $Tours{$TournamentId}->{editor} = $editor;
127: $Tours{$TournamentId}->{parent} = $parent;
128: $Tours{$TournamentId}->{type} = $type;
129: push @{$Tours{$parent}->{children}}, $TournamentId;
130: }
131:
132: foreach $t(keys %Tours) {
133: %tour = %{$Tours{$t}};
134: if (
135:
136: (exists $tour{'children'}) &&
137: ($tour{'type'} eq 'Ч')
138: ) {
139: $childrenSameAuthor = 1;
140: foreach (@{$tour{children}}) {
141: if ($Tours{$_} -> {editor} ne $tour{editor}) {
142: $childrenSameAuthor = 0;
143: } else {
144: $Tours{$_} -> {editor} = '';
145: }
146: }
147: }
148: }
149:
150: foreach (keys %Tours)
151: {
152: $editor = $Tours{$_}->{editor};
153: $TournamentId = $_;
154: next unless $editor;
155: $editor=~s/([\.\,\:\!\?])/$1 /gm;
156: $editor=~s/^\s+//mg;
157: $editor=~s/\\n/ /g;
158: $editor=~s/\s+$//mg;
159: $editor=~s/\s+/ /mg;
160: $editor=uc $editor;
161: $e4split = $editor;
162: $e4split=~s/\(.*?\)//mg;
163: $e4split=~s/Ё/Е/mg;
164: $e4split=~s/^\s*//;
165: $e4split=~s/\s*$//;
166: $e4split=~s/\.$//;
167: $e4split=~s/ - ТОП-РЕДАКТОР//;
168:
169: @editors = split /\s*[,;]\s+|\s+[иИ]\s+/, $e4split;
170: $ok = 1;
171: @nicks = ();
172: foreach $ed(@editors) {
173: if ($nickfromname{$ed}) {
174: push @nicks, $nickfromname{$ed};
175: } else {
176: @nicks=();
177: $ok = 0;
178: last;
179: }
180: }
181: if (!@nicks && ($nick = $nick{$editor})) {
182: @nicks = split ' ',$nick;
183: }
184: if (@nicks)
185: {
186: push @{$tours{$_}},$TournamentId foreach @nicks;
187: }
188: else
189: {
190: $unknown{$editor}=1;
191: }
192: }
193:
194:
195:
196: print scalar keys %nick , " editors found\n";
197:
198:
199: #print STDERR "$_ ".$name{$_}."!\n" foreach keys %name;
200:
201: addtours2author($_,$name{$_},$surname{$_},$tours{$_},$ssnick{$_}) foreach keys %tours;
202:
203: print UNKNOWN "$_\n" foreach sort keys %unknown;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>