morphology/lib/Text/Tradition/Language.pm

   1 package Text::Tradition::Language;
   2
   3 use strict;
   4 use warnings;
   5 use Module::Load;
   6 use Moose::Role;
   7 use TryCatch;
   8
   9 requires 'throw';
  10
  11 =head1 NAME
  12
  13 Text::Tradition::Language - add-on role to enable language awareness and
  14 morphology functions to a Text::Tradition object.  Please see
  15 L<Text::Tradition::Morphology> for more information on the morphology
  16 add-on distribution.
  17
  18 =head1 METHODS
  19
  20 =head2 language
  21
  22 Accessor for the primary language of the tradition. Must correspond to one
  23 of the Text::Tradition::Language::* modules in this package.
  24
  25 =begin testing
  26
  27 use Test::Warn;
  28 use TryCatch;
  29 use_ok( 'Text::Tradition' ); # with Language
  30
  31 # Test setting and recovering language
  32 my $t = Text::Tradition->new( input => 'Self', file => 't/data/legendfrag.xml' );
  33 warning_like { $t->language( 'Klingon' ); } qr/^Cannot load any language/,
  34         "Got expected warning for setting of unsupported language";
  35 $t->language( 'English' );
  36 is( $t->language, 'English', "Successfully set supported language" );
  37
  38 # Test bad attempt to lemmatize - proper lemmatization is tested separately
  39 my $bt = Text::Tradition->new( input => 'Self', file => 't/data/besoin.xml' );
  40 try {
  41         $bt->lemmatize;
  42         ok( 0, "Failed to throw error on lemmatizing without language" );
  43 } catch( Text::Tradition::Error $e ) {
  44         is( $e->message, "Please set a language to lemmatize a tradition",
  45                 "Got correct error thrown for lemmatization without set language" );
  46 } catch {
  47         ok( 0, "Unexpected error on bad lemmatization attempt" );
  48 }
  49
  50 =end testing
  51
  52 =cut
  53
  54 has 'language' => (
  55         is => 'rw',
  56         isa => 'Str',
  57         predicate => 'has_language',
  58         );
  59
  60 before 'language' => sub {
  61         my $self = shift;
  62         if( @_ && $_[0] ne 'Default' ) {
  63                 # We are trying to set the language; check that the corresponding
  64                 # module exists.
  65                 try {
  66                         load( "Text::Tradition::Language::".$_[0] );
  67                 } catch ( $e ) {
  68                         warn "Cannot load any language module for @_";
  69                 }
  70         }
  71 };
  72
  73 =head2 lemmatize
  74
  75 Calls the appropriate lemmatization function for the language of the
  76 tradition.
  77
  78 =cut
  79
  80 sub lemmatize {
  81         my $self = shift;
  82         unless( $self->has_language ) {
  83                 $self->throw( "Please set a language to lemmatize a tradition" );
  84         }
  85         my $mod = "Text::Tradition::Language::" . $self->language;
  86         try {
  87                 load( $mod );
  88         } catch ( $e ) {
  89                 $self->throw( "Cannot load language module for " . $self->language );
  90         }
  91         $self->throw( "Language module $mod has no lemmatize function" )
  92                 unless $mod->can( 'lemmatize' );
  93         $mod->can( 'lemmatize' )->( $self );
  94 }
  95
  96 1;
  97