naive serialization of lexems in GraphML

[scpubgit/stemmatology.git] / lib / Text / Tradition / Collation.pm

diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm
index b246c7e..a77f74f 100644 (file)
--- a/lib/Text/Tradition/Collation.pm
+++ b/lib/Text/Tradition/Collation.pm
@@ -284,6 +284,9 @@ sub add_reading {
        my( $self, $reading ) = @_;
        unless( ref( $reading ) eq 'Text::Tradition::Collation::Reading' ) {
                my %args = %$reading;
+               if( $self->tradition->has_language && !exists $args{'language'} ) {
+                       $args{'language'} = $self->tradition->language;
+               }
                $reading = Text::Tradition::Collation::Reading->new( 
                        'collation' => $self,
                        %args );
@@ -971,6 +974,9 @@ sub as_graphml {
                next unless $save_types{$attr->type_constraint->name};
                $reading_attributes{$attr->name} = $save_types{$attr->type_constraint->name};
        }
+       # Extra custom key for the reading morphology
+       $reading_attributes{'lexemes'} = 'string';
+       
     my %node_data_keys;
     my $ndi = 0;
     foreach my $datum ( sort keys %reading_attributes ) {
@@ -1049,6 +1055,13 @@ sub as_graphml {
         $node_el->setAttribute( 'id', $node_xmlid );
         foreach my $d ( keys %reading_attributes ) {
                my $nval = $n->$d;
+               # Custom serialization
+               if( $d eq 'lexemes' ) {
+                               # If nval is a true value, we have lexemes so we need to
+                               # serialize them. Otherwise set nval to undef so that the
+                               # key is excluded from this reading.
+                       $nval = $nval ? $n->_serialize_lexemes : undef;
+               }
                if( $rankoffset && $d eq 'rank' && $n ne $self->start ) {
                        # Adjust the ranks within the subgraph.
                        $nval = $n eq $self->end ? $end->rank - $rankoffset + 1 
@@ -1386,21 +1399,13 @@ sub path_text {
        $start = $self->start unless $start;
        $end = $self->end unless $end;
        my @path = grep { !$_->is_meta } $self->reading_sequence( $start, $end, $wit );
-       return $self->_text_from_path( @path );
-}
-
-# Utility function so that we can cheat and use it when we need both the path
-# and its text.
-sub _text_from_path {
-       my( $self, @path ) = @_;
        my $pathtext = '';
        my $last;
        foreach my $r ( @path ) {
-               if( $r->join_prior || !$last || $last->join_next ) {
-                       $pathtext .= $r->text;
-               } else {
-                       $pathtext .= ' ' . $r->text;
-               }
+               unless ( $r->join_prior || !$last || $last->join_next ) {
+                       $pathtext .= ' ';
+               } 
+               $pathtext .= $r->text;
                $last = $r;
        }
        return $pathtext;