generalize Latin module to Latin/Greek/Armenian on Perseus

[scpubgit/stemmatology.git] / lib / Text / Tradition / Language / Latin.pm

diff --git a/lib/Text/Tradition/Language/Latin.pm b/lib/Text/Tradition/Language/Latin.pm
index df87505..2f4a42a 100644 (file)
--- a/lib/Text/Tradition/Language/Latin.pm
+++ b/lib/Text/Tradition/Language/Latin.pm
@@ -3,8 +3,7 @@ package Text::Tradition::Language::Latin;
 use strict;
 use warnings;
 use Module::Load;
-use Text::Tradition::Language::Base qw/ lemmatize_treetagger lfs_morph_tags /;
-use TryCatch;
+use parent qw/ Text::Tradition::Language::Perseus /;
 
 =head1 NAME
 
@@ -12,14 +11,14 @@ Text::Tradition::Language::Latin - language-specific module for Latin
 
 =head1 DESCRIPTION
 
-Implements morphology lookup for French words in context.  This module
+Implements morphology lookup for Latin words in context.  This module
 depends on the Lingua::Morph::Perseus module for access to PhiloLogic database data.
 
 =head1 SUBROUTINES
 
 =head2 lemmatize( $text )
 
-Evaluates the string using the Flemm package, and returns the results.
+Evaluates the string using Treetagger and Perseus, and returns the results.
 
 =begin testing
 
@@ -61,101 +60,14 @@ SKIP: {
 
 =cut
 
+our $dbhandle;
+
 sub lemmatize {
-       my $tradition = shift;
-       my %opts = ( 
-               'language' => 'Latin', 
-               'callback' => sub { _perseus_lookup_tt( @_ ) } 
-               );
-       return lemmatize_treetagger( $tradition, %opts );
+       return __PACKAGE__->perseus_lemmatize( @_ );
 }
 
-=head2 reading_lookup( $rdg[, $rdg, ...] )
-
-Looks up one or more readings using the Perseus package, and returns the
-possible results.  This skips the tree tagger / tokenizer, returning any
-match for the word string(s) in the morphology DB.
-
-=cut
-
 sub reading_lookup {
-       my @words = @_;
-       return map { _perseus_lookup_str( $_ ) } @words;
-}
-
-=head2 morphology_tags
-
-Return a data structure describing the available parts of speech and their attributes.
-
-=cut
-
-sub morphology_tags {
-       return lfs_morph_tags();
+       return __PACKAGE__->perseus_reading_lookup( @_ );
 }
 
-
-{
-       my $morph;
-       
-       sub _morph_connect {
-               unless( $morph ) {
-                       try {
-                               load 'Lingua::Morph::Perseus';
-                               $morph = Lingua::Morph::Perseus->connect( 'Latin' );
-                       } catch {
-                               warn "Cannot do Latin word lemmatization without Lingua::Morph::Perseus: @_";
-                               return;
-                       }
-               }
-       }
-                               
-       sub _perseus_lookup_tt {
-               my( $orig, $pos, $lemma ) = split( /\t/, $_[0] );
-               _morph_connect();
-               return unless $morph;
-               # Discard results that don't match the lemma, unless lemma is unknown
-               my $lookupopts = {};
-               unless( $lemma eq '<unknown>' || $lemma =~ /^\W+$/ ) {
-                       my %lems;
-                       map { $lems{$_} = 1; $lems{lc($_)} = 1 } split( /\|/, $lemma );
-                       $lookupopts->{'lemma'} = [ keys %lems ];
-               }
-               $lookupopts->{'ttpos'} = $pos if $pos;
-               
-               my $result = $morph->lexicon_lookup( $orig, $lookupopts );
-               # unless( !keys( %$lookupopts ) ||  $result->{'filtered'} ) {
-               #       warn "Filter on $pos / $lemma returned no results; using all results";
-               # }
-               my @ret = @{$result->{'objects'}};
-               my %unique_wordforms;
-               foreach my $obj ( @ret ) {
-                       my $wf = _wordform_from_row( $obj );
-                       $unique_wordforms{$wf->to_string} = $wf;
-               }
-               return values( %unique_wordforms );
-       }
-       
-       sub _perseus_lookup_str {
-               my( $orig ) = @_;
-               _morph_connect();
-               return unless $morph;
-               # Simple morph DB lookup, and return the results.
-               my $result = $morph->lexicon_lookup( $orig );
-               return map { _wordform_from_row( $_ ) } @{$result->{'objects'}};
-       }
-       
-}
-
-sub _wordform_from_row {
-       my( $rowobj ) = @_;
-       my $lemma = $rowobj->lemma;
-       $lemma =~ s/^(\D+)\d*$/$1/;
-       my $wf = Text::Tradition::Collation::Reading::WordForm->new(
-               'language' => 'Latin',
-               'lemma' => $lemma,
-               'morphology' => $rowobj->morphology,
-               );
-       return $wf;
-}
-       
 1;