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";
138 } elsif( $ext =~ /^(txt|csv|xls(x)?)$/ ) {
139 # If it's Excel we need to pass excel => $ext;
140 # otherwise we need to pass sep_char => [record separator].
141 if( $ext =~ /xls/ ) {
142 $newopts{'excel'} = $ext;
144 $newopts{'sep_char'} = $ext eq 'txt' ? "\t" : ',';
147 $tradition = Text::Tradition->new(
149 'input' => 'Tabular',
151 } catch ( Text::Tradition::Error $e ) {
152 $errmsg = $e->message;
154 $errmsg = "Unexpected parsing error";
157 # Error unless we have a recognized filename extension
158 return _json_error( $c, 403, "Unrecognized file type extension $ext" );
161 # Save the tradition if we have it, and return its data or else the
162 # error that occurred trying to make it.
164 return _json_error( $c, 500, "Error parsing tradition .$ext file: $errmsg" );
165 } elsif( !$tradition ) {
166 return _json_error( $c, 500, "No error caught but tradition not created" );
169 my $m = $c->model('Directory');
170 $user->add_tradition( $tradition );
171 my $id = $c->model('Directory')->store( $tradition );
172 $c->model('Directory')->store( $user );
173 $c->stash->{'result'} = { 'id' => $id, 'name' => $tradition->name };
174 $c->forward('View::JSON');
179 GET /textinfo/$textid
180 POST /textinfo/$textid,
182 language: $new_language,
184 owner: $new_userid } # only admin users can update the owner
186 Returns information about a particular text.
190 sub textinfo :Local :Args(1) {
191 my( $self, $c, $textid ) = @_;
192 my $tradition = $c->model('Directory')->tradition( $textid );
193 ## Have to keep users in the same scope as tradition
196 unless( $tradition ) {
197 return _json_error( $c, 404, "No tradition with ID $textid" );
199 my $ok = _check_permission( $c, $tradition );
201 if( $c->req->method eq 'POST' ) {
202 return _json_error( $c, 403,
203 'You do not have permission to update this tradition' )
204 unless $ok eq 'full';
205 my $params = $c->request->parameters;
206 # Handle changes to owner-accessible parameters
207 my $m = $c->model('Directory');
209 # Handle name param - easy
210 if( exists $params->{name} ) {
211 my $newname = delete $params->{name};
212 unless( $tradition->name eq $newname ) {
214 $tradition->name( $newname );
217 return _json_error( $c, 500, "Error setting name to $newname" );
221 # Handle language param, making Default => null
222 my $langval = delete $params->{language} || 'Default';
224 unless( $tradition->language eq $langval || !$tradition->can('language') ) {
226 $tradition->language( $langval );
229 return _json_error( $c, 500, "Error setting language to $langval" );
234 my $ispublic = $tradition->public;
235 if( delete $params->{'public'} ) { # if it's any true value...
236 $tradition->public( 1 );
237 $changed = 1 unless $ispublic;
238 } else { # the checkbox was unchecked, ergo it should not be public
239 $tradition->public( 0 );
240 $changed = 1 if $ispublic;
243 # Handle ownership change
244 if( exists $params->{'owner'} ) {
245 # Only admins can update user / owner
246 my $newownerid = delete $params->{'owner'};
247 unless( !$newownerid ||
248 ( $tradition->has_user && $tradition->user->email eq $newownerid ) ) {
249 unless( $c->user->get_object->is_admin ) {
250 return _json_error( $c, 403,
251 "Only admin users can change tradition ownership" );
253 $newuser = $m->find_user({ email => $newownerid });
255 return _json_error( $c, 500, "No such user " . $newownerid );
257 if( $tradition->has_user ) {
258 $olduser = $tradition->user;
259 $olduser->remove_tradition( $tradition );
261 $newuser->add_tradition( $tradition );
265 # TODO check for rogue parameters
266 if( scalar keys %$params ) {
267 my $rogueparams = join( ', ', keys %$params );
268 return _json_error( $c, 403, "Request parameters $rogueparams not recognized" );
270 # If we safely got to the end, then write to the database.
271 $m->save( $tradition ) if $changed;
272 $m->save( $newuser ) if $newuser;
275 # Now return the current textinfo, whether GET or successful POST.
278 name => $tradition->name,
279 #language => $tradition->language,
280 public => $tradition->public || 0,
281 owner => $tradition->user ? $tradition->user->email : undef,
282 witnesses => [ map { $_->sigil } $tradition->witnesses ],
284 if( $tradition->can('language') ) {
285 $textinfo->{'language'} = $tradition->language;
287 my @stemmasvg = map { $_->as_svg() } $tradition->stemmata;
288 map { $_ =~ s/\n/ /mg } @stemmasvg;
289 $textinfo->{stemmata} = \@stemmasvg;
290 $c->stash->{'result'} = $textinfo;
291 $c->forward('View::JSON');
296 GET /variantgraph/$textid
298 Returns the variant graph for the text specified at $textid, in SVG form.
302 sub variantgraph :Local :Args(1) {
303 my( $self, $c, $textid ) = @_;
304 my $tradition = $c->model('Directory')->tradition( $textid );
305 unless( $tradition ) {
306 return _json_error( $c, 404, "No tradition with ID $textid" );
308 my $ok = _check_permission( $c, $tradition );
311 my $collation = $tradition->collation;
312 $c->stash->{'result'} = $collation->as_svg;
313 $c->forward('View::SVG');
318 GET /stemma/$textid/$stemmaseq
319 POST /stemma/$textid/$stemmaseq, { 'dot' => $dot_string }
321 Returns an SVG representation of the given stemma hypothesis for the text.
322 If the URL is called with POST, the stemma at $stemmaseq will be altered
323 to reflect the definition in $dot_string. If $stemmaseq is 'n', a new
324 stemma will be added.
328 sub stemma :Local :Args(2) {
329 my( $self, $c, $textid, $stemmaid ) = @_;
330 my $m = $c->model('Directory');
331 my $tradition = $m->tradition( $textid );
332 unless( $tradition ) {
333 return _json_error( $c, 404, "No tradition with ID $textid" );
335 my $ok = _check_permission( $c, $tradition );
338 $c->stash->{'result'} = '';
340 if( $c->req->method eq 'POST' ) {
341 if( $ok eq 'full' ) {
342 my $dot = $c->request->body_params->{'dot'};
344 if( $stemmaid eq 'n' ) {
345 # We are adding a new stemma.
346 $stemmaid = $tradition->stemma_count;
347 $stemma = $tradition->add_stemma( 'dot' => $dot );
348 } elsif( $stemmaid !~ /^\d+$/ ) {
349 return _json_error( $c, 403, "Invalid stemma ID specification $stemmaid" );
350 } elsif( $stemmaid < $tradition->stemma_count ) {
351 # We are updating an existing stemma.
352 $stemma = $tradition->stemma( $stemmaid );
353 $stemma->alter_graph( $dot );
355 # Unrecognized stemma ID
356 return _json_error( $c, 404, "No stemma at index $stemmaid, cannot update" );
358 } catch ( Text::Tradition::Error $e ) {
359 return _json_error( $c, 500, $e->message );
361 $m->store( $tradition );
363 # No permissions to update the stemma
364 return _json_error( $c, 403,
365 'You do not have permission to update stemmata for this tradition' );
369 # For a GET or a successful POST request, return the SVG representation
370 # of the stemma in question, if any.
371 if( !$stemma && $tradition->stemma_count > $stemmaid ) {
372 $stemma = $tradition->stemma( $stemmaid );
374 my $stemma_xml = $stemma ? $stemma->as_svg() : '';
375 # What was requested, XML or JSON?
376 my $return_view = 'SVG';
377 if( my $accept_header = $c->req->header('Accept') ) {
378 $c->log->debug( "Received Accept header: $accept_header" );
379 foreach my $type ( split( /,\s*/, $accept_header ) ) {
380 # If we were first asked for XML, return SVG
381 last if $type =~ /^(application|text)\/xml$/;
382 # If we were first asked for JSON, return JSON
383 if( $type eq 'application/json' ) {
384 $return_view = 'JSON';
389 if( $return_view eq 'SVG' ) {
390 $c->stash->{'result'} = $stemma_xml;
391 $c->forward('View::SVG');
393 $stemma_xml =~ s/\n/ /mg;
394 $c->stash->{'result'} = { 'stemmaid' => $stemmaid, 'stemmasvg' => $stemma_xml };
395 $c->forward('View::JSON');
401 GET /stemmadot/$textid/$stemmaseq
403 Returns the 'dot' format representation of the current stemma hypothesis.
407 sub stemmadot :Local :Args(2) {
408 my( $self, $c, $textid, $stemmaid ) = @_;
409 my $m = $c->model('Directory');
410 my $tradition = $m->tradition( $textid );
411 unless( $tradition ) {
412 return _json_error( $c, 404, "No tradition with ID $textid" );
414 my $ok = _check_permission( $c, $tradition );
416 my $stemma = $tradition->stemma( $stemmaid );
418 return _json_error( $c, 404, "Tradition $textid has no stemma ID $stemmaid" );
420 # Get the dot and transmute its line breaks to literal '|n'
421 $c->stash->{'result'} = { 'dot' => $stemma->editable( { linesep => '|n' } ) };
422 $c->forward('View::JSON');
429 # Helper to check what permission, if any, the active user has for
430 # the given tradition
431 sub _check_permission {
432 my( $c, $tradition ) = @_;
433 my $user = $c->user_exists ? $c->user->get_object : undef;
435 return 'full' if ( $user->is_admin ||
436 ( $tradition->has_user && $tradition->user->id eq $user->id ) );
438 # Text doesn't belong to us, so maybe it's public?
439 return 'readonly' if $tradition->public;
441 # ...nope. Forbidden!
442 return _json_error( $c, 403, 'You do not have permission to view this tradition.' );
445 # Helper to throw a JSON exception
447 my( $c, $code, $errmsg ) = @_;
448 $c->response->status( $code );
449 $c->stash->{'result'} = { 'error' => $errmsg };
450 $c->forward('View::JSON');
456 Standard 404 error page
461 my ( $self, $c ) = @_;
462 $c->response->body( 'Page not found' );
463 $c->response->status(404);
468 Attempt to render a view, if needed.
472 sub end : ActionClass('RenderView') {}
480 This library is free software. You can redistribute it and/or modify
481 it under the same terms as Perl itself.
485 __PACKAGE__->meta->make_immutable;