From: Tara L Andrews <tla\@mit.edu>
Date: Fri, 13 Jan 2012 22:03:08 +0000 (+0100)
Subject: add run_pars functionality to the webservice, based on figtree
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=27e2a8fef4f5a8f402a367056b345a5c131dac95;p=scpubgit%2Fstemmatology.git

add run_pars functionality to the webservice, based on figtree
---

diff --git a/TreeOfTexts/lib/TreeOfTexts/Controller/Stemmagraph.pm b/TreeOfTexts/lib/TreeOfTexts/Controller/Stemmagraph.pm
index b440dfb..3079312 100644
--- a/TreeOfTexts/lib/TreeOfTexts/Controller/Stemmagraph.pm
+++ b/TreeOfTexts/lib/TreeOfTexts/Controller/Stemmagraph.pm
@@ -4,7 +4,7 @@ use namespace::autoclean;
 use File::Temp;
 use JSON;
 use Text::Tradition::Collation;
-use Text::Tradition::StemmaUtil qw/ character_input /;
+use Text::Tradition::StemmaUtil qw/ character_input phylip_pars newick_to_svg /;
 
 BEGIN { extends 'Catalyst::Controller' }
 
@@ -69,13 +69,57 @@ sub character_matrix :Local {
 	$c->stash->{'result'} = { 'matrix' => $matrix };
 	$c->forward( 'View::JSON' );
 }
-=head2 end
 
-Attempt to render a view, if needed.
+=head2 run_pars 
+
+Takes either an alignment table in JSON format (passed as the parameter 'alignment')
+or a character matrix Phylip accepts (passed as the parameter 'matrix').  Returns
+either the Newick-format answer or an SVG representation of the graph.
 
 =cut
 
-sub end : ActionClass('RenderView') {}
+sub run_pars :Local {
+	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 AUTHOR
 
diff --git a/lib/Text/Tradition/StemmaUtil.pm b/lib/Text/Tradition/StemmaUtil.pm
index f9e9bb0..6e6a11d 100644
--- a/lib/Text/Tradition/StemmaUtil.pm
+++ b/lib/Text/Tradition/StemmaUtil.pm
@@ -5,13 +5,15 @@ use warnings;
 use Exporter 'import';
 use vars qw/ @EXPORT_OK /;
 use Bio::Phylo::IO;
+use Encode qw( decode_utf8 );
 use File::chdir;
 use File::Temp;
 use File::Which;
 use Graph;
 use Graph::Reader::Dot;
 use IPC::Run qw/ run binary /;
-@EXPORT_OK = qw/ make_character_matrix character_input phylip_pars parse_newick /;
+@EXPORT_OK = qw/ make_character_matrix character_input phylip_pars 
+				 parse_newick newick_to_svg /;
 
 sub make_character_matrix {
     my( $table ) = @_;
@@ -169,6 +171,22 @@ sub parse_newick {
     return \@trees;
 }
 
+sub newick_to_svg {
+	my $newick = shift;
+    my $program = File::Which::which( 'figtree' );
+    unless( -x $program ) {
+		warn "FigTree commandline utility not found in path";
+		return;
+    }
+    my $svg;
+    my $nfile = File::Temp->new();
+    print $nfile $newick;
+    close $nfile;
+	my @cmd = ( $program, '-graphic', 'SVG', $nfile );
+    run( \@cmd, ">", binary(), \$svg );
+    return decode_utf8( $svg );
+}
+
 sub _graph_from_bio {
     my $tree = shift;
     my $graph = Graph->new( 'undirected' => 1 );