blob: 305388b0e35eb795f4452012322d7c6c8ce8202d [file] [log] [blame]
Akron9cb13942020-02-14 07:39:54 +01001#!/usr/bin/env perl
Peter Hardersd892a582020-02-12 15:45:22 +01002
Peter Hardersd892a582020-02-12 15:45:22 +01003###
Peter Harders6f526a32020-06-29 21:44:41 +02004### converts input in TEI P5 format (https://www1.ids-mannheim.de/kl/projekte/korpora/textmodell.html)
5### into output in KorAP-XML format (https://github.com/KorAP/KorAP-XML-Krill -> 'KorAP-XML document')
Peter Hardersd892a582020-02-12 15:45:22 +01006###
Peter Harders6f526a32020-06-29 21:44:41 +02007### input restrictions:
Peter Hardersd892a582020-02-12 15:45:22 +01008###
Peter Harders6f526a32020-06-29 21:44:41 +02009### . utf8 encoded
10### . TEI P5 formatted input with certain restrictions:
11### . mandatory: text-header with integrated textsigle, text-body
12### . optional: corp-header with integrated corpsigle, doc-header with integrated docsigle
13###
14### . all tokens inside the primary text (inside $data) may not be newline seperated, because newlines
15### are removed (see below: 'inside text body') and a conversion of newlines into blanks between 2 tokens
16### could lead to additional blanks, where there should be none (e.g.: punctuation characters like ',' or
17### '.' should not be seperated from their predecessor token).
18### - see also '~ whitespace handling ~'
19###
20### . POS and MSD inline annotations handling (see below: expected format)
21### ...
22###
23### notes on the output:
24###
25### . zip file output (default on stdout) with utf8 encoded entries (which together form the KorAP-XML format)
26### ...
27###
Peter Hardersd892a582020-02-12 15:45:22 +010028
29use strict;
30use warnings;
Peter Harders6f526a32020-06-29 21:44:41 +020031
32use Pod::Usage;
33use Getopt::Long qw(GetOptions :config no_auto_abbrev);
34
35use File::Basename qw(dirname);
36use IO::Handle;
Peter Hardersd892a582020-02-12 15:45:22 +010037use IO::Select;
38
39use open qw(:std :utf8); # assume utf-8 encoding
40use Encode qw(encode_utf8 decode_utf8);
41
Peter Hardersd892a582020-02-12 15:45:22 +010042use XML::CompactTree::XS;
43use XML::LibXML::Reader;
44use IO::Compress::Zip qw(zip $ZipError :constants);
Peter Harders6f526a32020-06-29 21:44:41 +020045use IPC::Open2 qw(open2);
Peter Hardersd892a582020-02-12 15:45:22 +010046
Akron4f67cd42020-07-02 12:27:58 +020047use FindBin;
48BEGIN {
49 unshift @INC, "$FindBin::Bin/../lib";
50};
51
52use KorAP::XML::TEI;
Akroneac374d2020-07-07 09:00:44 +020053use KorAP::XML::TEI::Tokenization;
Peter Hardersd892a582020-02-12 15:45:22 +010054
Akrond949e182020-02-14 12:23:57 +010055our $VERSION = '0.01';
Peter Harders6f526a32020-06-29 21:44:41 +020056
Akrond949e182020-02-14 12:23:57 +010057our $VERSION_MSG = "\ntei2korapxml - v$VERSION\n";
58
Peter Hardersd892a582020-02-12 15:45:22 +010059
Peter Harders6f526a32020-06-29 21:44:41 +020060# Parse options from the command line
Peter Hardersd892a582020-02-12 15:45:22 +010061GetOptions(
Peter Harders6f526a32020-06-29 21:44:41 +020062 "root|r=s" => \(my $_root_dir = '.'), # name of root directory inside zip file
63 "input|i=s" => \(my $input_fname = ''), # input file (yet only TEI I5 Format accepted)
Akrond949e182020-02-14 12:23:57 +010064 'help|h' => sub {
65 pod2usage(
66 -verbose => 99,
67 -sections => 'NAME|DESCRIPTION|SYNOPSIS|ARGUMENTS|OPTIONS',
68 -msg => $VERSION_MSG,
69 -output => '-'
70 )
71 },
72 'version|v' => sub {
73 pod2usage(
74 -verbose => 0,
75 -msg => $VERSION_MSG,
76 -output => '-'
77 )
78 }
Peter Hardersd892a582020-02-12 15:45:22 +010079);
80
Peter Harders6f526a32020-06-29 21:44:41 +020081#
82# ~~~ parameter (mandatory) ~~~
83#
Peter Hardersd892a582020-02-12 15:45:22 +010084
Peter Harders6f526a32020-06-29 21:44:41 +020085 # optional
86my $_CORP_SIGLE = "korpusSigle"; # opening and closing tags (without attributes) have to be in one line
87 # (e.g.: <korpusSigle>GOE</korpusSigle>)
88 # optional
89my $_DOC_SIGLE = "dokumentSigle"; # analog
90 # mandatory
91my $_TEXT_SIGLE = "textSigle"; # analog
92 # mandatory
93my $_TEXT_BODY = "text"; # tag (without attributes), which contains the primary text
94 # optional
95my $_CORP_HEADER_BEG = "idsHeader type=\"corpus\""; # just keep the correct order of the attributes and evtl. add an '.*' between them
96 # optional
97my $_DOC_HEADER_BEG = "idsHeader type=\"document\""; # analog
98 # mandatory
99my $_TEXT_HEADER_BEG = "idsHeader type=\"text\""; # analog
100
101#
102# ~~~ constants ~~~
103#
Peter Hardersd892a582020-02-12 15:45:22 +0100104
Peter Harders6f526a32020-06-29 21:44:41 +0200105## DEPRECATED (only IDS-intern - the tokenization is normally done by external tools)
106my $_GEN_TOK_BAS = 0; # IDS internal tokenization
107 my( $chld_out, $chld_in, $pid, $select );
108##
109
110## dummy tokenization (only for testing)
Akroneac374d2020-07-07 09:00:44 +0200111my $_GEN_TOK_DUMMY = 1; # use dummy base tokenization for testing (base tokenization is normally done by external tools)
Peter Harders6f526a32020-06-29 21:44:41 +0200112 my $_tok_file_con = "tokens_conservative.xml";
113 my $_tok_file_agg = "tokens_aggressive.xml";
114 my ( @tok_tokens_con, @tok_tokens_agg, $m1, $m2, $m3, $m4, $tmp, $p1, $p2, $pr, $txt, $offset );
115my $_base_tokenization_dir = "base"; # name of directory for storing files of dummy tokenization (only used in func. select_tokenization)
116
117# man IO::Compress::Zip
118# At present three compression methods are supported by IO::Compress::Zip, namely
119# Store (no compression at all), Deflate, Bzip2 and LZMA.
120# Note that to create Bzip2 content, the module "IO::Compress::Bzip2" must be installed.
121# Note that to create LZMA content, the module "IO::Compress::Lzma" must be installed.
122my $_COMPRESSION_METHOD = ZIP_CM_DEFLATE; # The symbols, ZIP_CM_STORE, ZIP_CM_DEFLATE, ZIP_CM_BZIP2 and ZIP_CM_LZMA are used to select the compression method.
123
124my $_DEBUG = 0; # set to 1 for minimal more debug output (no need to be parametrized)
125my $_XCT_LN = 0; # only for debugging: include line numbers in elements of $tree_data
126 # (see also manpage of XML::CompactTree::XS)
127
128my $_header_file = "header.xml"; # name of files containing the text, document and corpus header
129my $_data_file = "data.xml"; # name of file containing the primary text data (tokens)
130my $_structure_dir = "struct"; # name of directory containing the $_structure_file
131my $_structure_file = "structure.xml"; # name of file containing all tags (except ${_TOKEN_TAG}'s) related information
132 # (= their names and byte offsets in $_data)
133## TODO: optional (different annotation tools can produce more zip-files for feeding into KorAP-XML-Krill)
134my $_TOKENS_PROC = 1; # on/off: processing of ${_TOKEN_TAG}'s (default: 1)
135my $_tokens_dir = "tokens"; # name of directory containing the $_tokens_file
136my $_tokens_file = "morpho.xml"; # name of file containing all ${_TOKEN_TAG}'s related information (=their byte offsets in $_data)
137 # - evtl. with additional inline annotations
138my $_TOKENS_TAG = "w"; # name of tag containing all information stored in $_tokens_file
139
140## TODO: optional
141# handling inline annotations (inside $_TOKENS_TAG)
142my $_INLINE_ANNOT = 0; # on/off: set to 1 if inline annotations are present and should be processed (default: 0)
143my $_INLINE_LEM_RD = "lemma"; # from which attribute to read LEMMA information
144my $_INLINE_ATT_RD = "ana"; # from which attribute to read POS information (and evtl. additional MSD - Morphosyntactic Descriptions)
145 # TODO: The format for the POS and MSD information has to suffice the regular expression ([^ ]+)( (.+))?
146 # - which means, that the POS information can be followed by an optional blank with additional
147 # MSD information; unlike the MSD part, the POS part may not contain any blanks.
148my $_INLINE_POS_WR = "pos"; # name (inside $_tokens_file) referring to POS information
149my $_INLINE_MSD_WR = "msd"; # name (inside $_tokens_file) referring to MSD information
150my $_INLINE_LEM_WR = "lemma"; # name (inside $_tokens_file) referring to LEMMA information
151##
152
153
154#
155# ~~~ variables ~~~
156#
157
158my $zip; # IO::Compress::Zip object
159my $zip_outh; # handle for zip file output (stdout)
160my $first_write; # needed to decide wether to call '$zip->newStream' (for appending to zip file)
161my $input_fh; # input file handle (default: stdin)
162
163my $buf_in; # text body data extracted from input document ($input_fh), further processed by XML::LibXML::Reader
164my $data; # contains the primary text (created by func. 'retr_info' from $buf_in), which is written to '$data_file'
165
166my $dir; # text directory (below $_root_dir)
167my $dir_crp; # corpus directory (below $_root_dir)
168my $dir_doc; # document directory (below $_root_dir)
169
170my ( $text_id, $text_id_esc ); # '$text_id_esc' = escaped version of $text_id (see %ent)
171
172my %ent = ('"', '&quot;', '&','&amp;', # convert '&', '<' and '>' into their corresponding sgml-entities
173 '<','&lt;','>','&gt;');
174 # note: the index still refers to the 'single character'-versions, which are counted as 1
175 # (search for '&amp;' in data.xml and see corresponding indices in $_tokens_file)
176
177my $header_txt; # raw text header (written to '$_root_dir$dir/$_header_file')
178my $header_doc; # raw document header (written to '$_root_dir$dir_doc/$_header_file')
179my $header_crp; # raw corpus header (written to '$_root_dir$dir_crp/$_header_file')
180
181my ( $header_fl_crp, $header_fl_doc, # flags for tracking where we are in the input document
182 $header_fl_txt, $data_fl );
183
184my ( $header_prfx, $data_prfx1, # $header_prfx is written to $_header_file, $data_* are written to $_data_file
185 $data_prfx2, $data_sfx );
186
187my @structures; # list of arrays, where each array represents a TEI I5 tag (except $_TOKENS_TAG) from the input document
188 # - the input of this array is written in func. 'write_structures' into the file '$_structure_file'
189
190my @tokens; # list of arrays, where each array represents a $_TOKENS_TAG from the input document
191 # - the input of this array is written in func. 'write_tokens' into the file '$_tokens_file'
192
193my ( $ref, $idx, $att_idx ); # needed in func. 'write_structures' and 'write_tokens'
194
195my ( $reader, # instance of 'XML::LibXML::Reader->new' (on input '$buf_in')
196 $tree_data ); # instance of 'XML::CompactTree::XS::readSubtreeToPerl' (on input '$reader')
197
198# these are only used inside recursive function 'retr_info'
199my ( $_IDX, # value is set dependent on $_XCT_LN - for extracting array of child elements from element in $tree_data
200 $e, # element from $tree_data
201 $n, # tag name of actual processed element $e
202 $rl, # recursion level
203 $dl, # actual length of string $data
204 @oti, # oti='open tags indizes' - a stack of indizes into @structures, where the top index in @oti
205 # represents the actual processed element from @structures
206 @oti2, # analogously to @oti, but with reference to array @tokens
207 $inside_tokens_tag, # flag is set, when inside $_TOKENS_TAG
208 ## variables for handling ~ whitespace related issue ~ (it is sometimes necessary, to correct the from-values for some tags)
209 $add_one, # ...
210 $fval, $fval2, # ...
211 %ws); # hash for indices of whitespace nodes (needed to recorrect from-values)
212 # idea: when closing element, check if it's from-index minus 1 refers to a whitespace node
213 # (means: 'from-index - 1' is a key in %ws).
214 # if this is _not_ the case, then the from-value is one to high => correct it by substracting 1
215
216my $output; # temporary variable needed in 'write_*'-functions for writing output to zip-stream $zip)
217
218my ( $i, $c ); # index variables used in loops
219
220## DEPRECATED (only IDS-intern)
221my $_tok_file_bas = "tokens.xml";
222##
223
224my ( $_CORP_HEADER_END, $_DOC_HEADER_END, $_TEXT_HEADER_END );
225
226
227#
228# ~~~ main ~~~
229#
230
231# ~ initializations ~
232
233($_XCT_LN)?($_IDX=5):($_IDX=4);
234
235$header_prfx = $data_prfx1 = $data_prfx2 = $data_sfx = "";
236
237$header_fl_txt = $header_fl_doc = $header_fl_crp = 0;
238
239$inside_tokens_tag = -1;
240
241$fval = $fval2 = 0;
242
243$_root_dir .= '/'; # base dir must always end with a slash
244$_root_dir =~ s/^\.?\///; # remove leading / (only relative paths allowed in IO::Compress::Zip) and redundant ./
245
246$_CORP_HEADER_BEG =~ s#^([^\s]+)(.*)$#$1\[\^>\]*$2#; $_CORP_HEADER_END = $1;
247$_DOC_HEADER_BEG =~ s#^([^\s]+)(.*)$#$1\[\^>\]*$2#; $_DOC_HEADER_END = $1;
248$_TEXT_HEADER_BEG =~ s#^([^\s]+)(.*)$#$1\[\^>\]*$2#; $_TEXT_HEADER_END = $1;
249
250## TODO: remove this, because it's IDS-specific
Peter Hardersd892a582020-02-12 15:45:22 +0100251$header_prfx = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
252$header_prfx .= "<?xml-model href=\"header.rng\" type=\"application/xml\" schematypens=\"http://relaxng.org/ns/structure/1.0\"?>\n";
253$header_prfx .= "<!DOCTYPE idsCorpus PUBLIC \"-//IDS//DTD IDS-XCES 1.0//EN\" \"http://corpora.ids-mannheim.de/idsxces1/DTD/ids.xcesdoc.dtd\">\n";
Peter Harders6f526a32020-06-29 21:44:41 +0200254##
Peter Hardersd892a582020-02-12 15:45:22 +0100255
256$data_prfx1 = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
257$data_prfx1 .= "<?xml-model href=\"text.rng\" type=\"application/xml\" schematypens=\"http://relaxng.org/ns/structure/1.0\"?>\n\n";
258$data_prfx1 .= "<raw_text docid=\"";
259$data_prfx2 .= "\" xmlns=\"http://ids-mannheim.de/ns/KorAP\">\n";
Peter Harders6f526a32020-06-29 21:44:41 +0200260## TODO: can 'metadata.xml' change or is it constant?
Peter Hardersd892a582020-02-12 15:45:22 +0100261$data_prfx2 .= " <metadata file=\"metadata.xml\" />\n";
Peter Harders6f526a32020-06-29 21:44:41 +0200262##
Peter Hardersd892a582020-02-12 15:45:22 +0100263$data_prfx2 .= " <text>";
264$data_sfx = "</text>\n</raw_text>";
265
Peter Hardersd892a582020-02-12 15:45:22 +0100266
Peter Harders6f526a32020-06-29 21:44:41 +0200267## DEPRECATED (only IDS-intern)
268startTokenizer() if $_GEN_TOK_BAS;
269##
Peter Hardersd892a582020-02-12 15:45:22 +0100270
Peter Harders6f526a32020-06-29 21:44:41 +0200271# ~ read input and write output (text by text) ~
Peter Harders90157342020-07-01 21:05:14 +0200272process();
Peter Hardersd892a582020-02-12 15:45:22 +0100273
Peter Hardersd892a582020-02-12 15:45:22 +0100274
Peter Harders6f526a32020-06-29 21:44:41 +0200275#
276# ~~~ subs ~~~
277#
Peter Hardersd892a582020-02-12 15:45:22 +0100278
Peter Hardersd892a582020-02-12 15:45:22 +0100279
Peter Harders90157342020-07-01 21:05:14 +0200280sub process {
Peter Hardersd892a582020-02-12 15:45:22 +0100281
Peter Harders6f526a32020-06-29 21:44:41 +0200282 my ( $pfx, $sfx );
Peter Hardersd892a582020-02-12 15:45:22 +0100283
Peter Harders6f526a32020-06-29 21:44:41 +0200284 my $lc = 0; # line counter
285
286 my $tc = 0; # text counter
287
288 $input_fh = *STDIN; # input file handle (default: stdin)
289
290 $zip_outh = *STDOUT; # output file handle (default: stdout)
291
292 $data_fl = 0; $first_write = 1;
293
294 $buf_in = $data = $dir = $dir_doc = $dir_crp = "";
295 $header_txt = $header_doc = $header_crp = "";
296
297
298 if ( $input_fname ne '' ){
299
300 open ( $input_fh, "<", "$input_fname") || die "File \'$input_fname\' could not be opened.\n";
301
302 }
303
304
Peter Harders90157342020-07-01 21:05:14 +0200305 # prevents segfaulting of 'XML::LibXML::Reader' inside 'process()' - see notes on 'PerlIO layers' in 'man XML::LibXML')
306 # removing 'use open qw(:std :utf8)' would fix this problem too, but using binmode on input is more granular
307 binmode $input_fh;
308
309
Peter Harders6f526a32020-06-29 21:44:41 +0200310 # ~ loop (reading input document) ~
311
312 while ( <$input_fh> ){
313
314 $lc++; # line counter
315
316 # TODO: yet not tested fo big amounts of data
317 # must-have, otherwise comments in input could be fatal (e.g.: ...<!--\n<idsHeader...\n-->...)
Akron4f67cd42020-07-02 12:27:58 +0200318 KorAP::XML::TEI::delHTMLcom ( $input_fh, $_ ); # remove HTML comments (<!--...-->)
Peter Harders6f526a32020-06-29 21:44:41 +0200319
320 if ( $data_fl && m#^(.*)</${_TEXT_BODY}>(.*)$# ){
321
322
323 # ~ end of text body ~
324
325
326 # write data.xml, structure.xml and evtl. morpho.xml and/or the dummy tokenization files (s.a.: $_tok_file_con and $_tok_file_agg)
327
328 $pfx = $1; $sfx = $2;
329
330 die "ERROR ($0): main(): input line number $lc: line with closing text-body tag '${_TEXT_BODY}'"
331 ." contains additional information ... => Aborting\n\tline=$_"
332 if $pfx !~ /^\s*$/ || $sfx !~ /^\s*$/;
333
334 if ( $dir ne "" ){
335
Peter Harders6f526a32020-06-29 21:44:41 +0200336 $reader = XML::LibXML::Reader->new( string => "<text>$buf_in</text>", huge => 1 );
Peter Harders6f526a32020-06-29 21:44:41 +0200337
338 if ( $_XCT_LN ){ # _XCT_LINE_NUMBERS is only for debugging
339 $tree_data = XML::CompactTree::XS::readSubtreeToPerl( $reader, XCT_DOCUMENT_ROOT | XCT_IGNORE_COMMENTS | XCT_ATTRIBUTE_ARRAY | XCT_LINE_NUMBERS );
340 } else {
341 $tree_data = XML::CompactTree::XS::readSubtreeToPerl( $reader, XCT_DOCUMENT_ROOT | XCT_IGNORE_COMMENTS | XCT_ATTRIBUTE_ARRAY );
342 }
343
344 @structures = (); @oti = ();
345
346 if ( $_TOKENS_PROC ){
347 @tokens = (); @oti2 = ()
348 }
349
350 $dl = $rl = 0;
351
352 # ~ whitespace related issue ~
353 $add_one = 0;
354 %ws = ();
355
356
357 # ~ recursion ~
358
359 retr_info( \$tree_data->[2] ); # parse input data
360
361 $rl--;
362
363
364 # ~ write data.xml ~
365
366 $data =~ tr/\n\r/ /; # note: 2 blanks - otherwise offset data would become corrupt
367
368 $data = encode_utf8( $data );
369
370 ## DEPRECATED (only IDS-intern)
371 # first write it to tokenization pipe to give it some time
372 if ( $_GEN_TOK_BAS ){
373 print $chld_in "$data\n\x03\n";
374 }
375 ##
376
377 print STDERR "DEBUG ($0): main(): Writing (utf8-formatted) xml file $_root_dir$dir/$_data_file\n" if $_DEBUG;
378
379 if ( $first_write ){
380
381 $first_write = 0;
382
383 # 1st time: create instance
384 $zip = new IO::Compress::Zip $zip_outh, Zip64 => 1, TextFlag => 1, Method => $_COMPRESSION_METHOD, Append => 0, Name => "$_root_dir$dir/$_data_file"
385 or die "ERROR ('$_root_dir$dir/$_data_file'): zip failed: $ZipError\n"
386
387 } else {
388
389 # closes the current compressed data stream and starts a new one.
390 $zip->newStream( Zip64 => 1, TextFlag => 1, Method => $_COMPRESSION_METHOD, Append => 1, Name => "$_root_dir$dir/$_data_file" )
391 or die "ERROR ('$_root_dir$dir/$_data_file'): zip failed: $ZipError\n"
392 }
393
394 $data =~ s/(&|<|>)/$ent{$1}/g;
395
396 $zip->print( "$data_prfx1$text_id_esc$data_prfx2$data$data_sfx" );
397
398
399 # ~ write structures ~
400
401 write_structures() if @structures;
402
403
404 # ~ write tokens ~
405
406 write_tokens() if $_TOKENS_PROC && @tokens;
407
408
409 # ~ dummy tokenization ~
410
411 if ( $_GEN_TOK_BAS || $_GEN_TOK_DUMMY ){ ## DEPRECATED ($_GEN_TOK_BAS: only IDS-intern)
412
413 select_tokenization();
414
415 if ( $_GEN_TOK_DUMMY ){
416 $offset = 0; @tok_tokens_con=(); @tok_tokens_agg=();
417 }
418 }
419
420 $data_fl = 0; $buf_in = $data = $dir = ""; # reinit.
421
422 } else { # $dir eq ""
423
424 print STDERR "WARNING ($0): main(): maybe empty textSigle => skipping this text ...\n";
425 print STDERR "WARNING ($0): main(): text header=$header_txt\n";
426 print STDERR "WARNING ($0): main(): data=$data\n";
Peter Hardersd892a582020-02-12 15:45:22 +0100427 }
428
Peter Harders6f526a32020-06-29 21:44:41 +0200429 } elsif ( $data_fl ){
Peter Hardersd892a582020-02-12 15:45:22 +0100430
Peter Hardersd892a582020-02-12 15:45:22 +0100431
Peter Harders6f526a32020-06-29 21:44:41 +0200432 # ~ inside text body ~
Peter Hardersd892a582020-02-12 15:45:22 +0100433
Peter Hardersd892a582020-02-12 15:45:22 +0100434
Peter Harders6f526a32020-06-29 21:44:41 +0200435 #print STDERR "inside text body (\$data_fl set)\n";
436
437 # ~ whitespace handling ~
438
439 # remove consecutive whitespace at beginning and end (mostly one newline)
440 # to let 'XML::CompactTree::XS' recognize these blanks as 'text-nodes', the option 'XCT_IGNORE_WS' may not be used (see above).
441 s/^\s+//; s/\s+$//;
442
443 # There's nothing wrong with inserting an additional blank at the start of the 2nd and all consecutive lines (which contain at least one tag),
444 # because it helps for better readability of the text in the '$_data_file' (e.g.: assure blanks between sentences).
445 # Furthermore, the input lines should avoid primary text tokens, which span across several lines, unless the line breaks doesn't lead
446 # to a situation which produces unwanted blanks - e.g.: '...<w>end</w>\n<w>.</w>...' would lead to '...<w>end</w> <w>.</w>...', or
447 # '...<w>,</w>\n<w>this</w>\n<w>is</w>\n<w>it</w>\n<w>!</w>...' to '<w>,<w> <w>this</w> <w>is</w> <w>it</w> <w>!</w>'. Even when considering
448 # to correct those unwanted effects, there would be lots of examples aside punctuation, where there would not exist an easy way or unarbitrary
449 # solution regarding the elimination of the false blanks.
Peter Hardersd892a582020-02-12 15:45:22 +0100450 #
Peter Harders6f526a32020-06-29 21:44:41 +0200451 # So, the best way to avoid having false blanks in the output, is to assure that linebreaks between word-tags doesn't occur in the input
452 # (see also comments on 'input restrictions' at the top of this script).
Peter Hardersd892a582020-02-12 15:45:22 +0100453
Peter Harders6f526a32020-06-29 21:44:41 +0200454 if ( m/<[^>]+>[^<]/ ){ # line contains at least one tag with at least one character contents
Peter Hardersd892a582020-02-12 15:45:22 +0100455
Peter Harders6f526a32020-06-29 21:44:41 +0200456 $tc++; # text counter
Peter Hardersd892a582020-02-12 15:45:22 +0100457
Peter Harders6f526a32020-06-29 21:44:41 +0200458 s/^(.)/ $1/ if $tc > 1; # add blank before 1st character for 2nd line and consecutive lines (which contain at least one tag)
Peter Hardersd892a582020-02-12 15:45:22 +0100459 }
460
Peter Harders6f526a32020-06-29 21:44:41 +0200461 # add line to buffer
462 $buf_in .= $_;
463
464 } elsif ( $header_fl_txt && m#^(.*</${_TEXT_HEADER_END}>)(.*)$# ){
465
466
467 # ~ end of text header ~
468
469
470 #print STDERR "end of text header\n";
471
472 # write it to header.xml
473
474 $sfx = $2;
475
476 $header_txt .= $1; $header_fl_txt = 0;
477
478
479 die "ERROR ($0): main(): input line number $lc: line with closing text-header tag '${_TEXT_HEADER_END}'"
480 ." contains additional information ... => Aborting\n\tline=$_"
481 if $sfx !~ /^\s*$/;
482
483 if ( $dir eq "" ){
484
485 print STDERR "WARNING ($0): main(): input line number $lc: empty textSigle in text header => nothing to do ...\ntext header=$header_txt\n";
486
487 } else {
488
489 print STDERR "DEBUG ($0): Writing file $_root_dir$dir/$_header_file\n" if $_DEBUG;
490
491 if ( $first_write ){
492
493 $first_write = 0;
494
495 $zip = new IO::Compress::Zip $zip_outh, Zip64 => 1, TextFlag => 1, Method => $_COMPRESSION_METHOD,
496 Append => 0, Name => "$_root_dir$dir/$_header_file"
497 or die "ERROR ('$_root_dir$dir/$_header_file'): zip failed: $ZipError\n"
498
499 } else {
500
501 $zip->newStream( Zip64 => 1, TextFlag => 1, Method => $_COMPRESSION_METHOD, Append => 1, Name => "$_root_dir$dir/$_header_file" )
502 or die "ERROR ('$_root_dir$dir/$_header_file'): zip failed: $ZipError\n"
503 }
504
505 $header_txt = encode_utf8( $header_txt );
506
507 $zip->print( "$header_prfx$header_txt" );
508
509 $header_txt = "";
Peter Hardersd892a582020-02-12 15:45:22 +0100510 }
Peter Hardersd892a582020-02-12 15:45:22 +0100511
Peter Harders6f526a32020-06-29 21:44:41 +0200512 } elsif ( $header_fl_txt ){
Peter Hardersd892a582020-02-12 15:45:22 +0100513
Peter Harders6f526a32020-06-29 21:44:41 +0200514 # ~ inside text header ~
Peter Hardersd892a582020-02-12 15:45:22 +0100515
Peter Harders6f526a32020-06-29 21:44:41 +0200516
517 #print STDERR "inside text header\n";
518
519 if( m#^(.*)<${_TEXT_SIGLE}(?: [^>]*)?>([^<]*)(.*)$# ){
520
521 $pfx = $1; $sfx = $3;
522
523 $dir = $2; $text_id = $dir;
524
525 $text_id =~ tr/\//_/; $dir =~ s/("|&|<|>)/$ent{$1}/g;
526
527 $text_id = encode_utf8( $text_id );
528
529 die "ERROR ($0): main(): input line number $lc: line with text-sigle tag '$_TEXT_SIGLE' is not in expected format ... => Aborting\n\tline=$_"
530 if $pfx !~ /^\s*$/ || $sfx !~ m#^</${_TEXT_SIGLE}>\s*$# || $dir =~ /^\s*$/;
531
532 # log output for seeing progression
533 print STDERR "$0: main(): text_id=".decode_utf8( $text_id )."\n";
534
535 $text_id_esc = $text_id;
536
537 s#(<${_TEXT_SIGLE}(?: [^>]*)?>)[^<]+(</${_TEXT_SIGLE}>)#$1$dir$2# # to be consistent with escaping, escape also textSigle in text-header
538 if $text_id_esc =~ s/("|&|<|>)/$ent{$1}/g;
539
540 $dir =~ tr/\./\//;
541 }
542
543 $header_txt .= $_;
544
545 } elsif ( $header_fl_doc && m#^(.*</${_DOC_HEADER_END}>)(.*)$# ){
546
547
548 # ~ end of document header ~
549
550
551 #print STDERR "end of doc header\n";
552
553 # write it to header.xml
554
555 $sfx = $2;
556
557 $header_doc .= $1; $header_fl_doc = 0;
558
559 die "ERROR ($0): main(): input line number $lc: line with closing document-header tag '${_DOC_HEADER_END}'"
560 ." contains additional information ... => Aborting\n\tline=$_"
561 if $sfx !~ /^\s*$/;
562
563 if( $dir_doc eq "" ){
564
565 print STDERR "WARNING ($0): main(): input line number $lc: empty document sigle in document header"
566 ." => nothing to do ...\ndocument header=$header_doc\n";
567
568 } else {
569
570 print STDERR "DEBUG ($0): Writing file $_root_dir$dir_doc/$_header_file\n" if $_DEBUG;
571
572 if ( $first_write ){
573
574 $first_write = 0;
575
576 $zip = new IO::Compress::Zip $zip_outh, Zip64 => 1, TextFlag => 1, Method => $_COMPRESSION_METHOD, Append => 0,
577 Name => "$_root_dir$dir_doc/$_header_file"
578 or die "ERROR ('$_root_dir$dir_doc/$_header_file'): zip failed: $ZipError\n"
579
580 } else {
581
582 $zip->newStream( Zip64 => 1, TextFlag => 1, Method => $_COMPRESSION_METHOD, Append => 1, Name => "$_root_dir$dir_doc/$_header_file" )
583 or die "ERROR ('$_root_dir$dir_doc/$_header_file'): zip failed: $ZipError\n"
584 }
585
586 $header_doc = encode_utf8( $header_doc );
587
588 $zip->print( "$header_prfx$header_doc" );
589
590 $header_doc = $dir_doc = "";
591 }
592
593 } elsif ( $header_fl_doc ){
594
595
596 # ~ inside document header ~
597
598
599 #print STDERR "inside doc header\n";
600
601 if ( m#^(.*)<${_DOC_SIGLE}(?: [^>]*)?>([^<]*)(.*)$# ){
602
603 $pfx = $1; $sfx = $3;
604
605 $dir_doc = $2;
606
607 die "ERROR ($0): main(): input line number $lc: line with document-sigle tag '$_DOC_SIGLE' is not in expected format ... => Aborting\n\tline=$_"
608 if $pfx !~ /^\s*$/ || $sfx !~ m#^</${_DOC_SIGLE}>\s*$# || $dir_doc =~ /^\s*$/;
609
610 s#(<${_DOC_SIGLE}(?: [^>]*)?>)[^<]+(</${_DOC_SIGLE}>)#$1$dir_doc$2# # to be consistent with escaping, escape also textSigle in Document-Header
611 if $dir_doc =~ s/("|&|<|>)/$ent{$1}/g;
612 }
613
614 $header_doc .= $_;
615
616 } elsif ( m#^(.*)(<${_TEXT_HEADER_BEG}.*)$# ){
617
618 # ~ start of text header ~
619
620
621 #print STDERR "begin of text header\n";
622
623 $header_txt = $_; $header_fl_txt = 1; $pfx = $1;
624
625 $tc = 0; # reset (needed for ~ whitespace handling ~)
626
627 die "ERROR ($0): main(): input line number $lc: line with opening text-header tag '${_TEXT_HEADER_BEG}'"
628 ." is not in expected format ... => Aborting\n\tline=$_"
629 if $pfx !~ /^\s*$/;
630
631 } elsif ( m#^(.*)<${_TEXT_BODY}(?: [^>]*)?>(.*)$# ){
632
633
634 # ~ start of text body ~
635
636
637 #print STDERR "inside text body\n";
638
639 $pfx = $1; $sfx = $2;
640
641 $data_fl = 1;
642
643 die "ERROR ($0): main(): input line number $lc: line with opening text-body tag '${_TEXT_BODY}'"
644 ." contains additional information ... => Aborting\n\tline=$_"
645 if $pfx !~ /^\s*$/ || $sfx !~ /^\s*$/;
646
647 } elsif ( m#^(.*)(<${_DOC_HEADER_BEG}.*)$# ){
648
649
650 # ~ start of document header ~
651
652
653 #print STDERR "begin of doc header\n";
654
655 $header_doc = "$2\n"; $header_fl_doc = 1; $pfx = $1;
656
657 die "ERROR ($0): main(): input line number $lc: line with opening document-header tag '${_DOC_HEADER_BEG}'"
658 ."is not in expected format ... => Aborting\n\tline=$_"
659 if $pfx !~ /^\s*$/;
660
661 } elsif ( $header_fl_crp && m#^(.*</${_CORP_HEADER_END}>)(.*)$# ){
662
663
664 # ~ end of corpus header ~
665
666
667 #print STDERR "end of corp header\n";
668
669 $sfx = $2;
670
671 $header_crp .= $1; $header_fl_crp = 0;
672
673 die "ERROR ($0): main(): input line number $lc: line with closing corpus-header tag '${_CORP_HEADER_END}'"
674 ." contains additional information ... => Aborting\n\tline=$_"
675 if $sfx !~ /^\s*$/;
676
677 if ( $dir_crp eq "" ){
678
679 print STDERR "WARNING ($0): main(): input line number $lc: empty corpus sigle in corpus header => nothing to do ...\ncorpus header=$header_crp\n";
680
681 } else {
682
683 print STDERR "DEBUG ($0): Writing file $_root_dir$dir_crp/$_header_file\n" if $_DEBUG;
684
685 if ( $first_write ){
686
687 $first_write = 0;
688
Peter Harders6f526a32020-06-29 21:44:41 +0200689 $zip = new IO::Compress::Zip $zip_outh, Zip64 => 1, TextFlag => 1, Method => $_COMPRESSION_METHOD,
690 Append => 0, Name => "$_root_dir$dir_crp/$_header_file"
691 or die "ERROR ('$_root_dir$dir_crp/$_header_file'): zip failed: $ZipError\n";
Peter Harders6f526a32020-06-29 21:44:41 +0200692
693 } else {
694
695 $zip->newStream( Zip64 => 1, TextFlag => 1, Method => $_COMPRESSION_METHOD, Append => 1, Name => "$_root_dir$dir_crp/$_header_file" )
696 or die "ERROR ('$_root_dir$dir_crp/$_header_file'): zip failed: $ZipError\n"
697 }
698
699 $header_crp = encode_utf8( $header_crp );
700
701 $zip->print( "$header_prfx$header_crp" );
702
703 $header_crp = $dir_crp = "";
704 }
705
706 } elsif ( $header_fl_crp ){
707
708
709 # ~ inside corpus header ~
710
711
712 #print STDERR "inside corp header\n";
713
714 if ( m#^(.*)<${_CORP_SIGLE}(?: [^>]*)?>([^<]*)(.*)$# ){
715
716 $pfx = $1; $sfx = $3;
717
718 $dir_crp = $2;
719
720 die "ERROR ($0): main(): input line number $lc: line with korpusSigle-tag is not in expected format ... => Aborting\n\tline=$_"
721 if $pfx !~ /^\s*$/ || $sfx !~ m#^</${_CORP_SIGLE}>\s*$# || $dir_crp =~ /^\s*$/;
722
723 if ( $dir_crp =~ s/("|&|<|>)/$ent{$1}/g ){
724
725 s#(<${_CORP_SIGLE}(?: [^>]*)?>)[^<]+(</${_CORP_SIGLE}>)#$1$dir_crp$2# # to be consistent with escaping, escape also textSigle in Corpus-Header
Peter Hardersd892a582020-02-12 15:45:22 +0100726 }
727 }
728
Peter Harders6f526a32020-06-29 21:44:41 +0200729 $header_crp .= $_;
Peter Hardersd892a582020-02-12 15:45:22 +0100730
Peter Harders6f526a32020-06-29 21:44:41 +0200731 } elsif ( m#^(.*)(<${_CORP_HEADER_BEG}.*)$# ){
Peter Hardersd892a582020-02-12 15:45:22 +0100732
Peter Hardersd892a582020-02-12 15:45:22 +0100733
Peter Harders6f526a32020-06-29 21:44:41 +0200734 # ~ start of corpus header ~
Peter Hardersd892a582020-02-12 15:45:22 +0100735
Peter Harders6f526a32020-06-29 21:44:41 +0200736
737 #print STDERR "begin of corp header\n";
738
739 $header_crp = $2; $header_fl_crp = 1; $pfx = $1;
740
741 die "ERROR ($0): main(): input line number $lc: line with opening corpus-header tag '${_CORP_HEADER_BEG}'"
742 ." is not in expected format ... => Aborting\n\tline=$_"
743 if $pfx !~ /^\s*$/;
Peter Hardersd892a582020-02-12 15:45:22 +0100744 }
745
Peter Harders6f526a32020-06-29 21:44:41 +0200746 } #end: while
Peter Hardersd892a582020-02-12 15:45:22 +0100747
Peter Harders6f526a32020-06-29 21:44:41 +0200748 $zip->close();
749
750 ## DEPRECATED (only IDS-intern)
751 if( $_GEN_TOK_BAS ){
752 close($chld_in);
753 close($chld_out);
Peter Hardersd892a582020-02-12 15:45:22 +0100754 }
Peter Harders6f526a32020-06-29 21:44:41 +0200755 ##
Peter Hardersd892a582020-02-12 15:45:22 +0100756
Peter Harders90157342020-07-01 21:05:14 +0200757} # end: sub process
Peter Hardersd892a582020-02-12 15:45:22 +0100758
Peter Hardersd892a582020-02-12 15:45:22 +0100759
Peter Harders6f526a32020-06-29 21:44:41 +0200760sub retr_info { # called from process()
Peter Hardersd892a582020-02-12 15:45:22 +0100761
Peter Harders6f526a32020-06-29 21:44:41 +0200762 # EXAMPLE: <node a="v"><node1>some <n/> text</node1><node2>more-text</node2></node>
763 #
764 # print out values of above example:
765 # echo '<node a="v"><node1>some <n/> text</node1><node2>more-text</node2></node>' | perl -e 'use XML::CompactTree::XS; use XML::LibXML::Reader; $reader = XML::LibXML::Reader->new(IO => STDIN); $data = XML::CompactTree::XS::readSubtreeToPerl( $reader, XCT_DOCUMENT_ROOT | XCT_IGNORE_COMMENTS | XCT_LINE_NUMBERS ); print $data->[2]->[0]->[5]->[1]->[1]'
766 #
767 # $data = reference to below array
768 #
769 # [ 0: XML_READER_TYPE_DOCUMENT,
770 # 1: ?
771 # 2: [ 0: [ 0: XML_READER_TYPE_ELEMENT <- start recursion with array '$data->[2]' (see process(): retr_info( \$tree_data->[2] ))
772 # 1: 'node'
773 # 2: ?
774 # 3: HASH (attributes)
775 # 4: 1 (line number)
776 # 5: [ 0: [ 0: XML_READER_TYPE_ELEMENT
777 # 1: 'node1'
778 # 2: ?
779 # 3: undefined (no attributes)
780 # 4: 1 (line number)
781 # 5: [ 0: [ 0: XML_READER_TYPE_TEXT
782 # 1: 'some '
783 # ]
784 # 1: [ 0: XML_READER_TYPE_ELEMENT
785 # 1: 'n'
786 # 2: ?
787 # 3: undefined (no attributes)
788 # 4: 1 (line number)
789 # 5: undefined (no child nodes)
790 # ]
791 # 2: [ 0: XML_READER_TYPE_TEXT
792 # 1: ' text'
793 # ]
794 # ]
795 # ]
796 # 1: [ 0: XML_READER_TYPE_ELEMENT
797 # 1: 'node2'
798 # 2: ?
799 # 3: undefined (not attributes)
800 # 4: 1 (line number)
801 # 5: [ 0: [ 0: XML_READER_TYPE_TEXT
802 # 1: 'more-text'
803 # ]
804 # ]
805 # ]
806 # ]
807 # ]
808 # ]
809 # ]
810 #
811 # $data->[0] = 9 (=> type == XML_READER_TYPE_DOCUMENT)
812 #
813 # ref($data->[2]) == ARRAY (with 1 element for 'node')
814 # ref($data->[2]->[0]) == ARRAY (with 6 elements)
815 #
816 # $data->[2]->[0]->[0] == 1 (=> type == XML_READER_TYPE_ELEMENT)
817 # $data->[2]->[0]->[1] == 'node'
818 # ref($data->[2]->[0]->[3]) == HASH (=> ${$data->[2]->[0]->[3]}{a} == 'v')
819 # $data->[2]->[0]->[4] == 1 (line number)
820 # ref($data->[2]->[0]->[5]) == ARRAY (with 2 elements for 'node1' and 'node2')
821 # # child nodes of actual node (see $_IDX)
822 #
823 # ref($data->[2]->[0]->[5]->[0]) == ARRAY (with 6 elements)
824 # $data->[2]->[0]->[5]->[0]->[0] == 1 (=> type == XML_READER_TYPE_ELEMENT)
825 # $data->[2]->[0]->[5]->[0]->[1] == 'node1'
826 # $data->[2]->[0]->[5]->[0]->[3] == undefined (=> no attribute)
827 # $data->[2]->[0]->[5]->[0]->[4] == 1 (line number)
828 # ref($data->[2]->[0]->[5]->[0]->[5]) == ARRAY (with 3 elements for 'some ', '<n/>' and ' text')
829 #
830 # ref($data->[2]->[0]->[5]->[0]->[5]->[0]) == ARRAY (with 2 elements)
831 # $data->[2]->[0]->[5]->[0]->[5]->[0]->[0] == 3 (=> type == XML_READER_TYPE_TEXT)
832 # $data->[2]->[0]->[5]->[0]->[5]->[0]->[1] == 'some '
833 #
834 # ref($data->[2]->[0]->[5]->[0]->[5]->[1]) == ARRAY (with 5 elements)
835 # $data->[2]->[0]->[5]->[0]->[5]->[1]->[0] == 1 (=> type == XML_READER_TYPE_ELEMENT)
836 # $data->[2]->[0]->[5]->[0]->[5]->[1]->[1] == 'n'
837 # $data->[2]->[0]->[5]->[0]->[5]->[1]->[3] == undefined (=> no attribute)
838 # $data->[2]->[0]->[5]->[0]->[5]->[1]->[4] == 1 (line number)
839 # $data->[2]->[0]->[5]->[0]->[5]->[1]->[5] == undefined (=> no child nodes)
840 #
841 # ref($data->[2]->[0]->[5]->[0]->[5]->[2]) == ARRAY (with 2 elements)
842 # $data->[2]->[0]->[5]->[0]->[5]->[2]->[0] == 3 (=> type == XML_READER_TYPE_TEXT)
843 # $data->[2]->[0]->[5]->[0]->[5]->[2]->[1] == ' text'
844 #
845 #
846 # retr_info() starts with the array reference ${$_[0]} (= \$tree_data->[2]), which corresponds to ${\$data->[2]} in the above example.
847 # Hence, the expression @{${$_[0]}} corresponds to @{${\$data->[2]}}, $e to ${${\$data->[2]}}[0] (= $data->[2]->[0]) and $e->[0] to
848 # ${${\$data->[2]}}[0]->[0] (= $data->[2]->[0]->[0]).
Peter Hardersd892a582020-02-12 15:45:22 +0100849
Peter Harders6f526a32020-06-29 21:44:41 +0200850 $rl++; # recursion level (1 = topmost level inside retr_info() = should always be level of tag $_TEXT_BODY)
Peter Hardersd892a582020-02-12 15:45:22 +0100851
Peter Hardersd892a582020-02-12 15:45:22 +0100852
Peter Harders6f526a32020-06-29 21:44:41 +0200853 foreach $e ( @{${$_[0]}} ){ # iteration through all array elements ($_[0] is a reference to an array reference)
Peter Hardersd892a582020-02-12 15:45:22 +0100854
Peter Hardersd892a582020-02-12 15:45:22 +0100855
Peter Harders6f526a32020-06-29 21:44:41 +0200856 if ( $e->[0] == XML_READER_TYPE_ELEMENT ){ # element node (see 'NODE TYPES' in manpage of XML::LibXML::Reader)
Peter Hardersd892a582020-02-12 15:45:22 +0100857
Peter Hardersd892a582020-02-12 15:45:22 +0100858
Peter Harders6f526a32020-06-29 21:44:41 +0200859 #~~~~
860 # from here: opening tag
861 #~~~~
Peter Hardersd892a582020-02-12 15:45:22 +0100862
Peter Hardersd892a582020-02-12 15:45:22 +0100863
Peter Harders6f526a32020-06-29 21:44:41 +0200864 # insert new array (for new tag) into @structures with tag-name and tag-attributes (if present)
865 # update @oti (open tags indizes) with @structures highest index (= $#structures); e.g.: @a=(1,2,3) => $#a = 2
Peter Hardersd892a582020-02-12 15:45:22 +0100866
Peter Harders6f526a32020-06-29 21:44:41 +0200867 # ~ tag name ~
Peter Hardersd892a582020-02-12 15:45:22 +0100868
Peter Harders6f526a32020-06-29 21:44:41 +0200869 $n = $e->[1];
Peter Hardersd892a582020-02-12 15:45:22 +0100870
Peter Hardersd892a582020-02-12 15:45:22 +0100871
Peter Harders6f526a32020-06-29 21:44:41 +0200872 # ~ handle structures ~
Peter Hardersd892a582020-02-12 15:45:22 +0100873
Peter Harders6f526a32020-06-29 21:44:41 +0200874 my @array;
875 push @array, $n;
876 push @structures, \@array;
877 push @oti, $#structures; # add highest index of @structures to @oti
Peter Hardersd892a582020-02-12 15:45:22 +0100878
Peter Hardersd892a582020-02-12 15:45:22 +0100879
Peter Harders6f526a32020-06-29 21:44:41 +0200880 # ~ handle tokens ~
Peter Hardersd892a582020-02-12 15:45:22 +0100881
Peter Harders6f526a32020-06-29 21:44:41 +0200882 $inside_tokens_tag = $rl if $_TOKENS_PROC && $n eq $_TOKENS_TAG; # wether to push entry also into @tokens array
Peter Hardersd892a582020-02-12 15:45:22 +0100883
Peter Harders6f526a32020-06-29 21:44:41 +0200884 if ( $_TOKENS_PROC && $inside_tokens_tag == $rl ){
Peter Hardersd892a582020-02-12 15:45:22 +0100885
Peter Harders6f526a32020-06-29 21:44:41 +0200886 my @array2;
887 push @array2, $n;
888 push @tokens, \@array2;
889 push @oti2, $#tokens;
890 }
Peter Hardersd892a582020-02-12 15:45:22 +0100891
Peter Hardersd892a582020-02-12 15:45:22 +0100892
Peter Harders6f526a32020-06-29 21:44:41 +0200893 # ~ handle attributes ~
Peter Hardersd892a582020-02-12 15:45:22 +0100894
Peter Harders6f526a32020-06-29 21:44:41 +0200895 if ( defined $e->[3] ){ # only if attributes exist
Peter Hardersd892a582020-02-12 15:45:22 +0100896
Peter Harders6f526a32020-06-29 21:44:41 +0200897 for ( $c = 0; $c < @{$e->[3]}; $c += 2 ){ # with 'XCT_ATTRIBUTE_ARRAY', $node->[3] is an array reference of the form
898 # [ name1, value1, name2, value2, ....] of attribute names and corresponding values.
899 # note: arrays are faster (see: http://makepp.sourceforge.net/2.0/perl_performance.html)
Peter Hardersd892a582020-02-12 15:45:22 +0100900
Peter Harders6f526a32020-06-29 21:44:41 +0200901 # '$c' references the 'key' and '$c+1' the 'value'
902 push @{$structures[$#structures]}, ${$e->[3]}[$c], ${$e->[3]}[$c+1];
Peter Hardersd892a582020-02-12 15:45:22 +0100903
Peter Harders6f526a32020-06-29 21:44:41 +0200904 if ( $_TOKENS_PROC && $inside_tokens_tag == $rl ){
Peter Hardersd892a582020-02-12 15:45:22 +0100905
Peter Harders6f526a32020-06-29 21:44:41 +0200906 push @{$tokens[$#tokens]}, ${$e->[3]}[$c], ${$e->[3]}[$c+1];
907 }
908
909 }
910 }
911
912
913 # ~ index 'from' ~
914
915 # this is, where a normal tag or tokens-tag ($_TOKENS_TAG) starts
916
917 push @{$structures[$#structures]}, ( $dl + $add_one ); # see below (text and whitespace nodes) for explanation on '$add_one'
918
919 if ( $_TOKENS_PROC && $inside_tokens_tag == $rl ){
920
921 push @{$tokens[$#tokens]}, ( $dl + $add_one );
922 }
923
924
925 #~~~~
926 # until here: opening tag
927 #~~~~
928
929
930 # ~~ RECURSION ~~
931
932 if ( defined $e->[$_IDX] ){ # do no recursion, if $e->[$_IDX] is not defined (because we have no array of child nodes, e.g.: <back/>)
933
934 retr_info( \$e->[$_IDX] ); # recursion with array of child nodes
935
936 $rl--; # return from recursion
937 }
938
939
940 #~~~~~
941 # from here: closing tag
942 #~~~~~
943
944
945 # ~ handle structures ~
946
947 {
948 my $ix = pop @oti; # index of just closed tag
949
950 my $aix = $#{$structures[$ix]}; # determine highest index from 'array referring to last closed tag' ...
951
952 $fval = ${$structures[$ix]}[ $aix ]; # ... and get it's from-value
953
954 if ( $fval > 0 && not exists $ws{ $fval - 1 } ){ # ~ whitespace related issue ~
955
956 # previous node was a text-node
957
958 ${$structures[$ix]}[ $aix ] = $fval - 1; # recorrect from-value (see below: notes on ~ whitespace related issue ~)
959 }
960
961 # in case this fails, check input
962 die "ERROR ($0, retr_info()): text_id='$text_id', processing of \@structures: from-value ($fval) is 2 or more greater"
963 ." than to-value ($dl) => please check. aborting ...\n"
964 if ( $fval - 1 ) > $dl;
965
966 # TODO: construct example for which this case applies
967 # maybe this is not necessary anymore, because the above recorrection of the from-value suffices
968 # TODO: check, if it's better to remove this line and change above check to 'if ( $fval - 1) >= $dl;
969 ${$structures[$ix]}[ $aix ] = $dl if $fval == $dl + 1; # correct from-value (same as ... if $fval-1 == $dl)
970
971 push @{$structures[$ix]}, $dl, $rl; # to-value and recursion-level
972
973 # note: use $dl, because the offsets are _between_ the characters (e.g.: word = 'Hello' => from = 0 (before 'H'), to = 5 (after 'o'))
974 }
975
976
977 # ~ handle tokens ~
978
979
980 if ( $_TOKENS_PROC && $inside_tokens_tag == $rl ){
981
982 my $ix = pop @oti2;
983
984 my $aix = $#{$tokens[$ix]};
985
986 $fval2 = ${$tokens[$ix]}[ $aix ]; # from-value
987
988 if( $fval2 > 0 && not exists $ws{ $fval2 - 1 } ){ # ~ whitespace related issue ~
989
990 # previous node was a text-node
991
992 ${$tokens[$ix]}[ $aix ] = $fval2 - 1; # recorrect from-value
993 }
994
995 # in case this fails, check input
996 die "ERROR ($0, retr_info()): text_id='$text_id', processing of \@tokens: from-value ($fval2) is 2 or more greater"
997 ." than to-value ($dl) => please check. aborting ...\n"
998 if ( $fval2 - 1 ) > $dl;
999
1000 # TODO: construct example for which this case applies
1001 # maybe this is not necessary anymore, because the above recorrection of the from-value suffices
1002 # TODO: check, if it's better to remove this line and change above check to 'if ( $fval2 - 1) >= $dl;
1003 ${$tokens[$ix]}[ $aix ] = $dl if $fval2 == $dl + 1; # correct from-value (same as ... if $fval-1 == $dl)
1004
1005 push @{$tokens[$ix]}, $dl, $rl; # to-value and recursion-level
1006
1007 $inside_tokens_tag = -1; # reset
1008 }
1009
1010 # ~ whitespace related issue ~
Peter Hardersd892a582020-02-12 15:45:22 +01001011 # clean up
Peter Harders6f526a32020-06-29 21:44:41 +02001012 delete $ws{ $fval - 1 } if $fval > 0 && exists $ws{ $fval - 1 };
1013 delete $ws{ $fval2 - 1 } if $_TOKENS_PROC && $fval2 > 0 && exists $ws{ $fval2 - 1 };
Peter Hardersd892a582020-02-12 15:45:22 +01001014
1015
Peter Harders6f526a32020-06-29 21:44:41 +02001016 #~~~~~
1017 # from here: text (and whitespace) nodes
1018 #~~~~~
Peter Hardersd892a582020-02-12 15:45:22 +01001019
1020
Peter Harders6f526a32020-06-29 21:44:41 +02001021 # the 3rd form of nodes, next to text-nodes (XML_READER_TYPE_TEXT) and tag-nodes (XML_READER_TYPE_ELEMENT) are nodes
1022 # of the type 'XML_READER_TYPE_SIGNIFICANT_WHITESPACE'
1023 #
1024 # when modifiying the above example (at the top of this sub) by inserting an additional blank between '</node1>' and '<node2>',
1025 # the output for '$data->[2]->[0]->[5]->[1]->[1]' becomes a blank (' ') and it's type is '14' (see manpage of XML::LibXML::Reader):
1026 #
1027 # echo '<node a="v"><node1>some <n/> text</node1> <node2>more-text</node2></node>' | perl -e 'use XML::CompactTree::XS; use XML::LibXML::Reader; $reader = XML::LibXML::Reader->new(IO => STDIN); $data = XML::CompactTree::XS::readSubtreeToPerl( $reader, XCT_DOCUMENT_ROOT | XCT_IGNORE_COMMENTS | XCT_LINE_NUMBERS ); print "node=".$data->[2]->[0]->[5]->[1]->[1].", type=".$data->[2]->[0]->[5]->[1]->[0]."\n"'
Peter Hardersd892a582020-02-12 15:45:22 +01001028
Peter Harders6f526a32020-06-29 21:44:41 +02001029 } elsif ( $e->[0] == XML_READER_TYPE_TEXT || $e->[0] == XML_READER_TYPE_SIGNIFICANT_WHITESPACE ){
Peter Hardersd892a582020-02-12 15:45:22 +01001030
Peter Harders6f526a32020-06-29 21:44:41 +02001031 # notes on ~ whitespace related issue ~ (see below source code)
1032 #
1033 # example: '... <head type="main"><s>Campagne in Frankreich</s></head><head type="sub"> <s>1792</s> ...'
1034 #
1035 # Two text-nodes should normally be separated by a blank. In the above example, that would be the 2 text-nodes
1036 # 'Campagne in Frankreich' and '1792', which are separated by the whitespace-node ' '.
1037 #
1038 # Assumed, that the above example marks the general case, then the text-node 'Campagne in Frankreich' leads to the
1039 # setting of '$add_one' to 1, so that when opening the 2nd 'head'-tag and setting it's from-index, it gets the right
1040 # offset, which is the start-index of '1792'.
1041 #
1042 # To check, that the above consideration holds, we save the from-index of a read whitespace-node into the hash %ws.
1043 # By this, it can be checked when closing a tag, if the 'non-tag'-node (text or whitespace) before the last 'non-tag'-
1044 # node was actually a whitespace-node ($ws{ $fval - 1 }).
1045 #
1046 # For whitespace-nodes, also $add_one has to be set to 0, so when opening the next tag (in the above example the 2nd
1047 # 's'-tag), no additional 1 is added, because this was already done by the whitespace-node itself (by incrementing the
1048 # variable $dl).
1049 #
1050 # Now, what happens, when 2 text-nodes are not seperated by a whitespace-node (blank)? (e.g.: <w>Augen<c>,</c></w>)
1051 #
1052 # In this case, the falsely increased from-value has to be decreased again by 1 when closing the referring tag
1053 # (...$fval - 1; # recorrect).
1054 #
1055 # Comparing the 2 examples '<w>fu</w> <w>bar</w>' and '<w>fu</w><w> </w><w>bar</w>' (even though, the 2nd one makes less
1056 # sense, because of '<w> </w>'), in both the ' ' is handled as a whitespace-node (XML_READER_TYPE_SIGNIFICANT_WHITESPACE).
1057 #
1058 # So the from-index of the 2nd w-tag (in the second example) would refer to 'bar', which may not have been the intention
1059 # (even, if '<w> </w>' doesn't make a lot of sense). TODO: could this be a bug, which needs to be fixed?
1060 #
1061 # Empty tags also cling to the next text-token - e.g. in '...<w>tok1</w> <w>tok2</w><a><b/></a><w>tok3</w>...' the from-
1062 # and to-indizes for the tags 'a' and 'b' are both 9, which is the start-index of the token 'tok3'.
1063
1064 if( $e->[0] == XML_READER_TYPE_SIGNIFICANT_WHITESPACE ){
1065
1066 # ~ whitespace related issue ~
1067
1068 $add_one = 0;
1069
1070 $ws{ $dl }++; # '++' does not mean a thing here (could be used for consistency checking)
1071
1072 }else{
1073
1074 # ~ text-node ~
1075
1076 $add_one = 1;
1077 }
1078
1079
1080 # ~ update $data and $dl ~
1081
1082 $data .= $e->[1];
1083
1084 $dl += length( $e->[1] ); # update length of $data
1085
1086
1087
1088 #~~~~~
1089 # from here (until end): dummy tokenization
1090 #~~~~~
1091
1092 if ( $_GEN_TOK_DUMMY ){
1093
1094 $txt = $e->[1];
1095
Akroneac374d2020-07-07 09:00:44 +02001096
Peter Harders6f526a32020-06-29 21:44:41 +02001097 if ( substr( $txt, 0, 1 ) ne ' ' || substr( $txt, 1, 1) ne ' ' ){ # $txt has at least 2 chars, if it's not empty or equal to ' '
1098
Akroneac374d2020-07-07 09:00:44 +02001099 my $tok = KorAP::XML::TEI::Tokenization::conservative($txt, $offset);
1100 push @tok_tokens_con, @$tok;
Peter Harders6f526a32020-06-29 21:44:41 +02001101
Akroneac374d2020-07-07 09:00:44 +02001102 $tok = KorAP::XML::TEI::Tokenization::aggressive($txt, $offset);
1103 push @tok_tokens_agg, @$tok;
Peter Harders6f526a32020-06-29 21:44:41 +02001104
1105 ##$offset = $dl+1;
1106
1107 $offset = $dl;
1108
1109 } # fi
1110
1111 } # fi: $_GEN_TOK_DUMMY
1112
1113
1114 #elsif ( $e->[0] == XML_READER_TYPE_ATTRIBUTE ) # attribute node
1115 # note: attributes cannot be processed like this ( => use 'XCT_ATTRIBUTE_ARRAY' - see above )
1116
1117
1118 }else{ # not yet handled type
1119
1120 die "ERROR ($0): Not yet handled type (\$e->[0]=".$e->[0].") ... => Aborting\n";
1121 }
1122
1123 } # end: foreach iteration
1124
1125} # end: sub retr_info
1126
1127
1128sub select_tokenization { # called from process()
1129
1130 #print STDERR "$0: select_tokenization() ...\n";
1131
1132 ## DEPRECATED (only IDS-intern)
Peter Hardersd892a582020-02-12 15:45:22 +01001133 if( $_GEN_TOK_BAS ) {
1134 if( $select->can_read(3600) ){ # wait 60m for external tokenizer
1135 $_ = <$chld_out>;
1136 my @bounds = split;
Peter Harders6f526a32020-06-29 21:44:41 +02001137 write_tokenization("$_root_dir$dir/$_base_tokenization_dir/$_tok_file_bas", $text_id_esc, \@bounds);
Peter Hardersd892a582020-02-12 15:45:22 +01001138 while($select->can_read(0)) {
1139 $_ = <$chld_out>;
1140 if (defined $_ && $_ ne '') {
1141 print STDERR "WARNING: extra output: $_\n"
1142 } else {
1143 print STDERR "WARNING: tokenizer seems to have crashed, restarting.\n";
1144 startTokenizer();
1145 }
1146 }
1147 }else{
1148 $zip->close();
1149 die "ERROR ($0): cannot retrieve token bounds from external tokenizer for text '$text_id' => Aborting ...\n";
1150 }
Peter Harders6f526a32020-06-29 21:44:41 +02001151 ##
Peter Hardersd892a582020-02-12 15:45:22 +01001152 }elsif( $_GEN_TOK_DUMMY ){
Peter Harders6f526a32020-06-29 21:44:41 +02001153 write_tokenization("$_root_dir$dir/$_base_tokenization_dir/$_tok_file_con", $text_id_esc, \@tok_tokens_con);
1154 write_tokenization("$_root_dir$dir/$_base_tokenization_dir/$_tok_file_agg", $text_id_esc, \@tok_tokens_agg);
Peter Hardersd892a582020-02-12 15:45:22 +01001155 }
Peter Hardersd892a582020-02-12 15:45:22 +01001156
Peter Harders6f526a32020-06-29 21:44:41 +02001157 #print STDERR "$0: write_tokenization(): DONE\n";
1158
1159} # end: select_tokenization
1160
1161sub write_tokenization { # called from select_tokenization()
1162
1163 my ( $fname, $textid_esc, $bounds ) = @_;
Peter Hardersd892a582020-02-12 15:45:22 +01001164
1165 $zip->newStream( Zip64 => 1, TextFlag => 1, Method => $_COMPRESSION_METHOD, Append => 1, Name => $fname)
1166 or die "ERROR ('$fname'): zip failed: $ZipError\n";
Peter Harders6f526a32020-06-29 21:44:41 +02001167
1168 $output = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<?xml-model href=\"span.rng\" type=\"application/xml\""
1169 ." schematypens=\"http://relaxng.org/ns/structure/1.0\"?>\n\n<layer docid=\"$text_id_esc\" xmlns=\"http://ids-mannheim.de/ns/KorAP\""
1170 ." version=\"KorAP-0.4\">\n <spanList>\n";
1171
1172 $c = 0;
1173
1174 for( $i = 0; $i < ($#$bounds + 1); $i += 2 ){
1175
Peter Hardersd892a582020-02-12 15:45:22 +01001176 $output .= " <span id=\"t_$c\" from=\"".$bounds->[$i]."\" to=\"".$bounds->[$i+1]."\" />\n";
Peter Harders6f526a32020-06-29 21:44:41 +02001177
Peter Hardersd892a582020-02-12 15:45:22 +01001178 $c++;
1179 }
Peter Hardersd892a582020-02-12 15:45:22 +01001180
Peter Harders6f526a32020-06-29 21:44:41 +02001181 $output .= " </spanList>\n</layer>";
1182
1183 $zip->print ( "$output" );
1184
1185} # end: sub write_tokenization
1186
1187
1188sub write_structures { # called from process()
1189
1190 # ~ write @structures ~
Peter Hardersd892a582020-02-12 15:45:22 +01001191
1192 #print STDERR "$0: write_structures(): ...\n";
1193
Peter Harders6f526a32020-06-29 21:44:41 +02001194 if ( $dir eq "" ){
1195
1196 print STDERR "WARNING ($0): write_structures(): empty textSigle => nothing to do ...\n";
Peter Hardersd892a582020-02-12 15:45:22 +01001197 return;
1198 }
1199
1200 $zip->newStream( Zip64 => 1, TextFlag => 1, Method => $_COMPRESSION_METHOD, Append => 1, Name => "$_root_dir$dir/$_structure_dir/$_structure_file" )
1201 or die "ERROR ('$_root_dir$dir/$_structure_dir/$_structure_file'): zip failed: $ZipError\n";
1202
Peter Harders6f526a32020-06-29 21:44:41 +02001203 $output = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<?xml-model href=\"span.rng\" type=\"application/xml\""
1204 ." schematypens=\"http://relaxng.org/ns/structure/1.0\"?>\n\n<layer docid=\""
1205 .decode_utf8($text_id_esc)."\" xmlns=\"http://ids-mannheim.de/ns/KorAP\" version=\"KorAP-0.4\">\n <spanList>\n";
Peter Hardersd892a582020-02-12 15:45:22 +01001206
1207 $c = 0;
1208
Peter Harders6f526a32020-06-29 21:44:41 +02001209 foreach $ref ( @structures ){
Peter Hardersd892a582020-02-12 15:45:22 +01001210
Peter Harders6f526a32020-06-29 21:44:41 +02001211 ( @{$ref} == 4 )?( $idx = 1 ):( $idx = @{$ref}-3 ); # if array '@{$ref}' doesn't contain attributes, then the number of elements in this array is 4
1212 # (name, from, to, rec_level), otherwise >4
Peter Hardersd892a582020-02-12 15:45:22 +01001213
Peter Harders6f526a32020-06-29 21:44:41 +02001214 # correct last from-value ( if the 'second to last' from-value refers to an s-tag, then the last from-value is one to big - see retr_info )
1215
1216 if( $#structures == $c && ${$ref}[ $idx ] == ${$ref}[ $idx+1 ] + 1 ){
1217
1218 ${$ref}[$idx] = ${$ref}[ $idx+1 ];
Peter Hardersd892a582020-02-12 15:45:22 +01001219 }
Peter Hardersd892a582020-02-12 15:45:22 +01001220
Peter Harders6f526a32020-06-29 21:44:41 +02001221 # this consistency check is already done in 'retr_info()'
1222 #elsif( ${$ref}[$idx] > ${$ref}[$idx+1] ){ # consistency check: abort, if this doesn't hold
1223 # die "ERROR ($0: write_structures(): \$text_id=$text_id, \$c=$c, tag-name=${$ref}[0]):"
1224 # ." 'from-index=${$ref}[$idx]' > 'to-index=${$ref}[$idx+1]' => please check! aborting ...\n";
1225 # die "ERROR ($0: write_structures(): \$text_id=$text_id, \$c=$c, tag-name=${$ref}[0]):"
1226 # ." 'from-index=${$ref}[$idx]' > 'to-index=${$ref}[$idx+1]' => please check! aborting ...\n\n$output" }
Peter Hardersd892a582020-02-12 15:45:22 +01001227
Peter Harders6f526a32020-06-29 21:44:41 +02001228 # at least 'POS' should always be there => remove constraint '$_TOKENS_PROC'
1229 #if( $_TOKENS_PROC && ${$ref}[0] ne $_TOKENS_TAG )
Peter Hardersd892a582020-02-12 15:45:22 +01001230
Peter Harders6f526a32020-06-29 21:44:41 +02001231 if( ${$ref}[0] ne $_TOKENS_TAG ){ # $_TOKENS_TAG is already written in 'write_tokens'
Peter Hardersd892a582020-02-12 15:45:22 +01001232
Peter Harders6f526a32020-06-29 21:44:41 +02001233 # l (level): insert information about depth of element in XML-tree (top element = level 1)
1234 $output .= " <span id=\"s$c\" from=\"${$ref}[ $idx ]\" to=\"${$ref}[ $idx+1 ]\" l=\"${$ref}[ $idx+2 ]\">\n"
1235 ." <fs type=\"struct\" xmlns=\"http://www.tei-c.org/ns/1.0\">\n"
1236 ." <f name=\"name\">${$ref}[ 0 ]</f>\n";
1237
1238 if ( $idx > 2 ) # attributes
1239 {
1240 $output .= " <f name=\"attr\">\n <fs type=\"attr\">\n";
1241
1242 for ( $att_idx = 1; $att_idx < $idx; $att_idx += 2 ){
1243
1244 ${$ref}[ $att_idx+1 ] =~ s/(&|<|>)/$ent{$1}/g; # see explanation in func. 'write_tokens'
1245
1246 # attribute (at index $att_idx) with value (at index $att_idx+1)
1247 $output .= " <f name=\"${$ref}[ $att_idx ]\">${$ref}[ $att_idx+1 ]</f>\n";
1248 }
1249
1250 $output .= " </fs>\n </f>\n";
Peter Hardersd892a582020-02-12 15:45:22 +01001251 }
1252
Peter Harders6f526a32020-06-29 21:44:41 +02001253 $output .= " </fs>\n </span>\n";
Peter Hardersd892a582020-02-12 15:45:22 +01001254
Peter Harders6f526a32020-06-29 21:44:41 +02001255 } # fi: ... ne $_TOKENS_TAG
Peter Hardersd892a582020-02-12 15:45:22 +01001256
1257 $c++;
1258
Peter Harders6f526a32020-06-29 21:44:41 +02001259 } # end: foreach
Peter Hardersd892a582020-02-12 15:45:22 +01001260
1261 $output .= " </spanList>\n</layer>";
1262
Peter Harders6f526a32020-06-29 21:44:41 +02001263 $output = encode_utf8( $output );
Peter Hardersd892a582020-02-12 15:45:22 +01001264
Peter Harders6f526a32020-06-29 21:44:41 +02001265 $zip->print( "$output" );
Peter Hardersd892a582020-02-12 15:45:22 +01001266
1267 #print STDERR "$0: write_structures(): DONE\n";
Peter Harders6f526a32020-06-29 21:44:41 +02001268
Peter Hardersd892a582020-02-12 15:45:22 +01001269} # end: sub write_structures
1270
1271
Peter Harders6f526a32020-06-29 21:44:41 +02001272sub write_tokens { # called from process()
1273
1274 # ~ write @tokens ~
1275
1276 #print STDERR "$0: write_tokens(): ...\n";
Peter Hardersd892a582020-02-12 15:45:22 +01001277
1278 if( $dir eq "" ){
Peter Harders6f526a32020-06-29 21:44:41 +02001279
1280 print STDERR "WARNING ($0): write_tokens(): empty textSigle => nothing to do ...\n";
Peter Hardersd892a582020-02-12 15:45:22 +01001281 return;
1282 }
1283
Peter Harders6f526a32020-06-29 21:44:41 +02001284 $zip->newStream( Zip64 => 1, TextFlag => 1, Method => $_COMPRESSION_METHOD, Append => 1, Name => "$_root_dir$dir/$_tokens_dir/$_tokens_file" )
1285 or die "ERROR ('$_root_dir$dir/$_tokens_dir/$_tokens_file'): zip failed: $ZipError\n";
Peter Hardersd892a582020-02-12 15:45:22 +01001286
Peter Harders6f526a32020-06-29 21:44:41 +02001287 $output = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<?xml-model href=\"span.rng\" type=\"application/xml\""
1288 ." schematypens=\"http://relaxng.org/ns/structure/1.0\"?>\n\n<layer docid=\""
1289 .decode_utf8($text_id_esc)."\" xmlns=\"http://ids-mannheim.de/ns/KorAP\" version=\"KorAP-0.4\">\n <spanList>\n";
Peter Hardersd892a582020-02-12 15:45:22 +01001290
1291 $c = 0;
1292
Peter Harders6f526a32020-06-29 21:44:41 +02001293 foreach $ref ( @tokens ){
Peter Hardersd892a582020-02-12 15:45:22 +01001294
Peter Harders6f526a32020-06-29 21:44:41 +02001295 # if array '@{$ref}' doesn't contain attributes, then the number of elements in this array is 4 (name, from, to, rec_level), otherwise >4
1296 ( @{$ref} == 4 )?( $idx = 1 ):( $idx = @{$ref}-3 );
Peter Hardersd892a582020-02-12 15:45:22 +01001297
Peter Harders6f526a32020-06-29 21:44:41 +02001298 # correct last from-value (if the 'second to last' from-value refers to an s-tag, then the last from-value is one to big - see retr_info())
1299 if ( $#tokens == $c && ${$ref}[ $idx ] == ${$ref}[ $idx+1 ] + 1 ){
1300
1301 ${$ref}[ $idx ] = ${$ref}[ $idx+1 ]; # TODO: check
Peter Hardersd892a582020-02-12 15:45:22 +01001302 }
Peter Hardersd892a582020-02-12 15:45:22 +01001303
Peter Harders6f526a32020-06-29 21:44:41 +02001304 # l (level): insert information about depth of element in XML-tree (top element = level 1)
1305 $output .= " <span id=\"s$c\" from=\"${$ref}[ $idx ]\" to=\"${$ref}[ $idx+1 ]\" l=\"${$ref}[ $idx+2 ]\">\n"
1306 ." <fs type=\"lex\" xmlns=\"http://www.tei-c.org/ns/1.0\">\n"
1307 ." <f name=\"lex\">\n";
Peter Hardersd892a582020-02-12 15:45:22 +01001308
Peter Harders6f526a32020-06-29 21:44:41 +02001309 if ( $idx > 2 ){ # attributes
1310
Peter Hardersd892a582020-02-12 15:45:22 +01001311 $output .= " <fs>\n";
1312
Peter Harders6f526a32020-06-29 21:44:41 +02001313 for ( $att_idx = 1; $att_idx < $idx; $att_idx += 2 ){
Peter Hardersd892a582020-02-12 15:45:22 +01001314
Peter Harders6f526a32020-06-29 21:44:41 +02001315 ${$ref}[ $att_idx+1 ] =~ s/(&|<|>)/$ent{$1}/g; # ... <w lemma="&gt;" ana="PUNCTUATION">&gt;</w> ...
1316 # the '&gt;' is translated to '>' and hence the result would be '<f name="lemma">></f>'
Peter Hardersd892a582020-02-12 15:45:22 +01001317
Peter Harders6f526a32020-06-29 21:44:41 +02001318 if ( $_INLINE_ANNOT && ${$ref}[ $att_idx ] eq "$_INLINE_ATT_RD" ){
Peter Hardersd892a582020-02-12 15:45:22 +01001319
Peter Harders6f526a32020-06-29 21:44:41 +02001320 ${$ref}[ $att_idx+1 ] =~ /^([^ ]+)(?: (.+))?$/;
1321
1322 die "ERROR (write_tokens()): unexpected format! => Aborting ... (att: ${$ref}[ $att_idx+1 ])\n"
1323 if ( $_INLINE_POS_WR && not defined $1 ) || ( $_INLINE_MSD_WR && not defined $2 );
1324
1325 if ( "$_INLINE_POS_WR" ){
1326
1327 $output .= " <f name=\"$_INLINE_POS_WR\">";
Peter Hardersd892a582020-02-12 15:45:22 +01001328 $output .= "$1" if defined $1;
1329 $output .= "</f>\n";
1330 }
Peter Harders6f526a32020-06-29 21:44:41 +02001331
1332 if ( "$_INLINE_MSD_WR" ){
1333
1334 $output .= " <f name=\"$_INLINE_MSD_WR\">";
Peter Hardersd892a582020-02-12 15:45:22 +01001335 $output .= "$2" if defined $2;
1336 $output .= "</f>\n";
1337 }
1338
Peter Harders6f526a32020-06-29 21:44:41 +02001339 } elsif ( $_INLINE_ANNOT && "$_INLINE_LEM_RD" && ${$ref}[ $att_idx ] eq "$_INLINE_LEM_RD" ){
Peter Hardersd892a582020-02-12 15:45:22 +01001340
Peter Harders6f526a32020-06-29 21:44:41 +02001341 $output .= " <f name=\"$_INLINE_LEM_WR\">${$ref}[ $att_idx+1 ]</f>\n";
Peter Hardersd892a582020-02-12 15:45:22 +01001342
Peter Harders6f526a32020-06-29 21:44:41 +02001343 } else { # all other attributes
Peter Hardersd892a582020-02-12 15:45:22 +01001344
Peter Harders6f526a32020-06-29 21:44:41 +02001345 $output .= " <f name=\"${$ref}[$att_idx]\">${$ref}[ $att_idx+1 ]</f>\n"; # attribute (at index $att_idx) with value (at index $att_idx+1)
Peter Hardersd892a582020-02-12 15:45:22 +01001346 }
1347
Peter Harders6f526a32020-06-29 21:44:41 +02001348 } # end: for
Peter Hardersd892a582020-02-12 15:45:22 +01001349
1350 $output .= " </fs>\n";
Peter Harders6f526a32020-06-29 21:44:41 +02001351
1352 } # fi: attributes
Peter Hardersd892a582020-02-12 15:45:22 +01001353
1354 $output .= " </f>\n </fs>\n </span>\n";
1355
1356 $c++;
1357
Peter Harders6f526a32020-06-29 21:44:41 +02001358 } # end: foreach
Peter Hardersd892a582020-02-12 15:45:22 +01001359
1360 $output .= " </spanList>\n</layer>";
1361
Peter Harders6f526a32020-06-29 21:44:41 +02001362 $output = encode_utf8( $output );
Peter Hardersd892a582020-02-12 15:45:22 +01001363
Peter Harders6f526a32020-06-29 21:44:41 +02001364 $zip->print( "$output" );
Peter Hardersd892a582020-02-12 15:45:22 +01001365
Peter Harders6f526a32020-06-29 21:44:41 +02001366 #print STDERR "$0: write_tokens(): DONE\n";
Peter Hardersd892a582020-02-12 15:45:22 +01001367
Peter Harders6f526a32020-06-29 21:44:41 +02001368} # end: sub write_tokens
Peter Hardersd892a582020-02-12 15:45:22 +01001369
Peter Hardersd892a582020-02-12 15:45:22 +01001370
Peter Harders6f526a32020-06-29 21:44:41 +02001371## DEPRECATED ($_GEN_TOK_BAS: only IDS-intern)
Peter Hardersd892a582020-02-12 15:45:22 +01001372sub startTokenizer {
1373 $pid = open2($chld_out, $chld_in, 'java -cp '. join(":", ".", glob(&dirname(__FILE__)."/../target/*.jar"))." de.ids_mannheim.korap.tokenizer.KorAPTokenizerImpl");
1374 $select = IO::Select->new();
1375 $select->add(*$chld_out);
1376}
Peter Harders6f526a32020-06-29 21:44:41 +02001377##
Akrond949e182020-02-14 12:23:57 +01001378
1379__END__
1380
1381=pod
1382
1383=encoding utf8
1384
1385=head1 NAME
1386
1387tei2korapxml - Conversion of TEI P5 based formats to KorAP-XML
1388
1389=head1 SYNOPSIS
1390
1391 cat corpus.i5.xml | tei2korapxml > corpus.korapxml.zip
1392
1393=head1 DESCRIPTION
1394
1395C<tei2korapxml> is a script to convert TEI P5 and I5 based documents
Peter Harders6f526a32020-06-29 21:44:41 +02001396
Akrond949e182020-02-14 12:23:57 +01001397to the KorAP-XML format. If no specific input is defined, data is
Peter Harders6f526a32020-06-29 21:44:41 +02001398
Akrond949e182020-02-14 12:23:57 +01001399read from C<STDIN>. If no specific output is defined, data is written
Peter Harders6f526a32020-06-29 21:44:41 +02001400
Akrond949e182020-02-14 12:23:57 +01001401to C<STDOUT>.
Peter Harders6f526a32020-06-29 21:44:41 +02001402
Akrond949e182020-02-14 12:23:57 +01001403This program is usually called from inside another script.
1404
1405=head1 INSTALLATION
1406
1407C<tei2korapxml> requires L<libxml2-dev> bindings to build. When
Peter Harders6f526a32020-06-29 21:44:41 +02001408
Akrond949e182020-02-14 12:23:57 +01001409these bindings are available, the preferred way to install the script is
Peter Harders6f526a32020-06-29 21:44:41 +02001410
Akrond949e182020-02-14 12:23:57 +01001411to use L<cpanm|App::cpanminus>.
1412
1413 $ cpanm https://github.com/KorAP/KorAP-XML-TEI.git
1414
1415In case everything went well, the C<tei2korapxml> tool will
Peter Harders6f526a32020-06-29 21:44:41 +02001416
Akrond949e182020-02-14 12:23:57 +01001417be available on your command line immediately.
Peter Harders6f526a32020-06-29 21:44:41 +02001418
Akrond949e182020-02-14 12:23:57 +01001419Minimum requirement for L<KorAP::XML::TEI> is Perl 5.16.
1420
1421=head1 OPTIONS
1422
1423=over 2
1424
1425=item B<--base|-b>
1426
1427The base directory for output. Defaults to C<.>.
1428
1429=item B<--help|-h>
1430
1431Print help information.
1432
1433=item B<--version|-v>
1434
1435Print version information.
1436
1437=back
1438
1439=head1 COPYRIGHT AND LICENSE
1440
1441Copyright (C) 2020, L<IDS Mannheim|https://www.ids-mannheim.de/>
1442
1443Author: Peter Harders
1444
1445Contributors: Marc Kupietz, Carsten Schnober, Nils Diewald
1446
1447L<KorAP::XML::TEI> is developed as part of the L<KorAP|https://korap.ids-mannheim.de/>
Peter Harders6f526a32020-06-29 21:44:41 +02001448
Akrond949e182020-02-14 12:23:57 +01001449Corpus Analysis Platform at the
Peter Harders6f526a32020-06-29 21:44:41 +02001450
Akrond949e182020-02-14 12:23:57 +01001451L<Leibniz Institute for the German Language (IDS)|http://ids-mannheim.de/>,
Peter Harders6f526a32020-06-29 21:44:41 +02001452
Akrond949e182020-02-14 12:23:57 +01001453member of the
Peter Harders6f526a32020-06-29 21:44:41 +02001454
Akrond949e182020-02-14 12:23:57 +01001455L<Leibniz-Gemeinschaft|http://www.leibniz-gemeinschaft.de/>.
1456
1457This program is free software published under the
Peter Harders6f526a32020-06-29 21:44:41 +02001458
Akrond949e182020-02-14 12:23:57 +01001459L<BSD-2 License|https://raw.githubusercontent.com/KorAP/KorAP-XML-TEI/master/LICENSE>.
1460
1461=cut