[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',
	);
	
=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 100 as the special pars key
		# Add Pars as an algorithm
		push( @$parameters, {
			pk => 100,
			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 || $answer->{status} == -1  ) {
		# 1 means running, -1 means waiting to run. Either way, 'not ready'.
		$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 == 100 ) {
		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
532cc23b	28	=head1 NAME
	29
	30	stemmaweb::Controller::Stemweb - Client listener for Stemweb results
	31
	32	=head1 DESCRIPTION
	33
	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>.
	36
	37	=head1 METHODS
	38
	39	=head2 result
	40
	41	POST stemweb/result
	42	Content-Type: application/json
	43	(On success):
67b2a665	44	{ jobid: <ID number>
532cc23b	45	status: 0
	46	format: <format>
	47	result: <data> }
	48	(On failure):
	49	{ jobid: <ID number>
	50	status: >1
	51	result: <error message> }
	52
	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.
	55
	56	=cut
	57
	58	sub result :Local :Args(0) {
	59	my( $self, $c ) = @_;
	60	if( $c->request->method eq 'POST' ) {
	61	# TODO: Verify the sender!
	62	my $answer;
	63	if( ref( $c->request->body ) eq 'File::Temp' ) {
	64	# Read in the file and parse that.
67b2a665	65	$c->log->debug( "Request body is in a temp file" );
67b2a665	66	open( POSTDATA, $c->request->body )
c0292f64	67	or return _json_error( $c, 500, "Failed to open post data file" );
532cc23b	68	binmode( POSTDATA, ':utf8' );
	69	# JSON should be all one line
	70	my $pdata = <POSTDATA>;
	71	chomp $pdata;
	72	close POSTDATA;
c2b80bba	73	try {
	74	$answer = from_json( $pdata );
	75	} catch {
	76	return _json_error( $c, 400,
	77	"Could not parse POST request '' $pdata '' as JSON: $@" );
	78	}
532cc23b	79	} else {
	80	$answer = from_json( $c->request->body );
	81	}
67b2a665	82	$c->log->debug( "Received push notification from Stemweb: "
67b2a665	83	. to_json( $answer ) );
c2b80bba	84	return _process_stemweb_result( $c, $answer );
	85	} else {
	86	return _json_error( $c, 403, 'Please use POST!' );
	87	}
	88	}
	89
66458003	90	=head2 available
	91
	92	GET algorithms/available
	93
	94	Queries the Stemweb server for available stemma generation algorithms and their
	95	parameters. Returns the JSON answer as obtained from Stemweb.
	96
	97	=cut
	98
	99	sub available :Local :Args(0) {
	100	my( $self, $c ) = @_;
	101	my $ua = LWP::UserAgent->new();
d83d890b	102	my $resp = $ua->get( $self->stemweb_url . '/algorithms/available' );
f6dbd419	103	my $parameters = [];
66458003	104	if( $resp->is_success ) {
f6dbd419	105	$parameters = decode_json( $resp->content );
	106	} # otherwise we have no available algorithms.
	107	## Temporary HACK: run Pars too
	108	if( $self->_has_pars ) {
ef89f9c5	109	# Use 100 as the special pars key
f6dbd419	110	# Add Pars as an algorithm
f6dbd419	111	push( @$parameters, {
ef89f9c5	112	pk => 100,
f6dbd419	113	model => 'algorithms.algorithm',
	114	fields => {
	115	args => [],
	116	name => 'Pars',
	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.'
	118	}
	119	});
66458003	120	}
f6dbd419	121	$c->stash->{result} = $parameters;
66458003	122	$c->forward('View::JSON');
	123	}
	124
c2b80bba	125	=head2 query
	126
	127	GET stemweb/query/<jobid>
	128
	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.
	132
	133	=cut
	134
	135	sub query :Local :Args(1) {
	136	my( $self, $c, $jobid ) = @_;
	137	my $ua = LWP::UserAgent->new();
d83d890b	138	my $resp = $ua->get( $self->stemweb_url . "/algorithms/jobstatus/$jobid" );
c2b80bba	139	if( $resp->is_success ) {
	140	# Process it
	141	my $response = decode_utf8( $resp->content );
	142	$c->log->debug( "Got a response from the server: $response" );
	143	my $answer;
	144	try {
	145	$answer = from_json( $response );
	146	} catch {
532cc23b	147	return _json_error( $c, 500,
c2b80bba	148	"Could not parse stemweb response '' $response '' as JSON: $@" );
	149	}
	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." );
	155	} else {
	156	return _json_error( $c, 500, "Stemweb error: " . $resp->code . " / "
	157	. $resp->content );
	158	}
	159	}
	160
	161
	162	## Helper function for parsing Stemweb result data either by push or by pull
	163	sub _process_stemweb_result {
	164	my( $c, $answer ) = @_;
c0292f64	165	# Find the specified tradition and check its job ID.
c2b80bba	166	my $m = $c->model('Directory');
c0292f64	167	my $tradition = $m->tradition( $answer->{textid} );
	168	unless( $tradition ) {
	169	return _json_error( $c, 400, "No tradition found with ID "
	170	. $answer->{textid} );
	171	}
	172	if( $answer->{status} == 0 ) {
	173	my $stemmata;
	174	if( $tradition->has_stemweb_jobid
	175	&& $tradition->stemweb_jobid eq $answer->{jobid} ) {
c2b80bba	176	try {
	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 );
	181	} catch {
	182	return _json_error( $c, 500, $@ );
	183	}
c0292f64	184	} else {
	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;
	188	}
c0292f64	189	if( @$stemmata ) {
c2b80bba	190	# If we got here, success!
c55cf210	191	# TODO Use helper in Root.pm to do this
c2b80bba	192	my @steminfo = map { {
	193	name => $_->identifier,
	194	directed => _json_bool( !$_->is_undirected ),
	195	svg => $_->as_svg() } }
2c514a6f	196	@$stemmata;
c2b80bba	197	$c->stash->{'result'} = {
	198	'status' => 'success',
	199	'stemmata' => \@steminfo };
c2b80bba	200	} else {
c0292f64	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 );
	206	}
	207	$c->stash->{'result'} = { status => 'notfound' };
c2b80bba	208	}
c3001d44	209	} elsif( $answer->{status} == 1 \|\| $answer->{status} == -1 ) {
c3001d44	210	# 1 means running, -1 means waiting to run. Either way, 'not ready'.
c0292f64	211	$c->stash->{'result'} = { 'status' => 'running' };
c2b80bba	212	} else {
509e94bc	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} };
532cc23b	217	}
c2b80bba	218	$c->forward('View::JSON');
532cc23b	219	}
532cc23b	220
70744367	221	=head2 request
	222
	223	GET stemweb/request/?
	224	tradition=<tradition ID> &
	225	algorithm=<algorithm ID> &
	226	[<algorithm parameters>]
	227
	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.
	230
	231	=cut
	232
	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 );
	240	return unless $ok;
	241	return( _json_error( $c, 403,
	242	'You do not have permission to update stemmata for this tradition' ) )
	243	unless $ok eq 'full';
	244
70744367	245	my $algorithm = delete $reqparams->{algorithm};
3cb9d9c0	246	my $mergetypes = delete $reqparams->{merge_reltypes};
ef89f9c5	247	if( $self->_has_pars && $algorithm == 100 ) {
3cb9d9c0	248	my $start_time = scalar( gmtime( time() ) );
	249	$t->set_stemweb_jobid( 'local' );
	250	my $cdata = character_input( $t, { collapse => $mergetypes } );
	251	my $newick;
70744367	252	try {
3cb9d9c0	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: "
	256	. $e->message );
70744367	257	}
3cb9d9c0	258	# We have a result, so form an answer to process.
	259	my $answer = {
	260	status => 0,
	261	algorithm => 'pars',
	262	'format' => 'newick',
	263	textid => $tid,
	264	jobid => 'local',
	265	result => $newick,
	266	start_time => $start_time
	267	};
	268	return _process_stemweb_result( $c, $answer );
70744367	269	} else {
3cb9d9c0	270	# Form the request for Stemweb.
3cb9d9c0	271	my $return_uri = URI->new( $c->uri_for( '/stemweb/result' ) );
0f254bdc	272	my $tsv_options = { noac => 1, ascii => 1 };
3cb9d9c0	273	if( $mergetypes && @$mergetypes ) {
	274	$tsv_options->{mergetypes} = $mergetypes;
	275	}
	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,
	281	textid => $tid,
	282	parameters => _cast_nonstrings( $reqparams ) };
	283
	284	# Call to the appropriate URL with the request parameters.
	285	my $ua = LWP::UserAgent->new();
b7c3508f	286	# $c->log->debug( 'Sending request to Stemweb: ' . to_json( $stemweb_request ) );
3cb9d9c0	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 ) {
	291	# Process it
	292	$c->log->debug( 'Got a response from the server: '
	293	. decode_utf8( $resp->content ) );
	294	my $stemweb_response = decode_json( $resp->content );
	295	try {
	296	$t->set_stemweb_jobid( $stemweb_response->{jobid} );
	297	} catch( Text::Tradition::Error $e ) {
	298	return _json_error( $c, 429, $e->message );
	299	}
	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." );
	307	} else {
	308	return _json_error( $c, 500, "Stemweb error: " . $resp->code . " / "
	309	. $resp->content );
	310	}
70744367	311	}
	312	}
	313
	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;
	319	if( $user ) {
	320	return 'full' if ( $user->is_admin \|\|
	321	( $tradition->has_user && $tradition->user->id eq $user->id ) );
	322	}
	323	# Text doesn't belong to us, so maybe it's public?
	324	return 'readonly' if $tradition->public;
	325
	326	# ...nope. Forbidden!
	327	return _json_error( $c, 403, 'You do not have permission to view this tradition.' );
	328	}
	329
c55cf210	330	# QUICK HACK to deal with strict Stemweb validation.
	331	sub _cast_nonstrings {
	332	my $params = shift;
	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 );
	339	}
	340	}
	341	return $params;
	342	}
	343
532cc23b	344	# Helper to throw a JSON exception
	345	sub _json_error {
	346	my( $c, $code, $errmsg ) = @_;
	347	$c->response->status( $code );
	348	$c->stash->{'result'} = { 'error' => $errmsg };
	349	$c->forward('View::JSON');
	350	return 0;
c55cf210	351	}
532cc23b	352
c2b80bba	353	sub _json_bool {
	354	return $_[0] ? JSON::true : JSON::false;
	355	}
	356
3cb9d9c0	357	sub _has_pars {
	358	my $self = shift;
	359	return $self->pars_path \|\| which('pars');
	360	}
	361
c2b80bba	362
ed0ce314	363	1;