Я опять поднимаю старую тему конвертации БКРС под WenLin. К своему стыду я не продвинулся ни на миллиметр. И пока что нет намерения. По этой причине я выкладываю прямо в сообщение код скрипта, с помощью которого производится преобразование файла в формате DSL в формат WenLin. Может чуть позже я добавлю комментарии к этому ужасу. Сейчас нет времени.
До сих пор программа не умеет ставить слогораздел в пиньине в словах типа 一二. К тому же WenLin плохо понимает разночтения в упрощенных/полных формах, поэтому некоторые карточки бракуются.
Я попытался пройтись скриптом по последней версии БКРС от 8 мая 2006 года. Из 150 тыс. сгенерированных статей забракованы были около 16 тыс., что не так уж и плохо.
Очень важное замечание!!!!
Так как скрипт написан на Perl5, то нормально он умеет работать только с кодировкой текста UTF8. Следовательно для правильной работы программы НЕОБХОДИМО преобразовать файл.DSL из кодировки UTF-16 в UTF-8. Затем полученный файл нужно скормить в качестве параметра скрипту. Программа выдает результаты работы на экран, поэтому их нужно перенаправить в какой-нибудь файл. Этот файл нужно ТОЖЕ преобразовать, но уже из UTF-8 в UTF-16. А затем скормить описанным на 4-ой странице способом WenLinю.
Под Linux все делается так:
[user@host:~]$ iconv -f UTF-16 -t UTF-8 <BKRS.dsl >BKRS-utf8.dsl
[user@host:~]$ ./transform.pl BKRS-utf8.dsl >wenlin-utf8.dat
[user@host:~]$ iconv -f UTF-8 -t UTF-16 <wenlin-utf8.dat >wenlin-import.dat
где transform.pl - имя нижеприведенного скрипта, а wenlin-import.dat - желаемый результат.
Под Windows честно говоря не знаю, разве что у вас есть Cygwin, где все делается аналогично.
#!/usr/bin/perl -w
use utf8;
#sub InChina {
# return <<END;
#2E00\t9FFF
#END
#}
sub partOfSpeech {
my $engname = "b.f.";
SWITCH: {
if (/сущ./) { $engname = "n.";last SWITCH;}
if (/гл./) { $engname = "v.";last SWITCH;}
if (/прил./) {$engname = "a.";last SWITCH}
}
return $engname;
}
sub makeSimple {
my($simp,$ful) = @_;
return 0 if length($simp) != length($ful);
my(@reta)=();
my @si = unpack("U*",$simp);
my @fu = unpack("U*",$ful);
for(my $i=0;$i<length($simp);$i++){
if($si[$i] == $fu[$i]) {
push @reta, ord("-");
} else {
push @reta, $fu[$i];
}
}
return pack("U*",@reta);
}
sub makeSerial {
my @nums = unpack("U*",$_);
my $ret = 0;
for(my $i=0;$i<@nums;$i++){
$ret += $nums[$i]<<(8*(@nums - $i-1));
}
return sprintf("BKRS%X",$ret&0xfffff);
}
open FILE, "<:utf8","$ARGV[0]" or die "cantopenfile";
binmode STDOUT,":utf8";
binmode STDERR,":utf8";
$lin = 0;
$newline = "\r\n";
print "cidian.db",$newline;
print $newline;
print $newline;
while(<FILE>) {
next if /^#/;
$lin++;
#Start of the ideographics entry
# while(!(/^\[/) && (/^\p{Ideographic}+/) && $_) {
my @cards = ();
while(!(/\[/) && $_) {
# print "Card = ",$_;
chomp;s/\r//;
push @cards,$_ if !/\{\{/;
$_ = <FILE>;
}
if(scalar(@cards)>0) {
# Read in radical numbering
if(s/\[m1\]\[b\]([0-9 ]+\\\[[0-9, ]+\\\])\[\/b.*/$1/) {
# print "RADICALS ",$_;
$_ = <FILE>;
}
# Skip "instead of..."
if (/\[m1\]\[b\]\\\[\[\/b\]/) {
# print "skipping instead of....";
$_ = <FILE>;
}
my $pinyin = "";
# Let's read out pinyin
if(s/\[m1\]\[b\](\p{Latin}+)([,;] \p{Latin}+)?\[\/b.*/$1/) {
chomp;
$pinyin = $_;
}
next if $pinyin eq "";
print $newline,"*** $lin ***",$newline;
print "pinyin ",$pinyin,"$newline";
print "characters ",$cards[0];
if(scalar(@cards) > 1) {
# print "len = ",length($cards[0]);
my $ms = makeSimple(@cards);
# $ms = makeSimple(@cards[1]) if !$ms;
print "[",$ms,"]" if $ms;
}
print $newline;
print "serial-number ",makeSerial($cards[0]),
int($lin%100000),$newline;
my $curpos = 0;
$pofspe = 0;
$curpos = tell FILE;
$_ = <FILE>;
POFSPE:
if(/\[m1\]\[b\][IVX]+.*/) {
# Different parts of speech
$pofspe++;
if (/\[c\] *\[i\](.+)\[\/i\] *\[\/c\]\[\/m\]/) {
print $pofspe,"part-of-speech ",partOfSpeech($1),$newline;
}
$curpos = tell FILE;
$_ = <FILE>;
# print $pofspe,"part-of-speech b.f.$newline";
}
if (/\[m2\]\[c\] *\[i\](.+)\[\/i\] *\[\/c\]\[\/m\]/) {
print "part-of-speech ",partOfSpeech($1),$newline;
$curpos = tell FILE;
$_ = <FILE>;
} else {
print "part-of-speech b.f.$newline" if ($pofspe == 0);
}
if(!/\[m2\]/) {
print "definition simplified",$newline
} else {
while (/\[m2\]/) {
my $defnum = 0;
$defnum = $1 if(s/\[m2\]([0-9]+)(\)|\.)//);
my $def = "";
my $flag;
s/\[[icm0-9\/]+\]//g;
s/\\//g;
chomp;
s/\r//;
if ($pofspe == 0) {
print "definition " if $defnum == 0;
} else {
print $pofspe,"definition " if $defnum == 0;
}
print $defnum+$pofspe*10,"definition " if $defnum>0;
print $_,$newline;
$curpos = tell(FILE);
$_ = <FILE>;
my (@exms,@trans)=((),());
while (/\[m4\]/) {
my $example;
my $transl;
/\p{Ideographic}+(\P{Ideographic}+)\[\/ex\]/;
$transl = $1;
# print "LINE: $_" if(not defined $transl);
$transl =~ s/\[[icm0-9\/]+\]//g if defined $transl;
/\[ex\]((\p{Ideographic}|\\| |\pP|\p{Latin})+)/;
$example = $1;
$example =~ s/\[[icm0-9\/]+\]//g if defined $example;
if (defined($example) && defined ($transl)) {
push @exms,$example;
push @trans,$transl;
}
$curpos = tell FILE;
$_ = <FILE>;
}
my $globnum = $pofspe;
$globnum = $defnum+$globnum*10 if $defnum>0;
$globnum = $globnum*10+1 if @exms>1;
for (my $i=0;$i<@exms;$i++) {
print $globnum+$i if $globnum >0;
print "example ",$exms[$i],$newline;
print $globnum+$i if $globnum >0;
print "translation ",$trans[$i],$newline;
}
}
}
goto POFSPE if(/\[m1\]\[b\][IVX]+/);
seek(FILE,$curpos,0) if($curpos != 0);
} else {
# print "Error!!!! $_ \r\n";
}
# last if $lin>90840;
# last if $lin>90050;
}
