Akron | b62d92a | 2020-03-01 16:32:00 +0100 | [diff] [blame] | 1 | use strict; |
| 2 | use warnings; |
| 3 | use Test::More; |
| 4 | use Data::Dumper; |
| 5 | use JSON::XS; |
| 6 | use Log::Log4perl; |
| 7 | |
| 8 | use utf8; |
| 9 | use lib 'lib', '../lib'; |
| 10 | |
| 11 | use File::Basename 'dirname'; |
| 12 | use File::Spec::Functions 'catdir'; |
| 13 | |
| 14 | # Initialize log4perl object |
| 15 | Log::Log4perl->init({ |
| 16 | 'log4perl.rootLogger' => 'ERROR, STDERR', |
| 17 | 'log4perl.appender.STDERR' => 'Log::Log4perl::Appender::ScreenColoredLevels', |
| 18 | 'log4perl.appender.STDERR.layout' => 'PatternLayout', |
| 19 | 'log4perl.appender.STDERR.layout.ConversionPattern' => '[%r] %F %L %c - %m%n' |
| 20 | }); |
| 21 | |
| 22 | use_ok('KorAP::XML::Krill'); |
| 23 | |
| 24 | my $path = catdir(dirname(__FILE__), '../corpus/REDEW/DOC1/00000'); |
| 25 | |
| 26 | ok(my $doc = KorAP::XML::Krill->new( path => $path . '/' ), 'Load Korap::Document'); |
| 27 | ok($doc->parse, 'Parse document'); |
| 28 | |
| 29 | is($doc->text_sigle, 'REDEW/DOC1/00000', 'Correct text sigle'); |
| 30 | is($doc->doc_sigle, 'REDEW/DOC1', 'Correct document sigle'); |
| 31 | is($doc->corpus_sigle, 'REDEW', 'Correct corpus sigle'); |
| 32 | |
| 33 | my $meta = $doc->meta; |
| 34 | ok(!$meta->{T_title}, 'Title'); # ??? |
| 35 | ok(!$meta->{T_sub_title}, 'SubTitle'); |
| 36 | ok(!$meta->{T_author}, 'Author'); |
| 37 | ok(!$meta->{A_editor}, 'Editor'); |
| 38 | ok(!$meta->{S_pub_place}, 'PubPlace'); |
| 39 | is($meta->{A_publisher}, '...', 'Publisher'); # ??? |
| 40 | |
| 41 | is($meta->{S_text_type}, '?', 'Text Type'); # ??? |
| 42 | ok(!$meta->{S_text_type_art}, 'No Text Type Art'); |
| 43 | ok(!$meta->{S_text_type_ref}, 'No Text Type Ref'); |
| 44 | ok(!$meta->{S_text_domain}, 'No Text Domain'); |
| 45 | ok(!$meta->{S_text_column}, 'No Text Column'); |
| 46 | |
| 47 | ok(!$meta->{K_text_class}->[0], 'Correct Text Class'); |
| 48 | |
| 49 | is($meta->{D_pub_date}, '20200000', 'Creation date'); |
| 50 | is($meta->{D_creation_date}, '20200000', 'Creation date'); |
| 51 | is($meta->{S_availability}, 'QAO-NC', 'License'); # ??? |
| 52 | ok(!$meta->{A_pages}, 'Pages'); |
| 53 | |
| 54 | ok(!$meta->{A_file_edition_statement}, 'File Statement'); |
| 55 | ok(!$meta->{A_bibl_edition_statement}, 'Bibl Statement'); |
| 56 | |
| 57 | ok(!$meta->{A_reference}, 'Reference'); |
| 58 | ok(!$meta->{S_language}, 'Language'); # ??? |
| 59 | |
| 60 | is($meta->{T_corpus_title}, 'Redewiedergabe', 'Correct Corpus title'); |
| 61 | ok(!$meta->{T_corpus_sub_title}, 'Correct Corpus sub title'); |
| 62 | is($meta->{T_corpus_author}, '...', 'Correct Corpus author'); # ??? |
| 63 | is($meta->{A_corpus_editor}, '...', 'Correct Corpus editor'); # ??? |
| 64 | |
| 65 | is($meta->{T_doc_title}, 'Redewiedergabe Dokument 1', 'Correct Doc title'); |
| 66 | ok(!$meta->{T_doc_sub_title}, 'Correct Doc sub title'); |
| 67 | ok(!$meta->{T_doc_author}, 'Correct Doc author'); |
| 68 | ok(!$meta->{A_doc_editor}, 'Correct doc editor'); |
| 69 | |
| 70 | # Tokenization |
| 71 | use_ok('KorAP::XML::Tokenizer'); |
| 72 | |
| 73 | my ($token_base_foundry, $token_base_layer) = (qw/drukola Morpho/); |
| 74 | |
| 75 | # Get tokenization |
| 76 | my $tokens = KorAP::XML::Tokenizer->new( |
| 77 | path => $doc->path, |
| 78 | doc => $doc, |
| 79 | foundry => $token_base_foundry, |
| 80 | layer => $token_base_layer, |
| 81 | name => 'tokens' |
| 82 | ); |
| 83 | |
| 84 | ok($tokens, 'Token Object is fine'); |
| 85 | ok($tokens->parse, 'Token parsing is fine'); |
| 86 | |
| 87 | my $output = decode_json( $tokens->to_json ); |
| 88 | |
| 89 | is(substr($output->{data}->{text}, 0, 100), 'Cechov,_Anton_Pavlovic_Gram.tg4_1.xml 1886 1880 Gram Čechov, Anton Pavlovič yes yes Erzähltext digbi', 'Primary Data'); |
| 90 | |
| 91 | is($output->{data}->{name}, 'tokens', 'tokenName'); |
| 92 | is($output->{data}->{tokenSource}, 'drukola#morpho', 'tokenSource'); |
| 93 | is($output->{version}, '0.03', 'version'); |
| 94 | |
| 95 | is($output->{data}->{foundries}, '', 'Foundries'); |
| 96 | is($output->{data}->{layerInfos}, '', 'layerInfos'); |
| 97 | is($output->{data}->{stream}->[0]->[4], 's:Hörst', 'data'); |
| 98 | |
| 99 | is($output->{textSigle}, 'REDEW/DOC1/00000', 'Correct text sigle'); |
| 100 | is($output->{docSigle}, 'REDEW/DOC1', 'Correct document sigle'); |
| 101 | is($output->{corpusSigle}, 'REDEW', 'Correct corpus sigle'); |
| 102 | |
| 103 | ok(!$output->{title}, 'Title'); |
| 104 | ok(!$output->{subTitle}, 'Correct SubTitle'); |
| 105 | ok(!$output->{author}, 'Author'); |
| 106 | ok(!exists $output->{editor}, 'Publisher'); |
| 107 | |
| 108 | # Add annotations |
| 109 | $tokens->add('DRuKoLa', 'Morpho'); |
| 110 | $tokens->add('DeReKo', 'Structure'); |
| 111 | |
| 112 | $output = decode_json( $tokens->to_json ); |
| 113 | |
| 114 | my $first = $output->{data}->{stream}->[0]; |
| 115 | |
| 116 | is('-:tokens$<i>13',$first->[0]); |
Akron | dec4312 | 2020-03-03 11:22:25 +0100 | [diff] [blame] | 117 | is('<>:base/s:t$<b>64<i>0<i>197<i>13<b>0',$first->[1]); |
| 118 | is('<>:dereko/s:text$<b>64<i>0<i>197<i>13<b>0',$first->[2]); |
| 119 | is('<>:dereko/s:body$<b>64<i>118<i>197<i>13<b>1',$first->[3]); |
| 120 | is('<>:dereko/s:p$<b>64<i>118<i>197<i>13<b>2',$first->[4]); |
| 121 | is('<>:dereko/s:said$<b>64<i>118<i>197<i>13<b>3<s>1',$first->[5]); |
| 122 | is('@:dereko/s:level:1$<b>17<s>1<i>13',$first->[6]); |
| 123 | is('@:dereko/s:content:speech$<b>17<s>1<i>13',$first->[7]); |
| 124 | is('@:dereko/s:mode:direct$<b>17<s>1<i>13',$first->[8]); |
| 125 | is('@:dereko/s:id:1$<b>17<s>1<i>13',$first->[9]); |
Akron | b62d92a | 2020-03-01 16:32:00 +0100 | [diff] [blame] | 126 | is('_0$<i>123<i>128',$first->[10]); |
| 127 | is("drukola/l:H\x{f6}rst",$first->[11]); |
| 128 | is('drukola/m:msd:rfpos',$first->[12]); |
| 129 | is('drukola/m:sentstart:no',$first->[13]); |
| 130 | is('drukola/m:stwr:direct.speech.1',$first->[14]); |
| 131 | is('drukola/p:VVFIN',$first->[15]); |
| 132 | is("i:h\x{f6}rst",$first->[16]); |
| 133 | is("s:H\x{f6}rst",$first->[17]); |
| 134 | |
| 135 | my $nine = join(',', @{$output->{data}->{stream}->[9]}); |
| 136 | like($nine, qr{drukola\/l:nichts}, 'Nichts'); |
| 137 | like($nine, qr{_9\$<i>170<i>176}, 'Term boundaries'); |
Akron | dec4312 | 2020-03-03 11:22:25 +0100 | [diff] [blame] | 138 | unlike($nine, qr{<>:dereko/s:said\$<b>64<i>176<i>196<i>13<b>4<s>1}, 'Term boundaries'); |
Akron | b62d92a | 2020-03-01 16:32:00 +0100 | [diff] [blame] | 139 | |
| 140 | my $ten = join(',', @{$output->{data}->{stream}->[10]}); |
| 141 | like($ten, qr{_10\$<i>177<i>180}, 'Term boundaries'); |
Akron | dec4312 | 2020-03-03 11:22:25 +0100 | [diff] [blame] | 142 | like($ten, qr{<>:dereko/s:said\$<b>64<i>176<i>196<i>13<b>4<s>1}, 'Term boundaries'); |
Akron | b62d92a | 2020-03-01 16:32:00 +0100 | [diff] [blame] | 143 | |
| 144 | my $eleven = join(',', @{$output->{data}->{stream}->[11]}); |
| 145 | like($eleven, qr{_11\$<i>181<i>188}, 'Term boundaries'); |
| 146 | like($eleven, qr{<>:dereko/s:seg\$<b>64<i>180<i>188<i>12<b>5<s>1}, 'Segment'); |
| 147 | |
| 148 | |
| 149 | my $twelve = join(',', @{$output->{data}->{stream}->[12]}); |
| 150 | like($twelve, qr{_12\$<i>189<i>195}, 'Term boundaries'); |
| 151 | like($twelve, qr{drukola/l:Wort}, 'Lemma'); |
| 152 | like($twelve, qr{<>:dereko/s:seg\$<b>64<i>188<i>195<i>13<b>5<s>1}, 'Segment'); |
| 153 | |
| 154 | done_testing; |
| 155 | __END__ |