| Akron | 9cb1394 | 2020-02-14 07:39:54 +0100 | [diff] [blame] | 1 | #!/usr/bin/env perl | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 2 | use strict; | 
 | 3 | use warnings; | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 4 |  | 
| Akron | 3378dfd | 2020-08-01 15:01:36 +0200 | [diff] [blame] | 5 | use Log::Any '$log'; | 
 | 6 | use Log::Any::Adapter; | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 7 | use Pod::Usage; | 
 | 8 | use Getopt::Long qw(GetOptions :config no_auto_abbrev); | 
 | 9 |  | 
 | 10 | use File::Basename qw(dirname); | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 11 |  | 
| Akron | eaa9623 | 2020-10-15 17:06:15 +0200 | [diff] [blame] | 12 | use Encode qw(decode); | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 13 |  | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 14 | use XML::CompactTree::XS; | 
 | 15 | use XML::LibXML::Reader; | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 16 |  | 
| Akron | 4f67cd4 | 2020-07-02 12:27:58 +0200 | [diff] [blame] | 17 | use FindBin; | 
 | 18 | BEGIN { | 
 | 19 |   unshift @INC, "$FindBin::Bin/../lib"; | 
 | 20 | }; | 
 | 21 |  | 
| Marc Kupietz | 8a954e5 | 2021-02-16 22:03:07 +0100 | [diff] [blame] | 22 | use KorAP::XML::TEI qw!remove_xml_comments replace_entities!; | 
| Akron | 8b511f9 | 2020-07-09 17:28:08 +0200 | [diff] [blame] | 23 | use KorAP::XML::TEI::Tokenizer::External; | 
| Akron | d962747 | 2020-07-09 16:53:09 +0200 | [diff] [blame] | 24 | use KorAP::XML::TEI::Tokenizer::Conservative; | 
 | 25 | use KorAP::XML::TEI::Tokenizer::Aggressive; | 
| Akron | 7501ca0 | 2020-08-01 21:05:25 +0200 | [diff] [blame] | 26 | use KorAP::XML::TEI::Annotations::Collector; | 
| Akron | a10ad59 | 2020-08-03 11:20:23 +0200 | [diff] [blame] | 27 | use KorAP::XML::TEI::Data; | 
| Akron | 8571751 | 2020-07-08 11:19:19 +0200 | [diff] [blame] | 28 | use KorAP::XML::TEI::Zipper; | 
| Akron | f57ed81 | 2020-07-27 10:37:52 +0200 | [diff] [blame] | 29 | use KorAP::XML::TEI::Header; | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 30 |  | 
| Marc Kupietz | 1e882fb | 2020-09-09 00:05:46 +0200 | [diff] [blame] | 31 | eval { | 
 | 32 |   require KorAP::XML::TEI::Tokenizer::KorAP; | 
 | 33 |   1; | 
 | 34 | }; | 
| Peter Harders | 1c5ce15 | 2020-07-22 18:02:50 +0200 | [diff] [blame] | 35 |  | 
| Marc Kupietz | a1421f0 | 2021-02-18 15:32:38 +0100 | [diff] [blame^] | 36 | our $VERSION = '1.00'; | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 37 |  | 
| Akron | d949e18 | 2020-02-14 12:23:57 +0100 | [diff] [blame] | 38 | our $VERSION_MSG = "\ntei2korapxml - v$VERSION\n"; | 
 | 39 |  | 
| Akron | b364947 | 2020-09-29 08:24:46 +0200 | [diff] [blame] | 40 | # Set to 1 for minimal more debug output (no need to be parametrized) | 
 | 41 | use constant DEBUG => $ENV{KORAPXMLTEI_DEBUG} // 0; | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 42 |  | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 43 | # Parse options from the command line | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 44 | GetOptions( | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 45 |   "root|r=s"  => \(my $_root_dir = '.'),  # name of root directory inside zip file | 
 | 46 |   "input|i=s" => \(my $input_fname = ''), # input file (yet only TEI I5 Format accepted) | 
| Akron | 8b511f9 | 2020-07-09 17:28:08 +0200 | [diff] [blame] | 47 |   'tokenizer-call|tc=s' => \(my $tokenizer_call), # Temporary argument for testing purposes | 
| Marc Kupietz | 1e882fb | 2020-09-09 00:05:46 +0200 | [diff] [blame] | 48 |   'tokenizer-korap|tk' => \(my $tokenizer_korap), # use KorAP-tokenizer | 
| Akron | 6d7b8e4 | 2020-09-29 07:37:41 +0200 | [diff] [blame] | 49 |   'tokenizer-internal|ti' => \(my $tokenizer_intern), # use intern tokenization (default = no) | 
| Marc Kupietz | 985da0c | 2021-02-15 19:29:50 +0100 | [diff] [blame] | 50 |   'use-tokenizer-sentence-splits|s' => (\my $use_tokenizer_sentence_splits), # use KorAP tokenizer to split s (default=no) | 
| Akron | 1a5271a | 2021-02-18 13:18:15 +0100 | [diff] [blame] | 51 |   'inline-tokens=s' => \(my $inline_tokens = 'tokens#morpho'), | 
| Akron | 3378dfd | 2020-08-01 15:01:36 +0200 | [diff] [blame] | 52 |   'log|l=s' => \(my $log_level = 'notice'), | 
| Akron | 8b511f9 | 2020-07-09 17:28:08 +0200 | [diff] [blame] | 53 |   'help|h'    => sub { | 
| Akron | d949e18 | 2020-02-14 12:23:57 +0100 | [diff] [blame] | 54 |     pod2usage( | 
 | 55 |       -verbose => 99, | 
 | 56 |       -sections => 'NAME|DESCRIPTION|SYNOPSIS|ARGUMENTS|OPTIONS', | 
 | 57 |       -msg => $VERSION_MSG, | 
 | 58 |       -output => '-' | 
 | 59 |     ) | 
 | 60 |   }, | 
 | 61 |   'version|v' => sub { | 
 | 62 |     pod2usage( | 
 | 63 |       -verbose => 0, | 
 | 64 |       -msg => $VERSION_MSG, | 
 | 65 |       -output => '-' | 
 | 66 |     ) | 
 | 67 |   } | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 68 | ); | 
 | 69 |  | 
| Marc Kupietz | 44b1f25 | 2020-11-26 16:31:40 +0100 | [diff] [blame] | 70 | binmode(STDERR, ":encoding(UTF-8)"); | 
| Akron | 3378dfd | 2020-08-01 15:01:36 +0200 | [diff] [blame] | 71 | Log::Any::Adapter->set('Stderr', log_level => $log_level); | 
 | 72 |  | 
| Akron | b364947 | 2020-09-29 08:24:46 +0200 | [diff] [blame] | 73 | $log->notice('Debugging is activated') if DEBUG; | 
 | 74 |  | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 75 | # | 
 | 76 | # ~~~ parameter (mandatory) ~~~ | 
 | 77 | # | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 78 | my $_TEXT_BODY        = "text";                        # tag (without attributes), which contains the primary text | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 79 | # optional | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 80 | my $_CORP_HEADER_BEG  = "idsHeader type=\"corpus\"";   # just keep the correct order of the attributes and evtl. add an '.*' between them | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 81 | # optional | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 82 | my $_DOC_HEADER_BEG   = "idsHeader type=\"document\""; # analog | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 83 | # mandatory | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 84 | my $_TEXT_HEADER_BEG  = "idsHeader type=\"text\"";     # analog | 
| Akron | 09e0b2c | 2020-07-28 15:57:01 +0200 | [diff] [blame] | 85 |  | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 86 |  | 
| Peter Harders | 41c3562 | 2020-07-12 01:16:22 +0200 | [diff] [blame] | 87 | ## extern tokenization | 
| Marc Kupietz | 1e882fb | 2020-09-09 00:05:46 +0200 | [diff] [blame] | 88 | my $_GEN_TOK_EXT = $tokenizer_call || $tokenizer_korap ? 1 : 0; | 
 | 89 |  | 
| Marc Kupietz | 985da0c | 2021-02-15 19:29:50 +0100 | [diff] [blame] | 90 | if ($use_tokenizer_sentence_splits && !$tokenizer_korap) { | 
 | 91 |   die $log->fatal("Sentence splitting is currently only supported by KorAP tokenizer (use -tk to activate it"); | 
 | 92 | } | 
 | 93 |  | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 94 | my $ext_tok; | 
 | 95 | if ($tokenizer_call) { | 
 | 96 |   $ext_tok = KorAP::XML::TEI::Tokenizer::External->new($tokenizer_call); | 
 | 97 | } | 
| Marc Kupietz | 1e882fb | 2020-09-09 00:05:46 +0200 | [diff] [blame] | 98 |  | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 99 | elsif ($tokenizer_korap) { | 
| Marc Kupietz | 985da0c | 2021-02-15 19:29:50 +0100 | [diff] [blame] | 100 |   $ext_tok = KorAP::XML::TEI::Tokenizer::KorAP->new($use_tokenizer_sentence_splits); | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 101 | }; | 
 | 102 | my $_tok_file_ext  = "tokens.xml"; | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 103 | ## | 
 | 104 |  | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 105 |  | 
| Akron | 4e3c7e3 | 2021-02-18 15:19:53 +0100 | [diff] [blame] | 106 | # | 
 | 107 | # ~~~ constants ~~~ | 
 | 108 | # | 
 | 109 |  | 
 | 110 |  | 
| Akron | 8b511f9 | 2020-07-09 17:28:08 +0200 | [diff] [blame] | 111 | ## intern tokenization | 
| Peter Harders | f9c5124 | 2020-07-21 02:37:44 +0200 | [diff] [blame] | 112 | my $_GEN_TOK_INT = $tokenizer_intern;                  # simple tokenization (recommended for testing) | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 113 | my $_tok_file_con  = "tokens_conservative.xml"; | 
 | 114 | my $_tok_file_agg  = "tokens_aggressive.xml"; | 
 | 115 | my $aggr_tok       = KorAP::XML::TEI::Tokenizer::Aggressive->new; | 
 | 116 | my $cons_tok       = KorAP::XML::TEI::Tokenizer::Conservative->new; | 
| Peter Harders | 41c3562 | 2020-07-12 01:16:22 +0200 | [diff] [blame] | 117 | ## | 
 | 118 |  | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 119 |  | 
| Peter Harders | 41c3562 | 2020-07-12 01:16:22 +0200 | [diff] [blame] | 120 | my $_tok_dir         = "base";                       # name of directory for storing tokenization files | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 121 |  | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 122 | my $_header_file     = "header.xml";                 # name of files      containing the  text, document and corpus header | 
 | 123 | my $_data_file       = "data.xml";                   # name of file       containing the  primary text data (tokens) | 
 | 124 | my $_structure_dir   = "struct";                     # name of directory  containing the  $_structure_file | 
 | 125 | my $_structure_file  = "structure.xml";              # name of file       containing all  tags (except ${_TOKEN_TAG}'s) related information | 
 | 126 |                                                      #                                     (= their names and byte offsets in $_data) | 
 | 127 | ## TODO: optional (different annotation tools can produce more zip-files for feeding into KorAP-XML-Krill) | 
 | 128 | my $_TOKENS_PROC     = 1;                            # on/off: processing of ${_TOKEN_TAG}'s (default: 1) | 
| Akron | 1a5271a | 2021-02-18 13:18:15 +0100 | [diff] [blame] | 129 |  | 
 | 130 |  | 
 | 131 | # Name of the directory and the file containing all inline token informations | 
 | 132 | # i.e. tokens of the $_TOKENS_TAG, if $_TOKENS_PROC is set | 
 | 133 | my ($_tokens_dir, $_tokens_file) = split '#', $inline_tokens . '#morpho'; | 
 | 134 | $_tokens_file .= '.xml'; | 
 | 135 |  | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 136 | my $_TOKENS_TAG      = "w";                          # name of tag        containing all  information stored in $_tokens_file | 
 | 137 |  | 
| Akron | 4e3c7e3 | 2021-02-18 15:19:53 +0100 | [diff] [blame] | 138 | # Handling inline annotations (inside $_TOKENS_TAG) | 
 | 139 | my $_INLINE_ANNOT    = $ENV{KORAPXMLTEI_INLINE} ? 1 : 0; | 
| Akron | 09e0b2c | 2020-07-28 15:57:01 +0200 | [diff] [blame] | 140 |  | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 141 |  | 
 | 142 | # | 
 | 143 | # ~~~ variables ~~~ | 
 | 144 | # | 
 | 145 |  | 
| Akron | 7501ca0 | 2020-08-01 21:05:25 +0200 | [diff] [blame] | 146 | # Initialize Token- and Structure-Collector | 
 | 147 | my $tokens = KorAP::XML::TEI::Annotations::Collector->new; | 
 | 148 | my $structures = KorAP::XML::TEI::Annotations::Collector->new; | 
| Akron | 09e0b2c | 2020-07-28 15:57:01 +0200 | [diff] [blame] | 149 |  | 
 | 150 |  | 
| Akron | a10ad59 | 2020-08-03 11:20:23 +0200 | [diff] [blame] | 151 | # Initialize Data-Collector | 
 | 152 | my $data = KorAP::XML::TEI::Data->new; | 
 | 153 |  | 
 | 154 |  | 
| Akron | 8571751 | 2020-07-08 11:19:19 +0200 | [diff] [blame] | 155 | # Initialize zipper | 
| Akron | 3bdc0a3 | 2020-08-03 12:12:56 +0200 | [diff] [blame] | 156 | my $zipper = KorAP::XML::TEI::Zipper->new($_root_dir); | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 157 | my $input_fh;                                        # input file handle (default: stdin) | 
 | 158 |  | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 159 | my $dir;                                             # text     directory (below $_root_dir) | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 160 |  | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 161 | my ( $text_id, | 
 | 162 |      $text_id_esc );                                 # '$text_id_esc' = escaped version of $text_id | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 163 |  | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 164 | my ( $reader,                                        # instance of 'XML::LibXML::Reader->new' (on input '$buf_in') | 
 | 165 |      $tree_data );                                   # instance of 'XML::CompactTree::XS::readSubtreeToPerl' (on input '$reader') | 
 | 166 |  | 
 | 167 | # these are only used inside recursive function 'retr_info' | 
| Akron | 4e3c7e3 | 2021-02-18 15:19:53 +0100 | [diff] [blame] | 168 | my ( $_IDX,                                          # value is set dependent on DEBUG - for extracting array of child elements from element in $tree_data | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 169 |      $e,                                             # element from $tree_data | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 170 |      ## variables for handling ~ whitespace related issue ~ (it is sometimes necessary, to correct the from-values for some tags) | 
 | 171 |      $add_one,                                       # ... | 
| Akron | 7501ca0 | 2020-08-01 21:05:25 +0200 | [diff] [blame] | 172 |      $fval,                                          # ... | 
| Peter Harders | 41c3562 | 2020-07-12 01:16:22 +0200 | [diff] [blame] | 173 |      %ws);                                           # hash for indices of whitespace-nodes (needed to recorrect from-values) | 
 | 174 |                                                      # idea: when closing element, check if it's from-index minus 1 refers to a whitespace-node | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 175 |                                                      #  (means: 'from-index - 1' is a key in %ws). | 
 | 176 |                                                      # if this is _not_ the case, then the from-value is one to high => correct it by substracting 1 | 
 | 177 |  | 
| Akron | 7501ca0 | 2020-08-01 21:05:25 +0200 | [diff] [blame] | 178 | my $c;                                               # index variables used in loops | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 179 |  | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 180 |  | 
 | 181 | # | 
 | 182 | # ~~~ main ~~~ | 
 | 183 | # | 
 | 184 |  | 
 | 185 | # ~ initializations ~ | 
 | 186 |  | 
| Akron | 4e3c7e3 | 2021-02-18 15:19:53 +0100 | [diff] [blame] | 187 | # Include line numbers in elements of $tree_data for debugging | 
 | 188 | DEBUG ? ($_IDX = 5) : ($_IDX = 4); | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 189 |  | 
| Akron | 7501ca0 | 2020-08-01 21:05:25 +0200 | [diff] [blame] | 190 | $fval = 0; | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 191 |  | 
| Akron | ec2cef2 | 2020-07-31 10:00:15 +0200 | [diff] [blame] | 192 | # Normalize regex for header parsing | 
 | 193 | for ($_CORP_HEADER_BEG, | 
 | 194 |      $_DOC_HEADER_BEG, | 
 | 195 |      $_TEXT_HEADER_BEG) { | 
 | 196 |   s!^([^\s]+)(.*)$!$1\[\^>\]*$2!; | 
 | 197 | }; | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 198 |  | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 199 |  | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 200 | # ~ read input and write output (text by text) ~ | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 201 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 202 | my ( $pfx, $sfx ); | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 203 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 204 | my $tl = 0; # text line (needed for whitespace handling) | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 205 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 206 | $input_fh = *STDIN;  # input file handle (default: stdin) | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 207 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 208 | # Maybe not necessary | 
 | 209 | $data->reset; | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 210 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 211 | $dir = ""; | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 212 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 213 | if ( $input_fname ne '' ){ | 
 | 214 |   unless (open($input_fh, '<', $input_fname)) { | 
 | 215 |     die $log->fatal("File '$input_fname' could not be opened."); | 
 | 216 |   }; | 
 | 217 | } | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 218 |  | 
| Akron | f8088e6 | 2021-02-18 16:18:59 +0100 | [diff] [blame] | 219 | # Prevents segfaulting (see notes on segfault prevention) | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 220 | binmode $input_fh; | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 221 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 222 | my $pos; | 
| Akron | eaa9623 | 2020-10-15 17:06:15 +0200 | [diff] [blame] | 223 | my $input_enc = 'UTF-8'; | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 224 | my $l = length('</' . $_TEXT_BODY) + 1; | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 225 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 226 | # ~ loop (reading input document) ~ | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 227 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 228 | MAIN: while ( <$input_fh> ){ | 
 | 229 |  | 
 | 230 |   $_ = remove_xml_comments( $input_fh, $_ ); # remove HTML (multi-line) comments (<!--...-->) | 
 | 231 |  | 
| Akron | eaa9623 | 2020-10-15 17:06:15 +0200 | [diff] [blame] | 232 |   # Set input encoding | 
 | 233 |   if ( index($_, '<?xml') == 0 && $_ =~ /\sencoding=(['"])([^\1]+?)\1/) { | 
 | 234 |     $input_enc = $2; | 
 | 235 |     next; | 
 | 236 |   }; | 
 | 237 |  | 
 | 238 |   $_ = decode($input_enc, $_); | 
| Marc Kupietz | 8a954e5 | 2021-02-16 22:03:07 +0100 | [diff] [blame] | 239 |   $_ = replace_entities($_); | 
| Akron | eaa9623 | 2020-10-15 17:06:15 +0200 | [diff] [blame] | 240 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 241 |   if ( index($_, $_TEXT_BODY) >= 0 && m#^(.*)<${_TEXT_BODY}(?: [^>]*)?>(.*)$# ){ | 
 | 242 |  | 
 | 243 |     # ~ start of text body ~ | 
 | 244 |  | 
 | 245 |     $pfx = $1; | 
 | 246 |     $sfx = $2; | 
 | 247 |  | 
 | 248 |     if ($pfx !~ /^\s*$/ || $sfx !~ /^\s*$/) { | 
 | 249 |       die $log->fatal("input line number $.: " . | 
 | 250 |                         "line with opening text-body tag '${_TEXT_BODY}' " . | 
 | 251 |                         "contains additional information ... => Aborting (line=$_)"); | 
| Akron | 0bb7e72 | 2020-09-29 07:48:33 +0200 | [diff] [blame] | 252 |     }; | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 253 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 254 |     # text body data extracted from input document ($input_fh), further processed by XML::LibXML::Reader | 
 | 255 |     my $buf_in = ''; | 
| Peter Harders | 9015734 | 2020-07-01 21:05:14 +0200 | [diff] [blame] | 256 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 257 |     # Iterate over all lines in the text body | 
 | 258 |     while (<$input_fh>) { | 
| Peter Harders | 9015734 | 2020-07-01 21:05:14 +0200 | [diff] [blame] | 259 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 260 |       $_ = remove_xml_comments( $input_fh, $_ ); | 
| Akron | eaa9623 | 2020-10-15 17:06:15 +0200 | [diff] [blame] | 261 |       $_ = decode($input_enc, $_); | 
| Marc Kupietz | 8a954e5 | 2021-02-16 22:03:07 +0100 | [diff] [blame] | 262 |       $_ = replace_entities($_); | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 263 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 264 |       # ~ end of text body ~ | 
 | 265 |       if (($pos = index($_, '</' . $_TEXT_BODY)) >= 0) { | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 266 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 267 |         # 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 Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 268 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 269 |         if ((substr($_, 0, $pos) . substr($_, $l + $pos)) !~ /^\s*$/) { | 
 | 270 |           die $log->fatal("input line number $.: " . | 
 | 271 |                             "line with closing text-body tag '${_TEXT_BODY}'". | 
 | 272 |                             " contains additional information ... => Aborting (line=$_)"); | 
 | 273 |         }; | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 274 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 275 |         if ($dir ne "") { | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 276 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 277 |           $reader = XML::LibXML::Reader->new( string => "<text>$buf_in</text>", huge => 1 ); | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 278 |  | 
| Akron | f8088e6 | 2021-02-18 16:18:59 +0100 | [diff] [blame] | 279 |           # See notes on whitespace handling | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 280 |           my $param = XCT_DOCUMENT_ROOT | XCT_IGNORE_COMMENTS | XCT_ATTRIBUTE_ARRAY; | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 281 |  | 
| Akron | 4e3c7e3 | 2021-02-18 15:19:53 +0100 | [diff] [blame] | 282 |           # XCT_LINE_NUMBERS is only needed for debugging | 
 | 283 |           # (see XML::CompactTree::XS) | 
 | 284 |           $param |= XCT_LINE_NUMBERS if DEBUG; | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 285 |           $tree_data = XML::CompactTree::XS::readSubtreeToPerl( $reader, $param); | 
| Akron | 598d1a7 | 2020-08-02 17:33:31 +0200 | [diff] [blame] | 286 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 287 |           $structures->reset; | 
| Akron | 598d1a7 | 2020-08-02 17:33:31 +0200 | [diff] [blame] | 288 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 289 |           $tokens->reset if $_TOKENS_PROC; | 
| Akron | 598d1a7 | 2020-08-02 17:33:31 +0200 | [diff] [blame] | 290 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 291 |           # ~ whitespace related issue ~ | 
 | 292 |           $add_one = 0; | 
 | 293 |           %ws = (); | 
| Akron | 598d1a7 | 2020-08-02 17:33:31 +0200 | [diff] [blame] | 294 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 295 |           # ~ recursion ~ | 
 | 296 |           retr_info(1, \$tree_data->[2] ); # parse input data | 
| Akron | 598d1a7 | 2020-08-02 17:33:31 +0200 | [diff] [blame] | 297 |  | 
| Akron | b364947 | 2020-09-29 08:24:46 +0200 | [diff] [blame] | 298 |           if (DEBUG) { | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 299 |             $log->debug("Writing (utf8-formatted) xml file $dir/$_data_file"); | 
| Akron | 0bb7e72 | 2020-09-29 07:48:33 +0200 | [diff] [blame] | 300 |           }; | 
| Akron | 598d1a7 | 2020-08-02 17:33:31 +0200 | [diff] [blame] | 301 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 302 |           # ~ write data.xml ~ | 
 | 303 |           $data->to_zip( | 
 | 304 |             $zipper->new_stream("$dir/${_data_file}"), | 
 | 305 |             $text_id_esc | 
 | 306 |           ); | 
| Akron | 598d1a7 | 2020-08-02 17:33:31 +0200 | [diff] [blame] | 307 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 308 |           # ~ tokenization ~ | 
 | 309 |           if ($_GEN_TOK_EXT) { | 
| Akron | 598d1a7 | 2020-08-02 17:33:31 +0200 | [diff] [blame] | 310 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 311 |             # Tokenize and output | 
 | 312 |             $ext_tok->tokenize($data->data)->to_zip( | 
 | 313 |               $zipper->new_stream("$dir/$_tok_dir/$_tok_file_ext"), | 
 | 314 |               $text_id_esc | 
 | 315 |             ); | 
 | 316 |           }; | 
| Akron | a10ad59 | 2020-08-03 11:20:23 +0200 | [diff] [blame] | 317 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 318 |           if ($_GEN_TOK_INT) { | 
| Akron | a10ad59 | 2020-08-03 11:20:23 +0200 | [diff] [blame] | 319 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 320 |             # Tokenize and output | 
 | 321 |             $cons_tok->tokenize($data->data)->to_zip( | 
 | 322 |               $zipper->new_stream("$dir/$_tok_dir/$_tok_file_con"), | 
| Akron | a10ad59 | 2020-08-03 11:20:23 +0200 | [diff] [blame] | 323 |               $text_id_esc | 
 | 324 |             ); | 
| Marc Kupietz | 74ed7f3 | 2020-09-09 18:22:07 +0200 | [diff] [blame] | 325 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 326 |             $aggr_tok->tokenize($data->data)->to_zip( | 
 | 327 |               $zipper->new_stream("$dir/$_tok_dir/$_tok_file_agg"), | 
 | 328 |               $text_id_esc | 
 | 329 |             ); | 
| Akron | 598d1a7 | 2020-08-02 17:33:31 +0200 | [diff] [blame] | 330 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 331 |             $aggr_tok->reset; | 
 | 332 |             $cons_tok->reset; | 
 | 333 |           }; | 
| Akron | 598d1a7 | 2020-08-02 17:33:31 +0200 | [diff] [blame] | 334 |  | 
| Marc Kupietz | 985da0c | 2021-02-15 19:29:50 +0100 | [diff] [blame] | 335 |           if ($use_tokenizer_sentence_splits) { | 
 | 336 |             $ext_tok->sentencize_from_previous_input($structures); | 
 | 337 |           } | 
 | 338 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 339 |           # ~ write structures ~ | 
 | 340 |           if (!$structures->empty) { | 
 | 341 |             $structures->to_zip( | 
 | 342 |               $zipper->new_stream("$dir/$_structure_dir/$_structure_file"), | 
 | 343 |               $text_id_esc, | 
 | 344 |               2 # = structure serialization | 
 | 345 |             ); | 
 | 346 |           }; | 
| Akron | 598d1a7 | 2020-08-02 17:33:31 +0200 | [diff] [blame] | 347 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 348 |           # ~ write tokens ~ | 
 | 349 |           if ($_TOKENS_PROC && !$tokens->empty) { | 
 | 350 |             $tokens->to_zip( | 
 | 351 |               $zipper->new_stream("$dir/$_tokens_dir/${_tokens_file}"), | 
 | 352 |               $text_id_esc, | 
 | 353 |               $_INLINE_ANNOT # Either 0 = tokens without inline or 1 = tokens with inline | 
 | 354 |             ); | 
 | 355 |           }; | 
| Akron | 598d1a7 | 2020-08-02 17:33:31 +0200 | [diff] [blame] | 356 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 357 |           $dir = ""; # reinit. | 
| Akron | 598d1a7 | 2020-08-02 17:33:31 +0200 | [diff] [blame] | 358 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 359 |           # Maybe not necessary | 
 | 360 |           $data->reset; | 
| Akron | 598d1a7 | 2020-08-02 17:33:31 +0200 | [diff] [blame] | 361 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 362 |         } else { # $dir eq "" | 
| Akron | 598d1a7 | 2020-08-02 17:33:31 +0200 | [diff] [blame] | 363 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 364 |           $log->warn("Maybe empty textSigle => skipping this text ...\ndata=$data"); | 
| Akron | 598d1a7 | 2020-08-02 17:33:31 +0200 | [diff] [blame] | 365 |         } | 
| Akron | 598d1a7 | 2020-08-02 17:33:31 +0200 | [diff] [blame] | 366 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 367 |         next MAIN; | 
| Akron | 598d1a7 | 2020-08-02 17:33:31 +0200 | [diff] [blame] | 368 |       }; | 
 | 369 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 370 |       # ~ inside text body ~ | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 371 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 372 |       # ~ whitespace handling ~ | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 373 |  | 
| Akron | f8088e6 | 2021-02-18 16:18:59 +0100 | [diff] [blame] | 374 |       # Fix whitespaces (see notes on whitespace fixing) | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 375 |  | 
| Akron | f8088e6 | 2021-02-18 16:18:59 +0100 | [diff] [blame] | 376 |       # 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 | 
 | 377 |       #   an option on how newlines in primary text should be handled (stripped or replaced by a whitespace)). | 
 | 378 |  | 
 | 379 |       # Remove consecutive whitespace at beginning and end (mostly one newline) | 
 | 380 |       s/^\s+//; s/\s+$//; | 
| Akron | f57ed81 | 2020-07-27 10:37:52 +0200 | [diff] [blame] | 381 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 382 |       ### NOTE: this is only relevant, if a text consists of more than one line | 
 | 383 |       ### TODO: find a better solution, or create a warning, if a text has more than one line ($tl > 1) | 
 | 384 |       ###  do testing with 2 different corpora (one with only one-line texts, the other with several lines per text) | 
 | 385 |       if (m/<[^>]+>[^<]/) { # line contains at least one tag with at least one character contents | 
| Akron | f57ed81 | 2020-07-27 10:37:52 +0200 | [diff] [blame] | 386 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 387 |         $tl++; # counter for text lines | 
| Akron | f57ed81 | 2020-07-27 10:37:52 +0200 | [diff] [blame] | 388 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 389 |         s/^(.)/ $1/ if $tl > 1; # insert blank before 1st character (for 2nd line and consecutive lines) | 
 | 390 |       } | 
 | 391 |       ### | 
| Akron | f57ed81 | 2020-07-27 10:37:52 +0200 | [diff] [blame] | 392 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 393 |       # add line to buffer | 
 | 394 |       $buf_in .= $_; | 
 | 395 |     }; | 
| Akron | f57ed81 | 2020-07-27 10:37:52 +0200 | [diff] [blame] | 396 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 397 |   } elsif (m#^(.*)(<(?:${_TEXT_HEADER_BEG}|${_DOC_HEADER_BEG}|${_CORP_HEADER_BEG}).*)$#) { | 
| Akron | f57ed81 | 2020-07-27 10:37:52 +0200 | [diff] [blame] | 398 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 399 |     # ~ start of header ~ | 
 | 400 |     $pfx = $1; | 
 | 401 |     my $content = "$2\n"; | 
| Akron | f57ed81 | 2020-07-27 10:37:52 +0200 | [diff] [blame] | 402 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 403 |     if ($pfx !~ /^\s*$/) { | 
 | 404 |       die $log->fatal("input line number $.: " . | 
 | 405 |                         "line with opening header tag" . | 
 | 406 |                         " is not in expected format ... => Aborting (line=$_)"); | 
 | 407 |     }; | 
 | 408 |  | 
 | 409 |     # Parse header | 
| Akron | eaa9623 | 2020-10-15 17:06:15 +0200 | [diff] [blame] | 410 |     my $header = KorAP::XML::TEI::Header->new($content, $input_enc)->parse($input_fh); | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 411 |  | 
 | 412 |     # Header was parseable | 
 | 413 |     if ($header) { | 
 | 414 |  | 
 | 415 |       # Write header to zip | 
 | 416 |       my $file = $header->dir . '/' . $_header_file; | 
 | 417 |  | 
| Akron | b364947 | 2020-09-29 08:24:46 +0200 | [diff] [blame] | 418 |       $log->debug("Writing file $file") if DEBUG; | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 419 |  | 
 | 420 |       $header->to_zip($zipper->new_stream($file)); | 
 | 421 |  | 
 | 422 |       # Header is for text level | 
 | 423 |       if ($header->type eq 'text') { | 
 | 424 |  | 
 | 425 |         # Remember dir and sigles | 
 | 426 |         $dir         = $header->dir; | 
 | 427 |         $text_id     = $header->id; | 
 | 428 |         $text_id_esc = $header->id_esc; | 
 | 429 |  | 
 | 430 |         # log output for seeing progression | 
| Marc Kupietz | 44b1f25 | 2020-11-26 16:31:40 +0100 | [diff] [blame] | 431 |         $log->notice("$0: main(): text_id=$text_id"); | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 432 |  | 
 | 433 |         $tl = 0; # reset (needed for ~ whitespace handling ~) | 
| Akron | f57ed81 | 2020-07-27 10:37:52 +0200 | [diff] [blame] | 434 |       } | 
 | 435 |     } | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 436 |   } | 
 | 437 | } #end: while | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 438 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 439 | $zipper->close; | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 440 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 441 | $ext_tok->close if $_GEN_TOK_EXT; | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 442 |  | 
| Akron | 347be81 | 2020-09-29 07:52:52 +0200 | [diff] [blame] | 443 | exit(0); | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 444 |  | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 445 |  | 
| Peter Harders | 41c3562 | 2020-07-12 01:16:22 +0200 | [diff] [blame] | 446 | sub retr_info { # called from main() | 
| Akron | 1c4f220 | 2020-07-30 09:28:22 +0200 | [diff] [blame] | 447 |   # recursion level | 
 | 448 |   # (1 = topmost level inside retr_info() = should always be level of tag $_TEXT_BODY) | 
 | 449 |   my $rl = shift; | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 450 |  | 
| Marc Kupietz | 985da0c | 2021-02-15 19:29:50 +0100 | [diff] [blame] | 451 |   my $dummy_anno; | 
 | 452 |   if ($use_tokenizer_sentence_splits) { | 
 | 453 |     $dummy_anno = $structures->new_dummy_annotation(); | 
 | 454 |   } | 
 | 455 |  | 
| Akron | f8088e6 | 2021-02-18 16:18:59 +0100 | [diff] [blame] | 456 |   # See NOTES ON HOW | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 457 |  | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 458 |   foreach $e (@{${$_[0]}}) { # iteration through all array elements ($_[0] is a reference to an array reference) | 
| Peter Harders | 41c3562 | 2020-07-12 01:16:22 +0200 | [diff] [blame] | 459 |  | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 460 |     if ($e->[0] == XML_READER_TYPE_ELEMENT) { # element-node (see 'NODE TYPES' in manpage of XML::LibXML::Reader) | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 461 |  | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 462 |       #~~~~ | 
| Peter Harders | 41c3562 | 2020-07-12 01:16:22 +0200 | [diff] [blame] | 463 |       # from here: tag-node (opening) | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 464 |       #~~~~ | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 465 |  | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 466 |       # ~ handle structures ~ | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 467 |  | 
| Marc Kupietz | 985da0c | 2021-02-15 19:29:50 +0100 | [diff] [blame] | 468 |       my $anno; | 
 | 469 |  | 
| Akron | 7501ca0 | 2020-08-01 21:05:25 +0200 | [diff] [blame] | 470 |       # $e->[1] represents the tag name | 
| Marc Kupietz | 985da0c | 2021-02-15 19:29:50 +0100 | [diff] [blame] | 471 |       if ($use_tokenizer_sentence_splits && $e->[1] eq "s") { | 
 | 472 |         $anno = $dummy_anno; | 
 | 473 |       } else { | 
 | 474 |         $anno = $structures->add_new_annotation($e->[1]); | 
 | 475 |       } | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 476 |  | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 477 |       # ~ handle tokens ~ | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 478 |  | 
| Akron | 7501ca0 | 2020-08-01 21:05:25 +0200 | [diff] [blame] | 479 |       # Add element also to token list | 
 | 480 |       if ($_TOKENS_PROC && $e->[1] eq $_TOKENS_TAG) { | 
 | 481 |         $tokens->add_annotation($anno); | 
 | 482 |       }; | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 483 |  | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 484 |       # ~ handle attributes ~ | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 485 |  | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 486 |       if (defined $e->[3]) { # only if attributes exist | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 487 |  | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 488 |         for ($c = 0; $c < @{$e->[3]}; $c += 2) {  # with 'XCT_ATTRIBUTE_ARRAY', $node->[3] is an array reference of the form | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 489 |                                                   #  [ name1, value1, name2, value2, ....] of attribute names and corresponding values. | 
 | 490 |                                                   # note: arrays are faster (see: http://makepp.sourceforge.net/2.0/perl_performance.html) | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 491 |  | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 492 |           # '$c' references the 'key' and '$c+1' the 'value' | 
| Akron | 7501ca0 | 2020-08-01 21:05:25 +0200 | [diff] [blame] | 493 |           $anno->add_attribute( | 
 | 494 |             @{$e->[3]}[$c, $c + 1] | 
 | 495 |           ); | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 496 |         } | 
 | 497 |       } | 
 | 498 |  | 
 | 499 |  | 
 | 500 |       # ~ index 'from' ~ | 
 | 501 |  | 
 | 502 |       # this is, where a normal tag or tokens-tag ($_TOKENS_TAG) starts | 
| Akron | a10ad59 | 2020-08-03 11:20:23 +0200 | [diff] [blame] | 503 |       $anno->set_from($data->position + $add_one); | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 504 |  | 
 | 505 |       #~~~~ | 
| Peter Harders | 41c3562 | 2020-07-12 01:16:22 +0200 | [diff] [blame] | 506 |       # until here: tag-node (opening) | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 507 |       #~~~~ | 
 | 508 |  | 
 | 509 |  | 
 | 510 |       # ~~ RECURSION ~~ | 
 | 511 |  | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 512 |       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 Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 513 |  | 
| Akron | 1c4f220 | 2020-07-30 09:28:22 +0200 | [diff] [blame] | 514 |         retr_info($rl+1, \$e->[$_IDX]); # recursion with array of child-nodes | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 515 |       } | 
 | 516 |  | 
 | 517 |  | 
 | 518 |       #~~~~~ | 
| Peter Harders | 41c3562 | 2020-07-12 01:16:22 +0200 | [diff] [blame] | 519 |       # from here: tag-node (closing) | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 520 |       #~~~~~ | 
 | 521 |  | 
| Akron | a10ad59 | 2020-08-03 11:20:23 +0200 | [diff] [blame] | 522 |       my $pos = $data->position; | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 523 |  | 
| Akron | 7501ca0 | 2020-08-01 21:05:25 +0200 | [diff] [blame] | 524 |       # ~ handle structures and tokens ~ | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 525 |  | 
 | 526 |       { | 
| Akron | 7501ca0 | 2020-08-01 21:05:25 +0200 | [diff] [blame] | 527 |         $fval = $anno->from; | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 528 |  | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 529 |         if ($fval > 0 && not exists $ws{$fval - 1}) { # ~ whitespace related issue ~ | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 530 |  | 
| Peter Harders | 41c3562 | 2020-07-12 01:16:22 +0200 | [diff] [blame] | 531 |           # ~ previous node was a text-node ~ | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 532 |  | 
| Akron | 7501ca0 | 2020-08-01 21:05:25 +0200 | [diff] [blame] | 533 |           $anno->set_from($fval - 1); | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 534 |         } | 
 | 535 |  | 
 | 536 |         # in case this fails, check input | 
| Akron | 0bb7e72 | 2020-09-29 07:48:33 +0200 | [diff] [blame] | 537 |         if (($fval - 1) > $pos) { | 
 | 538 |           die $log->fatal("text_id='$text_id', " . | 
 | 539 |                             "processing of structures: " . | 
 | 540 |                             "from-value ($fval) is 2 or more greater " . | 
 | 541 |                             "than to-value ($pos) => please check. Aborting"); | 
 | 542 |         }; | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 543 |  | 
| Peter Harders | 41c3562 | 2020-07-12 01:16:22 +0200 | [diff] [blame] | 544 |         # TODO: find example for which this case applies | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 545 |         #  maybe this is not necessary anymore, because the above recorrection of the from-value suffices | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 546 |         # | 
| Akron | a10ad59 | 2020-08-03 11:20:23 +0200 | [diff] [blame] | 547 |         # TODO: check, if it's better to remove this line and change above check to 'if ( $fval - 1) >= $pos; | 
| Peter Harders | 41c3562 | 2020-07-12 01:16:22 +0200 | [diff] [blame] | 548 |         #   do testing with bigger corpus excerpt (wikipedia?) | 
| Akron | a10ad59 | 2020-08-03 11:20:23 +0200 | [diff] [blame] | 549 |         $anno->set_from($pos) if $fval == $pos + 1; | 
 | 550 |         $anno->set_to($pos); | 
| Akron | 7501ca0 | 2020-08-01 21:05:25 +0200 | [diff] [blame] | 551 |         $anno->set_level($rl); | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 552 |  | 
| Akron | a10ad59 | 2020-08-03 11:20:23 +0200 | [diff] [blame] | 553 |         # note: use $pos, because the offsets are _between_ the characters (e.g.: word = 'Hello' => from = 0 (before 'H'), to = 5 (after 'o')) | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 554 |       } | 
 | 555 |  | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 556 |       # ~ whitespace related issue ~ | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 557 |       # clean up | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 558 |       delete $ws{$fval  - 1} if $fval > 0 && exists $ws{$fval - 1}; | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 559 |  | 
 | 560 |  | 
| Peter Harders | 41c3562 | 2020-07-12 01:16:22 +0200 | [diff] [blame] | 561 |       #~~~~ | 
 | 562 |       # until here: tag-node (closing) | 
 | 563 |       #~~~~ | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 564 |  | 
 | 565 |  | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 566 |       #~~~~~ | 
 | 567 |       # from here: text- and whitespace-nodes | 
 | 568 |       #~~~~~ | 
| Peter Harders | 41c3562 | 2020-07-12 01:16:22 +0200 | [diff] [blame] | 569 |  | 
| Akron | f8088e6 | 2021-02-18 16:18:59 +0100 | [diff] [blame] | 570 |       # (See notes on whitespace handling - regarding XML_READER_TYPE_SIGNIFICANT_WHITESPACE) | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 571 |     } elsif ($e->[0] == XML_READER_TYPE_TEXT || $e->[0] == XML_READER_TYPE_SIGNIFICANT_WHITESPACE){ | 
| Peter Harders | d892a58 | 2020-02-12 15:45:22 +0100 | [diff] [blame] | 572 |  | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 573 |       if ($e->[0] == XML_READER_TYPE_SIGNIFICANT_WHITESPACE) { | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 574 |  | 
| Peter Harders | 41c3562 | 2020-07-12 01:16:22 +0200 | [diff] [blame] | 575 |         # ~ whitespace-node ~ | 
 | 576 |  | 
 | 577 |         # ~ whitespace related issue ~ | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 578 |  | 
 | 579 |         $add_one = 0; | 
 | 580 |  | 
| Akron | a10ad59 | 2020-08-03 11:20:23 +0200 | [diff] [blame] | 581 |         # state, that this from-index belongs to a whitespace-node | 
 | 582 |         #  ('++' doesn't mean a thing here - maybe it could be used for a consistency check) | 
 | 583 |         $ws{$data->position}++; | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 584 |  | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 585 |       } else { | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 586 |  | 
 | 587 |         # ~ text-node ~ | 
 | 588 |  | 
 | 589 |         $add_one = 1; | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 590 |       }; | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 591 |  | 
 | 592 |  | 
| Akron | a10ad59 | 2020-08-03 11:20:23 +0200 | [diff] [blame] | 593 |       # ~ update $data ~ | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 594 |  | 
| Akron | a10ad59 | 2020-08-03 11:20:23 +0200 | [diff] [blame] | 595 |       $data->append($e->[1]); | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 596 |  | 
| Peter Harders | 41c3562 | 2020-07-12 01:16:22 +0200 | [diff] [blame] | 597 |       #~~~~~ | 
 | 598 |       # until here: text- and whitespace-nodes | 
 | 599 |       #~~~~~ | 
 | 600 |  | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 601 |     } else { # not yet handled type | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 602 |  | 
| Akron | 0bb7e72 | 2020-09-29 07:48:33 +0200 | [diff] [blame] | 603 |       die $log->fatal('Not yet handled type ($e->[0]=' . $e->[0] . ') ... => Aborting'); | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 604 |     } | 
 | 605 |  | 
 | 606 |   } # end: foreach iteration | 
 | 607 |  | 
 | 608 | } # end: sub retr_info | 
 | 609 |  | 
| Akron | d949e18 | 2020-02-14 12:23:57 +0100 | [diff] [blame] | 610 | __END__ | 
 | 611 |  | 
 | 612 | =pod | 
 | 613 |  | 
 | 614 | =encoding utf8 | 
 | 615 |  | 
 | 616 | =head1 NAME | 
 | 617 |  | 
 | 618 | tei2korapxml - Conversion of TEI P5 based formats to KorAP-XML | 
 | 619 |  | 
 | 620 | =head1 SYNOPSIS | 
 | 621 |  | 
 | 622 |   cat corpus.i5.xml | tei2korapxml > corpus.korapxml.zip | 
 | 623 |  | 
 | 624 | =head1 DESCRIPTION | 
 | 625 |  | 
| Akron | ee434b1 | 2020-07-08 12:53:01 +0200 | [diff] [blame] | 626 | C<tei2korapxml> is a script to convert TEI P5 and | 
 | 627 | L<I5|https://www1.ids-mannheim.de/kl/projekte/korpora/textmodell.html> | 
 | 628 | based documents to the | 
 | 629 | L<KorAP-XML format|https://github.com/KorAP/KorAP-XML-Krill#about-korap-xml>. | 
 | 630 | If no specific input is defined, data is | 
| Akron | d949e18 | 2020-02-14 12:23:57 +0100 | [diff] [blame] | 631 | read from C<STDIN>. If no specific output is defined, data is written | 
 | 632 | to C<STDOUT>. | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 633 |  | 
| Akron | d949e18 | 2020-02-14 12:23:57 +0100 | [diff] [blame] | 634 | This program is usually called from inside another script. | 
 | 635 |  | 
| Akron | ee434b1 | 2020-07-08 12:53:01 +0200 | [diff] [blame] | 636 | =head1 FORMATS | 
 | 637 |  | 
 | 638 | =head2 Input restrictions | 
 | 639 |  | 
 | 640 | =over 2 | 
 | 641 |  | 
 | 642 | =item | 
 | 643 |  | 
| Akron | ee434b1 | 2020-07-08 12:53:01 +0200 | [diff] [blame] | 644 | TEI P5 formatted input with certain restrictions: | 
 | 645 |  | 
 | 646 | =over 4 | 
 | 647 |  | 
 | 648 | =item | 
 | 649 |  | 
 | 650 | B<mandatory>: text-header with integrated textsigle, text-body | 
 | 651 |  | 
 | 652 | =item | 
 | 653 |  | 
 | 654 | B<optional>: corp-header with integrated corpsigle, | 
 | 655 | doc-header with integrated docsigle | 
 | 656 |  | 
 | 657 | =back | 
 | 658 |  | 
 | 659 | =item | 
 | 660 |  | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 661 | All tokens inside the primary text may not be | 
| Akron | ee434b1 | 2020-07-08 12:53:01 +0200 | [diff] [blame] | 662 | newline seperated, because newlines are removed | 
| Akron | 0c41ab3 | 2020-09-29 07:33:33 +0200 | [diff] [blame] | 663 | (see L<KorAP::XML::TEI::Data>) and a conversion of newlines | 
| Akron | ee434b1 | 2020-07-08 12:53:01 +0200 | [diff] [blame] | 664 | into blanks between 2 tokens could lead to additional blanks, | 
 | 665 | where there should be none (e.g.: punctuation characters like C<,> or | 
 | 666 | C<.> should not be seperated from their predecessor token). | 
 | 667 | (see also code section C<~ whitespace handling ~>). | 
 | 668 |  | 
 | 669 | =back | 
 | 670 |  | 
 | 671 | =head2 Notes on the output | 
 | 672 |  | 
 | 673 | =over 2 | 
 | 674 |  | 
 | 675 | =item | 
 | 676 |  | 
 | 677 | zip file output (default on C<stdout>) with utf8 encoded entries | 
 | 678 | (which together form the KorAP-XML format) | 
 | 679 |  | 
 | 680 | =back | 
 | 681 |  | 
| Akron | d949e18 | 2020-02-14 12:23:57 +0100 | [diff] [blame] | 682 | =head1 INSTALLATION | 
 | 683 |  | 
 | 684 | C<tei2korapxml> requires L<libxml2-dev> bindings to build. When | 
 | 685 | these bindings are available, the preferred way to install the script is | 
 | 686 | to use L<cpanm|App::cpanminus>. | 
 | 687 |  | 
 | 688 |   $ cpanm https://github.com/KorAP/KorAP-XML-TEI.git | 
 | 689 |  | 
 | 690 | In case everything went well, the C<tei2korapxml> tool will | 
 | 691 | be available on your command line immediately. | 
| Peter Harders | 6f526a3 | 2020-06-29 21:44:41 +0200 | [diff] [blame] | 692 |  | 
| Akron | d949e18 | 2020-02-14 12:23:57 +0100 | [diff] [blame] | 693 | Minimum requirement for L<KorAP::XML::TEI> is Perl 5.16. | 
 | 694 |  | 
 | 695 | =head1 OPTIONS | 
 | 696 |  | 
 | 697 | =over 2 | 
 | 698 |  | 
| Akron | 4e603a5 | 2020-07-27 14:23:49 +0200 | [diff] [blame] | 699 | =item B<--root|-r> | 
| Akron | d949e18 | 2020-02-14 12:23:57 +0100 | [diff] [blame] | 700 |  | 
| Akron | 4e603a5 | 2020-07-27 14:23:49 +0200 | [diff] [blame] | 701 | The root directory for output. Defaults to C<.>. | 
| Akron | d949e18 | 2020-02-14 12:23:57 +0100 | [diff] [blame] | 702 |  | 
 | 703 | =item B<--help|-h> | 
 | 704 |  | 
 | 705 | Print help information. | 
 | 706 |  | 
 | 707 | =item B<--version|-v> | 
 | 708 |  | 
 | 709 | Print version information. | 
 | 710 |  | 
| Akron | 4e603a5 | 2020-07-27 14:23:49 +0200 | [diff] [blame] | 711 | =item B<--tokenizer-call|-tc> | 
 | 712 |  | 
 | 713 | Call an external tokenizer process, that will tokenize | 
 | 714 | a single line from STDIN and outputs one token per line. | 
 | 715 |  | 
| Marc Kupietz | 1e882fb | 2020-09-09 00:05:46 +0200 | [diff] [blame] | 716 | =item B<--tokenizer-korap|-tk> | 
 | 717 |  | 
 | 718 | Use the standard KorAP/DeReKo tokenizer. | 
 | 719 |  | 
| Akron | 6d7b8e4 | 2020-09-29 07:37:41 +0200 | [diff] [blame] | 720 | =item B<--tokenizer-internal|-ti> | 
| Akron | 4e603a5 | 2020-07-27 14:23:49 +0200 | [diff] [blame] | 721 |  | 
 | 722 | Tokenize the data using two embedded tokenizers, | 
 | 723 | that will take an I<Aggressive> and a I<conservative> | 
 | 724 | approach. | 
 | 725 |  | 
| Akron | 1a5271a | 2021-02-18 13:18:15 +0100 | [diff] [blame] | 726 | =item B<--inline-tokens> <foundry>#[<file>] | 
 | 727 |  | 
 | 728 | Define the foundry and file (without extension) | 
 | 729 | to store inline token information in. | 
 | 730 | If L</KORAPXMLTEI_INLINE> is set, this will contain | 
 | 731 | annotations as well. | 
 | 732 | Defaults to C<tokens> and C<morpho>. | 
 | 733 |  | 
| Marc Kupietz | 985da0c | 2021-02-15 19:29:50 +0100 | [diff] [blame] | 734 | =item B<--use-tokenizer-sentence-splits|-s> | 
 | 735 |  | 
 | 736 | Replace existing with, or add new, sentence boundary information | 
 | 737 | provided by the KorAP tokenizer (currently supported only). | 
 | 738 |  | 
| Akron | 3378dfd | 2020-08-01 15:01:36 +0200 | [diff] [blame] | 739 | =item B<--log|-l> | 
 | 740 |  | 
 | 741 | Loglevel for I<Log::Any>. Defaults to C<notice>. | 
 | 742 |  | 
| Akron | d949e18 | 2020-02-14 12:23:57 +0100 | [diff] [blame] | 743 | =back | 
 | 744 |  | 
| Akron | b364947 | 2020-09-29 08:24:46 +0200 | [diff] [blame] | 745 | =head1 ENVIRONMENT VARIABLES | 
 | 746 |  | 
 | 747 | =over 2 | 
 | 748 |  | 
 | 749 | =item B<KORAPXMLTEI_DEBUG> | 
 | 750 |  | 
 | 751 | Activate minimal debugging. | 
 | 752 | Defaults to C<false>. | 
 | 753 |  | 
 | 754 | =item B<KORAPXMLTEI_INLINE> | 
 | 755 |  | 
 | 756 | Process inline annotations, if present. | 
 | 757 | Defaults to C<false>. | 
 | 758 |  | 
 | 759 | =back | 
 | 760 |  | 
| Akron | d949e18 | 2020-02-14 12:23:57 +0100 | [diff] [blame] | 761 | =head1 COPYRIGHT AND LICENSE | 
 | 762 |  | 
| Marc Kupietz | e955ecc | 2021-02-17 17:42:01 +0100 | [diff] [blame] | 763 | Copyright (C) 2021, L<IDS Mannheim|https://www.ids-mannheim.de/> | 
| Akron | d949e18 | 2020-02-14 12:23:57 +0100 | [diff] [blame] | 764 |  | 
 | 765 | Author: Peter Harders | 
 | 766 |  | 
| Akron | aabd095 | 2020-09-29 07:35:08 +0200 | [diff] [blame] | 767 | Contributors: Nils Diewald, Marc Kupietz, Carsten Schnober | 
| Akron | d949e18 | 2020-02-14 12:23:57 +0100 | [diff] [blame] | 768 |  | 
 | 769 | L<KorAP::XML::TEI> is developed as part of the L<KorAP|https://korap.ids-mannheim.de/> | 
 | 770 | Corpus Analysis Platform at the | 
 | 771 | L<Leibniz Institute for the German Language (IDS)|http://ids-mannheim.de/>, | 
 | 772 | member of the | 
 | 773 | L<Leibniz-Gemeinschaft|http://www.leibniz-gemeinschaft.de/>. | 
 | 774 |  | 
 | 775 | This program is free software published under the | 
| Marc Kupietz | e955ecc | 2021-02-17 17:42:01 +0100 | [diff] [blame] | 776 | L<BSD-2 License|https://opensource.org/licenses/BSD-2-Clause>. | 
| Akron | d949e18 | 2020-02-14 12:23:57 +0100 | [diff] [blame] | 777 |  | 
 | 778 | =cut | 
| Akron | f8088e6 | 2021-02-18 16:18:59 +0100 | [diff] [blame] | 779 |  | 
 | 780 | # NOTES | 
 | 781 |  | 
 | 782 | ##  Notes on how 'XML::CompactTree::XS' works | 
 | 783 |  | 
 | 784 | Example: <node a="v"><node1>some <n/> text</node1><node2>more-text</node2></node> | 
 | 785 |  | 
 | 786 | Print out name of 'node2' for the above example: | 
 | 787 |  | 
 | 788 | 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"' | 
 | 789 |  | 
 | 790 | Exploring the structure of $data ( = reference to below array ): | 
 | 791 |  | 
 | 792 | [ 0: XML_READER_TYPE_DOCUMENT, | 
 | 793 |   1: ? | 
 | 794 |   2: [ 0: [ 0: XML_READER_TYPE_ELEMENT                     <- start recursion with array '$data->[2]' (see main(): retr_info( \$tree_data->[2] )) | 
 | 795 |             1: 'node' | 
 | 796 |             2: ? | 
 | 797 |             3: HASH (attributes) | 
 | 798 |             4: 1 (line number) | 
 | 799 |             5: [ 0: [ 0: XML_READER_TYPE_ELEMENT | 
 | 800 |                       1: 'node1' | 
 | 801 |                       2: ? | 
 | 802 |                       3: undefined (no attributes) | 
 | 803 |                       4: 1 (line number) | 
 | 804 |                       5: [ 0: [ 0: XML_READER_TYPE_TEXT | 
 | 805 |                                 1: 'some ' | 
 | 806 |                               ] | 
 | 807 |                            1: [ 0: XML_READER_TYPE_ELEMENT | 
 | 808 |                                 1: 'n' | 
 | 809 |                                 2: ? | 
 | 810 |                                 3: undefined (no attributes) | 
 | 811 |                                 4: 1 (line number) | 
 | 812 |                                 5: undefined (no child-nodes) | 
 | 813 |                               ] | 
 | 814 |                            2: [ 0: XML_READER_TYPE_TEXT | 
 | 815 |                                 1: ' text' | 
 | 816 |                               ] | 
 | 817 |                          ] | 
 | 818 |                     ] | 
 | 819 |                  1: [ 0: XML_READER_TYPE_ELEMENT | 
 | 820 |                       1: 'node2' | 
 | 821 |                       2: ? | 
 | 822 |                       3: undefined (not attributes) | 
 | 823 |                       4: 1 (line number) | 
 | 824 |                       5: [ 0: [ 0: XML_READER_TYPE_TEXT | 
 | 825 |                                 1: 'more-text' | 
 | 826 |                               ] | 
 | 827 |                          ] | 
 | 828 |                     ] | 
 | 829 |                ] | 
 | 830 |           ] | 
 | 831 |      ] | 
 | 832 | ] | 
 | 833 |  | 
 | 834 | $data->[0] = 9 (=> type == XML_READER_TYPE_DOCUMENT) | 
 | 835 |  | 
 | 836 | ref($data->[2])                                                         == ARRAY (with 1 element for 'node') | 
 | 837 | ref($data->[2]->[0])                                                    == ARRAY (with 6 elements) | 
 | 838 |  | 
 | 839 | $data->[2]->[0]->[0]                                                    == 1 (=> type == XML_READER_TYPE_ELEMENT) | 
 | 840 | $data->[2]->[0]->[1]                                                    == 'node' | 
 | 841 | ref($data->[2]->[0]->[3])                                               == HASH  (=> ${$data->[2]->[0]->[3]}{a} == 'v') | 
 | 842 | $data->[2]->[0]->[4]                                                    == 1 (line number) | 
 | 843 | ref($data->[2]->[0]->[5])                                               == ARRAY (with 2 elements for 'node1' and 'node2') | 
 | 844 |                                                                                    # child-nodes of actual node (see $_IDX) | 
 | 845 |  | 
 | 846 | ref($data->[2]->[0]->[5]->[0])                                          == ARRAY (with 6 elements) | 
 | 847 | $data->[2]->[0]->[5]->[0]->[0]                                          == 1 (=> type == XML_READER_TYPE_ELEMENT) | 
 | 848 | $data->[2]->[0]->[5]->[0]->[1]                                          == 'node1' | 
 | 849 | $data->[2]->[0]->[5]->[0]->[3]                                          == undefined (=> no attribute) | 
 | 850 | $data->[2]->[0]->[5]->[0]->[4]                                          == 1 (line number) | 
 | 851 | ref($data->[2]->[0]->[5]->[0]->[5])                                     == ARRAY (with 3 elements for 'some ', '<n/>' and ' text') | 
 | 852 |  | 
 | 853 | ref($data->[2]->[0]->[5]->[0]->[5]->[0])                                == ARRAY (with 2 elements) | 
 | 854 | $data->[2]->[0]->[5]->[0]->[5]->[0]->[0]                                == 3 (=> type ==  XML_READER_TYPE_TEXT) | 
 | 855 | $data->[2]->[0]->[5]->[0]->[5]->[0]->[1]                                == 'some ' | 
 | 856 |  | 
 | 857 | ref($data->[2]->[0]->[5]->[0]->[5]->[1])                                == ARRAY (with 5 elements) | 
 | 858 | $data->[2]->[0]->[5]->[0]->[5]->[1]->[0]                                == 1 (=> type == XML_READER_TYPE_ELEMENT) | 
 | 859 | $data->[2]->[0]->[5]->[0]->[5]->[1]->[1]                                == 'n' | 
 | 860 | $data->[2]->[0]->[5]->[0]->[5]->[1]->[3]                                == undefined (=> no attribute) | 
 | 861 | $data->[2]->[0]->[5]->[0]->[5]->[1]->[4]                                == 1 (line number) | 
 | 862 | $data->[2]->[0]->[5]->[0]->[5]->[1]->[5]                                == undefined (=> no child-nodes) | 
 | 863 |  | 
 | 864 | ref($data->[2]->[0]->[5]->[0]->[5]->[2])                                == ARRAY (with 2 elements) | 
 | 865 | $data->[2]->[0]->[5]->[0]->[5]->[2]->[0]                                == 3 (=> type ==  XML_READER_TYPE_TEXT) | 
 | 866 | $data->[2]->[0]->[5]->[0]->[5]->[2]->[1]                                == ' text' | 
 | 867 |  | 
 | 868 |  | 
 | 869 | retr_info() starts with the array reference ${$_[0]} (= \$tree_data->[2]), which corresponds to ${\$data->[2]} in the above example. | 
 | 870 | Hence, the expression @{${$_[0]}} corresponds to @{${\$data->[2]}}, $e to ${${\$data->[2]}}[0] (= $data->[2]->[0]) and $e->[0] to | 
 | 871 | ${${\$data->[2]}}[0]->[0] (= $data->[2]->[0]->[0]). | 
 | 872 |  | 
 | 873 |  | 
 | 874 | ## Notes on whitespace handling | 
 | 875 |  | 
 | 876 | Every whitespace inside the processed text is 'significant' and recognized as a node of type 'XML_READER_TYPE_SIGNIFICANT_WHITESPACE' | 
 | 877 | (see function 'retr_info()'). | 
 | 878 |  | 
 | 879 | Definition of significant and insignificant whitespace | 
 | 880 | (source: https://www.oracle.com/technical-resources/articles/wang-whitespace.html): | 
 | 881 |  | 
 | 882 | Significant whitespace is part of the document content and should be preserved. | 
 | 883 | Insignificant whitespace is used when editing XML documents for readability. | 
 | 884 | These whitespaces are typically not intended for inclusion in the delivery of the document. | 
 | 885 |  | 
 | 886 | ### Regarding XML_READER_TYPE_SIGNIFICANT_WHITESPACE | 
 | 887 |  | 
 | 888 | The 3rd form of nodes, besides text- (XML_READER_TYPE_TEXT) and tag-nodes (XML_READER_TYPE_ELEMENT) are nodes of the type | 
 | 889 |  'XML_READER_TYPE_SIGNIFICANT_WHITESPACE'. | 
 | 890 |  | 
 | 891 | When modifiying the previous example (see: Notes on how 'XML::CompactTree::XS' works) by inserting an additional blank between | 
 | 892 |  '</node1>' and '<node2>', the output for '$data->[2]->[0]->[5]->[1]->[1]' is a blank (' ') and it's type is '14' | 
 | 893 |  (XML_READER_TYPE_SIGNIFICANT_WHITESPACE, see 'man XML::LibXML::Reader'): | 
 | 894 |  | 
 | 895 | 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"' | 
 | 896 |  | 
 | 897 |  | 
 | 898 | Example: '... <head type="main"><s>Campagne in Frankreich</s></head><head type="sub"> <s>1792</s> ...' | 
 | 899 |  | 
 | 900 | Two text-nodes should normally be separated by a blank. In the above example, that would be the 2 text-nodes | 
 | 901 |  'Campagne in Frankreich' and '1792', which are separated by the whitespace-node ' ' (see [2]). | 
 | 902 |  | 
 | 903 | The text-node 'Campagne in Frankreich' leads to the setting of '$add_one' to 1, so that when opening the 2nd 'head'-tag, | 
 | 904 |  it's from-index gets set to the correct start-index of '1792' (and not to the start-index of the whitespace-node ' '). | 
 | 905 |  | 
 | 906 | The assumption here is, that in most cases there _is_ a whitespace node between 2 text-nodes. The below code fragment | 
 | 907 |  enables a way, to check, if this really _was_ the case for the last 2 'non-tag'-nodes, when closing a tag: | 
 | 908 |  | 
 | 909 | 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. | 
 | 910 |  So when closing a tag, it can be checked, if the previous 'non-tag'-node (text or whitespace), which is the one before | 
 | 911 |  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 | 
 | 912 |  the last read 'non-tag'-node has to be corrected (see [1]), | 
 | 913 |  | 
 | 914 | For whitespace-nodes $add_one is set to 0, so when opening the next tag (in the above example the 2nd 's'-tag), no | 
 | 915 |  additional 1 is added (because this was already done by the whitespace-node itself when incrementing the variable $pos). | 
 | 916 |  | 
 | 917 | [1] | 
 | 918 | Now, what happens, when 2 text-nodes are _not_ seperated by a whitespace-node (e.g.: <w>Augen<c>,</c></w>)? | 
 | 919 |  In this case, the falsely increased from-value has to be decreased again by 1 when closing the enclosing tag | 
 | 920 |  (see above code fragment '... not exists $ws{ $fval - 1 } ...'). | 
 | 921 |  | 
 | 922 | [2] | 
 | 923 | 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 | 
 | 924 |  whitespace-node (XML_READER_TYPE_SIGNIFICANT_WHITESPACE). | 
 | 925 |  | 
 | 926 | The from-index of the 2nd w-tag in the second example refers to 'bar', which may not have been the intention | 
 | 927 |  (even though '<w> </w>' doesn't make a lot of sense). TODO: could this be a bug? | 
 | 928 |  | 
 | 929 | 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- | 
 | 930 |  and to-indizes for the tags 'a' and 'b' both 12, which is the start-index of the token 'tok3'. | 
 | 931 |  | 
 | 932 |  | 
 | 933 | ## Notes on whitespace fixing | 
 | 934 |  | 
 | 935 | The idea for the below code fragment was to fix (recreate) missing whitespace in a poorly created corpus, in which linebreaks where inserted | 
 | 936 |  into the text with the addition that maybe (or not) whitespace before those linebreaks was unintenionally stripped. | 
 | 937 |  | 
 | 938 | It soon turned out, that it was best to suggest considering just avoiding linebreaks and putting all primary text tokens into one line (see | 
 | 939 |  example further down and notes on 'Input restrictions' in the manpage). | 
 | 940 |  | 
 | 941 | Somehow an old first very poor approach remained, which is not stringent, but also doesn't affect one-line text. | 
 | 942 |  | 
 | 943 | Examples (how primary text with linebreaks would be converted by below code): | 
 | 944 |  | 
 | 945 |   '...<w>end</w>\n<w>.</w>...' -> '...<w>end</w> <w>.</w>...' | 
 | 946 |   '...<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>'. | 
 | 947 |  | 
 | 948 | Blanks are inserted before the 1st character: | 
 | 949 |  | 
 | 950 |  NOTE: not stringent ('...' stands for text): | 
 | 951 |  | 
 | 952 |    beg1............................end1  => no blank before 'beg1' | 
 | 953 |    beg2....<pb/>...................end2  => no blank before 'beg2' | 
 | 954 |    beg3....<info attr1="val1"/>....end3  => no blank before 'beg3' | 
 | 955 |    beg4....<test>ok</test>.........end4  =>    blank before 'beg4' | 
 | 956 |  | 
 | 957 |      =>  beg1....end1beg2...<pb/>...end2beg3....<info attr1="val1"/>....end3 beg4...<test>ok</test>....end4 | 
 | 958 |                                                                             ^ | 
 | 959 |                                                                             |_blank between 'end3' and 'beg4' | 
 | 960 |  | 
 | 961 |  | 
 | 962 | ## Notes on segfault prevention | 
 | 963 |  | 
 | 964 | binmode on the input handler prevents segfaulting of 'XML::LibXML::Reader' inside 'main()' | 
 | 965 | (see notes on 'PerlIO layers' in  'man XML::LibXML'), | 
 | 966 | removing 'use open qw(:std :utf8)' would fix this problem too, but using binmode on input is more granular | 
 | 967 | see in perluniintro: You can switch encodings on an already opened stream by using "binmode() | 
 | 968 | see in perlfunc: If LAYER is omitted or specified as ":raw" the filehandle is made suitable for passing binary data. |