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 is_layered
  69
  70 Boolean method to note whether the witness has layers (e.g. pre-correction
  71 readings) in the collation.
  72
  73 =begin testing
  74
  75 use_ok( 'Text::Tradition::Witness', "can use module" );
  76
  77 my @text = qw( This is a line of text );
  78 my $wit = Text::Tradition::Witness->new(
  79     'sigil' => 'A',
  80     'text' => \@text,
  81      );
  82 is( ref( $wit ), 'Text::Tradition::Witness', 'Created a witness' );
  83 if( $wit ) {
  84     is( $wit->sigil, 'A', "Witness has correct sigil" );
  85     is( join( ' ', @{$wit->text} ), join( ' ', @text ), "Witness has correct text" );
  86 }
  87
  88 =end testing
  89
  90 =cut
  91
  92 # Sigil. Required identifier for a witness.
  93 has 'sigil' => (
  94         is => 'ro',
  95         isa => 'Str',
  96         required => 1,
  97         );
  98
  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.
 102 has 'text' => (
 103         is => 'rw',
 104         isa => 'ArrayRef[Str]',
 105         predicate => 'has_text',
 106         );
 107
 108 # Source.  This is where we read in the witness, if not from a
 109 # pre-prepared collation.  It is probably a filename.
 110 has 'source' => (
 111         is => 'ro',
 112         isa => 'Str',
 113         predicate => 'has_source',
 114         );
 115
 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.
 118 has 'path' => (
 119         is => 'rw',
 120         isa => 'ArrayRef[Text::Tradition::Collation::Reading]',
 121         predicate => 'has_path',
 122         clearer => 'clear_path',
 123         );
 124
 125 has 'uncorrected_path' => (
 126         is => 'rw',
 127         isa => 'ArrayRef[Text::Tradition::Collation::Reading]',
 128         clearer => 'clear_uncorrected_path',
 129         );
 130
 131 has 'is_layered' => (
 132         is => 'rw',
 133         isa => 'Bool',
 134         );
 135
 136 # Manuscript name or similar
 137 has 'identifier' => (
 138         is => 'ro',
 139         isa => 'Str',
 140         );
 141
 142 # Any other info we have
 143 has 'other_info' => (
 144         is => 'ro',
 145         isa => 'Str',
 146         );
 147
 148 # If we set an uncorrected path, ever, remember that we did so.
 149 around 'uncorrected_path' => sub {
 150         my $orig = shift;
 151         my $self = shift;
 152
 153         $self->is_layered( 1 );
 154         $self->$orig( @_ );
 155 };
 156
 157 sub BUILD {
 158         my $self = shift;
 159         if( $self->has_source ) {
 160                 # Read the file and initialize the text.
 161                 my $rc;
 162                 eval { no warnings; $rc = open( WITNESS, $self->source ); };
 163                 # If we didn't open a file, assume it is a string.
 164                 if( $rc ) {
 165                         my @words;
 166                         while(<WITNESS>) {
 167                                 chomp;
 168                                 push( @words, split( /\s+/, $_ ) );
 169                         }
 170                         close WITNESS;
 171                         $self->text( \@words );
 172                 } # else the text is in the source string, probably
 173                   # XML, and we are doing nothing with it.
 174         }
 175 }
 176
 177 =begin testing
 178
 179 use Text::Tradition;
 180
 181 my $simple = 't/data/simple.txt';
 182 my $s = Text::Tradition->new(
 183     'name'  => 'inline',
 184     'input' => 'Tabular',
 185     'file'  => $simple,
 186     );
 187 my $wit_c = $s->witness( 'C' );
 188 is( ref( $wit_c ), 'Text::Tradition::Witness' ),;
 189 if( $wit_c ) {
 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" );
 194 }
 195
 196 =end testing
 197
 198 =cut
 199
 200 # If the text is not present, and the path is, and this is a 'get'
 201 # request, generate text from path.
 202 around text => sub {
 203         my $orig = shift;
 204         my $self = shift;
 205
 206         if( $self->has_path && !$self->has_text && !@_ ) {
 207                 my @words = map { $_->label } grep { !$_->is_meta } @{$self->path};
 208                 $self->$orig( \@words );
 209         }
 210
 211         $self->$orig( @_ );
 212 };
 213
 214
 215 no Moose;
 216 __PACKAGE__->meta->make_immutable;
 217
 218 =head1 BUGS / TODO
 219
 220 =over
 221
 222 =item * Get rid of either text or path, as they are redundant.
 223
 224 =item * Re-think the mechanism for pre-correction readings etc.
 225
 226 =back
 227
 228 =head1 LICENSE
 229
 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.
 233
 234 =head1 AUTHOR
 235
 236 Tara L Andrews E<lt>aurum@cpan.orgE<gt>