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 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');