version 1.1, 2001/12/05 00:56:57
|
version 1.10, 2010/09/24 16:58:57
|
Line 1
|
Line 1
|
|
#!/usr/bin/perl -w |
#!/usr/local/bin/perl -w |
|
|
|
=head1 NAME |
=head1 NAME |
|
|
Line 24 makeauthors.pl
|
Line 23 makeauthors.pl
|
|
|
use dbchgk; |
use dbchgk; |
|
|
|
my $DUMPDIR = $ENV{DUMPDIR} || "../dump"; |
|
|
do "chgk.cnf"; |
do "chgk.cnf"; |
use locale; |
use locale; |
use POSIX qw (locale_h); |
use POSIX qw (locale_h); |
open NICKS, "<$nicksfile" or die "Can not open nicks"; |
open NICKS, "<$nicksfile" or die "Can not open nicks"; |
open SSNICKS, "<$ssnicksfile" or die "Can not open ssnicks"; |
open SSNICKS, "<$ssnicksfile" or die "Can not open ssnicks"; |
open UNKNOWN, ">uauthors"; |
open UNKNOWN, ">$DUMPDIR/uauthors"; |
open STDERR, ">errors"; |
open UNICKS, ">$DUMPDIR/unicks"; |
|
open STDERR, ">$DUMPDIR/errors"; |
my ($thislocale); |
my ($thislocale); |
if ($^O =~ /win/i) { |
if ($^O =~ /win/i) { |
$thislocale = "Russian_Russia.20866"; |
$thislocale = "Russian_Russia.20866"; |
Line 42 open STDERR, ">errors";
|
Line 44 open STDERR, ">errors";
|
|
|
|
|
|
|
mydo("DROP TABLE IF EXISTS Authors"); |
|
mydo("CREATE TABLE Authors |
|
( |
|
Id INT NOT NULL PRIMARY KEY AUTO_INCREMENT, |
|
KEY idkey (Id), |
|
CharId CHAR(20), |
|
Name CHAR(50), |
|
Surname CHAR(50), |
|
Nicks TEXT, |
|
QNumber INT |
|
)"); |
|
|
|
mydo ("DROP TABLE IF EXISTS A2Q"); |
|
mydo("CREATE TABLE A2Q |
|
( |
|
Id INT NOT NULL PRIMARY KEY AUTO_INCREMENT, |
|
Author INT UNSIGNED , |
|
Question INT UNSIGNED |
|
) |
|
|
|
" |
|
); |
|
|
|
|
|
while (<NICKS>) |
while (<NICKS>) |
{ |
{ |
($number,$nick)=split; |
($number,$nick)=split; |
|
next unless $number; |
next unless $number=~/^\d+$/; |
next unless $number=~/^\d+$/; |
($name,$surname)=split ' ',<NICKS>; |
@parts = split ' ',<NICKS>; |
$name{$nick}= ucfirst lc $name; |
$_ = ucfirst lc $_ foreach @parts; |
$surname=ucfirst lc $surname; |
$surname = pop @parts; |
|
my $name; |
|
$name = $name{$nick}= join ' ', @parts; |
$surname=~s/\-(.)/"-". uc $1/ge; |
$surname=~s/\-(.)/"-". uc $1/ge; |
|
$surname=~s/\'(.)/"'". uc $1/ge; |
$surname{$nick}= $surname; |
$surname{$nick}= $surname; |
|
$sn = "$name $surname"; |
|
print "$name!$surname\n"; |
|
$sn =~ tr/Ёё/Ее/; |
|
$nickfromname{uc $sn} = $nick; |
} |
} |
|
|
$surname{'error'}='Глюков'; |
$surname{'error'}='Глюков'; |
$name{'error'}='Очепят'; |
$name{'error'}='Очепят'; |
$surname{'unknown'}='Неизвестный'; |
$surname{'unknown'}='Неизвестный'; |
$name{'unknown'}='Псевдоним'; |
$name{'unknown'}='Псевдоним'; |
$surname{'team'}='Капитанова'; |
$surname{'team'}='Авторов'; |
$name{'team'}='Команда_'; |
$name{'team'}='Коллектив'; |
|
|
|
|
while (<SSNICKS>) |
while (<SSNICKS>) |
Line 96 while (<SSNICKS>)
|
Line 82 while (<SSNICKS>)
|
$ssnick{$nick}.="|$str"; |
$ssnick{$nick}.="|$str"; |
} |
} |
|
|
|
|
close (NICKS); |
close (NICKS); |
close (SSNICKS); |
close (SSNICKS); |
|
|
|
|
|
|
open AUTHORS,"<$authorsfile" or die "Can not open authors"; |
open AUTHORS,"<$authorsfile" or die "Can not open authors"; |
|
print "REading authors...\n"; |
while (<AUTHORS>) |
while (<AUTHORS>) |
{ |
{ |
|
|
($nick,$number,$descr)=m/^([a-zA-Z][a-zA-Z\s]+)(\d+)\s+(.*)$/g; |
($nick,$number,$descr)=m/^([a-zA-Z][a-zA-Z\s]+)(\d+)\s+(.*)$/g; |
if (!$nick) |
if (!$nick) |
{ |
{ |
($number,$descr)=m/^(\d+)\s+(.*)$/g; |
($number,$descr)=m/^(\d+)\s+(.*)$/g; |
$nick='unknown'; |
$nick='unknown'; |
} |
} |
$nick=~s/\s*$//; |
# if ($nick=~s/\s*$//) |
$descr=~s/([\.\,\:\!\?])/$1 /g; |
$descr=~s/([\.\,\:\!\?])/$1 /g; |
$descr=~s/\\n/ /g; |
$descr=~s/\\n/ /g; |
$descr=~s/^\s+//g; |
$descr=~s/^\s+//g; |
Line 128 while (<AUTHORS>)
|
Line 112 while (<AUTHORS>)
|
} |
} |
} |
} |
|
|
|
print "printing unknown...\n"; |
foreach $as(keys %unknick) |
foreach $as(keys %unknick) |
{ |
{ |
print "$as \n ", (join "\n ", (grep {$nick{$_}=~/$as/} keys %nick)); |
print UNICKS "$as \n ", (join "\n ", (grep {$nick{$_}=~/$as/} keys %nick)); |
print "\n"; |
print UNICKS "\n"; |
} |
} |
|
|
%forbidden=checktable('equalto')? getequalto : (); |
%forbidden=tableexists('equalto')? getequalto : (); |
|
|
#print scalar keys %forbidden, "forbidden questions\n"; |
#print scalar keys %forbidden, "forbidden questions\n"; |
|
|
getbase('QuestionId','Authors'); |
getbase('QuestionId','Authors'); |
|
|
while (($QuestionId, $author)=getrow,$QuestionId) |
while (($QuestionId, $author)=getrow,$QuestionId) |
{ |
{ |
|
print "." unless $i++ % 100; |
next unless $author; |
next unless $author; |
$author=~s/([\.\,\:\!\?])/$1 /gm; |
$author=~s/([\.\,\:\!\?])/$1 /gm; |
$author=~s/^\s+//mg; |
$author=~s/^\s+//mg; |
Line 150 while (($QuestionId, $author)=getrow,$Qu
|
Line 134 while (($QuestionId, $author)=getrow,$Qu
|
$author=~s/\s+$//mg; |
$author=~s/\s+$//mg; |
$author=~s/\s+/ /mg; |
$author=~s/\s+/ /mg; |
$author=uc $author; |
$author=uc $author; |
|
$author=~s/ё/е/mg; |
if ($nick = $nick{$author}) |
if ($nick = $nick{$author}) |
{ |
{ |
my @a=split ' ',$nick; |
my @a=split ' ',$nick; |
|
foreach $tmp(@a) { |
|
if ($tmp eq '!!!') { |
|
print STDERR "!$author!".$QuestionId."\n"; |
|
} |
|
} |
push @{$questions{$_}},$QuestionId foreach @a; |
push @{$questions{$_}},$QuestionId foreach @a; |
} |
} |
else |
else |
Line 168 print scalar keys %nick , " authors foun
|
Line 157 print scalar keys %nick , " authors foun
|
|
|
|
|
#print STDERR "$_ ".$name{$_}."!\n" foreach keys %name; |
#print STDERR "$_ ".$name{$_}."!\n" foreach keys %name; |
|
addquestions2author($_,$name{$_},$surname{$_},$questions{$_},$ssnick{$_},\%forbidden) foreach keys %questions; |
addauthors($_,$name{$_},$surname{$_},$questions{$_},$ssnick{$_},\%forbidden) foreach keys %questions; |
|
|
|
print UNKNOWN "$_\n" foreach sort keys %unknown; |
print UNKNOWN "$_\n" foreach sort keys %unknown; |