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