analysis/lib/Text/Tradition/HasStemma.pm

   1 package Text::Tradition::HasStemma;
   2
   3 use strict;
   4 use warnings;
   5 use Moose::Role;
   6 use Text::Tradition::Stemma;
   7
   8 =head1 NAME
   9
  10 Text::Tradition::HasStemma - add-on to associate stemma hypotheses to Text::Tradition objects
  11
  12 =head1 DESCRIPTION
  13
  14 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.
  15
  16 =head1 METHODS
  17
  18 =head2 stemmata
  19
  20 Return a list of all stemmata associated with the tradition.
  21
  22 =head2 stemma_count
  23
  24 Return the number of stemma hypotheses defined for this tradition.
  25
  26 =head2 stemma( $idx )
  27
  28 Return the L<Text::Tradition::Stemma> object identified by the given index.
  29
  30 =head2 clear_stemmata
  31
  32 Delete all stemma hypotheses associated with this tradition.
  33
  34 =cut
  35
  36 has '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
  52 Initializes a Text::Tradition::Stemma object from the given dotfile,
  53 and associates it with the tradition.
  54
  55 =begin testing
  56
  57 use Text::Tradition;
  58
  59 my $t = Text::Tradition->new(
  60     'name'  => 'simple test',
  61     'input' => 'Tabular',
  62     'file'  => 't/data/simple.txt',
  63     );
  64 $t->enable_stemmata;
  65 is( $t->stemma_count, 0, "No stemmas added yet" );
  66 my $s;
  67 ok( $s = $t->add_stemma( dotfile => 't/data/simple.dot' ), "Added a simple stemma" );
  68 is( ref( $s ), 'Text::Tradition::Stemma', "Got a stemma object returned" );
  69 is( $t->stemma_count, 1, "Tradition claims to have a stemma" );
  70 is( $t->stemma(0), $s, "Tradition hands back the right stemma" );
  71
  72 =end testing
  73
  74 =cut
  75
  76 sub 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
  95 1;
  96
  97 =head1 LICENSE
  98
  99 This package is free software and is provided "as is" without express
 100 or implied warranty.  You can redistribute it and/or modify it under
 101 the same terms as Perl itself.
 102
 103 =head1 AUTHOR
 104
 105 Tara L Andrews E<lt>aurum@cpan.orgE<gt>