make unsupported language non-fatal; correct exception raising

diff --git a/base/lib/Text/Tradition.pm b/base/lib/Text/Tradition.pm
index 769688f..f8f8ea1 100644 (file)
--- a/base/lib/Text/Tradition.pm
+++ b/base/lib/Text/Tradition.pm
@@ -305,6 +305,7 @@ sub add_json_witnesses {
 }
 
 sub throw {
+       my $self = shift;
        Text::Tradition::Error->throw( 
                'ident' => 'Tradition error',
                'message' => $_[0],

diff --git a/morphology/Makefile.PL b/morphology/Makefile.PL
index a326c7a..00ac278 100644 (file)
--- a/morphology/Makefile.PL
+++ b/morphology/Makefile.PL
@@ -19,6 +19,7 @@ requires( 'Moose::Role' );
 requires( 'Text::Tradition' );
 requires( 'TryCatch' );
 build_requires( 'Safe::Isa' );
+build_requires( 'Test::Warn' );
 
 # Modules needed for morphology but not trivially CPANnable
 recommends( 'Lingua::TreeTagger' );

diff --git a/morphology/lib/Text/Tradition/Language.pm b/morphology/lib/Text/Tradition/Language.pm
index 3a78744..0f947b2 100644 (file)
--- a/morphology/lib/Text/Tradition/Language.pm
+++ b/morphology/lib/Text/Tradition/Language.pm
@@ -4,6 +4,7 @@ use strict;
 use warnings;
 use Module::Load;
 use Moose::Role;
+use TryCatch;
 
 requires 'throw';
 
@@ -21,6 +22,33 @@ add-on distribution.
 Accessor for the primary language of the tradition. Must correspond to one
 of the Text::Tradition::Language::* modules in this package.
 
+=begin testing
+
+use Test::Warn;
+use TryCatch;
+use_ok( 'Text::Tradition' ); # with Language
+
+# Test setting and recovering language
+my $t = Text::Tradition->new( input => 'Self', file => 't/data/legendfrag.xml' );
+warning_like { $t->language( 'Klingon' ); } qr/^Cannot load language/,
+       "Got expected warning for setting of unsupported language";
+$t->language( 'English' );
+is( $t->language, 'English', "Successfully set supported language" );
+
+# Test bad attempt to lemmatize - proper lemmatization is tested separately
+my $bt = Text::Tradition->new( input => 'Self', file => 't/data/besoin.xml' );
+try {
+       $bt->lemmatize;
+       ok( 0, "Failed to throw error on lemmatizing without language" );
+} catch( Text::Tradition::Error $e ) {
+       is( $e->message, "Please set a language to lemmatize a tradition",
+               "Got correct error thrown for lemmatization without set language" );
+} catch {
+       ok( 0, "Unexpected error on bad lemmatization attempt" );
+}
+
+=end testing
+
 =cut
 
 has 'language' => (
@@ -34,9 +62,10 @@ before 'language' => sub {
        if( @_ && $_[0] ne 'Default' ) {
                # We are trying to set the language; check that the corresponding
                # module exists.
-               eval "require Text::Tradition::Language::".$_[0];
-               if( $@ ) {
-                       throw( "Cannot load language module for @_: $@" );
+               try {
+                       load( "Text::Tradition::Language::".$_[0] );
+               } catch ( $e ) {
+                       warn( "Cannot load language module for @_: $e" );
                }
        }
 };
@@ -51,10 +80,16 @@ tradition.
 sub lemmatize {
        my $self = shift;
        unless( $self->has_language ) {
-               throw( "Please set a language to lemmatize a tradition" );
+               $self->throw( "Please set a language to lemmatize a tradition" );
        }
        my $mod = "Text::Tradition::Language::" . $self->language;
-       load( $mod );
+       try {
+               load( $mod );
+       } catch ( $e ) {
+               $self->throw( "Cannot load language module for " . $self->language );
+       }
+       $self->throw( "Language module $mod has no lemmatize function" )
+               unless $mod->can( 'lemmatize' );
        $mod->can( 'lemmatize' )->( $self );
 }
 

diff --git a/morphology/t/text_tradition_language.t b/morphology/t/text_tradition_language.t
new file mode 100644 (file)
index 0000000..92f736a
--- /dev/null
+++ b/morphology/t/text_tradition_language.t
@@ -0,0 +1,38 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More 'no_plan';
+$| = 1;
+
+
+
+# =begin testing
+{
+use Test::Warn;
+use TryCatch;
+use_ok( 'Text::Tradition' ); # with Language
+
+# Test setting and recovering language
+my $t = Text::Tradition->new( input => 'Self', file => 't/data/legendfrag.xml' );
+warning_like { $t->language( 'Klingon' ); } qr/^Cannot load language/,
+       "Got expected warning for setting of unsupported language";
+$t->language( 'English' );
+is( $t->language, 'English', "Successfully set supported language" );
+
+# Test bad attempt to lemmatize - proper lemmatization is tested separately
+my $bt = Text::Tradition->new( input => 'Self', file => 't/data/besoin.xml' );
+try {
+       $bt->lemmatize;
+       ok( 0, "Failed to throw error on lemmatizing without language" );
+} catch( Text::Tradition::Error $e ) {
+       is( $e->message, "Please set a language to lemmatize a tradition",
+               "Got correct error thrown for lemmatization without set language" );
+} catch {
+       ok( 0, "Unexpected error on bad lemmatization attempt" );
+}
+}
+
+
+
+
+1;