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