Blame - script/tei2korapxml - KorAP/KorAP-XML-TEI

### 2. Let 'data.xml' only be used/referred by 'sentences.xml', 'paragraphs.xml' and 'structure.xml', since it can contain double blanks (' ' - see comment to '<s/>' in func.

12

### retr_info) and TODO: also contains not only text inside s-tags (e.g.: <label><hi rend="it bo">Ludwig Pietsch (1824-1911):</hi></label><item><s>Journalist ...)

13

###

14

Peter Harders

d892a58

2020-02-12 15:45:22 +0100

[diff] [blame]

use 5.012;

use strict;

use warnings;

use File::Basename; # dirname

20

use IO::Handle qw( );

21

use IO::Select;

22

23

use open qw(:std :utf8); # assume utf-8 encoding

24

use Encode qw(encode_utf8 decode_utf8);

25

26

use Getopt::Long;

27

use XML::CompactTree::XS;

28

use XML::LibXML::Reader;

29

use IO::Compress::Zip qw(zip $ZipError :constants);

30

use IPC::Open2; # open2

31

32

my $zip; my $first_write=1;

33

my $outh = *STDOUT;

34

35

my $_CORR_POS_FOR_EMPTY_S_TAGS = 1; # this should only be deactivated for test purposes (empty s-tags produce an additional blank (look for ' ' in data.xml)

36

my $_CORR_BYTE_POS_FOR_P_TAGS = 1;

37

Peter Harders

7025713

2020-02-13 13:47:55 +0100

[diff] [blame]

38

my $_GEN_TOK_BAS = 0;

Peter Harders

d892a58

2020-02-12 15:45:22 +0100

[diff] [blame]

39

my $_GEN_TOK_DUMMY = 0; # not needed for drukola or cmc

40

41

my $_COMPRESSION_METHOD = ZIP_CM_DEFLATE;

my $_DEBUG = 0;

my $_root_dir = "."; # output base directory

46

my $_header_file = "header.xml"; # filename to save text header in (in Latin1 format -> needed for ... ?) # TODO: why 'Latin1'?

47

my $_data_file = "data.xml"; # filename to save text data in (in UTF-8 format -> needed for ... ?)

48

my $_base_dir = "base"; # directory to store sentence and paragraph file and ...

49

my $_structure_dir = "struct";

50

my $_structure_file = "structure.xml";

51

my ($text_id, $text_id_esc); # '$text_id_esc' = escaped version of $text_id - see %ent (needed e.g. for 'Corola-PublishingHouse/Editura "Cronica"/260_a_608')

52

my $dir = ""; # text directory (on top of base)

53

my $dir_crp = ""; # corpus directory (on top of base)

54

my $dir_doc = ""; # document directory (on top of base)

55

my $data = ""; # $data is written to '$_data_file'

56

my %ent=('"', '"', '&','&','<','<','>','>'); # convert '&', '<' and '>' to their corresp. sgml-entities for compat. with KorAP

57

# NOTE: the index still refers to the above char-versions, which are counted as 1

58

# (search for '&' in data.xml and see corresp. indices in structure.xml, lemma.xml, ana.xml ...)

59

my $header_crp = "";

60

my $header_doc = "";

61

my $header_txt = ""; # $header_* are written to '$_header_file'

62

63

my ($header_fl_crp, $header_fl_doc, $header_fl_txt, $data_fl, $header_prfx, $data_prfx1, $data_prfx2, $data_sfx);

64

$header_prfx = $data_prfx1 = $data_prfx2 = $data_sfx = "";

my ($i, $c);

### needed for sub retr_info

69

my $_XCT_LN=0; # remember line numbers (set to 1 if debugging)

70

my ($reader, $tree_data, $rl, $_IDX, $n, $e, $dl, @oti);

71

# 'dl' stands for 'data length', 'oti' stands for 'open tags index'

72

($_XCT_LN)?($_IDX=5):($_IDX=4);

73

###

74

### needed in func. write_structures

75

my ($ref, $idx, $att_idx);

my $buf_in = "";

my $output;

### needed for tokenization

81

my $_tok_file_bas = "tokens.xml";

82

83

#my @sentences; # sentence character offsets (start, end, start, end, ...)

84

#my @paragraphs; # paragraph character offsets (start, end, start, end, ...)

85

my @structures; # list of hashes, each hash representing an XML element

86

87

## whitespace-related issue (see retr_info()): needed to correct from-offset for some tags

88

my $add_one;

89

my %hws; # hash for indices of whitespace nodes (needed to recorrect from-value)

90

# idea: when closing element, check if it's from-index minus 1 refers to a whitespace node (means: 'from-index - 1' is a key in %hws).

91

# if this is _not_ the case, then the from-value is one to high => correct it by substracting 1

92

my ($fval, $fval2);

93

$fval=$fval2=0; # init.

94

##

95

96

## needed if $_GEN_TOK_DUMMY is set

97

my $_tok_file_con = "tokens_conservative.xml";

98

my $_tok_file_agg = "tokens_aggr.xml";

99

my (@tok_tokens_con, @tok_tokens_agg);

100

my ($m1, $m2, $m3, $m4, $tmp, $p1, $p2, $pr, $offset, $txt);

$offset=0;

##

# do this to prevent error message 'Global symbol "..." requires explicit package name at ...'

105

my ($_ANNOT_ATT_ANNOT_NAME_RD, $_ANNOT_ATT_LEM_NAME_RD, $_ANNOT_ATT_POS_NAME_WR, $_ANNOT_ATT_MSD_NAME_WR) = ('','','','');

106

107

## needed for handling some inline annotations

108

my $_ANNOT_GEN = 0; # turn processing of inline annotations on/off

109

#my $_ANNOT_DIR_NAME = "connexor"; # name of path/foundry to write information to

110

my $_ANNOT_DIR_NAME = "drukola"; # name of path/foundry to write information to

111

#my $_ANNOT_DIR_NAME = "cmc"; # name of path/foundry to write information to # cmc = computer mediated communication - needed for dck corpus

112

my $_ANNOT_FILE_NAME = "morpho.xml"; # file to write annotations to

113

my $_ANNOT_TAG_NAME_RD = "w"; # from which tag to fetch the below attributes

114

$_ANNOT_ATT_ANNOT_NAME_RD = "ana"; # from which attribute to fetch the msd and pos information

115

#$_ANNOT_ATT_ANNOT_NAME_RD = "type"; # from which attribute to fetch the msd and pos information # must be 'type' for dck corpus

116

# new: comment out, if not needed

117

$_ANNOT_ATT_LEM_NAME_RD = "lemma"; # from which attribute to fetch the lemma information

118

# new: comment out, if not needed

119

$_ANNOT_ATT_POS_NAME_WR = "pos"; # see e.g.: GIT/KorAP-XML-Krill/t/annotation/corpus/doc/0001/mate/morpho.xml

120

# new: comment out, if not needed

121

$_ANNOT_ATT_MSD_NAME_WR = "msd"; # not needed for dck corpus

122

# new: comment out, if not needed

123

my $_ANNOT_ATT_LEM_NAME_WR = "lemma"; # s.a.

124

my (@annot, @oti2);

125

my $inside_annot_tag = -1;

##

my $help;

GetOptions(

"base=s" => \$_root_dir,

"help" => \$help

);

printhelp() if $help;

######

###### MAIN

######

$_root_dir.='/'; # must always end with a slash at this point

141

$_root_dir=~s/^\.?\///; # remove leading / (only relative paths allowed in IO::Compress::Zip) and ./

142

143

my $lc=0; my $tc=0; my ($pfx, $sfx);

$header_fl_txt=0;

# header_prfx

$header_prfx = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";

148

$header_prfx .= "<?xml-model href=\"header.rng\" type=\"application/xml\" schematypens=\"http://relaxng.org/ns/structure/1.0\"?>\n";

149

$header_prfx .= "<!DOCTYPE idsCorpus PUBLIC \"-//IDS//DTD IDS-XCES 1.0//EN\" \"http://corpora.ids-mannheim.de/idsxces1/DTD/ids.xcesdoc.dtd\">\n";

150

151

$data_prfx1 = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";

152

$data_prfx1 .= "<?xml-model href=\"text.rng\" type=\"application/xml\" schematypens=\"http://relaxng.org/ns/structure/1.0\"?>\n\n";

153

$data_prfx1 .= "<raw_text docid=\"";

154

$data_prfx2 .= "\" xmlns=\"http://ids-mannheim.de/ns/KorAP\">\n";

155

$data_prfx2 .= " <metadata file=\"metadata.xml\" />\n";

156

$data_prfx2 .= " <text>";

157

$data_sfx = "</text>\n</raw_text>";

158

159

my($chld_out, $chld_in, $pid, $select);

if( $_GEN_TOK_BAS ){

startTokenizer();

}

while(<STDIN>){

$lc++; # line counter

167

168

if( $data_fl && m/^(.+)?<\/text>(.+)?$/ ){ # end of text body

169

###

170

### write data.xml, sentences.xml, paragraph.xml and structure.xml

###

$pfx=$1; $sfx=$2;

die "ERROR ($0): main(): input line number $lc: line with closing tag for 'text' contains additional information ... => Aborting\n\tline=$_"

175

if (defined $pfx && $pfx !~ /^\s*$/) || (defined $sfx && $sfx !~ /^\s*$/);

if( $dir ne "" ){

### NOTE: needed for debugging (e.g. whitespace issues)

180

#if( $text_id eq "GOE_AGA.00000" )

181

#if( $text_id eq "GOE_AGI.04846" )

182

#{

183

#open H1, ">/tmp/t123";

#print H1 "$buf_in";

#close H1;

#}

####

$reader = XML::LibXML::Reader->new(string => "<text>$buf_in</text>", huge => 1);

190

191

if( $_XCT_LN ){ # _XCT_LINE_NUMBERS is only for debugging

192

193

# remove 'XCT_IGNORE_WS', because whitespace (in form of one blank) between tags is needed for separation of 'text-nodes' in data.xml

194

# TODO: check out the meanings/differences of 'XCT_IGNORE_WS' and 'XCT_IGNORE_SIGNIFICANT_WS': seems like, 'XCT_IGNORE_SIGNIFICANT_WS' is the one we need

195

$tree_data = XML::CompactTree::XS::readSubtreeToPerl($reader, XCT_DOCUMENT_ROOT|XCT_IGNORE_COMMENTS|XCT_ATTRIBUTE_ARRAY|XCT_LINE_NUMBERS);

196

197

}else{

198

$tree_data = XML::CompactTree::XS::readSubtreeToPerl($reader, XCT_DOCUMENT_ROOT|XCT_IGNORE_COMMENTS|XCT_ATTRIBUTE_ARRAY);

199

# $tree_data = XML::CompactTree::XS::readSubtreeToPerl($reader, XCT_DOCUMENT_ROOT|XCT_IGNORE_COMMENTS|XCT_ATTRIBUTE_ARRAY|XCT_IGNORE_WS|XCT_IGNORE_SIGNIFICANT_WS);

200

}

201

202

@structures=(); @oti=();

if( $_ANNOT_GEN ){

@annot=(); @oti2=()

}

$dl = 0;

$rl = 0; # recursion level

211

212

# whitespace related issue

$add_one = 0;

%hws=();

#

###

### recursion

retr_info( \$tree_data->[2] ); # parse input data

###

###

$rl--;

# write data.xml

$data=~tr/\n\r/ /; # NOTE: 2 blanks - otherwise offset data would become corrupt

226

$data=encode_utf8($data);

227

228

# first write it to tokenization pipe to give it some time

229

if( $_GEN_TOK_BAS ){

230

print $chld_in "$data\n\x03\n";

231

}

232

233

print STDERR "DEBUG ($0): main(): Writing (utf8-formatted) xml file $_root_dir$dir/$_data_file\n" if $_DEBUG;

234

if ($first_write){

235

$first_write=0;

236

### 1st time: create instance

Peter Harders

7025713

2020-02-13 13:47:55 +0100

[diff] [blame]

237

$zip = new IO::Compress::Zip $outh, Zip64 => 1, TextFlag => 1, Method => $_COMPRESSION_METHOD, Append => 0, Name => "$_root_dir$dir/$_data_file"

Peter Harders

d892a58

2020-02-12 15:45:22 +0100

[diff] [blame]

238

or die "ERROR ('$_root_dir$dir/$_data_file'): zip failed: $ZipError\n"

239

}else{

240

### close previous stream and open new one

241

$zip->newStream( Zip64 => 1, TextFlag => 1, Method => $_COMPRESSION_METHOD, Append => 1, Name => "$_root_dir$dir/$_data_file" )

242

or die "ERROR ('$_root_dir$dir/$_data_file'): zip failed: $ZipError\n"

243

}

244

$data =~ s/(&|<|>)/$ent{$1}/g;

245

$zip->print("$data_prfx1$text_id_esc$data_prfx2$data$data_sfx");

246

247

# write structures

248

write_structures() if @structures;

249

250

# write annotations

251

write_annot() if $_ANNOT_GEN && @annot;

252

253

# tokenization

254

if( $_GEN_TOK_BAS || $_GEN_TOK_DUMMY )

255

{

256

write_tok();

257

if( $_GEN_TOK_DUMMY ){

258

$offset = 0; @tok_tokens_con=(); @tok_tokens_agg=();

}

}

$data_fl=0; $data = $dir = $buf_in = ""; # reinit.

}else{ # $dir eq ""

print STDERR "WARNING ($0): main(): maybe empty textSigle => skipping this text ...\n";

267

print STDERR "WARNING ($0): main(): text header=$header_txt\n";

268

print STDERR "WARNING ($0): main(): data=$data\n";

269

}

270

}elsif( $data_fl ){ # inside text body

271

#print STDERR "inside text body (\$data_fl set)\n";

272

273

### whitespace handling

274

# remove consecutive whitespace at beginning and end (mostly one newline)

275

# to let 'XML::CompactTree::XS' recognize these blanks as 'text-nodes', the option 'XCT_IGNORE_WS' may not be used (see above).

276

s/^\s+//; s/\s+$//;

277

278

# important!: search for '>[^<][^<]*<' e.g. in 'vim goe_tagged.i5.xml.bz2' => insert a blank before every _first_ tag in a line, that contains text

279

# NOTE: the input text should avoid structures like below (which could also happen to other tags like '<pb ... />' or '<abbr>' etc.):

280

# negative example for '<w>' (see dck corpus in 'DeReKo-2016-II' - H.L. will fix this in 'DeReKo-2017-I'):

281

# <s>

282

# ...

283

# <w id="f1306078.m10.t9" lemma="zu" type="APPRART">zur</w>

284

# <w id="f1306078.m10.t10" lemma="Kenntnis" type="NN">Kenntnis</w>

285

# <w id="f1306078.m10.t11" lemma="nehmen" type="VVINF">nehmen</w>

286

# <w id="f1306078.m10.t12" lemma="," type="$,">,</w>

287

# <w id="f1306078.m10.t13" lemma="dass" type="KOUS">dass</w>

288

# ...

289

# In the above example, the whitespace/blank information between the words is lost. The below perl subst. expression does not recognize, that there may not be a blank before a comma.

290

if(m/<[^>]+>[^<]/){

291

$tc++; # text counter

292

s/^(.)/ $1/ if $tc>1; # only add a blank, if this is not the first text in the whole text

}

# add line to buffer

$buf_in .= $_;

}elsif( $header_fl_txt && m/^(.*<\/idsHeader>)(.+)?$/ ){ # end of text header

299

#print STDERR "end of text header\n";

###

### write header.xml

###

$header_txt .= $1; $header_fl_txt = 0; $sfx=$2;

304

die "ERROR ($0): main(): input line number $lc: line with closing tag for 'idsHeader type=\"text\"' contains additional information ... => Aborting\n\tline=$_"

305

if defined $sfx && $sfx !~ /^\s*$/;

306

if( $dir eq "" ){

307

print STDERR "WARNING ($0): main(): input line number $lc: empty textSigle in text header => nothing to do ...\ntext header=$header_txt\n";

308

}else{

309

print STDERR "DEBUG ($0): Writing file $_root_dir$dir/$_header_file\n" if $_DEBUG;

310

# create zip buffer

311

if ($first_write){

312

$first_write=0;

Peter Harders

7025713

2020-02-13 13:47:55 +0100

[diff] [blame]

313

$zip = new IO::Compress::Zip $outh, Zip64 => 1, TextFlag => 1, Method => $_COMPRESSION_METHOD, Append => 0, Name => "$_root_dir$dir/$_header_file"

Peter Harders

d892a58

2020-02-12 15:45:22 +0100

[diff] [blame]

314

or die "ERROR ('$_root_dir$dir/$_header_file'): zip failed: $ZipError\n"

315

}else{

316

$zip->newStream( Zip64 => 1, TextFlag => 1, Method => $_COMPRESSION_METHOD, Append => 1, Name => "$_root_dir$dir/$_header_file" )

317

or die "ERROR ('$_root_dir$dir/$_header_file'): zip failed: $ZipError\n"

318

}

319

$header_txt=encode_utf8($header_txt);

320

$zip->print("$header_prfx$header_txt");

321

}

322

}elsif( $header_fl_txt ){ # inside text header

323

#print STDERR "inside text header\n";

324

if( m/^(.+)?<textSigle>([^<]+)(.+)$/ ){

325

$pfx=$1; $sfx=$3; $dir=$2; $text_id = $dir; $text_id =~ tr/\//_/; $dir =~ s/("|&|<|>)/$ent{$1}/g;

326

$text_id=encode_utf8($text_id); # otherwise problems with "wide character" where $text_id is printed (see e.g.: http://ahinea.com/en/tech/perl-unicode-struggle.html)

327

# see e.g.: Drukola-Project

328

die "ERROR ($0): main(): input line number $lc: line with textSigle-tag is not in expected format ... => Aborting\n\tline=$_"

329

if (defined $pfx && $pfx !~ /^\s*$/) || $sfx !~ /^<\/textSigle>\s*$/;

330

print STDERR "$0: main(): text_id=".decode_utf8($text_id)."\n"; # some output to see progression

331

$text_id_esc = $text_id;

332

if( $text_id_esc =~ s/("|&|<|>)/$ent{$1}/g ){

333

$_ =~ s/(<textSigle>)[^<]+(<\/textSigle>)/$1$dir$2/; # do be consistent with escaping, escape also textSigle in Text-Header

}

$dir =~ tr/\./\//;

}

$header_txt .= $_;

}elsif( $header_fl_doc && m/^(.*<\/idsHeader>)(.+)?$/ ){ # end of document header

339

#print STDERR "end of doc header\n";

340

$header_doc .= $1; $header_fl_doc = 0; $sfx=$2;

341

die "ERROR ($0): main(): input line number $lc: line with closing tag for 'idsHeader type=\"document\"' contains additional information ... => Aborting\n\tline=$_"

342

if defined $sfx && $sfx !~ /^\s*$/;

343

if( $dir_doc eq "" ){

344

print STDERR "WARNING ($0): main(): input line number $lc: empty document sigle in document header => nothing to do ...\ndocument header=$header_doc\n";

345

}else{

346

print STDERR "DEBUG ($0): Writing file $_root_dir$dir_doc/$_header_file\n" if $_DEBUG;

347

if ($first_write){

348

$first_write=0;

Peter Harders

7025713

2020-02-13 13:47:55 +0100

[diff] [blame]

349

$zip = new IO::Compress::Zip $outh, Zip64 => 1, TextFlag => 1, Method => $_COMPRESSION_METHOD, Append => 0, Name => "$_root_dir$dir_doc/$_header_file"

Peter Harders

d892a58

2020-02-12 15:45:22 +0100

[diff] [blame]

350

or die "ERROR ('$_root_dir$dir_doc/$_header_file'): zip failed: $ZipError\n"

351

}else{

352

$zip->newStream( Zip64 => 1, TextFlag => 1, Method => $_COMPRESSION_METHOD, Append => 1, Name => "$_root_dir$dir_doc/$_header_file" )

353

or die "ERROR ('$_root_dir$dir_doc/$_header_file'): zip failed: $ZipError\n"

354

}

355

$header_doc=encode_utf8($header_doc);

356

$zip->print("$header_prfx$header_doc");

357

}

358

}elsif( $header_fl_doc ){ # inside document header

359

#print STDERR "inside doc header\n";

360

if( m/^(.+)?<dokumentSigle>([^<]+)(.+)$/ ){

361

$pfx=$1; $sfx=$3; $dir_doc=$2;

362

die "ERROR ($0): main(): input line number $lc: line with dokumentSigle-tag is not in expected format ... => Aborting\n\tline=$_"

363

if (defined $pfx && $pfx !~ /^\s*$/) || $sfx !~ /^<\/dokumentSigle>\s*$/;

364

if( $dir_doc =~ s/("|&|<|>)/$ent{$1}/g ){

365

$_ =~ s/(<dokumentSigle>)[^<]+(<\/dokumentSigle>)/$1$dir_doc$2/; # do be consistent with escaping, escape also textSigle in Document-Header

}

}

$header_doc .= $_;

}elsif ( m/^.*(<idsHeader[^>]*type=\"text\".*)$/ ){ # begin of text header

370

#print STDERR "begin of text header\n";

371

$tc=0; ### reset (needed for whitespace-handling)

372

$header_txt = "$1\n"; $header_fl_txt = 1;

373

}elsif( m/^(.+)?<text(?: [^>]*)?>(.+)?$/ ){ # begin of text body

374

#print STDERR "inside text body\n";

375

$pfx=$1; $sfx=$2;

376

die "ERROR ($0): main(): input line number $lc: line with opening tag for 'text' contains additional information ... => Aborting\n\tline=$_"

377

if (defined $pfx && $pfx !~ /^\s*$/) || (defined $sfx && $sfx !~ /^\s*$/);

378

$data_fl=1;

379

}elsif ( m/^.*(<idsHeader[^>]*type=\"document\".*)$/ ){ # begin of document header

380

#print STDERR "begin of doc header\n";

381

$header_doc = "$1\n"; $header_fl_doc = 1;

382

}elsif( $header_fl_crp && m/^(.*<\/idsHeader>)(.+)?$/ ){ # end of corpus header

383

#print STDERR "end of corp header\n";

384

$header_crp .= $1; $header_fl_crp = 0; $sfx=$2;

385

die "ERROR ($0): main(): input line number $lc: line with closing tag for 'idsHeader type=\"corpus\"' contains additional information ... => Aborting\n\tline=$_"

386

if defined $sfx && $sfx !~ /^\s*$/;

387

if( $dir_crp eq "" ){

388

print STDERR "WARNING ($0): main(): input line number $lc: empty corpus sigle in corpus header => nothing to do ...\ncorpus header=$header_crp\n";

389

}else{

390

print STDERR "DEBUG ($0): Writing file $_root_dir$dir_crp/$_header_file\n" if $_DEBUG;

391

if ($first_write){

392

$first_write=0;

Peter Harders

7025713

2020-02-13 13:47:55 +0100

[diff] [blame]

393

$zip = new IO::Compress::Zip $outh, Zip64 => 1, TextFlag => 1, Method => $_COMPRESSION_METHOD, Append => 0, Name => "$_root_dir$dir_crp/$_header_file"

Peter Harders

d892a58

2020-02-12 15:45:22 +0100

[diff] [blame]

394

or die "ERROR ('$_root_dir$dir_crp/$_header_file'): zip failed: $ZipError\n"

395

}else{

396

$zip->newStream( Zip64 => 1, TextFlag => 1, Method => $_COMPRESSION_METHOD, Append => 1, Name => "$_root_dir$dir_crp/$_header_file" )

397

or die "ERROR ('$_root_dir$dir_crp/$_header_file'): zip failed: $ZipError\n"

398

}

399

$header_crp=encode_utf8($header_crp);

400

$zip->print("$header_prfx$header_crp");

401

}

402

}elsif( $header_fl_crp ){ # inside corpus header

403

#print STDERR "inside corp header\n";

404

if( m/^(.+)?<korpusSigle>([^<]+)(.+)$/ ){

405

$pfx=$1; $sfx=$3; $dir_crp=$2;

406

die "ERROR ($0): main(): input line number $lc: line with korpusSigle-tag is not in expected format ... => Aborting\n\tline=$_"

407

if (defined $pfx && $pfx !~ /^\s*$/) || $sfx !~ /^<\/korpusSigle>\s*$/;

408

if( $dir_crp =~ s/("|&|<|>)/$ent{$1}/g ){

409

$_ =~ s/(<korpusSigle>)[^<]+(<\/korpusSigle>)/$1$dir_crp$2/; # do be consistent with escaping, escape also textSigle in Corpus-Header

}

}

$header_crp .= $_;

}elsif ( m/^.*(<idsHeader[^>]*type=\"corpus\".*)$/ ){ # begin of corpus header

414

#print STDERR "begin of corp header\n";

415

$header_crp = "$1\n"; $header_fl_crp = 1;

}

###

}#end: while

if( $_GEN_TOK_BAS ){

close($chld_in);

close($chld_out);

}

$zip->close();

######

###### SUBS

######

#

# $reader = XML::LibXML::Reader->new(IO => STDIN);

432

# $data = XML::CompactTree::XS::readSubtreeToPerl($reader, XCT_DOCUMENT_ROOT|XCT_IGNORE_WS|XCT_IGNORE_SIGNIFICANT_WS|XCT_IGNORE_COMMENTS);

433

#

434

# example: <node a=\"v\"><node1>some <n/> text</node1><node2>more-text</node2></node>

435

#

436

# ( print out values of above example: 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_WS|XCT_IGNORE_SIGNIFICANT_WS|XCT_IGNORE_COMMENTS|XCT_LINE_NUMBERS);print $data->[2]->[0]->[5]->[1]->[1]' )

437

#

438

# $data = reference to below array

439

#

440

# [ 0: XML_READER_TYPE_DOCUMENT,

441

# 1: ?

442

# 2: [ 0: [ 0: XML_READER_TYPE_ELEMENT

443

# 1: 'node'

444

# 2: ?

445

# 3: HASH (attributes)

446

# 4: 1 (line number)

447

# 5: [ 0: [ 0: XML_READER_TYPE_ELEMENT

448

# 1: 'node1'

449

# 2: ?

450

# 3: undefined (no attributes)

451

# 4: 1 (line number)

452

# 5: [ 0: [ 0: XML_READER_TYPE_TEXT

453

# 1: 'some '

454

# ]

455

# 1: [ 0: XML_READER_TYPE_ELEMENT

456

# 1: 'n'

457

# 2: ?

458

# 3: undefined (no attributes)

459

# 4: 1 (line number)

460

# 5: undefined (no child nodes)

461

# ]

462

# 2: [ 0: XML_READER_TYPE_TEXT

# 1: ' text'

# ]

# ]

# ]

# 1: [ 0: XML_READER_TYPE_ELEMENT

468

# 1: 'node2'

469

# 2: ?

470

# 3: undefined (not attributes)

471

# 4: 1 (line number)

472

# 5: [ 0: [ 0: XML_READER_TYPE_TEXT

# 1: 'more-text'

# ]

# ]

# ]

# ]

# ]

# ]

# ]

#

# $data->[0] = 9 (=> type == XML_READER_TYPE_DOCUMENT)

483

#

484

# ref($data->[2]) == ARRAY (with 1 element for 'node')

485

# ref($data->[2]->[0]) == ARRAY (with 6 elements)

486

#

487

# $data->[2]->[0]->[0] == 1 (=> type == XML_READER_TYPE_ELEMENT)

488

# $data->[2]->[0]->[1] == 'node'

489

# ref($data->[2]->[0]->[3]) == HASH (=> ${$data->[2]->[0]->[3]}{a} == 'v')

490

# $data->[2]->[0]->[4] == 1 (line number)

491

# ref($data->[2]->[0]->[5]) == ARRAY (with 2 elements for 'node1' and 'node2') NOTE: child nodes of actual node (see $_IDX)

492

#

493

# ref($data->[2]->[0]->[5]->[0]) == ARRAY (with 6 elements)

494

# $data->[2]->[0]->[5]->[0]->[0] == 1 (=> type == XML_READER_TYPE_ELEMENT)

495

# $data->[2]->[0]->[5]->[0]->[1] == 'node1'

496

# $data->[2]->[0]->[5]->[0]->[3] == undefined (=> no attribute)

497

# $data->[2]->[0]->[5]->[0]->[4] == 1 (line number)

498

# ref($data->[2]->[0]->[5]->[0]->[5]) == ARRAY (with 3 elements for 'some ', '<n/>' and ' text')

499

#

500

# ref($data->[2]->[0]->[5]->[0]->[5]->[0]) == ARRAY (with 2 elements)

501

# $data->[2]->[0]->[5]->[0]->[5]->[0]->[0] == 3 (=> type == XML_READER_TYPE_TEXT)

502

# $data->[2]->[0]->[5]->[0]->[5]->[0]->[1] == 'some '

503

#

504

# ref($data->[2]->[0]->[5]->[0]->[5]->[1]) == ARRAY (with 5 elements)

505

# $data->[2]->[0]->[5]->[0]->[5]->[1]->[0] == 1 (=> type == XML_READER_TYPE_ELEMENT)

506

# $data->[2]->[0]->[5]->[0]->[5]->[1]->[1] == 'n'

507

# $data->[2]->[0]->[5]->[0]->[5]->[1]->[3] == undefined (=> no attribute)

508

# $data->[2]->[0]->[5]->[0]->[5]->[1]->[4] == 1 (line number)

509

# $data->[2]->[0]->[5]->[0]->[5]->[1]->[5] == undefined (=> no child nodes)

510

#

511

# ref($data->[2]->[0]->[5]->[0]->[5]->[2]) == ARRAY (with 2 elements)

512

# $data->[2]->[0]->[5]->[0]->[5]->[2]->[0] == 3 (=> type == XML_READER_TYPE_TEXT)

513

# $data->[2]->[0]->[5]->[0]->[5]->[2]->[1] == ' text'

514

#

515

#

516

# NOTE: the sub 'retr_info' starts with the array reference '${$_[0]}' (= '\$tree_data->[2]'), which corresponds to '${\$data->[2]}' in the above example.

517

# Hence, the expression '@{${$_[0]}}' corresponds to '@{${\$data->[2]}', '$e' to '${${\$data->[2]}}[0]' (='$data->[2]->[0]') and '$e->[0]' to '${${\$data->[2]}}[0]->[0]' (='$data->[2]->[0]->[0]'.

sub retr_info{

$rl++; # rec. level (2 = topmost level inside retr_info() = level for all elements directly under <text>)

522

523

# $_[0] is a reference to an array reference

524

foreach $e( @{${$_[0]}} ){ # iteration through all array elements

525

526

## http://search.cpan.org/~shlomif/XML-LibXML-2.0118/lib/XML/LibXML/Reader.pod#NODE_TYPES

527

if( $e->[0] == XML_READER_TYPE_ELEMENT ){ # element node

528

529

### . insert new array (for new tag) into @structures with tag-name and (if present) tag-attributes

530

### . update @oti (open tags indizes) with @structures highest index (=$#structures); e.g.: @a=(1,2,3) => $#a = 2

531

###

532

$n = $e->[1]; # name of tag

533

534

$inside_annot_tag = $rl if $_ANNOT_GEN && $n eq "$_ANNOT_TAG_NAME_RD";

535

536

my @array;

537

push @array, $n; # name of tag

538

push @structures, \@array;

539

540

push @oti, $#structures; # add highest index of @structures to @oti

541

542

if( $_ANNOT_GEN && $inside_annot_tag == $rl ){

543

my @array2;

544

push @array2, $n;

545

push @annot, \@array2;

push @oti2, $#annot;

}

### handle attributes

550

if( defined $e->[3] ){ # only go on if attributes exist

551

for( $c = 0; $c < @{$e->[3]}; $c += 2 ){ # with 'XCT_ATTRIBUTE_ARRAY', $node->[3] is an array reference of the form [ name1, value1, name2, value2, ....]

552

# of attribute names and corresponding values. NOTE: arrays are faster! (see: http://makepp.sourceforge.net/2.0/perl_performance.html)

553

554

# '$c' references the 'key' and '$c+1' the 'value' (example: perl -e '@a=(X,Y);push @b,\@a;$ref=$b[$#b];push @{$ref},Z;print @{$ref}' => XYZ)

555

push @{$structures[$#structures]}, ${$e->[3]}[$c], ${$e->[3]}[$c+1];

556

557

if( $_ANNOT_GEN && $inside_annot_tag == $rl ){

558

push @{$annot[$#annot]}, ${$e->[3]}[$c], ${$e->[3]}[$c+1];

}

}

}

###

push @{$structures[$#structures]}, ($dl+$add_one); # from-value

565

566

if( $_ANNOT_GEN && $inside_annot_tag == $rl ){

567

push @{$annot[$#annot]}, ($dl+$add_one);

}

######

# until here: opening tag-node

######

### RECURSION

if(defined $e->[$_IDX]){ # if $e->[$_IDX] is not defined (=> no array of child nodes, e.g.: <pb id="bka.00001-643-pb643" n="643" TEIform="pb"/>), do no recursion

576

577

retr_info( \$e->[$_IDX] ); # recursion with array of child nodes

578

579

$rl--; # return from recursion

}

###

######

# from here: closing tag-node

585

######

586

#print STDERR "2: dl=$dl\n" if $text_id eq "BIH_BKA.00001";

587

#

588

{ my $ix = pop @oti;

589

my $aix = @{$structures[$ix]};

590

$fval = ${$structures[$ix]}[$aix-1]; # from-value

591

592

# whitespace related issue

593

if( $fval>0 && not exists $hws{$fval-1} ){

594

# previous node was a text-node

595

${$structures[$ix]}[$aix-1] = $fval-1; # recorrect from-value

}

#

die "ERROR ($0, retr_info()): text_id='$text_id', processing of \@structures: from-value ($fval) is more than 1 greater than to-value ($dl) => please check. aborting ...\n" if ($fval-1) > $dl;

600

${$structures[$ix]}[$aix-1] = $dl if $fval == $dl+1; # correct from-value

601

602

push @{$structures[$ix]}, $dl, $rl; # to-value and recursion-level

603

### use $dl, because the offsets are _between_ the characters (e.g.: word = 'Hallo' => from = 0 (before 'H'), to = 5 (after 'o'))

604

}

605

606

if ( $_ANNOT_GEN && $inside_annot_tag == $rl ){

607

my $ix = pop @oti2;

608

my $aix = @{$annot[$ix]};

609

$fval2 = ${$annot[$ix]}[$aix-1]; # from-value

610

611

# whitespace related issue

612

if( $fval2>0 && not exists $hws{$fval2-1} ){

613

# previous node was a text-node

614

${$annot[$ix]}[$aix-1] = $fval2-1; # recorrect from-value

}

#

die "ERROR ($0, retr_info()): text_id='$text_id', processing of \@annot: from-value ($fval2) is more than 1 greater than to-value ($dl) => please check. aborting ...\n" if ($fval2-1) > $dl;

619

${$annot[$ix]}[$aix-1] = $dl if $fval2 == $dl+1; # correct from-value

620

621

push @{$annot[$ix]}, $dl, $rl; # to-value and recursion-level

622

$inside_annot_tag = -1; # reset

623

}

624

625

# whitespace related issue

626

# clean up

627

delete $hws{$fval-1} if $fval>0 && exists $hws{$fval-1};

628

delete $hws{$fval2-1} if $_ANNOT_GEN && $fval2>0 && exists $hws{$fval2-1};

#

######

# from here: text nodes

633

######

634

}elsif( $e->[0] == XML_READER_TYPE_TEXT || $e->[0] == XML_READER_TYPE_SIGNIFICANT_WHITESPACE ){ # see 'man XML::LibXML::Reader'

635

636

# set flag, to remember to add 1 to 'from'-$dl (see above), if this text-node was _not_ a whitespace-node

637

# NOTE: this is needed to address e.g. the following situation (see first text in goe-corpus):

638

# '... <head type="main"><s>Campagne in Frankreich</s></head><head type="sub"> <s>1792</s> ...': the from-index of the 2nd head-tag

639

# should be right before '1792' (which was produced by a text-node) and not before the ' ' (which was produced by a whitespace-node)

640

# by the way: '$add_one' is not set (resp. 're'-set) for whitespace-nodes, because they always (incidentally) set '$dl' to the right

641

# from-index of the next node (e.g.: '<w>fu</w> <w>bar</w>' or '<w>fu</w><w> </w><w>bar</w>) - this is actually not the case for

642

# text-nodes (see same previous 'fubar'-example), for which '$dl' points to the from-index of ' ', _IF_ there is alway a ' ' between

643

# two text-nodes.

644

# NOTE: A new problem arises with this approach, _IF_ there is _NOT_ a ' ' between two text-nodes

645

# (see e.g. in romanian corpus 'corola-bucurenci': ... >Anului</w><w lemma="," ana="PUNCTUATION">,</w> <w ...).

646

# In this case, the from-index for the next node would be exactly 1 to high (see in approp. zip-file for above example:

647

# '... ...' - the correct span should be: '... ...').

648

# NOTE: it's not possible to solve the above problem here, because the following case would not be covered:

649

# ... <a><c><d/></c></a> ... (or see in goe-corpus 'GOE/AGI.04846': <div...></div> ...)

650

# Because, no text- and whitespace-nodes are present, the from-values for 'a', 'b' and 'c' can only be corrected, when closing these tags.

651

# But this can be easily done by looking at the actual value of '$add_one' - if it's set, then there was no whitespace-node (and hence no ' ')

652

# before '<a>' and hence the from-values must be corrected.

653

# NOTE: To realize, what's stated in the above note, another information is needed, by which can be checked, if a tag contains text/ws or not

654

# (in the above 'abcd'-example, all tags are empty in the sense of that they don't contain any text/ws).

655

# By saving the recursion level, the 'text containing'-info can be simply checked, by the condition '$last_text_or_ws_node > $rl'.

656

# The condition is true, when there is text below the tag on level $rl.

657

##$last_text_or_ws_node = $rl;

658

# NOTE: a much simpler solution, which should have the same effect, without following exactly the information-processing, is, to just set the

659

# value of the 'from'-index to the value of the 'to'-index, if "to==from-1" holds and to die with an error, if "(from-1)>to" holds.

660

661

# whitespace related issue

662

if( $e->[0] == XML_READER_TYPE_SIGNIFICANT_WHITESPACE ){

663

$add_one=0;

664

$hws{$dl}++; # '++' does not mean a thing here (could be used for consistency checking)

}else{ # text-node

$add_one=1;

}

#

$data .= $e->[1];

$dl += length($e->[1]);

672

673

### needed only for dummy tokenization

674

if( $_GEN_TOK_DUMMY ){

675

$txt = $e->[1];

676

if( (substr($txt,0,1) ne ' ' || substr($txt,1,1) ne ' ') ){ # $txt has at least 2 chars, if it is not empty or equal to ' '

677

678

### start: conservative tokenization

679

# '\p{Punct}' is equal to the character class '[-!"#%&'()*,./:;?@[\\\]_{}]'

680

while( $txt =~ /([\p{Punct}]*)([^\p{Punct} \x{9}\n]+(?:([\p{Punct}]+)[^\p{Punct} \x{9}\n]+)*)?([\p{Punct}]*)(?:[ \x{9}\n])?/g ){

681

682

$m1=$1; $m2=$2; $m3=$3; $m4=$4;

683

684

#print STDERR "*** m1=$1, m2="; (defined $m2)?(print STDERR "$2"):(print STDERR "undef");print STDERR ", m3="; (defined $3)?(print STDERR "$3"):(print STDERR "undef"); print STDERR ", m4=$4\n";

685

if("$m1" ne ""){ # special chars before token

686

$p1=$-[1]; $p2=$+[1];

687

#print STDERR "A1: ".$m1." -> from $p1 to $p2\n";

688

if($p2==$p1+1){

689

if($p1!=0){$tmp=substr($txt,$p1-1,1);$pr=($tmp=~/^[^A-Za-z0-9]/)}else{$pr=0};

690

if(not $pr){$tmp=substr($txt,$p2,1);$pr=($tmp=~/^[^A-Za-z0-9]/)};

691

if($pr){push @tok_tokens_con, $p1+$offset; push @tok_tokens_con, $p2+$offset}; # from and to

692

}else{

693

for($i=0;$i<($p2-$p1);$i++){

694

#print STDERR "A2: ".substr($m1,$i,1)." -> from $p1 to $p2\n";

695

push @tok_tokens_con, $p1+$i+$offset; push @tok_tokens_con, $p1+$i+1+$offset; # from and to

}

}

}# "$m1" ne ""

#print STDERR "B: "."$m2 -> from ".($-[2]+$offset)." to ".($+[2]+$offset)."\n" if defined $m2; # token (wordform)

700

701

if(defined $m2){push @tok_tokens_con, $-[2]+$offset; push @tok_tokens_con, $+[2]+$offset}; # from and to

702

703

if(defined $m3){

704

$p1=$-[3]; $p2=$+[3];

705

#print STDERR "C: ".$m3." -> from $p1 to $p2\n";

706

if($p2==$p1+1){

707

$tmp=substr($txt,$p2,1);$pr=($tmp=~/^$/);$pr=($tmp=~/^[^A-Za-z0-9]/) if not $pr; # char after match

708

if(not $pr){$tmp=substr($txt,$p1-1,1);$pr=($tmp=~/^[^A-Za-z0-9]/)}; # char before match

709

if($pr){push @tok_tokens_con, $p1+$offset; push @tok_tokens_con, $p2+$offset}; # from and to

710

}else{ # length($m3)>1 => print all chars

711

for($i=0; $i<($p2-$p1); $i++){

712

#$tmp=substr($m3,$i,1);

713

#print STDERR "C2: $tmp -> from $p1 to $p2\n";

714

push @tok_tokens_con, $p1+$i+$offset; push @tok_tokens_con, $p1+$i+1+$offset; # from and to

}

}

}# defined $m3

if("$m4" ne ""){ # special chars after token

720

$p1=$-[4]; $p2=$+[4];

721

#print STDERR "D1: ".$m4." -> from ".($p1+$offset)." to ".($p2+$offset)."\n";

722

if($p2==$p1+1){

723

$tmp=substr($txt,$p2,1);$pr=($tmp=~/^$/);$pr=($tmp=~/^[^A-Za-z0-9]/) if not $pr; # char after match

724

if(not $pr){$tmp=substr($txt,$p1-1,1);$pr=($tmp=~/^[^A-Za-z0-9]/)}; # char before match

725

if($pr){push @tok_tokens_con, $p1+$offset; push @tok_tokens_con, $p2+$offset} # from and to

726

}else{

727

for($i=0;$i<($p2-$p1);$i++){

728

#print STDERR "D2: ".substr($m4,$i,1)." -> from ".($p1+$i+$offset)." to ".($p1+$i+1+$offset)."\n";

729

push @tok_tokens_con, $p1+$i+$offset; push @tok_tokens_con, $p1+$i+1+$offset; # from and to

}

}

}# "$m4" ne ""

}# end: while

### end: conservative tokenization

736

737

### start: aggressive tokenization

738

while( $txt =~ /([^\p{Punct} \x{9}\n]+)(?:([\p{Punct}])|(?:[ \x{9}\n])?)|([\p{Punct}])/g ){

739

if(defined $1){

740

push @tok_tokens_agg, $-[1]+$offset; push @tok_tokens_agg, $+[1]+$offset; # from and to

741

if(defined $2){push @tok_tokens_agg, $-[2]+$offset; push @tok_tokens_agg, $+[2]+$offset} # from and to

742

}else{ # defined $3

743

push @tok_tokens_agg, $-[3]+$offset; push @tok_tokens_agg, $+[3]+$offset # from and to

744

}

745

}# end: while

746

### end: aggressive tokenization

#$offset = $dl+1;

$offset = $dl;

}

}

###

# }#fi

#print STDERR "1: dl=$dl\n" if $text_id eq "BIH_BKA.00001";

756

757

758

# elsif( $e->[0] == XML_READER_TYPE_ATTRIBUTE ) # attribute node

759

# NOTE: attributes cannot be processed like this

760

761

### from here: should not really happen

762

763

}else{ # not yet handled type

764

765

die "ERROR ($0): Not yet handled type (\$e->[0]=".$e->[0].") ... => Aborting\n";

}

}#end: foreach iteration

}#end: sub retr_info

sub write_tok { # called from MAIN

775

776

#print STDERR "$0: write_tok() ...\n";

777

778

if( $_GEN_TOK_BAS ) {

779

if( $select->can_read(3600) ){ # wait 60m for external tokenizer

780

$_ = <$chld_out>;

781

my @bounds = split;

782

write_tokenization("$_root_dir$dir/$_base_dir/$_tok_file_bas", $text_id_esc, \@bounds);

783

while($select->can_read(0)) {

784

$_ = <$chld_out>;

785

if (defined $_ && $_ ne '') {

786

print STDERR "WARNING: extra output: $_\n"

787

} else {

788

print STDERR "WARNING: tokenizer seems to have crashed, restarting.\n";

startTokenizer();

}

}

}else{

$zip->close();

die "ERROR ($0): cannot retrieve token bounds from external tokenizer for text '$text_id' => Aborting ...\n";

795

}

796

}elsif( $_GEN_TOK_DUMMY ){

797

write_tokenization("$_root_dir$dir/$_base_dir/$_tok_file_con", $text_id_esc, \@tok_tokens_con);

798

write_tokenization("$_root_dir$dir/$_base_dir/$_tok_file_agg", $text_id_esc, \@tok_tokens_agg);

799

}

800

#print STDERR "$0: write_tok(): DONE\n";

801

} # end: write_tok

802

803

sub write_tokenization {

804

my ($fname, $textid_esc, $bounds) = @_;

805

806

$zip->newStream( Zip64 => 1, TextFlag => 1, Method => $_COMPRESSION_METHOD, Append => 1, Name => $fname)

807

or die "ERROR ('$fname'): zip failed: $ZipError\n";

808

$output = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<?xml-model href=\"span.rng\" type=\"application/xml\" schematypens=\"http://relaxng.org/ns/structure/1.0\"?>\n\n<layer docid=\"$text_id_esc\" xmlns=\"http://ids-mannheim.de/ns/KorAP\" version=\"KorAP-0.4\">\n <spanList>\n";

809

$c=0; for( $i=0; $i < ($#$bounds + 1); $i+=2 ){

810

$output .= " [$i]."\" to=\"".$bounds->[$i+1]."\" />\n";

811

$c++;

812

}

813

$output .= " </spanList>\n</layer>";

814

$zip->print("$output");

815

}

816

817

# write structure file

818

sub write_structures { # called from MAIN

819

820

#print STDERR "$0: write_structures(): ...\n";

821

822

if( $dir eq "" ){

823

print STDERR "WARNING ($0): write_structures(): empty textSigle => nothing to do ...\n";

return;

}

$zip->newStream( Zip64 => 1, TextFlag => 1, Method => $_COMPRESSION_METHOD, Append => 1, Name => "$_root_dir$dir/$_structure_dir/$_structure_file" )

828

or die "ERROR ('$_root_dir$dir/$_structure_dir/$_structure_file'): zip failed: $ZipError\n";

829

830

$output = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<?xml-model href=\"span.rng\" type=\"application/xml\" schematypens=\"http://relaxng.org/ns/structure/1.0\"?>\n\n<layer docid=\"".decode_utf8($text_id_esc)."\" xmlns=\"http://ids-mannheim.de/ns/KorAP\" version=\"KorAP-0.4\">\n <spanList>\n";

$c = 0;

foreach $ref (@structures){

835

836

(@{$ref}==4)?($idx=1):($idx=@{$ref}-3); # if array '@{$ref}' doesn't contain attributes, then the number of elements in this array is 4 (name, from, to, rec_level), otherwise >4

837

838

### correct last from-value (if the 'second to last' from-value refers to an s-tag, then the last from-value is one to big - see retr_info)

839

if( $#structures == $c && ${$ref}[$idx] == ${$ref}[$idx+1] + 1 ){

840

${$ref}[$idx] = ${$ref}[$idx+1];

841

}

842

## this consistency check is already done in 'retr_info()'

843

##elsif( ${$ref}[$idx] > ${$ref}[$idx+1] ){ # consistency check: abort, if this doesn't hold

844

## #die "ERROR ($0: write_structures(): \$text_id=$text_id, \$c=$c, tag-name=${$ref}[0]): 'from-index=${$ref}[$idx]' > 'to-index=${$ref}[$idx+1]' => please check! aborting ...\n";

845

## die "ERROR ($0: write_structures(): \$text_id=$text_id, \$c=$c, tag-name=${$ref}[0]): 'from-index=${$ref}[$idx]' > 'to-index=${$ref}[$idx+1]' => please check! aborting ...\n\n$output";

##}

###

### at least 'POS' should always be there => remove constraint '$_ANNOT_GEN'

850

#if( $_ANNOT_GEN && ${$ref}[0] ne "$_ANNOT_TAG_NAME_RD" ){ # this is already written in 'write_annot', so don't do it twice

851

if( ${$ref}[0] ne "$_ANNOT_TAG_NAME_RD" ){ # this is already written in 'write_annot', so don't do it twice

852

853

$output .= " \n"; # l (level): insert information about depth of element in XML-tree (top element = level 1)

854

$output .= " <fs type=\"struct\" xmlns=\"http://www.tei-c.org/ns/1.0\">\n";

855

$output .= " <f name=\"name\">${$ref}[0]</f>\n";

856

857

if ( $idx > 2 ) # attributes

858

{

859

$output .= " <f name=\"attr\">\n <fs type=\"attr\">\n";

860

861

for ( $att_idx=1; $att_idx < $idx; $att_idx+=2 ){

862

${$ref}[$att_idx+1] =~ s/(&|<|>)/$ent{$1}/g; # see explanation in func. 'write_annot'

863

$output .= " <f name=\"${$ref}[$att_idx]\">${$ref}[$att_idx+1]</f>\n"; # attribute (at index $att_idx) with value (at index $att_idx+1)

864

}

865

866

$output .= " </fs>\n </f>\n";

867

}

868

869

$output .= " </fs>\n \n";

}

$c++;

}# end: foreach

$output .= " </spanList>\n</layer>";

878

879

$output=encode_utf8($output);

880

881

$zip->print("$output");

882

883

#print STDERR "$0: write_structures(): DONE\n";

884

} # end: sub write_structures

885

886

887

sub write_annot { # called from MAIN

888

#print STDERR "$0: write_annot(): ...\n";

889

890

if( $dir eq "" ){

891

print STDERR "WARNING ($0): write_annot(): empty textSigle => nothing to do ...\n";

return;

}

$zip->newStream( Zip64 => 1, TextFlag => 1, Method => $_COMPRESSION_METHOD, Append => 1, Name => "$_root_dir$dir/$_ANNOT_DIR_NAME/$_ANNOT_FILE_NAME" )

896

or die "ERROR ('$_root_dir$dir/$_ANNOT_DIR_NAME/$_ANNOT_FILE_NAME'): zip failed: $ZipError\n";

897

898

$output = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<?xml-model href=\"span.rng\" type=\"application/xml\" schematypens=\"http://relaxng.org/ns/structure/1.0\"?>\n\n<layer docid=\"".decode_utf8($text_id_esc)."\" xmlns=\"http://ids-mannheim.de/ns/KorAP\" version=\"KorAP-0.4\">\n <spanList>\n";

$c = 0;

#open H1, ">/tmp/t456" if $text_id eq "GOE_AGA.00000";

903

foreach $ref (@annot){

904

905

#if($text_id eq "GOE_AGA.00000"){

906

#foreach my $key(@{$ref}){print H1 " $c:$key"};

907

#print H1 "\n";

908

#}

909

(@{$ref}==4)?($idx=1):($idx=@{$ref}-3); # if array '@{$ref}' doesn't contain attributes, then the number of elements in this array is 4 (name, from, to, rec_level), otherwise >4

910

911

### correct last from-value (if the 'second to last' from-value refers to a s-tag, then the last from-value is one to big - see retr_info)

912

if( $#annot == $c && ${$ref}[$idx] == ${$ref}[$idx+1] + 1 ){

913

${$ref}[$idx] = ${$ref}[$idx+1];

}

###

$output .= " \n"; # l (level): insert information about depth of element in XML-tree (top element = level 1)

918

$output .= " <fs type=\"lex\" xmlns=\"http://www.tei-c.org/ns/1.0\">\n";

919

##$output .= " <f name=\"${$ref}[0]\">\n";

920

$output .= " <f name=\"lex\">\n";

921

922

if ( $idx > 2 ) # attributes

923

{

924

$output .= " <fs>\n";

925

926

for ( $att_idx=1; $att_idx < $idx; $att_idx+=2 ){

927

928

${$ref}[$att_idx+1] =~ s/(&|<|>)/$ent{$1}/g; # e.g.: look for 4th occurence of '…' in '84030_a_82705' in Drukola-Korpus 'corola-bucurenci':

929

# ... <w lemma=">" ana="PUNCTUATION">></w> ...

930

# - the '>' is translated to '>' and hence the result would be '<f name="lemma">></f>'

931

932

if( "$_ANNOT_ATT_ANNOT_NAME_RD" && ${$ref}[$att_idx] eq "$_ANNOT_ATT_ANNOT_NAME_RD" ){

933

934

${$ref}[$att_idx+1] =~ /^([^ ]+)(?: (.+))?$/;

935

die "ERROR (write_annot()): unexpected format! => Aborting ... (att: ${$ref}[$att_idx+1])\n" if ($_ANNOT_ATT_POS_NAME_WR && not defined $1) || ($_ANNOT_ATT_MSD_NAME_WR && not defined $2);

936

if( "$_ANNOT_ATT_POS_NAME_WR" ){

937

$output .= " <f name=\"$_ANNOT_ATT_POS_NAME_WR\">";

938

$output .= "$1" if defined $1;

939

$output .= "</f>\n";

940

}

941

if( "$_ANNOT_ATT_MSD_NAME_WR" ){

942

$output .= " <f name=\"$_ANNOT_ATT_MSD_NAME_WR\">";

943

$output .= "$2" if defined $2;

$output .= "</f>\n";

}

}elsif( "$_ANNOT_ATT_LEM_NAME_RD" && ${$ref}[$att_idx] eq "$_ANNOT_ATT_LEM_NAME_RD" ){

948

949

$output .= " <f name=\"$_ANNOT_ATT_LEM_NAME_WR\">${$ref}[$att_idx+1]</f>\n";

950

951

}else{ # all other attributes

952

953

$output .= " <f name=\"${$ref}[$att_idx]\">${$ref}[$att_idx+1]</f>\n"; # attribute (at index $att_idx) with value (at index $att_idx+1)

}

} # end:for

$output .= " </fs>\n";

959

} # fi

960

961

$output .= " </f>\n </fs>\n \n";

$c++;

}# end: foreach

#close H1 if $text_id eq "GOE_AGA.00000";

967

968

$output .= " </spanList>\n</layer>";

969

970

$output=encode_utf8($output);

971

972

$zip->print("$output");

973

974

#print STDERR "$0: write_annot(): DONE\n";

975

976

} # end: sub write_annot

977

978

sub printhelp {

979

print STDERR <<EOHELP;

980

This program is called from inside another script.

EOHELP

exit();

}

sub startTokenizer {

$pid = open2($chld_out, $chld_in, 'java -cp '. join(":", ".", glob(&dirname(__FILE__)."/../target/*.jar"))." de.ids_mannheim.korap.tokenizer.KorAPTokenizerImpl");

987

$select = IO::Select->new();

988

$select->add(*$chld_out);

989

}