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 $c->stash->{template} = 'index.tt';
39 =head1 Elements of index page
45 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.
49 sub directory :Local :Args(0) {
51 my $m = $c->model('Directory');
52 # Is someone logged in?
54 if( $c->user_exists ) {
55 my $user = $c->user->get_object;
56 my @list = $m->traditionlist( $user );
57 map { $usertexts{$_->{id}} = 1 } @list;
58 $c->stash->{usertexts} = \@list;
59 $c->stash->{is_admin} = 1 if $user->is_admin;
61 # List public (i.e. readonly) texts separately from any user (i.e.
62 # full access) texts that exist. Admin users therefore have nothing
64 my @plist = grep { !$usertexts{$_->{id}} } $m->traditionlist('public');
65 $c->stash->{publictexts} = \@plist;
66 $c->stash->{template} = 'directory.tt';
69 =head1 AJAX methods for traditions and their properties
79 Creates a new tradition belonging to the logged-in user, with the given name
80 and the collation given in the uploaded file. The file type is indicated via
81 the filename extension (.csv, .txt, .xls, .xlsx, .xml). Returns the ID and
82 name of the new tradition.
86 sub newtradition :Local :Args(0) {
88 return _json_error( $c, 403, 'Cannot save a tradition without being logged in' )
89 unless $c->user_exists;
91 my $user = $c->user->get_object;
92 # Grab the file upload, check its name/extension, and call the
93 # appropriate parser(s).
94 my $upload = $c->request->upload('file');
95 my $name = $c->request->param('name') || 'Uploaded tradition';
96 my $lang = $c->request->param( 'language' ) || 'Default';
97 my $public = $c->request->param( 'public' ) ? 1 : undef;
98 my( $ext ) = $upload->filename =~ /\.(\w+)$/;
103 'file' => $upload->tempname
108 if( $ext eq 'xml' ) {
109 # Try the different XML parsing options to see if one works.
110 foreach my $type ( qw/ CollateX CTE TEI / ) {
112 $tradition = Text::Tradition->new( %newopts, 'input' => $type );
113 } catch ( Text::Tradition::Error $e ) {
114 $errmsg = $e->message;
116 $errmsg = "Unexpected parsing error";
120 } elsif( $ext =~ /^(txt|csv|xls(x)?)$/ ) {
121 # If it's Excel we need to pass excel => $ext;
122 # otherwise we need to pass sep_char => [record separator].
123 if( $ext =~ /xls/ ) {
124 $newopts{'excel'} = $ext;
126 $newopts{'sep_char'} = $ext eq 'txt' ? "\t" : ',';
129 $tradition = Text::Tradition->new(
131 'input' => 'Tabular',
133 } catch ( Text::Tradition::Error $e ) {
134 $errmsg = $e->message;
136 $errmsg = "Unexpected parsing error";
139 # Error unless we have a recognized filename extension
140 return _json_error( $c, 500, "Unrecognized file type extension $ext" );
143 # Save the tradition if we have it, and return its data or else the
144 # error that occurred trying to make it.
146 return _json_error( $c, 500, "Error parsing tradition .$ext file: $errmsg" );
147 } elsif( !$tradition ) {
148 return _json_error( $c, 500, "No error caught but tradition not created" );
151 my $m = $c->model('Directory');
152 $user->add_tradition( $tradition );
153 my $id = $c->model('Directory')->store( $tradition );
154 $c->model('Directory')->store( $user );
155 $c->stash->{'result'} = { 'id' => $id, 'name' => $tradition->name };
156 $c->forward('View::JSON');
161 GET /textinfo/$textid
162 POST /textinfo/$textid,
164 language: $new_language,
166 owner: $new_userid } # only admin users can update the owner
168 Returns information about a particular text.
172 sub textinfo :Local :Args(1) {
173 my( $self, $c, $textid ) = @_;
174 my $tradition = $c->model('Directory')->tradition( $textid );
175 unless( $tradition ) {
176 return _json_error( $c, 500, "No tradition with ID $textid" );
178 my $ok = _check_permission( $c, $tradition );
180 if( $c->req->method eq 'POST' ) {
181 return _json_error( $c, 403,
182 'You do not have permission to update this tradition' )
183 unless $ok eq 'full';
184 my $params = $c->request->parameters;
185 # Handle changes to owner-accessible parameters
186 my $m = $c->model('Directory');
188 # Handle name param - easy
189 if( exists $params->{name} ) {
190 my $newname = delete $params->{name};
191 unless( $tradition->name eq $newname ) {
193 $tradition->name( $newname );
196 return _json_error( $c, 500, "Error setting name to $newname" );
200 # Handle language param, making Default => null
201 my $langval = delete $params->{language} || 'Default';
202 unless( $tradition->language eq $langval ) {
204 $tradition->language( $langval );
207 return _json_error( $c, 500, "Error setting language to $langval" );
212 my $ispublic = $tradition->public;
213 if( delete $params->{'public'} ) { # if it's any true value...
214 $tradition->public( 1 );
215 $changed = 1 unless $ispublic;
216 } else { # the checkbox was unchecked, ergo it should not be public
217 $tradition->public( 0 );
218 $changed = 1 if $ispublic;
221 # Handle ownership change
223 if( exists $params->{'owner'} ) {
224 # Only admins can update user / owner
225 my $newownerid = delete $params->{'owner'};
226 unless( !$newownerid ||
227 ( $tradition->has_user && $tradition->user->id eq $newownerid ) ) {
228 unless( $c->user->get_object->is_admin ) {
229 return _json_error( $c, 403,
230 "Only admin users can change tradition ownership" );
232 $newuser = $m->find_user({ username => $newownerid });
234 return _json_error( $c, 500, "No such user " . $newownerid );
236 $newuser->add_tradition( $tradition );
240 # TODO check for rogue parameters
241 if( scalar keys %$params ) {
242 my $rogueparams = join( ', ', keys %$params );
243 return _json_error( $c, 403, "Request parameters $rogueparams not recognized" );
245 # If we safely got to the end, then write to the database.
246 $m->save( $tradition ) if $changed;
247 $m->save( $newuser ) if $newuser;
250 # Now return the current textinfo, whether GET or successful POST.
253 name => $tradition->name,
254 language => $tradition->language,
255 public => $tradition->public,
256 owner => $tradition->user ? $tradition->user->id : undef,
257 witnesses => [ map { $_->sigil } $tradition->witnesses ],
259 my @stemmasvg = map { $_->as_svg({ size => [ 500, 375 ] }) } $tradition->stemmata;
260 map { $_ =~ s/\n/ /mg } @stemmasvg;
261 $textinfo->{stemmata} = \@stemmasvg;
262 $c->stash->{'result'} = $textinfo;
263 $c->forward('View::JSON');
268 GET /variantgraph/$textid
270 Returns the variant graph for the text specified at $textid, in SVG form.
274 sub variantgraph :Local :Args(1) {
275 my( $self, $c, $textid ) = @_;
276 my $tradition = $c->model('Directory')->tradition( $textid );
277 unless( $tradition ) {
278 return _json_error( $c, 500, "No tradition with ID $textid" );
280 my $ok = _check_permission( $c, $tradition );
283 my $collation = $tradition->collation;
284 $c->stash->{'result'} = $collation->as_svg;
285 $c->forward('View::SVG');
290 GET /stemma/$textid/$stemmaseq
291 POST /stemma/$textid/$stemmaseq, { 'dot' => $dot_string }
293 Returns an SVG representation of the given stemma hypothesis for the text.
294 If the URL is called with POST, the stemma at $stemmaseq will be altered
295 to reflect the definition in $dot_string. If $stemmaseq is 'n', a new
296 stemma will be added.
300 sub stemma :Local :Args(2) {
301 my( $self, $c, $textid, $stemmaid ) = @_;
302 my $m = $c->model('Directory');
303 my $tradition = $m->tradition( $textid );
304 unless( $tradition ) {
305 return _json_error( $c, 500, "No tradition with ID $textid" );
307 my $ok = _check_permission( $c, $tradition );
310 $c->stash->{'result'} = '';
312 if( $c->req->method eq 'POST' ) {
313 if( $ok eq 'full' ) {
314 my $dot = $c->request->body_params->{'dot'};
316 if( $stemmaid eq 'n' ) {
317 # We are adding a new stemma.
318 $stemma = $tradition->add_stemma( 'dot' => $dot );
319 $stemmaid = $tradition->stemma_count - 1;
320 } elsif( $stemmaid < $tradition->stemma_count ) {
321 # We are updating an existing stemma.
322 $stemma = $tradition->stemma( $stemmaid );
323 $stemma->alter_graph( $dot );
325 # Unrecognized stemma ID
326 return _json_error( $c, 500, "No stemma at index $stemmaid, cannot update" );
328 } catch ( Text::Tradition::Error $e ) {
329 return _json_error( $c, 500, $e->message );
331 $m->store( $tradition );
333 # No permissions to update the stemma
334 return _json_error( $c, 403,
335 'You do not have permission to update stemmata for this tradition' );
339 # For a GET or a successful POST request, return the SVG representation
340 # of the stemma in question, if any.
341 if( !$stemma && $tradition->stemma_count > $stemmaid ) {
342 $stemma = $tradition->stemma( $stemmaid );
344 my $stemma_xml = $stemma ? $stemma->as_svg( { size => [ 500, 375 ] } ) : '';
345 # What was requested, XML or JSON?
346 my $return_view = 'SVG';
347 if( my $accept_header = $c->req->header('Accept') ) {
348 $c->log->debug( "Received Accept header: $accept_header" );
349 foreach my $type ( split( /,\s*/, $accept_header ) ) {
350 # If we were first asked for XML, return SVG
351 last if $type =~ /^(application|text)\/xml$/;
352 # If we were first asked for JSON, return JSON
353 if( $type eq 'application/json' ) {
354 $return_view = 'JSON';
359 if( $return_view eq 'SVG' ) {
360 $c->stash->{'result'} = $stemma_xml;
361 $c->forward('View::SVG');
363 $stemma_xml =~ s/\n/ /mg;
364 $c->stash->{'result'} = { 'stemmaid' => $stemmaid, 'stemmasvg' => $stemma_xml };
365 $c->forward('View::JSON');
371 GET /stemmadot/$textid/$stemmaseq
373 Returns the 'dot' format representation of the current stemma hypothesis.
377 sub stemmadot :Local :Args(2) {
378 my( $self, $c, $textid, $stemmaid ) = @_;
379 my $m = $c->model('Directory');
380 my $tradition = $m->tradition( $textid );
381 unless( $tradition ) {
382 return _json_error( $c, 500, "No tradition with ID $textid" );
384 my $ok = _check_permission( $c, $tradition );
386 my $stemma = $tradition->stemma( $stemmaid );
388 return _json_error( $c, 500, "Tradition $textid has no stemma ID $stemmaid" );
390 # Get the dot and transmute its line breaks to literal '|n'
391 $c->stash->{'result'} = { 'dot' => $stemma->editable( { linesep => '|n' } ) };
392 $c->forward('View::JSON');
399 # Helper to check what permission, if any, the active user has for
400 # the given tradition
401 sub _check_permission {
402 my( $c, $tradition ) = @_;
403 my $user = $c->user_exists ? $c->user->get_object : undef;
405 return 'full' if ( $user->is_admin ||
406 ( $tradition->has_user && $tradition->user->id eq $user->id ) );
408 # Text doesn't belong to us, so maybe it's public?
409 return 'readonly' if $tradition->public;
411 # ...nope. Forbidden!
412 return _json_error( $c, 403, 'You do not have permission to view this tradition.' );
415 # Helper to throw a JSON exception
417 my( $c, $code, $errmsg ) = @_;
418 $c->response->status( $code );
419 $c->stash->{'result'} = { 'error' => $errmsg };
420 $c->forward('View::JSON');
426 Standard 404 error page
431 my ( $self, $c ) = @_;
432 $c->response->body( 'Page not found' );
433 $c->response->status(404);
438 Attempt to render a view, if needed.
442 sub end : ActionClass('RenderView') {}
450 This library is free software. You can redistribute it and/or modify
451 it under the same terms as Perl itself.
455 __PACKAGE__->meta->make_immutable;