X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FText%2FTradition%2FCollation%2FRelationshipStore.pm;h=f3fe5cbe1a717c2e3fa2c0d6fa74d59e0986f71e;hb=4e5a7b2cd8f38cd4f178072058d5016be64993c5;hp=ba8b2de9f938a1b65e394b980f13ea9042db8e30;hpb=c84275ff42c4d3e6f7fbc13140101975c990101a;p=scpubgit%2Fstemmatology.git

diff --git a/lib/Text/Tradition/Collation/RelationshipStore.pm b/lib/Text/Tradition/Collation/RelationshipStore.pm
index ba8b2de..f3fe5cb 100644
--- a/lib/Text/Tradition/Collation/RelationshipStore.pm
+++ b/lib/Text/Tradition/Collation/RelationshipStore.pm
@@ -8,7 +8,8 @@ use Moose;
 
 =head1 NAME
 
-Text::Tradition::Collation::Reading - represents a reading (usually a word) in a collation.
+Text::Tradition::Collation::RelationshipStore - Keeps track of the relationships
+between readings in a given collation
     
 =head1 DESCRIPTION
 
@@ -64,9 +65,9 @@ sub create {
 	my $rel;
 	if( $self->graph->has_edge( $source, $target ) ) {
 		$rel = $self->graph->get_edge_attribute( $source, $target, 'object' );
-		if( $rel->type ne $options->type ) {
-			warn "Relationship of type " . $rel->type 
-				. "already exists between $source and $target";
+		if( $rel->type ne $options->{'type'} ) {
+			warn "Another relationship of type " . $rel->type 
+				. " already exists between $source and $target";
 			return;
 		} else {
 			return $rel;
@@ -268,7 +269,6 @@ sub related_readings {
 		my $check = [ $reading ];
 		my $iter = 0;
 		while( @$check ) {
-			$DB::single = 1 if $iter++ > 100;
 			my $more = [];
 			foreach my $r ( @$check ) {
 				foreach my $nr ( $self->graph->neighbors( $r ) ) {
@@ -325,7 +325,7 @@ sub merge_readings {
 }
 
 sub as_graphml { 
-	my( $self, $graphml_ns, $xmlroot, $node_hash, $edge_keys ) = @_;
+	my( $self, $graphml_ns, $xmlroot, $node_hash, $nodeid_key, $edge_keys ) = @_;
 	
     my $rgraph = $xmlroot->addNewChild( $graphml_ns, 'graph' );
 	$rgraph->setAttribute( 'edgedefault', 'directed' );
@@ -337,9 +337,11 @@ sub as_graphml {
     $rgraph->setAttribute( 'parse.order', 'nodesfirst' );
     
     # Add the vertices according to their XML IDs
-    foreach my $n ( sort _by_xmlid values( %$node_hash ) ) {
+    my %rdg_lookup = ( reverse %$node_hash );
+    foreach my $n ( sort _by_xmlid keys( %rdg_lookup ) ) {
     	my $n_el = $rgraph->addNewChild( $graphml_ns, 'node' );
     	$n_el->setAttribute( 'id', $n );
+    	_add_graphml_data( $n_el, $nodeid_key, $rdg_lookup{$n} );
     }
     
     # Add the relationship edges, with their object information
@@ -362,9 +364,11 @@ sub as_graphml {
 }
 
 sub _by_xmlid {
-	$a =~ s/\D//g;
-	$b =~ s/\D//g;
-	return $a <=> $b;
+	my $tmp_a = $a;
+	my $tmp_b = $b;
+	$tmp_a =~ s/\D//g;
+	$tmp_b =~ s/\D//g;
+	return $tmp_a <=> $tmp_b;
 }
 
 sub _add_graphml_data {