X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fstemmaweb%2FController%2FRelation.pm;h=7b75c8ec07f35d9df99d3fd10a4d9c80c140cb6e;hb=e4bdf6606498d358c80e45b8cee69250b3bee6d3;hp=52bc5f9d767eb9c34b01391fa7d04c9bd669b7b0;hpb=fdb375813058a9ce84302986d594f4f08cc9f291;p=scpubgit%2Fstemmaweb.git diff --git a/lib/stemmaweb/Controller/Relation.pm b/lib/stemmaweb/Controller/Relation.pm index 52bc5f9..7b75c8e 100644 --- a/lib/stemmaweb/Controller/Relation.pm +++ b/lib/stemmaweb/Controller/Relation.pm @@ -1,8 +1,10 @@ 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' } @@ -70,7 +72,10 @@ sub main :Chained('text') :PathPart('') :Args(0) { my $collation = $tradition->collation; # 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; @@ -201,8 +206,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 +227,33 @@ 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}; + $opts->{propagate} = 1; try { my @vectors = $collation->add_relationship( $node, $target, $opts ); @@ -388,6 +418,74 @@ sub reading :Chained('text') :PathPart :Args(1) { } +=head2 merge + + POST relation/$textid/merge { data } + +Merges the requested readings, combining the witnesses of both readings into +the target reading. All non-conflicting source relationships are inherited by +the target relationship. + +=cut + +sub merge :Chained('text') :PathPart :Args(0) { + my( $self, $c ) = @_; + my $tradition = delete $c->stash->{'tradition'}; + my $collation = $tradition->collation; + my $m = $c->model('Directory'); + 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; + } + my $errmsg; + my $response; + + my $main = $c->request->param('target_id'); + my $second = $c->request->param('source_id'); + # Find the common successor of these, so that we can detect other + # potentially identical readings. + my $csucc = $collation->common_successor( $main, $second ); + + # Try the merge if these are parallel readings. + if( $csucc->id eq $main || $csucc->id eq $second ) { + $errmsg = "Cannot merge readings in the same path"; + } else { + try { + $collation->merge_readings( $main, $second ); + } 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' ); + $errmsg = 'Something went wrong with the request'; + } + } + + # Look for readings that are now identical. + if( $errmsg ) { + $response = { status => 'error', error => $errmsg }; + } else { + $response = { status => 'ok' }; + 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 ); + } + $c->stash->{'result'} = $response; + $c->forward('View::JSON'); + } +} + =head2 duplicate POST relation/$textid/duplicate { data } @@ -428,7 +526,8 @@ sub duplicate :Chained('text') :PathPart :Args(0) { foreach my $rwit ( $rdg->witnesses( $rid ) ) { $numwits++ if exists $wits{$rwit}; } - if( $numwits > 0 && $numwits < keys( %wits ) ) { + next unless $numwits; # Disregard readings with none of our witnesses + if( $numwits < keys( %wits ) ) { $errmsg = "Reading $rid contains some but not all of the specified witnesses."; last; } elsif( exists $rdgranks{ $rdg->rank } ) { @@ -467,11 +566,14 @@ 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; @@ -481,13 +583,17 @@ sub duplicate :Chained('text') :PathPart :Args(0) { $errmsg = 'Something went wrong with the request'; } if( $newrdg ) { - $response->{$reading_id} = _reading_struct( $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; } } @@ -520,8 +626,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'; }