X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FText%2FTradition%2FCollation.pm;h=dda84852ee08ae2914484ba243577d9c99c9c2cd;hb=428bcf0bc79f77a7857b21ef881708faa792e33a;hp=465ef1e9caf72db4c9ba068eb7b2f01b74958c5f;hpb=339786dd0b0c493786af4df1ec3bc7ef2bf497e2;p=scpubgit%2Fstemmatology.git

diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm
index 465ef1e..dda8485 100644
--- a/lib/Text/Tradition/Collation.pm
+++ b/lib/Text/Tradition/Collation.pm
@@ -11,8 +11,6 @@ use Text::Tradition::Collation::Reading;
 use Text::Tradition::Collation::RelationshipStore;
 use Text::Tradition::Error;
 use XML::Easy::Syntax qw( $xml10_namestartchar_rx $xml10_namechar_rx );
-use XML::LibXML;
-use XML::LibXML::XPathContext;
 use Moose;
 
 has 'sequence' => (
@@ -448,6 +446,15 @@ sub compress_readings {
 	# readings.
 	my %gobbled;
 	foreach my $rdg ( sort { $a->rank <=> $b->rank } $self->readings ) {
+		# While we are here, get rid of any extra wordforms from a disambiguated
+		# reading.
+		if( $rdg->disambiguated ) {
+			foreach my $lex ( $rdg->lexemes ) {
+				$lex->clear_matching_forms();
+				$lex->add_matching_form( $lex->form );
+			}
+		}
+		# Now look for readings that can be joined to their successors.
 		next if $rdg->is_meta;
 		next if $gobbled{$rdg->id};
 		next if $rdg->grammar_invalid || $rdg->is_nonsense;
@@ -973,13 +980,23 @@ is( scalar $st->collation->readings, $READINGS, "Reparsed collation has all read
 is( scalar $st->collation->paths, $PATHS, "Reparsed collation has all paths" );
 is( scalar $st->collation->relationships, 3, "Reparsed collation has new relationships" );
 
-# Now add a stemma, write to GraphML, and parse again.
+# Now add a stemma, write to GraphML, and look at the output.
 my $stemma = $tradition->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
 is( ref( $stemma ), 'Text::Tradition::Stemma', "Parsed dotfile into stemma" );
 is( $tradition->stemmata, 1, "Tradition now has the stemma" );
 $graphml = $c->as_graphml;
 like( $graphml, qr/digraph/, "Digraph declaration exists in GraphML" );
 
+# Now add a user, write to GraphML, and look at the output.
+unlike( $graphml, qr/testuser/, "Test user name does not exist in GraphML yet" );
+my $testuser = Text::Tradition::User->new( 
+	id => 'testuser', password => 'testpass' );
+is( ref( $testuser ), 'Text::Tradition::User', "Created test user object" );
+$testuser->add_tradition( $tradition );
+is( $tradition->user->id, $testuser->id, "Tradition assigned to test user" );
+$graphml = $c->as_graphml;
+like( $graphml, qr/testuser/, "Test user name now exists in GraphML" );
+
 =end testing
 
 =cut
@@ -1011,6 +1028,7 @@ sub as_graphml {
         'http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd';
 
     # Create the document and root node
+    require XML::LibXML;
     my $graphml = XML::LibXML->createDocument( "1.0", "UTF-8" );
     my $root = $graphml->createElementNS( $graphml_ns, 'graphml' );
     $graphml->setDocumentElement( $root );
@@ -1050,14 +1068,25 @@ sub as_graphml {
 		next unless $save_types{$attr->type_constraint->name};
 		$graph_attributes{$attr->name} = $save_types{$attr->type_constraint->name};
 	}
-    # Extra custom key for the tradition stemma(ta)
-    $graph_attributes{'stemmata'} = 'string';
+    # Extra custom keys for complex objects that should be saved in some form.
+    # The subroutine should return a string, or undef/empty.
+    $graph_attributes{'stemmata'} = sub { 
+    	my @stemstrs;
+		map { push( @stemstrs, $_->editable( {linesep => ''} ) ) } 
+			$self->tradition->stemmata;
+		join( "\n", @stemstrs );
+	};
+    $graph_attributes{'user'} = sub { 
+    	$self->tradition->user ? $self->tradition->user->id : undef 
+    };
 	
     foreach my $datum ( sort keys %graph_attributes ) {
     	$graph_data_keys{$datum} = 'dg'.$gdi++;
         my $key = $root->addNewChild( $graphml_ns, 'key' );
+        my $dtype = ref( $graph_attributes{$datum} ) ? 'string' 
+        	: $graph_attributes{$datum};
         $key->setAttribute( 'attr.name', $datum );
-        $key->setAttribute( 'attr.type', $graph_attributes{$datum} );
+        $key->setAttribute( 'attr.type', $dtype );
         $key->setAttribute( 'for', 'graph' );
         $key->setAttribute( 'id', $graph_data_keys{$datum} );    	
     }
@@ -1130,11 +1159,9 @@ sub as_graphml {
     	my $value;
     	if( $datum eq 'version' ) {
     		$value = '3.2';
-    	} elsif( $datum eq 'stemmata' ) {
-    		my @stemstrs;
-    		map { push( @stemstrs, $_->editable( {linesep => ''} ) ) } 
-    			$self->tradition->stemmata;
-    		$value = join( "\n", @stemstrs );
+    	} elsif( ref( $graph_attributes{$datum} ) ) {
+    		my $sub = $graph_attributes{$datum};
+    		$value = &$sub();
     	} elsif( $gattr_from{$datum} eq 'Tradition' ) {
     		$value = $self->tradition->$datum;
     	} else {