From: Tara L Andrews <tla\@mit.edu>
Date: Mon, 26 Dec 2011 10:59:53 +0000 (+0100)
Subject: make tests for Tradition.pm and Tradition/Parser/CollateX.pm work
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a753cc846a37032aca109851f8de6ce760283383;p=scpubgit%2Fstemmatology.git

make tests for Tradition.pm and Tradition/Parser/CollateX.pm work
---

diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm
index abdb441..50903a2 100644
--- a/lib/Text/Tradition/Collation.pm
+++ b/lib/Text/Tradition/Collation.pm
@@ -312,15 +312,20 @@ sub relationship_valid {
 
 sub related_readings {
 	my( $self, $reading, $colocated ) = @_;
-	$reading = $reading->id 
-		if ref( $reading ) eq 'Text::Tradition::Collation::Reading';
+	my $return_object;
+	if( ref( $reading ) eq 'Text::Tradition::Collation::Reading' ) {
+		$reading = $reading->id;
+		$return_object = 1;
+		print STDERR "Returning related objects\n";
+	} else {
+		print STDERR "Returning related object names\n";
+	}
 	my @related = $self->relations->all_reachable( $reading );
 	if( $colocated ) {
 		my @colo = grep { $self->relations->has_edge_attribute( $reading, $_, 'colocated' ) } @related;
-		return @colo;
-	} else {
-		return @related;
-	}
+		@related = @colo;
+	} 
+	return $return_object ? map { $self->reading( $_ ) } @related : @related;
 }
 
 =head2 Output method(s)
diff --git a/lib/Text/Tradition/Parser/CollateX.pm b/lib/Text/Tradition/Parser/CollateX.pm
index d3a6dc5..7123d4d 100644
--- a/lib/Text/Tradition/Parser/CollateX.pm
+++ b/lib/Text/Tradition/Parser/CollateX.pm
@@ -59,13 +59,14 @@ my $t = Text::Tradition->new(
 is( ref( $t ), 'Text::Tradition', "Parsed our own GraphML" );
 if( $t ) {
     is( scalar $t->collation->readings, 26, "Collation has all readings" );
-    is( scalar $t->collation->paths, 49, "Collation has all paths" );
+    is( scalar $t->collation->paths, 32, "Collation has all paths" );
     is( scalar $t->witnesses, 3, "Collation has all witnesses" );
     
     # Check an 'identical' node
     my $transposed = $t->collation->reading( 'n15' );
-    ok( $transposed->has_primary, "Reading links to transposed primary" );
-    is( $transposed->primary->name, 'n17', "Correct transposition link" );
+    my @related = $transposed->related_readings;
+    is( scalar @related, 1, "Reading links to transposed version" );
+    is( $related[0]->id, 'n17', "Correct transposition link" );
 }
 
 =end testing
diff --git a/lib/Text/Tradition/Parser/Tabular.pm b/lib/Text/Tradition/Parser/Tabular.pm
index 1ccf8d2..543100e 100644
--- a/lib/Text/Tradition/Parser/Tabular.pm
+++ b/lib/Text/Tradition/Parser/Tabular.pm
@@ -151,8 +151,11 @@ sub parse {
                 # If we are in a lacuna already, drop this node.
                 # Otherwise make a lacuna node and drop this node.
                 unless( $last_rdg->is_lacuna ) {
-                    my $l = $c->add_lacuna( $rdg->name );
-                    $l->rank( $rdg->rank );
+                    my $l = $c->add_reading( {
+                		'collation' => $c,
+                		'id' => $rdg->name,
+                		'is_lacuna' => 1,
+                		} );
                     push( @$new_p, $l );
                     $last_rdg = $l;
                 }
@@ -188,11 +191,15 @@ sub make_nodes {
     }
     my $ctr = 1;
     foreach my $w ( keys %unique ) {
-        my $r = $collation->add_reading( "$index,$ctr" );
-        $ctr++;
-        $r->rank( $index );
-        $r->text( $w );
+    	my $rargs = {
+    		'collation' => $collation,
+    		'id' => "$index,$ctr",
+    		'rank' => $index,
+    		'text' => $w,
+    		};
+        my $r = $collation->add_reading( $rargs );
         $unique{$w} = $r;
+        $ctr++;
     }
     return \%unique;
 }
diff --git a/t/text_tradition_parser_collatex.t b/t/text_tradition_parser_collatex.t
index 6bba0d1..733cf1b 100644
--- a/t/text_tradition_parser_collatex.t
+++ b/t/text_tradition_parser_collatex.t
@@ -23,13 +23,14 @@ my $t = Text::Tradition->new(
 is( ref( $t ), 'Text::Tradition', "Parsed our own GraphML" );
 if( $t ) {
     is( scalar $t->collation->readings, 26, "Collation has all readings" );
-    is( scalar $t->collation->paths, 49, "Collation has all paths" );
+    is( scalar $t->collation->paths, 32, "Collation has all paths" );
     is( scalar $t->witnesses, 3, "Collation has all witnesses" );
     
     # Check an 'identical' node
     my $transposed = $t->collation->reading( 'n15' );
-    ok( $transposed->has_primary, "Reading links to transposed primary" );
-    is( $transposed->primary->name, 'n17', "Correct transposition link" );
+    my @related = $transposed->related_readings;
+    is( scalar @related, 1, "Reading links to transposed version" );
+    is( $related[0]->id, 'n17', "Correct transposition link" );
 }
 }