1 package stemmaweb::Controller::Root;
3 use namespace::autoclean;
4 use Text::Tradition::Analysis qw/ run_analysis /;
8 BEGIN { extends 'Catalyst::Controller' }
11 # Sets the actions in this controller to be registered with no prefix
12 # so they function identically to actions created in MyApp.pm
14 __PACKAGE__->config(namespace => '');
18 stemmaweb::Controller::Root - Root Controller for stemmaweb
22 Serves up the main container pages.
28 The root page (/). Serves the main container page, from which the various
29 components will be loaded.
33 sub index :Path :Args(0) {
34 my ( $self, $c ) = @_;
36 # Are we being asked to load a text immediately? If so
37 if( $c->req->param('withtradition') ) {
38 $c->stash->{'withtradition'} = $c->req->param('withtradition');
40 $c->stash->{template} = 'index.tt';
45 A general overview/documentation page for the site.
49 sub about :Local :Args(0) {
51 $c->stash->{template} = 'about.tt';
54 =head1 Elements of index page
60 Serves a snippet of HTML that lists the available texts. This returns texts belonging to the logged-in user if any, otherwise it returns all public texts.
64 sub directory :Local :Args(0) {
66 my $m = $c->model('Directory');
67 # Is someone logged in?
69 if( $c->user_exists ) {
70 my $user = $c->user->get_object;
71 my @list = $m->traditionlist( $user );
72 map { $usertexts{$_->{id}} = 1 } @list;
73 $c->stash->{usertexts} = \@list;
74 $c->stash->{is_admin} = 1 if $user->is_admin;
76 # List public (i.e. readonly) texts separately from any user (i.e.
77 # full access) texts that exist. Admin users therefore have nothing
79 my @plist = grep { !$usertexts{$_->{id}} } $m->traditionlist('public');
80 $c->stash->{publictexts} = \@plist;
81 $c->stash->{template} = 'directory.tt';
84 =head1 AJAX methods for traditions and their properties
94 Creates a new tradition belonging to the logged-in user, with the given name
95 and the collation given in the uploaded file. The file type is indicated via
96 the filename extension (.csv, .txt, .xls, .xlsx, .xml). Returns the ID and
97 name of the new tradition.
101 sub newtradition :Local :Args(0) {
102 my( $self, $c ) = @_;
103 return _json_error( $c, 403, 'Cannot save a tradition without being logged in' )
104 unless $c->user_exists;
106 my $user = $c->user->get_object;
107 # Grab the file upload, check its name/extension, and call the
108 # appropriate parser(s).
109 my $upload = $c->request->upload('file');
110 my $name = $c->request->param('name') || 'Uploaded tradition';
111 my $lang = $c->request->param( 'language' ) || 'Default';
112 my $public = $c->request->param( 'public' ) ? 1 : undef;
113 my( $ext ) = $upload->filename =~ /\.(\w+)$/;
118 'file' => $upload->tempname
123 if( $ext eq 'xml' ) {
124 # Try the different XML parsing options to see if one works.
125 foreach my $type ( qw/ CollateX CTE TEI / ) {
127 $tradition = Text::Tradition->new( %newopts, 'input' => $type );
128 } catch ( Text::Tradition::Error $e ) {
129 $errmsg = $e->message;
131 $errmsg = "Unexpected parsing error";
135 } elsif( $ext =~ /^(txt|csv|xls(x)?)$/ ) {
136 # If it's Excel we need to pass excel => $ext;
137 # otherwise we need to pass sep_char => [record separator].
138 if( $ext =~ /xls/ ) {
139 $newopts{'excel'} = $ext;
141 $newopts{'sep_char'} = $ext eq 'txt' ? "\t" : ',';
144 $tradition = Text::Tradition->new(
146 'input' => 'Tabular',
148 } catch ( Text::Tradition::Error $e ) {
149 $errmsg = $e->message;
151 $errmsg = "Unexpected parsing error";
154 # Error unless we have a recognized filename extension
155 return _json_error( $c, 403, "Unrecognized file type extension $ext" );
158 # Save the tradition if we have it, and return its data or else the
159 # error that occurred trying to make it.
161 return _json_error( $c, 500, "Error parsing tradition .$ext file: $errmsg" );
162 } elsif( !$tradition ) {
163 return _json_error( $c, 500, "No error caught but tradition not created" );
166 my $m = $c->model('Directory');
167 $user->add_tradition( $tradition );
168 my $id = $c->model('Directory')->store( $tradition );
169 $c->model('Directory')->store( $user );
170 $c->stash->{'result'} = { 'id' => $id, 'name' => $tradition->name };
171 $c->forward('View::JSON');
176 GET /textinfo/$textid
177 POST /textinfo/$textid,
179 language: $new_language,
181 owner: $new_userid } # only admin users can update the owner
183 Returns information about a particular text.
187 sub textinfo :Local :Args(1) {
188 my( $self, $c, $textid ) = @_;
189 my $tradition = $c->model('Directory')->tradition( $textid );
190 unless( $tradition ) {
191 return _json_error( $c, 404, "No tradition with ID $textid" );
193 my $ok = _check_permission( $c, $tradition );
195 if( $c->req->method eq 'POST' ) {
196 return _json_error( $c, 403,
197 'You do not have permission to update this tradition' )
198 unless $ok eq 'full';
199 my $params = $c->request->parameters;
200 # Handle changes to owner-accessible parameters
201 my $m = $c->model('Directory');
203 # Handle name param - easy
204 if( exists $params->{name} ) {
205 my $newname = delete $params->{name};
206 unless( $tradition->name eq $newname ) {
208 $tradition->name( $newname );
211 return _json_error( $c, 500, "Error setting name to $newname" );
215 # Handle language param, making Default => null
216 my $langval = delete $params->{language} || 'Default';
217 unless( $tradition->language eq $langval ) {
219 $tradition->language( $langval );
222 return _json_error( $c, 500, "Error setting language to $langval" );
227 my $ispublic = $tradition->public;
228 if( delete $params->{'public'} ) { # if it's any true value...
229 $tradition->public( 1 );
230 $changed = 1 unless $ispublic;
231 } else { # the checkbox was unchecked, ergo it should not be public
232 $tradition->public( 0 );
233 $changed = 1 if $ispublic;
236 # Handle ownership change
238 if( exists $params->{'owner'} ) {
239 # Only admins can update user / owner
240 my $newownerid = delete $params->{'owner'};
241 unless( !$newownerid ||
242 ( $tradition->has_user && $tradition->user->id eq $newownerid ) ) {
243 unless( $c->user->get_object->is_admin ) {
244 return _json_error( $c, 403,
245 "Only admin users can change tradition ownership" );
247 $newuser = $m->find_user({ username => $newownerid });
249 return _json_error( $c, 500, "No such user " . $newownerid );
251 $newuser->add_tradition( $tradition );
255 # TODO check for rogue parameters
256 if( scalar keys %$params ) {
257 my $rogueparams = join( ', ', keys %$params );
258 return _json_error( $c, 403, "Request parameters $rogueparams not recognized" );
260 # If we safely got to the end, then write to the database.
261 $m->save( $tradition ) if $changed;
262 $m->save( $newuser ) if $newuser;
265 # Now return the current textinfo, whether GET or successful POST.
268 name => $tradition->name,
269 language => $tradition->language,
270 public => $tradition->public,
271 owner => $tradition->user ? $tradition->user->id : undef,
272 witnesses => [ map { $_->sigil } $tradition->witnesses ],
274 my @stemmasvg = map { $_->as_svg() } $tradition->stemmata;
275 map { $_ =~ s/\n/ /mg } @stemmasvg;
276 $textinfo->{stemmata} = \@stemmasvg;
277 $c->stash->{'result'} = $textinfo;
278 $c->forward('View::JSON');
283 GET /variantgraph/$textid
285 Returns the variant graph for the text specified at $textid, in SVG form.
289 sub variantgraph :Local :Args(1) {
290 my( $self, $c, $textid ) = @_;
291 my $tradition = $c->model('Directory')->tradition( $textid );
292 unless( $tradition ) {
293 return _json_error( $c, 404, "No tradition with ID $textid" );
295 my $ok = _check_permission( $c, $tradition );
298 my $collation = $tradition->collation;
299 $c->stash->{'result'} = $collation->as_svg;
300 $c->forward('View::SVG');
305 GET /stemma/$textid/$stemmaseq
306 POST /stemma/$textid/$stemmaseq, { 'dot' => $dot_string }
308 Returns an SVG representation of the given stemma hypothesis for the text.
309 If the URL is called with POST, the stemma at $stemmaseq will be altered
310 to reflect the definition in $dot_string. If $stemmaseq is 'n', a new
311 stemma will be added.
315 sub stemma :Local :Args(2) {
316 my( $self, $c, $textid, $stemmaid ) = @_;
317 my $m = $c->model('Directory');
318 my $tradition = $m->tradition( $textid );
319 unless( $tradition ) {
320 return _json_error( $c, 404, "No tradition with ID $textid" );
322 my $ok = _check_permission( $c, $tradition );
325 $c->stash->{'result'} = '';
327 if( $c->req->method eq 'POST' ) {
328 if( $ok eq 'full' ) {
329 my $dot = $c->request->body_params->{'dot'};
331 if( $stemmaid eq 'n' ) {
332 # We are adding a new stemma.
333 $stemmaid = $tradition->stemma_count;
334 $stemma = $tradition->add_stemma( 'dot' => $dot );
335 } elsif( $stemmaid !~ /^\d+$/ ) {
336 return _json_error( $c, 403, "Invalid stemma ID specification $stemmaid" );
337 } elsif( $stemmaid < $tradition->stemma_count ) {
338 # We are updating an existing stemma.
339 $stemma = $tradition->stemma( $stemmaid );
340 $stemma->alter_graph( $dot );
342 # Unrecognized stemma ID
343 return _json_error( $c, 404, "No stemma at index $stemmaid, cannot update" );
345 } catch ( Text::Tradition::Error $e ) {
346 return _json_error( $c, 500, $e->message );
348 $m->store( $tradition );
350 # No permissions to update the stemma
351 return _json_error( $c, 403,
352 'You do not have permission to update stemmata for this tradition' );
356 # For a GET or a successful POST request, return the SVG representation
357 # of the stemma in question, if any.
358 if( !$stemma && $tradition->stemma_count > $stemmaid ) {
359 $stemma = $tradition->stemma( $stemmaid );
361 my $stemma_xml = $stemma ? $stemma->as_svg() : '';
362 # What was requested, XML or JSON?
363 my $return_view = 'SVG';
364 if( my $accept_header = $c->req->header('Accept') ) {
365 $c->log->debug( "Received Accept header: $accept_header" );
366 foreach my $type ( split( /,\s*/, $accept_header ) ) {
367 # If we were first asked for XML, return SVG
368 last if $type =~ /^(application|text)\/xml$/;
369 # If we were first asked for JSON, return JSON
370 if( $type eq 'application/json' ) {
371 $return_view = 'JSON';
376 if( $return_view eq 'SVG' ) {
377 $c->stash->{'result'} = $stemma_xml;
378 $c->forward('View::SVG');
380 $stemma_xml =~ s/\n/ /mg;
381 $c->stash->{'result'} = { 'stemmaid' => $stemmaid, 'stemmasvg' => $stemma_xml };
382 $c->forward('View::JSON');
388 GET /stemmadot/$textid/$stemmaseq
390 Returns the 'dot' format representation of the current stemma hypothesis.
394 sub stemmadot :Local :Args(2) {
395 my( $self, $c, $textid, $stemmaid ) = @_;
396 my $m = $c->model('Directory');
397 my $tradition = $m->tradition( $textid );
398 unless( $tradition ) {
399 return _json_error( $c, 404, "No tradition with ID $textid" );
401 my $ok = _check_permission( $c, $tradition );
403 my $stemma = $tradition->stemma( $stemmaid );
405 return _json_error( $c, 404, "Tradition $textid has no stemma ID $stemmaid" );
407 # Get the dot and transmute its line breaks to literal '|n'
408 $c->stash->{'result'} = { 'dot' => $stemma->editable( { linesep => '|n' } ) };
409 $c->forward('View::JSON');
416 # Helper to check what permission, if any, the active user has for
417 # the given tradition
418 sub _check_permission {
419 my( $c, $tradition ) = @_;
420 my $user = $c->user_exists ? $c->user->get_object : undef;
422 return 'full' if ( $user->is_admin ||
423 ( $tradition->has_user && $tradition->user->id eq $user->id ) );
425 # Text doesn't belong to us, so maybe it's public?
426 return 'readonly' if $tradition->public;
428 # ...nope. Forbidden!
429 return _json_error( $c, 403, 'You do not have permission to view this tradition.' );
432 # Helper to throw a JSON exception
434 my( $c, $code, $errmsg ) = @_;
435 $c->response->status( $code );
436 $c->stash->{'result'} = { 'error' => $errmsg };
437 $c->forward('View::JSON');
443 Standard 404 error page
448 my ( $self, $c ) = @_;
449 $c->response->body( 'Page not found' );
450 $c->response->status(404);
455 Attempt to render a view, if needed.
459 sub end : ActionClass('RenderView') {}
467 This library is free software. You can redistribute it and/or modify
468 it under the same terms as Perl itself.
472 __PACKAGE__->meta->make_immutable;