1 package stemmaweb::Controller::Root;
3 use namespace::autoclean;
7 use XML::LibXML::XPathContext;
10 BEGIN { extends 'Catalyst::Controller' }
13 # Sets the actions in this controller to be registered with no prefix
14 # so they function identically to actions created in MyApp.pm
16 __PACKAGE__->config(namespace => '');
20 stemmaweb::Controller::Root - Root Controller for stemmaweb
24 Serves up the main container pages.
30 The root page (/). Serves the main container page, from which the various
31 components will be loaded.
35 sub index :Path :Args(0) {
36 my ( $self, $c ) = @_;
38 # Are we being asked to load a text immediately? If so
39 if( $c->req->param('withtradition') ) {
40 $c->stash->{'withtradition'} = $c->req->param('withtradition');
42 $c->stash->{template} = 'index.tt';
47 A general overview/documentation page for the site.
51 sub about :Local :Args(0) {
53 $c->stash->{template} = 'about.tt';
58 A dispatcher for documentation of various aspects of the application.
62 sub help :Local :Args(1) {
63 my( $self, $c, $topic ) = @_;
64 $c->stash->{template} = "$topic.tt";
67 =head1 Elements of index page
73 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.
77 sub directory :Local :Args(0) {
79 my $m = $c->model('Directory');
80 # Is someone logged in?
82 if( $c->user_exists ) {
83 my $user = $c->user->get_object;
84 my @list = $m->traditionlist( $user );
85 map { $usertexts{$_->{id}} = 1 } @list;
86 $c->stash->{usertexts} = \@list;
87 $c->stash->{is_admin} = 1 if $user->is_admin;
89 # List public (i.e. readonly) texts separately from any user (i.e.
90 # full access) texts that exist. Admin users therefore have nothing
92 my @plist = grep { !$usertexts{$_->{id}} } $m->traditionlist('public');
93 $c->stash->{publictexts} = \@plist;
94 $c->stash->{template} = 'directory.tt';
97 =head1 AJAX methods for traditions and their properties
103 language: <language>,
107 Creates a new tradition belonging to the logged-in user, with the given name
108 and the collation given in the uploaded file. The file type is indicated via
109 the filename extension (.csv, .txt, .xls, .xlsx, .xml). Returns the ID and
110 name of the new tradition.
114 sub newtradition :Local :Args(0) {
115 my( $self, $c ) = @_;
116 return _json_error( $c, 403, 'Cannot save a tradition without being logged in' )
117 unless $c->user_exists;
119 my $user = $c->user->get_object;
120 # Grab the file upload, check its name/extension, and call the
121 # appropriate parser(s).
122 my $upload = $c->request->upload('file');
123 my $name = $c->request->param('name') || 'Uploaded tradition';
124 my $lang = $c->request->param( 'language' ) || 'Default';
125 my $public = $c->request->param( 'public' ) ? 1 : undef;
126 my( $ext ) = $upload->filename =~ /\.(\w+)$/;
131 'file' => $upload->tempname
136 if( $ext eq 'xml' ) {
138 # Parse the XML to see which flavor it is.
139 my $parser = XML::LibXML->new();
142 $doc = $parser->parse_file( $newopts{'file'} );
144 $errmsg = "XML file parsing error: $err";
147 if( $doc->documentElement->nodeName eq 'graphml' ) {
149 } elsif( $doc->documentElement->nodeName ne 'TEI' ) {
150 $errmsg = 'Unrecognized XML type ' . $doc->documentElement->nodeName;
152 my $xpc = XML::LibXML::XPathContext->new( $doc->documentElement );
153 my $venc = $xpc->findvalue( '/TEI/teiHeader/encodingDesc/variantEncoding/attribute::method' );
154 if( $venc && $venc eq 'double-end-point' ) {
161 # Try the relevant XML parsing option.
163 delete $newopts{'file'};
164 $newopts{'xmlobj'} = $doc;
166 $tradition = Text::Tradition->new( %newopts, 'input' => $type );
167 } catch ( Text::Tradition::Error $e ) {
168 $errmsg = $e->message;
170 $errmsg = "Unexpected parsing error: $e";
173 } elsif( $ext =~ /^(txt|csv|xls(x)?)$/ ) {
174 # If it's Excel we need to pass excel => $ext;
175 # otherwise we need to pass sep_char => [record separator].
176 if( $ext =~ /xls/ ) {
177 $newopts{'excel'} = $ext;
179 $newopts{'sep_char'} = $ext eq 'txt' ? "\t" : ',';
182 $tradition = Text::Tradition->new(
184 'input' => 'Tabular',
186 } catch ( Text::Tradition::Error $e ) {
187 $errmsg = $e->message;
189 $errmsg = "Unexpected parsing error: $e";
192 # Error unless we have a recognized filename extension
193 return _json_error( $c, 403, "Unrecognized file type extension $ext" );
196 # Save the tradition if we have it, and return its data or else the
197 # error that occurred trying to make it.
199 return _json_error( $c, 500, "Error parsing tradition .$ext file: $errmsg" );
200 } elsif( !$tradition ) {
201 return _json_error( $c, 500, "No error caught but tradition not created" );
204 my $m = $c->model('Directory');
205 $user->add_tradition( $tradition );
206 my $id = $c->model('Directory')->store( $tradition );
207 $c->model('Directory')->store( $user );
208 $c->stash->{'result'} = { 'id' => $id, 'name' => $tradition->name };
209 $c->forward('View::JSON');
214 GET /textinfo/$textid
215 POST /textinfo/$textid,
217 language: $new_language,
219 owner: $new_userid } # only admin users can update the owner
221 Returns information about a particular text.
225 sub textinfo :Local :Args(1) {
226 my( $self, $c, $textid ) = @_;
227 my $tradition = $c->model('Directory')->tradition( $textid );
228 ## Have to keep users in the same scope as tradition
231 unless( $tradition ) {
232 return _json_error( $c, 404, "No tradition with ID $textid" );
234 my $ok = _check_permission( $c, $tradition );
236 if( $c->req->method eq 'POST' ) {
237 return _json_error( $c, 403,
238 'You do not have permission to update this tradition' )
239 unless $ok eq 'full';
240 my $params = $c->request->parameters;
241 # Handle changes to owner-accessible parameters
242 my $m = $c->model('Directory');
244 # Handle name param - easy
245 if( exists $params->{name} ) {
246 my $newname = delete $params->{name};
247 unless( $tradition->name eq $newname ) {
249 $tradition->name( $newname );
252 return _json_error( $c, 500, "Error setting name to $newname: $@" );
256 # Handle language param, making Default => null
257 my $langval = delete $params->{language} || 'Default';
259 unless( $tradition->language eq $langval || !$tradition->can('language') ) {
261 $tradition->language( $langval );
264 return _json_error( $c, 500, "Error setting language to $langval: $@" );
269 my $ispublic = $tradition->public;
270 if( delete $params->{'public'} ) { # if it's any true value...
271 $tradition->public( 1 );
272 $changed = 1 unless $ispublic;
273 } else { # the checkbox was unchecked, ergo it should not be public
274 $tradition->public( 0 );
275 $changed = 1 if $ispublic;
278 # Handle ownership change
279 if( exists $params->{'owner'} ) {
280 # Only admins can update user / owner
281 my $newownerid = delete $params->{'owner'};
282 if( $tradition->has_user && !$tradition->user ) {
283 $tradition->clear_user;
285 unless( !$newownerid ||
286 ( $tradition->has_user && $tradition->user->email eq $newownerid ) ) {
287 unless( $c->user->get_object->is_admin ) {
288 return _json_error( $c, 403,
289 "Only admin users can change tradition ownership" );
291 $newuser = $m->find_user({ email => $newownerid });
293 return _json_error( $c, 500, "No such user " . $newownerid );
295 if( $tradition->has_user ) {
296 $olduser = $tradition->user;
297 $olduser->remove_tradition( $tradition );
299 $newuser->add_tradition( $tradition );
303 # TODO check for rogue parameters
304 if( scalar keys %$params ) {
305 my $rogueparams = join( ', ', keys %$params );
306 return _json_error( $c, 403, "Request parameters $rogueparams not recognized" );
308 # If we safely got to the end, then write to the database.
309 $m->save( $tradition ) if $changed;
310 $m->save( $newuser ) if $newuser;
313 # Now return the current textinfo, whether GET or successful POST.
316 name => $tradition->name,
317 public => $tradition->public || 0,
318 owner => $tradition->user ? $tradition->user->email : undef,
319 witnesses => [ map { $_->sigil } $tradition->witnesses ],
320 # TODO Send them all with appropriate parameters so that the
321 # client side can choose what to display.
322 reltypes => [ map { $_->name } grep { !$_->is_weak && $_->is_colocation }
323 $tradition->collation->relationship_types ]
325 ## TODO Make these into callbacks in the other controllers maybe?
326 if( $tradition->can('language') ) {
327 $textinfo->{'language'} = $tradition->language;
329 if( $tradition->can('stemweb_jobid') ) {
330 $textinfo->{'stemweb_jobid'} = $tradition->stemweb_jobid || 0;
332 my @stemmasvg = map { _stemma_info( $_ ) } $tradition->stemmata;
333 $textinfo->{stemmata} = \@stemmasvg;
334 $c->stash->{'result'} = $textinfo;
335 $c->forward('View::JSON');
340 GET /variantgraph/$textid
342 Returns the variant graph for the text specified at $textid, in SVG form.
346 sub variantgraph :Local :Args(1) {
347 my( $self, $c, $textid ) = @_;
348 my $tradition = $c->model('Directory')->tradition( $textid );
349 unless( $tradition ) {
350 return _json_error( $c, 404, "No tradition with ID $textid" );
352 my $ok = _check_permission( $c, $tradition );
355 my $collation = $tradition->collation;
356 $c->stash->{'result'} = $collation->as_svg;
357 $c->forward('View::SVG');
361 my( $stemma, $sid ) = @_;
362 my $ssvg = $stemma->as_svg();
365 name => $stemma->identifier,
366 directed => _json_bool( !$stemma->is_undirected ),
369 $sinfo->{stemmaid} = $sid;
374 ## TODO Separate stemma manipulation functionality into its own controller.
378 GET /stemma/$textid/$stemmaseq
379 POST /stemma/$textid/$stemmaseq, { 'dot' => $dot_string }
381 Returns an SVG representation of the given stemma hypothesis for the text.
382 If the URL is called with POST, the stemma at $stemmaseq will be altered
383 to reflect the definition in $dot_string. If $stemmaseq is 'n', a new
384 stemma will be added.
388 sub stemma :Local :Args(2) {
389 my( $self, $c, $textid, $stemmaid ) = @_;
390 my $m = $c->model('Directory');
391 my $tradition = $m->tradition( $textid );
392 unless( $tradition ) {
393 return _json_error( $c, 404, "No tradition with ID $textid" );
395 my $ok = _check_permission( $c, $tradition );
398 $c->stash->{'result'} = '';
400 if( $c->req->method eq 'POST' ) {
401 if( $ok eq 'full' ) {
402 my $dot = $c->request->body_params->{'dot'};
404 if( $stemmaid eq 'n' ) {
405 # We are adding a new stemma.
406 $stemmaid = $tradition->stemma_count;
407 $stemma = $tradition->add_stemma( 'dot' => $dot );
408 } elsif( $stemmaid !~ /^\d+$/ ) {
409 return _json_error( $c, 403, "Invalid stemma ID specification $stemmaid" );
410 } elsif( $stemmaid < $tradition->stemma_count ) {
411 # We are updating an existing stemma.
412 $stemma = $tradition->stemma( $stemmaid );
413 $stemma->alter_graph( $dot );
415 # Unrecognized stemma ID
416 return _json_error( $c, 404, "No stemma at index $stemmaid, cannot update" );
418 } catch ( Text::Tradition::Error $e ) {
419 return _json_error( $c, 500, $e->message );
421 $m->store( $tradition );
423 # No permissions to update the stemma
424 return _json_error( $c, 403,
425 'You do not have permission to update stemmata for this tradition' );
429 # For a GET or a successful POST request, return the SVG representation
430 # of the stemma in question, if any.
431 if( !$stemma && $tradition->stemma_count > $stemmaid ) {
432 $stemma = $tradition->stemma( $stemmaid );
434 # What was requested, XML or JSON?
435 my $return_view = 'SVG';
436 if( my $accept_header = $c->req->header('Accept') ) {
437 $c->log->debug( "Received Accept header: $accept_header" );
438 foreach my $type ( split( /,\s*/, $accept_header ) ) {
439 # If we were first asked for XML, return SVG
440 last if $type =~ /^(application|text)\/xml$/;
441 # If we were first asked for JSON, return JSON
442 if( $type eq 'application/json' ) {
443 $return_view = 'JSON';
448 if( $return_view eq 'SVG' ) {
449 $c->stash->{'result'} = $stemma->as_svg();
450 $c->forward('View::SVG');
452 $c->stash->{'result'} = _stemma_info( $stemma, $stemmaid );
453 $c->forward('View::JSON');
459 GET /stemmadot/$textid/$stemmaseq
461 Returns the 'dot' format representation of the current stemma hypothesis.
465 sub stemmadot :Local :Args(2) {
466 my( $self, $c, $textid, $stemmaid ) = @_;
467 my $m = $c->model('Directory');
468 my $tradition = $m->tradition( $textid );
469 unless( $tradition ) {
470 return _json_error( $c, 404, "No tradition with ID $textid" );
472 my $ok = _check_permission( $c, $tradition );
474 my $stemma = $tradition->stemma( $stemmaid );
476 return _json_error( $c, 404, "Tradition $textid has no stemma ID $stemmaid" );
478 # Get the dot and transmute its line breaks to literal '|n'
479 $c->stash->{'result'} = { 'dot' => $stemma->editable( { linesep => '|n' } ) };
480 $c->forward('View::JSON');
485 POST /stemmaroot/$textid/$stemmaseq, { root: <root node ID> }
487 Orients the given stemma so that the given node is the root (archetype). Returns the
488 information structure for the new stemma.
492 sub stemmaroot :Local :Args(2) {
493 my( $self, $c, $textid, $stemmaid ) = @_;
494 my $m = $c->model('Directory');
495 my $tradition = $m->tradition( $textid );
496 unless( $tradition ) {
497 return _json_error( $c, 404, "No tradition with ID $textid" );
499 my $ok = _check_permission( $c, $tradition );
500 if( $ok eq 'full' ) {
501 my $stemma = $tradition->stemma( $stemmaid );
503 $stemma->root_graph( $c->req->param('root') );
504 $m->save( $tradition );
505 } catch( Text::Tradition::Error $e ) {
506 return _json_error( $c, 400, $e->message );
508 return _json_error( $c, 500, "Error re-rooting stemma: $@" );
510 $c->stash->{'result'} = _stemma_info( $stemma );
511 $c->forward('View::JSON');
513 return _json_error( $c, 403,
514 'You do not have permission to update stemmata for this tradition' );
520 GET /download/$textid/$format
522 Returns a file for download of the tradition in the requested format.
526 sub download :Local :Args(2) {
527 my( $self, $c, $textid, $format ) = @_;
528 my $tradition = $c->model('Directory')->tradition( $textid );
529 unless( $tradition ) {
530 return _json_error( $c, 404, "No tradition with ID $textid" );
532 my $ok = _check_permission( $c, $tradition );
535 my $outmethod = "as_" . lc( $format );
536 my $view = "View::$format";
537 $c->stash->{'name'} = $tradition->name();
538 $c->stash->{'download'} = 1;
540 if( $format eq 'SVG' ) {
541 # Send the list of colors through to the backend.
542 # TODO Think of some way not to hard-code this.
543 push( @outputargs, { 'show_relations' => 'all',
544 'graphcolors' => [ "#5CCCCC", "#67E667", "#F9FE72", "#6B90D4",
545 "#FF7673", "#E467B3", "#AA67D5", "#8370D8", "#FFC173" ] } );
548 $c->stash->{'result'} = $tradition->collation->$outmethod( @outputargs );
549 } catch( Text::Tradition::Error $e ) {
550 return _json_error( $c, 500, $e->message );
552 $c->forward( $view );
559 # Helper to check what permission, if any, the active user has for
560 # the given tradition
561 sub _check_permission {
562 my( $c, $tradition ) = @_;
563 my $user = $c->user_exists ? $c->user->get_object : undef;
565 return 'full' if ( $user->is_admin ||
566 ( $tradition->has_user && $tradition->user->id eq $user->id ) );
568 # Text doesn't belong to us, so maybe it's public?
569 return 'readonly' if $tradition->public;
571 # ...nope. Forbidden!
572 return _json_error( $c, 403, 'You do not have permission to view this tradition.' );
575 # Helper to throw a JSON exception
577 my( $c, $code, $errmsg ) = @_;
578 $c->response->status( $code );
579 $c->stash->{'result'} = { 'error' => $errmsg };
580 $c->forward('View::JSON');
585 return $_[0] ? JSON::true : JSON::false;
590 Standard 404 error page
595 my ( $self, $c ) = @_;
596 $c->response->body( 'Page not found' );
597 $c->response->status(404);
602 Attempt to render a view, if needed.
606 sub end : ActionClass('RenderView') {}
614 This library is free software. You can redistribute it and/or modify
615 it under the same terms as Perl itself.
619 __PACKAGE__->meta->make_immutable;