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