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