lib/stemmaweb/Controller/Microservice.pm

   1 package stemmaweb::Controller::Microservice;
   2 use Moose;
   3 use namespace::autoclean;
   4 use JSON;
   5 use TryCatch;
   6 use Text::Tradition;
   7 #use Text::Tradition::Error;
   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
  30 =item * type - Can be one of CollateX, CSV, JSON, nCritic, TEI, Tabular.
  31
  32 =item * data - The collation data itself.
  33
  34 =back
  35
  36 =head1 COLLATION URLs
  37
  38 =head2 renderSVG
  39
  40  POST microservice/renderSVG
  41
  42 Parse the passed collation data and return an SVG of the collated text.
  43
  44 =cut
  45
  46 # Utility function to render SVG from a collation in some recognized format.
  47 sub renderSVG :Local :Args(0) {
  48         my( $self, $c ) = @_;
  49         my $tradition = _parse_to_tradition( $c->request );
  50         try {
  51                 $c->stash->{'result'} = $tradition->collation->as_svg;
  52                 $c->forward('View::SVG');
  53         } catch( Text::Tradition::Error $e ) {
  54                 $c->detach( 'error', [ $e ] );
  55         }
  56 }
  57
  58 =head1 STEMMA / DISTANCE TREE URLs
  59
  60 =head2 stemma_svg
  61
  62  POST microservice/stemma_svg
  63
  64 Parameter: dot => a string containing the dot description of the stemma.
  65
  66 =cut
  67
  68 sub stemma_svg :Local :Args(0) {
  69         my( $self, $c ) = @_;
  70         my $t = Text::Tradition->new();
  71         my $stemma;
  72         try {
  73                 $stemma = $t->add_stemma( 'dot' => $c->req->param('dot') );
  74         } catch( Text::Tradition::Error $e ) {
  75                 $c->detach( 'error', [ $e ] );
  76         }
  77         $c->stash->{'result'} = $stemma->as_svg;
  78         $c->forward('View::SVG');
  79 }
  80
  81 =head2 character_matrix
  82
  83  POST microservice/character_matrix
  84
  85 Given an alignment table in JSON form, in the parameter 'alignment', returns a
  86 character matrix suitable for input to Phylip PARS.
  87
  88 =cut
  89
  90 sub character_matrix :Local :Args(0) {
  91         my( $self, $c ) = @_;
  92         my $json = $c->request->params->{'alignment'};
  93         $c->log->debug( $json );
  94         my $table = from_json( $json );
  95         my $matrix = character_input( $table );
  96         $c->stash->{'result'} = { 'matrix' => $matrix };
  97         $c->forward( 'View::JSON' );
  98 }
  99
 100 =head2 run_pars
 101
 102  POST microservice/run_pars
 103
 104 Runs Phylip PARS on the provided alignment, and returns the result. Parameters include:
 105
 106 =over 4
 107
 108 =item * alignment - A JSON alignment table, as produced by CollateX
 109
 110 =item * matrix - A character matrix suitable for Phylip.
 111
 112 =item * format - The format in which to return the results.  Default is 'newick'; also allowed is 'svg'.
 113
 114 =back
 115
 116 Exactly one of 'alignment' or 'matrix' must be specified.
 117
 118 =cut
 119
 120 sub run_pars :Local :Args(0) {
 121         my( $self, $c ) = @_;
 122         my $matrix;
 123         if( $c->request->param('matrix') ) {
 124                 $matrix = $c->request->param('matrix');
 125         } elsif( $c->request->param('alignment') ) {
 126                 # Make the matrix from the alignment
 127                 my $table = from_json( $c->request->param('alignment') );
 128                 $matrix = character_input( $table );
 129         } else {
 130                 $c->detach( 'error', [ "Must pass either an alignment or a matrix" ] );
 131         }
 132
 133         # Got the matrix, so try to run pars.
 134         my $output;
 135         try {
 136                 $output = phylip_pars( $matrix );
 137         } catch( Text::Tradition::Error $e ) {
 138                 $c->detach( 'error', [ $e ] );
 139         }
 140
 141         # Did we want newick or a graph?
 142         my $view = 'View::JSON';
 143         my $format = 'newick';
 144         $format = $c->request->param('format') if $c->request->param('format');
 145         if( $format eq 'svg' ) {
 146                 # Do something
 147                 try {
 148                         $c->stash->{'result'} = newick_to_svg( $output );
 149                         $view = 'View::SVG';
 150                 } catch( Text::Tradition::Error $e ) {
 151                         $c->detach( 'error', [ $e ] );
 152                 }
 153         } elsif( $format ne 'newick' ) {
 154                 $c->detach( 'error', [ "Requested output format $format unknown" ] );
 155         } else {
 156                 $c->stash->{'result'} = { 'tree' => $output };
 157         }
 158
 159         $c->forward( $view );
 160 }
 161
 162
 163 =head1 OPENSOCIAL URLs
 164
 165 =head2 view_table
 166
 167 Simple gadget to return the analysis table for the stexaminer
 168
 169 =cut
 170
 171 sub view_table :Local :Args(0) {
 172     my( $self, $c ) = @_;
 173     my $m = $c->model('Directory');
 174         my $id = $c->request->params->{'textid'};
 175         my $t = run_analysis( $m->tradition( $id ), $m->stemma( $id ) );
 176         $c->stash->{variants} = $t->{'variants'};
 177     $c->stash->{template} = 'table_gadget.tt';
 178 }
 179
 180 =head2 view_stemma_svg
 181
 182 Simple gadget to return the SVG for a given stemma
 183
 184 =cut
 185
 186 sub view_svg :Local :Args(0) {
 187     my( $self, $c ) = @_;
 188     my $m = $c->model('Directory');
 189     my $stemma = $m->tradition( $c->request->params->{'textid'} )->stemma;
 190         if( $stemma ) {
 191                 $c->stash->{svg} = $stemma->as_svg;
 192         }
 193     $c->stash->{template} = 'stemma_gadget.tt';
 194 }
 195
 196 =head2 error
 197
 198 Default response when actions generate Text::Tradition::Error exceptions
 199
 200 =cut
 201
 202 sub error :Private {
 203         my( $self, $c, $error ) = @_;
 204         my $errstr = $error;
 205         if( ref( $error ) eq 'Text::Tradition::Error' ) {
 206                 $errstr = $error->ident . ": " . $error->message;
 207         }
 208         $c->response->code( 500 );
 209         $c->stash->{'error'} = $errstr;
 210         $c->stash->{'template'} = 'error.tt';
 211 }
 212
 213 =head2 default
 214
 215 Standard 404 error page
 216
 217 =cut
 218
 219 sub default :Path {
 220     my ( $self, $c ) = @_;
 221     $c->response->body( 'Page not found' );
 222     $c->response->status(404);
 223 }
 224
 225 ## Internal utility function
 226
 227 sub _parse_to_tradition {
 228         my $req = shift;
 229         my $type = $req->body_params->{'type'};
 230         my $name = $req->param('name') || 'Collation graph';
 231         my $data = $req->body_params->{'data'};
 232         my $opts = {
 233                 'name' => $name,
 234                 'input' => $type,
 235                 'string' => $data
 236                 };
 237         $opts->{'sep_char'} = ',' if $type eq 'CSV';
 238         $opts->{'sep_char'} = "\t" if $type eq 'TabSep';
 239         return Text::Tradition->new( $opts );
 240 }
 241
 242
 243 =head1 AUTHOR
 244
 245 Tara L Andrews
 246
 247 =head1 LICENSE
 248
 249 This library is free software. You can redistribute it and/or modify
 250 it under the same terms as Perl itself.
 251
 252 =cut
 253
 254 __PACKAGE__->meta->make_immutable;
 255
 256 1;