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',
30 stemmaweb::Controller::Stemweb - Client listener for Stemweb results
34 This is a client listener for the Stemweb API as implemented by the protocol defined at
35 L<https://docs.google.com/document/d/1aNYGAo1v1WPDZi6LXZ30FJSMJwF8RQPYbOkKqHdCZEc/pub>.
42 Content-Type: application/json
51 result: <error message> }
53 Used by the Stemweb server to notify us that one or more stemma graphs
54 has been calculated in response to an earlier request.
58 sub result :Local :Args(0) {
60 if( $c->request->method eq 'POST' ) {
61 # TODO: Verify the sender!
63 if( ref( $c->request->body ) eq 'File::Temp' ) {
64 # Read in the file and parse that.
65 $c->log->debug( "Request body is in a temp file" );
66 open( POSTDATA, $c->request->body )
67 or return _json_error( $c, 500, "Failed to open post data file" );
68 binmode( POSTDATA, ':utf8' );
69 # JSON should be all one line
70 my $pdata = <POSTDATA>;
74 $answer = from_json( $pdata );
76 return _json_error( $c, 400,
77 "Could not parse POST request '' $pdata '' as JSON: $@" );
80 $answer = from_json( $c->request->body );
82 $c->log->debug( "Received push notification from Stemweb: "
83 . to_json( $answer ) );
84 return _process_stemweb_result( $c, $answer );
86 return _json_error( $c, 403, 'Please use POST!' );
92 GET algorithms/available
94 Queries the Stemweb server for available stemma generation algorithms and their
95 parameters. Returns the JSON answer as obtained from Stemweb.
99 sub available :Local :Args(0) {
100 my( $self, $c ) = @_;
101 my $ua = LWP::UserAgent->new();
102 my $resp = $ua->get( $self->stemweb_url . '/algorithms/available' );
104 if( $resp->is_success ) {
105 $parameters = decode_json( $resp->content );
106 } # otherwise we have no available algorithms.
107 ## Temporary HACK: run Pars too
108 if( $self->_has_pars ) {
109 # Use 100 as the special pars key
110 # Add Pars as an algorithm
111 push( @$parameters, {
113 model => 'algorithms.algorithm',
117 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.'
121 $c->stash->{result} = $parameters;
122 $c->forward('View::JSON');
127 GET stemweb/query/<jobid>
129 A backup method to query the stemweb server to check a particular job status.
130 Returns a result as in /stemweb/result above, but status can also be -1 to
131 indicate that the job is still running.
135 sub query :Local :Args(1) {
136 my( $self, $c, $jobid ) = @_;
137 my $ua = LWP::UserAgent->new();
138 my $resp = $ua->get( $self->stemweb_url . "/algorithms/jobstatus/$jobid" );
139 if( $resp->is_success ) {
141 my $response = decode_utf8( $resp->content );
142 $c->log->debug( "Got a response from the server: $response" );
145 $answer = from_json( $response );
147 return _json_error( $c, 500,
148 "Could not parse stemweb response '' $response '' as JSON: $@" );
150 return _process_stemweb_result( $c, $answer );
151 } elsif( $resp->code == 500 && $resp->header('Client-Warning')
152 && $resp->header('Client-Warning') eq 'Internal response' ) {
153 # The server was unavailable.
154 return _json_error( $c, 503, "The Stemweb server is currently unreachable." );
156 return _json_error( $c, 500, "Stemweb error: " . $resp->code . " / "
162 ## Helper function for parsing Stemweb result data either by push or by pull
163 sub _process_stemweb_result {
164 my( $c, $answer ) = @_;
165 # Find the specified tradition and check its job ID.
166 my $m = $c->model('Directory');
167 my $tradition = $m->tradition( $answer->{textid} );
168 unless( $tradition ) {
169 return _json_error( $c, 400, "No tradition found with ID "
170 . $answer->{textid} );
172 if( $answer->{status} == 0 ) {
174 if( $tradition->has_stemweb_jobid
175 && $tradition->stemweb_jobid eq $answer->{jobid} ) {
177 $stemmata = $tradition->record_stemweb_result( $answer );
178 $m->save( $tradition );
179 } catch( Text::Tradition::Error $e ) {
180 return _json_error( $c, 500, $e->message );
182 return _json_error( $c, 500, $@ );
185 # It may be that we already received a callback meanwhile.
186 # Check all stemmata for the given jobid and return them.
187 @$stemmata = grep { $_->came_from_jobid && $_->from_jobid eq $answer->{jobid} } $tradition->stemmata;
190 # If we got here, success!
191 # TODO Use helper in Root.pm to do this
192 my @steminfo = map { {
193 name => $_->identifier,
194 directed => _json_bool( !$_->is_undirected ),
195 svg => $_->as_svg() } }
197 $c->stash->{'result'} = {
198 'status' => 'success',
199 'stemmata' => \@steminfo };
201 # Hm, no stemmata found on this tradition with this jobid.
202 # Clear the tradition jobid so that the user can try again.
203 if( $tradition->has_stemweb_jobid ) {
204 $tradition->_clear_stemweb_jobid;
205 $m->save( $tradition );
207 $c->stash->{'result'} = { status => 'notfound' };
209 } elsif( $answer->{status} == 1 || $answer->{status} == -1 ) {
210 # 1 means running, -1 means waiting to run. Either way, 'not ready'.
211 $c->stash->{'result'} = { 'status' => 'running' };
213 # Failure. Clear the job ID so that the user can try again.
214 $tradition->_clear_stemweb_jobid;
215 $m->save( $tradition );
216 $c->stash->{'result'} = { 'status' => 'failed', 'message' => $answer->{result} };
218 $c->forward('View::JSON');
223 GET stemweb/request/?
224 tradition=<tradition ID> &
225 algorithm=<algorithm ID> &
226 [<algorithm parameters>]
228 Send a request for the given tradition with the given parameters to Stemweb.
229 Processes and returns the JSON response given by the Stemweb server.
233 sub request :Local :Args(0) {
234 my( $self, $c ) = @_;
235 # Look up the relevant tradition and check permissions.
236 my $reqparams = $c->req->params;
237 my $tid = delete $reqparams->{tradition};
238 my $t = $c->model('Directory')->tradition( $tid );
239 my $ok = _check_permission( $c, $t );
241 return( _json_error( $c, 403,
242 'You do not have permission to update stemmata for this tradition' ) )
243 unless $ok eq 'full';
245 my $algorithm = delete $reqparams->{algorithm};
246 my $mergetypes = delete $reqparams->{merge_reltypes};
247 if( $self->_has_pars && $algorithm == 100 ) {
248 my $start_time = scalar( gmtime( time() ) );
249 $t->set_stemweb_jobid( 'local' );
250 my $cdata = character_input( $t, { collapse => $mergetypes } );
253 $newick = phylip_pars( $cdata, { parspath => $self->_has_pars } );
254 } catch ( Text::Tradition::Error $e ) {
255 return _json_error( $c, 503, "Parsimony tree generation failed: "
258 # We have a result, so form an answer to process.
262 'format' => 'newick',
266 start_time => $start_time
268 return _process_stemweb_result( $c, $answer );
270 # Form the request for Stemweb.
271 my $return_uri = URI->new( $c->uri_for( '/stemweb/result' ) );
272 my $tsv_options = { noac => 1, ascii => 1 };
273 if( $mergetypes && @$mergetypes ) {
274 $tsv_options->{mergetypes} = $mergetypes;
276 my $stemweb_request = {
277 return_path => $return_uri->path,
278 return_host => $return_uri->host_port,
279 data => $t->collation->as_tsv( $tsv_options ),
280 userid => $c->user->get_object->email,
282 parameters => _cast_nonstrings( $reqparams ) };
284 # Call to the appropriate URL with the request parameters.
285 my $ua = LWP::UserAgent->new();
286 # $c->log->debug( 'Sending request to Stemweb: ' . to_json( $stemweb_request ) );
287 my $resp = $ua->post( $self->stemweb_url . "/algorithms/process/$algorithm/",
288 'Content-Type' => 'application/json; charset=utf-8',
289 'Content' => encode_json( $stemweb_request ) );
290 if( $resp->is_success ) {
292 $c->log->debug( 'Got a response from the server: '
293 . decode_utf8( $resp->content ) );
294 my $stemweb_response = decode_json( $resp->content );
296 $t->set_stemweb_jobid( $stemweb_response->{jobid} );
297 } catch( Text::Tradition::Error $e ) {
298 return _json_error( $c, 429, $e->message );
300 $c->model('Directory')->save( $t );
301 $c->stash->{'result'} = $stemweb_response;
302 $c->forward('View::JSON');
303 } elsif( $resp->code == 500 && $resp->header('Client-Warning')
304 && $resp->header('Client-Warning') eq 'Internal response' ) {
305 # The server was unavailable.
306 return _json_error( $c, 503, "The Stemweb server is currently unreachable." );
308 return _json_error( $c, 500, "Stemweb error: " . $resp->code . " / "
314 # Helper to check what permission, if any, the active user has for
315 # the given tradition
316 sub _check_permission {
317 my( $c, $tradition ) = @_;
318 my $user = $c->user_exists ? $c->user->get_object : undef;
320 return 'full' if ( $user->is_admin ||
321 ( $tradition->has_user && $tradition->user->id eq $user->id ) );
323 # Text doesn't belong to us, so maybe it's public?
324 return 'readonly' if $tradition->public;
326 # ...nope. Forbidden!
327 return _json_error( $c, 403, 'You do not have permission to view this tradition.' );
330 # QUICK HACK to deal with strict Stemweb validation.
331 sub _cast_nonstrings {
333 foreach my $k ( keys %$params ) {
334 my $v = $params->{$k};
335 if( looks_like_number( $v ) ) {
336 $params->{$k} = $v * 1;
337 } elsif ( !defined $v || $v eq 'true' ) {
338 $params->{$k} = _json_bool( $v );
344 # Helper to throw a JSON exception
346 my( $c, $code, $errmsg ) = @_;
347 $c->response->status( $code );
348 $c->stash->{'result'} = { 'error' => $errmsg };
349 $c->forward('View::JSON');
354 return $_[0] ? JSON::true : JSON::false;
359 return $self->pars_path || which('pars');