Error handling when compressing readings
[scpubgit/stemmaweb.git] / lib / stemmaweb / Controller / Relation.pm
index bfe9d87..fd5a452 100644 (file)
@@ -1,13 +1,23 @@
 package stemmaweb::Controller::Relation;
 use JSON qw/ to_json from_json /;
 use Moose;
+use Moose::Util::TypeConstraints qw/ find_type_constraint /;
 use Module::Load;
 use namespace::autoclean;
+use Text::Tradition::Datatypes;
 use TryCatch;
 
 BEGIN { extends 'Catalyst::Controller' }
 
 
+sub throw {
+       Text::Tradition::Error->throw(
+               'ident' => 'Collation error',
+               'message' => $_[0],
+               );
+}
+
+
 =head1 NAME
 
 stemmaweb::Controller::Relation - Controller for the relationship mapper
@@ -68,9 +78,15 @@ sub main :Chained('text') :PathPart('') :Args(0) {
        my( $self, $c ) = @_;
        my $tradition = delete $c->stash->{'tradition'};
        my $collation = $tradition->collation;
-       
+
+       # Stash text direction to use in JS.
+       $c->stash->{'direction'} = $collation->direction;
+
        # Stash the relationship definitions
-       $c->stash->{'relationship_scopes'} = to_json( [ qw/ local global / ] );
+       $c->stash->{'relationship_scopes'} = 
+               to_json( find_type_constraint( 'RelationshipScope' )->values );
+       $c->stash->{'ternary_values'} = 
+               to_json( find_type_constraint( 'Ternary' )->values );
        my @reltypeinfo;
        foreach my $type ( sort { _typesort( $a, $b ) } $collation->relations->types ) {
                next if $type->is_weak;
@@ -128,7 +144,7 @@ sub main :Chained('text') :PathPart('') :Args(0) {
        $c->stash->{'startseg'} = $startseg if defined $startseg;
        $c->stash->{'svg_string'} = $svg_str;
        $c->stash->{'text_title'} = $tradition->name;
-       if( $tradition->can('language') ) {
+       if( $tradition->can('language') && $tradition->language ) {
                $c->stash->{'text_lang'} = $tradition->language;
                $c->stash->{'can_morphologize'} = 1;
        } else {
@@ -201,8 +217,15 @@ sub relationships :Chained('text') :PathPart :Args(0) {
                        my $relobj = $collation->relations->get_relationship( @$p );
                        next if $relobj->type eq 'collated'; # Don't show these
                        next if $p->[0] eq $p->[1]; # HACK until bugfix
-                       my $relhash = { source => $p->[0], target => $p->[1], 
-                                 type => $relobj->type, scope => $relobj->scope };
+                       my $relhash = { source_id => $p->[0], target_id => $p->[1], 
+                                 source_text => $collation->reading( $p->[0] )->text,
+                                 target_text => $collation->reading( $p->[1] )->text,
+                                 type => $relobj->type, scope => $relobj->scope,
+                                 a_derivable_from_b => $relobj->a_derivable_from_b,
+                                 b_derivable_from_a => $relobj->b_derivable_from_a,
+                                 non_independent => $relobj->non_independent,
+                                 is_significant => $relobj->is_significant
+                                 };
                        $relhash->{'note'} = $relobj->annotation if $relobj->has_annotation;
                        push( @all_relations, $relhash );
                }
@@ -215,15 +238,34 @@ sub relationships :Chained('text') :PathPart :Args(0) {
                                'error' => 'You do not have permission to modify this tradition.' };
                        $c->detach( 'View::JSON' );
                } elsif( $c->request->method eq 'POST' ) {
-                       my $node = $c->request->param('source_id');
-                       my $target = $c->request->param('target_id');
-                       my $relation = $c->request->param('rel_type');
-                       my $note = $c->request->param('note');
-                       my $scope = $c->request->param('scope');
+                       my $opts = $c->request->params; 
+                       
+                       # Retrieve the source / target from the options
+                       my $node = delete $opts->{source_id};
+                       my $target = delete $opts->{target_id};
+                       
+                       # Make sure we didn't send a blank or invalid relationship type
+                       my $relation = $opts->{type};
+                       unless( $collation->get_relationship_type( $relation ) ) {
+                               my $errmsg = $relation ? "No such relationship type $relation" :
+                                       "You must specify a relationship type";
+                               $c->stash->{'result'} = { error => $errmsg };
+                               $c->response->status( '400' );
+                               $c->detach( 'View::JSON' );
+                       }
+                       
+                       # Keep the data clean
+                       my @booleans = qw/ a_derivable_from_b b_derivable_from_a non_independent /;
+                       foreach my $k ( keys %$opts ) {
+                               if( $opts->{$k} && grep { $_ eq $k } @booleans ) {
+                                       $opts->{$k} = 1;
+                               }
+                       }
                
-                       my $opts = { 'type' => $relation, 'propagate' => 1 };
-                       $opts->{'scope'} = $scope if $scope;
-                       $opts->{'annotation'} = $note if $note;
+                       delete $opts->{scope} unless $opts->{scope};
+                       delete $opts->{annotation} unless $opts->{annotation};
+                       delete $opts->{is_significant} unless $opts->{is_significant};
+                       $opts->{propagate} = 1;
                        
                        try {
                                my @vectors = $collation->add_relationship( $node, $target, $opts );
@@ -231,7 +273,10 @@ sub relationships :Chained('text') :PathPart :Args(0) {
                                $m->save( $tradition );
                        } catch( Text::Tradition::Error $e ) {
                                $c->response->status( '403' );
-                               $c->stash->{'result'} = { 'error' => $e->message };
+                               $c->stash->{'result'} = { error => $e->message };
+                       } catch {
+                               $c->response->status( '500' );
+                               $c->stash->{'result'} = { error => "Something went wrong with the request" };
                        }
                } elsif( $c->request->method eq 'DELETE' ) {
                        my $node = $c->request->param('source_id');
@@ -245,7 +290,10 @@ sub relationships :Chained('text') :PathPart :Args(0) {
                        } catch( Text::Tradition::Error $e ) {
                                $c->response->status( '403' );
                                $c->stash->{'result'} = { 'error' => $e->message };
-                       }       
+                       } catch {
+                               $c->response->status( '500' );
+                               $c->stash->{'result'} = { error => "Something went wrong with the request" };
+                       }
                }
        }
        $c->forward('View::JSON');
@@ -365,7 +413,7 @@ sub reading :Chained('text') :PathPart :Args(1) {
                                                                $errmsg = $e->message;
                                                        } catch {
                                                                # Something else went wrong, probably a Moose error
-                                                               $c->response->status( '403' );
+                                                               $c->response->status( '500' );
                                                                $errmsg = 'Something went wrong with the request';      
                                                        }
                                                }
@@ -388,6 +436,111 @@ sub reading :Chained('text') :PathPart :Args(1) {
 
 }
 
+sub compress :Chained('text') :PathPart :Args(0) {
+       my( $self, $c ) = @_;
+       my $tradition = delete $c->stash->{'tradition'};
+       my $collation = $tradition->collation;
+       my $m = $c->model('Directory');
+
+       my @rids = $c->request->param('readings[]');
+       my @readings;
+
+       foreach my $rid (@rids) {
+               my $rdg = $collation->reading( $rid );
+
+               push @readings, $rdg;
+       }
+
+       my $len = scalar @readings;
+
+       if( $c->request->method eq 'POST' ) {
+               if( $c->stash->{'permission'} ne 'full' ) {
+                       $c->response->status( '403' );
+                       $c->stash->{'result'} = { 
+                               'error' => 'You do not have permission to modify this tradition.' };
+                       $c->detach('View::JSON');
+                       return;
+               }
+
+               # Sanity check: first save the original text of each witness.
+               my %origtext;
+               foreach my $wit ( $tradition->witnesses ) {
+                       $origtext{$wit->sigil} = $collation->path_text( $wit->sigil );
+                       if( $wit->is_layered ) {
+                               my $acsig = $wit->sigil . $collation->ac_label;
+                               $origtext{$acsig} = $collation->path_text( $acsig );
+                       }
+               }
+
+               my $first = 0;
+
+               for (my $i = 0; $i < $len; $i++) {
+                       my $rdg = $readings[$i];
+
+                       if ($rdg->is_combinable) {
+                               $first = $i;
+                               last;
+                       }
+               }
+
+               my @nodes;
+               push @nodes, "$readings[$first]";
+
+               for (my $i = $first+1; $i < $len; $i++) {
+                       my $rdg = $readings[$first];
+                       my $next = $readings[$i];
+
+                       last unless $next->is_combinable;
+                       push @nodes, "$next";
+
+                       try {
+                               $collation->merge_readings( "$rdg", "$next", 1 );
+                       } catch ($e) {
+                               $c->stash->{result} = {
+                                       error_msg => $e->message,
+                               };
+
+                               $c->detach('View::JSON');
+                       }
+               }
+               
+               try {
+                       # Finally, make sure we haven't screwed anything up.
+                       foreach my $wit ( $tradition->witnesses ) {
+                               my $pathtext = $collation->path_text( $wit->sigil );
+                               throw( "Text differs for witness " . $wit->sigil )
+                                       unless $pathtext eq $origtext{$wit->sigil};
+                               if( $wit->is_layered ) {
+                                       my $acsig = $wit->sigil . $collation->ac_label;
+                                       $pathtext = $collation->path_text( $acsig );
+                                       throw( "Layered text differs for witness " . $wit->sigil )
+                                               unless $pathtext eq $origtext{$acsig};
+                               }
+                       }
+               } catch ($e) {
+                       $c->stash->{result} = {
+                               error_msg => $e->message,
+                       };
+
+                       $c->detach('View::JSON');
+               }
+
+
+               $collation->relations->rebuild_equivalence();
+               $collation->calculate_ranks();
+
+               $m->save($collation);
+
+
+               $c->stash->{'result'} = {
+                       success => 1,
+                       nodes   => \@nodes,
+               };
+
+               $c->forward('View::JSON');
+       }
+}
+
 =head2 merge
 
  POST relation/$textid/merge { data }
@@ -441,11 +594,13 @@ sub merge :Chained('text') :PathPart :Args(0) {
                        $response = { status => 'error', error => $errmsg };
                } else {
                        $response = { status => 'ok' };
-                       my @identical = $collation->identical_readings(
-                               start => $main, end => $csucc->id );
-                       if( @identical ) {
-                               $response->{'checkalign'} = [ 
-                                       map { [ $_->[0]->id, $_->[1]->id ] } @identical ];
+                       unless( $c->request->param('single') ) {
+                               my @identical = $collation->identical_readings(
+                                       start => $main, end => $csucc->id );
+                               if( @identical ) {
+                                       $response->{'checkalign'} = [ 
+                                               map { [ $_->[0]->id, $_->[1]->id ] } @identical ];
+                               }
                        }
                        $m->save( $collation );
                }
@@ -534,29 +689,34 @@ sub duplicate :Chained('text') :PathPart :Args(0) {
                
                # Otherwise, do the dirty work.
                my @witlist = keys %wits;
+               my @deleted_relations;
                foreach my $rank ( sort { $a <=> $b } keys %rdgranks ) {
                        my $newrdg;
                        my $reading_id = $rdgranks{$rank};
+                       my @delrels;
                        try {
-                               $newrdg = $collation->duplicate_reading( $reading_id, @witlist );
+                               ( $newrdg, @delrels ) = 
+                                       $collation->duplicate_reading( $reading_id, @witlist );
                        } catch( Text::Tradition::Error $e ) {
                                $c->response->status( '403' );
                                $errmsg = $e->message;
                        } catch {
                                # Something else went wrong, probably a Moose error
-                               $c->response->status( '403' );
+                               $c->response->status( '500' );
                                $errmsg = 'Something went wrong with the request';      
                        }
                        if( $newrdg ) {
                                my $data = _reading_struct( $newrdg );
                                $data->{'orig_rdg'} = $reading_id;
                                $response->{"$newrdg"} = $data;
+                               push( @deleted_relations, @delrels );
                        }
                } 
                if( $errmsg ) {
                        $c->stash->{'result'} = { 'error' => $errmsg };
                } else {
                        $m->save( $collation );
+                       $response->{'DELETED'} = \@deleted_relations;
                        $c->stash->{'result'} = $response;
                }
        }
@@ -589,8 +749,8 @@ sub _check_permission {
 }
 
 sub _clean_booleans {
-       my( $rdg, $param, $val ) = @_;
-       if( $rdg->meta->get_attribute( $param )->type_constraint->name eq 'Bool' ) {
+       my( $obj, $param, $val ) = @_;
+       if( $obj->meta->get_attribute( $param )->type_constraint->name eq 'Bool' ) {
                $val = 1 if $val eq 'true';
                $val = undef if $val eq 'false';
        }