X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FText%2FTradition%2FCollation%2FReading%2FWordForm.pm;h=9d27181f84f194dc8eae7279a538612be7bbe7e8;hb=a7f4020a1a1fd72aba6e25dc0a8f8aa9a1891202;hp=a56cd2b5c04537f82f66d6e5af51295cd8c37c21;hpb=cca4f996c756a6989b0c38aa13f974b31f3da54a;p=scpubgit%2Fstemmatology.git

diff --git a/lib/Text/Tradition/Collation/Reading/WordForm.pm b/lib/Text/Tradition/Collation/Reading/WordForm.pm
index a56cd2b..9d27181 100644
--- a/lib/Text/Tradition/Collation/Reading/WordForm.pm
+++ b/lib/Text/Tradition/Collation/Reading/WordForm.pm
@@ -1,6 +1,10 @@
 package Text::Tradition::Collation::Reading::WordForm;
 
+use Lingua::Features::Structure;
+use JSON ();
 use Moose;
+use Text::Tradition::Error;
+use TryCatch;
 
 =head1 NAME
 
@@ -57,25 +61,54 @@ has 'lemma' => (
 	
 has 'morphology' => (
 	is => 'ro',
-	isa => 'ArrayRef',
+	isa => 'Lingua::Features::Structure',
 	required => 1,
 	);
 	
 around BUILDARGS => sub {
 	my $orig = shift;
 	my $class = shift;
-	my %args = @_ == 1 ? %{$_[0]} : @_;
-	unless( ref( $args{'morphology'} ) ) {
-		my @morph = split( '', $args{'morphology'} );
-		$args{'morphology'} = \@morph;
+	my $args = @_ == 1 ? $_[0] : { @_ };
+	if( exists $args->{'JSON'} ) {
+		my @data = split( / \/\/ /, $args->{'JSON'} );
+		# print STDERR "Attempting to parse " . $data[2] . " into structure";
+		my $morph;
+		try {
+			$morph = Lingua::Features::Structure->from_string( $data[2] );
+		} catch {
+			throw("Could not parse string " . $data[2] . " into morphological structure");
+		}
+		$args = { 'language' => $data[0], 'lemma' => $data[1],
+			'morphology' => $morph };
 	}
-	$class->$orig( %args );
+	$class->$orig( $args );
 };
+	
+=head2 to_string
+
+Returns a string combination of language/lemma/morphology that can be used
+in equivalence testing.
 
-sub _stringify {
+=cut
+
+sub to_string {
 	my $self = shift;
-	return sprintf( "%s//%s//%s", $self->language, $self->lemma,
-		join( '', $self->morphology ) );
+	return JSON->new->convert_blessed(1)->encode( $self );
+}
+
+# Rather than spitting it out as a JSON hash, encode it as a string so that
+# the XML serialization doesn't become insane.
+sub TO_JSON {
+	my $self = shift;
+	return sprintf( "%s // %s // %s", $self->language, $self->lemma,
+		$self->morphology->to_string() );
+}
+	
+sub throw {
+	Text::Tradition::Error->throw( 
+		'ident' => 'Wordform error',
+		'message' => $_[0],
+		);
 }
 
 no Moose;