stemmaweb/lib/stemmaweb/Controller/Microservice.pm

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