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

package stemmaweb::Controller::Microservice;
use Moose;
use namespace::autoclean;
use JSON;
use TryCatch;
use Text::Tradition;
#use Text::Tradition::Error;
use Text::Tradition::Stemma;
use Text::Tradition::StemmaUtil qw/ character_input phylip_pars newick_to_svg /;

BEGIN { extends 'Catalyst::Controller' }

=head1 NAME

stemmaweb::Controller::Microservice - Controller for stemmaweb standalone
components

=head1 DESCRIPTION

This package contains the pieces of web functionality relating to text tradition
objects that are useful outside the framework of this application.

=head1 COLLATION PARSING INPUT

Each URL call which operates on a provided collation is called by POST with the
following form parameters in the body: 

=over 4 

=item * type - Can be one of CollateX, CTE, CSV, JSON, nCritic, TEI, Tabular.

=item * data - The collation data itself.

=back

=head1 COLLATION URLs

=head2 parse

 GET microservice/parse
 POST microservice/parse {
    type: $type
    file: $uploadfile
 }
 
Attempt a parse of the passed collation data, and return diagnostic information about whether it was successful.

=cut

sub parse :Local :Args(0) {
	my( $self, $c ) = @_;
	if( $c->req->method eq 'POST' ) {
		# Get the passed options...
		my $warnings = [];
		$DB::single = 1;
		my %newopts = (
			'name' => $c->request->param('name') || 'Uploaded tradition',
			'file' => $c->request->upload('file')->tempname,
			'warnings_to' => $warnings,
			);
		my $type = $c->request->param( 'type' );
		if( $type eq 'csv' ) {
			$newopts{'input'} = 'Tabular';
			$newopts{'sep_char'} = ',';
		} elsif( $type eq 'tsv' ) {
			$newopts{'input'} = 'Tabular';
			$newopts{'sep_char'} = "\t";
		} elsif( $type =~ /^xls/ ) {
			$newopts{'input'} = 'Tabular';
			$newopts{'excel'} = $type;
		} else {
			$newopts{'input'} = $type;
		}
		# Now try the parse.
		my $tradition;
		try {
			$c->stash->{'result'} = Text::Tradition->new( %newopts );
		} catch ( Text::Tradition::Error $e ) {
			$c->stash->{'errormsg'} = $e->message; 
		}
		$c->stash->{'warnings'} = join( "\n", @$warnings );	
	} 
	$c->stash->{template} = 'testparse.tt';
}

=head2 renderSVG

 POST microservice/renderSVG

Parse the passed collation data and return an SVG of the collated text.

=cut

# Utility function to render SVG from a collation in some recognized format.
sub renderSVG :Local :Args(0) {
	my( $self, $c ) = @_;
	my $tradition = _parse_to_tradition( $c->request );
	try {
		$c->stash->{'result'} = $tradition->collation->as_svg;
		$c->forward('View::SVG');
	} catch( Text::Tradition::Error $e ) {
		$c->detach( 'error', [ $e ] );
	}
}

=head1 STEMMA / DISTANCE TREE URLs

=head2 stemma_svg

 POST microservice/stemma_svg
 
Parameter: dot => a string containing the dot description of the stemma.

=cut

sub stemma_svg :Local :Args(0) {
	my( $self, $c ) = @_;
	my $t = Text::Tradition->new();
	my $stemma;
	try {
		$stemma = $t->add_stemma( 'dot' => $c->req->param('dot') );
	} catch( Text::Tradition::Error $e ) {
		$c->detach( 'error', [ $e ] );
	}
	$c->stash->{'result'} = $stemma->as_svg;
	$c->forward('View::SVG');
}

=head2 character_matrix

 POST microservice/character_matrix

Given an alignment table in JSON form, in the parameter 'alignment', returns a
character matrix suitable for input to Phylip PARS. 

=cut

sub character_matrix :Local :Args(0) {
	my( $self, $c ) = @_;
	my $json = $c->request->params->{'alignment'};
	$c->log->debug( $json );
	my $table = from_json( $json );
	my $matrix = character_input( $table );
	$c->stash->{'result'} = { 'matrix' => $matrix };
	$c->forward( 'View::JSON' );
}

=head2 run_pars 

 POST microservice/run_pars

Runs Phylip PARS on the provided alignment, and returns the result. Parameters include:

=over 4

=item * alignment - A JSON alignment table, as produced by CollateX

=item * matrix - A character matrix suitable for Phylip.

=item * format - The format in which to return the results.  Default is 'newick'; also allowed is 'svg'.

=back

Exactly one of 'alignment' or 'matrix' must be specified.

=cut

sub run_pars :Local :Args(0) {
	my( $self, $c ) = @_;
	my $matrix;
	if( $c->request->param('matrix') ) {
		$matrix = $c->request->param('matrix');
	} elsif( $c->request->param('alignment') ) {
		# Make the matrix from the alignment
		my $table = from_json( $c->request->param('alignment') );
		$matrix = character_input( $table );
	} else {
		$c->detach( 'error', [ "Must pass either an alignment or a matrix" ] );
	}
	
	# Got the matrix, so try to run pars.
	my $output;
	try {
		$output = phylip_pars( $matrix );
	} catch( Text::Tradition::Error $e ) {
		$c->detach( 'error', [ $e ] );
	}
	
	# Did we want newick or a graph?
	my $view = 'View::JSON';
	my $format = 'newick';
	$format = $c->request->param('format') if $c->request->param('format');
	if( $format eq 'svg' ) {
		# Do something
		try {
			$c->stash->{'result'} = newick_to_svg( $output );
			$view = 'View::SVG';
		} catch( Text::Tradition::Error $e ) {
			$c->detach( 'error', [ $e ] );
		}
	} elsif( $format ne 'newick' ) {
		$c->detach( 'error', [ "Requested output format $format unknown" ] );
	} else {
		$c->stash->{'result'} = { 'tree' => $output };
	}

	$c->forward( $view );
}


=head1 OPENSOCIAL URLs

=head2 view_table

Simple gadget to return the analysis table for the stexaminer

=cut

sub view_table :Local :Args(0) {
    my( $self, $c ) = @_;
    my $m = $c->model('Directory');
	my $id = $c->request->params->{'textid'};
	my $t = run_analysis( $m->tradition( $id ), $m->stemma( $id ) );
   	$c->stash->{variants} = $t->{'variants'};
    $c->stash->{template} = 'table_gadget.tt';
}

=head2 view_stemma_svg

Simple gadget to return the SVG for a given stemma

=cut

sub view_svg :Local :Args(0) {
    my( $self, $c ) = @_;
    my $m = $c->model('Directory');
    my $stemma = $m->tradition( $c->request->params->{'textid'} )->stemma;
	if( $stemma ) {
	   	$c->stash->{svg} = $stemma->as_svg;
	}
    $c->stash->{template} = 'stemma_gadget.tt';
}

=head2 error

Default response when actions generate Text::Tradition::Error exceptions

=cut

sub error :Private {
	my( $self, $c, $error ) = @_;
	my $errstr = $error;
	if( ref( $error ) eq 'Text::Tradition::Error' ) {
		$errstr = $error->ident . ": " . $error->message;
	}
	$c->response->code( 500 );
	$c->stash->{'error'} = $errstr;
	$c->stash->{'template'} = 'error.tt';
}

=head2 default

Standard 404 error page

=cut

sub default :Path {
    my ( $self, $c ) = @_;
    $c->response->body( 'Page not found' );
    $c->response->status(404);
}

## Internal utility function

sub _parse_to_tradition {
	my $req = shift;
	my $type = $req->body_params->{'type'};
	my $name = $req->param('name') || 'Collation graph';
	my $data = $req->body_params->{'data'};
	my $opts = { 
		'name' => $name,
		'input' => $type,
		'string' => $data
		};
	$opts->{'sep_char'} = ',' if $type eq 'CSV';
	$opts->{'sep_char'} = "\t" if $type eq 'TabSep';
	return Text::Tradition->new( $opts );
}


=head1 AUTHOR

Tara L Andrews

=head1 LICENSE

This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

__PACKAGE__->meta->make_immutable;

1;
Commit	Line	Data
b8a92065	1	package stemmaweb::Controller::Microservice;
	2	use Moose;
	3	use namespace::autoclean;
	4	use JSON;
13c54385	5	use TryCatch;
b8a92065	6	use Text::Tradition;
13c54385	7	#use Text::Tradition::Error;
b8a92065	8	use Text::Tradition::Stemma;
	9	use Text::Tradition::StemmaUtil qw/ character_input phylip_pars newick_to_svg /;
	10
	11	BEGIN { extends 'Catalyst::Controller' }
	12
	13	=head1 NAME
	14
	15	stemmaweb::Controller::Microservice - Controller for stemmaweb standalone
	16	components
	17
	18	=head1 DESCRIPTION
	19
	20	This package contains the pieces of web functionality relating to text tradition
	21	objects that are useful outside the framework of this application.
	22
	23	=head1 COLLATION PARSING INPUT
	24
	25	Each URL call which operates on a provided collation is called by POST with the
	26	following form parameters in the body:
	27
	28	=over 4
	29
378668ee	30	=item * type - Can be one of CollateX, CTE, CSV, JSON, nCritic, TEI, Tabular.
b8a92065	31
	32	=item * data - The collation data itself.
	33
	34	=back
	35
	36	=head1 COLLATION URLs
	37
378668ee	38	=head2 parse
	39
	40	GET microservice/parse
	41	POST microservice/parse {
	42	type: $type
	43	file: $uploadfile
	44	}
	45
	46	Attempt a parse of the passed collation data, and return diagnostic information about whether it was successful.
	47
	48	=cut
	49
	50	sub parse :Local :Args(0) {
	51	my( $self, $c ) = @_;
	52	if( $c->req->method eq 'POST' ) {
	53	# Get the passed options...
	54	my $warnings = [];
	55	$DB::single = 1;
	56	my %newopts = (
	57	'name' => $c->request->param('name') \|\| 'Uploaded tradition',
	58	'file' => $c->request->upload('file')->tempname,
	59	'warnings_to' => $warnings,
	60	);
	61	my $type = $c->request->param( 'type' );
	62	if( $type eq 'csv' ) {
	63	$newopts{'input'} = 'Tabular';
	64	$newopts{'sep_char'} = ',';
	65	} elsif( $type eq 'tsv' ) {
	66	$newopts{'input'} = 'Tabular';
	67	$newopts{'sep_char'} = "\t";
	68	} elsif( $type =~ /^xls/ ) {
	69	$newopts{'input'} = 'Tabular';
	70	$newopts{'excel'} = $type;
	71	} else {
	72	$newopts{'input'} = $type;
	73	}
	74	# Now try the parse.
	75	my $tradition;
	76	try {
	77	$c->stash->{'result'} = Text::Tradition->new( %newopts );
	78	} catch ( Text::Tradition::Error $e ) {
	79	$c->stash->{'errormsg'} = $e->message;
	80	}
	81	$c->stash->{'warnings'} = join( "\n", @$warnings );
	82	}
	83	$c->stash->{template} = 'testparse.tt';
	84	}
	85
b8a92065	86	=head2 renderSVG
	87
	88	POST microservice/renderSVG
	89
	90	Parse the passed collation data and return an SVG of the collated text.
	91
	92	=cut
	93
	94	# Utility function to render SVG from a collation in some recognized format.
	95	sub renderSVG :Local :Args(0) {
	96	my( $self, $c ) = @_;
	97	my $tradition = _parse_to_tradition( $c->request );
13c54385	98	try {
	99	$c->stash->{'result'} = $tradition->collation->as_svg;
	100	$c->forward('View::SVG');
	101	} catch( Text::Tradition::Error $e ) {
	102	$c->detach( 'error', [ $e ] );
	103	}
b8a92065	104	}
	105
	106	=head1 STEMMA / DISTANCE TREE URLs
	107
	108	=head2 stemma_svg
	109
	110	POST microservice/stemma_svg
	111
	112	Parameter: dot => a string containing the dot description of the stemma.
	113
	114	=cut
	115
	116	sub stemma_svg :Local :Args(0) {
	117	my( $self, $c ) = @_;
	118	my $t = Text::Tradition->new();
13c54385	119	my $stemma;
	120	try {
	121	$stemma = $t->add_stemma( 'dot' => $c->req->param('dot') );
	122	} catch( Text::Tradition::Error $e ) {
	123	$c->detach( 'error', [ $e ] );
	124	}
b8a92065	125	$c->stash->{'result'} = $stemma->as_svg;
	126	$c->forward('View::SVG');
	127	}
	128
	129	=head2 character_matrix
	130
	131	POST microservice/character_matrix
	132
	133	Given an alignment table in JSON form, in the parameter 'alignment', returns a
	134	character matrix suitable for input to Phylip PARS.
	135
	136	=cut
	137
	138	sub character_matrix :Local :Args(0) {
	139	my( $self, $c ) = @_;
	140	my $json = $c->request->params->{'alignment'};
	141	$c->log->debug( $json );
	142	my $table = from_json( $json );
	143	my $matrix = character_input( $table );
	144	$c->stash->{'result'} = { 'matrix' => $matrix };
	145	$c->forward( 'View::JSON' );
	146	}
	147
	148	=head2 run_pars
	149
	150	POST microservice/run_pars
	151
	152	Runs Phylip PARS on the provided alignment, and returns the result. Parameters include:
	153
	154	=over 4
	155
	156	=item * alignment - A JSON alignment table, as produced by CollateX
	157
	158	=item * matrix - A character matrix suitable for Phylip.
	159
	160	=item * format - The format in which to return the results. Default is 'newick'; also allowed is 'svg'.
	161
	162	=back
	163
	164	Exactly one of 'alignment' or 'matrix' must be specified.
	165
	166	=cut
	167
	168	sub run_pars :Local :Args(0) {
	169	my( $self, $c ) = @_;
b8a92065	170	my $matrix;
	171	if( $c->request->param('matrix') ) {
	172	$matrix = $c->request->param('matrix');
	173	} elsif( $c->request->param('alignment') ) {
	174	# Make the matrix from the alignment
	175	my $table = from_json( $c->request->param('alignment') );
	176	$matrix = character_input( $table );
	177	} else {
13c54385	178	$c->detach( 'error', [ "Must pass either an alignment or a matrix" ] );
b8a92065	179	}
	180
	181	# Got the matrix, so try to run pars.
13c54385	182	my $output;
	183	try {
	184	$output = phylip_pars( $matrix );
	185	} catch( Text::Tradition::Error $e ) {
	186	$c->detach( 'error', [ $e ] );
b8a92065	187	}
	188
	189	# Did we want newick or a graph?
13c54385	190	my $view = 'View::JSON';
	191	my $format = 'newick';
	192	$format = $c->request->param('format') if $c->request->param('format');
	193	if( $format eq 'svg' ) {
	194	# Do something
	195	try {
b8a92065	196	$c->stash->{'result'} = newick_to_svg( $output );
b8a92065	197	$view = 'View::SVG';
13c54385	198	} catch( Text::Tradition::Error $e ) {
13c54385	199	$c->detach( 'error', [ $e ] );
b8a92065	200	}
13c54385	201	} elsif( $format ne 'newick' ) {
	202	$c->detach( 'error', [ "Requested output format $format unknown" ] );
	203	} else {
	204	$c->stash->{'result'} = { 'tree' => $output };
b8a92065	205	}
b8a92065	206
b8a92065	207	$c->forward( $view );
	208	}
	209
	210
	211	=head1 OPENSOCIAL URLs
	212
	213	=head2 view_table
	214
	215	Simple gadget to return the analysis table for the stexaminer
	216
	217	=cut
	218
	219	sub view_table :Local :Args(0) {
	220	my( $self, $c ) = @_;
	221	my $m = $c->model('Directory');
	222	my $id = $c->request->params->{'textid'};
	223	my $t = run_analysis( $m->tradition( $id ), $m->stemma( $id ) );
	224	$c->stash->{variants} = $t->{'variants'};
	225	$c->stash->{template} = 'table_gadget.tt';
	226	}
	227
	228	=head2 view_stemma_svg
	229
	230	Simple gadget to return the SVG for a given stemma
	231
	232	=cut
	233
	234	sub view_svg :Local :Args(0) {
	235	my( $self, $c ) = @_;
	236	my $m = $c->model('Directory');
	237	my $stemma = $m->tradition( $c->request->params->{'textid'} )->stemma;
	238	if( $stemma ) {
	239	$c->stash->{svg} = $stemma->as_svg;
	240	}
	241	$c->stash->{template} = 'stemma_gadget.tt';
	242	}
	243
13c54385	244	=head2 error
	245
	246	Default response when actions generate Text::Tradition::Error exceptions
	247
	248	=cut
	249
	250	sub error :Private {
	251	my( $self, $c, $error ) = @_;
	252	my $errstr = $error;
	253	if( ref( $error ) eq 'Text::Tradition::Error' ) {
	254	$errstr = $error->ident . ": " . $error->message;
	255	}
	256	$c->response->code( 500 );
	257	$c->stash->{'error'} = $errstr;
	258	$c->stash->{'template'} = 'error.tt';
	259	}
	260
b8a92065	261	=head2 default
	262
	263	Standard 404 error page
	264
	265	=cut
	266
	267	sub default :Path {
	268	my ( $self, $c ) = @_;
	269	$c->response->body( 'Page not found' );
	270	$c->response->status(404);
	271	}
	272
	273	## Internal utility function
	274
	275	sub _parse_to_tradition {
	276	my $req = shift;
	277	my $type = $req->body_params->{'type'};
	278	my $name = $req->param('name') \|\| 'Collation graph';
	279	my $data = $req->body_params->{'data'};
	280	my $opts = {
	281	'name' => $name,
	282	'input' => $type,
	283	'string' => $data
	284	};
	285	$opts->{'sep_char'} = ',' if $type eq 'CSV';
	286	$opts->{'sep_char'} = "\t" if $type eq 'TabSep';
	287	return Text::Tradition->new( $opts );
	288	}
	289
b8a92065	290
	291	=head1 AUTHOR
	292
	293	Tara L Andrews
	294
	295	=head1 LICENSE
	296
	297	This library is free software. You can redistribute it and/or modify
	298	it under the same terms as Perl itself.
	299
	300	=cut
	301
	302	__PACKAGE__->meta->make_immutable;
	303
	304	1;