blob: 2b2c6daf91ca443a14e9874f760f569721410a43 [file] [log] [blame]
Akron9cb13942020-02-14 07:39:54 +01001#!/usr/bin/env perl
Peter Hardersd892a582020-02-12 15:45:22 +01002use strict;
3use warnings;
Peter Harders6f526a32020-06-29 21:44:41 +02004
5use Pod::Usage;
6use Getopt::Long qw(GetOptions :config no_auto_abbrev);
7
8use File::Basename qw(dirname);
Peter Hardersd892a582020-02-12 15:45:22 +01009
10use open qw(:std :utf8); # assume utf-8 encoding
11use Encode qw(encode_utf8 decode_utf8);
12
Peter Hardersd892a582020-02-12 15:45:22 +010013use XML::CompactTree::XS;
14use XML::LibXML::Reader;
Peter Hardersd892a582020-02-12 15:45:22 +010015
Akron4f67cd42020-07-02 12:27:58 +020016use FindBin;
17BEGIN {
18 unshift @INC, "$FindBin::Bin/../lib";
19};
20
Akron95bc98a2020-07-11 12:00:12 +020021use KorAP::XML::TEI qw'remove_xml_comments';
Akron8b511f92020-07-09 17:28:08 +020022use KorAP::XML::TEI::Tokenizer::External;
Akrond9627472020-07-09 16:53:09 +020023use KorAP::XML::TEI::Tokenizer::Conservative;
24use KorAP::XML::TEI::Tokenizer::Aggressive;
Akron85717512020-07-08 11:19:19 +020025use KorAP::XML::TEI::Zipper;
Peter Hardersd892a582020-02-12 15:45:22 +010026
Akrond949e182020-02-14 12:23:57 +010027our $VERSION = '0.01';
Peter Harders6f526a32020-06-29 21:44:41 +020028
Akrond949e182020-02-14 12:23:57 +010029our $VERSION_MSG = "\ntei2korapxml - v$VERSION\n";
30
Peter Hardersd892a582020-02-12 15:45:22 +010031
Peter Harders6f526a32020-06-29 21:44:41 +020032# Parse options from the command line
Peter Hardersd892a582020-02-12 15:45:22 +010033GetOptions(
Peter Harders6f526a32020-06-29 21:44:41 +020034 "root|r=s" => \(my $_root_dir = '.'), # name of root directory inside zip file
35 "input|i=s" => \(my $input_fname = ''), # input file (yet only TEI I5 Format accepted)
Akron8b511f92020-07-09 17:28:08 +020036 'tokenizer-call|tc=s' => \(my $tokenizer_call), # Temporary argument for testing purposes
Peter Hardersf9c51242020-07-21 02:37:44 +020037 'use-intern-tokenization|ti' => \(my $tokenizer_intern), # use intern tokenization (default = no)
Akron8b511f92020-07-09 17:28:08 +020038 'help|h' => sub {
Akrond949e182020-02-14 12:23:57 +010039 pod2usage(
40 -verbose => 99,
41 -sections => 'NAME|DESCRIPTION|SYNOPSIS|ARGUMENTS|OPTIONS',
42 -msg => $VERSION_MSG,
43 -output => '-'
44 )
45 },
46 'version|v' => sub {
47 pod2usage(
48 -verbose => 0,
49 -msg => $VERSION_MSG,
50 -output => '-'
51 )
52 }
Peter Hardersd892a582020-02-12 15:45:22 +010053);
54
Peter Harders6f526a32020-06-29 21:44:41 +020055#
56# ~~~ parameter (mandatory) ~~~
57#
Peter Hardersd892a582020-02-12 15:45:22 +010058
Peter Harders6f526a32020-06-29 21:44:41 +020059 # optional
60my $_CORP_SIGLE = "korpusSigle"; # opening and closing tags (without attributes) have to be in one line
61 # (e.g.: <korpusSigle>GOE</korpusSigle>)
62 # optional
63my $_DOC_SIGLE = "dokumentSigle"; # analog
64 # mandatory
65my $_TEXT_SIGLE = "textSigle"; # analog
66 # mandatory
67my $_TEXT_BODY = "text"; # tag (without attributes), which contains the primary text
68 # optional
69my $_CORP_HEADER_BEG = "idsHeader type=\"corpus\""; # just keep the correct order of the attributes and evtl. add an '.*' between them
70 # optional
71my $_DOC_HEADER_BEG = "idsHeader type=\"document\""; # analog
72 # mandatory
73my $_TEXT_HEADER_BEG = "idsHeader type=\"text\""; # analog
74
75#
76# ~~~ constants ~~~
77#
Peter Hardersd892a582020-02-12 15:45:22 +010078
Peter Harders41c35622020-07-12 01:16:22 +020079## extern tokenization
Peter Hardersf9c51242020-07-21 02:37:44 +020080my $_GEN_TOK_EXT = $tokenizer_call ? 1 : 0;
Akron8b511f92020-07-09 17:28:08 +020081 # TODO:
82 # Read tokenizer call from configuration file.
83 # was 'java -cp '. join(":", ".", glob(&dirname(__FILE__)."/../target/*.jar")). " de.ids_mannheim.korap.tokenizer.KorAPTokenizerImpl";
84 my $ext_tok;
85 if ($tokenizer_call) {
86 $ext_tok = KorAP::XML::TEI::Tokenizer::External->new($tokenizer_call);
87 };
Peter Harders41c35622020-07-12 01:16:22 +020088 my $_tok_file_ext = "tokens.xml";
Peter Harders6f526a32020-06-29 21:44:41 +020089##
90
Akron8b511f92020-07-09 17:28:08 +020091## intern tokenization
Peter Hardersf9c51242020-07-21 02:37:44 +020092my $_GEN_TOK_INT = $tokenizer_intern; # simple tokenization (recommended for testing)
Peter Harders41c35622020-07-12 01:16:22 +020093 my $_tok_file_con = "tokens_conservative.xml";
94 my $_tok_file_agg = "tokens_aggressive.xml";
95 my $aggr_tok = KorAP::XML::TEI::Tokenizer::Aggressive->new;
96 my $cons_tok = KorAP::XML::TEI::Tokenizer::Conservative->new;
Peter Harders41c35622020-07-12 01:16:22 +020097##
98
99my $_tok_dir = "base"; # name of directory for storing tokenization files
Peter Harders6f526a32020-06-29 21:44:41 +0200100
Peter Harders6f526a32020-06-29 21:44:41 +0200101my $_DEBUG = 0; # set to 1 for minimal more debug output (no need to be parametrized)
102my $_XCT_LN = 0; # only for debugging: include line numbers in elements of $tree_data
103 # (see also manpage of XML::CompactTree::XS)
104
105my $_header_file = "header.xml"; # name of files containing the text, document and corpus header
106my $_data_file = "data.xml"; # name of file containing the primary text data (tokens)
107my $_structure_dir = "struct"; # name of directory containing the $_structure_file
108my $_structure_file = "structure.xml"; # name of file containing all tags (except ${_TOKEN_TAG}'s) related information
109 # (= their names and byte offsets in $_data)
110## TODO: optional (different annotation tools can produce more zip-files for feeding into KorAP-XML-Krill)
111my $_TOKENS_PROC = 1; # on/off: processing of ${_TOKEN_TAG}'s (default: 1)
112my $_tokens_dir = "tokens"; # name of directory containing the $_tokens_file
113my $_tokens_file = "morpho.xml"; # name of file containing all ${_TOKEN_TAG}'s related information (=their byte offsets in $_data)
114 # - evtl. with additional inline annotations
115my $_TOKENS_TAG = "w"; # name of tag containing all information stored in $_tokens_file
116
117## TODO: optional
118# handling inline annotations (inside $_TOKENS_TAG)
119my $_INLINE_ANNOT = 0; # on/off: set to 1 if inline annotations are present and should be processed (default: 0)
120my $_INLINE_LEM_RD = "lemma"; # from which attribute to read LEMMA information
121my $_INLINE_ATT_RD = "ana"; # from which attribute to read POS information (and evtl. additional MSD - Morphosyntactic Descriptions)
122 # TODO: The format for the POS and MSD information has to suffice the regular expression ([^ ]+)( (.+))?
123 # - which means, that the POS information can be followed by an optional blank with additional
124 # MSD information; unlike the MSD part, the POS part may not contain any blanks.
125my $_INLINE_POS_WR = "pos"; # name (inside $_tokens_file) referring to POS information
126my $_INLINE_MSD_WR = "msd"; # name (inside $_tokens_file) referring to MSD information
127my $_INLINE_LEM_WR = "lemma"; # name (inside $_tokens_file) referring to LEMMA information
128##
129
130
131#
132# ~~~ variables ~~~
133#
134
Akron85717512020-07-08 11:19:19 +0200135# Initialize zipper
136my $zipper = KorAP::XML::TEI::Zipper->new;
Peter Harders6f526a32020-06-29 21:44:41 +0200137my $input_fh; # input file handle (default: stdin)
138
139my $buf_in; # text body data extracted from input document ($input_fh), further processed by XML::LibXML::Reader
140my $data; # contains the primary text (created by func. 'retr_info' from $buf_in), which is written to '$data_file'
141
142my $dir; # text directory (below $_root_dir)
143my $dir_crp; # corpus directory (below $_root_dir)
144my $dir_doc; # document directory (below $_root_dir)
145
146my ( $text_id, $text_id_esc ); # '$text_id_esc' = escaped version of $text_id (see %ent)
147
148my %ent = ('"', '&quot;', '&','&amp;', # convert '&', '<' and '>' into their corresponding sgml-entities
149 '<','&lt;','>','&gt;');
150 # note: the index still refers to the 'single character'-versions, which are counted as 1
151 # (search for '&amp;' in data.xml and see corresponding indices in $_tokens_file)
152
153my $header_txt; # raw text header (written to '$_root_dir$dir/$_header_file')
154my $header_doc; # raw document header (written to '$_root_dir$dir_doc/$_header_file')
155my $header_crp; # raw corpus header (written to '$_root_dir$dir_crp/$_header_file')
156
157my ( $header_fl_crp, $header_fl_doc, # flags for tracking where we are in the input document
158 $header_fl_txt, $data_fl );
159
160my ( $header_prfx, $data_prfx1, # $header_prfx is written to $_header_file, $data_* are written to $_data_file
161 $data_prfx2, $data_sfx );
162
163my @structures; # list of arrays, where each array represents a TEI I5 tag (except $_TOKENS_TAG) from the input document
164 # - the input of this array is written in func. 'write_structures' into the file '$_structure_file'
165
166my @tokens; # list of arrays, where each array represents a $_TOKENS_TAG from the input document
167 # - the input of this array is written in func. 'write_tokens' into the file '$_tokens_file'
168
169my ( $ref, $idx, $att_idx ); # needed in func. 'write_structures' and 'write_tokens'
170
171my ( $reader, # instance of 'XML::LibXML::Reader->new' (on input '$buf_in')
172 $tree_data ); # instance of 'XML::CompactTree::XS::readSubtreeToPerl' (on input '$reader')
173
174# these are only used inside recursive function 'retr_info'
175my ( $_IDX, # value is set dependent on $_XCT_LN - for extracting array of child elements from element in $tree_data
176 $e, # element from $tree_data
177 $n, # tag name of actual processed element $e
178 $rl, # recursion level
179 $dl, # actual length of string $data
180 @oti, # oti='open tags indizes' - a stack of indizes into @structures, where the top index in @oti
181 # represents the actual processed element from @structures
182 @oti2, # analogously to @oti, but with reference to array @tokens
183 $inside_tokens_tag, # flag is set, when inside $_TOKENS_TAG
184 ## variables for handling ~ whitespace related issue ~ (it is sometimes necessary, to correct the from-values for some tags)
185 $add_one, # ...
186 $fval, $fval2, # ...
Peter Harders41c35622020-07-12 01:16:22 +0200187 %ws); # hash for indices of whitespace-nodes (needed to recorrect from-values)
188 # idea: when closing element, check if it's from-index minus 1 refers to a whitespace-node
Peter Harders6f526a32020-06-29 21:44:41 +0200189 # (means: 'from-index - 1' is a key in %ws).
190 # if this is _not_ the case, then the from-value is one to high => correct it by substracting 1
191
192my $output; # temporary variable needed in 'write_*'-functions for writing output to zip-stream $zip)
193
194my ( $i, $c ); # index variables used in loops
195
Peter Harders6f526a32020-06-29 21:44:41 +0200196my ( $_CORP_HEADER_END, $_DOC_HEADER_END, $_TEXT_HEADER_END );
197
198
199#
200# ~~~ main ~~~
201#
202
203# ~ initializations ~
204
205($_XCT_LN)?($_IDX=5):($_IDX=4);
206
207$header_prfx = $data_prfx1 = $data_prfx2 = $data_sfx = "";
208
209$header_fl_txt = $header_fl_doc = $header_fl_crp = 0;
210
211$inside_tokens_tag = -1;
212
213$fval = $fval2 = 0;
214
215$_root_dir .= '/'; # base dir must always end with a slash
216$_root_dir =~ s/^\.?\///; # remove leading / (only relative paths allowed in IO::Compress::Zip) and redundant ./
217
218$_CORP_HEADER_BEG =~ s#^([^\s]+)(.*)$#$1\[\^>\]*$2#; $_CORP_HEADER_END = $1;
219$_DOC_HEADER_BEG =~ s#^([^\s]+)(.*)$#$1\[\^>\]*$2#; $_DOC_HEADER_END = $1;
220$_TEXT_HEADER_BEG =~ s#^([^\s]+)(.*)$#$1\[\^>\]*$2#; $_TEXT_HEADER_END = $1;
221
222## TODO: remove this, because it's IDS-specific
Peter Hardersd892a582020-02-12 15:45:22 +0100223$header_prfx = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
224$header_prfx .= "<?xml-model href=\"header.rng\" type=\"application/xml\" schematypens=\"http://relaxng.org/ns/structure/1.0\"?>\n";
225$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 +0200226##
Peter Hardersd892a582020-02-12 15:45:22 +0100227
228$data_prfx1 = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
229$data_prfx1 .= "<?xml-model href=\"text.rng\" type=\"application/xml\" schematypens=\"http://relaxng.org/ns/structure/1.0\"?>\n\n";
230$data_prfx1 .= "<raw_text docid=\"";
231$data_prfx2 .= "\" xmlns=\"http://ids-mannheim.de/ns/KorAP\">\n";
Peter Harders6f526a32020-06-29 21:44:41 +0200232## TODO: can 'metadata.xml' change or is it constant?
Peter Hardersd892a582020-02-12 15:45:22 +0100233$data_prfx2 .= " <metadata file=\"metadata.xml\" />\n";
Peter Harders6f526a32020-06-29 21:44:41 +0200234##
Peter Hardersd892a582020-02-12 15:45:22 +0100235$data_prfx2 .= " <text>";
236$data_sfx = "</text>\n</raw_text>";
237
Peter Hardersd892a582020-02-12 15:45:22 +0100238
Peter Harders6f526a32020-06-29 21:44:41 +0200239# ~ read input and write output (text by text) ~
Peter Harders41c35622020-07-12 01:16:22 +0200240main();
Peter Hardersd892a582020-02-12 15:45:22 +0100241
Peter Hardersd892a582020-02-12 15:45:22 +0100242
Peter Harders6f526a32020-06-29 21:44:41 +0200243#
244# ~~~ subs ~~~
245#
Peter Hardersd892a582020-02-12 15:45:22 +0100246
Peter Hardersd892a582020-02-12 15:45:22 +0100247
Peter Harders41c35622020-07-12 01:16:22 +0200248sub main {
Peter Hardersd892a582020-02-12 15:45:22 +0100249
Peter Harders6f526a32020-06-29 21:44:41 +0200250 my ( $pfx, $sfx );
Peter Hardersd892a582020-02-12 15:45:22 +0100251
Akron95bc98a2020-07-11 12:00:12 +0200252 # TODO:
253 # Replace all calls of $lc with $. or $input_fh->input_line_number,
254 # because otherwise remove_html_comments will
255 # move the lines forward without incrementing.
Peter Harders41c35622020-07-12 01:16:22 +0200256 my $lc = 0; # line counter (only for error handling and debugging)
Peter Harders6f526a32020-06-29 21:44:41 +0200257
Peter Harders41c35622020-07-12 01:16:22 +0200258 my $tl = 0; # text line (needed for whitespace handling)
Peter Harders6f526a32020-06-29 21:44:41 +0200259
260 $input_fh = *STDIN; # input file handle (default: stdin)
261
Akron85717512020-07-08 11:19:19 +0200262 $data_fl = 0;
Peter Harders6f526a32020-06-29 21:44:41 +0200263
264 $buf_in = $data = $dir = $dir_doc = $dir_crp = "";
265 $header_txt = $header_doc = $header_crp = "";
266
267
268 if ( $input_fname ne '' ){
269
270 open ( $input_fh, "<", "$input_fname") || die "File \'$input_fname\' could not be opened.\n";
271
272 }
273
274
Peter Harders41c35622020-07-12 01:16:22 +0200275 # prevents segfaulting of 'XML::LibXML::Reader' inside 'main()' - see notes on 'PerlIO layers' in 'man XML::LibXML')
Peter Harders90157342020-07-01 21:05:14 +0200276 # removing 'use open qw(:std :utf8)' would fix this problem too, but using binmode on input is more granular
277 binmode $input_fh;
278
279
Peter Harders6f526a32020-06-29 21:44:41 +0200280 # ~ loop (reading input document) ~
281
282 while ( <$input_fh> ){
283
284 $lc++; # line counter
285
286 # TODO: yet not tested fo big amounts of data
287 # must-have, otherwise comments in input could be fatal (e.g.: ...<!--\n<idsHeader...\n-->...)
Akron95bc98a2020-07-11 12:00:12 +0200288 remove_xml_comments( $input_fh, $_ ); # remove HTML comments (<!--...-->)
Peter Harders6f526a32020-06-29 21:44:41 +0200289
290 if ( $data_fl && m#^(.*)</${_TEXT_BODY}>(.*)$# ){
291
292
293 # ~ end of text body ~
294
295
Akron8b511f92020-07-09 17:28:08 +0200296 # write data.xml, structure.xml and evtl. morpho.xml and/or tokenization files (s.a.: $_tok_file_ext, $_tok_file_con, $_tok_file_agg)
Peter Harders6f526a32020-06-29 21:44:41 +0200297
298 $pfx = $1; $sfx = $2;
299
300 die "ERROR ($0): main(): input line number $lc: line with closing text-body tag '${_TEXT_BODY}'"
301 ." contains additional information ... => Aborting\n\tline=$_"
302 if $pfx !~ /^\s*$/ || $sfx !~ /^\s*$/;
303
304 if ( $dir ne "" ){
305
Peter Harders6f526a32020-06-29 21:44:41 +0200306 $reader = XML::LibXML::Reader->new( string => "<text>$buf_in</text>", huge => 1 );
Peter Harders6f526a32020-06-29 21:44:41 +0200307
Peter Harders41c35622020-07-12 01:16:22 +0200308 # ~ whitespace handling ~
309 #
310 # Every whitespace inside the processed text is 'significant' and recognized as a node of type 'XML_READER_TYPE_SIGNIFICANT_WHITESPACE'
311 # (see function 'retr_info()').
312 #
313 # Definition of significant and insignificant whitespace
314 # (source: https://www.oracle.com/technical-resources/articles/wang-whitespace.html):
315 #
316 # Significant whitespace is part of the document content and should be preserved.
317 # Insignificant whitespace is used when editing XML documents for readability.
318 # These whitespaces are typically not intended for inclusion in the delivery of the document.
319 #
Peter Harders6f526a32020-06-29 21:44:41 +0200320 if ( $_XCT_LN ){ # _XCT_LINE_NUMBERS is only for debugging
321 $tree_data = XML::CompactTree::XS::readSubtreeToPerl( $reader, XCT_DOCUMENT_ROOT | XCT_IGNORE_COMMENTS | XCT_ATTRIBUTE_ARRAY | XCT_LINE_NUMBERS );
322 } else {
323 $tree_data = XML::CompactTree::XS::readSubtreeToPerl( $reader, XCT_DOCUMENT_ROOT | XCT_IGNORE_COMMENTS | XCT_ATTRIBUTE_ARRAY );
324 }
325
326 @structures = (); @oti = ();
327
328 if ( $_TOKENS_PROC ){
329 @tokens = (); @oti2 = ()
330 }
331
332 $dl = $rl = 0;
333
334 # ~ whitespace related issue ~
335 $add_one = 0;
336 %ws = ();
337
338
339 # ~ recursion ~
340
341 retr_info( \$tree_data->[2] ); # parse input data
342
343 $rl--;
344
345
346 # ~ write data.xml ~
347
Peter Harders41c35622020-07-12 01:16:22 +0200348 # TODO: should not be necessary, because whitespace at the end of every input line is removed: see 'whitespace handling' inside text body
349 # (...elsif ( $data_fl )....)
Peter Harders6f526a32020-06-29 21:44:41 +0200350 $data =~ tr/\n\r/ /; # note: 2 blanks - otherwise offset data would become corrupt
Peter Harders41c35622020-07-12 01:16:22 +0200351 #
Peter Harders6f526a32020-06-29 21:44:41 +0200352
Peter Harders6f526a32020-06-29 21:44:41 +0200353
Akron8b511f92020-07-09 17:28:08 +0200354 if ( $_GEN_TOK_EXT ){
Peter Hardersb1227172020-07-21 02:12:10 +0200355
356 $ext_tok->tokenize($data);
357
358 } elsif ( $_GEN_TOK_INT ){
359
360 $cons_tok->tokenize($data);
361 $aggr_tok->tokenize($data);
Peter Harders6f526a32020-06-29 21:44:41 +0200362 }
Akron8b511f92020-07-09 17:28:08 +0200363
Peter Hardersb1227172020-07-21 02:12:10 +0200364 $data = encode_utf8( $data );
365
Peter Harders6f526a32020-06-29 21:44:41 +0200366 print STDERR "DEBUG ($0): main(): Writing (utf8-formatted) xml file $_root_dir$dir/$_data_file\n" if $_DEBUG;
367
Peter Harders6f526a32020-06-29 21:44:41 +0200368
369 $data =~ s/(&|<|>)/$ent{$1}/g;
370
Akron85717512020-07-08 11:19:19 +0200371 $zipper->new_stream("$_root_dir$dir/$_data_file")
372 ->print("$data_prfx1$text_id_esc$data_prfx2$data$data_sfx");
Peter Harders6f526a32020-06-29 21:44:41 +0200373
374 # ~ write structures ~
375
376 write_structures() if @structures;
377
378
379 # ~ write tokens ~
380
381 write_tokens() if $_TOKENS_PROC && @tokens;
382
383
Akron8b511f92020-07-09 17:28:08 +0200384 # ~ tokenization ~
Peter Harders6f526a32020-06-29 21:44:41 +0200385
Peter Hardersb1227172020-07-21 02:12:10 +0200386 if ( $_GEN_TOK_EXT ) {
Peter Harders6f526a32020-06-29 21:44:41 +0200387
Peter Hardersb1227172020-07-21 02:12:10 +0200388 $ext_tok->to_zip(
389 $zipper->new_stream("$_root_dir$dir/$_tok_dir/$_tok_file_ext"),
390 $text_id_esc
391 )
Peter Harders6f526a32020-06-29 21:44:41 +0200392
Peter Hardersb1227172020-07-21 02:12:10 +0200393 } elsif ( $_GEN_TOK_INT ){
Akron997e9402020-07-11 12:06:13 +0200394
Peter Hardersb1227172020-07-21 02:12:10 +0200395 # Output token streams to zip streams
396 $cons_tok->to_zip(
397 $zipper->new_stream("$_root_dir$dir/$_tok_dir/$_tok_file_con"),
398 $text_id_esc
399 );
400 $aggr_tok->to_zip(
401 $zipper->new_stream("$_root_dir$dir/$_tok_dir/$_tok_file_agg"),
402 $text_id_esc
403 );
404 $aggr_tok->reset;
405 $cons_tok->reset;
Peter Harders6f526a32020-06-29 21:44:41 +0200406 }
407
Peter Hardersb1227172020-07-21 02:12:10 +0200408 #print STDERR "$0: write_tokenization(): DONE\n";
409
Peter Harders6f526a32020-06-29 21:44:41 +0200410 $data_fl = 0; $buf_in = $data = $dir = ""; # reinit.
411
412 } else { # $dir eq ""
413
414 print STDERR "WARNING ($0): main(): maybe empty textSigle => skipping this text ...\n";
415 print STDERR "WARNING ($0): main(): text header=$header_txt\n";
416 print STDERR "WARNING ($0): main(): data=$data\n";
Peter Hardersd892a582020-02-12 15:45:22 +0100417 }
418
Peter Harders6f526a32020-06-29 21:44:41 +0200419 } elsif ( $data_fl ){
Peter Hardersd892a582020-02-12 15:45:22 +0100420
Peter Hardersd892a582020-02-12 15:45:22 +0100421
Peter Harders6f526a32020-06-29 21:44:41 +0200422 # ~ inside text body ~
Peter Hardersd892a582020-02-12 15:45:22 +0100423
Peter Hardersd892a582020-02-12 15:45:22 +0100424
Peter Harders6f526a32020-06-29 21:44:41 +0200425 #print STDERR "inside text body (\$data_fl set)\n";
426
427 # ~ whitespace handling ~
428
Peter Harders41c35622020-07-12 01:16:22 +0200429 # The idea for the below code fragment was to fix (recreate) missing whitespace in a poorly created corpus, in which linebreaks where inserted
430 # into the text with the addition that maybe (or not) whitespace before those linebreaks was unintenionally stripped.
Peter Hardersd892a582020-02-12 15:45:22 +0100431 #
Peter Harders41c35622020-07-12 01:16:22 +0200432 # It soon turned out, that it was best to suggest considering just avoiding linebreaks and putting all primary text tokens into one line (see
433 # example further down and notes on 'Input restrictions' in the manpage).
434 #
435 # Somehow an old first very poor approach remained, which is not stringent, but also doesn't affect one-line text.
436 #
437 # TODO: Maybe it's best, to keep the stripping of whitespace and to just remove the if-clause and to insert a blank by default (with possibly
438 # an option on how newlines in primary text should be handled (stripped or replaced by a whitespace)).
439 #
440 # Examples (how primary text with linebreaks would be converted by below code):
441 #
442 # '...<w>end</w>\n<w>.</w>...' -> '...<w>end</w> <w>.</w>...'
443 # '...<w>,</w>\n<w>this</w>\n<w>is</w>\n<w>it</w>\n<w>!</w>...' -> '<w>,<w> <w>this</w> <w>is</w> <w>it</w> <w>!</w>'.
Peter Hardersd892a582020-02-12 15:45:22 +0100444
Peter Harders41c35622020-07-12 01:16:22 +0200445 s/^\s+//; s/\s+$//; # remove consecutive whitespace at beginning and end (mostly one newline)
446
447 ### NOTE: this is only relevant, if a text consists of more than one line
448 ### TODO: find a better solution, or create a warning, if a text has more than one line ($tl > 1)
449 ### do testing with 2 different corpora (one with only one-line texts, the other with several lines per text)
Peter Harders6f526a32020-06-29 21:44:41 +0200450 if ( m/<[^>]+>[^<]/ ){ # line contains at least one tag with at least one character contents
Peter Hardersd892a582020-02-12 15:45:22 +0100451
Peter Harders41c35622020-07-12 01:16:22 +0200452 # NOTE: not stringent ('...' stands for text):
453 #
454 # beg1............................end1 => no blank before 'beg1'
455 # beg2....<pb/>...................end2 => no blank before 'beg2'
456 # beg3....<info attr1="val1"/>....end3 => no blank before 'beg3'
457 # beg4....<test>ok</test>.........end4 => blank before 'beg4'
458 #
459 # => beg1....end1beg2...<pb/>...end2beg3....<info attr1="val1"/>....end3 beg4...<test>ok</test>....end4
460 # ^
461 # |_blank between 'end3' and 'beg4'
Peter Hardersd892a582020-02-12 15:45:22 +0100462
Peter Harders41c35622020-07-12 01:16:22 +0200463 $tl++; # counter for text lines
464
465 s/^(.)/ $1/ if $tl > 1; # insert blank before 1st character (for 2nd line and consecutive lines)
Peter Hardersd892a582020-02-12 15:45:22 +0100466 }
Peter Harders41c35622020-07-12 01:16:22 +0200467 ###
Peter Hardersd892a582020-02-12 15:45:22 +0100468
Peter Harders6f526a32020-06-29 21:44:41 +0200469 # add line to buffer
470 $buf_in .= $_;
471
472 } elsif ( $header_fl_txt && m#^(.*</${_TEXT_HEADER_END}>)(.*)$# ){
473
474
475 # ~ end of text header ~
476
477
478 #print STDERR "end of text header\n";
479
480 # write it to header.xml
481
482 $sfx = $2;
483
484 $header_txt .= $1; $header_fl_txt = 0;
485
486
487 die "ERROR ($0): main(): input line number $lc: line with closing text-header tag '${_TEXT_HEADER_END}'"
488 ." contains additional information ... => Aborting\n\tline=$_"
489 if $sfx !~ /^\s*$/;
490
491 if ( $dir eq "" ){
492
493 print STDERR "WARNING ($0): main(): input line number $lc: empty textSigle in text header => nothing to do ...\ntext header=$header_txt\n";
494
495 } else {
496
497 print STDERR "DEBUG ($0): Writing file $_root_dir$dir/$_header_file\n" if $_DEBUG;
498
Peter Harders6f526a32020-06-29 21:44:41 +0200499 $header_txt = encode_utf8( $header_txt );
500
Akron85717512020-07-08 11:19:19 +0200501 $zipper->new_stream("$_root_dir$dir/$_header_file")
502 ->print("$header_prfx$header_txt");
Peter Harders6f526a32020-06-29 21:44:41 +0200503
504 $header_txt = "";
Peter Hardersd892a582020-02-12 15:45:22 +0100505 }
Peter Hardersd892a582020-02-12 15:45:22 +0100506
Peter Harders6f526a32020-06-29 21:44:41 +0200507 } elsif ( $header_fl_txt ){
Peter Hardersd892a582020-02-12 15:45:22 +0100508
Peter Harders6f526a32020-06-29 21:44:41 +0200509 # ~ inside text header ~
Peter Hardersd892a582020-02-12 15:45:22 +0100510
Peter Harders6f526a32020-06-29 21:44:41 +0200511
512 #print STDERR "inside text header\n";
513
514 if( m#^(.*)<${_TEXT_SIGLE}(?: [^>]*)?>([^<]*)(.*)$# ){
515
516 $pfx = $1; $sfx = $3;
517
518 $dir = $2; $text_id = $dir;
519
520 $text_id =~ tr/\//_/; $dir =~ s/("|&|<|>)/$ent{$1}/g;
521
522 $text_id = encode_utf8( $text_id );
523
524 die "ERROR ($0): main(): input line number $lc: line with text-sigle tag '$_TEXT_SIGLE' is not in expected format ... => Aborting\n\tline=$_"
525 if $pfx !~ /^\s*$/ || $sfx !~ m#^</${_TEXT_SIGLE}>\s*$# || $dir =~ /^\s*$/;
526
527 # log output for seeing progression
528 print STDERR "$0: main(): text_id=".decode_utf8( $text_id )."\n";
529
530 $text_id_esc = $text_id;
531
532 s#(<${_TEXT_SIGLE}(?: [^>]*)?>)[^<]+(</${_TEXT_SIGLE}>)#$1$dir$2# # to be consistent with escaping, escape also textSigle in text-header
533 if $text_id_esc =~ s/("|&|<|>)/$ent{$1}/g;
534
535 $dir =~ tr/\./\//;
536 }
537
538 $header_txt .= $_;
539
540 } elsif ( $header_fl_doc && m#^(.*</${_DOC_HEADER_END}>)(.*)$# ){
541
542
543 # ~ end of document header ~
544
Peter Harders6f526a32020-06-29 21:44:41 +0200545 #print STDERR "end of doc header\n";
546
547 # write it to header.xml
548
549 $sfx = $2;
550
551 $header_doc .= $1; $header_fl_doc = 0;
552
553 die "ERROR ($0): main(): input line number $lc: line with closing document-header tag '${_DOC_HEADER_END}'"
554 ." contains additional information ... => Aborting\n\tline=$_"
555 if $sfx !~ /^\s*$/;
556
557 if( $dir_doc eq "" ){
558
559 print STDERR "WARNING ($0): main(): input line number $lc: empty document sigle in document header"
560 ." => nothing to do ...\ndocument header=$header_doc\n";
561
562 } else {
563
564 print STDERR "DEBUG ($0): Writing file $_root_dir$dir_doc/$_header_file\n" if $_DEBUG;
565
Peter Harders6f526a32020-06-29 21:44:41 +0200566 $header_doc = encode_utf8( $header_doc );
567
Akron85717512020-07-08 11:19:19 +0200568 $zipper->new_stream("$_root_dir$dir_doc/$_header_file")
569 ->print("$header_prfx$header_doc");
Peter Harders6f526a32020-06-29 21:44:41 +0200570
571 $header_doc = $dir_doc = "";
572 }
573
574 } elsif ( $header_fl_doc ){
575
576
577 # ~ inside document header ~
578
579
580 #print STDERR "inside doc header\n";
581
582 if ( m#^(.*)<${_DOC_SIGLE}(?: [^>]*)?>([^<]*)(.*)$# ){
583
584 $pfx = $1; $sfx = $3;
585
586 $dir_doc = $2;
587
588 die "ERROR ($0): main(): input line number $lc: line with document-sigle tag '$_DOC_SIGLE' is not in expected format ... => Aborting\n\tline=$_"
589 if $pfx !~ /^\s*$/ || $sfx !~ m#^</${_DOC_SIGLE}>\s*$# || $dir_doc =~ /^\s*$/;
590
591 s#(<${_DOC_SIGLE}(?: [^>]*)?>)[^<]+(</${_DOC_SIGLE}>)#$1$dir_doc$2# # to be consistent with escaping, escape also textSigle in Document-Header
592 if $dir_doc =~ s/("|&|<|>)/$ent{$1}/g;
593 }
594
595 $header_doc .= $_;
596
597 } elsif ( m#^(.*)(<${_TEXT_HEADER_BEG}.*)$# ){
598
599 # ~ start of text header ~
600
601
602 #print STDERR "begin of text header\n";
603
604 $header_txt = $_; $header_fl_txt = 1; $pfx = $1;
605
Peter Harders41c35622020-07-12 01:16:22 +0200606 $tl = 0; # reset (needed for ~ whitespace handling ~)
Peter Harders6f526a32020-06-29 21:44:41 +0200607
608 die "ERROR ($0): main(): input line number $lc: line with opening text-header tag '${_TEXT_HEADER_BEG}'"
609 ." is not in expected format ... => Aborting\n\tline=$_"
610 if $pfx !~ /^\s*$/;
611
612 } elsif ( m#^(.*)<${_TEXT_BODY}(?: [^>]*)?>(.*)$# ){
613
614
615 # ~ start of text body ~
616
617
618 #print STDERR "inside text body\n";
619
620 $pfx = $1; $sfx = $2;
621
622 $data_fl = 1;
623
624 die "ERROR ($0): main(): input line number $lc: line with opening text-body tag '${_TEXT_BODY}'"
625 ." contains additional information ... => Aborting\n\tline=$_"
626 if $pfx !~ /^\s*$/ || $sfx !~ /^\s*$/;
627
628 } elsif ( m#^(.*)(<${_DOC_HEADER_BEG}.*)$# ){
629
630
631 # ~ start of document header ~
632
633
634 #print STDERR "begin of doc header\n";
635
636 $header_doc = "$2\n"; $header_fl_doc = 1; $pfx = $1;
637
638 die "ERROR ($0): main(): input line number $lc: line with opening document-header tag '${_DOC_HEADER_BEG}'"
639 ."is not in expected format ... => Aborting\n\tline=$_"
640 if $pfx !~ /^\s*$/;
641
642 } elsif ( $header_fl_crp && m#^(.*</${_CORP_HEADER_END}>)(.*)$# ){
643
644
645 # ~ end of corpus header ~
646
647
648 #print STDERR "end of corp header\n";
649
650 $sfx = $2;
651
652 $header_crp .= $1; $header_fl_crp = 0;
653
654 die "ERROR ($0): main(): input line number $lc: line with closing corpus-header tag '${_CORP_HEADER_END}'"
655 ." contains additional information ... => Aborting\n\tline=$_"
656 if $sfx !~ /^\s*$/;
657
658 if ( $dir_crp eq "" ){
659
660 print STDERR "WARNING ($0): main(): input line number $lc: empty corpus sigle in corpus header => nothing to do ...\ncorpus header=$header_crp\n";
661
662 } else {
663
664 print STDERR "DEBUG ($0): Writing file $_root_dir$dir_crp/$_header_file\n" if $_DEBUG;
665
Peter Harders6f526a32020-06-29 21:44:41 +0200666 $header_crp = encode_utf8( $header_crp );
667
Akron85717512020-07-08 11:19:19 +0200668 $zipper->new_stream("$_root_dir$dir_crp/$_header_file")
669 ->print("$header_prfx$header_crp");
Peter Harders6f526a32020-06-29 21:44:41 +0200670
671 $header_crp = $dir_crp = "";
672 }
673
674 } elsif ( $header_fl_crp ){
675
676
677 # ~ inside corpus header ~
678
679
680 #print STDERR "inside corp header\n";
681
682 if ( m#^(.*)<${_CORP_SIGLE}(?: [^>]*)?>([^<]*)(.*)$# ){
683
684 $pfx = $1; $sfx = $3;
685
686 $dir_crp = $2;
687
688 die "ERROR ($0): main(): input line number $lc: line with korpusSigle-tag is not in expected format ... => Aborting\n\tline=$_"
689 if $pfx !~ /^\s*$/ || $sfx !~ m#^</${_CORP_SIGLE}>\s*$# || $dir_crp =~ /^\s*$/;
690
691 if ( $dir_crp =~ s/("|&|<|>)/$ent{$1}/g ){
692
693 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 +0100694 }
695 }
696
Peter Harders6f526a32020-06-29 21:44:41 +0200697 $header_crp .= $_;
Peter Hardersd892a582020-02-12 15:45:22 +0100698
Peter Harders6f526a32020-06-29 21:44:41 +0200699 } elsif ( m#^(.*)(<${_CORP_HEADER_BEG}.*)$# ){
Peter Hardersd892a582020-02-12 15:45:22 +0100700
Peter Hardersd892a582020-02-12 15:45:22 +0100701
Peter Harders6f526a32020-06-29 21:44:41 +0200702 # ~ start of corpus header ~
Peter Hardersd892a582020-02-12 15:45:22 +0100703
Peter Harders6f526a32020-06-29 21:44:41 +0200704
705 #print STDERR "begin of corp header\n";
706
707 $header_crp = $2; $header_fl_crp = 1; $pfx = $1;
708
709 die "ERROR ($0): main(): input line number $lc: line with opening corpus-header tag '${_CORP_HEADER_BEG}'"
710 ." is not in expected format ... => Aborting\n\tline=$_"
711 if $pfx !~ /^\s*$/;
Peter Hardersd892a582020-02-12 15:45:22 +0100712 }
713
Peter Harders6f526a32020-06-29 21:44:41 +0200714 } #end: while
Peter Hardersd892a582020-02-12 15:45:22 +0100715
Akron85717512020-07-08 11:19:19 +0200716 $zipper->close;
Peter Harders6f526a32020-06-29 21:44:41 +0200717
Akron8b511f92020-07-09 17:28:08 +0200718 if( $_GEN_TOK_EXT ){
719 $ext_tok->close;
Peter Hardersd892a582020-02-12 15:45:22 +0100720 }
Peter Hardersd892a582020-02-12 15:45:22 +0100721
Peter Harders41c35622020-07-12 01:16:22 +0200722} # end: sub main
Peter Hardersd892a582020-02-12 15:45:22 +0100723
Peter Hardersd892a582020-02-12 15:45:22 +0100724
Peter Harders41c35622020-07-12 01:16:22 +0200725sub retr_info { # called from main()
Peter Hardersd892a582020-02-12 15:45:22 +0100726
Peter Harders41c35622020-07-12 01:16:22 +0200727 # Notes on how 'XML::CompactTree::XS' works
Peter Harders6f526a32020-06-29 21:44:41 +0200728 #
Peter Harders41c35622020-07-12 01:16:22 +0200729 # Example: <node a="v"><node1>some <n/> text</node1><node2>more-text</node2></node>
Peter Harders6f526a32020-06-29 21:44:41 +0200730 #
Peter Harders41c35622020-07-12 01:16:22 +0200731 # Print out name of 'node2' for the above example:
732 #
733 # 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 "\x27".$data->[2]->[0]->[5]->[1]->[1]."\x27\n"'
734 #
735 # Exploring the structure of $data ( = reference to below array ):
Peter Harders6f526a32020-06-29 21:44:41 +0200736 #
737 # [ 0: XML_READER_TYPE_DOCUMENT,
738 # 1: ?
Peter Harders41c35622020-07-12 01:16:22 +0200739 # 2: [ 0: [ 0: XML_READER_TYPE_ELEMENT <- start recursion with array '$data->[2]' (see main(): retr_info( \$tree_data->[2] ))
Peter Harders6f526a32020-06-29 21:44:41 +0200740 # 1: 'node'
741 # 2: ?
742 # 3: HASH (attributes)
743 # 4: 1 (line number)
744 # 5: [ 0: [ 0: XML_READER_TYPE_ELEMENT
745 # 1: 'node1'
746 # 2: ?
747 # 3: undefined (no attributes)
748 # 4: 1 (line number)
749 # 5: [ 0: [ 0: XML_READER_TYPE_TEXT
750 # 1: 'some '
751 # ]
752 # 1: [ 0: XML_READER_TYPE_ELEMENT
753 # 1: 'n'
754 # 2: ?
755 # 3: undefined (no attributes)
756 # 4: 1 (line number)
Peter Harders41c35622020-07-12 01:16:22 +0200757 # 5: undefined (no child-nodes)
Peter Harders6f526a32020-06-29 21:44:41 +0200758 # ]
759 # 2: [ 0: XML_READER_TYPE_TEXT
760 # 1: ' text'
761 # ]
762 # ]
763 # ]
764 # 1: [ 0: XML_READER_TYPE_ELEMENT
765 # 1: 'node2'
766 # 2: ?
767 # 3: undefined (not attributes)
768 # 4: 1 (line number)
769 # 5: [ 0: [ 0: XML_READER_TYPE_TEXT
770 # 1: 'more-text'
771 # ]
772 # ]
773 # ]
774 # ]
775 # ]
776 # ]
777 # ]
778 #
779 # $data->[0] = 9 (=> type == XML_READER_TYPE_DOCUMENT)
780 #
781 # ref($data->[2]) == ARRAY (with 1 element for 'node')
782 # ref($data->[2]->[0]) == ARRAY (with 6 elements)
783 #
784 # $data->[2]->[0]->[0] == 1 (=> type == XML_READER_TYPE_ELEMENT)
785 # $data->[2]->[0]->[1] == 'node'
786 # ref($data->[2]->[0]->[3]) == HASH (=> ${$data->[2]->[0]->[3]}{a} == 'v')
787 # $data->[2]->[0]->[4] == 1 (line number)
788 # ref($data->[2]->[0]->[5]) == ARRAY (with 2 elements for 'node1' and 'node2')
Peter Harders41c35622020-07-12 01:16:22 +0200789 # # child-nodes of actual node (see $_IDX)
Peter Harders6f526a32020-06-29 21:44:41 +0200790 #
791 # ref($data->[2]->[0]->[5]->[0]) == ARRAY (with 6 elements)
792 # $data->[2]->[0]->[5]->[0]->[0] == 1 (=> type == XML_READER_TYPE_ELEMENT)
793 # $data->[2]->[0]->[5]->[0]->[1] == 'node1'
794 # $data->[2]->[0]->[5]->[0]->[3] == undefined (=> no attribute)
795 # $data->[2]->[0]->[5]->[0]->[4] == 1 (line number)
796 # ref($data->[2]->[0]->[5]->[0]->[5]) == ARRAY (with 3 elements for 'some ', '<n/>' and ' text')
797 #
798 # ref($data->[2]->[0]->[5]->[0]->[5]->[0]) == ARRAY (with 2 elements)
799 # $data->[2]->[0]->[5]->[0]->[5]->[0]->[0] == 3 (=> type == XML_READER_TYPE_TEXT)
800 # $data->[2]->[0]->[5]->[0]->[5]->[0]->[1] == 'some '
801 #
802 # ref($data->[2]->[0]->[5]->[0]->[5]->[1]) == ARRAY (with 5 elements)
803 # $data->[2]->[0]->[5]->[0]->[5]->[1]->[0] == 1 (=> type == XML_READER_TYPE_ELEMENT)
804 # $data->[2]->[0]->[5]->[0]->[5]->[1]->[1] == 'n'
805 # $data->[2]->[0]->[5]->[0]->[5]->[1]->[3] == undefined (=> no attribute)
806 # $data->[2]->[0]->[5]->[0]->[5]->[1]->[4] == 1 (line number)
Peter Harders41c35622020-07-12 01:16:22 +0200807 # $data->[2]->[0]->[5]->[0]->[5]->[1]->[5] == undefined (=> no child-nodes)
Peter Harders6f526a32020-06-29 21:44:41 +0200808 #
809 # ref($data->[2]->[0]->[5]->[0]->[5]->[2]) == ARRAY (with 2 elements)
810 # $data->[2]->[0]->[5]->[0]->[5]->[2]->[0] == 3 (=> type == XML_READER_TYPE_TEXT)
811 # $data->[2]->[0]->[5]->[0]->[5]->[2]->[1] == ' text'
812 #
813 #
814 # retr_info() starts with the array reference ${$_[0]} (= \$tree_data->[2]), which corresponds to ${\$data->[2]} in the above example.
815 # Hence, the expression @{${$_[0]}} corresponds to @{${\$data->[2]}}, $e to ${${\$data->[2]}}[0] (= $data->[2]->[0]) and $e->[0] to
816 # ${${\$data->[2]}}[0]->[0] (= $data->[2]->[0]->[0]).
Peter Hardersd892a582020-02-12 15:45:22 +0100817
Peter Harders41c35622020-07-12 01:16:22 +0200818
Peter Harders6f526a32020-06-29 21:44:41 +0200819 $rl++; # recursion level (1 = topmost level inside retr_info() = should always be level of tag $_TEXT_BODY)
Peter Hardersd892a582020-02-12 15:45:22 +0100820
Peter Hardersd892a582020-02-12 15:45:22 +0100821
Peter Harders6f526a32020-06-29 21:44:41 +0200822 foreach $e ( @{${$_[0]}} ){ # iteration through all array elements ($_[0] is a reference to an array reference)
Peter Hardersd892a582020-02-12 15:45:22 +0100823
Peter Hardersd892a582020-02-12 15:45:22 +0100824
Peter Harders41c35622020-07-12 01:16:22 +0200825 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 +0100826
Peter Hardersd892a582020-02-12 15:45:22 +0100827
Peter Harders6f526a32020-06-29 21:44:41 +0200828 #~~~~
Peter Harders41c35622020-07-12 01:16:22 +0200829 # from here: tag-node (opening)
Peter Harders6f526a32020-06-29 21:44:41 +0200830 #~~~~
Peter Hardersd892a582020-02-12 15:45:22 +0100831
Peter Hardersd892a582020-02-12 15:45:22 +0100832
Peter Harders6f526a32020-06-29 21:44:41 +0200833 # insert new array (for new tag) into @structures with tag-name and tag-attributes (if present)
834 # 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 +0100835
Peter Harders6f526a32020-06-29 21:44:41 +0200836 # ~ tag name ~
Peter Hardersd892a582020-02-12 15:45:22 +0100837
Peter Harders6f526a32020-06-29 21:44:41 +0200838 $n = $e->[1];
Peter Hardersd892a582020-02-12 15:45:22 +0100839
Peter Hardersd892a582020-02-12 15:45:22 +0100840
Peter Harders6f526a32020-06-29 21:44:41 +0200841 # ~ handle structures ~
Peter Hardersd892a582020-02-12 15:45:22 +0100842
Peter Harders6f526a32020-06-29 21:44:41 +0200843 my @array;
844 push @array, $n;
845 push @structures, \@array;
846 push @oti, $#structures; # add highest index of @structures to @oti
Peter Hardersd892a582020-02-12 15:45:22 +0100847
Peter Hardersd892a582020-02-12 15:45:22 +0100848
Peter Harders6f526a32020-06-29 21:44:41 +0200849 # ~ handle tokens ~
Peter Hardersd892a582020-02-12 15:45:22 +0100850
Peter Harders6f526a32020-06-29 21:44:41 +0200851 $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 +0100852
Peter Harders6f526a32020-06-29 21:44:41 +0200853 if ( $_TOKENS_PROC && $inside_tokens_tag == $rl ){
Peter Hardersd892a582020-02-12 15:45:22 +0100854
Peter Harders6f526a32020-06-29 21:44:41 +0200855 my @array2;
856 push @array2, $n;
857 push @tokens, \@array2;
858 push @oti2, $#tokens;
859 }
Peter Hardersd892a582020-02-12 15:45:22 +0100860
Peter Hardersd892a582020-02-12 15:45:22 +0100861
Peter Harders6f526a32020-06-29 21:44:41 +0200862 # ~ handle attributes ~
Peter Hardersd892a582020-02-12 15:45:22 +0100863
Peter Harders6f526a32020-06-29 21:44:41 +0200864 if ( defined $e->[3] ){ # only if attributes exist
Peter Hardersd892a582020-02-12 15:45:22 +0100865
Peter Harders6f526a32020-06-29 21:44:41 +0200866 for ( $c = 0; $c < @{$e->[3]}; $c += 2 ){ # with 'XCT_ATTRIBUTE_ARRAY', $node->[3] is an array reference of the form
867 # [ name1, value1, name2, value2, ....] of attribute names and corresponding values.
868 # note: arrays are faster (see: http://makepp.sourceforge.net/2.0/perl_performance.html)
Peter Hardersd892a582020-02-12 15:45:22 +0100869
Peter Harders6f526a32020-06-29 21:44:41 +0200870 # '$c' references the 'key' and '$c+1' the 'value'
871 push @{$structures[$#structures]}, ${$e->[3]}[$c], ${$e->[3]}[$c+1];
Peter Hardersd892a582020-02-12 15:45:22 +0100872
Peter Harders6f526a32020-06-29 21:44:41 +0200873 if ( $_TOKENS_PROC && $inside_tokens_tag == $rl ){
Peter Hardersd892a582020-02-12 15:45:22 +0100874
Peter Harders6f526a32020-06-29 21:44:41 +0200875 push @{$tokens[$#tokens]}, ${$e->[3]}[$c], ${$e->[3]}[$c+1];
876 }
877
878 }
879 }
880
881
882 # ~ index 'from' ~
883
884 # this is, where a normal tag or tokens-tag ($_TOKENS_TAG) starts
885
Peter Harders41c35622020-07-12 01:16:22 +0200886 push @{$structures[$#structures]}, ( $dl + $add_one ); # see below (text- and whitespace-nodes) for explanation on '$add_one'
Peter Harders6f526a32020-06-29 21:44:41 +0200887
888 if ( $_TOKENS_PROC && $inside_tokens_tag == $rl ){
889
890 push @{$tokens[$#tokens]}, ( $dl + $add_one );
891 }
892
893
894 #~~~~
Peter Harders41c35622020-07-12 01:16:22 +0200895 # until here: tag-node (opening)
Peter Harders6f526a32020-06-29 21:44:41 +0200896 #~~~~
897
898
899 # ~~ RECURSION ~~
900
Peter Harders41c35622020-07-12 01:16:22 +0200901 if ( defined $e->[$_IDX] ){ # do no recursion, if $e->[$_IDX] is not defined (because we have no array of child-nodes, e.g.: <back/>)
Peter Harders6f526a32020-06-29 21:44:41 +0200902
Peter Harders41c35622020-07-12 01:16:22 +0200903 retr_info( \$e->[$_IDX] ); # recursion with array of child-nodes
Peter Harders6f526a32020-06-29 21:44:41 +0200904
905 $rl--; # return from recursion
906 }
907
908
909 #~~~~~
Peter Harders41c35622020-07-12 01:16:22 +0200910 # from here: tag-node (closing)
Peter Harders6f526a32020-06-29 21:44:41 +0200911 #~~~~~
912
913
914 # ~ handle structures ~
915
916 {
917 my $ix = pop @oti; # index of just closed tag
918
919 my $aix = $#{$structures[$ix]}; # determine highest index from 'array referring to last closed tag' ...
920
921 $fval = ${$structures[$ix]}[ $aix ]; # ... and get it's from-value
922
923 if ( $fval > 0 && not exists $ws{ $fval - 1 } ){ # ~ whitespace related issue ~
924
Peter Harders41c35622020-07-12 01:16:22 +0200925 # ~ previous node was a text-node ~
Peter Harders6f526a32020-06-29 21:44:41 +0200926
Peter Harders41c35622020-07-12 01:16:22 +0200927 ${$structures[$ix]}[ $aix ] = $fval - 1; # recorrect from-value (see below: Notes on ~ whitespace related issue ~)
Peter Harders6f526a32020-06-29 21:44:41 +0200928 }
929
930 # in case this fails, check input
931 die "ERROR ($0, retr_info()): text_id='$text_id', processing of \@structures: from-value ($fval) is 2 or more greater"
932 ." than to-value ($dl) => please check. aborting ...\n"
933 if ( $fval - 1 ) > $dl;
934
Peter Harders41c35622020-07-12 01:16:22 +0200935 # TODO: find example for which this case applies
Peter Harders6f526a32020-06-29 21:44:41 +0200936 # maybe this is not necessary anymore, because the above recorrection of the from-value suffices
937 # TODO: check, if it's better to remove this line and change above check to 'if ( $fval - 1) >= $dl;
Peter Harders41c35622020-07-12 01:16:22 +0200938 # do testing with bigger corpus excerpt (wikipedia?)
Peter Harders6f526a32020-06-29 21:44:41 +0200939 ${$structures[$ix]}[ $aix ] = $dl if $fval == $dl + 1; # correct from-value (same as ... if $fval-1 == $dl)
940
941 push @{$structures[$ix]}, $dl, $rl; # to-value and recursion-level
942
943 # note: use $dl, because the offsets are _between_ the characters (e.g.: word = 'Hello' => from = 0 (before 'H'), to = 5 (after 'o'))
944 }
945
946
947 # ~ handle tokens ~
948
949
950 if ( $_TOKENS_PROC && $inside_tokens_tag == $rl ){
951
952 my $ix = pop @oti2;
953
954 my $aix = $#{$tokens[$ix]};
955
956 $fval2 = ${$tokens[$ix]}[ $aix ]; # from-value
957
958 if( $fval2 > 0 && not exists $ws{ $fval2 - 1 } ){ # ~ whitespace related issue ~
959
Peter Harders41c35622020-07-12 01:16:22 +0200960 # ~ previous node was a text-node ~
Peter Harders6f526a32020-06-29 21:44:41 +0200961
Peter Harders41c35622020-07-12 01:16:22 +0200962 ${$tokens[$ix]}[ $aix ] = $fval2 - 1; # recorrect from-value (see below: Notes on ~ whitespace related issue ~)
Peter Harders6f526a32020-06-29 21:44:41 +0200963 }
964
965 # in case this fails, check input
966 die "ERROR ($0, retr_info()): text_id='$text_id', processing of \@tokens: from-value ($fval2) is 2 or more greater"
967 ." than to-value ($dl) => please check. aborting ...\n"
968 if ( $fval2 - 1 ) > $dl;
969
Peter Harders41c35622020-07-12 01:16:22 +0200970 # TODO: find example for which this case applies
Peter Harders6f526a32020-06-29 21:44:41 +0200971 # maybe this is not necessary anymore, because the above recorrection of the from-value suffices
972 # TODO: check, if it's better to remove this line and change above check to 'if ( $fval2 - 1) >= $dl;
Peter Harders41c35622020-07-12 01:16:22 +0200973 # do testing with bigger corpus excerpt (wikipedia?)
Peter Harders6f526a32020-06-29 21:44:41 +0200974 ${$tokens[$ix]}[ $aix ] = $dl if $fval2 == $dl + 1; # correct from-value (same as ... if $fval-1 == $dl)
975
976 push @{$tokens[$ix]}, $dl, $rl; # to-value and recursion-level
977
978 $inside_tokens_tag = -1; # reset
979 }
980
981 # ~ whitespace related issue ~
Peter Hardersd892a582020-02-12 15:45:22 +0100982 # clean up
Peter Harders6f526a32020-06-29 21:44:41 +0200983 delete $ws{ $fval - 1 } if $fval > 0 && exists $ws{ $fval - 1 };
984 delete $ws{ $fval2 - 1 } if $_TOKENS_PROC && $fval2 > 0 && exists $ws{ $fval2 - 1 };
Peter Hardersd892a582020-02-12 15:45:22 +0100985
986
Peter Harders41c35622020-07-12 01:16:22 +0200987 #~~~~
988 # until here: tag-node (closing)
989 #~~~~
Peter Hardersd892a582020-02-12 15:45:22 +0100990
991
Peter Harders41c35622020-07-12 01:16:22 +0200992 #~~~~~
993 # from here: text- and whitespace-nodes
994 #~~~~~
995
996 # The 3rd form of nodes, besides text- (XML_READER_TYPE_TEXT) and tag-nodes (XML_READER_TYPE_ELEMENT) are nodes of the type
997 # 'XML_READER_TYPE_SIGNIFICANT_WHITESPACE'.
Peter Harders6f526a32020-06-29 21:44:41 +0200998 #
Peter Harders41c35622020-07-12 01:16:22 +0200999 # When modifiying the previous example (see: Notes on how 'XML::CompactTree::XS' works) by inserting an additional blank between
1000 # '</node1>' and '<node2>', the output for '$data->[2]->[0]->[5]->[1]->[1]' is a blank (' ') and it's type is '14'
1001 # (XML_READER_TYPE_SIGNIFICANT_WHITESPACE, see 'man XML::LibXML::Reader'):
Peter Harders6f526a32020-06-29 21:44:41 +02001002 #
Peter Harders41c35622020-07-12 01:16:22 +02001003 # 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=\x27".$data->[2]->[0]->[5]->[1]->[1]."\x27, type=".$data->[2]->[0]->[5]->[1]->[0]."\n"'
Peter Hardersd892a582020-02-12 15:45:22 +01001004
Peter Harders6f526a32020-06-29 21:44:41 +02001005 } elsif ( $e->[0] == XML_READER_TYPE_TEXT || $e->[0] == XML_READER_TYPE_SIGNIFICANT_WHITESPACE ){
Peter Hardersd892a582020-02-12 15:45:22 +01001006
Peter Harders41c35622020-07-12 01:16:22 +02001007 # Notes on ~ whitespace related issue ~ (referred to the code fragment below)
Peter Harders6f526a32020-06-29 21:44:41 +02001008 #
Peter Harders41c35622020-07-12 01:16:22 +02001009 # Example: '... <head type="main"><s>Campagne in Frankreich</s></head><head type="sub"> <s>1792</s> ...'
Peter Harders6f526a32020-06-29 21:44:41 +02001010 #
1011 # Two text-nodes should normally be separated by a blank. In the above example, that would be the 2 text-nodes
Peter Harders41c35622020-07-12 01:16:22 +02001012 # 'Campagne in Frankreich' and '1792', which are separated by the whitespace-node ' ' (see [2]).
Peter Harders6f526a32020-06-29 21:44:41 +02001013 #
Peter Harders41c35622020-07-12 01:16:22 +02001014 # The text-node 'Campagne in Frankreich' leads to the setting of '$add_one' to 1, so that when opening the 2nd 'head'-tag,
1015 # it's from-index gets set to the correct start-index of '1792' (and not to the start-index of the whitespace-node ' ').
Peter Harders6f526a32020-06-29 21:44:41 +02001016 #
Peter Harders41c35622020-07-12 01:16:22 +02001017 # The assumption here is, that in most cases there _is_ a whitespace node between 2 text-nodes. The below code fragment
1018 # enables a way, to check, if this really _was_ the case for the last 2 'non-tag'-nodes, when closing a tag:
Peter Harders6f526a32020-06-29 21:44:41 +02001019 #
Peter Harders41c35622020-07-12 01:16:22 +02001020 # When a whitespace-node is read, its from-index is stored as a hash-key (in %ws), to state that it belongs to a ws-node.
1021 # So when closing a tag, it can be checked, if the previous 'non-tag'-node (text or whitespace), which is the one before
1022 # the last read 'non-tag'-node, was a actually _not_ a ws-node, but instead a text-node. In that case, the from-value of
1023 # the last read 'non-tag'-node has to be corrected (see [1]),
Peter Harders6f526a32020-06-29 21:44:41 +02001024 #
Peter Harders41c35622020-07-12 01:16:22 +02001025 # For whitespace-nodes $add_one is set to 0, so when opening the next tag (in the above example the 2nd 's'-tag), no
1026 # additional 1 is added (because this was already done by the whitespace-node itself when incrementing the variable $dl).
Peter Harders6f526a32020-06-29 21:44:41 +02001027 #
Peter Harders41c35622020-07-12 01:16:22 +02001028 # [1]
1029 # Now, what happens, when 2 text-nodes are _not_ seperated by a whitespace-node (e.g.: <w>Augen<c>,</c></w>)?
1030 # In this case, the falsely increased from-value has to be decreased again by 1 when closing the enclosing tag
1031 # (see above code fragment '... not exists $ws{ $fval - 1 } ...').
Peter Harders6f526a32020-06-29 21:44:41 +02001032 #
Peter Harders41c35622020-07-12 01:16:22 +02001033 # [2]
1034 # Comparing the 2 examples '<w>fu</w> <w>bar</w>' and '<w>fu</w><w> </w><w>bar</w>', is ' ' in both cases handled as a
1035 # whitespace-node (XML_READER_TYPE_SIGNIFICANT_WHITESPACE).
Peter Harders6f526a32020-06-29 21:44:41 +02001036 #
Peter Harders41c35622020-07-12 01:16:22 +02001037 # The from-index of the 2nd w-tag in the second example refers to 'bar', which may not have been the intention
1038 # (even though '<w> </w>' doesn't make a lot of sense). TODO: could this be a bug?
Peter Harders6f526a32020-06-29 21:44:41 +02001039 #
Peter Harders41c35622020-07-12 01:16:22 +02001040 # Empty tags also cling to the next text-token - e.g. in '<w>tok1</w> <w>tok2</w><a><b/></a> <w>tok3</w>' are the from-
1041 # and to-indizes for the tags 'a' and 'b' both 12, which is the start-index of the token 'tok3'.
Peter Harders6f526a32020-06-29 21:44:41 +02001042
1043 if( $e->[0] == XML_READER_TYPE_SIGNIFICANT_WHITESPACE ){
1044
Peter Harders41c35622020-07-12 01:16:22 +02001045 # ~ whitespace-node ~
1046
1047 # ~ whitespace related issue ~
Peter Harders6f526a32020-06-29 21:44:41 +02001048
1049 $add_one = 0;
1050
Peter Harders41c35622020-07-12 01:16:22 +02001051 $ws{ $dl }++; # state, that this from-index belongs to a whitespace-node
1052 # ('++' doesn't mean a thing here - maybe it could be used for a consistency check)
Peter Harders6f526a32020-06-29 21:44:41 +02001053
1054 }else{
1055
1056 # ~ text-node ~
1057
1058 $add_one = 1;
1059 }
1060
1061
1062 # ~ update $data and $dl ~
1063
1064 $data .= $e->[1];
1065
1066 $dl += length( $e->[1] ); # update length of $data
1067
1068
Peter Harders41c35622020-07-12 01:16:22 +02001069 #~~~~~
1070 # until here: text- and whitespace-nodes
1071 #~~~~~
1072
1073
1074 #elsif ( $e->[0] == XML_READER_TYPE_ATTRIBUTE ) # attribute-node
Peter Harders6f526a32020-06-29 21:44:41 +02001075 # note: attributes cannot be processed like this ( => use 'XCT_ATTRIBUTE_ARRAY' - see above )
1076
1077
1078 }else{ # not yet handled type
1079
1080 die "ERROR ($0): Not yet handled type (\$e->[0]=".$e->[0].") ... => Aborting\n";
1081 }
1082
1083 } # end: foreach iteration
1084
1085} # end: sub retr_info
1086
1087
Peter Harders41c35622020-07-12 01:16:22 +02001088sub write_structures { # called from main()
Peter Harders6f526a32020-06-29 21:44:41 +02001089
1090 # ~ write @structures ~
Peter Hardersd892a582020-02-12 15:45:22 +01001091
1092 #print STDERR "$0: write_structures(): ...\n";
1093
Peter Harders6f526a32020-06-29 21:44:41 +02001094 if ( $dir eq "" ){
1095
1096 print STDERR "WARNING ($0): write_structures(): empty textSigle => nothing to do ...\n";
Peter Hardersd892a582020-02-12 15:45:22 +01001097 return;
1098 }
1099
Peter Harders6f526a32020-06-29 21:44:41 +02001100 $output = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<?xml-model href=\"span.rng\" type=\"application/xml\""
1101 ." schematypens=\"http://relaxng.org/ns/structure/1.0\"?>\n\n<layer docid=\""
1102 .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 +01001103
1104 $c = 0;
1105
Peter Harders6f526a32020-06-29 21:44:41 +02001106 foreach $ref ( @structures ){
Peter Hardersd892a582020-02-12 15:45:22 +01001107
Peter Harders6f526a32020-06-29 21:44:41 +02001108 ( @{$ref} == 4 )?( $idx = 1 ):( $idx = @{$ref}-3 ); # if array '@{$ref}' doesn't contain attributes, then the number of elements in this array is 4
1109 # (name, from, to, rec_level), otherwise >4
Peter Hardersd892a582020-02-12 15:45:22 +01001110
Peter Harders6f526a32020-06-29 21:44:41 +02001111 # 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 )
1112
1113 if( $#structures == $c && ${$ref}[ $idx ] == ${$ref}[ $idx+1 ] + 1 ){
1114
1115 ${$ref}[$idx] = ${$ref}[ $idx+1 ];
Peter Hardersd892a582020-02-12 15:45:22 +01001116 }
Peter Hardersd892a582020-02-12 15:45:22 +01001117
Peter Harders6f526a32020-06-29 21:44:41 +02001118 # this consistency check is already done in 'retr_info()'
1119 #elsif( ${$ref}[$idx] > ${$ref}[$idx+1] ){ # consistency check: abort, if this doesn't hold
1120 # die "ERROR ($0: write_structures(): \$text_id=$text_id, \$c=$c, tag-name=${$ref}[0]):"
1121 # ." 'from-index=${$ref}[$idx]' > 'to-index=${$ref}[$idx+1]' => please check! aborting ...\n";
1122 # die "ERROR ($0: write_structures(): \$text_id=$text_id, \$c=$c, tag-name=${$ref}[0]):"
1123 # ." 'from-index=${$ref}[$idx]' > 'to-index=${$ref}[$idx+1]' => please check! aborting ...\n\n$output" }
Peter Hardersd892a582020-02-12 15:45:22 +01001124
Peter Harders6f526a32020-06-29 21:44:41 +02001125 # at least 'POS' should always be there => remove constraint '$_TOKENS_PROC'
1126 #if( $_TOKENS_PROC && ${$ref}[0] ne $_TOKENS_TAG )
Peter Hardersd892a582020-02-12 15:45:22 +01001127
Peter Harders6f526a32020-06-29 21:44:41 +02001128 if( ${$ref}[0] ne $_TOKENS_TAG ){ # $_TOKENS_TAG is already written in 'write_tokens'
Peter Hardersd892a582020-02-12 15:45:22 +01001129
Peter Harders6f526a32020-06-29 21:44:41 +02001130 # l (level): insert information about depth of element in XML-tree (top element = level 1)
1131 $output .= " <span id=\"s$c\" from=\"${$ref}[ $idx ]\" to=\"${$ref}[ $idx+1 ]\" l=\"${$ref}[ $idx+2 ]\">\n"
1132 ." <fs type=\"struct\" xmlns=\"http://www.tei-c.org/ns/1.0\">\n"
1133 ." <f name=\"name\">${$ref}[ 0 ]</f>\n";
1134
1135 if ( $idx > 2 ) # attributes
1136 {
1137 $output .= " <f name=\"attr\">\n <fs type=\"attr\">\n";
1138
1139 for ( $att_idx = 1; $att_idx < $idx; $att_idx += 2 ){
1140
1141 ${$ref}[ $att_idx+1 ] =~ s/(&|<|>)/$ent{$1}/g; # see explanation in func. 'write_tokens'
1142
1143 # attribute (at index $att_idx) with value (at index $att_idx+1)
1144 $output .= " <f name=\"${$ref}[ $att_idx ]\">${$ref}[ $att_idx+1 ]</f>\n";
1145 }
1146
1147 $output .= " </fs>\n </f>\n";
Peter Hardersd892a582020-02-12 15:45:22 +01001148 }
1149
Peter Harders6f526a32020-06-29 21:44:41 +02001150 $output .= " </fs>\n </span>\n";
Peter Hardersd892a582020-02-12 15:45:22 +01001151
Peter Harders6f526a32020-06-29 21:44:41 +02001152 } # fi: ... ne $_TOKENS_TAG
Peter Hardersd892a582020-02-12 15:45:22 +01001153
1154 $c++;
1155
Peter Harders6f526a32020-06-29 21:44:41 +02001156 } # end: foreach
Peter Hardersd892a582020-02-12 15:45:22 +01001157
1158 $output .= " </spanList>\n</layer>";
1159
Peter Harders6f526a32020-06-29 21:44:41 +02001160 $output = encode_utf8( $output );
Peter Hardersd892a582020-02-12 15:45:22 +01001161
Akron85717512020-07-08 11:19:19 +02001162 $zipper->new_stream("$_root_dir$dir/$_structure_dir/$_structure_file")
1163 ->print($output);
Peter Hardersd892a582020-02-12 15:45:22 +01001164
1165 #print STDERR "$0: write_structures(): DONE\n";
Peter Harders6f526a32020-06-29 21:44:41 +02001166
Peter Hardersd892a582020-02-12 15:45:22 +01001167} # end: sub write_structures
1168
1169
Peter Harders41c35622020-07-12 01:16:22 +02001170sub write_tokens { # called from main()
Peter Harders6f526a32020-06-29 21:44:41 +02001171
1172 # ~ write @tokens ~
1173
1174 #print STDERR "$0: write_tokens(): ...\n";
Peter Hardersd892a582020-02-12 15:45:22 +01001175
1176 if( $dir eq "" ){
Peter Harders6f526a32020-06-29 21:44:41 +02001177
1178 print STDERR "WARNING ($0): write_tokens(): empty textSigle => nothing to do ...\n";
Peter Hardersd892a582020-02-12 15:45:22 +01001179 return;
1180 }
1181
Peter Harders6f526a32020-06-29 21:44:41 +02001182 $output = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<?xml-model href=\"span.rng\" type=\"application/xml\""
1183 ." schematypens=\"http://relaxng.org/ns/structure/1.0\"?>\n\n<layer docid=\""
1184 .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 +01001185
1186 $c = 0;
1187
Peter Harders6f526a32020-06-29 21:44:41 +02001188 foreach $ref ( @tokens ){
Peter Hardersd892a582020-02-12 15:45:22 +01001189
Peter Harders6f526a32020-06-29 21:44:41 +02001190 # if array '@{$ref}' doesn't contain attributes, then the number of elements in this array is 4 (name, from, to, rec_level), otherwise >4
1191 ( @{$ref} == 4 )?( $idx = 1 ):( $idx = @{$ref}-3 );
Peter Hardersd892a582020-02-12 15:45:22 +01001192
Peter Harders6f526a32020-06-29 21:44:41 +02001193 # 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())
1194 if ( $#tokens == $c && ${$ref}[ $idx ] == ${$ref}[ $idx+1 ] + 1 ){
1195
1196 ${$ref}[ $idx ] = ${$ref}[ $idx+1 ]; # TODO: check
Peter Hardersd892a582020-02-12 15:45:22 +01001197 }
Peter Hardersd892a582020-02-12 15:45:22 +01001198
Peter Harders6f526a32020-06-29 21:44:41 +02001199 # l (level): insert information about depth of element in XML-tree (top element = level 1)
1200 $output .= " <span id=\"s$c\" from=\"${$ref}[ $idx ]\" to=\"${$ref}[ $idx+1 ]\" l=\"${$ref}[ $idx+2 ]\">\n"
1201 ." <fs type=\"lex\" xmlns=\"http://www.tei-c.org/ns/1.0\">\n"
1202 ." <f name=\"lex\">\n";
Peter Hardersd892a582020-02-12 15:45:22 +01001203
Peter Harders6f526a32020-06-29 21:44:41 +02001204 if ( $idx > 2 ){ # attributes
1205
Peter Hardersd892a582020-02-12 15:45:22 +01001206 $output .= " <fs>\n";
1207
Peter Harders6f526a32020-06-29 21:44:41 +02001208 for ( $att_idx = 1; $att_idx < $idx; $att_idx += 2 ){
Peter Hardersd892a582020-02-12 15:45:22 +01001209
Peter Harders6f526a32020-06-29 21:44:41 +02001210 ${$ref}[ $att_idx+1 ] =~ s/(&|<|>)/$ent{$1}/g; # ... <w lemma="&gt;" ana="PUNCTUATION">&gt;</w> ...
1211 # the '&gt;' is translated to '>' and hence the result would be '<f name="lemma">></f>'
Peter Hardersd892a582020-02-12 15:45:22 +01001212
Peter Harders6f526a32020-06-29 21:44:41 +02001213 if ( $_INLINE_ANNOT && ${$ref}[ $att_idx ] eq "$_INLINE_ATT_RD" ){
Peter Hardersd892a582020-02-12 15:45:22 +01001214
Peter Harders6f526a32020-06-29 21:44:41 +02001215 ${$ref}[ $att_idx+1 ] =~ /^([^ ]+)(?: (.+))?$/;
1216
1217 die "ERROR (write_tokens()): unexpected format! => Aborting ... (att: ${$ref}[ $att_idx+1 ])\n"
1218 if ( $_INLINE_POS_WR && not defined $1 ) || ( $_INLINE_MSD_WR && not defined $2 );
1219
1220 if ( "$_INLINE_POS_WR" ){
1221
1222 $output .= " <f name=\"$_INLINE_POS_WR\">";
Peter Hardersd892a582020-02-12 15:45:22 +01001223 $output .= "$1" if defined $1;
1224 $output .= "</f>\n";
1225 }
Peter Harders6f526a32020-06-29 21:44:41 +02001226
1227 if ( "$_INLINE_MSD_WR" ){
1228
1229 $output .= " <f name=\"$_INLINE_MSD_WR\">";
Peter Hardersd892a582020-02-12 15:45:22 +01001230 $output .= "$2" if defined $2;
1231 $output .= "</f>\n";
1232 }
1233
Peter Harders6f526a32020-06-29 21:44:41 +02001234 } elsif ( $_INLINE_ANNOT && "$_INLINE_LEM_RD" && ${$ref}[ $att_idx ] eq "$_INLINE_LEM_RD" ){
Peter Hardersd892a582020-02-12 15:45:22 +01001235
Peter Harders6f526a32020-06-29 21:44:41 +02001236 $output .= " <f name=\"$_INLINE_LEM_WR\">${$ref}[ $att_idx+1 ]</f>\n";
Peter Hardersd892a582020-02-12 15:45:22 +01001237
Peter Harders6f526a32020-06-29 21:44:41 +02001238 } else { # all other attributes
Peter Hardersd892a582020-02-12 15:45:22 +01001239
Peter Harders6f526a32020-06-29 21:44:41 +02001240 $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 +01001241 }
1242
Peter Harders6f526a32020-06-29 21:44:41 +02001243 } # end: for
Peter Hardersd892a582020-02-12 15:45:22 +01001244
1245 $output .= " </fs>\n";
Peter Harders6f526a32020-06-29 21:44:41 +02001246
1247 } # fi: attributes
Peter Hardersd892a582020-02-12 15:45:22 +01001248
1249 $output .= " </f>\n </fs>\n </span>\n";
1250
1251 $c++;
1252
Peter Harders6f526a32020-06-29 21:44:41 +02001253 } # end: foreach
Peter Hardersd892a582020-02-12 15:45:22 +01001254
1255 $output .= " </spanList>\n</layer>";
1256
Peter Harders6f526a32020-06-29 21:44:41 +02001257 $output = encode_utf8( $output );
Peter Hardersd892a582020-02-12 15:45:22 +01001258
Akron85717512020-07-08 11:19:19 +02001259 $zipper->new_stream("$_root_dir$dir/$_tokens_dir/$_tokens_file")
1260 ->print($output);
Peter Hardersd892a582020-02-12 15:45:22 +01001261
Peter Harders6f526a32020-06-29 21:44:41 +02001262 #print STDERR "$0: write_tokens(): DONE\n";
Peter Hardersd892a582020-02-12 15:45:22 +01001263
Peter Harders6f526a32020-06-29 21:44:41 +02001264} # end: sub write_tokens
Peter Hardersd892a582020-02-12 15:45:22 +01001265
Peter Hardersd892a582020-02-12 15:45:22 +01001266
Akrond949e182020-02-14 12:23:57 +01001267__END__
1268
1269=pod
1270
1271=encoding utf8
1272
1273=head1 NAME
1274
1275tei2korapxml - Conversion of TEI P5 based formats to KorAP-XML
1276
1277=head1 SYNOPSIS
1278
1279 cat corpus.i5.xml | tei2korapxml > corpus.korapxml.zip
1280
1281=head1 DESCRIPTION
1282
Akronee434b12020-07-08 12:53:01 +02001283C<tei2korapxml> is a script to convert TEI P5 and
1284L<I5|https://www1.ids-mannheim.de/kl/projekte/korpora/textmodell.html>
1285based documents to the
1286L<KorAP-XML format|https://github.com/KorAP/KorAP-XML-Krill#about-korap-xml>.
1287If no specific input is defined, data is
Akrond949e182020-02-14 12:23:57 +01001288read from C<STDIN>. If no specific output is defined, data is written
1289to C<STDOUT>.
Peter Harders6f526a32020-06-29 21:44:41 +02001290
Akrond949e182020-02-14 12:23:57 +01001291This program is usually called from inside another script.
1292
Akronee434b12020-07-08 12:53:01 +02001293=head1 FORMATS
1294
1295=head2 Input restrictions
1296
1297=over 2
1298
1299=item
1300
1301utf8 encoded
1302
1303=item
1304
1305TEI P5 formatted input with certain restrictions:
1306
1307=over 4
1308
1309=item
1310
1311B<mandatory>: text-header with integrated textsigle, text-body
1312
1313=item
1314
1315B<optional>: corp-header with integrated corpsigle,
1316doc-header with integrated docsigle
1317
1318=back
1319
1320=item
1321
1322all tokens inside the primary text (inside $data) may not be
1323newline seperated, because newlines are removed
1324(see code section C<~ inside text body ~>) and a conversion of newlines
1325into blanks between 2 tokens could lead to additional blanks,
1326where there should be none (e.g.: punctuation characters like C<,> or
1327C<.> should not be seperated from their predecessor token).
1328(see also code section C<~ whitespace handling ~>).
1329
1330=back
1331
1332=head2 Notes on the output
1333
1334=over 2
1335
1336=item
1337
1338zip file output (default on C<stdout>) with utf8 encoded entries
1339(which together form the KorAP-XML format)
1340
1341=back
1342
Akrond949e182020-02-14 12:23:57 +01001343=head1 INSTALLATION
1344
1345C<tei2korapxml> requires L<libxml2-dev> bindings to build. When
1346these bindings are available, the preferred way to install the script is
1347to use L<cpanm|App::cpanminus>.
1348
1349 $ cpanm https://github.com/KorAP/KorAP-XML-TEI.git
1350
1351In case everything went well, the C<tei2korapxml> tool will
1352be available on your command line immediately.
Peter Harders6f526a32020-06-29 21:44:41 +02001353
Akrond949e182020-02-14 12:23:57 +01001354Minimum requirement for L<KorAP::XML::TEI> is Perl 5.16.
1355
1356=head1 OPTIONS
1357
1358=over 2
1359
1360=item B<--base|-b>
1361
1362The base directory for output. Defaults to C<.>.
1363
1364=item B<--help|-h>
1365
1366Print help information.
1367
1368=item B<--version|-v>
1369
1370Print version information.
1371
1372=back
1373
1374=head1 COPYRIGHT AND LICENSE
1375
1376Copyright (C) 2020, L<IDS Mannheim|https://www.ids-mannheim.de/>
1377
1378Author: Peter Harders
1379
1380Contributors: Marc Kupietz, Carsten Schnober, Nils Diewald
1381
1382L<KorAP::XML::TEI> is developed as part of the L<KorAP|https://korap.ids-mannheim.de/>
1383Corpus Analysis Platform at the
1384L<Leibniz Institute for the German Language (IDS)|http://ids-mannheim.de/>,
1385member of the
1386L<Leibniz-Gemeinschaft|http://www.leibniz-gemeinschaft.de/>.
1387
1388This program is free software published under the
1389L<BSD-2 License|https://raw.githubusercontent.com/KorAP/KorAP-XML-TEI/master/LICENSE>.
1390
1391=cut