split off stemma analysis modules from base Tradition layer
[scpubgit/stemmatology.git] / analysis / lib / Text / Tradition / HasStemma.pm
CommitLineData
951ddfe8 1package Text::Tradition::HasStemma;
2
3use strict;
4use warnings;
5use Moose::Role;
6use Text::Tradition::Stemma;
7
8=head1 NAME
9
10Text::Tradition::HasStemma - add-on to associate stemma hypotheses to Text::Tradition objects
11
12=head1 DESCRIPTION
13
14It 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.
15
16=head1 METHODS
17
18=head2 stemmata
19
20Return a list of all stemmata associated with the tradition.
21
22=head2 stemma_count
23
24Return the number of stemma hypotheses defined for this tradition.
25
26=head2 stemma( $idx )
27
28Return the L<Text::Tradition::Stemma> object identified by the given index.
29
30=head2 clear_stemmata
31
32Delete all stemma hypotheses associated with this tradition.
33
34=cut
35
36has 'stemmata' => (
37 traits => ['Array'],
38 isa => 'ArrayRef[Text::Tradition::Stemma]',
39 handles => {
40 stemmata => 'elements',
41 _add_stemma => 'push',
42 stemma => 'get',
43 stemma_count => 'count',
44 clear_stemmata => 'clear',
45 },
46 default => sub { [] },
47 );
48
49
50=head2 add_stemma( $dotfile )
51
52Initializes a Text::Tradition::Stemma object from the given dotfile,
53and associates it with the tradition.
54
55=begin testing
56
57use Text::Tradition;
58
59my $t = Text::Tradition->new(
60 'name' => 'simple test',
61 'input' => 'Tabular',
62 'file' => 't/data/simple.txt',
63 );
64$t->enable_stemmata;
65is( $t->stemma_count, 0, "No stemmas added yet" );
66my $s;
67ok( $s = $t->add_stemma( dotfile => 't/data/simple.dot' ), "Added a simple stemma" );
68is( ref( $s ), 'Text::Tradition::Stemma', "Got a stemma object returned" );
69is( $t->stemma_count, 1, "Tradition claims to have a stemma" );
70is( $t->stemma(0), $s, "Tradition hands back the right stemma" );
71
72=end testing
73
74=cut
75
76sub add_stemma {
77 my $self = shift;
78 my %opts = @_;
79 my $stemma_fh;
80 if( $opts{'dotfile'} ) {
81 open $stemma_fh, '<', $opts{'dotfile'}
82 or warn "Could not open file " . $opts{'dotfile'};
83 } elsif( $opts{'dot'} ) {
84 my $str = $opts{'dot'};
85 open $stemma_fh, '<', \$str;
86 }
87 # Assume utf-8
88 binmode $stemma_fh, ':utf8';
89 my $stemma = Text::Tradition::Stemma->new(
90 'dot' => $stemma_fh );
91 $self->_add_stemma( $stemma ) if $stemma;
92 return $stemma;
93}
94
951;
96
97=head1 LICENSE
98
99This package is free software and is provided "as is" without express
100or implied warranty. You can redistribute it and/or modify it under
101the same terms as Perl itself.
102
103=head1 AUTHOR
104
105Tara L Andrews E<lt>aurum@cpan.orgE<gt>