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