[scpubgit/stemmaweb.git] / lib / stemmaweb / Controller / Stemweb.pm

package stemmaweb::Controller::Stemweb;
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' }

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

stemmaweb::Controller::Stemweb - Client listener for Stemweb results

=head1 DESCRIPTION

This is a client listener for the Stemweb API as implemented by the protocol defined at
L<https://docs.google.com/document/d/1aNYGAo1v1WPDZi6LXZ30FJSMJwF8RQPYbOkKqHdCZEc/pub>.

=head1 METHODS

=head2 result

 POST stemweb/result
 Content-Type: application/json
 (On success):
 { jobid: <ID number>
   status: 0
   format: <format>
   result: <data> }
 (On failure):
 { jobid: <ID number>
   status: >1
   result: <error message> }
   
Used by the Stemweb server to notify us that one or more stemma graphs
has been calculated in response to an earlier request.

=cut

sub result :Local :Args(0) {
	my( $self, $c ) = @_;
	if( $c->request->method eq 'POST' ) {
		# TODO: Verify the sender!
		my $answer;
		if( ref( $c->request->body ) eq 'File::Temp' ) {
			# Read in the file and parse that.
			$c->log->debug( "Request body is in a temp file" );
			open( POSTDATA, $c->request->body ) 
				or return _json_error( $c, 500, "Failed to open post data file" );
			binmode( POSTDATA, ':utf8' );
			# JSON should be all one line
			my $pdata = <POSTDATA>;
			chomp $pdata;
			close POSTDATA;
			try {
				$answer = from_json( $pdata );
			} catch {
				return _json_error( $c, 400, 
					"Could not parse POST request '' $pdata '' as JSON: $@" );
			}
		} else {
			$answer = from_json( $c->request->body );
		}
		$c->log->debug( "Received push notification from Stemweb: "
			. to_json( $answer ) );
		return _process_stemweb_result( $c, $answer );
	} else {
		return _json_error( $c, 403, 'Please use POST!' );
	}
}

=head2 available

 GET algorithms/available
 
Queries the Stemweb server for available stemma generation algorithms and their 
parameters. Returns the JSON answer as obtained from Stemweb.

=cut

sub available :Local :Args(0) {
	my( $self, $c ) = @_;
	my $ua = LWP::UserAgent->new();
	my $resp = $ua->get( $self->stemweb_url . '/algorithms/available' );
	my $parameters = [];
	if( $resp->is_success ) {
		$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');
}

=head2 query

 GET stemweb/query/<jobid>

A backup method to query the stemweb server to check a particular job status.
Returns a result as in /stemweb/result above, but status can also be -1 to 
indicate that the job is still running.

=cut

sub query :Local :Args(1) {
	my( $self, $c, $jobid ) = @_;
	my $ua = LWP::UserAgent->new();
	my $resp = $ua->get( $self->stemweb_url . "/algorithms/jobstatus/$jobid" );
	if( $resp->is_success ) {
		# Process it
		my $response = decode_utf8( $resp->content );
		$c->log->debug( "Got a response from the server: $response" );
		my $answer;
		try {
			$answer = from_json( $response );
		} catch {
			return _json_error( $c, 500, 
				"Could not parse stemweb response '' $response '' as JSON: $@" );
		}
		return _process_stemweb_result( $c, $answer );
	} 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 );
	}
}


## Helper function for parsing Stemweb result data either by push or by pull
sub _process_stemweb_result {
	my( $c, $answer ) = @_;
	# Find the specified tradition and check its job ID.
	my $m = $c->model('Directory');
	my $tradition = $m->tradition( $answer->{textid} );
	unless( $tradition ) {
		return _json_error( $c, 400, "No tradition found with ID "
			. $answer->{textid} );
	}
	if( $answer->{status} == 0 ) {
		my $stemmata;
		if( $tradition->has_stemweb_jobid 
			&& $tradition->stemweb_jobid eq $answer->{jobid} ) {
			try {
				$stemmata = $tradition->record_stemweb_result( $answer );
				$m->save( $tradition );
			} catch( Text::Tradition::Error $e ) {
				return _json_error( $c, 500, $e->message );
			} catch {
				return _json_error( $c, 500, $@ );
			}
		} else {
			# It may be that we already received a callback meanwhile.
			# Check all stemmata for the given jobid and return them.
			@$stemmata = grep { $_->came_from_jobid && $_->from_jobid eq $answer->{jobid} } $tradition->stemmata;
		}
		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 ),
					svg => $_->as_svg() } } 
				@$stemmata;
			$c->stash->{'result'} = { 
				'status' => 'success',
				'stemmata' => \@steminfo };
		} else {
			# Hm, no stemmata found on this tradition with this jobid.
			# Clear the tradition jobid so that the user can try again.
			if( $tradition->has_stemweb_jobid ) {
				$tradition->_clear_stemweb_jobid;
				$m->save( $tradition );
			}
			$c->stash->{'result'} = { status => 'notfound' };
		}
	} elsif( $answer->{status} == 1 ) {
		$c->stash->{'result'} = { 'status' => 'running' };
	} else {
		# 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');
}

=head2 request

 GET stemweb/request/?
	tradition=<tradition ID> &
	algorithm=<algorithm ID> &
	[<algorithm parameters>]
   
Send a request for the given tradition with the given parameters to Stemweb.
Processes and returns the JSON response given by the Stemweb server.

=cut

sub request :Local :Args(0) {
	my( $self, $c ) = @_;
	# Look up the relevant tradition and check permissions.
	my $reqparams = $c->req->params;
	my $tid = delete $reqparams->{tradition};
	my $t = $c->model('Directory')->tradition( $tid );
	my $ok = _check_permission( $c, $t );
	return unless $ok;
	return( _json_error( $c, 403, 
			'You do not have permission to update stemmata for this tradition' ) )
		unless $ok eq 'full';
	
	my $algorithm = delete $reqparams->{algorithm};
	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 {
			$newick = phylip_pars( $cdata, { parspath => $self->_has_pars } );
		} catch ( Text::Tradition::Error $e ) {
			return _json_error( $c, 503, "Parsimony tree generation failed: "
				. $e->message );
		}
		# 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 {
		# 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 );
		}
	}
}

# Helper to check what permission, if any, the active user has for
# the given tradition
sub _check_permission {
	my( $c, $tradition ) = @_;
    my $user = $c->user_exists ? $c->user->get_object : undef;
    if( $user ) {
    	return 'full' if ( $user->is_admin || 
    		( $tradition->has_user && $tradition->user->id eq $user->id ) );
    }
	# Text doesn't belong to us, so maybe it's public?
	return 'readonly' if $tradition->public;

	# ...nope. Forbidden!
	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->response->status( $code );
	$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;
Commit	Line	Data
532cc23b	1	package stemmaweb::Controller::Stemweb;
	2	use Moose;
	3	use namespace::autoclean;
ed0ce314	4	use Encode qw/ decode_utf8 /;
3cb9d9c0	5	use File::Which;
c2b80bba	6	use JSON;
3cb9d9c0	7	use List::Util qw/ max /;
70744367	8	use LWP::UserAgent;
532cc23b	9	use Safe::Isa;
c55cf210	10	use Scalar::Util qw/ looks_like_number /;
3cb9d9c0	11	use Text::Tradition::StemmaUtil qw/ character_input phylip_pars /;
532cc23b	12	use TryCatch;
70744367	13	use URI;
532cc23b	14
	15	BEGIN { extends 'Catalyst::Controller' }
	16
d83d890b	17	has stemweb_url => (
	18	is => 'ro',
	19	isa => 'Str',
	20	default => 'http://slinkola.users.cs.helsinki.fi',
	21	);
3cb9d9c0	22
	23	has pars_path => (
	24	is => 'ro',
	25	isa => 'Str',
	26	);
	27
	28	has pars_pk => (
	29	is => 'rw',
	30	isa => 'Int',
	31	);
70744367	32
532cc23b	33	=head1 NAME
	34
	35	stemmaweb::Controller::Stemweb - Client listener for Stemweb results
	36
	37	=head1 DESCRIPTION
	38
	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>.
	41
	42	=head1 METHODS
	43
	44	=head2 result
	45
	46	POST stemweb/result
	47	Content-Type: application/json
	48	(On success):
67b2a665	49	{ jobid: <ID number>
532cc23b	50	status: 0
	51	format: <format>
	52	result: <data> }
	53	(On failure):
	54	{ jobid: <ID number>
	55	status: >1
	56	result: <error message> }
	57
	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.
	60
	61	=cut
	62
	63	sub result :Local :Args(0) {
	64	my( $self, $c ) = @_;
	65	if( $c->request->method eq 'POST' ) {
	66	# TODO: Verify the sender!
	67	my $answer;
	68	if( ref( $c->request->body ) eq 'File::Temp' ) {
	69	# Read in the file and parse that.
67b2a665	70	$c->log->debug( "Request body is in a temp file" );
67b2a665	71	open( POSTDATA, $c->request->body )
c0292f64	72	or return _json_error( $c, 500, "Failed to open post data file" );
532cc23b	73	binmode( POSTDATA, ':utf8' );
	74	# JSON should be all one line
	75	my $pdata = <POSTDATA>;
	76	chomp $pdata;
	77	close POSTDATA;
c2b80bba	78	try {
	79	$answer = from_json( $pdata );
	80	} catch {
	81	return _json_error( $c, 400,
	82	"Could not parse POST request '' $pdata '' as JSON: $@" );
	83	}
532cc23b	84	} else {
	85	$answer = from_json( $c->request->body );
	86	}
67b2a665	87	$c->log->debug( "Received push notification from Stemweb: "
67b2a665	88	. to_json( $answer ) );
c2b80bba	89	return _process_stemweb_result( $c, $answer );
	90	} else {
	91	return _json_error( $c, 403, 'Please use POST!' );
	92	}
	93	}
	94
66458003	95	=head2 available
	96
	97	GET algorithms/available
	98
	99	Queries the Stemweb server for available stemma generation algorithms and their
	100	parameters. Returns the JSON answer as obtained from Stemweb.
	101
	102	=cut
	103
	104	sub available :Local :Args(0) {
	105	my( $self, $c ) = @_;
	106	my $ua = LWP::UserAgent->new();
d83d890b	107	my $resp = $ua->get( $self->stemweb_url . '/algorithms/available' );
f6dbd419	108	my $parameters = [];
66458003	109	if( $resp->is_success ) {
f6dbd419	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, {
	120	pk => $parspk,
	121	model => 'algorithms.algorithm',
	122	fields => {
	123	args => [],
	124	name => 'Pars',
	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.'
	126	}
	127	});
66458003	128	}
f6dbd419	129	$c->stash->{result} = $parameters;
66458003	130	$c->forward('View::JSON');
	131	}
	132
c2b80bba	133	=head2 query
	134
	135	GET stemweb/query/<jobid>
	136
	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.
	140
	141	=cut
	142
	143	sub query :Local :Args(1) {
	144	my( $self, $c, $jobid ) = @_;
	145	my $ua = LWP::UserAgent->new();
d83d890b	146	my $resp = $ua->get( $self->stemweb_url . "/algorithms/jobstatus/$jobid" );
c2b80bba	147	if( $resp->is_success ) {
	148	# Process it
	149	my $response = decode_utf8( $resp->content );
	150	$c->log->debug( "Got a response from the server: $response" );
	151	my $answer;
	152	try {
	153	$answer = from_json( $response );
	154	} catch {
532cc23b	155	return _json_error( $c, 500,
c2b80bba	156	"Could not parse stemweb response '' $response '' as JSON: $@" );
	157	}
	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." );
	163	} else {
	164	return _json_error( $c, 500, "Stemweb error: " . $resp->code . " / "
	165	. $resp->content );
	166	}
	167	}
	168
	169
	170	## Helper function for parsing Stemweb result data either by push or by pull
	171	sub _process_stemweb_result {
	172	my( $c, $answer ) = @_;
c0292f64	173	# Find the specified tradition and check its job ID.
c2b80bba	174	my $m = $c->model('Directory');
c0292f64	175	my $tradition = $m->tradition( $answer->{textid} );
	176	unless( $tradition ) {
	177	return _json_error( $c, 400, "No tradition found with ID "
	178	. $answer->{textid} );
	179	}
	180	if( $answer->{status} == 0 ) {
	181	my $stemmata;
	182	if( $tradition->has_stemweb_jobid
	183	&& $tradition->stemweb_jobid eq $answer->{jobid} ) {
c2b80bba	184	try {
	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 );
	189	} catch {
	190	return _json_error( $c, 500, $@ );
	191	}
c0292f64	192	} else {
	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;
	196	}
c0292f64	197	if( @$stemmata ) {
c2b80bba	198	# If we got here, success!
c55cf210	199	# TODO Use helper in Root.pm to do this
c2b80bba	200	my @steminfo = map { {
	201	name => $_->identifier,
	202	directed => _json_bool( !$_->is_undirected ),
	203	svg => $_->as_svg() } }
2c514a6f	204	@$stemmata;
c2b80bba	205	$c->stash->{'result'} = {
	206	'status' => 'success',
	207	'stemmata' => \@steminfo };
c2b80bba	208	} else {
c0292f64	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 );
	214	}
	215	$c->stash->{'result'} = { status => 'notfound' };
c2b80bba	216	}
69d4ecfe	217	} elsif( $answer->{status} == 1 ) {
c0292f64	218	$c->stash->{'result'} = { 'status' => 'running' };
c2b80bba	219	} else {
509e94bc	220	# Failure. Clear the job ID so that the user can try again.
	221	$tradition->_clear_stemweb_jobid;
	222	$m->save( $tradition );
	223	$c->stash->{'result'} = { 'status' => 'failed', 'message' => $answer->{result} };
532cc23b	224	}
c2b80bba	225	$c->forward('View::JSON');
532cc23b	226	}
532cc23b	227
70744367	228	=head2 request
	229
	230	GET stemweb/request/?
	231	tradition=<tradition ID> &
	232	algorithm=<algorithm ID> &
	233	[<algorithm parameters>]
	234
	235	Send a request for the given tradition with the given parameters to Stemweb.
	236	Processes and returns the JSON response given by the Stemweb server.
	237
	238	=cut
	239
	240	sub request :Local :Args(0) {
	241	my( $self, $c ) = @_;
	242	# Look up the relevant tradition and check permissions.
	243	my $reqparams = $c->req->params;
	244	my $tid = delete $reqparams->{tradition};
	245	my $t = $c->model('Directory')->tradition( $tid );
	246	my $ok = _check_permission( $c, $t );
	247	return unless $ok;
	248	return( _json_error( $c, 403,
	249	'You do not have permission to update stemmata for this tradition' ) )
	250	unless $ok eq 'full';
	251
70744367	252	my $algorithm = delete $reqparams->{algorithm};
3cb9d9c0	253	my $mergetypes = delete $reqparams->{merge_reltypes};
	254	if( $self->_has_pars && $algorithm == $self->pars_pk ) {
	255	my $start_time = scalar( gmtime( time() ) );
	256	$t->set_stemweb_jobid( 'local' );
	257	my $cdata = character_input( $t, { collapse => $mergetypes } );
	258	my $newick;
70744367	259	try {
3cb9d9c0	260	$newick = phylip_pars( $cdata, { parspath => $self->_has_pars } );
	261	} catch ( Text::Tradition::Error $e ) {
	262	return _json_error( $c, 503, "Parsimony tree generation failed: "
	263	. $e->message );
70744367	264	}
3cb9d9c0	265	# We have a result, so form an answer to process.
	266	my $answer = {
	267	status => 0,
	268	algorithm => 'pars',
	269	'format' => 'newick',
	270	textid => $tid,
	271	jobid => 'local',
	272	result => $newick,
	273	start_time => $start_time
	274	};
	275	return _process_stemweb_result( $c, $answer );
70744367	276	} else {
3cb9d9c0	277	# Form the request for Stemweb.
3cb9d9c0	278	my $return_uri = URI->new( $c->uri_for( '/stemweb/result' ) );
0f254bdc	279	my $tsv_options = { noac => 1, ascii => 1 };
3cb9d9c0	280	if( $mergetypes && @$mergetypes ) {
	281	$tsv_options->{mergetypes} = $mergetypes;
	282	}
	283	my $stemweb_request = {
	284	return_path => $return_uri->path,
	285	return_host => $return_uri->host_port,
	286	data => $t->collation->as_tsv( $tsv_options ),
	287	userid => $c->user->get_object->email,
	288	textid => $tid,
	289	parameters => _cast_nonstrings( $reqparams ) };
	290
	291	# Call to the appropriate URL with the request parameters.
	292	my $ua = LWP::UserAgent->new();
b7c3508f	293	# $c->log->debug( 'Sending request to Stemweb: ' . to_json( $stemweb_request ) );
3cb9d9c0	294	my $resp = $ua->post( $self->stemweb_url . "/algorithms/process/$algorithm/",
	295	'Content-Type' => 'application/json; charset=utf-8',
	296	'Content' => encode_json( $stemweb_request ) );
	297	if( $resp->is_success ) {
	298	# Process it
	299	$c->log->debug( 'Got a response from the server: '
	300	. decode_utf8( $resp->content ) );
	301	my $stemweb_response = decode_json( $resp->content );
	302	try {
	303	$t->set_stemweb_jobid( $stemweb_response->{jobid} );
	304	} catch( Text::Tradition::Error $e ) {
	305	return _json_error( $c, 429, $e->message );
	306	}
	307	$c->model('Directory')->save( $t );
	308	$c->stash->{'result'} = $stemweb_response;
	309	$c->forward('View::JSON');
	310	} elsif( $resp->code == 500 && $resp->header('Client-Warning')
	311	&& $resp->header('Client-Warning') eq 'Internal response' ) {
	312	# The server was unavailable.
	313	return _json_error( $c, 503, "The Stemweb server is currently unreachable." );
	314	} else {
	315	return _json_error( $c, 500, "Stemweb error: " . $resp->code . " / "
	316	. $resp->content );
	317	}
70744367	318	}
	319	}
	320
	321	# Helper to check what permission, if any, the active user has for
	322	# the given tradition
	323	sub _check_permission {
	324	my( $c, $tradition ) = @_;
	325	my $user = $c->user_exists ? $c->user->get_object : undef;
	326	if( $user ) {
	327	return 'full' if ( $user->is_admin \|\|
	328	( $tradition->has_user && $tradition->user->id eq $user->id ) );
	329	}
	330	# Text doesn't belong to us, so maybe it's public?
	331	return 'readonly' if $tradition->public;
	332
	333	# ...nope. Forbidden!
	334	return _json_error( $c, 403, 'You do not have permission to view this tradition.' );
	335	}
	336
c55cf210	337	# QUICK HACK to deal with strict Stemweb validation.
	338	sub _cast_nonstrings {
	339	my $params = shift;
	340	foreach my $k ( keys %$params ) {
	341	my $v = $params->{$k};
	342	if( looks_like_number( $v ) ) {
	343	$params->{$k} = $v * 1;
	344	} elsif ( !defined $v \|\| $v eq 'true' ) {
	345	$params->{$k} = _json_bool( $v );
	346	}
	347	}
	348	return $params;
	349	}
	350
532cc23b	351	# Helper to throw a JSON exception
	352	sub _json_error {
	353	my( $c, $code, $errmsg ) = @_;
	354	$c->response->status( $code );
	355	$c->stash->{'result'} = { 'error' => $errmsg };
	356	$c->forward('View::JSON');
	357	return 0;
c55cf210	358	}
532cc23b	359
c2b80bba	360	sub _json_bool {
	361	return $_[0] ? JSON::true : JSON::false;
	362	}
	363
3cb9d9c0	364	sub _has_pars {
	365	my $self = shift;
	366	return $self->pars_path \|\| which('pars');
	367	}
	368
c2b80bba	369
ed0ce314	370	1;