From: tla <tla@mit.edu>
Date: Sat, 18 Apr 2015 12:20:04 +0000 (+0200)
Subject: Move normal-form logc to Morphology.pm
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=eef2a5a960f3248d26810f8d6ca58dc6a402a336;p=scpubgit%2Fstemmatology.git

Move normal-form logc to Morphology.pm
---

diff --git a/base/lib/Text/Tradition/Collation/Reading.pm b/base/lib/Text/Tradition/Collation/Reading.pm
index 88c1d5d..45040d1 100644
--- a/base/lib/Text/Tradition/Collation/Reading.pm
+++ b/base/lib/Text/Tradition/Collation/Reading.pm
@@ -215,16 +215,7 @@ around make_lemma => sub {
 
 	# TODO unset the lemma from any other reading at the same rank.
 	if( $val && $self->does( 'Text::Tradition::Morphology' )) {
-		# Set the normal form on all orthographically related readings to match
-		# the normal form on this one.
-		my $filter = sub { 
-			my $rl = shift; 
-			my $rltype = $self->collation->relations->type( $rl->type );
-			return $rltype->bindlevel < 2 
-		};
-		foreach my $r ( $self->related_readings( $filter ) ) {
-			$r->normal_form( $self->normal_form );
-		}
+		$self->push_normal_form();
 	}
 	$self->$orig( $val );
 };
diff --git a/morphology/lib/Text/Tradition/Morphology.pm b/morphology/lib/Text/Tradition/Morphology.pm
index 286ef33..35abfd8 100644
--- a/morphology/lib/Text/Tradition/Morphology.pm
+++ b/morphology/lib/Text/Tradition/Morphology.pm
@@ -311,6 +311,20 @@ sub relationship_added {
 	}
 }
 
+sub push_normal_form {
+	my $self = shift;
+	# Set the normal form on all orthographically related readings to match
+	# the normal form on this one.
+	my $filter = sub { 
+		my $rl = shift; 
+		my $rltype = $self->collation->relations->type( $rl->type );
+		return $rltype->bindlevel < 2 
+	};
+	foreach my $r ( $self->related_readings( $filter ) ) {
+		$r->normal_form( $self->normal_form );
+	}
+}
+
 1;
 
 =head1 LICENSE