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 || $answer->{status} == -1 ) {
218 # 1 means running, -1 means waiting to run. Either way, 'not ready'.
219 $c->stash->{'result'} = { 'status' => 'running' };
221 # Failure. Clear the job ID so that the user can try again.
222 $tradition->_clear_stemweb_jobid;
223 $m->save( $tradition );
224 $c->stash->{'result'} = { 'status' => 'failed', 'message' => $answer->{result} };
226 $c->forward('View::JSON');
231 GET stemweb/request/?
232 tradition=<tradition ID> &
233 algorithm=<algorithm ID> &
234 [<algorithm parameters>]
236 Send a request for the given tradition with the given parameters to Stemweb.
237 Processes and returns the JSON response given by the Stemweb server.
241 sub request :Local :Args(0) {
242 my( $self, $c ) = @_;
243 # Look up the relevant tradition and check permissions.
244 my $reqparams = $c->req->params;
245 my $tid = delete $reqparams->{tradition};
246 my $t = $c->model('Directory')->tradition( $tid );
247 my $ok = _check_permission( $c, $t );
249 return( _json_error( $c, 403,
250 'You do not have permission to update stemmata for this tradition' ) )
251 unless $ok eq 'full';
253 my $algorithm = delete $reqparams->{algorithm};
254 my $mergetypes = delete $reqparams->{merge_reltypes};
255 if( $self->_has_pars && $algorithm == $self->pars_pk ) {
256 my $start_time = scalar( gmtime( time() ) );
257 $t->set_stemweb_jobid( 'local' );
258 my $cdata = character_input( $t, { collapse => $mergetypes } );
261 $newick = phylip_pars( $cdata, { parspath => $self->_has_pars } );
262 } catch ( Text::Tradition::Error $e ) {
263 return _json_error( $c, 503, "Parsimony tree generation failed: "
266 # We have a result, so form an answer to process.
270 'format' => 'newick',
274 start_time => $start_time
276 return _process_stemweb_result( $c, $answer );
278 # Form the request for Stemweb.
279 my $return_uri = URI->new( $c->uri_for( '/stemweb/result' ) );
280 my $tsv_options = { noac => 1, ascii => 1 };
281 if( $mergetypes && @$mergetypes ) {
282 $tsv_options->{mergetypes} = $mergetypes;
284 my $stemweb_request = {
285 return_path => $return_uri->path,
286 return_host => $return_uri->host_port,
287 data => $t->collation->as_tsv( $tsv_options ),
288 userid => $c->user->get_object->email,
290 parameters => _cast_nonstrings( $reqparams ) };
292 # Call to the appropriate URL with the request parameters.
293 my $ua = LWP::UserAgent->new();
294 # $c->log->debug( 'Sending request to Stemweb: ' . to_json( $stemweb_request ) );
295 my $resp = $ua->post( $self->stemweb_url . "/algorithms/process/$algorithm/",
296 'Content-Type' => 'application/json; charset=utf-8',
297 'Content' => encode_json( $stemweb_request ) );
298 if( $resp->is_success ) {
300 $c->log->debug( 'Got a response from the server: '
301 . decode_utf8( $resp->content ) );
302 my $stemweb_response = decode_json( $resp->content );
304 $t->set_stemweb_jobid( $stemweb_response->{jobid} );
305 } catch( Text::Tradition::Error $e ) {
306 return _json_error( $c, 429, $e->message );
308 $c->model('Directory')->save( $t );
309 $c->stash->{'result'} = $stemweb_response;
310 $c->forward('View::JSON');
311 } elsif( $resp->code == 500 && $resp->header('Client-Warning')
312 && $resp->header('Client-Warning') eq 'Internal response' ) {
313 # The server was unavailable.
314 return _json_error( $c, 503, "The Stemweb server is currently unreachable." );
316 return _json_error( $c, 500, "Stemweb error: " . $resp->code . " / "
322 # Helper to check what permission, if any, the active user has for
323 # the given tradition
324 sub _check_permission {
325 my( $c, $tradition ) = @_;
326 my $user = $c->user_exists ? $c->user->get_object : undef;
328 return 'full' if ( $user->is_admin ||
329 ( $tradition->has_user && $tradition->user->id eq $user->id ) );
331 # Text doesn't belong to us, so maybe it's public?
332 return 'readonly' if $tradition->public;
334 # ...nope. Forbidden!
335 return _json_error( $c, 403, 'You do not have permission to view this tradition.' );
338 # QUICK HACK to deal with strict Stemweb validation.
339 sub _cast_nonstrings {
341 foreach my $k ( keys %$params ) {
342 my $v = $params->{$k};
343 if( looks_like_number( $v ) ) {
344 $params->{$k} = $v * 1;
345 } elsif ( !defined $v || $v eq 'true' ) {
346 $params->{$k} = _json_bool( $v );
352 # Helper to throw a JSON exception
354 my( $c, $code, $errmsg ) = @_;
355 $c->response->status( $code );
356 $c->stash->{'result'} = { 'error' => $errmsg };
357 $c->forward('View::JSON');
362 return $_[0] ? JSON::true : JSON::false;
367 return $self->pars_path || which('pars');