add throw() sub to Lexeme.pm

[scpubgit/stemmatology.git] / lib / Text / Tradition / Collation / Reading / Lexeme.pm

diff --git a/lib/Text/Tradition/Collation/Reading/Lexeme.pm b/lib/Text/Tradition/Collation/Reading/Lexeme.pm
index ca4802c..0d17763 100644 (file)
--- a/lib/Text/Tradition/Collation/Reading/Lexeme.pm
+++ b/lib/Text/Tradition/Collation/Reading/Lexeme.pm
@@ -1,7 +1,10 @@
 package Text::Tradition::Collation::Reading::Lexeme;
 
 use Moose;
+use JSON ();
 use Module::Load;
+use Text::Tradition::Collation::Reading::WordForm;
+use Text::Tradition::Error;
 
 =head1 NAME
 
@@ -77,6 +80,7 @@ has 'wordform_matchlist' => (
                'matching_form' => 'get',
                'add_matching_form' => 'push',
                },
+       default => sub { [] },
        );
 
 has 'is_disambiguated' => (
@@ -91,6 +95,30 @@ has 'form' => (
        writer => '_set_form',
        );
        
+around BUILDARGS => sub {
+       my $orig = shift;
+       my $class = shift;
+       my $args = @_ == 1 ? $_[0] : { @_ };
+       if( exists $args->{JSON} ) {
+               my $data = $args->{JSON};
+               if( exists $data->{'form'} && $data->{'form'} ) {
+                       my $form = Text::Tradition::Collation::Reading::WordForm->new(
+                               'JSON' => $data->{'form'} );
+                       $data->{'form'} = $form;
+               }
+               if( exists $data->{'wordform_matchlist'} && $data->{'wordform_matchlist'} ) {
+                       my @ml;
+                       foreach my $wfjson ( @{$data->{'wordform_matchlist'}} ) {
+                               push( @ml, Text::Tradition::Collation::Reading::WordForm->new(
+                                       'JSON' => $wfjson ) );
+                       }
+                       $data->{'wordform_matchlist'} = \@ml;
+               }
+               $args = $data;
+       }
+       $class->$orig( $args );
+};
+       
 # Do auto-disambiguation if we were created with a single wordform
 sub BUILD {
        my $self = shift;
@@ -100,6 +128,23 @@ sub BUILD {
        }       
 }
 
+around 'add_matching_form' => sub {
+       my $orig = shift;
+       my $self = shift;
+       my @realargs;
+       foreach my $a ( @_ ) {
+               if( ref( $a ) ) {
+                       push( @realargs, $a );
+               } else {
+                       # Make the wordform from the string
+                       my $wf = Text::Tradition::Collation::Reading::WordForm->new(
+                               'JSON' => $a );
+                       push( @realargs, $wf );
+               }
+       }
+       return $self->$orig( @realargs );
+};
+
 =head2 disambiguate( $index )
 
 Selects the word form at $index in the list of matching forms, and asserts
@@ -116,28 +161,40 @@ sub disambiguate {
        $self->is_disambiguated( 1 );   
 }
 
-=head2 lookup
+=head2 has_form( $rep ) 
 
-Uses the module for the declared language to look up the lexeme in the
-language database (if any.) Sets the returned morphological matches in
-matching_forms, and returns the list as an array of WordForm objects.
+Returns the index of the matching form whose string representation is in $rep, 
+or else undef if none is found.
 
 =cut
 
-sub lookup {
-       my $self = shift;
-       my $lang = $self->language;
-       my @answers;
-       try {
-               my $langmod = "Text::Tradition::Language::$lang";
-               load( $langmod );
-               @answers = $langmod->can( 'word_lookup' )->( $self->string );
-       } catch {
-               throw( "No language module for $lang, or the module has no word_lookup functionality" );
+sub has_form {
+       my( $self, $rep ) = @_;
+       my $i = 0;
+       foreach my $mf ( $self->matching_forms ) {
+               my $struct = $mf->TO_JSON;
+               return $i if $struct eq $rep;
+               $i++;
        }
-       $self->clear_matching_forms;
-       $self->add_matching_form( @answers );
-       return @answers;
+       return undef;
+}
+               
+
+sub TO_JSON {
+       my $self = shift;
+       my $hash = {};
+       # Do the scalar keys
+       map { $hash->{$_} = $self->$_ if defined $self->$_ } 
+               qw/ language string is_disambiguated form /; 
+       $hash->{'wordform_matchlist'} = [ $self->matching_forms ] if $self->matches;
+       return $hash;
+}
+
+sub throw {
+       Text::Tradition::Error->throw( 
+               'ident' => 'Lexeme error',
+               'message' => $_[0],
+               );
 }
 
 no Moose;