1 package stemmaweb::Controller::Stemweb;
3 use namespace::autoclean;
4 use Encode qw/ decode_utf8 /;
7 use List::Util qw/ max /;
10 use Scalar::Util qw/ looks_like_number /;
11 use Text::Tradition::StemmaUtil qw/ character_input phylip_pars /;
15 BEGIN { extends 'Catalyst::Controller' }
20 default => 'http://slinkola.users.cs.helsinki.fi',
35 stemmaweb::Controller::Stemweb - Client listener for Stemweb results
39 This is a client listener for the Stemweb API as implemented by the protocol defined at
40 L<https://docs.google.com/document/d/1aNYGAo1v1WPDZi6LXZ30FJSMJwF8RQPYbOkKqHdCZEc/pub>.
47 Content-Type: application/json
56 result: <error message> }
58 Used by the Stemweb server to notify us that one or more stemma graphs
59 has been calculated in response to an earlier request.
63 sub result :Local :Args(0) {
65 if( $c->request->method eq 'POST' ) {
66 # TODO: Verify the sender!
68 if( ref( $c->request->body ) eq 'File::Temp' ) {
69 # Read in the file and parse that.
70 $c->log->debug( "Request body is in a temp file" );
71 open( POSTDATA, $c->request->body )
72 or return _json_error( $c, 500, "Failed to open post data file" );
73 binmode( POSTDATA, ':utf8' );
74 # JSON should be all one line
75 my $pdata = <POSTDATA>;
79 $answer = from_json( $pdata );
81 return _json_error( $c, 400,
82 "Could not parse POST request '' $pdata '' as JSON: $@" );
85 $answer = from_json( $c->request->body );
87 $c->log->debug( "Received push notification from Stemweb: "
88 . to_json( $answer ) );
89 return _process_stemweb_result( $c, $answer );
91 return _json_error( $c, 403, 'Please use POST!' );
97 GET algorithms/available
99 Queries the Stemweb server for available stemma generation algorithms and their
100 parameters. Returns the JSON answer as obtained from Stemweb.
104 sub available :Local :Args(0) {
105 my( $self, $c ) = @_;
106 my $ua = LWP::UserAgent->new();
107 my $resp = $ua->get( $self->stemweb_url . '/algorithms/available' );
109 if( $resp->is_success ) {
110 $parameters = decode_json( $resp->content );
111 } # otherwise we have no available algorithms.
112 ## Temporary HACK: run Pars too
113 if( $self->_has_pars ) {
114 # Use the highest passed primary key + 1
115 my $parspk = max( map { $_->{pk} }
116 grep { $_->{model} eq 'algorithms.algorithm' } @$parameters ) + 1;
117 # Add Pars as an algorithm
118 $self->pars_pk( $parspk );
119 push( @$parameters, {
121 model => 'algorithms.algorithm',
125 desc => 'The program "pars", from the Phylip bio-statistical software package, produces a maximum-parsimony distance tree of the witnesses. More information on maximum parsimony can be found <a href="https://wiki.hiit.fi/display/stemmatology/Maximum+parsimony">here</a>. Please note that Phylip "pars" only supports a maximum of eight variants readings in any one variant location in the text. If your text displays more divergence than this at any point, please consider disregarding orthographic and spelling variation below, or use one of the other algorithms.'
129 $c->stash->{result} = $parameters;
130 $c->forward('View::JSON');
135 GET stemweb/query/<jobid>
137 A backup method to query the stemweb server to check a particular job status.
138 Returns a result as in /stemweb/result above, but status can also be -1 to
139 indicate that the job is still running.
143 sub query :Local :Args(1) {
144 my( $self, $c, $jobid ) = @_;
145 my $ua = LWP::UserAgent->new();
146 my $resp = $ua->get( $self->stemweb_url . "/algorithms/jobstatus/$jobid" );
147 if( $resp->is_success ) {
149 my $response = decode_utf8( $resp->content );
150 $c->log->debug( "Got a response from the server: $response" );
153 $answer = from_json( $response );
155 return _json_error( $c, 500,
156 "Could not parse stemweb response '' $response '' as JSON: $@" );
158 return _process_stemweb_result( $c, $answer );
159 } elsif( $resp->code == 500 && $resp->header('Client-Warning')
160 && $resp->header('Client-Warning') eq 'Internal response' ) {
161 # The server was unavailable.
162 return _json_error( $c, 503, "The Stemweb server is currently unreachable." );
164 return _json_error( $c, 500, "Stemweb error: " . $resp->code . " / "
170 ## Helper function for parsing Stemweb result data either by push or by pull
171 sub _process_stemweb_result {
172 my( $c, $answer ) = @_;
173 # Find the specified tradition and check its job ID.
174 my $m = $c->model('Directory');
175 my $tradition = $m->tradition( $answer->{textid} );
176 unless( $tradition ) {
177 return _json_error( $c, 400, "No tradition found with ID "
178 . $answer->{textid} );
180 if( $answer->{status} == 0 ) {
182 if( $tradition->has_stemweb_jobid
183 && $tradition->stemweb_jobid eq $answer->{jobid} ) {
185 $stemmata = $tradition->record_stemweb_result( $answer );
186 $m->save( $tradition );
187 } catch( Text::Tradition::Error $e ) {
188 return _json_error( $c, 500, $e->message );
190 return _json_error( $c, 500, $@ );
193 # It may be that we already received a callback meanwhile.
194 # Check all stemmata for the given jobid and return them.
195 @$stemmata = grep { $_->came_from_jobid && $_->from_jobid eq $answer->{jobid} } $tradition->stemmata;
198 # If we got here, success!
199 # TODO Use helper in Root.pm to do this
200 my @steminfo = map { {
201 name => $_->identifier,
202 directed => _json_bool( !$_->is_undirected ),
203 svg => $_->as_svg() } }
205 $c->stash->{'result'} = {
206 'status' => 'success',
207 'stemmata' => \@steminfo };
209 # Hm, no stemmata found on this tradition with this jobid.
210 # Clear the tradition jobid so that the user can try again.
211 if( $tradition->has_stemweb_jobid ) {
212 $tradition->_clear_stemweb_jobid;
213 $m->save( $tradition );
215 $c->stash->{'result'} = { status => 'notfound' };
217 } elsif( $answer->{status} == 1 ) {
218 $c->stash->{'result'} = { 'status' => 'running' };
220 # Failure. Clear the job ID so that the user can try again.
221 $tradition->_clear_stemweb_jobid;
222 $m->save( $tradition );
223 $c->stash->{'result'} = { 'status' => 'failed', 'message' => $answer->{result} };
225 $c->forward('View::JSON');
230 GET stemweb/request/?
231 tradition=<tradition ID> &
232 algorithm=<algorithm ID> &
233 [<algorithm parameters>]
235 Send a request for the given tradition with the given parameters to Stemweb.
236 Processes and returns the JSON response given by the Stemweb server.
240 sub request :Local :Args(0) {
241 my( $self, $c ) = @_;
242 # Look up the relevant tradition and check permissions.
243 my $reqparams = $c->req->params;
244 my $tid = delete $reqparams->{tradition};
245 my $t = $c->model('Directory')->tradition( $tid );
246 my $ok = _check_permission( $c, $t );
248 return( _json_error( $c, 403,
249 'You do not have permission to update stemmata for this tradition' ) )
250 unless $ok eq 'full';
252 my $algorithm = delete $reqparams->{algorithm};
253 my $mergetypes = delete $reqparams->{merge_reltypes};
254 if( $self->_has_pars && $algorithm == $self->pars_pk ) {
255 my $start_time = scalar( gmtime( time() ) );
256 $t->set_stemweb_jobid( 'local' );
257 my $cdata = character_input( $t, { collapse => $mergetypes } );
260 $newick = phylip_pars( $cdata, { parspath => $self->_has_pars } );
261 } catch ( Text::Tradition::Error $e ) {
262 return _json_error( $c, 503, "Parsimony tree generation failed: "
265 # We have a result, so form an answer to process.
269 'format' => 'newick',
273 start_time => $start_time
275 return _process_stemweb_result( $c, $answer );
277 # Form the request for Stemweb.
278 my $return_uri = URI->new( $c->uri_for( '/stemweb/result' ) );
279 my $tsv_options = { noac => 1 };
280 if( $mergetypes && @$mergetypes ) {
281 $tsv_options->{mergetypes} = $mergetypes;
283 my $stemweb_request = {
284 return_path => $return_uri->path,
285 return_host => $return_uri->host_port,
286 data => $t->collation->as_tsv( $tsv_options ),
287 userid => $c->user->get_object->email,
289 parameters => _cast_nonstrings( $reqparams ) };
291 # Call to the appropriate URL with the request parameters.
292 my $ua = LWP::UserAgent->new();
293 # $c->log->debug( 'Sending request to Stemweb: ' . to_json( $stemweb_request ) );
294 my $resp = $ua->post( $self->stemweb_url . "/algorithms/process/$algorithm/",
295 'Content-Type' => 'application/json; charset=utf-8',
296 'Content' => encode_json( $stemweb_request ) );
297 if( $resp->is_success ) {
299 $c->log->debug( 'Got a response from the server: '
300 . decode_utf8( $resp->content ) );
301 my $stemweb_response = decode_json( $resp->content );
303 $t->set_stemweb_jobid( $stemweb_response->{jobid} );
304 } catch( Text::Tradition::Error $e ) {
305 return _json_error( $c, 429, $e->message );
307 $c->model('Directory')->save( $t );
308 $c->stash->{'result'} = $stemweb_response;
309 $c->forward('View::JSON');
310 } elsif( $resp->code == 500 && $resp->header('Client-Warning')
311 && $resp->header('Client-Warning') eq 'Internal response' ) {
312 # The server was unavailable.
313 return _json_error( $c, 503, "The Stemweb server is currently unreachable." );
315 return _json_error( $c, 500, "Stemweb error: " . $resp->code . " / "
321 # Helper to check what permission, if any, the active user has for
322 # the given tradition
323 sub _check_permission {
324 my( $c, $tradition ) = @_;
325 my $user = $c->user_exists ? $c->user->get_object : undef;
327 return 'full' if ( $user->is_admin ||
328 ( $tradition->has_user && $tradition->user->id eq $user->id ) );
330 # Text doesn't belong to us, so maybe it's public?
331 return 'readonly' if $tradition->public;
333 # ...nope. Forbidden!
334 return _json_error( $c, 403, 'You do not have permission to view this tradition.' );
337 # QUICK HACK to deal with strict Stemweb validation.
338 sub _cast_nonstrings {
340 foreach my $k ( keys %$params ) {
341 my $v = $params->{$k};
342 if( looks_like_number( $v ) ) {
343 $params->{$k} = $v * 1;
344 } elsif ( !defined $v || $v eq 'true' ) {
345 $params->{$k} = _json_bool( $v );
351 # Helper to throw a JSON exception
353 my( $c, $code, $errmsg ) = @_;
354 $c->response->status( $code );
355 $c->stash->{'result'} = { 'error' => $errmsg };
356 $c->forward('View::JSON');
361 return $_[0] ? JSON::true : JSON::false;
366 return $self->pars_path || which('pars');