1 package Text::Tradition::Witness;
3 use Moose::Util::TypeConstraints;
7 Text::Tradition::Witness - a manuscript witness to a text tradition
11 use Text::Tradition::Witness;
12 my $w = Text::Tradition::Witness->new(
14 'identifier' => 'Oxford MS Ex.1932',
19 Text::Tradition::Witness is an object representation of a manuscript
20 witness to a text tradition. A manuscript has a sigil (a short code that
21 represents it in the wider tradition), an identifier (e.g. the library ID),
28 Create a new witness. Options include:
32 =item * sigil - A short code to represent the manuscript. Required.
34 =item * text - An array of strings (words) that contains the text of the
37 =item * source - A reference to the text, such as a filename, if it is not
38 given in the 'text' option.
40 =item * identifier - The recognized name of the manuscript, e.g. a library
43 =item * other_info - A freeform string for any other description of the
50 Accessor method for the witness sigil.
54 Accessor method to get and set the text array.
58 Accessor method to get and set the text source.
62 Accessor method for the witness identifier.
66 Accessor method for the general witness description.
70 Boolean method to note whether the witness has layers (e.g. pre-correction
71 readings) in the collation.
75 use_ok( 'Text::Tradition::Witness', "can use module" );
77 my @text = qw( This is a line of text );
78 my $wit = Text::Tradition::Witness->new(
82 is( ref( $wit ), 'Text::Tradition::Witness', 'Created a witness' );
84 is( $wit->sigil, 'A', "Witness has correct sigil" );
85 is( join( ' ', @{$wit->text} ), join( ' ', @text ), "Witness has correct text" );
92 # Sigil. Required identifier for a witness.
99 # Text. This is an array of strings (i.e. word tokens).
100 # TODO Think about how to handle this for the case of pre-prepared
101 # collations, where the tokens are in the graph already.
104 isa => 'ArrayRef[Str]',
105 predicate => 'has_text',
108 # Source. This is where we read in the witness, if not from a
109 # pre-prepared collation. It is probably a filename.
113 predicate => 'has_source',
116 # Path. This is an array of Reading nodes that can be saved during
117 # initialization, but should be cleared before saving in a DB.
120 isa => 'ArrayRef[Text::Tradition::Collation::Reading]',
121 predicate => 'has_path',
122 clearer => 'clear_path',
125 has 'uncorrected_path' => (
127 isa => 'ArrayRef[Text::Tradition::Collation::Reading]',
128 clearer => 'clear_uncorrected_path',
131 has 'is_layered' => (
136 # Manuscript name or similar
137 has 'identifier' => (
142 # Any other info we have
143 has 'other_info' => (
148 # If we set an uncorrected path, ever, remember that we did so.
149 around 'uncorrected_path' => sub {
153 $self->is_layered( 1 );
159 if( $self->has_source ) {
160 # Read the file and initialize the text.
162 eval { no warnings; $rc = open( WITNESS, $self->source ); };
163 # If we didn't open a file, assume it is a string.
168 push( @words, split( /\s+/, $_ ) );
171 $self->text( \@words );
172 } # else the text is in the source string, probably
173 # XML, and we are doing nothing with it.
181 my $simple = 't/data/simple.txt';
182 my $s = Text::Tradition->new(
184 'input' => 'Tabular',
187 my $wit_c = $s->witness( 'C' );
188 is( ref( $wit_c ), 'Text::Tradition::Witness' ),;
190 ok( !$wit_c->has_text, "Text property not yet set" );
191 my $c_arr = $wit_c->text;
192 is( $c_arr->[0], 'Je', "Text constructed from path" );
193 ok( $wit_c->has_text, "Text property now set" );
200 # If the text is not present, and the path is, and this is a 'get'
201 # request, generate text from path.
206 if( $self->has_path && !$self->has_text && !@_ ) {
207 my @words = map { $_->label } grep { !$_->is_meta } @{$self->path};
208 $self->$orig( \@words );
216 __PACKAGE__->meta->make_immutable;
222 =item * Get rid of either text or path, as they are redundant.
224 =item * Re-think the mechanism for pre-correction readings etc.
230 This package is free software and is provided "as is" without express
231 or implied warranty. You can redistribute it and/or modify it under
232 the same terms as Perl itself.
236 Tara L Andrews E<lt>aurum@cpan.orgE<gt>