make relationships work, add some hacks for Boodts collation
[scpubgit/stemmatology.git] / lib / Text / Tradition / Witness.pm
1 package Text::Tradition::Witness;
2 use Moose;
3 use Moose::Util::TypeConstraints;
4
5 # Sigil. Required identifier for a witness.
6 has 'sigil' => (
7     is => 'ro',
8     isa => 'Str',
9     required => 1,
10     );
11
12 # Text.  This is an array of strings (i.e. word tokens).
13 # TODO Think about how to handle this for the case of pre-prepared
14 # collations, where the tokens are in the graph already.
15 has 'text' => (
16     is => 'rw',
17     isa => 'ArrayRef[Str]',
18     predicate => 'has_text',
19     );
20
21 # Source.  This is where we read in the witness, if not from a
22 # pre-prepared collation.  It is probably a filename.
23 has 'source' => (
24     is => 'ro',
25     isa => 'Str',
26     predicate => 'has_source',
27     );
28
29 # Path.  This is an array of Reading nodes that should mirror the
30 # text above.
31 has 'path' => (
32     is => 'rw',
33     isa => 'ArrayRef[Text::Tradition::Collation::Reading]',
34     predicate => 'has_path',
35     );         
36
37 has 'uncorrected_path' => (
38     is => 'rw',
39     isa => 'ArrayRef[Text::Tradition::Collation::Reading]',
40     predicate => 'has_ante_corr',
41     );
42     
43
44 sub BUILD {
45     my $self = shift;
46     if( $self->has_source ) {
47         # Read the file and initialize the text.
48         open( WITNESS, $self->source ) or die "Could not open " 
49             . $self->file . "for reading";
50         # TODO support TEI as well as plaintext, sometime
51         my @words;
52         while(<WITNESS>) {
53             chomp;
54             push( @words, split( /\s+/, $_ ) );
55         }
56         close WITNESS;
57         $self->text( \@words );
58     }
59 }
60
61 # If the text is not present, and the path is, and this is a 'get'
62 # request, generate text from path.
63 around text => sub {
64     my $orig = shift;
65     my $self = shift;
66
67     if( $self->has_path && !$self->has_text && !@_ ) {
68         my @words = map { $_->label } @{$self->path};
69         $self->$orig( \@words );
70     }
71     
72     $self->$orig( @_ );
73 };
74
75 no Moose;
76 __PACKAGE__->meta->make_immutable;