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 other tools
170 =item * KUL - a specific CSV format for variants, not documented here
172 =item * TEI - a TEI parallel segmentation format file
174 =item * Tabular - a comma- or tab-separated collation. Takes an additional
175 option, 'sep_char', which defaults to the tab character.
179 =item B<file> - The name of the file that contains the data. One of 'file'
180 or 'string' should be specified.
182 =item B<string> - A text string that contains the data. One of 'file' or
183 'string' should be specified.
185 =item B<base> - The name of a text file that contains the base text, to be
186 used with input formats that require it (currently only KUL).
190 Initialization based on a list of witnesses [NOT YET IMPLEMENTED]:
194 =item B<witnesses> - A reference to an array of Text::Tradition::Witness
195 objects that carry the text to be collated.
197 =item B<collator> - A reference to a collation program that will accept
204 Return the Text::Tradition::Witness objects associated with this tradition,
207 =head2 B<witness>( $sigil )
209 Returns the Text::Tradition::Witness object whose sigil is $sigil, or undef
210 if there is no such object within the tradition.
212 =head2 B<add_witness>( %opts )
214 Instantiate a new witness with the given options (see documentation for
215 Text::Tradition::Witness) and add it to the tradition.
217 =head2 B<del_witness>( $sigil )
219 Delete the witness with the given sigil from the tradition. Returns the
220 witness object for the deleted witness.
224 use_ok( 'Text::Tradition', "can use module" );
226 my $t = Text::Tradition->new( 'name' => 'empty' );
227 is( ref( $t ), 'Text::Tradition', "initialized an empty Tradition object" );
228 is( $t->name, 'empty', "object has the right name" );
229 is( scalar $t->witnesses, 0, "object has no witnesses" );
231 my $simple = 't/data/simple.txt';
232 my $s = Text::Tradition->new(
234 'input' => 'Tabular',
237 is( ref( $s ), 'Text::Tradition', "initialized a Tradition object" );
238 is( $s->name, 'inline', "object has the right name" );
239 is( scalar $s->witnesses, 3, "object has three witnesses" );
241 my $wit_a = $s->witness('A');
242 is( ref( $wit_a ), 'Text::Tradition::Witness', "Found a witness A" );
244 is( $wit_a->sigil, 'A', "Witness A has the right sigil" );
246 is( $s->witness('X'), undef, "There is no witness X" );
247 ok( !exists $s->{'witnesses'}->{'X'}, "Witness key X not created" );
249 my $wit_d = $s->add_witness( 'sigil' => 'D', 'sourcetype' => 'collation' );
250 is( ref( $wit_d ), 'Text::Tradition::Witness', "new witness created" );
251 is( $wit_d->sigil, 'D', "witness has correct sigil" );
252 is( scalar $s->witnesses, 4, "object now has four witnesses" );
254 my $del = $s->del_witness( 'D' );
255 is( $del, $wit_d, "Deleted correct witness" );
256 is( scalar $s->witnesses, 3, "object has three witnesses again" );
258 # TODO test initialization by witness list when we have it
266 my( $self, $init_args ) = @_;
268 # First, make a collation object. This will use only those arguments in
269 # init_args that apply to the collation.
270 my $collation = Text::Tradition::Collation->new( %$init_args,
271 'tradition' => $self );
272 $self->_save_collation( $collation );
274 if( exists $init_args->{'input'} ) {
275 # Call the appropriate parser on the given data
276 my @format_standalone = qw/ Self CollateText CollateX CTE JSON TEI Tabular /;
277 my @format_basetext = qw/ KUL /;
279 my $format = $init_args->{'input'};
280 if( $format && !( grep { $_ eq $format } @format_standalone )
281 && !( grep { $_ eq $format } @format_basetext ) ) {
282 warn "Unrecognized input format $format; not parsing";
285 if( $format && grep { $_ eq $format } @format_basetext ) {
287 if( !exists $init_args->{'base'} ) {
288 warn "Cannot make a collation from $format without a base text";
293 # Now do the parsing.
296 $format = 'BaseText'; # Use the BaseText module for parsing,
297 # but retain the original input arg.
299 my $mod = "Text::Tradition::Parser::$format";
301 $mod->can('parse')->( $self, $init_args );
304 $self->_init_done( 1 );
308 =head2 add_json_witnesses( $jsonstring, $options )
310 Adds a set of witnesses from a JSON array specification. This is a wrapper
311 to parse the JSON and call add_witness (with the specified $options) for
312 each element therein.
316 sub add_json_witnesses {
317 my( $self, $jsonstr, $extraopts ) = @_;
318 my $witarray = from_json( $jsonstr );
319 foreach my $witspec ( @{$witarray->{witnesses}} ) {
320 my $opts = $extraopts || {};
321 $opts->{'sourcetype'} = 'json';
322 $opts->{'object'} = $witspec;
323 $self->add_witness( $opts );
329 =head2 enable_stemmata();
331 If the tradition in question does not have the HasStemma role, make it so. Throws
332 an error if the role (ergo, if the Analysis package) is not installed.
336 sub enable_stemmata {
338 my $rolename = 'Text::Tradition::HasStemma';
339 return 1 if does_role( $self, $rolename );
341 apply_all_roles( $self, $rolename );
343 throw( "Cannot apply role to enable stemmata; is the Analysis extension installed?" );
350 unless( $self->has_language ) {
351 warn "Please set a language to lemmatize a tradition";
354 my $mod = "Text::Tradition::Language::" . $self->language;
356 $mod->can( 'lemmatize' )->( $self );
360 Text::Tradition::Error->throw(
361 'ident' => 'Tradition error',
367 __PACKAGE__->meta->make_immutable;
374 =item * Allow tradition to be initialized via passing to a collator.
380 This package is free software and is provided "as is" without express
381 or implied warranty. You can redistribute it and/or modify it under
382 the same terms as Perl itself.
386 Tara L Andrews E<lt>aurum@cpan.orgE<gt>