Commit | Line | Data |
dd3b58b0 |
1 | package Text::Tradition; |
2 | |
4a8828f0 |
3 | use Module::Load; |
dd3b58b0 |
4 | use Moose; |
8e1394aa |
5 | use Text::Tradition::Collation; |
56cf65bd |
6 | use Text::Tradition::Stemma; |
8e1394aa |
7 | use Text::Tradition::Witness; |
dd3b58b0 |
8 | |
331c2dbf |
9 | use vars qw( $VERSION ); |
10 | $VERSION = "0.1"; |
11 | |
dd3b58b0 |
12 | has 'collation' => ( |
8e1394aa |
13 | is => 'ro', |
14 | isa => 'Text::Tradition::Collation', |
15 | writer => '_save_collation', |
16 | ); |
dd3b58b0 |
17 | |
3b853983 |
18 | has 'witness_hash' => ( |
19 | traits => ['Hash'], |
20 | isa => 'HashRef[Text::Tradition::Witness]', |
8e1394aa |
21 | handles => { |
3b853983 |
22 | witness => 'get', |
23 | add_witness => 'set', |
24 | del_witness => 'delete', |
25 | has_witness => 'exists', |
26 | witnesses => 'values', |
8e1394aa |
27 | }, |
3b853983 |
28 | default => sub { {} }, |
8e1394aa |
29 | ); |
c5104dc0 |
30 | |
df6d9812 |
31 | has 'name' => ( |
32 | is => 'rw', |
33 | isa => 'Str', |
34 | default => 'Tradition', |
35 | ); |
56cf65bd |
36 | |
37 | has 'stemma' => ( |
38 | is => 'ro', |
39 | isa => 'Text::Tradition::Stemma', |
40 | writer => '_add_stemma', |
2c669bca |
41 | predicate => 'has_stemma', |
56cf65bd |
42 | ); |
3b853983 |
43 | |
44 | # Create the witness before trying to add it |
910a0a6d |
45 | around 'add_witness' => sub { |
46 | my $orig = shift; |
47 | my $self = shift; |
331c2dbf |
48 | # TODO allow add of a Witness object? |
910a0a6d |
49 | my $new_wit = Text::Tradition::Witness->new( @_ ); |
3b853983 |
50 | $self->$orig( $new_wit->sigil => $new_wit ); |
910a0a6d |
51 | return $new_wit; |
52 | }; |
331c2dbf |
53 | |
3b853983 |
54 | # Allow deletion of witness by object as well as by sigil |
55 | around 'del_witness' => sub { |
56 | my $orig = shift; |
57 | my $self = shift; |
58 | my @key_args; |
59 | foreach my $arg ( @_ ) { |
60 | push( @key_args, |
61 | ref( $arg ) eq 'Text::Tradition::Witness' ? $arg->sigil : $arg ); |
62 | } |
63 | return $self->$orig( @key_args ); |
64 | }; |
65 | |
66 | # Don't allow an empty hash value |
67 | around 'witness' => sub { |
68 | my( $orig, $self, $arg ) = @_; |
69 | return unless $self->has_witness( $arg ); |
70 | return $self->$orig( $arg ); |
71 | }; |
72 | |
331c2dbf |
73 | =head1 NAME |
74 | |
75 | Text::Tradition - a software model for a set of collated texts |
76 | |
77 | =head1 SYNOPSIS |
78 | |
79 | use Text::Tradition; |
80 | my $t = Text::Tradition->new( |
81 | 'name' => 'this is a text', |
82 | 'input' => 'TEI', |
83 | 'file' => '/path/to/tei_parallel_seg_file.xml' ); |
84 | |
85 | my @text_wits = $t->witnesses(); |
86 | my $manuscript_a = $t->witness( 'A' ); |
87 | my $new_ms = $t->add_witness( 'sigil' => 'B' ); |
88 | |
89 | my $text_path_svg = $t->collation->as_svg(); |
90 | ## See Text::Tradition::Collation for more on text collation itself |
91 | |
92 | =head1 DESCRIPTION |
93 | |
94 | Text::Tradition is a library for representation and analysis of collated |
95 | texts, particularly medieval ones. A 'tradition' refers to the aggregation |
96 | of surviving versions of a text, generally preserved in multiple |
97 | manuscripts (or 'witnesses'). A Tradition object thus has one more more |
98 | Witnesses, as well as a Collation that represents the unity of all versions |
99 | of the text. |
100 | |
101 | =head1 METHODS |
102 | |
103 | =head2 new |
104 | |
105 | Creates and returns a new text tradition object. The following options are |
106 | accepted. |
107 | |
108 | General options: |
109 | |
110 | =over 4 |
111 | |
112 | =item B<name> - The name of the text. |
113 | |
114 | =back |
115 | |
116 | Initialization based on a collation file: |
117 | |
118 | =over 4 |
119 | |
120 | =item B<input> - The input format of the collation file. Can be one of the |
121 | following: |
122 | |
123 | =over 4 |
124 | |
125 | =item * Self - a GraphML format produced by this module |
126 | |
127 | =item * CollateX - a GraphML format produced by CollateX |
128 | |
129 | =item * CTE - a TEI XML format produced by Classical Text Editor |
130 | |
131 | =item * KUL - a specific CSV format for variants, not documented here |
132 | |
133 | =item * TEI - a TEI parallel segmentation format file |
134 | |
135 | =item * Tabular - a comma- or tab-separated collation. Takes an additional |
136 | option, 'sep_char', which defaults to the tab character. |
137 | |
138 | =back |
139 | |
140 | =item B<file> - The name of the file that contains the data. One of 'file' |
141 | or 'string' should be specified. |
142 | |
143 | =item B<string> - A text string that contains the data. One of 'file' or |
144 | 'string' should be specified. |
145 | |
146 | =item B<base> - The name of a text file that contains the base text, to be |
147 | used with input formats that require it (currently only KUL). |
148 | |
149 | =back |
150 | |
151 | Initialization based on a list of witnesses [NOT YET IMPLEMENTED]: |
152 | |
153 | =over 4 |
154 | |
155 | =item B<witnesses> - A reference to an array of Text::Tradition::Witness |
156 | objects that carry the text to be collated. |
157 | |
158 | =item B<collator> - A reference to a collation program that will accept |
159 | Witness objects. |
160 | |
161 | =back |
162 | |
163 | =head2 B<witnesses> |
164 | |
165 | Return the Text::Tradition::Witness objects associated with this tradition, |
166 | as an array. |
167 | |
044d1e45 |
168 | =head2 B<witness>( $sigil ) |
169 | |
170 | Returns the Text::Tradition::Witness object whose sigil is $sigil, or undef |
171 | if there is no such object within the tradition. |
172 | |
331c2dbf |
173 | =head2 B<add_witness>( %opts ) |
174 | |
175 | Instantiate a new witness with the given options (see documentation for |
176 | Text::Tradition::Witness) and add it to the tradition. |
177 | |
044d1e45 |
178 | =head2 B<del_witness>( $sigil ) |
179 | |
180 | Delete the witness with the given sigil from the tradition. Returns the |
181 | witness object for the deleted witness. |
182 | |
331c2dbf |
183 | =begin testing |
184 | |
185 | use_ok( 'Text::Tradition', "can use module" ); |
186 | |
187 | my $t = Text::Tradition->new( 'name' => 'empty' ); |
188 | is( ref( $t ), 'Text::Tradition', "initialized an empty Tradition object" ); |
189 | is( $t->name, 'empty', "object has the right name" ); |
190 | is( scalar $t->witnesses, 0, "object has no witnesses" ); |
191 | |
192 | my $simple = 't/data/simple.txt'; |
193 | my $s = Text::Tradition->new( |
194 | 'name' => 'inline', |
195 | 'input' => 'Tabular', |
196 | 'file' => $simple, |
197 | ); |
198 | is( ref( $s ), 'Text::Tradition', "initialized a Tradition object" ); |
199 | is( $s->name, 'inline', "object has the right name" ); |
200 | is( scalar $s->witnesses, 3, "object has three witnesses" ); |
201 | |
044d1e45 |
202 | my $wit_a = $s->witness('A'); |
203 | is( ref( $wit_a ), 'Text::Tradition::Witness', "Found a witness A" ); |
204 | if( $wit_a ) { |
205 | is( $wit_a->sigil, 'A', "Witness A has the right sigil" ); |
206 | } |
207 | is( $s->witness('X'), undef, "There is no witness X" ); |
208 | ok( !exists $s->{'witnesses'}->{'X'}, "Witness key X not created" ); |
209 | |
210 | my $wit_d = $s->add_witness( 'sigil' => 'D' ); |
211 | is( ref( $wit_d ), 'Text::Tradition::Witness', "new witness created" ); |
212 | is( $wit_d->sigil, 'D', "witness has correct sigil" ); |
331c2dbf |
213 | is( scalar $s->witnesses, 4, "object now has four witnesses" ); |
214 | |
3b853983 |
215 | my $del = $s->del_witness( 'D' ); |
044d1e45 |
216 | is( $del, $wit_d, "Deleted correct witness" ); |
3b853983 |
217 | is( scalar $s->witnesses, 3, "object has three witnesses again" ); |
218 | |
331c2dbf |
219 | # TODO test initialization by witness list when we have it |
220 | |
221 | =end testing |
222 | |
223 | =cut |
910a0a6d |
224 | |
df6d9812 |
225 | |
8e1394aa |
226 | sub BUILD { |
227 | my( $self, $init_args ) = @_; |
c5104dc0 |
228 | |
8e1394aa |
229 | if( exists $init_args->{'witnesses'} ) { |
910a0a6d |
230 | # We got passed an uncollated list of witnesses. Make a |
231 | # witness object for each witness, and then send them to the |
232 | # collator. |
233 | my $autosigil = 0; |
234 | foreach my $wit ( %{$init_args->{'witnesses'}} ) { |
235 | # Each item in the list is either a string or an arrayref. |
236 | # If it's a string, it is a filename; if it's an arrayref, |
237 | # it is a tuple of 'sigil, file'. Handle either case. |
238 | my $args; |
239 | if( ref( $wit ) eq 'ARRAY' ) { |
240 | $args = { 'sigil' => $wit->[0], |
241 | 'file' => $wit->[1] }; |
242 | } else { |
243 | $args = { 'sigil' => chr( $autosigil+65 ), |
244 | 'file' => $wit }; |
245 | $autosigil++; |
246 | } |
247 | $self->witnesses->add_witness( $args ); |
248 | # TODO Now how to collate these? |
249 | } |
c5104dc0 |
250 | } else { |
910a0a6d |
251 | # Else we need to parse some collation data. Make a Collation object |
252 | my $collation = Text::Tradition::Collation->new( %$init_args, |
253 | 'tradition' => $self ); |
254 | $self->_save_collation( $collation ); |
4a8828f0 |
255 | |
910a0a6d |
256 | # Call the appropriate parser on the given data |
fa954f4c |
257 | my @format_standalone = qw/ Self CollateText CollateX CTE TEI Tabular /; |
dfc37e38 |
258 | my @format_basetext = qw/ KUL /; |
259 | my $use_base; |
260 | my $format = $init_args->{'input'}; |
dfc37e38 |
261 | if( $format && !( grep { $_ eq $format } @format_standalone ) |
262 | && !( grep { $_ eq $format } @format_basetext ) ) { |
263 | warn "Unrecognized input format $format; not parsing"; |
910a0a6d |
264 | return; |
265 | } |
dfc37e38 |
266 | if( $format && grep { $_ eq $format } @format_basetext ) { |
267 | $use_base = 1; |
268 | if( !exists $init_args->{'base'} ) { |
269 | warn "Cannot make a collation from $format without a base text"; |
270 | return; |
271 | } |
272 | } |
4a8828f0 |
273 | |
910a0a6d |
274 | # Now do the parsing. |
910a0a6d |
275 | if( $format ) { |
dfc37e38 |
276 | if( $use_base ) { |
277 | $format = 'BaseText'; # Use the BaseText module for parsing, |
278 | # but retain the original input arg. |
910a0a6d |
279 | } |
280 | my $mod = "Text::Tradition::Parser::$format"; |
281 | load( $mod ); |
dfc37e38 |
282 | $mod->can('parse')->( $self, $init_args ); |
910a0a6d |
283 | } |
c5104dc0 |
284 | } |
8e1394aa |
285 | } |
c5104dc0 |
286 | |
56cf65bd |
287 | =head2 add_stemma( $dotfile ) |
288 | |
289 | Initializes a Text::Tradition::Stemma object from the given dotfile, |
290 | and associates it with the tradition. |
291 | |
292 | =begin testing |
293 | |
294 | use Text::Tradition; |
295 | |
296 | my $t = Text::Tradition->new( |
297 | 'name' => 'simple test', |
298 | 'input' => 'Tabular', |
299 | 'file' => 't/data/simple.txt', |
300 | ); |
301 | |
302 | my $s; |
303 | ok( $s = $t->add_stemma( 't/data/simple.dot' ), "Added a simple stemma" ); |
304 | is( ref( $s ), 'Text::Tradition::Stemma', "Got a stemma object returned" ); |
305 | is( $t->stemma, $s, "Stemma is the right one" ); |
306 | |
307 | =end testing |
308 | |
309 | =cut |
310 | |
311 | sub add_stemma { |
312 | my( $self, $dot ) = @_; |
313 | open my $stemma_fh, '<', $dot or warn "Could not open file $dot"; |
314 | my $stemma = Text::Tradition::Stemma->new( |
315 | 'collation' => $self->collation, |
316 | 'dot' => $stemma_fh ); |
317 | $self->_add_stemma( $stemma ) if $stemma; |
318 | return $stemma; |
319 | } |
320 | |
dd3b58b0 |
321 | no Moose; |
322 | __PACKAGE__->meta->make_immutable; |
331c2dbf |
323 | |
324 | |
325 | =head1 BUGS / TODO |
326 | |
327 | =over |
328 | |
329 | =item * Allow tradition to be initialized via passing to a collator. |
330 | |
331 | =back |
332 | |
333 | =head1 LICENSE |
334 | |
335 | This package is free software and is provided "as is" without express |
336 | or implied warranty. You can redistribute it and/or modify it under |
337 | the same terms as Perl itself. |
338 | |
339 | =head1 AUTHOR |
340 | |
341 | Tara L Andrews E<lt>aurum@cpan.orgE<gt> |