lib/Text/Tradition/Witness.pm

   1 package Text::Tradition::Witness;
   2 use Moose;
   3 use Moose::Util::TypeConstraints;
   4
   5 subtype 'Correction',
   6     => as 'ArrayRef',
   7     => where { return 0 unless @$_ == 3;
   8                return 0 unless $_->[0] =~ /^\d+$/;
   9                return 0 unless $_->[1] =~ /^\d+$/;
  10                foreach my $x ( @{$_->[2]} ) {
  11                    return $0 unless $x->isa( 'Text::Tradition::Collation::Reading' );
  12                }
  13                return 1;
  14            },
  15     => message { "Correction must be ref of [ offset, length, replacement_list ]" };
  16
  17
  18 # Sigil. Required identifier for a witness.
  19 has 'sigil' => (
  20     is => 'ro',
  21     isa => 'Str',
  22     required => 1,
  23     );
  24
  25 # Text.  This is an array of strings (i.e. word tokens).
  26 # TODO Think about how to handle this for the case of pre-prepared
  27 # collations, where the tokens are in the graph already.
  28 has 'text' => (
  29     is => 'rw',
  30     isa => 'ArrayRef[Str]',
  31     predicate => 'has_text',
  32     );
  33
  34 # Source.  This is where we read in the witness, if not from a
  35 # pre-prepared collation.  It is probably a filename.
  36 has 'source' => (
  37     is => 'ro',
  38     isa => 'Str',
  39     predicate => 'has_source',
  40     );
  41
  42 # Path.  This is an array of Reading nodes that should mirror the
  43 # text above.
  44 has 'path' => (
  45     is => 'rw',
  46     isa => 'ArrayRef[Text::Tradition::Collation::Reading]',
  47     predicate => 'has_path',
  48     );
  49
  50 # Uncorrection.  This is an array of sets of reading nodes that show
  51 # where the witness was corrected.
  52 has 'uncorrected' => (
  53     is => 'rw',
  54     isa => 'ArrayRef[Correction]',
  55     predicate => 'has_uncorrected',
  56     );
  57
  58
  59 sub BUILD {
  60     my $self = shift;
  61     if( $self->has_source ) {
  62         # Read the file and initialize the text.
  63         open( WITNESS, $self->source ) or die "Could not open "
  64             . $self->file . "for reading";
  65         # TODO support TEI as well as plaintext, sometime
  66         my @words;
  67         while(<WITNESS>) {
  68             chomp;
  69             push( @words, split( /\s+/, $_ ) );
  70         }
  71         close WITNESS;
  72         $self->text( \@words );
  73     }
  74 }
  75
  76 # If the text is not present, and the path is, and this is a 'get'
  77 # request, generate text from path.
  78 around text => sub {
  79     my $orig = shift;
  80     my $self = shift;
  81
  82     if( $self->has_path && !$self->has_text && !@_ ) {
  83         my @words = map { $_->label } @{$self->path};
  84         $self->$orig( \@words );
  85     }
  86
  87     $self->$orig( @_ );
  88 };
  89
  90 sub uncorrected_path {
  91     my $self = shift;
  92     my @path;
  93     push( @path, @{$self->path} );
  94     foreach my $corr ( @{$self->uncorrected} ) {
  95         splice( @path, $corr->[0], $corr->[1], @{$corr->[2]} );
  96     }
  97     return \@path;
  98 }
  99
 100 no Moose;
 101 __PACKAGE__->meta->make_immutable;