lib/Text/Tradition/Witness.pm

   1 package Text::Tradition::Witness;
   2 use Moose;
   3 use Moose::Util::TypeConstraints;
   4
   5 =head1 NAME
   6
   7 Text::Tradition::Witness - a manuscript witness to a text tradition
   8
   9 =head1 SYNOPSIS
  10
  11   use Text::Tradition::Witness;
  12   my $w = Text::Tradition::Witness->new(
  13     'sigil' => 'A',
  14     'identifier' => 'Oxford MS Ex.1932',
  15     );
  16
  17 =head1 DESCRIPTION
  18
  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),
  22 and probably a text.
  23
  24 =head1 METHODS
  25
  26 =head2 new
  27
  28 Create a new witness.  Options include:
  29
  30 =over
  31
  32 =item * sigil - A short code to represent the manuscript.  Required.
  33
  34 =item * text - An array of strings (words) that contains the text of the
  35 manuscript.
  36
  37 =item * source - A reference to the text, such as a filename, if it is not
  38 given in the 'text' option.
  39
  40 =item * identifier - The recognized name of the manuscript, e.g. a library
  41 identifier.
  42
  43 =item * other_info - A freeform string for any other description of the
  44 manuscript.
  45
  46 =back
  47
  48 =head2 sigil
  49
  50 Accessor method for the witness sigil.
  51
  52 =head2 text
  53
  54 Accessor method to get and set the text array.
  55
  56 =head2 source
  57
  58 Accessor method to get and set the text source.
  59
  60 =head2 identifier
  61
  62 Accessor method for the witness identifier.
  63
  64 =head2 other_info
  65
  66 Accessor method for the general witness description.
  67
  68 =head2 path
  69
  70 An array of Text::Tradition::Collation::Reading objects which, taken in
  71 sequence, represent the text.
  72
  73 =head2 uncorrected_path
  74
  75 An array of Text::Tradition::Collation::Reading objects which, taken in
  76 sequence, represent the text before any scribal corrections were made.
  77
  78 =begin testing
  79
  80 use_ok( 'Text::Tradition::Witness', "can use module" );
  81
  82 my @text = qw( This is a line of text );
  83 my $wit = Text::Tradition::Witness->new(
  84     'sigil' => 'A',
  85     'text' => \@text,
  86      );
  87 is( ref( $wit ), 'Text::Tradition::Witness', 'Created a witness' );
  88 if( $wit ) {
  89     is( $wit->sigil, 'A', "Witness has correct sigil" );
  90     is( join( ' ', @{$wit->text} ), join( ' ', @text ), "Witness has correct text" );
  91 }
  92
  93 =end testing
  94
  95 =cut
  96
  97 # Sigil. Required identifier for a witness.
  98 has 'sigil' => (
  99         is => 'ro',
 100         isa => 'Str',
 101         required => 1,
 102         );
 103
 104 # Text.  This is an array of strings (i.e. word tokens).
 105 # TODO Think about how to handle this for the case of pre-prepared
 106 # collations, where the tokens are in the graph already.
 107 has 'text' => (
 108         is => 'rw',
 109         isa => 'ArrayRef[Str]',
 110         predicate => 'has_text',
 111         );
 112
 113 # Source.  This is where we read in the witness, if not from a
 114 # pre-prepared collation.  It is probably a filename.
 115 has 'source' => (
 116         is => 'ro',
 117         isa => 'Str',
 118         predicate => 'has_source',
 119         );
 120
 121 # Path.  This is an array of Reading nodes that should mirror the
 122 # text above.
 123 has 'path' => (
 124         is => 'rw',
 125         isa => 'ArrayRef[Text::Tradition::Collation::Reading]',
 126         predicate => 'has_path',
 127         );
 128
 129 has 'uncorrected_path' => (
 130         is => 'rw',
 131         isa => 'ArrayRef[Text::Tradition::Collation::Reading]',
 132         predicate => 'has_ante_corr',
 133         );
 134
 135 # Manuscript name or similar
 136 has 'identifier' => (
 137         is => 'ro',
 138         isa => 'Str',
 139         );
 140
 141 # Any other info we have
 142 has 'other_info' => (
 143         is => 'ro',
 144         isa => 'Str',
 145         );
 146
 147
 148 sub BUILD {
 149         my $self = shift;
 150         if( $self->has_source ) {
 151                 # Read the file and initialize the text.
 152                 my $rc;
 153                 eval { no warnings; $rc = open( WITNESS, $self->source ); };
 154                 # If we didn't open a file, assume it is a string.
 155                 if( $rc ) {
 156                         my @words;
 157                         while(<WITNESS>) {
 158                                 chomp;
 159                                 push( @words, split( /\s+/, $_ ) );
 160                         }
 161                         close WITNESS;
 162                         $self->text( \@words );
 163                 } # else the text is in the source string, probably
 164                   # XML, and we are doing nothing with it.
 165         }
 166 }
 167
 168 =begin testing
 169
 170 use Text::Tradition;
 171
 172 my $simple = 't/data/simple.txt';
 173 my $s = Text::Tradition->new(
 174     'name'  => 'inline',
 175     'input' => 'Tabular',
 176     'file'  => $simple,
 177     );
 178 my $wit_c = $s->witness( 'C' );
 179 is( ref( $wit_c ), 'Text::Tradition::Witness' ),;
 180 if( $wit_c ) {
 181     ok( !$wit_c->has_text, "Text property not yet set" );
 182     my $c_arr = $wit_c->text;
 183     is( $c_arr->[0], 'Je', "Text constructed from path" );
 184     ok( $wit_c->has_text, "Text property now set" );
 185 }
 186
 187 =end testing
 188
 189 =cut
 190
 191 # If the text is not present, and the path is, and this is a 'get'
 192 # request, generate text from path.
 193 around text => sub {
 194         my $orig = shift;
 195         my $self = shift;
 196
 197         if( $self->has_path && !$self->has_text && !@_ ) {
 198                 my @words = map { $_->label } grep { !$_->is_meta } @{$self->path};
 199                 $self->$orig( \@words );
 200         }
 201
 202         $self->$orig( @_ );
 203 };
 204
 205 no Moose;
 206 __PACKAGE__->meta->make_immutable;
 207
 208 =head1 BUGS / TODO
 209
 210 =over
 211
 212 =item * Get rid of either text or path, as they are redundant.
 213
 214 =item * Re-think the mechanism for pre-correction readings etc.
 215
 216 =back
 217
 218 =head1 LICENSE
 219
 220 This package is free software and is provided "as is" without express
 221 or implied warranty.  You can redistribute it and/or modify it under
 222 the same terms as Perl itself.
 223
 224 =head1 AUTHOR
 225
 226 Tara L Andrews E<lt>aurum@cpan.orgE<gt>