Commit | Line | Data |
dd3b58b0 |
1 | package Text::Tradition::Witness; |
2 | use Moose; |
7854e12e |
3 | use Moose::Util::TypeConstraints; |
dd3b58b0 |
4 | |
1ed3973e |
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 | |
784877d9 |
18 | # Sigil. Required identifier for a witness. |
dd3b58b0 |
19 | has 'sigil' => ( |
d047cd52 |
20 | is => 'ro', |
21 | isa => 'Str', |
22 | required => 1, |
23 | ); |
dd3b58b0 |
24 | |
d047cd52 |
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. |
dd3b58b0 |
28 | has 'text' => ( |
d047cd52 |
29 | is => 'rw', |
30 | isa => 'ArrayRef[Str]', |
de51424a |
31 | predicate => 'has_text', |
d047cd52 |
32 | ); |
dd3b58b0 |
33 | |
d047cd52 |
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', |
8e1394aa |
39 | predicate => 'has_source', |
d047cd52 |
40 | ); |
784877d9 |
41 | |
1ed3973e |
42 | # Path. This is an array of Reading nodes that should mirror the |
43 | # text above. |
4a8828f0 |
44 | has 'path' => ( |
45 | is => 'rw', |
46 | isa => 'ArrayRef[Text::Tradition::Collation::Reading]', |
de51424a |
47 | predicate => 'has_path', |
4a8828f0 |
48 | ); |
49 | |
1ed3973e |
50 | # Uncorrection. This is an array of sets of reading nodes that show |
51 | # where the witness was corrected. |
52 | has 'uncorrected' => ( |
6a222840 |
53 | is => 'rw', |
1ed3973e |
54 | isa => 'ArrayRef[Correction]', |
55 | predicate => 'has_uncorrected', |
7854e12e |
56 | ); |
e2902068 |
57 | |
58 | |
784877d9 |
59 | sub BUILD { |
60 | my $self = shift; |
d047cd52 |
61 | if( $self->has_source ) { |
784877d9 |
62 | # Read the file and initialize the text. |
d047cd52 |
63 | open( WITNESS, $self->source ) or die "Could not open " |
784877d9 |
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; |
d047cd52 |
72 | $self->text( \@words ); |
784877d9 |
73 | } |
74 | } |
75 | |
de51424a |
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 | |
1ed3973e |
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 | } |
7854e12e |
99 | |
dd3b58b0 |
100 | no Moose; |
101 | __PACKAGE__->meta->make_immutable; |