*~
-*.bbprojectd/
-t/var
+*/t/var
data
-!/t/data
+!*/t/data
Makefile
Makefile.old
META.yml
blib
db
inc
+blib/
+.build/
+_build/
+cover_db/
+inc/
+Build
+Build.bat
+.last_cover_stats
+MANIFEST.bak
+MYMETA.yml
+nytprof.out
+pm_to_blib
+++ /dev/null
-lib/Text/Tradition/Parser/BaseText.pm
-lib/Text/Tradition/Parser/CollateText.pm
-lib/Text/Tradition/Parser/CTE.pm
-lib/Text/Tradition/Parser/KUL.pm
-lib/Text/Tradition/Analysis.pm
-lib/Text/Tradition/Analysis/Result.pm
-t/analysis.t
-t/text_tradition_analysis.t
-t/text_tradition_analysis_result.t
-.git/
-.gitignore
--- /dev/null
+#!/usr/bin/env perl
+
+use inc::Module::Install;
+author( 'Tara L Andrews <aurum@cpan.org>' );
+license( 'perl' );
+perl_version( '5.012' );
+all_from( 'lib/Text/Tradition/Analysis.pm' );
+requires( 'Algorithm::Diff' );
+requires( 'Bio::Phylo::IO' );
+requires( 'File::chdir' );
+requires( 'File::Which' );
+requires( 'Graph' );
+requires( 'Graph::Reader::Dot' );
+requires( 'IPC::Run' );
+requires( 'JSON' );
+requires( 'LWP::UserAgent' );
+requires( 'Moose' );
+requires( 'Moose::Role' );
+requires( 'Set::Scalar' );
+requires( 'Text::Tradition' );
+requires( 'Text::Tradition::Directory' );
+requires( 'Text::Tradition::Error' );
+requires( 'TryCatch' );
+
+build_requires( 'Test::More::UTF8' );
+&WriteAll;
use Text::Tradition::Stemma;
use TryCatch;
-use vars qw/ @EXPORT_OK /;
+use vars qw/ @EXPORT_OK $VERSION /;
@EXPORT_OK = qw/ run_analysis group_variants analyze_variant_location wit_stringify /;
+$VERSION = "1.0";
+
my $SOLVER_URL = 'http://byzantini.st/cgi-bin/graphcalc.cgi';
my $unsolved_problems = {};
'name' => 'this is a text',
'input' => 'TEI',
'file' => '/path/to/tei_parallel_seg_file.xml' );
+ $t->enable_stemmata;
$t->add_stemma( 'dotfile' => $stemmafile );
my $variant_data = run_analysis( $tradition );
=head1 DESCRIPTION
Text::Tradition is a library for representation and analysis of collated
-texts, particularly medieval ones. The Collation is the central feature of
-a Tradition, where the text, its sequence of readings, and its relationships
-between readings are actually kept.
+texts, particularly medieval ones. Where the Collation is the central feature of
+a Tradition, it may also have one or more temmata associated with it, and these stemmata may be analyzed. This package provides the following modules:
+
+=over 4
+
+=item * L<Text::Tradition::HasStemma> - a role that can be composed into Text::Tradition objects, providing the ability for Text::Tradition::Stemma objects to be associated with them.
+
+=item * L<Text::Tradition::Stemma> - an object class that represents stemma hypotheses, both rooted (with a single archetype) and unrooted (e.g. phylogenetic trees).
+
+=item * Text::Tradition::Analysis (this package). Provides functions for the analysis of a given stemma against the collation within a given Tradition.
+
+=back
=head1 SUBROUTINES
my $tradition = Text::Tradition->new( 'input' => 'TEI',
'name' => 'test0',
'file' => $datafile );
+$tradition->enable_stemmata;
my $s = $tradition->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
is( ref( $s ), 'Text::Tradition::Stemma', "Added stemma to tradition" );
my $tradition = Text::Tradition->new( 'input' => 'TEI',
'name' => 'flortest',
'file' => $datafile );
+$tradition->enable_stemmata;
my $s = $tradition->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
my $sets = [ [ qw/ D Q / ], [ qw/ F H / ], [ qw/ A B C P S T / ] ];
--- /dev/null
+package Text::Tradition::HasStemma;
+
+use strict;
+use warnings;
+use Moose::Role;
+use Text::Tradition::Stemma;
+
+=head1 NAME
+
+Text::Tradition::HasStemma - add-on to associate stemma hypotheses to Text::Tradition objects
+
+=head1 DESCRIPTION
+
+It is often the case that, for a given text tradition, the order of copying of the witnesses can or should be reconstructed (or at least the attempt should be made.) This class is a role that can be applied to Text::Tradition objects to record stemma hypotheses. See the documentation for L<Text::Tradition::Stemma> for more information.
+
+=head1 METHODS
+
+=head2 stemmata
+
+Return a list of all stemmata associated with the tradition.
+
+=head2 stemma_count
+
+Return the number of stemma hypotheses defined for this tradition.
+
+=head2 stemma( $idx )
+
+Return the L<Text::Tradition::Stemma> object identified by the given index.
+
+=head2 clear_stemmata
+
+Delete all stemma hypotheses associated with this tradition.
+
+=cut
+
+has 'stemmata' => (
+ traits => ['Array'],
+ isa => 'ArrayRef[Text::Tradition::Stemma]',
+ handles => {
+ stemmata => 'elements',
+ _add_stemma => 'push',
+ stemma => 'get',
+ stemma_count => 'count',
+ clear_stemmata => 'clear',
+ },
+ default => sub { [] },
+ );
+
+
+=head2 add_stemma( $dotfile )
+
+Initializes a Text::Tradition::Stemma object from the given dotfile,
+and associates it with the tradition.
+
+=begin testing
+
+use Text::Tradition;
+
+my $t = Text::Tradition->new(
+ 'name' => 'simple test',
+ 'input' => 'Tabular',
+ 'file' => 't/data/simple.txt',
+ );
+$t->enable_stemmata;
+is( $t->stemma_count, 0, "No stemmas added yet" );
+my $s;
+ok( $s = $t->add_stemma( dotfile => 't/data/simple.dot' ), "Added a simple stemma" );
+is( ref( $s ), 'Text::Tradition::Stemma', "Got a stemma object returned" );
+is( $t->stemma_count, 1, "Tradition claims to have a stemma" );
+is( $t->stemma(0), $s, "Tradition hands back the right stemma" );
+
+=end testing
+
+=cut
+
+sub add_stemma {
+ my $self = shift;
+ my %opts = @_;
+ my $stemma_fh;
+ if( $opts{'dotfile'} ) {
+ open $stemma_fh, '<', $opts{'dotfile'}
+ or warn "Could not open file " . $opts{'dotfile'};
+ } elsif( $opts{'dot'} ) {
+ my $str = $opts{'dot'};
+ open $stemma_fh, '<', \$str;
+ }
+ # Assume utf-8
+ binmode $stemma_fh, ':utf8';
+ my $stemma = Text::Tradition::Stemma->new(
+ 'dot' => $stemma_fh );
+ $self->_add_stemma( $stemma ) if $stemma;
+ return $stemma;
+}
+
+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>
package Text::Tradition::Stemma;
-use Bio::Phylo::IO;
use Encode qw( decode_utf8 );
use File::Temp;
use Graph;
use File::Temp;
use File::Which;
use Graph;
-use Graph::Reader::Dot;
use IPC::Run qw/ run binary /;
use Text::Tradition::Error;
use Text::Tradition::Stemma;
my $tradition = Text::Tradition->new(
'input' => 'Self',
'file' => 't/data/besoin.xml' );
+$tradition->enable_stemmata;
$tradition->add_stemma( 'dotfile' => 't/data/besoin.dot' );
# Run the analysis of the tradition
use lib 'lib';
use Text::Tradition;
use Text::Tradition::StemmaUtil qw/ character_input phylip_pars parse_newick /;
-use XML::LibXML;
-use XML::LibXML::XPathContext;
+use TryCatch;
my $datafile = 't/data/Collatex-16.xml'; #TODO need other test data
$c->add_relationship( 'n12', 'n13', { 'type' => 'spelling' } );
$c->calculate_ranks();
+$tradition->enable_stemmata;
my $stemma = $tradition->add_stemma( dotfile => 't/data/simple.dot' );
# Test for object creation
# Test that pars runs
SKIP: {
- skip "pars not in path", 3 unless File::Which::which('pars');
- my $newick = phylip_pars( $mstr );
- ok( $newick, "pars ran successfully" );
+ skip "pars not in path", 3 unless File::Which::which('pars');
+ my $newick = phylip_pars( $mstr );
+ ok( $newick, "pars ran successfully" );
my $trees = parse_newick( $newick );
- # Test that we get a tree
- is( scalar @$trees, 1, "Got a single tree" );
- # Test that the tree has all our witnesses
- my $tree = $trees->[0];
- is( scalar $tree->witnesses, 3, "All witnesses in the tree" );
+ # Test that we get a tree
+ is( scalar @$trees, 1, "Got a single tree" );
+ # Test that the tree has all our witnesses
+ my $tree = $trees->[0];
+ is( scalar $tree->witnesses, 3, "All witnesses in the tree" );
}
# Test our dot output
my $editable = $stemma->editable();
ok( $editable =~ /digraph/, "Got a dot edit graph" );
ok( $editable =~ /hypothetical/, "Graph contains an edit class" );
-
done_testing();
my $tradition = Text::Tradition->new( 'input' => 'TEI',
'name' => 'test0',
'file' => $datafile );
+$tradition->enable_stemmata;
my $s = $tradition->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
is( ref( $s ), 'Text::Tradition::Stemma', "Added stemma to tradition" );
my $tradition = Text::Tradition->new( 'input' => 'TEI',
'name' => 'flortest',
'file' => $datafile );
+$tradition->enable_stemmata;
my $s = $tradition->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
my $sets = [ [ qw/ D Q / ], [ qw/ F H / ], [ qw/ A B C P S T / ] ];
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More 'no_plan';
+$| = 1;
+
+
+
+# =begin testing
+{
+use Text::Tradition;
+
+my $t = Text::Tradition->new(
+ 'name' => 'simple test',
+ 'input' => 'Tabular',
+ 'file' => 't/data/simple.txt',
+ );
+$t->enable_stemmata;
+is( $t->stemma_count, 0, "No stemmas added yet" );
+my $s;
+ok( $s = $t->add_stemma( dotfile => 't/data/simple.dot' ), "Added a simple stemma" );
+is( ref( $s ), 'Text::Tradition::Stemma', "Got a stemma object returned" );
+is( $t->stemma_count, 1, "Tradition claims to have a stemma" );
+is( $t->stemma(0), $s, "Tradition hands back the right stemma" );
+}
+
+
+
+
+1;
--- /dev/null
+lib/Text/Tradition/Parser/BaseText.pm
+lib/Text/Tradition/Parser/CollateText.pm
+lib/Text/Tradition/Parser/KUL.pm
+.git/
+.gitignore
requires( 'KiokuX::User::Util' );
requires( 'Module::Load' );
requires( 'Moose' );
+requires( 'Moose::Util' );
requires( 'Moose::Util::TypeConstraints' );
+requires( 'Safe::Isa' );
requires( 'Spreadsheet::ParseExcel' );
requires( 'Spreadsheet::XLSX' );
requires( 'StackTrace::Auto' );
use JSON qw / from_json /;
use Module::Load;
use Moose;
+use Moose::Util qw/ does_role apply_all_roles /;
use Text::Tradition::Collation;
-use Text::Tradition::Stemma;
+use Text::Tradition::Error;
use Text::Tradition::Witness;
use Text::Tradition::User;
+use TryCatch;
use vars qw( $VERSION );
$VERSION = "0.5";
predicate => 'has_language',
);
-has 'stemmata' => (
- traits => ['Array'],
- isa => 'ArrayRef[Text::Tradition::Stemma]',
- handles => {
- stemmata => 'elements',
- _add_stemma => 'push',
- stemma => 'get',
- stemma_count => 'count',
- clear_stemmata => 'clear',
- },
- default => sub { [] },
- );
-
has '_initialized' => (
is => 'ro',
isa => 'Bool',
}
}
-=head2 add_stemma( $dotfile )
-
-Initializes a Text::Tradition::Stemma object from the given dotfile,
-and associates it with the tradition.
-
-=begin testing
-
-use Text::Tradition;
+=head1 PLUGIN HOOKS
-my $t = Text::Tradition->new(
- 'name' => 'simple test',
- 'input' => 'Tabular',
- 'file' => 't/data/simple.txt',
- );
-
-is( $t->stemma_count, 0, "No stemmas added yet" );
-my $s;
-ok( $s = $t->add_stemma( dotfile => 't/data/simple.dot' ), "Added a simple stemma" );
-is( ref( $s ), 'Text::Tradition::Stemma', "Got a stemma object returned" );
-is( $t->stemma_count, 1, "Tradition claims to have a stemma" );
-is( $t->stemma(0), $s, "Tradition hands back the right stemma" );
+=head2 enable_stemmata();
-=end testing
+If the tradition in question does not have the HasStemma role, make it so. Throws
+an error if the role (ergo, if the Analysis package) is not installed.
=cut
-sub add_stemma {
+sub enable_stemmata {
my $self = shift;
- my %opts = @_;
- my $stemma_fh;
- if( $opts{'dotfile'} ) {
- open $stemma_fh, '<', $opts{'dotfile'}
- or warn "Could not open file " . $opts{'dotfile'};
- } elsif( $opts{'dot'} ) {
- my $str = $opts{'dot'};
- open $stemma_fh, '<', \$str;
+ my $rolename = 'Text::Tradition::HasStemma';
+ return 1 if does_role( $self, $rolename );
+ try {
+ apply_all_roles( $self, $rolename );
+ } catch {
+ throw( "Cannot apply role to enable stemmata; is the Analysis extension installed?" );
}
- # Assume utf-8
- binmode $stemma_fh, ':utf8';
- my $stemma = Text::Tradition::Stemma->new(
- 'dot' => $stemma_fh );
- $self->_add_stemma( $stemma ) if $stemma;
- return $stemma;
+ return 1;
}
sub lemmatize {
$mod->can( 'lemmatize' )->( $self );
}
+sub throw {
+ Text::Tradition::Error->throw(
+ 'ident' => 'Tradition error',
+ 'message' => $_[0],
+ );
+}
+
no Moose;
__PACKAGE__->meta->make_immutable;
=begin testing
use Text::Tradition;
+use TryCatch;
my $READINGS = 311;
my $PATHS = 361;
is( scalar $st->collation->relationships, 3, "Reparsed collation has new relationships" );
# Now add a stemma, write to GraphML, and look at the output.
-my $stemma = $tradition->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
-is( ref( $stemma ), 'Text::Tradition::Stemma', "Parsed dotfile into stemma" );
-is( $tradition->stemmata, 1, "Tradition now has the stemma" );
-$graphml = $c->as_graphml;
-like( $graphml, qr/digraph/, "Digraph declaration exists in GraphML" );
+my $SKIP_STEMMA;
+try {
+ $tradition->enable_stemmata;
+} catch {
+ $SKIP_STEMMA = 1;
+}
+SKIP: {
+ skip "Analysis module not present", 3 if $SKIP_STEMMA;
+ my $stemma = $tradition->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
+ is( ref( $stemma ), 'Text::Tradition::Stemma', "Parsed dotfile into stemma" );
+ is( $tradition->stemmata, 1, "Tradition now has the stemma" );
+ $graphml = $c->as_graphml;
+ like( $graphml, qr/digraph/, "Digraph declaration exists in GraphML" );
+}
# Now add a user, write to GraphML, and look at the output.
unlike( $graphml, qr/testuser/, "Test user name does not exist in GraphML yet" );
=cut
+## TODO MOVE this to Tradition.pm
sub as_graphml {
my( $self, $options ) = @_;
$self->calculate_ranks unless $self->_graphcalc_done;
}
# Extra custom keys for complex objects that should be saved in some form.
# The subroutine should return a string, or undef/empty.
- $graph_attributes{'stemmata'} = sub {
- my @stemstrs;
- map { push( @stemstrs, $_->editable( {linesep => ''} ) ) }
- $self->tradition->stemmata;
- join( "\n", @stemstrs );
- };
+ if( $tmeta->has_method('stemmata') ) {
+ $graph_attributes{'stemmata'} = sub {
+ my @stemstrs;
+ map { push( @stemstrs, $_->editable( {linesep => ''} ) ) }
+ $self->tradition->stemmata;
+ join( "\n", @stemstrs );
+ };
+ }
+
$graph_attributes{'user'} = sub {
$self->tradition->user ? $self->tradition->user->id : undef
};
use KiokuDB::GC::Naive;
use KiokuDB::TypeMap;
use KiokuDB::TypeMap::Entry::Naive;
+use Safe::Isa;
use Text::Tradition::Error;
## users
);
my $tradition = Text::Tradition->new( @args );
+ $tradition->enable_stemmata;
my $stemma = $tradition->add_stemma( dotfile => $dotfile );
$d->save_tradition( $tradition );
use TryCatch;
use File::Temp;
+use Safe::Isa;
use Text::Tradition;
use_ok 'Text::Tradition::Directory';
'input' => 'Tabular',
'file' => 't/data/simple.txt',
);
+my $stemma_enabled;
+eval { $stemma_enabled = $t->enable_stemmata; };
{
my $d = Text::Tradition::Directory->new( 'dsn' => $dsn,
'extra_args' => { 'create' => 1 } );
- is( ref $d, 'Text::Tradition::Directory', "Got directory object" );
+ ok( $d->$_isa('Text::Tradition::Directory'), "Got directory object" );
my $scope = $d->new_scope;
$uuid = $d->save( $t );
ok( $uuid, "Saved test tradition" );
- my $s = $t->add_stemma( dotfile => 't/data/simple.dot' );
- ok( $d->save( $t ), "Updated tradition with stemma" );
- is( $d->tradition( $uuid ), $t, "Correct tradition returned for id" );
- is( $d->tradition( $uuid )->stemma(0), $s, "...and it has the correct stemma" );
- try {
- $d->save( $s );
- } catch( Text::Tradition::Error $e ) {
- is( $e->ident, 'database error', "Got exception trying to save stemma directly" );
- like( $e->message, qr/Cannot directly save non-Tradition object/,
- "Exception has correct message" );
+ SKIP: {
+ skip "Analysis package not installed", 5 unless $stemma_enabled;
+ my $s = $t->add_stemma( dotfile => 't/data/simple.dot' );
+ ok( $d->save( $t ), "Updated tradition with stemma" );
+ is( $d->tradition( $uuid ), $t, "Correct tradition returned for id" );
+ is( $d->tradition( $uuid )->stemma(0), $s, "...and it has the correct stemma" );
+ try {
+ $d->save( $s );
+ } catch( Text::Tradition::Error $e ) {
+ is( $e->ident, 'database error', "Got exception trying to save stemma directly" );
+ like( $e->message, qr/Cannot directly save non-Tradition object/,
+ "Exception has correct message" );
+ }
}
}
my $nt = Text::Tradition->new(
'input' => 'CollateX',
'file' => 't/data/Collatex-16.xml',
);
-is( ref( $nt ), 'Text::Tradition', "Made new tradition" );
+ok( $nt->$_isa('Text::Tradition'), "Made new tradition" );
{
my $f = Text::Tradition::Directory->new( 'dsn' => $dsn );
my( $tlobj ) = grep { $_->{'id'} eq $uuid } @tlist;
is( $tlobj->{'name'}, $tf->name, "Directory index has correct tradition name" );
is( $tf->name, $t->name, "Retrieved the tradition from a new directory" );
- my $sid = $f->object_to_id( $tf->stemma(0) );
- try {
- $f->tradition( $sid );
- } catch( Text::Tradition::Error $e ) {
- is( $e->ident, 'database error', "Got exception trying to fetch stemma directly" );
- like( $e->message, qr/not a Text::Tradition/, "Exception has correct message" );
- }
- try {
- $f->delete( $sid );
- } catch( Text::Tradition::Error $e ) {
- is( $e->ident, 'database error', "Got exception trying to delete stemma directly" );
- like( $e->message, qr/Cannot directly delete non-Tradition object/,
- "Exception has correct message" );
+ my $sid;
+ SKIP: {
+ skip "Analysis package not installed", 4 unless $stemma_enabled;
+ $sid = $f->object_to_id( $tf->stemma(0) );
+ try {
+ $f->tradition( $sid );
+ } catch( Text::Tradition::Error $e ) {
+ is( $e->ident, 'database error', "Got exception trying to fetch stemma directly" );
+ like( $e->message, qr/not a Text::Tradition/, "Exception has correct message" );
+ }
+ try {
+ $f->delete( $sid );
+ } catch( Text::Tradition::Error $e ) {
+ is( $e->ident, 'database error', "Got exception trying to delete stemma directly" );
+ like( $e->message, qr/Cannot directly delete non-Tradition object/,
+ "Exception has correct message" );
+ }
}
$f->delete( $uuid );
ok( !$f->exists( $uuid ), "Object is deleted from DB" );
- ok( !$f->exists( $sid ), "Object stemma also deleted from DB" );
+ ok( !$f->exists( $sid ), "Object stemma also deleted from DB" ) if $stemma_enabled;
is( scalar $f->traditionlist, 1, "Object is deleted from index" );
}
my $self = shift;
my @nontrad;
foreach my $obj ( @_ ) {
- if( ref( $obj ) && ref( $obj ) ne 'Text::Tradition'
- && ref ($obj) ne 'Text::Tradition::User' ) {
+ if( ref( $obj ) && !$obj->$_isa( 'Text::Tradition' )
+ && !$obj->$_isa('Text::Tradition::User') ) {
# Is it an id => Tradition hash?
if( ref( $obj ) eq 'HASH' && keys( %$obj ) == 1 ) {
my( $k ) = keys %$obj;
- next if ref( $obj->{$k} ) eq 'Text::Tradition';
+ next if $obj->{$k}->$_isa('Text::Tradition');
}
push( @nontrad, $obj );
}
}
}
}
- if( $obj && ref( $obj ) ne 'Text::Tradition' ) {
+ if( $obj && !$obj->$_isa('Text::Tradition') ) {
throw( "Retrieved object is a " . ref( $obj ) . ", not a Text::Tradition" );
}
return $obj;
=begin testing
use File::Temp;
+use Safe::Isa;
use Test::Warn;
use Text::Tradition;
+use TryCatch;
binmode STDOUT, ":utf8";
binmode STDERR, ":utf8";
eval { no warnings; binmode $DB::OUT, ":utf8"; };
'file' => $tradition,
);
-is( ref( $t ), 'Text::Tradition', "Parsed GraphML version 2" );
+ok( $t->$_isa('Text::Tradition'), "Parsed GraphML version 2" );
if( $t ) {
is( scalar $t->collation->readings, 319, "Collation has all readings" );
is( scalar $t->collation->paths, 376, "Collation has all paths" );
# TODO add a relationship, add a stemma, write graphml, reparse it, check that
# the new data is there
$t->language('Greek');
-$t->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
+my $stemma_enabled;
+try {
+ $stemma_enabled = $t->enable_stemmata;
+} catch {
+ ok( 1, "Skipping stemma tests without Analysis module" );
+}
+if( $stemma_enabled ) {
+ $t->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
+}
$t->collation->add_relationship( 'w12', 'w13',
{ 'type' => 'grammatical', 'scope' => 'global',
'annotation' => 'This is some note' } );
my $graphml_str = $t->collation->as_graphml;
my $newt = Text::Tradition->new( 'input' => 'Self', 'string' => $graphml_str );
-is( ref( $newt ), 'Text::Tradition', "Parsed current GraphML version" );
+ok( $newt->$_isa('Text::Tradition'), "Parsed current GraphML version" );
if( $newt ) {
is( scalar $newt->collation->readings, 319, "Collation has all readings" );
is( scalar $newt->collation->paths, 376, "Collation has all paths" );
my $rel = $newt->collation->get_relationship( 'w12', 'w13' );
ok( $rel, "Found set relationship" );
is( $rel->annotation, 'This is some note', "Relationship has its properties" );
- is( scalar $newt->stemmata, 1, "Tradition has its stemma" );
- is( $newt->stemma(0)->witnesses, $t->stemma(0)->witnesses, "Stemma has correct length witness list" );
+ if( $stemma_enabled ) {
+ is( scalar $newt->stemmata, 1, "Tradition has its stemma" );
+ is( $newt->stemma(0)->witnesses, $t->stemma(0)->witnesses, "Stemma has correct length witness list" );
+ }
}
# Test user save / restore
extra_args => { create => 1 } } );
my $scope = $userstore->new_scope();
my $testuser = $userstore->create_user( { url => 'http://example.com' } );
-is( ref( $testuser ), 'Text::Tradition::User', "Created test user via userstore" );
+ok( $testuser->$_isa('Text::Tradition::User'), "Created test user via userstore" );
$testuser->add_tradition( $newt );
is( $newt->user->id, $testuser->id, "Assigned tradition to test user" );
$graphml_str = $newt->collation->as_graphml;
'userstore' => $userstore );
is( $usert->user->id, $testuser->id, "Parsed tradition with userstore points to correct user" );
+# Test warning if we can
+unless( $stemma_enabled ) {
+ my $nst;
+ warnings_exist {
+ $nst = Text::Tradition->new( 'input' => 'Self', 'file' => 't/data/lexformat.xml' );
+ } [qr/DROPPING stemmata/],
+ "Got expected stemma drop warning on parse";
+}
=end testing
if( $gkey eq 'version' ) {
$use_version = $val;
} elsif( $gkey eq 'stemmata' ) {
+ # Make sure we can handle stemmata
+ my $stemma_enabled;
+ try {
+ $stemma_enabled = $tradition->enable_stemmata;
+ } catch {
+ warn "Analysis module not installed; DROPPING stemmata";
+ }
# Parse the stemmata into objects
- foreach my $dotstr ( split( /\n/, $val ) ) {
- $tradition->add_stemma( 'dot' => $dotstr );
+ if( $stemma_enabled ) {
+ foreach my $dotstr ( split( /\n/, $val ) ) {
+ $tradition->add_stemma( 'dot' => $dotstr );
+ }
}
} elsif( $gkey eq 'user' ) {
# Assign the tradition to the user if we can
use lib 'lib';
use strict;
use warnings;
+use Safe::Isa;
use Test::More;
use Text::Tradition;
string => $graphmlstr,
language => 'French' );
-is( ref $tf2, 'Text::Tradition', "Re-parsed tradition with lemmatization" );
+ok( $tf2->$_isa('Text::Tradition'), "Re-parsed tradition with lemmatization" );
is( $tf->name, $tf2->name, "Traditions have same name" );
foreach my $r ( $tf->collation->readings ) {
my $r2 = $tf2->collation->reading( $r->id );
- is( ref $r2, 'Text::Tradition::Collation::Reading',
+ ok( $r2->$_isa('Text::Tradition::Collation::Reading'),
"Reading $r exists in new tradition" );
if( $r2 ) {
is( scalar $r->lexemes, scalar $r2->lexemes,
my $tf3 = Text::Tradition->new(
'input' => 'Self',
'file' => 't/data/lexformat.xml' );
-is( ref $tf3, 'Text::Tradition',
+ok( $tf3->$_isa('Text::Tradition'),
"Successfully parsed tradition with incomplete lexemes" );
done_testing();
# 'input' => 'Tabular',
# 'file' => 't/data/simple.txt',
);
-$tradition->add_stemma(dotfile => "t/data/${test_name}.dot");
+#$tradition->add_stemma(dotfile => "t/data/${test_name}.dot");
#my $fh = File::Temp->new();
#my $file = $fh->filename;
-# =begin testing
-{
-use Text::Tradition;
-
-my $t = Text::Tradition->new(
- 'name' => 'simple test',
- 'input' => 'Tabular',
- 'file' => 't/data/simple.txt',
- );
-
-is( $t->stemma_count, 0, "No stemmas added yet" );
-my $s;
-ok( $s = $t->add_stemma( dotfile => 't/data/simple.dot' ), "Added a simple stemma" );
-is( ref( $s ), 'Text::Tradition::Stemma', "Got a stemma object returned" );
-is( $t->stemma_count, 1, "Tradition claims to have a stemma" );
-is( $t->stemma(0), $s, "Tradition hands back the right stemma" );
-}
-
-
-
1;
# =begin testing
{
use Text::Tradition;
+use TryCatch;
my $READINGS = 311;
my $PATHS = 361;
is( scalar $st->collation->relationships, 3, "Reparsed collation has new relationships" );
# Now add a stemma, write to GraphML, and look at the output.
-my $stemma = $tradition->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
-is( ref( $stemma ), 'Text::Tradition::Stemma', "Parsed dotfile into stemma" );
-is( $tradition->stemmata, 1, "Tradition now has the stemma" );
-$graphml = $c->as_graphml;
-like( $graphml, qr/digraph/, "Digraph declaration exists in GraphML" );
+my $SKIP_STEMMA;
+try {
+ $tradition->enable_stemmata;
+} catch {
+ $SKIP_STEMMA = 1;
+}
+SKIP: {
+ skip "Analysis module not present", 3 if $SKIP_STEMMA;
+ my $stemma = $tradition->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
+ is( ref( $stemma ), 'Text::Tradition::Stemma', "Parsed dotfile into stemma" );
+ is( $tradition->stemmata, 1, "Tradition now has the stemma" );
+ $graphml = $c->as_graphml;
+ like( $graphml, qr/digraph/, "Digraph declaration exists in GraphML" );
+}
# Now add a user, write to GraphML, and look at the output.
unlike( $graphml, qr/testuser/, "Test user name does not exist in GraphML yet" );
{
use TryCatch;
use File::Temp;
+use Safe::Isa;
use Text::Tradition;
use_ok 'Text::Tradition::Directory';
'input' => 'Tabular',
'file' => 't/data/simple.txt',
);
+my $stemma_enabled;
+eval { $stemma_enabled = $t->enable_stemmata; };
{
my $d = Text::Tradition::Directory->new( 'dsn' => $dsn,
'extra_args' => { 'create' => 1 } );
- is( ref $d, 'Text::Tradition::Directory', "Got directory object" );
+ ok( $d->$_isa('Text::Tradition::Directory'), "Got directory object" );
my $scope = $d->new_scope;
$uuid = $d->save( $t );
ok( $uuid, "Saved test tradition" );
- my $s = $t->add_stemma( dotfile => 't/data/simple.dot' );
- ok( $d->save( $t ), "Updated tradition with stemma" );
- is( $d->tradition( $uuid ), $t, "Correct tradition returned for id" );
- is( $d->tradition( $uuid )->stemma(0), $s, "...and it has the correct stemma" );
- try {
- $d->save( $s );
- } catch( Text::Tradition::Error $e ) {
- is( $e->ident, 'database error', "Got exception trying to save stemma directly" );
- like( $e->message, qr/Cannot directly save non-Tradition object/,
- "Exception has correct message" );
+ SKIP: {
+ skip "Analysis package not installed", 5 unless $stemma_enabled;
+ my $s = $t->add_stemma( dotfile => 't/data/simple.dot' );
+ ok( $d->save( $t ), "Updated tradition with stemma" );
+ is( $d->tradition( $uuid ), $t, "Correct tradition returned for id" );
+ is( $d->tradition( $uuid )->stemma(0), $s, "...and it has the correct stemma" );
+ try {
+ $d->save( $s );
+ } catch( Text::Tradition::Error $e ) {
+ is( $e->ident, 'database error', "Got exception trying to save stemma directly" );
+ like( $e->message, qr/Cannot directly save non-Tradition object/,
+ "Exception has correct message" );
+ }
}
}
my $nt = Text::Tradition->new(
'input' => 'CollateX',
'file' => 't/data/Collatex-16.xml',
);
-is( ref( $nt ), 'Text::Tradition', "Made new tradition" );
+ok( $nt->$_isa('Text::Tradition'), "Made new tradition" );
{
my $f = Text::Tradition::Directory->new( 'dsn' => $dsn );
my( $tlobj ) = grep { $_->{'id'} eq $uuid } @tlist;
is( $tlobj->{'name'}, $tf->name, "Directory index has correct tradition name" );
is( $tf->name, $t->name, "Retrieved the tradition from a new directory" );
- my $sid = $f->object_to_id( $tf->stemma(0) );
- try {
- $f->tradition( $sid );
- } catch( Text::Tradition::Error $e ) {
- is( $e->ident, 'database error', "Got exception trying to fetch stemma directly" );
- like( $e->message, qr/not a Text::Tradition/, "Exception has correct message" );
- }
- try {
- $f->delete( $sid );
- } catch( Text::Tradition::Error $e ) {
- is( $e->ident, 'database error', "Got exception trying to delete stemma directly" );
- like( $e->message, qr/Cannot directly delete non-Tradition object/,
- "Exception has correct message" );
+ my $sid;
+ SKIP: {
+ skip "Analysis package not installed", 4 unless $stemma_enabled;
+ $sid = $f->object_to_id( $tf->stemma(0) );
+ try {
+ $f->tradition( $sid );
+ } catch( Text::Tradition::Error $e ) {
+ is( $e->ident, 'database error', "Got exception trying to fetch stemma directly" );
+ like( $e->message, qr/not a Text::Tradition/, "Exception has correct message" );
+ }
+ try {
+ $f->delete( $sid );
+ } catch( Text::Tradition::Error $e ) {
+ is( $e->ident, 'database error', "Got exception trying to delete stemma directly" );
+ like( $e->message, qr/Cannot directly delete non-Tradition object/,
+ "Exception has correct message" );
+ }
}
$f->delete( $uuid );
ok( !$f->exists( $uuid ), "Object is deleted from DB" );
- ok( !$f->exists( $sid ), "Object stemma also deleted from DB" );
+ ok( !$f->exists( $sid ), "Object stemma also deleted from DB" ) if $stemma_enabled;
is( scalar $f->traditionlist, 1, "Object is deleted from index" );
}
# =begin testing
{
use File::Temp;
+use Safe::Isa;
use Test::Warn;
use Text::Tradition;
+use TryCatch;
binmode STDOUT, ":utf8";
binmode STDERR, ":utf8";
eval { no warnings; binmode $DB::OUT, ":utf8"; };
'file' => $tradition,
);
-is( ref( $t ), 'Text::Tradition', "Parsed GraphML version 2" );
+ok( $t->$_isa('Text::Tradition'), "Parsed GraphML version 2" );
if( $t ) {
is( scalar $t->collation->readings, 319, "Collation has all readings" );
is( scalar $t->collation->paths, 376, "Collation has all paths" );
# TODO add a relationship, add a stemma, write graphml, reparse it, check that
# the new data is there
$t->language('Greek');
-$t->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
+my $stemma_enabled;
+try {
+ $stemma_enabled = $t->enable_stemmata;
+} catch {
+ ok( 1, "Skipping stemma tests without Analysis module" );
+}
+if( $stemma_enabled ) {
+ $t->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
+}
$t->collation->add_relationship( 'w12', 'w13',
{ 'type' => 'grammatical', 'scope' => 'global',
'annotation' => 'This is some note' } );
my $graphml_str = $t->collation->as_graphml;
my $newt = Text::Tradition->new( 'input' => 'Self', 'string' => $graphml_str );
-is( ref( $newt ), 'Text::Tradition', "Parsed current GraphML version" );
+ok( $newt->$_isa('Text::Tradition'), "Parsed current GraphML version" );
if( $newt ) {
is( scalar $newt->collation->readings, 319, "Collation has all readings" );
is( scalar $newt->collation->paths, 376, "Collation has all paths" );
my $rel = $newt->collation->get_relationship( 'w12', 'w13' );
ok( $rel, "Found set relationship" );
is( $rel->annotation, 'This is some note', "Relationship has its properties" );
- is( scalar $newt->stemmata, 1, "Tradition has its stemma" );
- is( $newt->stemma(0)->witnesses, $t->stemma(0)->witnesses, "Stemma has correct length witness list" );
+ if( $stemma_enabled ) {
+ is( scalar $newt->stemmata, 1, "Tradition has its stemma" );
+ is( $newt->stemma(0)->witnesses, $t->stemma(0)->witnesses, "Stemma has correct length witness list" );
+ }
}
# Test user save / restore
extra_args => { create => 1 } } );
my $scope = $userstore->new_scope();
my $testuser = $userstore->create_user( { url => 'http://example.com' } );
-is( ref( $testuser ), 'Text::Tradition::User', "Created test user via userstore" );
+ok( $testuser->$_isa('Text::Tradition::User'), "Created test user via userstore" );
$testuser->add_tradition( $newt );
is( $newt->user->id, $testuser->id, "Assigned tradition to test user" );
$graphml_str = $newt->collation->as_graphml;
$usert = Text::Tradition->new( 'input' => 'Self', 'string' => $graphml_str,
'userstore' => $userstore );
is( $usert->user->id, $testuser->id, "Parsed tradition with userstore points to correct user" );
+
+# Test warning if we can
+unless( $stemma_enabled ) {
+ my $nst;
+ warnings_exist {
+ $nst = Text::Tradition->new( 'input' => 'Self', 'file' => 't/data/lexformat.xml' );
+ } [qr/DROPPING stemmata/],
+ "Got expected stemma drop warning on parse";
+}
}
projects / scpubgit/stemmatology.git / commitdiff