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' );
108 if( $resp->is_success ) {
109 my $parameters = decode_json( $resp->content );
110 # Temporary hack: add Pars
111 if( $self->_has_pars ) {
112 # Use the highest passed primary key + 1
113 my $parspk = max( map { $_->{pk} }
114 grep { $_->{model} eq 'algorithms.algorithm' } @$parameters ) + 1;
115 # Add Pars as an algorithm
116 $self->pars_pk( $parspk );
117 push( @$parameters, {
119 model => 'algorithms.algorithm',
126 $c->stash->{'result'} = $parameters;
128 $c->stash->{'result'} = {};
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 return _json_error( $c, 500,
221 "Stemweb failure not handled: " . $answer->{result} );
223 $c->forward('View::JSON');
228 GET stemweb/request/?
229 tradition=<tradition ID> &
230 algorithm=<algorithm ID> &
231 [<algorithm parameters>]
233 Send a request for the given tradition with the given parameters to Stemweb.
234 Processes and returns the JSON response given by the Stemweb server.
238 sub request :Local :Args(0) {
239 my( $self, $c ) = @_;
240 # Look up the relevant tradition and check permissions.
241 my $reqparams = $c->req->params;
242 my $tid = delete $reqparams->{tradition};
243 my $t = $c->model('Directory')->tradition( $tid );
244 my $ok = _check_permission( $c, $t );
246 return( _json_error( $c, 403,
247 'You do not have permission to update stemmata for this tradition' ) )
248 unless $ok eq 'full';
250 my $algorithm = delete $reqparams->{algorithm};
251 my $mergetypes = delete $reqparams->{merge_reltypes};
252 if( $self->_has_pars && $algorithm == $self->pars_pk ) {
253 my $start_time = scalar( gmtime( time() ) );
254 $t->set_stemweb_jobid( 'local' );
255 my $cdata = character_input( $t, { collapse => $mergetypes } );
258 $newick = phylip_pars( $cdata, { parspath => $self->_has_pars } );
259 } catch ( Text::Tradition::Error $e ) {
260 return _json_error( $c, 503, "Parsimony tree generation failed: "
263 # We have a result, so form an answer to process.
267 'format' => 'newick',
271 start_time => $start_time
273 return _process_stemweb_result( $c, $answer );
275 # Form the request for Stemweb.
276 my $return_uri = URI->new( $c->uri_for( '/stemweb/result' ) );
277 my $tsv_options = { noac => 1 };
278 if( $mergetypes && @$mergetypes ) {
279 $tsv_options->{mergetypes} = $mergetypes;
281 my $stemweb_request = {
282 return_path => $return_uri->path,
283 return_host => $return_uri->host_port,
284 data => $t->collation->as_tsv( $tsv_options ),
285 userid => $c->user->get_object->email,
287 parameters => _cast_nonstrings( $reqparams ) };
289 # Call to the appropriate URL with the request parameters.
290 my $ua = LWP::UserAgent->new();
291 $c->log->debug( 'Sending request to Stemweb: ' . to_json( $stemweb_request ) );
292 my $resp = $ua->post( $self->stemweb_url . "/algorithms/process/$algorithm/",
293 'Content-Type' => 'application/json; charset=utf-8',
294 'Content' => encode_json( $stemweb_request ) );
295 if( $resp->is_success ) {
297 $c->log->debug( 'Got a response from the server: '
298 . decode_utf8( $resp->content ) );
299 my $stemweb_response = decode_json( $resp->content );
301 $t->set_stemweb_jobid( $stemweb_response->{jobid} );
302 } catch( Text::Tradition::Error $e ) {
303 return _json_error( $c, 429, $e->message );
305 $c->model('Directory')->save( $t );
306 $c->stash->{'result'} = $stemweb_response;
307 $c->forward('View::JSON');
308 } elsif( $resp->code == 500 && $resp->header('Client-Warning')
309 && $resp->header('Client-Warning') eq 'Internal response' ) {
310 # The server was unavailable.
311 return _json_error( $c, 503, "The Stemweb server is currently unreachable." );
313 return _json_error( $c, 500, "Stemweb error: " . $resp->code . " / "
319 # Helper to check what permission, if any, the active user has for
320 # the given tradition
321 sub _check_permission {
322 my( $c, $tradition ) = @_;
323 my $user = $c->user_exists ? $c->user->get_object : undef;
325 return 'full' if ( $user->is_admin ||
326 ( $tradition->has_user && $tradition->user->id eq $user->id ) );
328 # Text doesn't belong to us, so maybe it's public?
329 return 'readonly' if $tradition->public;
331 # ...nope. Forbidden!
332 return _json_error( $c, 403, 'You do not have permission to view this tradition.' );
335 # QUICK HACK to deal with strict Stemweb validation.
336 sub _cast_nonstrings {
338 foreach my $k ( keys %$params ) {
339 my $v = $params->{$k};
340 if( looks_like_number( $v ) ) {
341 $params->{$k} = $v * 1;
342 } elsif ( !defined $v || $v eq 'true' ) {
343 $params->{$k} = _json_bool( $v );
349 # Helper to throw a JSON exception
351 my( $c, $code, $errmsg ) = @_;
352 $c->response->status( $code );
353 $c->stash->{'result'} = { 'error' => $errmsg };
354 $c->forward('View::JSON');
359 return $_[0] ? JSON::true : JSON::false;
364 return $self->pars_path || which('pars');