package Text::Tradition::Collation::Reading::WordForm;
+use Lingua::Features::Structure;
+use JSON ();
use Moose;
+use Text::Tradition::Error;
+use TryCatch;
=head1 NAME
required => 1,
);
-# TODO do we need this?
-has 'form' => (
- is => 'ro',
- isa => 'Str',
- # required => 1,
- );
-
has 'lemma' => (
is => 'ro',
isa => 'Str',
required => 1,
);
-has 'morphology' => (
+has 'morphstr' => (
is => 'ro',
- isa => 'ArrayRef',
+ isa => 'Str',
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";
+ $args = { 'language' => $data[0], 'lemma' => $data[1],
+ 'morphstr' => $data[2] };
+ } elsif( exists $args->{'morphology'} ) {
+ # Backwards compat
+ my $mobj = delete $args->{'morphology'};
+ $args->{'morphstr'} = $mobj->to_string()
+ if ref $mobj;
}
- $class->$orig( %args );
+ $class->$orig( $args );
};
-sub _stringify {
+=head2 morphology
+
+Returns a Lingua::Features::Structure object that corresponds to morphstr.
+
+=cut
+
+sub morphology {
my $self = shift;
- return sprintf( "%s//%s//%s", $self->language, $self->lemma,
- join( '', $self->morphology ) );
+ return unless $self->morphstr;
+ my $struct;
+ try {
+ $struct = Lingua::Features::Structure->from_string( $self->morphstr );
+ } catch {
+ throw( "Morphology string " . $self->morphstr . " does not parse" );
+ }
+ return $struct;
+}
+
+=head2 to_string
+
+Returns a string combination of language/lemma/morphology that can be used
+in equivalence testing.
+
+=cut
+
+sub to_string {
+ my $self = shift;
+ 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->morphstr );
+}
+
+sub throw {
+ Text::Tradition::Error->throw(
+ 'ident' => 'Wordform error',
+ 'message' => $_[0],
+ );
}
no Moose;