[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 {
		return _json_error( $c, 500,
			"Stemweb failure not handled: " . $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 };
		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	}
39283bfb	217	} elsif( $answer->{status} == -1 ) {
c0292f64	218	$c->stash->{'result'} = { 'status' => 'running' };
c2b80bba	219	} else {
c0292f64	220	return _json_error( $c, 500,
c0292f64	221	"Stemweb failure not handled: " . $answer->{result} );
532cc23b	222	}
c2b80bba	223	$c->forward('View::JSON');
532cc23b	224	}
532cc23b	225
70744367	226	=head2 request
	227
	228	GET stemweb/request/?
	229	tradition=<tradition ID> &
	230	algorithm=<algorithm ID> &
	231	[<algorithm parameters>]
	232
	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.
	235
	236	=cut
	237
	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 );
	245	return unless $ok;
	246	return( _json_error( $c, 403,
	247	'You do not have permission to update stemmata for this tradition' ) )
	248	unless $ok eq 'full';
	249
70744367	250	my $algorithm = delete $reqparams->{algorithm};
3cb9d9c0	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 } );
	256	my $newick;
70744367	257	try {
3cb9d9c0	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: "
	261	. $e->message );
70744367	262	}
3cb9d9c0	263	# We have a result, so form an answer to process.
	264	my $answer = {
	265	status => 0,
	266	algorithm => 'pars',
	267	'format' => 'newick',
	268	textid => $tid,
	269	jobid => 'local',
	270	result => $newick,
	271	start_time => $start_time
	272	};
	273	return _process_stemweb_result( $c, $answer );
70744367	274	} else {
3cb9d9c0	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;
	280	}
	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,
	286	textid => $tid,
	287	parameters => _cast_nonstrings( $reqparams ) };
	288
	289	# Call to the appropriate URL with the request parameters.
	290	my $ua = LWP::UserAgent->new();
b7c3508f	291	# $c->log->debug( 'Sending request to Stemweb: ' . to_json( $stemweb_request ) );
3cb9d9c0	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 ) {
	296	# Process it
	297	$c->log->debug( 'Got a response from the server: '
	298	. decode_utf8( $resp->content ) );
	299	my $stemweb_response = decode_json( $resp->content );
	300	try {
	301	$t->set_stemweb_jobid( $stemweb_response->{jobid} );
	302	} catch( Text::Tradition::Error $e ) {
	303	return _json_error( $c, 429, $e->message );
	304	}
	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." );
	312	} else {
	313	return _json_error( $c, 500, "Stemweb error: " . $resp->code . " / "
	314	. $resp->content );
	315	}
70744367	316	}
	317	}
	318
	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;
	324	if( $user ) {
	325	return 'full' if ( $user->is_admin \|\|
	326	( $tradition->has_user && $tradition->user->id eq $user->id ) );
	327	}
	328	# Text doesn't belong to us, so maybe it's public?
	329	return 'readonly' if $tradition->public;
	330
	331	# ...nope. Forbidden!
	332	return _json_error( $c, 403, 'You do not have permission to view this tradition.' );
	333	}
	334
c55cf210	335	# QUICK HACK to deal with strict Stemweb validation.
	336	sub _cast_nonstrings {
	337	my $params = shift;
	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 );
	344	}
	345	}
	346	return $params;
	347	}
	348
532cc23b	349	# Helper to throw a JSON exception
	350	sub _json_error {
	351	my( $c, $code, $errmsg ) = @_;
	352	$c->response->status( $code );
	353	$c->stash->{'result'} = { 'error' => $errmsg };
	354	$c->forward('View::JSON');
	355	return 0;
c55cf210	356	}
532cc23b	357
c2b80bba	358	sub _json_bool {
	359	return $_[0] ? JSON::true : JSON::false;
	360	}
	361
3cb9d9c0	362	sub _has_pars {
	363	my $self = shift;
	364	return $self->pars_path \|\| which('pars');
	365	}
	366
c2b80bba	367
ed0ce314	368	1;