Commit | Line | Data |
b8a92065 |
1 | package stemmaweb::Controller::Microservice; |
2 | use Moose; |
3 | use namespace::autoclean; |
4 | use JSON; |
13c54385 |
5 | use TryCatch; |
b8a92065 |
6 | use Text::Tradition; |
13c54385 |
7 | #use Text::Tradition::Error; |
b8a92065 |
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 | |
378668ee |
30 | =item * type - Can be one of CollateX, CTE, CSV, JSON, nCritic, TEI, Tabular. |
b8a92065 |
31 | |
32 | =item * data - The collation data itself. |
33 | |
34 | =back |
35 | |
36 | =head1 COLLATION URLs |
37 | |
378668ee |
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 | |
b8a92065 |
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 ); |
13c54385 |
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 | } |
b8a92065 |
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(); |
13c54385 |
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 | } |
b8a92065 |
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 ) = @_; |
b8a92065 |
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 { |
13c54385 |
178 | $c->detach( 'error', [ "Must pass either an alignment or a matrix" ] ); |
b8a92065 |
179 | } |
180 | |
181 | # Got the matrix, so try to run pars. |
13c54385 |
182 | my $output; |
183 | try { |
184 | $output = phylip_pars( $matrix ); |
185 | } catch( Text::Tradition::Error $e ) { |
186 | $c->detach( 'error', [ $e ] ); |
b8a92065 |
187 | } |
188 | |
189 | # Did we want newick or a graph? |
13c54385 |
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 { |
b8a92065 |
196 | $c->stash->{'result'} = newick_to_svg( $output ); |
197 | $view = 'View::SVG'; |
13c54385 |
198 | } catch( Text::Tradition::Error $e ) { |
199 | $c->detach( 'error', [ $e ] ); |
b8a92065 |
200 | } |
13c54385 |
201 | } elsif( $format ne 'newick' ) { |
202 | $c->detach( 'error', [ "Requested output format $format unknown" ] ); |
203 | } else { |
204 | $c->stash->{'result'} = { 'tree' => $output }; |
b8a92065 |
205 | } |
206 | |
b8a92065 |
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 | |
13c54385 |
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 | |
b8a92065 |
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 | |
b8a92065 |
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; |