From: Tara L Andrews Date: Sat, 21 Jan 2012 21:19:51 +0000 (+0100) Subject: add exceptions to the rest of the Tradition library X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=63778331994b16f1890a1d6aa1a1e0dbfad73a21;hp=a2cf85dd89b882408436836441a51588d97ed443;p=scpubgit%2Fstemmatology.git add exceptions to the rest of the Tradition library --- diff --git a/Makefile.PL b/Makefile.PL index c5427c7..2ac2f1e 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -21,6 +21,7 @@ requires( 'KiokuX::Model' ); 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' ); diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm index 77a367e..1323c49 100644 --- a/lib/Text/Tradition/Collation.pm +++ b/lib/Text/Tradition/Collation.pm @@ -7,6 +7,7 @@ use IPC::Run qw( run binary ); use Text::CSV_XS; use Text::Tradition::Collation::Reading; use Text::Tradition::Collation::RelationshipStore; +use Text::Tradition::Error; use XML::LibXML; use Moose; @@ -246,8 +247,7 @@ sub add_reading { } # 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. @@ -401,11 +401,11 @@ sub clear_witness { 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 ) @@ -465,8 +465,7 @@ sub svg_subgraph { 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/; @@ -867,8 +866,7 @@ keys have a true hash value will be included. 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 ); @@ -969,23 +967,21 @@ sub reading_sequence { 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; @@ -1212,8 +1208,12 @@ sub calculate_ranks { 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?" ); } } } @@ -1373,6 +1373,13 @@ sub common_in_path { 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; diff --git a/lib/Text/Tradition/Collation/RelationshipStore.pm b/lib/Text/Tradition/Collation/RelationshipStore.pm index f33d12d..981fded 100644 --- a/lib/Text/Tradition/Collation/RelationshipStore.pm +++ b/lib/Text/Tradition/Collation/RelationshipStore.pm @@ -2,6 +2,7 @@ package Text::Tradition::Collation::RelationshipStore; use strict; use warnings; +use Text::Tradition::Error; use Text::Tradition::Collation::Relationship; use Moose; @@ -94,9 +95,8 @@ sub create { 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; } @@ -108,8 +108,7 @@ sub create { 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; @@ -173,7 +172,7 @@ sub add_relationship { 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. @@ -181,8 +180,7 @@ sub add_relationship { $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 ] ); @@ -212,17 +210,18 @@ sub add_relationship { 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 ) @@ -403,6 +402,13 @@ sub _add_graphml_data { $data_el->appendText( $value ); } +sub throw { + Text::Tradition::Error->throw( + 'ident' => 'Relationship error', + 'message' => $_[0], + ); +} + no Moose; __PACKAGE__->meta->make_immutable; diff --git a/lib/Text/Tradition/Error.pm b/lib/Text/Tradition/Error.pm index 14bfa79..18cb10e 100644 --- a/lib/Text/Tradition/Error.pm +++ b/lib/Text/Tradition/Error.pm @@ -5,16 +5,17 @@ use warnings; 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 diff --git a/lib/Text/Tradition/Parser/BaseText.pm b/lib/Text/Tradition/Parser/BaseText.pm index e07cdec..96d54ff 100644 --- a/lib/Text/Tradition/Parser/BaseText.pm +++ b/lib/Text/Tradition/Parser/BaseText.pm @@ -3,7 +3,9 @@ package Text::Tradition::Parser::BaseText; 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 @@ -392,10 +394,20 @@ sub set_relationships { $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; + } } } } @@ -413,8 +425,13 @@ sub set_relationships { $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. @@ -422,9 +439,9 @@ sub set_relationships { # 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"; diff --git a/lib/Text/Tradition/Stemma.pm b/lib/Text/Tradition/Stemma.pm index 2c7b310..fbf9ff7 100644 --- a/lib/Text/Tradition/Stemma.pm +++ b/lib/Text/Tradition/Stemma.pm @@ -6,6 +6,7 @@ use File::Temp; 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; @@ -57,7 +58,7 @@ sub graph_from_dot { unless $self->graph->has_vertex_attribute( $v, 'class' ); } } else { - warn "Failed to parse dot in $dotfh"; + throw( "Failed to parse dot in $dotfh" ); } } @@ -201,7 +202,7 @@ before 'distance_trees' => sub { $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" ); } } }; @@ -212,6 +213,14 @@ sub run_phylip_pars { return phylip_pars( $cdata ); } +sub throw { + Text::Tradition::Error->throw( + 'ident' => 'Stemma error', + 'message' => $_[0], + ); +} + + no Moose; __PACKAGE__->meta->make_immutable;