Added support for DGD pseudo-sentences based on anchor milestones

Change-Id: I4bbbde7906cec533f9e12916027a0dedb57bdcdf
diff --git a/Changes b/Changes
index de79254..a41ac8b 100644
--- a/Changes
+++ b/Changes
@@ -1,8 +1,10 @@
-0.39 2019-12-11
+0.39 2019-12-16
         - Added Talismane support.
         - Added "distributor" field to I5 metadata.
         - Added DGD link field to I5 metadata.
         - Improve logging.
+        - Added support for DGD pseudo-sentences
+          based on anchor milestones.
 
 0.38 2019-05-22
         - Stop file processing when base tokenization
diff --git a/Readme.pod b/Readme.pod
index 7a87ccc..8e82eda 100644
--- a/Readme.pod
+++ b/Readme.pod
@@ -133,7 +133,8 @@
 
 Define the layer for base sentences.
 If given, this will be used instead of using C<Base#Sentences>.
-Currently C<DeReKo#Structure> is the only additional layer supported.
+Currently C<DeReKo#Structure> and C<DGD#Structure> are the only additional
+layers supported.
 
  Defaults to unset.
 
@@ -364,6 +365,7 @@
 
   DGD
     #Morpho
+    #Structure
 
   DRuKoLa
     #Morpho
diff --git a/lib/KorAP/XML/Annotation/DGD/Structure.pm b/lib/KorAP/XML/Annotation/DGD/Structure.pm
new file mode 100644
index 0000000..6961b45
--- /dev/null
+++ b/lib/KorAP/XML/Annotation/DGD/Structure.pm
@@ -0,0 +1,98 @@
+package KorAP::XML::Annotation::DGD::Structure;
+use KorAP::XML::Annotation::Base;
+use List::Util qw/uniq/;
+
+# This handler introduces pseudo sentences
+# based on anchor texts in AGD. A sentence is defined as
+# being the span between
+#   a) two empty anchor elements, or
+#   b) an anchor element and the start of the doc, or
+#   c) an anchor element and the end of the doc.
+
+sub parse {
+  my $self = shift;
+
+  my @milestones = ();
+  my ($p_start, $o_start) = (0,0);
+  my ($last_p, $last_o) = (0,0);
+
+  $$self->add_spandata(
+    foundry => 'struct',
+    layer => 'structure',
+    cb => sub {
+      my ($stream, $span) = @_;
+
+      # Read feature
+      my $feature = $span->hash->{fs}->{f};
+      my $attrs;
+
+      # Get attributes
+      if (ref $feature eq 'ARRAY') {
+        $attrs = $feature->[1]->{fs}->{f};
+        $attrs = ref $attrs eq 'ARRAY' ? $attrs : [$attrs];
+        $feature = $feature->[0];
+      };
+
+      # Get term label
+      my $name = $feature->{'#text'};
+
+      # Check only for anchors
+      if ($name eq 'anchor') {
+        push @milestones, [ $span->p_start, $span->o_start ];
+      } else {
+        $last_p = $span->p_start;
+        $last_o = $span->o_end;
+      }
+    }
+  ) or return;
+
+  my $sentences = 0;
+
+  # Add final position
+  push @milestones, [$last_p, $last_o];
+
+  # Sort and unique milestones
+  @milestones = sort {
+    $a->[0] <=> $b->[0]
+  } @milestones;
+
+  my $stream = $$self->stream;
+
+  # Iterate overs milestones
+  foreach (@milestones) {
+
+    if (($_->[0] == $p_start) || ($_->[1] == $o_start)) {
+      next;
+    };
+
+    my $mtt = $stream->pos($p_start);
+
+    # Add the base sentence
+    my $mt = $mtt->add(
+      term    => '<>:base/s:s',
+      o_start => $o_start,
+      o_end   => $_->[1],
+      p_start => $p_start,
+      p_end   => $_->[0] + 1,
+      pti     => 64
+    );
+    $mt->payload('<b>1');
+    $sentences++;
+
+    $p_start = $_->[0];
+    $o_start = $_->[1];
+  }
+
+  # Set meta information about sentence count
+  $stream->add_meta('base/sentences', '<i>' . $sentences);
+
+  return 1;
+};
+
+sub layer_info {
+  [];
+};
+
+
+1;
+__END__
diff --git a/script/korapxml2krill b/script/korapxml2krill
index e8aded2..e6754d9 100644
--- a/script/korapxml2krill
+++ b/script/korapxml2krill
@@ -142,9 +142,13 @@
 #
 # 2019/08/08
 # - Support for Talismane.
+#
+# 2019/12/16
+# - Added support for DGD pseudo-sentences
+#   based on anchor milestones.
 # ----------------------------------------------------------
 
-our $LAST_CHANGE = '2019/08/08';
+our $LAST_CHANGE = '2019/12/16';
 our $LOCAL = $FindBin::Bin;
 our $KORAL_VERSION = 0.03;
 our $VERSION_MSG = <<"VERSION";
@@ -491,6 +495,9 @@
 
 # DGD
 push(@layers, ['DGD', 'Morpho']);
+if ($base_sentences eq 'dgd#structure') {
+  push(@layers, ['DGD', 'Structure', 'base-sentence']);
+}
 
 # DRuKoLa
 push(@layers, ['DRuKoLa', 'Morpho']);
@@ -1227,7 +1234,8 @@
 
 Define the layer for base sentences.
 If given, this will be used instead of using C<Base#Sentences>.
-Currently C<DeReKo#Structure> is the only additional layer supported.
+Currently C<DeReKo#Structure> and C<DGD#Structure> are the only additional
+layers supported.
 
  Defaults to unset.
 
@@ -1458,6 +1466,7 @@
 
   DGD
     #Morpho
+    #Structure
 
   DRuKoLa
     #Morpho
diff --git a/t/real/agd.t b/t/real/agd.t
index 1e87bfe..498f4e2 100644
--- a/t/real/agd.t
+++ b/t/real/agd.t
@@ -94,7 +94,7 @@
 like($first_token, qr!<>:dereko/s:text!);
 
 ## DGD
-$tokens->add('DGD', 'Morpho');
+ok($tokens->add('DGD', 'Morpho'), 'Add Morpho');
 
 $output = decode_json( $tokens->to_json );
 is($output->{data}->{foundries},
@@ -109,11 +109,20 @@
 like($third_token, qr!i:alxv!);
 like($third_token, qr!s:alxv!);
 
-# TODO:
-#   Check sentences!
-#   Check paragraphs!
+## DGD base sentences
+ok($tokens->add('DGD', 'Structure'), 'Add sentences');
+$output = decode_json( $tokens->to_json );
 
+# Offsets are suboptimal set, but good enough
 
+$first_token = join('||', @{$output->{data}->{stream}->[0]});
+like($first_token, qr!<>:base/s:s\$<b>64<i>0<i>16<i>3<b>1!);
+
+my $token = join('||', @{$output->{data}->{stream}->[1]});
+unlike($token, qr!<>:base/s:s!);
+
+$token = join('||', @{$output->{data}->{stream}->[2]});
+like($token, qr!<>:base/s:s\$<b>64<i>16<i>23<i>5<b>1!);
 
 done_testing;
 __END__