various bugfixes, getting real traditions to parse
[scpubgit/stemmatology.git] / lib / Text / Tradition / Collation / Reading.pm
1 package Text::Tradition::Collation::Reading;
2
3 use Moose;
4 use overload '""' => \&_stringify, 'fallback' => 1;
5 use Text::Tradition::Collation;
6
7 =head1 NAME
8
9 Text::Tradition::Collation::Reading - represents a reading (usually a word) in a collation.
10     
11 =head1 DESCRIPTION
12
13 Text::Tradition is a library for representation and analysis of collated
14 texts, particularly medieval ones.  A 'reading' refers to a unit of text,
15 usually a word, that appears in one or more witnesses (manuscripts) of the
16 tradition; the text of a given witness is composed of a set of readings in
17 a particular sequence
18
19 =head1 METHODS
20
21 =head2 new
22
23 Creates a new reading in the given collation with the given attributes. 
24 Options include:
25
26 =over 4
27
28 =item collation - The Text::Tradition::Collation object to which this reading belongs.  Required.
29
30 =item id - A unique identifier for this reading. Required.
31
32 =item text - The word or other text of the reading.
33
34 =item is_start - The reading is the starting point for the collation.
35
36 =item is_end - The reading is the ending point for the collation.
37
38 =item is_lacuna - The 'reading' represents a known gap in the text.
39
40 =item rank - The sequence number of the reading. This should probably not be set manually.
41
42 =back
43
44 One of 'text', 'is_start', 'is_end', or 'is_lacuna' is required.
45
46 =head2 collation
47
48 =head2 id
49
50 =head2 text
51
52 =head2 is_start
53
54 =head2 is_end
55
56 =head2 is_lacuna
57
58 =head2 rank
59
60 Accessor methods for the given attributes.
61
62 =cut
63
64 has 'collation' => (
65         is => 'ro',
66         isa => 'Text::Tradition::Collation',
67         # required => 1,
68         weak_ref => 1,
69         );
70
71 has 'id' => (
72         is => 'ro',
73         isa => 'Str',
74         required => 1,
75         );
76
77 has 'text' => (
78         is => 'ro',
79         isa => 'Str',
80         required => 1,
81         writer => 'alter_text',
82         );
83
84 has 'is_start' => (
85         is => 'ro',
86         isa => 'Bool',
87         default => undef,
88         );
89
90 has 'is_end' => (
91         is => 'ro',
92         isa => 'Bool',
93         default => undef,
94         );
95     
96 has 'is_lacuna' => (
97     is => 'ro',
98     isa => 'Bool',
99         default => undef,
100     );
101
102 has 'rank' => (
103     is => 'rw',
104     isa => 'Int',
105     predicate => 'has_rank',
106     );
107
108
109 around BUILDARGS => sub {
110         my $orig = shift;
111         my $class = shift;
112         my $args;
113         if( @_ == 1 ) {
114                 $args = shift;
115         } else {
116                 $args = { @_ };
117         }
118         
119         # If one of our special booleans is set, we change the text and the
120         # ID to match.
121         
122         if( exists $args->{'is_lacuna'} && !exists $args->{'text'} ) {
123                 $args->{'text'} = sprintf( "#LACUNA_%s#", $args->{'id'} );
124         } elsif( exists $args->{'is_start'} ) {
125                 $args->{'id'} = '#START#';  # Change the ID to ensure we have only one
126                 $args->{'text'} = '#START#';
127                 $args->{'rank'} = 0;
128         } elsif( exists $args->{'is_end'} ) {
129                 $args->{'id'} = '#END#';        # Change the ID to ensure we have only one
130                 $args->{'text'} = '#END#';
131         }
132         
133         $class->$orig( $args );
134 };
135
136 =head2 is_meta
137
138 A meta attribute (ha ha), which should be true if any of our 'special'
139 booleans are true.  Implies that the reading does not represent a bit 
140 of text found in a witness.
141
142 =cut
143
144 sub is_meta {
145         my $self = shift;
146         return $self->is_start || $self->is_end || $self->is_lacuna;    
147 }
148
149 # Some syntactic sugar
150 sub related_readings {
151         my $self = shift;
152         return $self->collation->related_readings( $self, @_ );
153 }
154
155 sub set_identical {
156         my( $self, $other ) = @_;
157         return $self->collation->add_relationship( $self, $other, 
158                 { 'type' => 'transposition' } );
159 }
160
161 sub _stringify {
162         my $self = shift;
163         return $self->id;
164 }
165
166 no Moose;
167 __PACKAGE__->meta->make_immutable;
168
169 1;
170