use Text::CSV_XS;
use Text::Tradition::Collation::Reading;
use Text::Tradition::Collation::RelationshipStore;
+use Text::Tradition::Error;
use XML::LibXML;
use Moose;
}
# First check to see if a reading with this ID exists.
if( $self->reading( $reading->id ) ) {
- warn "Collation already has a reading with id " . $reading->id;
- return undef;
+ throw( "Collation already has a reading with id " . $reading->id );
}
$self->_add_reading( $reading->id => $reading );
# Once the reading has been added, put it in both graphs.
sub add_relationship {
my $self = shift;
my( $source, $target, $opts ) = $self->_stringify_args( @_ );
- my( $ret, @vectors ) = $self->relations->add_relationship( $source,
+ my( @vectors ) = $self->relations->add_relationship( $source,
$self->reading( $source ), $target, $self->reading( $target ), $opts );
# Force a full rank recalculation every time. Yuck.
- $self->calculate_ranks() if $ret && $self->end->has_rank;
- return( $ret, @vectors );
+ $self->calculate_ranks() if $self->end->has_rank;
+ return @vectors;
}
=head2 reading_witnesses( $reading )
my $dot = $self->as_dot( $from, $to );
unless( $dot ) {
- warn "Could not output a graph with range $from - $to";
- return;
+ throw( "Could not output a graph with range $from - $to" );
}
my @cmd = qw/dot -Tsvg/;
sub make_alignment_table {
my( $self, $noderefs, $include ) = @_;
unless( $self->linear ) {
- warn "Need a linear graph in order to make an alignment table";
- return;
+ throw( "Need a linear graph in order to make an alignment table" );
}
my $table = { 'alignment' => [], 'length' => $self->end->rank - 1 };
my @all_pos = ( 1 .. $self->end->rank - 1 );
{ 'witness' => $wit->sigil, 'tokens' => \@row } );
if( $wit->is_layered ) {
my @wit_ac_path = $self->reading_sequence( $self->start, $self->end,
- $wit->sigil.$self->ac_label, $wit->sigil );
+ $wit->sigil.$self->ac_label );
my @ac_row = _make_witness_row( \@wit_ac_path, \@all_pos, $noderefs );
push( @{$table->{'alignment'}},
{ 'witness' => $wit->sigil.$self->ac_label, 'tokens' => \@ac_row } );
# TODO Get rid of backup; we should know from what witness is whether we need it.
sub reading_sequence {
- my( $self, $start, $end, $witness, $backup ) = @_;
+ my( $self, $start, $end, $witness ) = @_;
$witness = $self->baselabel unless $witness;
my @readings = ( $start );
my $n = $start;
while( $n && $n->id ne $end->id ) {
if( exists( $seen{$n->id} ) ) {
- warn "Detected loop at " . $n->id;
- last;
+ throw( "Detected loop for $witness at " . $n->id );
}
$seen{$n->id} = 1;
- my $next = $self->next_reading( $n, $witness, $backup );
+ my $next = $self->next_reading( $n, $witness );
unless( $next ) {
- warn "Did not find any path for $witness from reading " . $n->id;
- last;
+ throw( "Did not find any path for $witness from reading " . $n->id );
}
push( @readings, $next );
$n = $next;
}
# Check that the last reading is our end reading.
my $last = $readings[$#readings];
- warn "Last reading found from " . $start->text .
- " for witness $witness is not the end!"
+ throw( "Last reading found from " . $start->text .
+ " for witness $witness is not the end!" ) # TODO do we get this far?
unless $last->id eq $end->id;
return @readings;
}
sub _find_linked_reading {
- my( $self, $direction, $node, $path, $alt_path ) = @_;
+ my( $self, $direction, $node, $path ) = @_;
+
+ # Get a backup if we are dealing with a layered witness
+ my $alt_path;
+ my $aclabel = $self->ac_label;
+ if( $path && $path =~ /^(.*)\Q$aclabel\E$/ ) {
+ $alt_path = $1;
+ }
+
my @linked_paths = $direction eq 'next'
? $self->sequence->edges_from( $node )
: $self->sequence->edges_to( $node );
=cut
sub path_text {
- my( $self, $wit, $backup, $start, $end ) = @_;
+ my( $self, $wit, $start, $end ) = @_;
$start = $self->start unless $start;
$end = $self->end unless $end;
- my @path = grep { !$_->is_meta } $self->reading_sequence( $start, $end, $wit, $backup );
+ my @path = grep { !$_->is_meta } $self->reading_sequence( $start, $end, $wit );
return join( ' ', map { $_->text } @path );
}
if( defined $node_ranks->{$rel_containers{$r->id}} ) {
$r->rank( $node_ranks->{$rel_containers{$r->id}} );
} else {
- die "No rank calculated for node " . $r->id
- . " - do you have a cycle in the graph?";
+ # Die. Find the last rank we calculated.
+ my @all_defined = sort { $node_ranks->{$rel_containers{$a->id}}
+ <=> $node_ranks->{$rel_containers{$b->id}} }
+ $self->readings;
+ my $last = pop @all_defined;
+ throw( "Ranks not calculated after $last - do you have a cycle in the graph?" );
}
}
}
}
}
+=head2 text_from_paths
+
+Calculate the text array for all witnesses from the path, for later consistency
+checking. Only to be used if there is no non-graph-based way to know the
+original texts.
+
+=cut
+
+sub text_from_paths {
+ my $self = shift;
+ foreach my $wit ( $self->tradition->witnesses ) {
+ my @text = split( /\s+/,
+ $self->reading_sequence( $self->start, $self->end, $wit->sigil ) );
+ $wit->text( \@text );
+ if( $wit->is_layered ) {
+ my @uctext = split( /\s+/,
+ $self->reading_sequence( $self->start, $self->end,
+ $wit->sigil.$self->ac_label ) );
+ $wit->text( \@uctext );
+ }
+ }
+}
=head1 UTILITY FUNCTIONS
return $dir eq 'predecessors' ? pop( @answer ) : shift ( @answer );
}
+sub throw {
+ Text::Tradition::Error->throw(
+ 'ident' => 'Collation error',
+ 'message' => $_[0],
+ );
+}
+
no Moose;
__PACKAGE__->meta->make_immutable;
projects / scpubgit/stemmatology.git / blobdiff