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';
56 A dispatcher for documentation of various aspects of the application.
60 sub help :Local :Args(1) {
61 my( $self, $c, $topic ) = @_;
62 $c->stash->{template} = "$topic.tt";
65 =head1 Elements of index page
71 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.
75 sub directory :Local :Args(0) {
77 my $m = $c->model('Directory');
78 # Is someone logged in?
80 if( $c->user_exists ) {
81 my $user = $c->user->get_object;
82 my @list = $m->traditionlist( $user );
83 map { $usertexts{$_->{id}} = 1 } @list;
84 $c->stash->{usertexts} = \@list;
85 $c->stash->{is_admin} = 1 if $user->is_admin;
87 # List public (i.e. readonly) texts separately from any user (i.e.
88 # full access) texts that exist. Admin users therefore have nothing
90 my @plist = grep { !$usertexts{$_->{id}} } $m->traditionlist('public');
91 $c->stash->{publictexts} = \@plist;
92 $c->stash->{template} = 'directory.tt';
95 =head1 AJAX methods for traditions and their properties
101 language: <language>,
105 Creates a new tradition belonging to the logged-in user, with the given name
106 and the collation given in the uploaded file. The file type is indicated via
107 the filename extension (.csv, .txt, .xls, .xlsx, .xml). Returns the ID and
108 name of the new tradition.
112 sub newtradition :Local :Args(0) {
113 my( $self, $c ) = @_;
114 return _json_error( $c, 403, 'Cannot save a tradition without being logged in' )
115 unless $c->user_exists;
117 my $user = $c->user->get_object;
118 # Grab the file upload, check its name/extension, and call the
119 # appropriate parser(s).
120 my $upload = $c->request->upload('file');
121 my $name = $c->request->param('name') || 'Uploaded tradition';
122 my $lang = $c->request->param( 'language' ) || 'Default';
123 my $public = $c->request->param( 'public' ) ? 1 : undef;
124 my( $ext ) = $upload->filename =~ /\.(\w+)$/;
129 'file' => $upload->tempname
134 if( $ext eq 'xml' ) {
135 # Try the different XML parsing options to see if one works.
136 foreach my $type ( qw/ CollateX CTE TEI / ) {
138 $tradition = Text::Tradition->new( %newopts, 'input' => $type );
139 } catch ( Text::Tradition::Error $e ) {
140 $errmsg = $e->message;
142 $errmsg = "Unexpected parsing error";
149 } elsif( $ext =~ /^(txt|csv|xls(x)?)$/ ) {
150 # If it's Excel we need to pass excel => $ext;
151 # otherwise we need to pass sep_char => [record separator].
152 if( $ext =~ /xls/ ) {
153 $newopts{'excel'} = $ext;
155 $newopts{'sep_char'} = $ext eq 'txt' ? "\t" : ',';
158 $tradition = Text::Tradition->new(
160 'input' => 'Tabular',
162 } catch ( Text::Tradition::Error $e ) {
163 $errmsg = $e->message;
165 $errmsg = "Unexpected parsing error";
168 # Error unless we have a recognized filename extension
169 return _json_error( $c, 403, "Unrecognized file type extension $ext" );
172 # Save the tradition if we have it, and return its data or else the
173 # error that occurred trying to make it.
175 return _json_error( $c, 500, "Error parsing tradition .$ext file: $errmsg" );
176 } elsif( !$tradition ) {
177 return _json_error( $c, 500, "No error caught but tradition not created" );
180 my $m = $c->model('Directory');
181 $user->add_tradition( $tradition );
182 my $id = $c->model('Directory')->store( $tradition );
183 $c->model('Directory')->store( $user );
184 $c->stash->{'result'} = { 'id' => $id, 'name' => $tradition->name };
185 $c->forward('View::JSON');
190 GET /textinfo/$textid
191 POST /textinfo/$textid,
193 language: $new_language,
195 owner: $new_userid } # only admin users can update the owner
197 Returns information about a particular text.
201 sub textinfo :Local :Args(1) {
202 my( $self, $c, $textid ) = @_;
203 my $tradition = $c->model('Directory')->tradition( $textid );
204 ## Have to keep users in the same scope as tradition
207 unless( $tradition ) {
208 return _json_error( $c, 404, "No tradition with ID $textid" );
210 my $ok = _check_permission( $c, $tradition );
212 if( $c->req->method eq 'POST' ) {
213 return _json_error( $c, 403,
214 'You do not have permission to update this tradition' )
215 unless $ok eq 'full';
216 my $params = $c->request->parameters;
217 # Handle changes to owner-accessible parameters
218 my $m = $c->model('Directory');
220 # Handle name param - easy
221 if( exists $params->{name} ) {
222 my $newname = delete $params->{name};
223 unless( $tradition->name eq $newname ) {
225 $tradition->name( $newname );
228 return _json_error( $c, 500, "Error setting name to $newname" );
232 # Handle language param, making Default => null
233 my $langval = delete $params->{language} || 'Default';
235 unless( $tradition->language eq $langval || !$tradition->can('language') ) {
237 $tradition->language( $langval );
240 return _json_error( $c, 500, "Error setting language to $langval" );
245 my $ispublic = $tradition->public;
246 if( delete $params->{'public'} ) { # if it's any true value...
247 $tradition->public( 1 );
248 $changed = 1 unless $ispublic;
249 } else { # the checkbox was unchecked, ergo it should not be public
250 $tradition->public( 0 );
251 $changed = 1 if $ispublic;
254 # Handle ownership change
255 if( exists $params->{'owner'} ) {
256 # Only admins can update user / owner
257 my $newownerid = delete $params->{'owner'};
258 unless( !$newownerid ||
259 ( $tradition->has_user && $tradition->user->email eq $newownerid ) ) {
260 unless( $c->user->get_object->is_admin ) {
261 return _json_error( $c, 403,
262 "Only admin users can change tradition ownership" );
264 $newuser = $m->find_user({ email => $newownerid });
266 return _json_error( $c, 500, "No such user " . $newownerid );
268 if( $tradition->has_user ) {
269 $olduser = $tradition->user;
270 $olduser->remove_tradition( $tradition );
272 $newuser->add_tradition( $tradition );
276 # TODO check for rogue parameters
277 if( scalar keys %$params ) {
278 my $rogueparams = join( ', ', keys %$params );
279 return _json_error( $c, 403, "Request parameters $rogueparams not recognized" );
281 # If we safely got to the end, then write to the database.
282 $m->save( $tradition ) if $changed;
283 $m->save( $newuser ) if $newuser;
286 # Now return the current textinfo, whether GET or successful POST.
289 name => $tradition->name,
290 #language => $tradition->language,
291 public => $tradition->public || 0,
292 owner => $tradition->user ? $tradition->user->email : undef,
293 witnesses => [ map { $_->sigil } $tradition->witnesses ],
295 if( $tradition->can('language') ) {
296 $textinfo->{'language'} = $tradition->language;
298 my @stemmasvg = map { $_->as_svg() } $tradition->stemmata;
299 map { $_ =~ s/\n/ /mg } @stemmasvg;
300 $textinfo->{stemmata} = \@stemmasvg;
301 $c->stash->{'result'} = $textinfo;
302 $c->forward('View::JSON');
307 GET /variantgraph/$textid
309 Returns the variant graph for the text specified at $textid, in SVG form.
313 sub variantgraph :Local :Args(1) {
314 my( $self, $c, $textid ) = @_;
315 my $tradition = $c->model('Directory')->tradition( $textid );
316 unless( $tradition ) {
317 return _json_error( $c, 404, "No tradition with ID $textid" );
319 my $ok = _check_permission( $c, $tradition );
322 my $collation = $tradition->collation;
323 $c->stash->{'result'} = $collation->as_svg;
324 $c->forward('View::SVG');
329 GET /stemma/$textid/$stemmaseq
330 POST /stemma/$textid/$stemmaseq, { 'dot' => $dot_string }
332 Returns an SVG representation of the given stemma hypothesis for the text.
333 If the URL is called with POST, the stemma at $stemmaseq will be altered
334 to reflect the definition in $dot_string. If $stemmaseq is 'n', a new
335 stemma will be added.
339 sub stemma :Local :Args(2) {
340 my( $self, $c, $textid, $stemmaid ) = @_;
341 my $m = $c->model('Directory');
342 my $tradition = $m->tradition( $textid );
343 unless( $tradition ) {
344 return _json_error( $c, 404, "No tradition with ID $textid" );
346 my $ok = _check_permission( $c, $tradition );
349 $c->stash->{'result'} = '';
351 if( $c->req->method eq 'POST' ) {
352 if( $ok eq 'full' ) {
353 my $dot = $c->request->body_params->{'dot'};
355 if( $stemmaid eq 'n' ) {
356 # We are adding a new stemma.
357 $stemmaid = $tradition->stemma_count;
358 $stemma = $tradition->add_stemma( 'dot' => $dot );
359 } elsif( $stemmaid !~ /^\d+$/ ) {
360 return _json_error( $c, 403, "Invalid stemma ID specification $stemmaid" );
361 } elsif( $stemmaid < $tradition->stemma_count ) {
362 # We are updating an existing stemma.
363 $stemma = $tradition->stemma( $stemmaid );
364 $stemma->alter_graph( $dot );
366 # Unrecognized stemma ID
367 return _json_error( $c, 404, "No stemma at index $stemmaid, cannot update" );
369 } catch ( Text::Tradition::Error $e ) {
370 return _json_error( $c, 500, $e->message );
372 $m->store( $tradition );
374 # No permissions to update the stemma
375 return _json_error( $c, 403,
376 'You do not have permission to update stemmata for this tradition' );
380 # For a GET or a successful POST request, return the SVG representation
381 # of the stemma in question, if any.
382 if( !$stemma && $tradition->stemma_count > $stemmaid ) {
383 $stemma = $tradition->stemma( $stemmaid );
385 my $stemma_xml = $stemma ? $stemma->as_svg() : '';
386 # What was requested, XML or JSON?
387 my $return_view = 'SVG';
388 if( my $accept_header = $c->req->header('Accept') ) {
389 $c->log->debug( "Received Accept header: $accept_header" );
390 foreach my $type ( split( /,\s*/, $accept_header ) ) {
391 # If we were first asked for XML, return SVG
392 last if $type =~ /^(application|text)\/xml$/;
393 # If we were first asked for JSON, return JSON
394 if( $type eq 'application/json' ) {
395 $return_view = 'JSON';
400 if( $return_view eq 'SVG' ) {
401 $c->stash->{'result'} = $stemma_xml;
402 $c->forward('View::SVG');
404 $stemma_xml =~ s/\n/ /mg;
405 $c->stash->{'result'} = { 'stemmaid' => $stemmaid, 'stemmasvg' => $stemma_xml };
406 $c->forward('View::JSON');
412 GET /stemmadot/$textid/$stemmaseq
414 Returns the 'dot' format representation of the current stemma hypothesis.
418 sub stemmadot :Local :Args(2) {
419 my( $self, $c, $textid, $stemmaid ) = @_;
420 my $m = $c->model('Directory');
421 my $tradition = $m->tradition( $textid );
422 unless( $tradition ) {
423 return _json_error( $c, 404, "No tradition with ID $textid" );
425 my $ok = _check_permission( $c, $tradition );
427 my $stemma = $tradition->stemma( $stemmaid );
429 return _json_error( $c, 404, "Tradition $textid has no stemma ID $stemmaid" );
431 # Get the dot and transmute its line breaks to literal '|n'
432 $c->stash->{'result'} = { 'dot' => $stemma->editable( { linesep => '|n' } ) };
433 $c->forward('View::JSON');
438 GET /download/$textid
440 Returns the full XML definition of the tradition and its stemmata, if any.
444 sub download :Local :Args(1) {
445 my( $self, $c, $textid ) = @_;
446 my $tradition = $c->model('Directory')->tradition( $textid );
447 unless( $tradition ) {
448 return _json_error( $c, 404, "No tradition with ID $textid" );
450 my $ok = _check_permission( $c, $tradition );
453 $c->stash->{'result'} = $tradition->collation->as_graphml();
454 } catch( Text::Tradition::Error $e ) {
455 return _json_error( $c, 500, $e->message );
457 $c->forward('View::GraphML');
464 # Helper to check what permission, if any, the active user has for
465 # the given tradition
466 sub _check_permission {
467 my( $c, $tradition ) = @_;
468 my $user = $c->user_exists ? $c->user->get_object : undef;
470 return 'full' if ( $user->is_admin ||
471 ( $tradition->has_user && $tradition->user->id eq $user->id ) );
473 # Text doesn't belong to us, so maybe it's public?
474 return 'readonly' if $tradition->public;
476 # ...nope. Forbidden!
477 return _json_error( $c, 403, 'You do not have permission to view this tradition.' );
480 # Helper to throw a JSON exception
482 my( $c, $code, $errmsg ) = @_;
483 $c->response->status( $code );
484 $c->stash->{'result'} = { 'error' => $errmsg };
485 $c->forward('View::JSON');
491 Standard 404 error page
496 my ( $self, $c ) = @_;
497 $c->response->body( 'Page not found' );
498 $c->response->status(404);
503 Attempt to render a view, if needed.
507 sub end : ActionClass('RenderView') {}
515 This library is free software. You can redistribute it and/or modify
516 it under the same terms as Perl itself.
520 __PACKAGE__->meta->make_immutable;