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

package Text::Tradition::HasStemma;

use strict;
use warnings;
use Moose::Role;
use Text::Tradition::Stemma;

=head1 NAME

Text::Tradition::HasStemma - add-on to associate stemma hypotheses to
Text::Tradition objects

=head1 DESCRIPTION

It is often the case that, for a given text tradition, the order of copying
of the witnesses can or should be reconstructed (or at least the attempt
should be made.) This class is a role that can be applied to
Text::Tradition objects to record stemma hypotheses.  See the documentation
for L<Text::Tradition::Stemma> for more information.

=head1 METHODS

=head2 stemmata

Return a list of all stemmata associated with the tradition.

=head2 stemma_count

Return the number of stemma hypotheses defined for this tradition.

=head2 stemma( $idx )

Return the L<Text::Tradition::Stemma> object identified by the given index.

=head2 clear_stemmata

Delete all stemma hypotheses associated with this tradition.

=cut

has 'stemmata' => (
	traits => ['Array'],
	isa => 'ArrayRef[Text::Tradition::Stemma]',
	handles => {
		stemmata => 'elements',
		_add_stemma => 'push',
		stemma => 'get',
		stemma_count => 'count',
		clear_stemmata => 'clear',
	},
	default => sub { [] },
	);
  

=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',
    );
is( $t->stemma_count, 0, "No stemmas added yet" );
my $s;
ok( $s = $t->add_stemma( dotfile => 't/data/simple.dot' ), "Added a simple stemma" );
is( ref( $s ), 'Text::Tradition::Stemma', "Got a stemma object returned" );
is( $t->stemma_count, 1, "Tradition claims to have a stemma" );
is( $t->stemma(0), $s, "Tradition hands back the right stemma" );

=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( 
		'dot' => $stemma_fh );
	$self->_add_stemma( $stemma ) if $stemma;
	return $stemma;
}

1;

=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
951ddfe8	1	package Text::Tradition::HasStemma;
	2
	3	use strict;
	4	use warnings;
	5	use Moose::Role;
	6	use Text::Tradition::Stemma;
	7
	8	=head1 NAME
	9
a445ce40	10	Text::Tradition::HasStemma - add-on to associate stemma hypotheses to
a445ce40	11	Text::Tradition objects
951ddfe8	12
	13	=head1 DESCRIPTION
	14
a445ce40	15	It is often the case that, for a given text tradition, the order of copying
	16	of the witnesses can or should be reconstructed (or at least the attempt
	17	should be made.) This class is a role that can be applied to
	18	Text::Tradition objects to record stemma hypotheses. See the documentation
	19	for L<Text::Tradition::Stemma> for more information.
951ddfe8	20
	21	=head1 METHODS
	22
	23	=head2 stemmata
	24
	25	Return a list of all stemmata associated with the tradition.
	26
	27	=head2 stemma_count
	28
	29	Return the number of stemma hypotheses defined for this tradition.
	30
	31	=head2 stemma( $idx )
	32
	33	Return the L<Text::Tradition::Stemma> object identified by the given index.
	34
	35	=head2 clear_stemmata
	36
	37	Delete all stemma hypotheses associated with this tradition.
	38
	39	=cut
	40
	41	has 'stemmata' => (
	42	traits => ['Array'],
	43	isa => 'ArrayRef[Text::Tradition::Stemma]',
	44	handles => {
	45	stemmata => 'elements',
	46	_add_stemma => 'push',
	47	stemma => 'get',
	48	stemma_count => 'count',
	49	clear_stemmata => 'clear',
	50	},
	51	default => sub { [] },
	52	);
	53
	54
	55	=head2 add_stemma( $dotfile )
	56
	57	Initializes a Text::Tradition::Stemma object from the given dotfile,
	58	and associates it with the tradition.
	59
	60	=begin testing
	61
	62	use Text::Tradition;
	63
	64	my $t = Text::Tradition->new(
	65	'name' => 'simple test',
	66	'input' => 'Tabular',
	67	'file' => 't/data/simple.txt',
	68	);
951ddfe8	69	is( $t->stemma_count, 0, "No stemmas added yet" );
	70	my $s;
	71	ok( $s = $t->add_stemma( dotfile => 't/data/simple.dot' ), "Added a simple stemma" );
	72	is( ref( $s ), 'Text::Tradition::Stemma', "Got a stemma object returned" );
	73	is( $t->stemma_count, 1, "Tradition claims to have a stemma" );
	74	is( $t->stemma(0), $s, "Tradition hands back the right stemma" );
	75
	76	=end testing
	77
	78	=cut
	79
	80	sub add_stemma {
	81	my $self = shift;
	82	my %opts = @_;
	83	my $stemma_fh;
	84	if( $opts{'dotfile'} ) {
	85	open $stemma_fh, '<', $opts{'dotfile'}
	86	or warn "Could not open file " . $opts{'dotfile'};
	87	} elsif( $opts{'dot'} ) {
	88	my $str = $opts{'dot'};
	89	open $stemma_fh, '<', \$str;
	90	}
	91	# Assume utf-8
	92	binmode $stemma_fh, ':utf8';
	93	my $stemma = Text::Tradition::Stemma->new(
	94	'dot' => $stemma_fh );
	95	$self->_add_stemma( $stemma ) if $stemma;
	96	return $stemma;
	97	}
	98
	99	1;
	100
	101	=head1 LICENSE
	102
	103	This package is free software and is provided "as is" without express
	104	or implied warranty. You can redistribute it and/or modify it under
	105	the same terms as Perl itself.
	106
	107	=head1 AUTHOR
	108
	109	Tara L Andrews E<lt>aurum@cpan.orgE<gt>