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.  This should not change after the witness has been instantiated,
  36 and the path through the collation should always match it.
  37
  38 =item * layertext - An array of strings (words) that contains the layered text,
  39 if any, of the manuscript.  This should not change after the witness has been
  40 instantiated, and the path through the collation should always match it.
  41
  42 =item * source - A reference to the text, such as a filename, if it is not
  43 given in the 'text' option.
  44
  45 =item * identifier - The recognized name of the manuscript, e.g. a library
  46 identifier.
  47
  48 =item * other_info - A freeform string for any other description of the
  49 manuscript.
  50
  51 =back
  52
  53 =head2 sigil
  54
  55 Accessor method for the witness sigil.
  56
  57 =head2 text
  58
  59 Accessor method to get and set the text array.
  60
  61 =head2 source
  62
  63 Accessor method to get and set the text source.
  64
  65 =head2 identifier
  66
  67 Accessor method for the witness identifier.
  68
  69 =head2 other_info
  70
  71 Accessor method for the general witness description.
  72
  73 =head2 is_layered
  74
  75 Boolean method to note whether the witness has layers (e.g. pre-correction
  76 readings) in the collation.
  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 has 'layertext' => (
 114         is => 'rw',
 115         isa => 'ArrayRef[Str]',
 116         predicate => 'has_layertext',
 117         );
 118
 119 # Source.  This is where we read in the witness, if not from a
 120 # pre-prepared collation.  It is probably a filename.
 121 has 'source' => (
 122         is => 'ro',
 123         isa => 'Str',
 124         predicate => 'has_source',
 125         );
 126
 127 # Path.  This is an array of Reading nodes that can be saved during
 128 # initialization, but should be cleared before saving in a DB.
 129 has 'path' => (
 130         is => 'rw',
 131         isa => 'ArrayRef[Text::Tradition::Collation::Reading]',
 132         predicate => 'has_path',
 133         clearer => 'clear_path',
 134         );
 135
 136 has 'uncorrected_path' => (
 137         is => 'rw',
 138         isa => 'ArrayRef[Text::Tradition::Collation::Reading]',
 139         clearer => 'clear_uncorrected_path',
 140         );
 141
 142 has 'is_layered' => (
 143         is => 'rw',
 144         isa => 'Bool',
 145         );
 146
 147 # Manuscript name or similar
 148 has 'identifier' => (
 149         is => 'ro',
 150         isa => 'Str',
 151         );
 152
 153 # Any other info we have
 154 has 'other_info' => (
 155         is => 'ro',
 156         isa => 'Str',
 157         );
 158
 159 # If we set an uncorrected path, ever, remember that we did so.
 160 around 'uncorrected_path' => sub {
 161         my $orig = shift;
 162         my $self = shift;
 163
 164         $self->is_layered( 1 );
 165         $self->$orig( @_ );
 166 };
 167
 168 sub BUILD {
 169         my $self = shift;
 170         if( $self->has_source ) {
 171                 # Read the file and initialize the text.
 172                 my $rc;
 173                 eval { no warnings; $rc = open( WITNESS, $self->source ); };
 174                 # If we didn't open a file, assume it is a string.
 175                 if( $rc ) {
 176                         my @words;
 177                         while(<WITNESS>) {
 178                                 chomp;
 179                                 push( @words, split( /\s+/, $_ ) );
 180                         }
 181                         close WITNESS;
 182                         $self->text( \@words );
 183                 } # else the text is in the source string, probably
 184                   # XML, and we are doing nothing with it.
 185         }
 186 }
 187
 188 no Moose;
 189 __PACKAGE__->meta->make_immutable;
 190
 191 =head1 BUGS / TODO
 192
 193 =over
 194
 195 =item * Get rid of either text or path, as they are redundant.
 196
 197 =item * Re-think the mechanism for pre-correction readings etc.
 198
 199 =back
 200
 201 =head1 LICENSE
 202
 203 This package is free software and is provided "as is" without express
 204 or implied warranty.  You can redistribute it and/or modify it under
 205 the same terms as Perl itself.
 206
 207 =head1 AUTHOR
 208
 209 Tara L Andrews E<lt>aurum@cpan.orgE<gt>