#!/usr/bin/perl
# Time-stamp: <2008-05-18 16:01:59 phm>
BEGIN { $ENV{PATH} = '/bin:/usr/bin:/usr/local/bin' };

package A2E::TratextTest;
use base qw(Test::Unit::TestCase);
use A2E::Tratext;
binmode STDIN, ':utf8';
binmode STDOUT, ':utf8';
binmode STDERR, ':utf8';
use strict;
use utf8;
use Encode qw(_utf8_on);
use warnings;
use diagnostics;

sub new {
    my $self = shift()->SUPER::new(@_);
};

our $tt;
our $keyvals = {
    tratext_etcdir=> '/usr/local/etc/tratext',
    cjk2asc_names => [ 'cjk2asc', 'cjk2asc_en' ],
    debug => 1,
    verbose => 1,
    interact => 0,
    table => 'jaen',
    nolookup => 1,
    localhost => 1
};
my ($input, $result, $format, $ja, $en) = ();

sub set_up {
    my $self = shift;
    $tt = new A2E::Tratext 'a2e', $keyvals;
};

sub test_tratext {
    my $self = shift;
    $self->assert_not_null($tt);
    $self->assert_not_null($tt->{nolookup});
    $self->assert_equals(1, $tt->{nolookup});
};

sub test_cjk2asc {
    my $self = shift;
    $self->assert_not_null($tt->{cjk2asc});
    $self->assert(@{$tt->{cjk2asc_files}});
    $self->assert_not_null($tt->{cjk2asc}->{65306});
    $self->assert_equals(':', $tt->{cjk2asc}->{65306});
    $self->assert_not_null($tt->{cjk2asc}->{65289});
    $self->assert_equals(')', $tt->{cjk2asc}->{65289});
    my $str = '倉頡輸入法';
    my $bigchar_p = $tt->{cjk2asc}->bigchar_p($input, 256);
    $self->assert($bigchar_p);
    $self->assert_equals($str, $tt->{cjk2asc}->map_symbols($str));
};

sub test_trim_to_mlexp_parenth {
    my $self = shift;
    $tt->{nolookup} = 0;
    my $ja = '試験場所';
    my $en = $tt->lookup($ja);
    $en ||= '??';
    my $frm0 = 'ABC（%s）：  ';
    my $frm1 = 'ABC ({ml ja="%s":%s}):  ';
    my $str0 = sprintf $frm0, $ja;
    my $str1 = sprintf $frm1, $ja, $en;
    $self->assert_equals($str1, $tt->trim_to_mlexp($str0));
};

sub test_sentences {
    my $self = shift;
    $tt->{nolookup} = 1;
    $input = '試験場所：　{vok:tp|これはいいね。|これもそうだ。}';
    $result = '{ml ja="試験場所":??}: {vok:tp|{ml ja="これはいいね。":??}|{ml ja="これもそうだ。":??}}';
    $self->assert_equals($result, $tt->cjk_sentences($input));
};

sub test_read_deplate_attrs {
    my $self = shift;
    $tt->{nolookup} = 1;
    my $attrs = 'id=dum syntax="key: val"';
    my $str0 = " $attrs:this is my argument";
    my $str1 = length($attrs) + 1;
    $tt->{cs}->reset(unpack('U*', $str0));
    $self->assert_equals($str1, $tt->{cs}->read_deplate_attrs);    
};

sub test_parse_body {
    my $self = shift;
    $tt->{nolookup} = 0;
    my $ja = '試験目的';
    my $en = $tt->lookup($ja);
    my $attrs = { ja=>$ja };
    my ($pd, $sd) = $tt->parse_body('ml', $attrs, unpack('U*', '??}') );
    $self->assert_equals(3, $pd);
    $self->assert_equals($en . '}', $sd); 
};

sub test_read_deplate_macro_ml {
    my $self = shift;
    $tt->{nolookup} = 0;
    my $ja = '試験目的';
    _utf8_on $ja;
    my $en = $tt->lookup($ja);
    $input = qq{{ml ja="$ja":??}};
    my ($pd, $sd) = $tt->parse_macro(unpack 'U*', $input);
    $self->assert_equals(qq{{ml ja="$ja":$en}}, $sd);
}

sub test_read_deplate_macro_ah_dok {
    my $self = shift;
    $tt->{nolookup} = 0;
    my $str = qq{{ah dok=tratext}};
    my ($pd, $sd) = $tt->parse_macro(unpack 'U*', $str);
    $self->assert_equals($str, $sd);
}

sub test_transtring1 {
    my $self = shift;
    $tt->{nolookup} = 1;
    $input = ' - Note: 炎症性変化陽性羽数/検査羽数';
    $result = ' - Note: {ml ja="炎症性変化陽性羽数/検査羽数":??}';
    $self->assert_equals($result, $tt->transtring($input));
}

sub test_transtring2 {
    my $self = shift;
    $tt->{nolookup} = 1;
    $input = '***** 鶏伝染性気管支炎ウイルスH120G株の病原性復帰否定試験';
    $result = '***** {ml ja="鶏伝染性気管支炎ウイルスH120G株の病原性復帰否定試験":??}';
    $self->assert_equals($result, $tt->transtring($input));
}

sub test_transtring3 {
    my $self = shift;
    $tt->{nolookup} = 1;
    $input = ' - 市販品　ポールバックコンビ(共立製薬)より単離したB1株*1 (以下、「B1(K)株」とする。)';
    $result = ' - {ml ja="市販品":??} {ml ja="ポールバックコンビ(共立製薬)より単離したB1株":??}*1 ({ml ja="以下、「B1(K)株」とする。":??})';
    $self->assert_equals($result, $tt->transtring($input));
};

sub test_transtring4 {
    my $self = shift;
    $tt->{nolookup} = 1;
    $input = "  - 供試鶏：メキシコALPES社SPF鶏由来の発育鶏卵より孵化した5週齢の鶏";
    $result = '  - {ml ja="供試鶏":??}: {ml ja="メキシコALPES社SPF鶏由来の発育鶏卵より孵化した5週齢の鶏":??}';
    $self->assert_equals($result, $tt->transtring($input));
};

sub test_transtring5 {
    my $self = shift;
    $tt->{nolookup} = 1;
    $input = '試験実施者名: {vok:comma_list|渡辺京子|斎藤文人|渡邉千尋|小向麻子|石田祐一}';
    $result = '{ml ja="試験実施者名":??}: {vok:comma_list|{ml ja="渡辺京子":??}|{ml ja="斎藤文人":??}|{ml ja="渡邉千尋":??}|{ml ja="小向麻子":??}|{ml ja="石田祐一":??}}';
    $self->assert_equals($result, $tt->transtring($input));
};

sub test_transtring6 {
    my $self = shift;
    $tt->{nolookup} = 1;
    $input = '#CAP: {ml ja=表Ⅱ:Table II}-3-2-9-1-1: {vok:tp|各B1株の免疫原性|攻撃後の耐過率}';
    $result = '#CAP: {ml ja=表Ⅱ:Table II}-3-2-9-1-1: {vok:tp|{ml ja="各B1株の免疫原性":??}|{ml ja="攻撃後の耐過率":??}}';
    $self->assert_equals($result, $tt->transtring($input));
}

sub test_transtring7 {
    my $self = shift;
    $tt->{nolookup} = 1;
    $input = '   - 供試ウイルス：';
    $result = '   - {ml ja="供試ウイルス":??}:'  ;
    $self->assert_equals($result, $tt->transtring($input));
}

sub test_transtring8 {
    my $self = shift;
    $tt->{nolookup} = 0;
    my $pfx = '  '.'#'.'. ';  
    my $ja1 = '製造用B1株';
    my $ja2 = '以下、「B1(G)株」とする。';
    my $en1 = $tt->lookup($ja1) || '??';
    my $en2 = $tt->lookup($ja2) || '??'; 
    my $frm0 = $pfx . '%s（%s）';
    my $frm1 = $pfx . '{ml ja="%s":%s} ({ml ja="%s":%s})';
    my $str0 = sprintf $frm0, $ja1, $ja2;
    my $str1 = sprintf $frm1, $ja1, $en1, $ja2, $en2;
    $self->assert_equals($str1, $tt->transtring($str0));
}

sub test_transtring9 {
    my $self = shift;
    $tt->{nolookup} = 0;
    my $ja1 = '市販H120株ワクチン';
    my $ja2 = 'ポールバックIB H120';
    my $ja3 = '共立製薬';
    my $en1 = $tt->lookup($ja1) || '??';
    my $en2 = $tt->lookup($ja2) || '??';
    my $en3 = $tt->lookup($ja3) || '??';
    my $pfx = '     '.'#'.' '; 
    my $frm0 = $pfx . '%s（%s（%s））';
    my $frm1 = $pfx . '{ml ja="%s":%s} ({ml ja="%s":%s} ({ml ja="%s":%s}))';
    my $str0 = sprintf $frm0, $ja1, $ja2, $ja3;
    my $str1 = sprintf $frm1, $ja1, $en1, $ja2, $en2, $ja3, $en3;
    $self->assert_equals($str1, $tt->transtring($str0));
}

sub test_transtring10 {
    my $self = shift;
    $tt->{nolookup} = 1;
    $input  = '    - Vero細胞、MDBK細胞、BHK21細胞';
    $result = '    - {ml ja="Vero細胞、MDBK細胞、BHK21細胞":??}';
    $self->assert_equals($result, $tt->transtring($input));
}
sub test_transtring11 {
    my $self = shift;
    $input  = '{vok:comma_list:{ml ja=渡辺京子:??}|{ml ja=斉藤文人:??}|{ml ja=渡邉千尋:??}|{ml ja=小向麻子:??}|{ml ja=石田祐一:??}}';
    $result = $input;
    $self->assert_equals($result, $tt->transtring($input));
}
sub test_transtring12 {
    my $self = shift;
    $tt->{nolookup} = 1;
    $input  = '{ml ja=供試鶏:??}: {vok:{ml id=xtoriyba ja="%1　%2羽":%2 %1}|{vok:{ml id=xyuraiyreitori ja="%1由来の発育鶏卵より孵化した%2日齢の鶏":??}|{vok:alpesspfkei}|4}|40}';
    $result = $input;
    $self->assert_equals($result, $tt->transtring($input));
};

sub test_transtring13 {
    my $self = shift;
    $tt->{nolookup} = 1;
    $input  = '| B1(G)10 | {vok:tp|40.2g|{vok:{ml id=xba ja="%1羽":%1 pcs}|25}} | {vok:tp|232.1g|{vok:xba|15}} |';
    $result = $input;
    $self->assert_equals($result, $tt->transtring($input));
};
sub test_transtring14 {
    my $self = shift;
    $input  = ' - {vok:{ml id=xgunyuraiyreiran ja="%1群由来の%2日齢発育鶏卵":??}|{ml id=alpesspfkei ja=メキシコALPES社SPF鶏:??}|10}*1';
    $result  = ' - {vok:{ml id=xgunyuraiyreiran ja="%1群由来の%2日齢発育鶏卵":??}|{ml id=alpesspfkei ja=メキシコALPES社SPF鶏:??}|10}*1';
    $self->assert_equals($result, $tt->transtring($input));
};

sub test_transtring_15 {
    my $self = shift;
    $tt->{nolookup} = 0;
    my $ja1 = '製造用B1株';
    my $ja2 = '以下「B1(G)株」とする。';
    my $en1 = $tt->lookup($ja1) || '??';
    my $en2 = $tt->lookup($ja2) || '??';
    my $pfx = '  '.'#'.'. ';
    my $frm = $pfx . q{{ml id=seizoub1ml ja="%s":%s} ({ml ja="%s":%s})};
    my $str0 = sprintf $frm, $ja1, '??', $ja2, '??';
    my $str1 = sprintf $frm, $ja1, $en1, $ja2, $en2;
    $self->assert_equals($str1, $tt->transtring($str0));
};

sub test_transtring_16 {
    my $self = shift;
    my $str0 = '#VAR: url=http://a2e.de/sig/oas/07/08/jekeK8/tra/d11';
    $self->assert_equals($str0, $tt->transtring($str0));
};

sub test_transtring_17 {
    my $self = shift;
    $tt->{nolookup} = 0;
    my $ja = "試験目的";
    $format = '****** {ml ja="%s":%s}';
    $input = sprintf($format, $ja, '??');
    $en = $tt->lookup($ja);
    $en ||= '??';
    $result = sprintf $format, $ja, $en;
    $self->assert_equals($result, $tt->transtring($input));
};

sub test_transtring_18 {
    my $self = shift;
    $tt->{nolookup} = 0;
    my $ja = '試験目的';
    my $pfx = ' '.'#. ';
    my $str0 = $pfx . $ja;
    my $en = $tt->lookup($ja) || '??';
    my $str1 = $pfx . qq{{ml ja=\"$ja\":$en}};
    $self->assert_equals($str1, $tt->transtring($str0));
};

sub test_transtring_19 {
    my $self = shift;
    $tt->{nolookup} = 0;
    my $ja = '試験目的';
    $format = "  | ^ | %s | \\- | \\- | \\- | \\- | \\- | \\- |";
    $input = sprintf $format, $ja;
    $en = $tt->lookup($ja);
    $en ||= '??';
    $result = sprintf $format, "{ml ja=\"$ja\":$en}"; 
    $self->assert_equals($result, $tt->transtring($input));
};

sub test_transtring_20 {
    my $self = shift;
    $tt->{nolookup} = 0;
    my $ja = "脾臓";
    my $en = $tt->lookup($ja) || '??';
    my $frm1 = " | ^ | %s | － | － | \\- | － | \\- | － |";
    my $frm2 = " | ^ | %s | \\- | \\- | \\- | \\- | \\- | \\- |";
    my $str0 = sprintf $frm1, $ja;
    my $str1 = sprintf $frm2, "{ml ja=\"$ja\":$en}"; 
    $self->assert_equals($str1, $tt->transtring($str0));
}
sub test_parse_vok_args {
    my $self = shift;
    $tt->{nolookup} = 0;
    my $ja1 = q{以上の結果から、%1株は%(2|哺乳動物由来株化細胞)での増殖が認められ、それは市販%3中の%4株と同等であると考えられた。};
    my $en1 = $tt->lookup($ja1) || '??';
    my $ja2 = 'Vero、MDBK及びBHK21';
    my $en2 = $tt->lookup($ja2) || '??';
    my $ja3 = 'NBワクチン';
    my $en3 = $tt->lookup($ja3) || '??';
    my $frm0 = qq{{vok:{ml ja="%s":%s}|B1(G)|(pe:%s)|{ml ja="%s":%s}|B1(K)}};
    my $frm1 = qq{{vok:{ml ja="%s":%s}|B1(G)|(pe:{ml ja="%s":%s})|{ml ja="%s":%s}|B1(K)}};
    my $str0 = sprintf $frm0, $ja1, '??', $ja2, $ja3, '??';
    my $str1 = sprintf $frm1, $ja1, $en1, $ja2, $en2, $ja3, $en3;
    $self->assert_equals($str1, $tt->transtring($str0));
};

sub test_parse_body_rekurs {
    my $self = shift;
    $tt->{nolookup} = 0;
    my $frm = q{{ah url=1:I. {ml ja="%s":%s} {ml ja="%s":%s}-1}};
    my $ja1 = "起源又は開発の経緯に関する資料";
    my $en1 = $tt->lookup($ja1);
    my $ja2 = "概要";
    my $en2 = $tt->lookup($ja2); 
    my $str0 = sprintf $frm, $ja1, '??', $ja2, '??';
    my $str1 = sprintf $frm, $ja1, $en1, $ja2, $en2; 
    $self->assert_equals($str1, $tt->transtring($str0));
};

sub test_trim_restore {
    my $self = shift;
    $tt->{nolookup} = 0;
    my $ja = '概要';
    my $en = $tt->lookup($ja);
    my $frm = '  [test_trim_restore ({ml ja="%s":%s})*1]*2  ';
    my $src = sprintf $frm, $ja, '??';
    my $cel = sprintf $frm, $ja, $en;
    $self->assert_equals($cel, $tt->trim_to_mlexp($src));
};

sub test_trim_to_mlexp_colon {
    my $self = shift;
    $self->assert_equals(':', $tt->trim_to_mlexp(':'));
}

sub test_tabchunks {
    my $self = shift;
    my $src = qq{{ml ja="ワクチンを投与する鶏群は、予め絶水させておき、乾燥ワクチンを下記の水(使用上の注意の【対象動物に対する注意】第4項":??}	{ml ja="適用上の注意を参照)の量に溶かして投与する。":??}};
    $tt->{nolookup} = 1;
    $self->assert_equals($src, $tt->transtring($src));
}

sub test_set_id {
    my $self = shift;
    my $ja = "試験目的";
    $tt->{nolookup} = 0;
    my $en = $tt->lookup($ja);
    my $frm1 = '#SET id=title:{ml ja="%s":%s}';
    my $frm2 = '#SET id=title: {ml ja="%s":%s}';
    my $src = sprintf $frm1, $ja, '??';
    my $res = sprintf $frm2, $ja, $en;
    $self->assert_equals($res, $tt->transtring($src));
};

sub test_heading {
    my $self = shift;
    my $ja = '鶏伝染性気管支炎ウイルスH120G株の同居感染性';
    my $en = $tt->lookup($en) || '??';
    my $frm = '***** II-2-3-2-7-2 {ml ja="%s":%s}';
    my $str0 = sprintf $frm, $ja, '??';
    my $str1 = sprintf $frm, $ja, $en;
    $self->assert_equals($str1, $tt->transtring($str0));
}

sub test_tabrow {
    my $self = shift;
    $tt->{nolookup} = 1;
    my $str0 = q{| {ml brev=PT ja="特性":properties} | < | < | 15.1.30 | 15.1.30 | {ml brev=CO ja=色調:coloring}: {ml brev=LB ja=淡褐色:light brown}, {ml brev=TY ja=透明度:transparency}: {ml brev=TYOK ja=透明:transparent}, {ml brev=EM ja=異物:extraneous matter}: {ml brev=NF ja=認めない:not found}, {ml brev=ES ja=異臭:unusual smell}: {ml brev=NF ja=認めない:not found}, {ml brev=HY ja=均一性:homogeneity}: {ml brev=HYOK ja=均一:homogeneous} | < | < | < |};
    my $str1 = q{| {ml brev=PT ja="特性":properties} | < | < | 15.1.30 | 15.1.30 | {ml brev=CO ja="色調":coloring}: {ml brev=LB ja="淡褐色":light brown}, {ml brev=TY ja="透明度":transparency}: {ml brev=TYOK ja="透明":transparent}, {ml brev=EM ja="異物":extraneous matter}: {ml brev=NF ja="認めない":not found}, {ml brev=ES ja="異臭":unusual smell}: {ml brev=NF ja="認めない":not found}, {ml brev=HY ja="均一性":homogeneity}: {ml brev=HYOK ja="均一":homogeneous} | < | < | < |};
    $self->assert_equals($str1, $tt->transtring($str0));
}

sub test_tabrow_zeroes {
    my $self = shift;
    $tt->{nolookup} = 1;
    my $str0 = q{| 10 | 0 | 0 | 1 | 1 | 2 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 0 | 0 | 0 | 0 | 0 | 0 |};
    $self->assert_equals($str0, $tt->transtring($str0));
}

sub tear_down {
    print STDERR "This is my tear_down routine.\n";
    # undef $tt;
    print STDERR "TORN down\n";
};

# our @TESTS = qw(test_trim_restore test_trim_to_mlexp_parenth test_trim_to_mlexp_colon);

return 1;

# Local Variables:
# coding: utf-8
# url: http://a2e.de/adv/tratext/TratextText.pm
# srcfile:/adv/tratext/TratextText.pm
# mode: perl
# End:
