use Moose;
use namespace::autoclean;
use Encode qw/ decode_utf8 /;
+use File::Which;
use JSON;
+use List::Util qw/ max /;
use LWP::UserAgent;
use Safe::Isa;
+use Scalar::Util qw/ looks_like_number /;
+use Text::Tradition::StemmaUtil qw/ character_input phylip_pars /;
use TryCatch;
use URI;
BEGIN { extends 'Catalyst::Controller' }
-## TODO Move the /algorithms/available function to the Stemweb module
-my $STEMWEB_BASE_URL = 'http://slinkola.users.cs.helsinki.fi';
+has stemweb_url => (
+ is => 'ro',
+ isa => 'Str',
+ default => 'http://slinkola.users.cs.helsinki.fi',
+ );
+
+has pars_path => (
+ is => 'ro',
+ isa => 'Str',
+ );
+
+has pars_pk => (
+ is => 'rw',
+ isa => 'Int',
+ );
=head1 NAME
sub available :Local :Args(0) {
my( $self, $c ) = @_;
my $ua = LWP::UserAgent->new();
- my $resp = $ua->get( $STEMWEB_BASE_URL . '/algorithms/available' );
+ my $resp = $ua->get( $self->stemweb_url . '/algorithms/available' );
+ my $parameters = [];
if( $resp->is_success ) {
- $c->stash->{'result'} = $resp->content;
- } else {
- $c->stash->{'result'} = '{}';
+ $parameters = decode_json( $resp->content );
+ } # otherwise we have no available algorithms.
+ ## Temporary HACK: run Pars too
+ if( $self->_has_pars ) {
+ # Use the highest passed primary key + 1
+ my $parspk = max( map { $_->{pk} }
+ grep { $_->{model} eq 'algorithms.algorithm' } @$parameters ) + 1;
+ # Add Pars as an algorithm
+ $self->pars_pk( $parspk );
+ push( @$parameters, {
+ pk => $parspk,
+ model => 'algorithms.algorithm',
+ fields => {
+ args => [],
+ name => 'Pars',
+ 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.'
+ }
+ });
}
+ $c->stash->{result} = $parameters;
$c->forward('View::JSON');
}
sub query :Local :Args(1) {
my( $self, $c, $jobid ) = @_;
my $ua = LWP::UserAgent->new();
- my $resp = $ua->get( $STEMWEB_BASE_URL . "/algorithms/jobstatus/$jobid" );
+ my $resp = $ua->get( $self->stemweb_url . "/algorithms/jobstatus/$jobid" );
if( $resp->is_success ) {
# Process it
my $response = decode_utf8( $resp->content );
# Check all stemmata for the given jobid and return them.
@$stemmata = grep { $_->came_from_jobid && $_->from_jobid eq $answer->{jobid} } $tradition->stemmata;
}
- $DB::single = 1;
if( @$stemmata ) {
# If we got here, success!
+ # TODO Use helper in Root.pm to do this
my @steminfo = map { {
name => $_->identifier,
directed => _json_bool( !$_->is_undirected ),
}
$c->stash->{'result'} = { status => 'notfound' };
}
- } elsif( $answer->{status} < 1 ) {
+ } elsif( $answer->{status} == 1 ) {
$c->stash->{'result'} = { 'status' => 'running' };
} else {
- return _json_error( $c, 500,
- "Stemweb failure not handled: " . $answer->{result} );
+ # Failure. Clear the job ID so that the user can try again.
+ $tradition->_clear_stemweb_jobid;
+ $m->save( $tradition );
+ $c->stash->{'result'} = { 'status' => 'failed', 'message' => $answer->{result} };
}
$c->forward('View::JSON');
}
'You do not have permission to update stemmata for this tradition' ) )
unless $ok eq 'full';
- # Form the request for Stemweb.
my $algorithm = delete $reqparams->{algorithm};
- my $return_uri = URI->new( $c->uri_for( '/stemweb/result' ) );
- my $stemweb_request = {
- return_path => $return_uri->path,
- return_host => $return_uri->host_port,
- data => $t->collation->as_tsv({noac => 1}),
- userid => $c->user->get_object->email,
- textid => $tid,
- parameters => $reqparams };
-
- # Call to the appropriate URL with the request parameters.
- my $ua = LWP::UserAgent->new();
- $c->log->debug( 'Sending request to Stemweb: ' . to_json( $stemweb_request ) );
- my $resp = $ua->post( $STEMWEB_BASE_URL . "/algorithms/process/$algorithm/",
- 'Content-Type' => 'application/json; charset=utf-8',
- 'Content' => encode_json( $stemweb_request ) );
- if( $resp->is_success ) {
- # Process it
- $c->log->debug( 'Got a response from the server: '
- . decode_utf8( $resp->content ) );
- my $stemweb_response = decode_json( $resp->content );
+ my $mergetypes = delete $reqparams->{merge_reltypes};
+ if( $self->_has_pars && $algorithm == $self->pars_pk ) {
+ my $start_time = scalar( gmtime( time() ) );
+ $t->set_stemweb_jobid( 'local' );
+ my $cdata = character_input( $t, { collapse => $mergetypes } );
+ my $newick;
try {
- $t->set_stemweb_jobid( $stemweb_response->{jobid} );
- } catch( Text::Tradition::Error $e ) {
- return _json_error( $c, 429, $e->message );
+ $newick = phylip_pars( $cdata, { parspath => $self->_has_pars } );
+ } catch ( Text::Tradition::Error $e ) {
+ return _json_error( $c, 503, "Parsimony tree generation failed: "
+ . $e->message );
}
- $c->model('Directory')->save( $t );
- $c->stash->{'result'} = $stemweb_response;
- $c->forward('View::JSON');
- } elsif( $resp->code == 500 && $resp->header('Client-Warning')
- && $resp->header('Client-Warning') eq 'Internal response' ) {
- # The server was unavailable.
- return _json_error( $c, 503, "The Stemweb server is currently unreachable." );
+ # We have a result, so form an answer to process.
+ my $answer = {
+ status => 0,
+ algorithm => 'pars',
+ 'format' => 'newick',
+ textid => $tid,
+ jobid => 'local',
+ result => $newick,
+ start_time => $start_time
+ };
+ return _process_stemweb_result( $c, $answer );
} else {
- return _json_error( $c, 500, "Stemweb error: " . $resp->code . " / "
- . $resp->content );
+ # Form the request for Stemweb.
+ my $return_uri = URI->new( $c->uri_for( '/stemweb/result' ) );
+ my $tsv_options = { noac => 1, ascii => 1 };
+ if( $mergetypes && @$mergetypes ) {
+ $tsv_options->{mergetypes} = $mergetypes;
+ }
+ my $stemweb_request = {
+ return_path => $return_uri->path,
+ return_host => $return_uri->host_port,
+ data => $t->collation->as_tsv( $tsv_options ),
+ userid => $c->user->get_object->email,
+ textid => $tid,
+ parameters => _cast_nonstrings( $reqparams ) };
+
+ # Call to the appropriate URL with the request parameters.
+ my $ua = LWP::UserAgent->new();
+ # $c->log->debug( 'Sending request to Stemweb: ' . to_json( $stemweb_request ) );
+ my $resp = $ua->post( $self->stemweb_url . "/algorithms/process/$algorithm/",
+ 'Content-Type' => 'application/json; charset=utf-8',
+ 'Content' => encode_json( $stemweb_request ) );
+ if( $resp->is_success ) {
+ # Process it
+ $c->log->debug( 'Got a response from the server: '
+ . decode_utf8( $resp->content ) );
+ my $stemweb_response = decode_json( $resp->content );
+ try {
+ $t->set_stemweb_jobid( $stemweb_response->{jobid} );
+ } catch( Text::Tradition::Error $e ) {
+ return _json_error( $c, 429, $e->message );
+ }
+ $c->model('Directory')->save( $t );
+ $c->stash->{'result'} = $stemweb_response;
+ $c->forward('View::JSON');
+ } elsif( $resp->code == 500 && $resp->header('Client-Warning')
+ && $resp->header('Client-Warning') eq 'Internal response' ) {
+ # The server was unavailable.
+ return _json_error( $c, 503, "The Stemweb server is currently unreachable." );
+ } else {
+ return _json_error( $c, 500, "Stemweb error: " . $resp->code . " / "
+ . $resp->content );
+ }
}
}
return _json_error( $c, 403, 'You do not have permission to view this tradition.' );
}
+# QUICK HACK to deal with strict Stemweb validation.
+sub _cast_nonstrings {
+ my $params = shift;
+ foreach my $k ( keys %$params ) {
+ my $v = $params->{$k};
+ if( looks_like_number( $v ) ) {
+ $params->{$k} = $v * 1;
+ } elsif ( !defined $v || $v eq 'true' ) {
+ $params->{$k} = _json_bool( $v );
+ }
+ }
+ return $params;
+}
+
# Helper to throw a JSON exception
sub _json_error {
my( $c, $code, $errmsg ) = @_;
$c->stash->{'result'} = { 'error' => $errmsg };
$c->forward('View::JSON');
return 0;
-}
+}
sub _json_bool {
return $_[0] ? JSON::true : JSON::false;
}
+sub _has_pars {
+ my $self = shift;
+ return $self->pars_path || which('pars');
+}
+
1;
projects / scpubgit/stemmaweb.git / blobdiff