morphology/lib/Text/Tradition/Language/Greek.pm

   1 package Text::Tradition::Language::Greek;
   2
   3 use strict;
   4 use warnings;
   5 use Module::Load;
   6 use parent qw/ Text::Tradition::Language::Perseus /;
   7 use Text::Tradition::Language::Base qw/ unicode_regularize /;
   8
   9 =head1 NAME
  10
  11 Text::Tradition::Language::Greek - language-specific module for Greek
  12
  13 =head1 DESCRIPTION
  14
  15 Implements morphology lookup for Greek words in context.  This module
  16 depends on the Lingua::Morph::Perseus module for access to PhiloLogic database data.
  17
  18 =head1 SUBROUTINES
  19
  20 =head2 lemmatize( $text )
  21
  22 Evaluates the string using Treetagger and Perseus, and returns the results.
  23
  24 =head2 reading_lookup( $word )
  25
  26 Returns a single-word morphological lookup of the given word using Perseus.
  27
  28 =begin testing
  29
  30 use Text::Tradition;
  31 use_ok( 'Text::Tradition::Language::Greek' );
  32
  33 eval "use Lingua::Morph::Perseus";
  34 my $err = $@;
  35
  36 SKIP: {
  37         skip "Greek linguistic data not read yet";
  38
  39         my $trad = Text::Tradition->new(
  40                 'language' => 'Greek',
  41                 'file' => 't/data/florilegium_graphml.xml',
  42                 'input' => 'Self' );
  43         $trad->lemmatize();
  44         my $ambig = 0;
  45         foreach my $r ( $trad->collation->readings ) {
  46                 next if $r->is_meta;
  47                 ok( $r->has_lexemes, "Reading $r has one or more lexemes" );
  48                 my @lex = $r->lexemes;
  49                 my $lexstr = join( '', map { $_->string } @lex );
  50                 my $textstr = $r->text;
  51                 $textstr =~ s/\s+//g;
  52                 is( $textstr, $lexstr, "Lexemes for reading $r match the reading" );
  53                 foreach my $l ( @lex ) {
  54                         next unless $l->matches;
  55                         next if $l->is_disambiguated;
  56                         printf( "Ambiguous lexeme %s for reading %s:\n\t%s\n", $l->string, $r->id,
  57                                 join( "\n\t", map { $_->lemma . ': ' . $_->morphology->to_string } $l->matching_forms ) );
  58                         $ambig++;
  59                 }
  60         }
  61         is( $ambig, 4, "Found 4 ambiguous forms as expected" );
  62 }
  63
  64 =end testing
  65
  66 =cut
  67
  68 our $dbhandle;
  69
  70 sub lemmatize {
  71         return __PACKAGE__->perseus_lemmatize( @_ );
  72 }
  73
  74 sub reading_lookup {
  75         return __PACKAGE__->perseus_reading_lookup( @_ );
  76 }
  77
  78 =head2 regularize( $text )
  79
  80 Returns a regularized form of the reading for the purposes of collation.
  81
  82 =cut
  83
  84 sub regularize {
  85         return unicode_regularize( @_ );
  86 }
  87
  88 1;
  89