requires( 'Module::Load' );
requires( 'Moose' );
requires( 'Moose::Util::TypeConstraints' );
+requires( 'StackTrace::Auto' );
requires( 'Text::CSV_XS' );
requires( 'Text::CSV::Simple' ); # TODO delete
requires( 'Throwable::X' );
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 );
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 );
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;
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?" );
}
}
}
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;
use strict;
use warnings;
+use Text::Tradition::Error;
use Text::Tradition::Collation::Relationship;
use Moose;
my $rel = $self->get_relationship( $source, $target );
if( $rel ) {
if( $rel->type ne $options->{'type'} ) {
- warn "Another relationship of type " . $rel->type
- . " already exists between $source and $target";
- return;
+ throw( "Another relationship of type " . $rel->type
+ . " already exists between $source and $target" );
} else {
return $rel;
}
if( $rel && $rel->type eq $options->{'type'} ) {
return $rel;
} elsif( $rel ) {
- warn sprintf( "Relationship of type %s with scope %s already defined for readings %s and %s", $rel->type, $rel->scope, $options->{'reading_a'}, $options->{'reading_b'} );
- return;
+ throw( sprintf( "Relationship of type %s with scope %s already defined for readings %s and %s", $rel->type, $rel->scope, $options->{'reading_a'}, $options->{'reading_b'} ) );
} else {
$rel = Text::Tradition::Collation::Relationship->new( $options );
$self->add_scoped_relationship( $rel ) if $rel->nonlocal;
my( $is_valid, $reason ) =
$self->relationship_valid( $source, $target, $options->{'type'} );
unless( $is_valid ) {
- return ( undef, $reason );
+ throw( "Invalid relationship: $reason" );
}
# Try to create the relationship object.
$options->{'reading_b'} = $target_rdg->text;
$options->{'orig_a'} = $source;
$options->{'orig_b'} = $target;
- my $relationship = $self->create( $options );
- return( undef, "Relationship creation failed" ) unless $relationship;
+ my $relationship = $self->create( $options ); # Will throw on error
# Find all the pairs for which we need to set the relationship.
my @vectors = ( [ $source, $target ] );
foreach my $v ( @vectors ) {
my $rel = $self->get_relationship( @$v );
if( $rel ) {
- my $warning = $rel->nonlocal
- ? "Found conflicting relationship at @$v"
- : "Not overriding local relationship set at @$v";
- warn $warning;
+ if( $rel->nonlocal ) {
+ throw( "Found conflicting relationship at @$v" );
+ } else {
+ warn "Not overriding local relationship set at @$v";
+ }
next;
}
$self->_set_relationship( $relationship, @$v );
push( @pairs_set, $v );
}
- return( 1, @pairs_set );
+ return @pairs_set;
}
=head2 relationship_valid( $source, $target, $type )
$data_el->appendText( $value );
}
+sub throw {
+ Text::Tradition::Error->throw(
+ 'ident' => 'Relationship error',
+ 'message' => $_[0],
+ );
+}
+
no Moose;
__PACKAGE__->meta->make_immutable;
use Moose;
use overload '""' => \&_stringify, 'fallback' => 1;
-with qw/ Throwable::X /;
+with qw/ Throwable::X StackTrace::Auto /;
use Throwable::X -all;
sub _stringify {
my $self = shift;
- return "Error: " . $self->ident . " // " . $self->message;
+ return "Error: " . $self->ident . " // " . $self->message
+ . "\n" . $self->stack_trace->as_string;
}
no Moose;
-__PACKAGE__->meta->make_immutable;
+__PACKAGE__->meta->make_immutable( inline_constructor => 0 );
=head1 NAME
use strict;
use warnings;
use Module::Load;
-use Text::Tradition::Parser::Util qw( collate_variants cmp_str check_for_repeated add_hash_entry );
+use TryCatch;
+use Text::Tradition::Parser::Util qw( collate_variants cmp_str
+ check_for_repeated add_hash_entry );
=head1 NAME
$r->id ne $labels{$r->text}->id ) {
if( $type eq 'repetition' ) {
# Repetition
- $collation->add_relationship( $r, $labels{$r->text}, \%rel_options );
+ try {
+ $collation->add_relationship( $r, $labels{$r->text}, \%rel_options );
+ } catch( Text::Tradition::Error $e ) {
+ warn "Could not set repetition relationship $r -> "
+ . $labels{$r->text} . ": " . $e->message;
+ }
} else {
# Transposition
- $r->set_identical( $labels{$r->text} );
+ try {
+ $r->set_identical( $labels{$r->text} );
+ } catch( Text::Tradition::Error $e ) {
+ warn "Could not set transposition relationship $r -> "
+ . $labels{$r->text} . ": " . $e->message;
+ }
}
}
}
$rel_options{'equal_rank'} = 1;
if( @$lemma == @$var ) {
foreach my $i ( 0 .. $#{$lemma} ) {
- $collation->add_relationship( $var->[$i], $lemma->[$i],
- \%rel_options );
+ try {
+ $collation->add_relationship( $var->[$i], $lemma->[$i],
+ \%rel_options );
+ } catch( Text::Tradition::Error $e ) {
+ warn "Could not set $type relationship " . $var->[$i] . " -> "
+ . $lemma->[$i] . ": " . $e->message;
+ }
}
} else {
# An uneven many-to-many mapping. Skip for now.
# my $lemseg = @$lemma > 1 ? $collation->add_segment( @$lemma ) : $lemma->[0];
# my $varseg = @$var > 1 ? $collation->add_segment( @$var ) : $var->[0];
# $collation->add_relationship( $varseg, $lemseg, \%rel_options );
- if( @$lemma == 1 && @$var == 1 ) {
- $collation->add_relationship( $lemma->[0], $var->[0], \%rel_options );
- }
+ # if( @$lemma == 1 && @$var == 1 ) {
+ # $collation->add_relationship( $lemma->[0], $var->[0], \%rel_options );
+ # }
}
} elsif( $type !~ /^(add|om|lex)$/i ) {
warn "Unrecognized type $type";
use Graph;
use Graph::Reader::Dot;
use IPC::Run qw/ run binary /;
+use Text::Tradition::Error;
use Text::Tradition::StemmaUtil qw/ character_input phylip_pars parse_newick /;
use Moose;
unless $self->graph->has_vertex_attribute( $v, 'class' );
}
} else {
- warn "Failed to parse dot in $dotfh";
+ throw( "Failed to parse dot in $dotfh" );
}
}
$self->_save_distance_trees( $trees );
$self->distance_program( $args{'program'} );
} else {
- warn "Failed to calculate distance trees: $result";
+ throw( "Failed to calculate distance trees: $result" );
}
}
};
return phylip_pars( $cdata );
}
+sub throw {
+ Text::Tradition::Error->throw(
+ 'ident' => 'Stemma error',
+ 'message' => $_[0],
+ );
+}
+
+
no Moose;
__PACKAGE__->meta->make_immutable;
projects / scpubgit/stemmatology.git / commitdiff