add witness role for collation regularization

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

diff --git a/morphology/lib/Text/Tradition/Language/Latin.pm b/morphology/lib/Text/Tradition/Language/Latin.pm
index ad36208..c2b89f8 100644 (file)
--- a/morphology/lib/Text/Tradition/Language/Latin.pm
+++ b/morphology/lib/Text/Tradition/Language/Latin.pm
@@ -20,21 +20,25 @@ depends on the Lingua::Morph::Perseus module for access to PhiloLogic database d
 
 Evaluates the string using Treetagger and Perseus, and returns the results.
 
+=head2 reading_lookup( $word )
+
+Returns a single-word morphological lookup of the given word using Perseus.
+
 =begin testing
 
 use Text::Tradition;
 use_ok( 'Text::Tradition::Language::Latin' );
 
+my $trad = Text::Tradition->new(
+       'language' => 'Latin',
+       'file' => 't/data/legendfrag.xml',
+       'input' => 'Self' );
+
 eval "use Lingua::Morph::Perseus";
 my $err = $@;
-
 SKIP: {
        skip "Package Lingua::Morph::Perseus not found" if $err;
 
-       my $trad = Text::Tradition->new(
-               'language' => 'Latin',
-               'file' => 't/data/legendfrag.xml',
-               'input' => 'Self' );
        $trad->lemmatize();
        my $ambig = 0;
        foreach my $r ( $trad->collation->readings ) {
@@ -55,6 +59,17 @@ SKIP: {
        }
        is( $ambig, 4, "Found 4 ambiguous forms as expected" );
 }
+       
+# Try exporting some witnesses
+my $e_v = 'in suetia uenerabilis pontifex beatus henricus in anglia oriundus';
+my $struct_v = $trad->witness('V')->export_as_json;
+my $g_v = join( ' ', map { $_->{'n'} } @{$struct_v->{'tokens'}} );
+is( $g_v, $e_v, "Got expected regularization of witness V" );
+my $e_n = 'in suetia beatus henricus uenerabilis pontifex de anglia oriundus';
+my $struct_n = $trad->witness('N')->export_as_json;
+my $g_n = join( ' ', map { $_->{'n'} } @{$struct_n->{'tokens'}} );
+is( $g_n, $e_n, "Got expected regularization of witness N" );
+
 
 =end testing
 
@@ -70,5 +85,22 @@ sub reading_lookup {
        return __PACKAGE__->perseus_reading_lookup( @_ );
 }
 
+=head2 regularize( $text )
+
+Returns a regularized form of the reading for the purposes of collation.
+
+=cut
+
+sub regularize {
+       my( $word ) = @_;
+       $word = lc( $word );
+       $word =~ s/v/u/g;
+       $word =~ s/w/u/g;
+       $word =~ s/j/i/g;
+       $word =~ s/ci/ti/g;
+       $word =~ s/cha/ca/g;
+       return $word;
+}
+
 1;