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