Commit | Line | Data |
5c9ecf66 |
1 | package stemmaweb::Controller::Microservice; |
2376359f |
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 | |
5c9ecf66 |
13 | stemmaweb::Controller::Microservice - Controller for stemmaweb standalone |
2376359f |
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; |