if( $@ ) {
warn "Text::Tradition::Analysis not found. Disabling stemma analysis functionality";
};
+eval { with 'Text::Tradition::Language'; };
has 'collation' => (
is => 'ro',
default => 'Tradition',
);
-has 'language' => (
- is => 'rw',
- isa => 'Str',
- predicate => 'has_language',
- );
-
has '_initialized' => (
is => 'ro',
isa => 'Bool',
# TODO allow add of a Witness object?
my %args = @_ == 1 ? %{$_[0]} : @_;
$args{'tradition'} = $self;
- $args{'language'} = $self->language
- if( $self->language && !exists $args{'language'} );
my $new_wit = Text::Tradition::Witness->new( %args );
$self->$orig( $new_wit->sigil => $new_wit );
return $new_wit;
}
}
-=head2 lemmatize
-
-Calls the appropriate lemmatization function for the language of the
-tradition. Will throw an error if the Morphology package is not installed.
-
-=cut
-
-# TODO find a better way to hook this
-sub lemmatize {
- my $self = shift;
- unless( $self->has_language ) {
- warn "Please set a language to lemmatize a tradition";
- return;
- }
- my $mod = "Text::Tradition::Language::" . $self->language;
- load( $mod );
- $mod->can( 'lemmatize' )->( $self );
-}
-
sub throw {
Text::Tradition::Error->throw(
'ident' => 'Tradition error',
# If we are initializing an empty collation, don't assume that we
# have set a tradition.
delete $args{'init'};
- } elsif( $self->tradition->has_language && !exists $args{'language'} ) {
+ } elsif( $self->tradition->can('language') && !exists $args{'language'} ) {
$args{'language'} = $self->tradition->language;
}
$reading = Text::Tradition::Collation::Reading->new(
use TryCatch;
my $t1;
-warning_is {
+warnings_exist {
$t1 = Text::Tradition->new( 'input' => 'Self', 'file' => 't/data/legendfrag.xml' );
-} 'DROPPING r14.2 -> r8.1: Cannot set relationship on a meta reading',
+} [qr/Cannot set relationship on a meta reading/],
"Got expected relationship drop warning on parse";
# Test 1.1: try to equate nodes that are prevented with an intermediate collation
# Test 2.1: try to equate nodes that are prevented with a real intermediate
# equivalence
my $t2;
-warning_is {
+warnings_exist {
$t2 = Text::Tradition->new( 'input' => 'Self', 'file' => 't/data/legendfrag.xml' );
-} 'DROPPING r14.2 -> r8.1: Cannot set relationship on a meta reading',
+} [qr/Cannot set relationship on a meta reading/],
"Got expected relationship drop warning on parse";
my $c2 = $t2->collation;
$c2->add_relationship( 'r9.2', 'r9.3', { 'type' => 'lexical' } );
my( $self, $rel ) = @_;
my $c = $self->collation;
# TODO Someday we might use a case sensitive language.
- my $lang = $c->tradition->language;
my @vectors;
my @identical_readings;
if( $rel->type eq 'orthographic' ) {
# TODO add a relationship, add a stemma, write graphml, reparse it, check that
# the new data is there
-$t->language('Greek');
+my $language_enabled = $t->can('language');
+if( $language_enabled ) {
+ $t->language('Greek');
+}
my $stemma_enabled = $t->can('add_stemma');
if( $stemma_enabled ) {
$t->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
is( scalar $newt->collation->paths, 376, "Collation has all paths" );
is( scalar $newt->witnesses, 13, "Collation has all witnesses" );
is( scalar $newt->collation->relationships, 1, "Collation has added relationship" );
- is( $newt->language, 'Greek', "Tradition has correct language setting" );
+ if( $language_enabled ) {
+ is( $newt->language, 'Greek', "Tradition has correct language setting" );
+ }
my $rel = $newt->collation->get_relationship( 'w12', 'w13' );
ok( $rel, "Found set relationship" );
is( $rel->annotation, 'This is some note', "Relationship has its properties" );
} else {
warn "Analysis module not installed; DROPPING stemmata";
}
+ } elsif( $gkey eq 'language' ) {
+ if( $tradition->can('language') ) {
+ $tradition->language( $val );
+ } else {
+ warn "Morphology module not installed; DROPPING language";
+ }
} elsif( $gkey eq 'user' ) {
# Assign the tradition to the user if we can
if( exists $opts->{'userstore'} ) {
use_text should be set to an XPath expression that will select the correct
text.
-=item * language - The name of the applicable L<Text::Tradition::Lang>
-module for language handling. Usually inherited from the language set in
-the L<Text::Tradition> object, and defaults to Default.
-
=item * identifier - The recognized name of the manuscript, e.g. a library
identifier. Taken from the msDesc element for a TEI file.
has been instantiated, and the path through the collation should always
match it.
-=head2 language
-
-Accessor method to get the witness language.
-
=head2 identifier
Accessor method for the witness identifier.
writer => '_set_sigil',
);
-has 'language' => (
- is => 'ro',
- isa => 'Str',
- default => 'Default',
- );
-
# Other identifying information
has 'identifier' => (
is => 'rw',
my @words;
foreach my $w ( @raw_words ) {
my $id = $self->sigil . 'r'. $c++;
- my %opts = ( 'text' => $w, 'id' => $id, 'language' => $self->language );
+ my %opts = ( 'text' => $w, 'id' => $id );
my $w_obj = $self->tradition->collation->add_reading( \%opts );
# Skip any words that have been canonized out of existence.
next if( length( $w_obj->text ) == 0 );
use TryCatch;
my $t1;
-warning_is {
+warnings_exist {
$t1 = Text::Tradition->new( 'input' => 'Self', 'file' => 't/data/legendfrag.xml' );
-} 'DROPPING r14.2 -> r8.1: Cannot set relationship on a meta reading',
+} [qr/Cannot set relationship on a meta reading/],
"Got expected relationship drop warning on parse";
# Test 1.1: try to equate nodes that are prevented with an intermediate collation
# Test 2.1: try to equate nodes that are prevented with a real intermediate
# equivalence
my $t2;
-warning_is {
+warnings_exist {
$t2 = Text::Tradition->new( 'input' => 'Self', 'file' => 't/data/legendfrag.xml' );
-} 'DROPPING r14.2 -> r8.1: Cannot set relationship on a meta reading',
+} [qr/Cannot set relationship on a meta reading/],
"Got expected relationship drop warning on parse";
my $c2 = $t2->collation;
$c2->add_relationship( 'r9.2', 'r9.3', { 'type' => 'lexical' } );
# TODO add a relationship, add a stemma, write graphml, reparse it, check that
# the new data is there
-$t->language('Greek');
+my $language_enabled = $t->can('language');
+if( $language_enabled ) {
+ $t->language('Greek');
+}
my $stemma_enabled = $t->can('add_stemma');
if( $stemma_enabled ) {
$t->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
is( scalar $newt->collation->paths, 376, "Collation has all paths" );
is( scalar $newt->witnesses, 13, "Collation has all witnesses" );
is( scalar $newt->collation->relationships, 1, "Collation has added relationship" );
- is( $newt->language, 'Greek', "Tradition has correct language setting" );
+ if( $language_enabled ) {
+ is( $newt->language, 'Greek', "Tradition has correct language setting" );
+ }
my $rel = $newt->collation->get_relationship( 'w12', 'w13' );
ok( $rel, "Found set relationship" );
is( $rel->annotation, 'This is some note', "Relationship has its properties" );
--- /dev/null
+package Text::Tradition::Language;
+
+use strict;
+use warnings;
+use Moose::Role;
+
+=head1 NAME
+
+Text::Tradition::Language - add-on role to enable language awareness and
+morphology functions to a Text::Tradition object. See also
+L<Text::Tradition::Morphology> for individual reading morphologies.
+
+=head1 METHODS
+
+=head2 language
+
+Accessor for the primary language of the tradition. Must correspond to one
+of the Text::Tradition::Language::* modules in this package.
+
+=cut
+
+has 'language' => (
+ is => 'rw',
+ isa => 'Str',
+ predicate => 'has_language',
+ );
+
+before 'language' => sub {
+ my $self = shift;
+ 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 @_: $@" );
+ }
+ }
+};
+
+=head2 lemmatize
+
+Calls the appropriate lemmatization function for the language of the
+tradition.
+
+=cut
+
+sub lemmatize {
+ my $self = shift;
+ unless( $self->has_language ) {
+ throw( "Please set a language to lemmatize a tradition" );
+ }
+ my $mod = "Text::Tradition::Language::" . $self->language;
+ load( $mod );
+ $mod->can( 'lemmatize' )->( $self );
+}
+
+1;
+
+=head1 LICENSE
+
+This package is free software and is provided "as is" without express
+or implied warranty. You can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Tara L Andrews E<lt>aurum@cpan.orgE<gt>
}
1;
+
+=head1 LICENSE
+
+This package is free software and is provided "as is" without express
+or implied warranty. You can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Tara L Andrews E<lt>aurum@cpan.orgE<gt>
}
1;
+
+=head1 LICENSE
+
+This package is free software and is provided "as is" without express
+or implied warranty. You can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Tara L Andrews E<lt>aurum@cpan.orgE<gt>
}
1;
+
+=head1 LICENSE
+
+This package is free software and is provided "as is" without express
+or implied warranty. You can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Tara L Andrews E<lt>aurum@cpan.orgE<gt>
}
1;
+
+=head1 LICENSE
+
+This package is free software and is provided "as is" without express
+or implied warranty. You can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Tara L Andrews E<lt>aurum@cpan.orgE<gt>
}
};
-1;
\ No newline at end of file
+1;
+
+=head1 LICENSE
+
+This package is free software and is provided "as is" without express
+or implied warranty. You can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Tara L Andrews E<lt>aurum@cpan.orgE<gt>
projects / scpubgit/stemmatology.git / commitdiff