serialize Lingua::Feature objects too

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

diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm
index 34151eb..63daec7 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 );
@@ -639,10 +642,10 @@ sub as_dot {
 
        # Output substitute start/end readings if necessary
        if( $startrank ) {
-               $dot .= "\t\"#SUBSTART#\" [ label=\"...\" ];\n";
+               $dot .= "\t\"#SUBSTART#\" [ label=\"...\",id=\"__SUBSTART__\" ];\n";
        }
        if( $endrank ) {
-               $dot .= "\t\"#SUBEND#\" [ label=\"...\" ];\n";  
+               $dot .= "\t\"#SUBEND#\" [ label=\"...\",id=\"__SUBEND__\" ];\n";        
        }
        if( $STRAIGHTENHACK ) {
                ## HACK part 1
@@ -669,6 +672,7 @@ sub as_dot {
         $label = "-$label" if $reading->join_prior;
         $label =~ s/\"/\\\"/g;
                $rattrs->{'label'} = $label;
+               $rattrs->{'id'} = $reading->id;
                $rattrs->{'fillcolor'} = '#b3f36d' if $reading->is_common && $color_common;
         $dot .= sprintf( "\t\"%s\" %s;\n", $reading->id, _dot_attr_string( $rattrs ) );
     }
@@ -926,6 +930,7 @@ sub as_graphml {
        'Str' => 'string',
        'Int' => 'int',
        'Bool' => 'boolean',
+       'ReadingID' => 'string',
        'RelationshipType' => 'string',
        'RelationshipScope' => 'string',
     );
@@ -971,6 +976,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 +1057,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 
@@ -1389,11 +1404,10 @@ sub path_text {
        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;
@@ -1715,12 +1729,12 @@ my $c = $t->collation;
 is( $c->common_predecessor( 'n24', 'n23' )->id, 
     'n20', "Found correct common predecessor" );
 is( $c->common_successor( 'n24', 'n23' )->id, 
-    '#END#', "Found correct common successor" );
+    '__END__', "Found correct common successor" );
 
 is( $c->common_predecessor( 'n19', 'n17' )->id, 
     'n16', "Found correct common predecessor for readings on same path" );
 is( $c->common_successor( 'n21', 'n10' )->id, 
-    '#END#', "Found correct common successor for readings on same path" );
+    '__END__', "Found correct common successor for readings on same path" );
 
 =end testing