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 (file)
--- 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 (file)
--- 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 );