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';
43 =head1 Elements of index page
49 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.
53 sub directory :Local :Args(0) {
55 my $m = $c->model('Directory');
56 # Is someone logged in?
58 if( $c->user_exists ) {
59 my $user = $c->user->get_object;
60 my @list = $m->traditionlist( $user );
61 map { $usertexts{$_->{id}} = 1 } @list;
62 $c->stash->{usertexts} = \@list;
63 $c->stash->{is_admin} = 1 if $user->is_admin;
65 # List public (i.e. readonly) texts separately from any user (i.e.
66 # full access) texts that exist. Admin users therefore have nothing
68 my @plist = grep { !$usertexts{$_->{id}} } $m->traditionlist('public');
69 $c->stash->{publictexts} = \@plist;
70 $c->stash->{template} = 'directory.tt';
73 =head1 AJAX methods for traditions and their properties
83 Creates a new tradition belonging to the logged-in user, with the given name
84 and the collation given in the uploaded file. The file type is indicated via
85 the filename extension (.csv, .txt, .xls, .xlsx, .xml). Returns the ID and
86 name of the new tradition.
90 sub newtradition :Local :Args(0) {
92 return _json_error( $c, 403, 'Cannot save a tradition without being logged in' )
93 unless $c->user_exists;
95 my $user = $c->user->get_object;
96 # Grab the file upload, check its name/extension, and call the
97 # appropriate parser(s).
98 my $upload = $c->request->upload('file');
99 my $name = $c->request->param('name') || 'Uploaded tradition';
100 my $lang = $c->request->param( 'language' ) || 'Default';
101 my $public = $c->request->param( 'public' ) ? 1 : undef;
102 my( $ext ) = $upload->filename =~ /\.(\w+)$/;
107 'file' => $upload->tempname
112 if( $ext eq 'xml' ) {
113 # Try the different XML parsing options to see if one works.
114 foreach my $type ( qw/ CollateX CTE TEI / ) {
116 $tradition = Text::Tradition->new( %newopts, 'input' => $type );
117 } catch ( Text::Tradition::Error $e ) {
118 $errmsg = $e->message;
120 $errmsg = "Unexpected parsing error";
124 } elsif( $ext =~ /^(txt|csv|xls(x)?)$/ ) {
125 # If it's Excel we need to pass excel => $ext;
126 # otherwise we need to pass sep_char => [record separator].
127 if( $ext =~ /xls/ ) {
128 $newopts{'excel'} = $ext;
130 $newopts{'sep_char'} = $ext eq 'txt' ? "\t" : ',';
133 $tradition = Text::Tradition->new(
135 'input' => 'Tabular',
137 } catch ( Text::Tradition::Error $e ) {
138 $errmsg = $e->message;
140 $errmsg = "Unexpected parsing error";
143 # Error unless we have a recognized filename extension
144 return _json_error( $c, 500, "Unrecognized file type extension $ext" );
147 # Save the tradition if we have it, and return its data or else the
148 # error that occurred trying to make it.
150 return _json_error( $c, 500, "Error parsing tradition .$ext file: $errmsg" );
151 } elsif( !$tradition ) {
152 return _json_error( $c, 500, "No error caught but tradition not created" );
155 my $m = $c->model('Directory');
156 $user->add_tradition( $tradition );
157 my $id = $c->model('Directory')->store( $tradition );
158 $c->model('Directory')->store( $user );
159 $c->stash->{'result'} = { 'id' => $id, 'name' => $tradition->name };
160 $c->forward('View::JSON');
165 GET /textinfo/$textid
166 POST /textinfo/$textid,
168 language: $new_language,
170 owner: $new_userid } # only admin users can update the owner
172 Returns information about a particular text.
176 sub textinfo :Local :Args(1) {
177 my( $self, $c, $textid ) = @_;
178 my $tradition = $c->model('Directory')->tradition( $textid );
179 unless( $tradition ) {
180 return _json_error( $c, 500, "No tradition with ID $textid" );
182 my $ok = _check_permission( $c, $tradition );
184 if( $c->req->method eq 'POST' ) {
185 return _json_error( $c, 403,
186 'You do not have permission to update this tradition' )
187 unless $ok eq 'full';
188 my $params = $c->request->parameters;
189 # Handle changes to owner-accessible parameters
190 my $m = $c->model('Directory');
192 # Handle name param - easy
193 if( exists $params->{name} ) {
194 my $newname = delete $params->{name};
195 unless( $tradition->name eq $newname ) {
197 $tradition->name( $newname );
200 return _json_error( $c, 500, "Error setting name to $newname" );
204 # Handle language param, making Default => null
205 my $langval = delete $params->{language} || 'Default';
206 unless( $tradition->language eq $langval ) {
208 $tradition->language( $langval );
211 return _json_error( $c, 500, "Error setting language to $langval" );
216 my $ispublic = $tradition->public;
217 if( delete $params->{'public'} ) { # if it's any true value...
218 $tradition->public( 1 );
219 $changed = 1 unless $ispublic;
220 } else { # the checkbox was unchecked, ergo it should not be public
221 $tradition->public( 0 );
222 $changed = 1 if $ispublic;
225 # Handle ownership change
227 if( exists $params->{'owner'} ) {
228 # Only admins can update user / owner
229 my $newownerid = delete $params->{'owner'};
230 unless( !$newownerid ||
231 ( $tradition->has_user && $tradition->user->id eq $newownerid ) ) {
232 unless( $c->user->get_object->is_admin ) {
233 return _json_error( $c, 403,
234 "Only admin users can change tradition ownership" );
236 $newuser = $m->find_user({ username => $newownerid });
238 return _json_error( $c, 500, "No such user " . $newownerid );
240 $newuser->add_tradition( $tradition );
244 # TODO check for rogue parameters
245 if( scalar keys %$params ) {
246 my $rogueparams = join( ', ', keys %$params );
247 return _json_error( $c, 403, "Request parameters $rogueparams not recognized" );
249 # If we safely got to the end, then write to the database.
250 $m->save( $tradition ) if $changed;
251 $m->save( $newuser ) if $newuser;
254 # Now return the current textinfo, whether GET or successful POST.
257 name => $tradition->name,
258 language => $tradition->language,
259 public => $tradition->public,
260 owner => $tradition->user ? $tradition->user->id : undef,
261 witnesses => [ map { $_->sigil } $tradition->witnesses ],
263 my @stemmasvg = map { $_->as_svg({ size => [ 500, 375 ] }) } $tradition->stemmata;
264 map { $_ =~ s/\n/ /mg } @stemmasvg;
265 $textinfo->{stemmata} = \@stemmasvg;
266 $c->stash->{'result'} = $textinfo;
267 $c->forward('View::JSON');
272 GET /variantgraph/$textid
274 Returns the variant graph for the text specified at $textid, in SVG form.
278 sub variantgraph :Local :Args(1) {
279 my( $self, $c, $textid ) = @_;
280 my $tradition = $c->model('Directory')->tradition( $textid );
281 unless( $tradition ) {
282 return _json_error( $c, 500, "No tradition with ID $textid" );
284 my $ok = _check_permission( $c, $tradition );
287 my $collation = $tradition->collation;
288 $c->stash->{'result'} = $collation->as_svg;
289 $c->forward('View::SVG');
294 GET /stemma/$textid/$stemmaseq
295 POST /stemma/$textid/$stemmaseq, { 'dot' => $dot_string }
297 Returns an SVG representation of the given stemma hypothesis for the text.
298 If the URL is called with POST, the stemma at $stemmaseq will be altered
299 to reflect the definition in $dot_string. If $stemmaseq is 'n', a new
300 stemma will be added.
304 sub stemma :Local :Args(2) {
305 my( $self, $c, $textid, $stemmaid ) = @_;
306 my $m = $c->model('Directory');
307 my $tradition = $m->tradition( $textid );
308 unless( $tradition ) {
309 return _json_error( $c, 500, "No tradition with ID $textid" );
311 my $ok = _check_permission( $c, $tradition );
314 $c->stash->{'result'} = '';
316 if( $c->req->method eq 'POST' ) {
317 if( $ok eq 'full' ) {
318 my $dot = $c->request->body_params->{'dot'};
320 if( $stemmaid eq 'n' ) {
321 # We are adding a new stemma.
322 $stemma = $tradition->add_stemma( 'dot' => $dot );
323 $stemmaid = $tradition->stemma_count - 1;
324 } elsif( $stemmaid < $tradition->stemma_count ) {
325 # We are updating an existing stemma.
326 $stemma = $tradition->stemma( $stemmaid );
327 $stemma->alter_graph( $dot );
329 # Unrecognized stemma ID
330 return _json_error( $c, 500, "No stemma at index $stemmaid, cannot update" );
332 } catch ( Text::Tradition::Error $e ) {
333 return _json_error( $c, 500, $e->message );
335 $m->store( $tradition );
337 # No permissions to update the stemma
338 return _json_error( $c, 403,
339 'You do not have permission to update stemmata for this tradition' );
343 # For a GET or a successful POST request, return the SVG representation
344 # of the stemma in question, if any.
345 if( !$stemma && $tradition->stemma_count > $stemmaid ) {
346 $stemma = $tradition->stemma( $stemmaid );
348 my $stemma_xml = $stemma ? $stemma->as_svg( { size => [ 500, 375 ] } ) : '';
349 # What was requested, XML or JSON?
350 my $return_view = 'SVG';
351 if( my $accept_header = $c->req->header('Accept') ) {
352 $c->log->debug( "Received Accept header: $accept_header" );
353 foreach my $type ( split( /,\s*/, $accept_header ) ) {
354 # If we were first asked for XML, return SVG
355 last if $type =~ /^(application|text)\/xml$/;
356 # If we were first asked for JSON, return JSON
357 if( $type eq 'application/json' ) {
358 $return_view = 'JSON';
363 if( $return_view eq 'SVG' ) {
364 $c->stash->{'result'} = $stemma_xml;
365 $c->forward('View::SVG');
367 $stemma_xml =~ s/\n/ /mg;
368 $c->stash->{'result'} = { 'stemmaid' => $stemmaid, 'stemmasvg' => $stemma_xml };
369 $c->forward('View::JSON');
375 GET /stemmadot/$textid/$stemmaseq
377 Returns the 'dot' format representation of the current stemma hypothesis.
381 sub stemmadot :Local :Args(2) {
382 my( $self, $c, $textid, $stemmaid ) = @_;
383 my $m = $c->model('Directory');
384 my $tradition = $m->tradition( $textid );
385 unless( $tradition ) {
386 return _json_error( $c, 500, "No tradition with ID $textid" );
388 my $ok = _check_permission( $c, $tradition );
390 my $stemma = $tradition->stemma( $stemmaid );
392 return _json_error( $c, 500, "Tradition $textid has no stemma ID $stemmaid" );
394 # Get the dot and transmute its line breaks to literal '|n'
395 $c->stash->{'result'} = { 'dot' => $stemma->editable( { linesep => '|n' } ) };
396 $c->forward('View::JSON');
403 # Helper to check what permission, if any, the active user has for
404 # the given tradition
405 sub _check_permission {
406 my( $c, $tradition ) = @_;
407 my $user = $c->user_exists ? $c->user->get_object : undef;
409 return 'full' if ( $user->is_admin ||
410 ( $tradition->has_user && $tradition->user->id eq $user->id ) );
412 # Text doesn't belong to us, so maybe it's public?
413 return 'readonly' if $tradition->public;
415 # ...nope. Forbidden!
416 return _json_error( $c, 403, 'You do not have permission to view this tradition.' );
419 # Helper to throw a JSON exception
421 my( $c, $code, $errmsg ) = @_;
422 $c->response->status( $code );
423 $c->stash->{'result'} = { 'error' => $errmsg };
424 $c->forward('View::JSON');
430 Standard 404 error page
435 my ( $self, $c ) = @_;
436 $c->response->body( 'Page not found' );
437 $c->response->status(404);
442 Attempt to render a view, if needed.
446 sub end : ActionClass('RenderView') {}
454 This library is free software. You can redistribute it and/or modify
455 it under the same terms as Perl itself.
459 __PACKAGE__->meta->make_immutable;