refactor the hardcoded attribute stuff in as_dot

[scpubgit/stemmatology.git] / TreeOfTexts / lib / TreeOfTexts / Controller / Microservice.pm

package TreeOfTexts::Controller::Microservice;
use Moose;
use namespace::autoclean;
use JSON;
use Text::Tradition;
use Text::Tradition::Stemma;
use Text::Tradition::StemmaUtil qw/ character_input phylip_pars newick_to_svg /;

BEGIN { extends 'Catalyst::Controller' }

=head1 NAME

TreeOfTexts::Controller::Microservice - Controller for TreeOfTexts 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, CSV, JSON, nCritic, TEI, Tabular.

=item * data - The collation data itself.

=back

=head1 COLLATION URLs

=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 );
	$c->stash->{'result'} = $tradition->collation->as_svg;
	$c->forward('View::SVG');
}

=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 = $t->add_stemma( 'dot' => $c->req->param('dot') );
	$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 $error;
	my $view = 'View::JSON';
	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 {
		$error = "Must pass either an alignment or a matrix";
	}
	
	# Got the matrix, so try to run pars.
	my( $result, $output );
	unless( $error ) {
		( $result, $output ) = phylip_pars( $matrix );
		$error = $output unless( $result );
	}
	
	# Did we want newick or a graph?
	unless( $error ) {
		my $format = 'newick';
		$format = $c->request->param('format') if $c->request->param('format');
		if( $format eq 'svg' ) {
			# Do something
			$c->stash->{'result'} = newick_to_svg( $output );
			$view = 'View::SVG';
		} elsif( $format ne 'newick' ) {
			$error = "Requested output format $format unknown";
		} else {
			$c->stash->{'result'} = { 'tree' => $output };
		}
	}

	if( $error ) {
		$c->stash->{'error'} = $error;
	} # else the stash is populated.
	$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 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 );
}

=head2 end

Attempt to render a view, if needed.

=cut

sub end : ActionClass('RenderView') {}

=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;