lib/Text/Tradition/Witness.pm

   1 package Text::Tradition::Witness;
   2 use Moose;
   3
   4 # Sigil. Required identifier for a witness.
   5 has 'sigil' => (
   6     is => 'ro',
   7     isa => 'Str',
   8     required => 1,
   9     );
  10
  11 # Text.  This is an array of strings (i.e. word tokens).
  12 # TODO Think about how to handle this for the case of pre-prepared
  13 # collations, where the tokens are in the graph already.
  14 has 'text' => (
  15     is => 'rw',
  16     isa => 'ArrayRef[Str]',
  17     predicate => 'has_text',
  18     );
  19
  20 # Source.  This is where we read in the witness, if not from a
  21 # pre-prepared collation.  It is probably a filename.
  22 has 'source' => (
  23     is => 'ro',
  24     isa => 'Str',
  25     predicate => 'has_source',
  26     );
  27
  28 has 'path' => (
  29     is => 'rw',
  30     isa => 'ArrayRef[Text::Tradition::Collation::Reading]',
  31     predicate => 'has_path',
  32     );
  33
  34 has 'post_correctione' => (
  35     is => 'rw',
  36     isa => 'Str',
  37     predicate => 'has_post_correctione',
  38     );
  39
  40
  41 sub BUILD {
  42     my $self = shift;
  43     if( $self->has_source ) {
  44         # Read the file and initialize the text.
  45         open( WITNESS, $self->source ) or die "Could not open "
  46             . $self->file . "for reading";
  47         # TODO support TEI as well as plaintext, sometime
  48         my @words;
  49         while(<WITNESS>) {
  50             chomp;
  51             push( @words, split( /\s+/, $_ ) );
  52         }
  53         close WITNESS;
  54         $self->text( \@words );
  55     }
  56 }
  57
  58 # If the text is not present, and the path is, and this is a 'get'
  59 # request, generate text from path.
  60 around text => sub {
  61     my $orig = shift;
  62     my $self = shift;
  63
  64     if( $self->has_path && !$self->has_text && !@_ ) {
  65         my @words = map { $_->label } @{$self->path};
  66         $self->$orig( \@words );
  67     }
  68
  69     $self->$orig( @_ );
  70 };
  71
  72 no Moose;
  73 __PACKAGE__->meta->make_immutable;