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 | |
160 | =head2 B<add_witness>( %opts ) |
161 | |
162 | Instantiate a new witness with the given options (see documentation for |
163 | Text::Tradition::Witness) and add it to the tradition. |
164 | |
165 | =begin testing |
166 | |
167 | use_ok( 'Text::Tradition', "can use module" ); |
168 | |
169 | my $t = Text::Tradition->new( 'name' => 'empty' ); |
170 | is( ref( $t ), 'Text::Tradition', "initialized an empty Tradition object" ); |
171 | is( $t->name, 'empty', "object has the right name" ); |
172 | is( scalar $t->witnesses, 0, "object has no witnesses" ); |
173 | |
174 | my $simple = 't/data/simple.txt'; |
175 | my $s = Text::Tradition->new( |
176 | 'name' => 'inline', |
177 | 'input' => 'Tabular', |
178 | 'file' => $simple, |
179 | ); |
180 | is( ref( $s ), 'Text::Tradition', "initialized a Tradition object" ); |
181 | is( $s->name, 'inline', "object has the right name" ); |
182 | is( scalar $s->witnesses, 3, "object has three witnesses" ); |
183 | |
184 | my $w = $s->add_witness( 'sigil' => 'D' ); |
185 | is( ref( $w ), 'Text::Tradition::Witness', "new witness created" ); |
186 | is( $w->sigil, 'D', "witness has correct sigil" ); |
187 | is( scalar $s->witnesses, 4, "object now has four witnesses" ); |
188 | |
3b853983 |
189 | my $del = $s->del_witness( 'D' ); |
190 | is( $del, $w, "Deleted correct witness" ); |
191 | is( scalar $s->witnesses, 3, "object has three witnesses again" ); |
192 | |
331c2dbf |
193 | # TODO test initialization by witness list when we have it |
194 | |
195 | =end testing |
196 | |
197 | =cut |
910a0a6d |
198 | |
df6d9812 |
199 | |
8e1394aa |
200 | sub BUILD { |
201 | my( $self, $init_args ) = @_; |
c5104dc0 |
202 | |
8e1394aa |
203 | if( exists $init_args->{'witnesses'} ) { |
910a0a6d |
204 | # We got passed an uncollated list of witnesses. Make a |
205 | # witness object for each witness, and then send them to the |
206 | # collator. |
207 | my $autosigil = 0; |
208 | foreach my $wit ( %{$init_args->{'witnesses'}} ) { |
209 | # Each item in the list is either a string or an arrayref. |
210 | # If it's a string, it is a filename; if it's an arrayref, |
211 | # it is a tuple of 'sigil, file'. Handle either case. |
212 | my $args; |
213 | if( ref( $wit ) eq 'ARRAY' ) { |
214 | $args = { 'sigil' => $wit->[0], |
215 | 'file' => $wit->[1] }; |
216 | } else { |
217 | $args = { 'sigil' => chr( $autosigil+65 ), |
218 | 'file' => $wit }; |
219 | $autosigil++; |
220 | } |
221 | $self->witnesses->add_witness( $args ); |
222 | # TODO Now how to collate these? |
223 | } |
c5104dc0 |
224 | } else { |
910a0a6d |
225 | # Else we need to parse some collation data. Make a Collation object |
226 | my $collation = Text::Tradition::Collation->new( %$init_args, |
227 | 'tradition' => $self ); |
228 | $self->_save_collation( $collation ); |
4a8828f0 |
229 | |
910a0a6d |
230 | # Call the appropriate parser on the given data |
331c2dbf |
231 | my @format_standalone = qw/ Self CollateX CTE TEI Tabular /; |
dfc37e38 |
232 | my @format_basetext = qw/ KUL /; |
233 | my $use_base; |
234 | my $format = $init_args->{'input'}; |
dfc37e38 |
235 | if( $format && !( grep { $_ eq $format } @format_standalone ) |
236 | && !( grep { $_ eq $format } @format_basetext ) ) { |
237 | warn "Unrecognized input format $format; not parsing"; |
910a0a6d |
238 | return; |
239 | } |
dfc37e38 |
240 | if( $format && grep { $_ eq $format } @format_basetext ) { |
241 | $use_base = 1; |
242 | if( !exists $init_args->{'base'} ) { |
243 | warn "Cannot make a collation from $format without a base text"; |
244 | return; |
245 | } |
246 | } |
4a8828f0 |
247 | |
910a0a6d |
248 | # Now do the parsing. |
910a0a6d |
249 | if( $format ) { |
dfc37e38 |
250 | if( $use_base ) { |
251 | $format = 'BaseText'; # Use the BaseText module for parsing, |
252 | # but retain the original input arg. |
910a0a6d |
253 | } |
254 | my $mod = "Text::Tradition::Parser::$format"; |
255 | load( $mod ); |
dfc37e38 |
256 | $mod->can('parse')->( $self, $init_args ); |
910a0a6d |
257 | } |
c5104dc0 |
258 | } |
8e1394aa |
259 | } |
c5104dc0 |
260 | |
331c2dbf |
261 | =head2 B<witness>( $sigil ) |
262 | |
263 | Returns the Text::Tradition::Witness object whose sigil is $sigil, or undef |
264 | if there is no such object within the tradition. |
265 | |
266 | =begin testing |
267 | |
268 | use Text::Tradition; |
269 | |
270 | my $simple = 't/data/simple.txt'; |
271 | my $s = Text::Tradition->new( |
272 | 'name' => 'inline', |
273 | 'input' => 'Tabular', |
274 | 'file' => $simple, |
275 | ); |
276 | my $wit_a = $s->witness('A'); |
277 | is( ref( $wit_a ), 'Text::Tradition::Witness', "Found a witness A" ); |
278 | if( $wit_a ) { |
279 | is( $wit_a->sigil, 'A', "Witness A has the right sigil" ); |
280 | } |
281 | is( $s->witness('X'), undef, "There is no witness X" ); |
282 | |
283 | =end testing |
284 | |
285 | =cut |
286 | |
dd3b58b0 |
287 | no Moose; |
288 | __PACKAGE__->meta->make_immutable; |
331c2dbf |
289 | |
290 | |
291 | =head1 BUGS / TODO |
292 | |
293 | =over |
294 | |
295 | =item * Allow tradition to be initialized via passing to a collator. |
296 | |
297 | =back |
298 | |
299 | =head1 LICENSE |
300 | |
301 | This package is free software and is provided "as is" without express |
302 | or implied warranty. You can redistribute it and/or modify it under |
303 | the same terms as Perl itself. |
304 | |
305 | =head1 AUTHOR |
306 | |
307 | Tara L Andrews E<lt>aurum@cpan.orgE<gt> |