1 package Text::Tradition;
3 use JSON qw / from_json /;
6 use Moose::Util qw/ does_role apply_all_roles /;
7 use Text::Tradition::Collation;
8 use Text::Tradition::Error;
9 use Text::Tradition::Witness;
10 use Text::Tradition::User;
13 use vars qw( $VERSION );
18 isa => 'Text::Tradition::Collation',
19 writer => '_save_collation',
22 has 'witness_hash' => (
24 isa => 'HashRef[Text::Tradition::Witness]',
28 del_witness => 'delete',
29 has_witness => 'exists',
30 witnesses => 'values',
32 default => sub { {} },
38 default => 'Tradition',
44 predicate => 'has_language',
47 has '_initialized' => (
51 writer => '_init_done',
56 isa => 'Text::Tradition::User',
58 predicate => 'has_user',
59 clearer => 'clear_user',
67 default => sub { 0; },
70 # Create the witness before trying to add it
71 around 'add_witness' => sub {
74 # TODO allow add of a Witness object?
75 my %args = @_ == 1 ? %{$_[0]} : @_;
76 $args{'tradition'} = $self;
77 $args{'language'} = $self->language
78 if( $self->language && !exists $args{'language'} );
79 my $new_wit = Text::Tradition::Witness->new( %args );
80 $self->$orig( $new_wit->sigil => $new_wit );
84 # Allow deletion of witness by object as well as by sigil
85 around 'del_witness' => sub {
89 foreach my $arg ( @_ ) {
91 ref( $arg ) eq 'Text::Tradition::Witness' ? $arg->sigil : $arg );
93 return $self->$orig( @key_args );
96 # Don't allow an empty hash value
97 around 'witness' => sub {
98 my( $orig, $self, $arg ) = @_;
99 return unless $self->has_witness( $arg );
100 return $self->$orig( $arg );
105 Text::Tradition - a software model for a set of collated texts
110 my $t = Text::Tradition->new(
111 'name' => 'this is a text',
113 'file' => '/path/to/tei_parallel_seg_file.xml' );
115 my @text_wits = $t->witnesses();
116 my $manuscript_a = $t->witness( 'A' );
118 $t = Text::Tradition->new();
119 $t->add_witness( 'sourcetype' => 'xmldesc',
120 'file' => '/path/to/teitranscription.xml' );
121 $t->add_witness( 'sourcetype => 'plaintext', 'sigil' => 'Q',
122 'string' => 'The quick brown fox jumped over the lazy dogs' );
126 my $text_path_svg = $t->collation->as_svg();
127 ## See Text::Tradition::Collation for more on text collation itself
131 Text::Tradition is a library for representation and analysis of collated
132 texts, particularly medieval ones. A 'tradition' refers to the aggregation
133 of surviving versions of a text, generally preserved in multiple
134 manuscripts (or 'witnesses'). A Tradition object thus has one more more
135 Witnesses, as well as a Collation that represents the unity of all versions
142 Creates and returns a new text tradition object. The following options are
149 =item B<name> - The name of the text.
153 Initialization based on a collation file:
157 =item B<input> - The input format of the collation file. Can be one of the
162 =item * Self - a GraphML format produced by this module
164 =item * CollateX - a GraphML format produced by CollateX
166 =item * CTE - a TEI XML format produced by Classical Text Editor
168 =item * JSON - an alignment table in JSON format, as produced by CollateX and
171 =item * TEI - a TEI parallel segmentation format file
173 =item * Tabular - a spreadsheet collation. See the documentation for
174 L<Text::Tradition::Parser::Tabular> for an explanation of additional options.
178 =item B<file> - The name of the file that contains the data. One of 'file'
179 or 'string' should be specified.
181 =item B<string> - A text string that contains the data. One of 'file' or
182 'string' should be specified.
186 Initialization based on a list of witnesses [NOT YET IMPLEMENTED]:
190 =item B<witnesses> - A reference to an array of Text::Tradition::Witness
191 objects that carry the text to be collated.
193 =item B<collator> - A reference to a collation program that will accept
200 Return the Text::Tradition::Witness objects associated with this tradition,
203 =head2 B<witness>( $sigil )
205 Returns the Text::Tradition::Witness object whose sigil is $sigil, or undef
206 if there is no such object within the tradition.
208 =head2 B<add_witness>( %opts )
210 Instantiate a new witness with the given options (see documentation for
211 Text::Tradition::Witness) and add it to the tradition.
213 =head2 B<del_witness>( $sigil )
215 Delete the witness with the given sigil from the tradition. Returns the
216 witness object for the deleted witness.
220 use_ok( 'Text::Tradition', "can use module" );
222 my $t = Text::Tradition->new( 'name' => 'empty' );
223 is( ref( $t ), 'Text::Tradition', "initialized an empty Tradition object" );
224 is( $t->name, 'empty', "object has the right name" );
225 is( scalar $t->witnesses, 0, "object has no witnesses" );
227 my $simple = 't/data/simple.txt';
228 my $s = Text::Tradition->new(
230 'input' => 'Tabular',
233 is( ref( $s ), 'Text::Tradition', "initialized a Tradition object" );
234 is( $s->name, 'inline', "object has the right name" );
235 is( scalar $s->witnesses, 3, "object has three witnesses" );
237 my $wit_a = $s->witness('A');
238 is( ref( $wit_a ), 'Text::Tradition::Witness', "Found a witness A" );
240 is( $wit_a->sigil, 'A', "Witness A has the right sigil" );
242 is( $s->witness('X'), undef, "There is no witness X" );
243 ok( !exists $s->{'witnesses'}->{'X'}, "Witness key X not created" );
245 my $wit_d = $s->add_witness( 'sigil' => 'D', 'sourcetype' => 'collation' );
246 is( ref( $wit_d ), 'Text::Tradition::Witness', "new witness created" );
247 is( $wit_d->sigil, 'D', "witness has correct sigil" );
248 is( scalar $s->witnesses, 4, "object now has four witnesses" );
250 my $del = $s->del_witness( 'D' );
251 is( $del, $wit_d, "Deleted correct witness" );
252 is( scalar $s->witnesses, 3, "object has three witnesses again" );
254 # TODO test initialization by witness list when we have it
262 my( $self, $init_args ) = @_;
264 # First, make a collation object. This will use only those arguments in
265 # init_args that apply to the collation.
266 my $collation = Text::Tradition::Collation->new( %$init_args,
267 'tradition' => $self );
268 $self->_save_collation( $collation );
270 if( exists $init_args->{'input'} ) {
271 # Call the appropriate parser on the given data
272 my @format_standalone = qw/ Self CollateText CollateX CTE JSON TEI Tabular /;
273 my @format_basetext = qw/ KUL /;
275 my $format = $init_args->{'input'};
276 if( $format && !( grep { $_ eq $format } @format_standalone )
277 && !( grep { $_ eq $format } @format_basetext ) ) {
278 warn "Unrecognized input format $format; not parsing";
281 if( $format && grep { $_ eq $format } @format_basetext ) {
283 if( !exists $init_args->{'base'} ) {
284 warn "Cannot make a collation from $format without a base text";
289 # Now do the parsing.
292 $format = 'BaseText'; # Use the BaseText module for parsing,
293 # but retain the original input arg.
295 my $mod = "Text::Tradition::Parser::$format";
297 $mod->can('parse')->( $self, $init_args );
300 $self->_init_done( 1 );
304 =head2 add_json_witnesses( $jsonstring, $options )
306 Adds a set of witnesses from a JSON array specification. This is a wrapper
307 to parse the JSON and call add_witness (with the specified $options) for
308 each element therein.
312 sub add_json_witnesses {
313 my( $self, $jsonstr, $extraopts ) = @_;
314 my $witarray = from_json( $jsonstr );
315 foreach my $witspec ( @{$witarray->{witnesses}} ) {
316 my $opts = $extraopts || {};
317 $opts->{'sourcetype'} = 'json';
318 $opts->{'object'} = $witspec;
319 $self->add_witness( $opts );
325 =head2 enable_stemmata
327 If the tradition in question does not have the HasStemma role, make it so. Throws
328 an error if the role (ergo, if the Analysis package) is not installed.
332 sub enable_stemmata {
334 my $rolename = 'Text::Tradition::HasStemma';
335 return 1 if does_role( $self, $rolename );
337 apply_all_roles( $self, $rolename );
339 throw( "Cannot apply role to enable stemmata; is the Analysis extension installed?" );
344 =head2 enable_morphology
346 If the tradition in question has readings that do not include the Morphology
347 role, apply the role to them. Throws an error if the role (ergo, if the
348 Morphology package) is not installed.
352 sub enable_morphology {
354 my $rolename = 'Text::Tradition::Morphology';
358 throw( "Cannot apply role to enable morphology; is the extension installed?" );
360 foreach my $r ( $self->collation->readings ) {
361 apply_all_roles( $r, $rolename )
362 unless does_role( $r, $rolename );
369 Calls the appropriate lemmatization function for the language of the
370 tradition. Implicitly applies the Morphology role where appropriate (and
371 throws an error if the package is not installed.)
375 # TODO find a better way to hook this
378 unless( $self->has_language ) {
379 warn "Please set a language to lemmatize a tradition";
382 $self->enable_morphology;
383 my $mod = "Text::Tradition::Language::" . $self->language;
385 $mod->can( 'lemmatize' )->( $self );
389 Text::Tradition::Error->throw(
390 'ident' => 'Tradition error',
396 __PACKAGE__->meta->make_immutable;
403 =item * Allow tradition to be initialized via passing to a collator.
409 This package is free software and is provided "as is" without express
410 or implied warranty. You can redistribute it and/or modify it under
411 the same terms as Perl itself.
415 Tara L Andrews E<lt>aurum@cpan.orgE<gt>