[scpubgit/stemmatology.git] / lib / Text / Tradition.pm

package Text::Tradition;

use Module::Load;
use Moose;
use Text::Tradition::Collation;
use Text::Tradition::Stemma;
use Text::Tradition::Witness;

use vars qw( $VERSION );
$VERSION = "0.1";

has 'collation' => (
    is => 'ro',
    isa => 'Text::Tradition::Collation',
    writer => '_save_collation',
    );

has 'witness_hash' => (
    traits => ['Hash'],
    isa => 'HashRef[Text::Tradition::Witness]',
    handles => {
        witness     => 'get',
        add_witness => 'set',
        del_witness => 'delete',
        has_witness => 'exists',
        witnesses   => 'values',
    },
    default => sub { {} },
    );

has 'name' => (
    is => 'rw',
    isa => 'Str',
    default => 'Tradition',
    );
    
has 'stemma' => (
	is => 'ro',
	isa => 'Text::Tradition::Stemma',
	writer => '_add_stemma',
	predicate => 'has_stemma',
	);
  
# Create the witness before trying to add it
around 'add_witness' => sub {
    my $orig = shift;
    my $self = shift;
    # TODO allow add of a Witness object?
    my $new_wit = Text::Tradition::Witness->new( @_ );
    $self->$orig( $new_wit->sigil => $new_wit );
    return $new_wit;
};

# Allow deletion of witness by object as well as by sigil
around 'del_witness' => sub {
    my $orig = shift;
    my $self = shift;
    my @key_args;
    foreach my $arg ( @_ ) {
        push( @key_args, 
              ref( $arg ) eq 'Text::Tradition::Witness' ? $arg->sigil : $arg );
    }
    return $self->$orig( @key_args );
};

# Don't allow an empty hash value
around 'witness' => sub {
    my( $orig, $self, $arg ) = @_;
    return unless $self->has_witness( $arg );
    return $self->$orig( $arg );
};

=head1 NAME

Text::Tradition - a software model for a set of collated texts

=head1 SYNOPSIS

  use Text::Tradition;
  my $t = Text::Tradition->new( 
    'name' => 'this is a text',
    'input' => 'TEI',
    'file' => '/path/to/tei_parallel_seg_file.xml' );

  my @text_wits = $t->witnesses();
  my $manuscript_a = $t->witness( 'A' );
  my $new_ms = $t->add_witness( 'sigil' => 'B' );
  
  my $text_path_svg = $t->collation->as_svg();
  ## See Text::Tradition::Collation for more on text collation itself
    
=head1 DESCRIPTION

Text::Tradition is a library for representation and analysis of collated
texts, particularly medieval ones.  A 'tradition' refers to the aggregation
of surviving versions of a text, generally preserved in multiple
manuscripts (or 'witnesses').  A Tradition object thus has one more more
Witnesses, as well as a Collation that represents the unity of all versions
of the text.

=head1 METHODS

=head2 new

Creates and returns a new text tradition object.  The following options are
accepted.

General options:

=over 4

=item B<name> - The name of the text.

=back

Initialization based on a collation file:

=over 4

=item B<input> - The input format of the collation file.  Can be one of the
following:

=over 4

=item * Self - a GraphML format produced by this module

=item * CollateX - a GraphML format produced by CollateX

=item * CTE - a TEI XML format produced by Classical Text Editor

=item * JSON - an alignment table in JSON format, as produced by CollateX and other tools

=item * KUL - a specific CSV format for variants, not documented here

=item * TEI - a TEI parallel segmentation format file

=item * Tabular - a comma- or tab-separated collation.  Takes an additional
option, 'sep_char', which defaults to the tab character.

=back

=item B<file> - The name of the file that contains the data.  One of 'file'
or 'string' should be specified.

=item B<string> - A text string that contains the data.  One of 'file' or
'string' should be specified.

=item B<base> - The name of a text file that contains the base text, to be
used with input formats that require it (currently only KUL).

=back

Initialization based on a list of witnesses [NOT YET IMPLEMENTED]:

=over 4

=item B<witnesses> - A reference to an array of Text::Tradition::Witness
objects that carry the text to be collated.

=item B<collator> - A reference to a collation program that will accept
Witness objects.

=back

=head2 B<witnesses>

Return the Text::Tradition::Witness objects associated with this tradition,
as an array.

=head2 B<witness>( $sigil )

Returns the Text::Tradition::Witness object whose sigil is $sigil, or undef
if there is no such object within the tradition.

=head2 B<add_witness>( %opts )

Instantiate a new witness with the given options (see documentation for
Text::Tradition::Witness) and add it to the tradition.

=head2 B<del_witness>( $sigil )

Delete the witness with the given sigil from the tradition.  Returns the
witness object for the deleted witness.

=begin testing

use_ok( 'Text::Tradition', "can use module" );

my $t = Text::Tradition->new( 'name' => 'empty' );
is( ref( $t ), 'Text::Tradition', "initialized an empty Tradition object" );
is( $t->name, 'empty', "object has the right name" );
is( scalar $t->witnesses, 0, "object has no witnesses" );

my $simple = 't/data/simple.txt';
my $s = Text::Tradition->new( 
    'name'  => 'inline', 
    'input' => 'Tabular',
    'file'  => $simple,
    );
is( ref( $s ), 'Text::Tradition', "initialized a Tradition object" );
is( $s->name, 'inline', "object has the right name" );
is( scalar $s->witnesses, 3, "object has three witnesses" );

my $wit_a = $s->witness('A');
is( ref( $wit_a ), 'Text::Tradition::Witness', "Found a witness A" );
if( $wit_a ) {
    is( $wit_a->sigil, 'A', "Witness A has the right sigil" );
}
is( $s->witness('X'), undef, "There is no witness X" );
ok( !exists $s->{'witnesses'}->{'X'}, "Witness key X not created" );

my $wit_d = $s->add_witness( 'sigil' => 'D' );
is( ref( $wit_d ), 'Text::Tradition::Witness', "new witness created" );
is( $wit_d->sigil, 'D', "witness has correct sigil" );
is( scalar $s->witnesses, 4, "object now has four witnesses" );

my $del = $s->del_witness( 'D' );
is( $del, $wit_d, "Deleted correct witness" );
is( scalar $s->witnesses, 3, "object has three witnesses again" );

# TODO test initialization by witness list when we have it

=end testing

=cut
    

sub BUILD {
    my( $self, $init_args ) = @_;

    if( exists $init_args->{'witnesses'} ) {
        # We got passed an uncollated list of witnesses.  Make a
        # witness object for each witness, and then send them to the
        # collator.
        my $autosigil = 0;
        foreach my $wit ( %{$init_args->{'witnesses'}} ) {
            # Each item in the list is either a string or an arrayref.
            # If it's a string, it is a filename; if it's an arrayref,
            # it is a tuple of 'sigil, file'.  Handle either case.
            my $args;
            if( ref( $wit ) eq 'ARRAY' ) {
                $args = { 'sigil' => $wit->[0],
                          'file' => $wit->[1] };
            } else {
                $args = { 'sigil' => chr( $autosigil+65 ),
                          'file' => $wit };
                $autosigil++;
            }
            $self->witnesses->add_witness( $args );
            # TODO Now how to collate these?
        }
    } else {
        # Else we need to parse some collation data.  Make a Collation object
        my $collation = Text::Tradition::Collation->new( %$init_args,
                                                        'tradition' => $self );
        $self->_save_collation( $collation );

        # Call the appropriate parser on the given data
        my @format_standalone = qw/ Self CollateText CollateX CTE JSON TEI Tabular /;
        my @format_basetext = qw/ KUL /;
        my $use_base;
        my $format = $init_args->{'input'};
        if( $format && !( grep { $_ eq $format } @format_standalone )
            && !( grep { $_ eq $format } @format_basetext ) ) {
            warn "Unrecognized input format $format; not parsing";
            return;
        }
        if( $format && grep { $_ eq $format } @format_basetext ) {
            $use_base = 1;
            if( !exists $init_args->{'base'} ) {
                warn "Cannot make a collation from $format without a base text";
                return;
            }
        }

        # Now do the parsing. 
        if( $format ) {
            if( $use_base ) { 
                $format = 'BaseText';   # Use the BaseText module for parsing,
                                        # but retain the original input arg.
            }
            my $mod = "Text::Tradition::Parser::$format";
            load( $mod );
            $mod->can('parse')->( $self, $init_args );
        }
    }
}

=head2 add_stemma( $dotfile )

Initializes a Text::Tradition::Stemma object from the given dotfile,
and associates it with the tradition.

=begin testing

use Text::Tradition;

my $t = Text::Tradition->new( 
    'name'  => 'simple test', 
    'input' => 'Tabular',
    'file'  => 't/data/simple.txt',
    );

my $s;
ok( $s = $t->add_stemma( 't/data/simple.dot' ), "Added a simple stemma" );
is( ref( $s ), 'Text::Tradition::Stemma', "Got a stemma object returned" );
is( $t->stemma, $s, "Stemma is the right one" );

=end testing

=cut

sub add_stemma {
	my $self = shift;
	my %opts = @_;
	my $stemma_fh;
	if( $opts{'dotfile'} ) {
		open $stemma_fh, '<', $opts{'dotfile'}
			or warn "Could not open file " . $opts{'dotfile'};
	} elsif( $opts{'dot'} ) {
		my $str = $opts{'dot'};
		open $stemma_fh, '<', \$str;
	}
	# Assume utf-8
	binmode $stemma_fh, ':utf8';
	my $stemma = Text::Tradition::Stemma->new( 
		'collation' => $self->collation,
		'dot' => $stemma_fh );
	$self->_add_stemma( $stemma ) if $stemma;
	return $stemma;
}

no Moose;
__PACKAGE__->meta->make_immutable;


=head1 BUGS / TODO

=over

=item * Allow tradition to be initialized via passing to a collator.

=back

=head1 LICENSE

This package is free software and is provided "as is" without express
or implied warranty.  You can redistribute it and/or modify it under
the same terms as Perl itself.

=head1 AUTHOR

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