add JSON alignment table parsing

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

diff --git a/TreeOfTexts/lib/TreeOfTexts/Controller/Stemmagraph.pm b/TreeOfTexts/lib/TreeOfTexts/Controller/Stemmagraph.pm
index eb9594f..3079312 100644 (file)
--- a/TreeOfTexts/lib/TreeOfTexts/Controller/Stemmagraph.pm
+++ b/TreeOfTexts/lib/TreeOfTexts/Controller/Stemmagraph.pm
@@ -2,8 +2,9 @@ package TreeOfTexts::Controller::Stemmagraph;
 use Moose;
 use namespace::autoclean;
 use File::Temp;
+use JSON;
 use Text::Tradition::Collation;
-use Text::Tradition::Stemma;
+use Text::Tradition::StemmaUtil qw/ character_input phylip_pars newick_to_svg /;
 
 BEGIN { extends 'Catalyst::Controller' }
 
@@ -15,7 +16,7 @@ __PACKAGE__->config(namespace => '');
 
 =head1 NAME
 
-TreeOfTexts::Controller::Root - Root Controller for TreeOfTexts
+TreeOfTexts::Controller::Stemmagraph - Simple controller for stemma display
 
 =head1 DESCRIPTION
 
@@ -23,17 +24,8 @@ TreeOfTexts::Controller::Root - Root Controller for TreeOfTexts
 
 =head1 METHODS
 
-=head2 index
-
-The root page (/)
-
 =cut
 
-sub index :Path :Args(0) {
-    my ( $self, $c ) = @_;
-    $c->stash->{template} = 'dotinput.tt2';  
-}
-
 sub get_graph :Local {
        my( $self, $c ) = @_;
        # If called interactively, we have params 'display', 'output', 'witnesses'
@@ -41,7 +33,6 @@ sub get_graph :Local {
        # The body is actually a File::Temp object; this is undocumented but 
        # so it seems to be.
        my $dotfile;
-       $DB::single = 1;
        my $must_unlink = 0;
        if( $c->request->params->{'dot'} ) {
            # Make a File::Temp object.
@@ -62,25 +53,73 @@ sub get_graph :Local {
     $c->forward( "View::SVG" );
 }
 
-=head2 default
+=head2 character_matrix
 
-Standard 404 error page
+Given an alignment table in JSON form, in the parameter 'alignment', returns a
+character matrix suitable for input to Phylip PARS. 
 
 =cut
 
-sub default :Path {
-    my ( $self, $c ) = @_;
-    $c->response->body( 'Page not found' );
-    $c->response->status(404);
+sub character_matrix :Local {
+       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 end
+=head2 run_pars 
 
-Attempt to render a view, if needed.
+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