1 package stemmaweb::Controller::Root;
4 use namespace::autoclean;
5 use Text::Tradition::Analysis qw/ run_analysis /;
9 BEGIN { extends 'Catalyst::Controller' }
12 # Sets the actions in this controller to be registered with no prefix
13 # so they function identically to actions created in MyApp.pm
15 __PACKAGE__->config(namespace => '');
19 stemmaweb::Controller::Root - Root Controller for stemmaweb
23 Serves up the main container pages.
29 The root page (/). Serves the main container page, from which the various
30 components will be loaded.
34 sub index :Path :Args(0) {
35 my ( $self, $c ) = @_;
37 # Are we being asked to load a text immediately? If so
38 if( $c->req->param('withtradition') ) {
39 $c->stash->{'withtradition'} = $c->req->param('withtradition');
41 $c->stash->{template} = 'index.tt';
46 A general overview/documentation page for the site.
50 sub about :Local :Args(0) {
52 $c->stash->{template} = 'about.tt';
55 =head1 Elements of index page
61 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.
65 sub directory :Local :Args(0) {
67 my $m = $c->model('Directory');
68 # Is someone logged in?
70 if( $c->user_exists ) {
71 my $user = $c->user->get_object;
72 my @list = $m->traditionlist( $user );
73 map { $usertexts{$_->{id}} = 1 } @list;
74 $c->stash->{usertexts} = \@list;
75 $c->stash->{is_admin} = 1 if $user->is_admin;
77 # List public (i.e. readonly) texts separately from any user (i.e.
78 # full access) texts that exist. Admin users therefore have nothing
80 my @plist = grep { !$usertexts{$_->{id}} } $m->traditionlist('public');
81 $c->stash->{publictexts} = \@plist;
82 $c->stash->{template} = 'directory.tt';
85 =head1 AJAX methods for traditions and their properties
96 Creates a new tradition belonging to the logged-in user, with the given name
97 and the collation given in the uploaded file. The file type is indicated via
98 the filename extension (.csv, .txt, .xls, .xlsx, .xml). Returns the ID and
99 name of the new tradition.
103 ## TODO Figure out how to mimic old-style HTML file uploads in AJAX / HTML5
104 sub newtradition :Local :Args(0) {
105 my( $self, $c ) = @_;
106 return _json_error( $c, 403, 'Cannot save a tradition without being logged in' )
107 unless $c->user_exists;
109 my $user = $c->user->get_object;
110 # Grab the file upload, check its name/extension, and call the
111 # appropriate parser(s).
112 my $upload = File::Temp->new();
113 print $upload $c->request->param('file');
115 my $name = $c->request->param('name') || 'Uploaded tradition';
116 my $lang = $c->request->param( 'language' ) || 'Default';
117 my $public = $c->request->param( 'public' ) ? 1 : undef;
118 my( $ext ) = $c->request->param( 'filename' ) =~ /\.(\w+)$/;
123 'file' => $upload->filename
128 if( $ext eq 'xml' ) {
129 # Try the different XML parsing options to see if one works.
130 foreach my $type ( qw/ CollateX CTE TEI / ) {
132 $tradition = Text::Tradition->new( %newopts, 'input' => $type );
133 } catch ( Text::Tradition::Error $e ) {
134 $errmsg = $e->message;
136 $errmsg = "Unexpected parsing error";
143 } elsif( $ext =~ /^(txt|csv|xls(x)?)$/ ) {
144 # If it's Excel we need to pass excel => $ext;
145 # otherwise we need to pass sep_char => [record separator].
146 if( $ext =~ /xls/ ) {
147 $newopts{'excel'} = $ext;
149 $newopts{'sep_char'} = $ext eq 'txt' ? "\t" : ',';
152 $tradition = Text::Tradition->new(
154 'input' => 'Tabular',
156 } catch ( Text::Tradition::Error $e ) {
157 $errmsg = $e->message;
159 $errmsg = "Unexpected parsing error";
162 # Error unless we have a recognized filename extension
163 return _json_error( $c, 403, "Unrecognized file type extension $ext" );
166 # Save the tradition if we have it, and return its data or else the
167 # error that occurred trying to make it.
169 return _json_error( $c, 500, "Error parsing tradition .$ext file: $errmsg" );
170 } elsif( !$tradition ) {
171 return _json_error( $c, 500, "No error caught but tradition not created" );
174 my $m = $c->model('Directory');
175 $user->add_tradition( $tradition );
176 my $id = $c->model('Directory')->store( $tradition );
177 $c->model('Directory')->store( $user );
178 $c->stash->{'result'} = { 'id' => $id, 'name' => $tradition->name };
179 $c->forward('View::JSON');
184 GET /textinfo/$textid
185 POST /textinfo/$textid,
187 language: $new_language,
189 owner: $new_userid } # only admin users can update the owner
191 Returns information about a particular text.
195 sub textinfo :Local :Args(1) {
196 my( $self, $c, $textid ) = @_;
197 my $tradition = $c->model('Directory')->tradition( $textid );
198 unless( $tradition ) {
199 return _json_error( $c, 404, "No tradition with ID $textid" );
201 my $ok = _check_permission( $c, $tradition );
203 if( $c->req->method eq 'POST' ) {
204 return _json_error( $c, 403,
205 'You do not have permission to update this tradition' )
206 unless $ok eq 'full';
207 my $params = $c->request->parameters;
208 # Handle changes to owner-accessible parameters
209 my $m = $c->model('Directory');
211 # Handle name param - easy
212 if( exists $params->{name} ) {
213 my $newname = delete $params->{name};
214 unless( $tradition->name eq $newname ) {
216 $tradition->name( $newname );
219 return _json_error( $c, 500, "Error setting name to $newname" );
223 # Handle language param, making Default => null
224 my $langval = delete $params->{language} || 'Default';
225 unless( $tradition->language eq $langval ) {
227 $tradition->language( $langval );
230 return _json_error( $c, 500, "Error setting language to $langval" );
235 my $ispublic = $tradition->public;
236 if( delete $params->{'public'} ) { # if it's any true value...
237 $tradition->public( 1 );
238 $changed = 1 unless $ispublic;
239 } else { # the checkbox was unchecked, ergo it should not be public
240 $tradition->public( 0 );
241 $changed = 1 if $ispublic;
244 # Handle ownership change
246 if( exists $params->{'owner'} ) {
247 # Only admins can update user / owner
248 my $newownerid = delete $params->{'owner'};
249 unless( !$newownerid ||
250 ( $tradition->has_user && $tradition->user->id eq $newownerid ) ) {
251 unless( $c->user->get_object->is_admin ) {
252 return _json_error( $c, 403,
253 "Only admin users can change tradition ownership" );
255 $newuser = $m->find_user({ username => $newownerid });
257 return _json_error( $c, 500, "No such user " . $newownerid );
259 $newuser->add_tradition( $tradition );
263 # TODO check for rogue parameters
264 if( scalar keys %$params ) {
265 my $rogueparams = join( ', ', keys %$params );
266 return _json_error( $c, 403, "Request parameters $rogueparams not recognized" );
268 # If we safely got to the end, then write to the database.
269 $m->save( $tradition ) if $changed;
270 $m->save( $newuser ) if $newuser;
273 # Now return the current textinfo, whether GET or successful POST.
276 name => $tradition->name,
277 language => $tradition->language,
278 public => $tradition->public || 0,
279 owner => $tradition->user ? $tradition->user->id : undef,
280 witnesses => [ map { $_->sigil } $tradition->witnesses ],
282 my @stemmasvg = map { $_->as_svg() } $tradition->stemmata;
283 map { $_ =~ s/\n/ /mg } @stemmasvg;
284 $textinfo->{stemmata} = \@stemmasvg;
285 $c->stash->{'result'} = $textinfo;
286 $c->forward('View::JSON');
291 GET /variantgraph/$textid
293 Returns the variant graph for the text specified at $textid, in SVG form.
297 sub variantgraph :Local :Args(1) {
298 my( $self, $c, $textid ) = @_;
299 my $tradition = $c->model('Directory')->tradition( $textid );
300 unless( $tradition ) {
301 return _json_error( $c, 404, "No tradition with ID $textid" );
303 my $ok = _check_permission( $c, $tradition );
306 my $collation = $tradition->collation;
307 $c->stash->{'result'} = $collation->as_svg;
308 $c->forward('View::SVG');
313 GET /stemma/$textid/$stemmaseq
314 POST /stemma/$textid/$stemmaseq, { 'dot' => $dot_string }
316 Returns an SVG representation of the given stemma hypothesis for the text.
317 If the URL is called with POST, the stemma at $stemmaseq will be altered
318 to reflect the definition in $dot_string. If $stemmaseq is 'n', a new
319 stemma will be added.
323 sub stemma :Local :Args(2) {
324 my( $self, $c, $textid, $stemmaid ) = @_;
325 my $m = $c->model('Directory');
326 my $tradition = $m->tradition( $textid );
327 unless( $tradition ) {
328 return _json_error( $c, 404, "No tradition with ID $textid" );
330 my $ok = _check_permission( $c, $tradition );
333 $c->stash->{'result'} = '';
335 if( $c->req->method eq 'POST' ) {
336 if( $ok eq 'full' ) {
337 my $dot = $c->request->body_params->{'dot'};
339 if( $stemmaid eq 'n' ) {
340 # We are adding a new stemma.
341 $stemmaid = $tradition->stemma_count;
342 $stemma = $tradition->add_stemma( 'dot' => $dot );
343 } elsif( $stemmaid !~ /^\d+$/ ) {
344 return _json_error( $c, 403, "Invalid stemma ID specification $stemmaid" );
345 } elsif( $stemmaid < $tradition->stemma_count ) {
346 # We are updating an existing stemma.
347 $stemma = $tradition->stemma( $stemmaid );
348 $stemma->alter_graph( $dot );
350 # Unrecognized stemma ID
351 return _json_error( $c, 404, "No stemma at index $stemmaid, cannot update" );
353 } catch ( Text::Tradition::Error $e ) {
354 return _json_error( $c, 500, $e->message );
356 $m->store( $tradition );
358 # No permissions to update the stemma
359 return _json_error( $c, 403,
360 'You do not have permission to update stemmata for this tradition' );
364 # For a GET or a successful POST request, return the SVG representation
365 # of the stemma in question, if any.
366 if( !$stemma && $tradition->stemma_count > $stemmaid ) {
367 $stemma = $tradition->stemma( $stemmaid );
369 my $stemma_xml = $stemma ? $stemma->as_svg() : '';
370 # What was requested, XML or JSON?
371 my $return_view = 'SVG';
372 if( my $accept_header = $c->req->header('Accept') ) {
373 $c->log->debug( "Received Accept header: $accept_header" );
374 foreach my $type ( split( /,\s*/, $accept_header ) ) {
375 # If we were first asked for XML, return SVG
376 last if $type =~ /^(application|text)\/xml$/;
377 # If we were first asked for JSON, return JSON
378 if( $type eq 'application/json' ) {
379 $return_view = 'JSON';
384 if( $return_view eq 'SVG' ) {
385 $c->stash->{'result'} = $stemma_xml;
386 $c->forward('View::SVG');
388 $stemma_xml =~ s/\n/ /mg;
389 $c->stash->{'result'} = { 'stemmaid' => $stemmaid, 'stemmasvg' => $stemma_xml };
390 $c->forward('View::JSON');
396 GET /stemmadot/$textid/$stemmaseq
398 Returns the 'dot' format representation of the current stemma hypothesis.
402 sub stemmadot :Local :Args(2) {
403 my( $self, $c, $textid, $stemmaid ) = @_;
404 my $m = $c->model('Directory');
405 my $tradition = $m->tradition( $textid );
406 unless( $tradition ) {
407 return _json_error( $c, 404, "No tradition with ID $textid" );
409 my $ok = _check_permission( $c, $tradition );
411 my $stemma = $tradition->stemma( $stemmaid );
413 return _json_error( $c, 404, "Tradition $textid has no stemma ID $stemmaid" );
415 # Get the dot and transmute its line breaks to literal '|n'
416 $c->stash->{'result'} = { 'dot' => $stemma->editable( { linesep => '|n' } ) };
417 $c->forward('View::JSON');
424 # Helper to check what permission, if any, the active user has for
425 # the given tradition
426 sub _check_permission {
427 my( $c, $tradition ) = @_;
428 my $user = $c->user_exists ? $c->user->get_object : undef;
430 return 'full' if ( $user->is_admin ||
431 ( $tradition->has_user && $tradition->user->id eq $user->id ) );
433 # Text doesn't belong to us, so maybe it's public?
434 return 'readonly' if $tradition->public;
436 # ...nope. Forbidden!
437 return _json_error( $c, 403, 'You do not have permission to view this tradition.' );
440 # Helper to throw a JSON exception
442 my( $c, $code, $errmsg ) = @_;
443 $c->response->status( $code );
444 $c->stash->{'result'} = { 'error' => $errmsg };
445 $c->forward('View::JSON');
451 Standard 404 error page
456 my ( $self, $c ) = @_;
457 $c->response->body( 'Page not found' );
458 $c->response->status(404);
463 Attempt to render a view, if needed.
467 sub end : ActionClass('RenderView') {}
475 This library is free software. You can redistribute it and/or modify
476 it under the same terms as Perl itself.
480 __PACKAGE__->meta->make_immutable;