Add struct generation from sent_id and newpar comments in conllu2korapxml
Change-Id: I0edca9d8c9e79945615c90c85ee85fe4c101d446
diff --git a/Changes b/Changes
index 4f6fe20..0320c22 100644
--- a/Changes
+++ b/Changes
@@ -11,6 +11,8 @@
(implemented with AI assistance)
- Filter SpaceAfter/SpacesAfter from MISC column
(implemented with AI assistance)
+ - Add struct.xml generation from sent_id and newpar comments
+ (implemented with AI assistance)
0.6.3 2024-06-04
- Trim filenames to fix double space after filename metadata
diff --git a/script/conllu2korapxml b/script/conllu2korapxml
index 58f443c..75b63d2 100755
--- a/script/conllu2korapxml
+++ b/script/conllu2korapxml
@@ -84,6 +84,17 @@
# Buffer dependency arcs until all token offsets in a sentence are known
my @dep_buffer;
+# Struct layer tracking for sentence and paragraph spans
+my @sentence_spans;
+my @paragraph_spans;
+my $current_sent_id = '';
+my $pending_newpar_id = '';
+my $current_par_from = -1;
+my $last_sent_to = -1;
+my $has_sent_ids = 0;
+my $sent_counter = 0;
+my $par_counter = 0;
+
my ($write_morpho, $write_syntax, $base) = (1, 0, 0);
my @doc_texts;
my @token_spans;
@@ -128,6 +139,15 @@
@doc_texts = ();
@token_spans = ();
$token_counter = 0;
+ @sentence_spans = ();
+ @paragraph_spans = ();
+ $current_sent_id = '';
+ $pending_newpar_id = '';
+ $current_par_from = -1;
+ $last_sent_to = -1;
+ $has_sent_ids = 0;
+ $sent_counter = 0;
+ $par_counter = 0;
} elsif (/^#\s*newdoc\s+id\s*=\s*(.*)/ && $text_sigle_template) {
my $newdoc_id = $1;
$newdoc_id =~ s/\s+$//;
@@ -165,6 +185,15 @@
}
$known = $unknown = 0;
$current = "";
+ @sentence_spans = ();
+ @paragraph_spans = ();
+ $current_sent_id = '';
+ $pending_newpar_id = '';
+ $current_par_from = -1;
+ $last_sent_to = -1;
+ $has_sent_ids = 0;
+ $sent_counter = 0;
+ $par_counter = 0;
$morpho_file = "$text_sigle/$foundry_name/morpho.xml";
$parser_file = "$text_sigle/$dependency_foundry_name/dependency.xml";
@@ -216,6 +245,14 @@
$txt =~ s/\s+$//;
push @doc_texts, $txt;
}
+ } elsif (/^#\s*sent_id\s*=\s*(.*)/) {
+ $current_sent_id = $1;
+ $current_sent_id =~ s/\s+$//;
+ $has_sent_ids = 1;
+ } elsif (/^#\s*newpar(?:\s+id\s*=\s*(.*))?/) {
+ my $pid = defined($1) ? $1 : '';
+ $pid =~ s/\s+$//;
+ $pending_newpar_id = $pid || '__NEWPAR__';
}
} elsif ( !/^\s*$/ ) {
# Pre-split columns before offset computation needs the raw form
@@ -328,15 +365,17 @@
# Empty line = end of sentence
flush_dep_buffer();
if ($compute_offsets_mode) {
- # Advance doc offset past sentence + 1-char space separator
$doc_offset += length($sentence_text) + 1;
@spansFrom = ();
@spansTo = ();
$compute_offsets_mode = 0;
}
$sentence_text = '';
+ record_sentence_struct();
}
}
+ # Flush last sentence if input lacks trailing empty line
+ record_sentence_struct();
$current .= "\n";
closeDoc(1);
$zip->close() if $zip;
@@ -371,6 +410,22 @@
@dep_buffer = ();
}
+sub record_sentence_struct {
+ return unless $has_sent_ids && $current_sent_id && scalar @spansFrom > 0;
+ $sent_counter++;
+ push @sentence_spans, ["s$sent_counter", $spansFrom[0], $spansTo[0]];
+ if ($pending_newpar_id) {
+ if ($current_par_from >= 0 && $last_sent_to >= 0) {
+ $par_counter++;
+ push @paragraph_spans, ["p$par_counter", $current_par_from, $last_sent_to];
+ }
+ $current_par_from = $spansFrom[0];
+ $pending_newpar_id = '';
+ }
+ $last_sent_to = $spansTo[0];
+ $current_sent_id = '';
+}
+
sub closeDoc {
flush_dep_buffer();
if ($write_morpho && $morpho_file) {
@@ -414,6 +469,34 @@
newZipStream($tokens_path);
$zip->print($tokens_out, qq(</spanList>\n</layer>\n));
}
+ if ($has_sent_ids && $filename) {
+ if ($current_par_from >= 0 && $last_sent_to >= 0) {
+ $par_counter++;
+ push @paragraph_spans, ["p$par_counter", $current_par_from, $last_sent_to];
+ }
+ my $text_dir = dirname($filename);
+ $text_dir =~ s@(.*)/[^/]+$@$1@;
+ my $struct_path = "$text_dir/base/struct.xml";
+ my $struct = layer_header($docid);
+ my @all_spans;
+ for my $span (@sentence_spans) {
+ push @all_spans, [$span->[0], $span->[1], $span->[2], 's'];
+ }
+ for my $span (@paragraph_spans) {
+ push @all_spans, [$span->[0], $span->[1], $span->[2], 'p'];
+ }
+ @all_spans = sort { $a->[1] <=> $b->[1] || $a->[2] <=> $b->[2] } @all_spans;
+ for my $span (@all_spans) {
+ my ($id, $from, $to, $name) = @$span;
+ $struct .= qq( <span id="$id" from="$from" to="$to">\n)
+ . qq( <fs type="struct" xmlns="http://www.tei-c.org/ns/1.0">\n)
+ . qq( <f name="name">$name</f>\n)
+ . qq( </fs>\n)
+ . qq( </span>\n);
+ }
+ newZipStream($struct_path);
+ $zip->print($struct, qq(</spanList>\n</layer>\n));
+ }
}
sub layer_header {
diff --git a/t/ud_conllu.t b/t/ud_conllu.t
index 43bc67f..034cebe 100644
--- a/t/ud_conllu.t
+++ b/t/ud_conllu.t
@@ -43,6 +43,33 @@
CONLLU
+my $struct_data = <<'CONLLU';
+# filename = TEST/TEST/TEST_STR_001/base/tokens.xml
+# text_id = TEST_TEST.TEST_STR_001
+# newpar id = p1
+# sent_id = s1.1
+# start_offsets = 0 0 6 11
+# end_offsets = 12 5 11 12
+1 Geras geras ADJ bdv. Case=Nom 2 amod _ _
+2 rytas rytas NOUN dkt. Case=Nom 0 root _ _
+3 . . PUNCT skyr. _ 2 punct _ SpaceAfter=No
+
+# sent_id = s1.2
+# start_offsets = 12 13 18 24
+# end_offsets = 25 17 24 25
+1 Kaip kaip ADV prv. _ 2 advmod _ _
+2 sekasi sektis VERB vksm. _ 0 root _ SpaceAfter=No
+3 ? ? PUNCT skyr. _ 2 punct _ _
+
+# newpar id = p2
+# sent_id = s2.1
+# start_offsets = 25 26 32
+# end_offsets = 39 31 39
+1 Labas labas ADJ bdv. Case=Nom 0 root _ _
+2 vakaras vakaras NOUN dkt. Case=Nom 1 nmod _ _
+
+CONLLU
+
my $test_tempdir = tempdir();
my $offset_file = "$test_tempdir/test_offset.conllu";
{
@@ -898,4 +925,253 @@
fail("MISC: no SpaceAfter value appears in output at all");
}
+my $struct_file = "$test_tempdir/test_struct.conllu";
+{
+ open(my $sfh, '>:encoding(UTF-8)', $struct_file)
+ or die "Cannot write test file: $!";
+ print $sfh $struct_data;
+ close($sfh);
+}
+
+my $zipcontent_str = '';
+script_runs(
+ [ 'script/conllu2korapxml', '-f', 'ud', $struct_file ],
+ { stdout => \$zipcontent_str },
+ "conllu2korapxml generates struct.xml when sent_id present"
+);
+
+my $zipfile_str = "$test_tempdir/test_struct.zip";
+if ($zipcontent_str) {
+ open(my $zfh, '>:raw', $zipfile_str) or die "Cannot write zip: $!";
+ print $zfh $zipcontent_str;
+ close($zfh);
+
+ my $ziplist = `$UNZIP -l $zipfile_str 2>/dev/null`;
+ like($ziplist,
+ qr@TEST/TEST/TEST_STR_001/base/struct\.xml@,
+ "Zip contains struct.xml at correct path");
+
+ my $struct_xml = `$UNZIP -p $zipfile_str 'TEST/TEST/TEST_STR_001/base/struct.xml' 2>/dev/null`;
+
+ like($struct_xml,
+ qr/docid="TEST_TEST\.TEST_STR_001"/,
+ "struct.xml has correct docid attribute");
+
+ like($struct_xml,
+ qr/xmlns="http:\/\/ids-mannheim\.de\/ns\/KorAP"/,
+ "struct.xml has correct namespace");
+
+ like($struct_xml,
+ qr/<\?xml-model href="span\.rng"/,
+ "struct.xml has correct processing instruction");
+
+ # Sentence spans: s1 (0..12), s2 (12..25), s3 (25..39)
+ like($struct_xml,
+ qr/id="s1" from="0" to="12".*?<f name="name">s<\/f>/s,
+ "Sentence span s1: from=0 to=12");
+
+ like($struct_xml,
+ qr/id="s2" from="12" to="25".*?<f name="name">s<\/f>/s,
+ "Sentence span s2: from=12 to=25");
+
+ like($struct_xml,
+ qr/id="s3" from="25" to="39".*?<f name="name">s<\/f>/s,
+ "Sentence span s3: from=25 to=39");
+
+ # Paragraph spans: p1 (0..25), p2 (25..39)
+ like($struct_xml,
+ qr/id="p1" from="0" to="25".*?<f name="name">p<\/f>/s,
+ "Paragraph span p1: from=0 to=25");
+
+ like($struct_xml,
+ qr/id="p2" from="25" to="39".*?<f name="name">p<\/f>/s,
+ "Paragraph span p2: from=25 to=39");
+
+ # All struct spans use the TEI namespace
+ like($struct_xml,
+ qr/<fs type="struct" xmlns="http:\/\/www\.tei-c\.org\/ns\/1\.0">/,
+ "Struct spans use TEI namespace");
+
+ # Spans are sorted by from ascending, then to ascending (mixed s and p)
+ my @span_order;
+ while ($struct_xml =~ /id="([sp]\d+)" from="(\d+)" to="(\d+)"/g) {
+ push @span_order, [$1, $2, $3];
+ }
+ my $sorted_ok = 1;
+ for my $j (1 .. $#span_order) {
+ if ($span_order[$j]->[1] < $span_order[$j-1]->[1] ||
+ ($span_order[$j]->[1] == $span_order[$j-1]->[1] &&
+ $span_order[$j]->[2] < $span_order[$j-1]->[2])) {
+ $sorted_ok = 0;
+ last;
+ }
+ }
+ ok($sorted_ok, "Struct spans are sorted by from then to");
+}
+else {
+ fail("Zip contains struct.xml at correct path");
+ fail("struct.xml has correct docid attribute");
+ fail("struct.xml has correct namespace");
+ fail("struct.xml has correct processing instruction");
+ fail("Sentence span s1: from=0 to=12");
+ fail("Sentence span s2: from=12 to=25");
+ fail("Sentence span s3: from=25 to=39");
+ fail("Paragraph span p1: from=0 to=25");
+ fail("Paragraph span p2: from=25 to=39");
+ fail("Struct spans use TEI namespace");
+}
+
+my $sent_only_data = <<'CONLLU';
+# filename = TEST/TEST/TEST_SNO_001/base/tokens.xml
+# text_id = TEST_TEST.TEST_SNO_001
+# sent_id = x1
+# start_offsets = 0 0 6
+# end_offsets = 11 5 11
+1 Hello hello INTJ intj. _ 0 root _ _
+2 world world NOUN n. _ 1 flat _ _
+
+# sent_id = x2
+# start_offsets = 11 12 18
+# end_offsets = 23 17 23
+1 Good good ADJ adj. _ 2 amod _ _
+2 night night NOUN n. _ 0 root _ _
+
+CONLLU
+
+my $sno_file = "$test_tempdir/test_sent_only.conllu";
+{
+ open(my $sfh, '>:encoding(UTF-8)', $sno_file)
+ or die "Cannot write test file: $!";
+ print $sfh $sent_only_data;
+ close($sfh);
+}
+
+my $zipcontent_sno = '';
+script_runs(
+ [ 'script/conllu2korapxml', '-f', 'ud', $sno_file ],
+ { stdout => \$zipcontent_sno },
+ "conllu2korapxml generates struct.xml with sent_id only (no newpar)"
+);
+
+my $zipfile_sno = "$test_tempdir/test_sent_only.zip";
+if ($zipcontent_sno) {
+ open(my $zfh, '>:raw', $zipfile_sno) or die "Cannot write zip: $!";
+ print $zfh $zipcontent_sno;
+ close($zfh);
+
+ my $struct_sno = `$UNZIP -p $zipfile_sno 'TEST/TEST/TEST_SNO_001/base/struct.xml' 2>/dev/null`;
+
+ like($struct_sno,
+ qr/id="s1" from="0" to="11".*?<f name="name">s<\/f>/s,
+ "Sent-only: sentence span s1 from=0 to=11");
+
+ like($struct_sno,
+ qr/id="s2" from="11" to="23".*?<f name="name">s<\/f>/s,
+ "Sent-only: sentence span s2 from=11 to=23");
+
+ unlike($struct_sno,
+ qr/>p<\/f>/,
+ "Sent-only: no paragraph spans when newpar absent");
+}
+else {
+ fail("Sent-only: sentence span s1 from=0 to=11");
+ fail("Sent-only: sentence span s2 from=11 to=23");
+ fail("Sent-only: no paragraph spans when newpar absent");
+}
+
+my $no_struct_data = <<'CONLLU';
+# filename = TEST/TEST/TEST_NOS_001/base/tokens.xml
+# text_id = TEST_TEST.TEST_NOS_001
+# start_offsets = 0 0 4
+# end_offsets = 7 3 7
+1 foo foo NOUN n. _ 0 root _ _
+2 bar bar NOUN n. _ 1 flat _ _
+
+CONLLU
+
+my $nos_file = "$test_tempdir/test_no_struct.conllu";
+{
+ open(my $nfh, '>:encoding(UTF-8)', $nos_file)
+ or die "Cannot write test file: $!";
+ print $nfh $no_struct_data;
+ close($nfh);
+}
+
+my $zipcontent_nos = '';
+script_runs(
+ [ 'script/conllu2korapxml', '-f', 'ud', $nos_file ],
+ { stdout => \$zipcontent_nos },
+ "conllu2korapxml runs without sent_id (no struct.xml)"
+);
+
+my $zipfile_nos = "$test_tempdir/test_no_struct.zip";
+if ($zipcontent_nos) {
+ open(my $zfh, '>:raw', $zipfile_nos) or die "Cannot write zip: $!";
+ print $zfh $zipcontent_nos;
+ close($zfh);
+
+ my $ziplist_nos = `$UNZIP -l $zipfile_nos 2>/dev/null`;
+ unlike($ziplist_nos,
+ qr/struct\.xml/,
+ "Zip does NOT contain struct.xml when sent_id absent");
+}
+else {
+ fail("Zip does NOT contain struct.xml when sent_id absent");
+}
+
+my $bare_newpar_data = <<'CONLLU';
+# filename = TEST/TEST/TEST_BNP_001/base/tokens.xml
+# text_id = TEST_TEST.TEST_BNP_001
+# newpar
+# sent_id = a1
+# start_offsets = 0 0 4
+# end_offsets = 7 3 7
+1 one one NUM num. _ 0 root _ _
+2 two two NUM num. _ 1 flat _ _
+
+# newpar
+# sent_id = a2
+# start_offsets = 7 8 14
+# end_offsets = 17 13 17
+1 three three NUM num. _ 0 root _ _
+2 four four NUM num. _ 1 flat _ _
+
+CONLLU
+
+my $bnp_file = "$test_tempdir/test_bare_newpar.conllu";
+{
+ open(my $bfh, '>:encoding(UTF-8)', $bnp_file)
+ or die "Cannot write test file: $!";
+ print $bfh $bare_newpar_data;
+ close($bfh);
+}
+
+my $zipcontent_bnp = '';
+script_runs(
+ [ 'script/conllu2korapxml', '-f', 'ud', $bnp_file ],
+ { stdout => \$zipcontent_bnp },
+ "conllu2korapxml handles bare newpar (without id)"
+);
+
+my $zipfile_bnp = "$test_tempdir/test_bare_newpar.zip";
+if ($zipcontent_bnp) {
+ open(my $zfh, '>:raw', $zipfile_bnp) or die "Cannot write zip: $!";
+ print $zfh $zipcontent_bnp;
+ close($zfh);
+
+ my $struct_bnp = `$UNZIP -p $zipfile_bnp 'TEST/TEST/TEST_BNP_001/base/struct.xml' 2>/dev/null`;
+
+ like($struct_bnp,
+ qr/id="p1" from="0" to="7".*?<f name="name">p<\/f>/s,
+ "Bare newpar: paragraph p1 from=0 to=7");
+
+ like($struct_bnp,
+ qr/id="p2" from="7" to="17".*?<f name="name">p<\/f>/s,
+ "Bare newpar: paragraph p2 from=7 to=17");
+}
+else {
+ fail("Bare newpar: paragraph p1 from=0 to=7");
+ fail("Bare newpar: paragraph p2 from=7 to=17");
+}
+
done_testing;