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';
71 GET /variantgraph/$textid
73 Returns the variant graph for the text specified at $textid, in SVG form.
77 sub variantgraph :Local :Args(1) {
78 my( $self, $c, $textid ) = @_;
79 my $tradition = $c->model('Directory')->tradition( $textid );
80 my $ok = _check_permission( $c, $tradition );
83 my $collation = $tradition->collation;
84 $c->stash->{'result'} = $collation->as_svg;
85 $c->forward('View::SVG');
90 GET /alignment/$textid
92 Returns an alignment table for the text specified at $textid.
96 sub alignment :Local :Args(1) {
97 my( $self, $c, $textid ) = @_;
98 my $tradition = $c->model('Directory')->tradition( $textid );
99 my $ok = _check_permission( $c, $tradition );
102 my $collation = $tradition->collation;
103 my $alignment = $collation->alignment_table;
105 # Turn the table, so that witnesses are by column and the rows
107 my $wits = [ map { $_->{'witness'} } @{$alignment->{'alignment'}} ];
109 foreach my $i ( 0 .. $alignment->{'length'} - 1 ) {
110 my @rankrdgs = map { $_->{'tokens'}->[$i]->{'t'} }
111 @{$alignment->{'alignment'}};
112 push( @$rows, { 'rank' => $i+1, 'readings' => \@rankrdgs } );
114 $c->stash->{'witnesses'} = $wits;
115 $c->stash->{'table'} = $rows;
116 $c->stash->{'template'} = 'alignment.tt';
121 GET /stemma/$textid/$stemmaid
122 POST /stemma/$textid, { 'dot' => $dot_string }
124 Returns an SVG representation of the stemma hypothesis for the text. If
125 the URL is called with POST and a new dot string, updates the stemma and
126 returns the SVG as with GET.
130 sub stemma :Local :Args {
131 my( $self, $c, $textid, $stemmaid ) = @_;
132 my $m = $c->model('Directory');
133 my $tradition = $m->tradition( $textid );
134 my $ok = _check_permission( $c, $tradition );
137 $stemmaid = 0 unless defined $stemmaid;
138 $c->stash->{'result'} = '';
140 if( $c->req->method eq 'POST' ) {
142 my $dot = $c->request->body_params->{'dot'};
143 $tradition->add_stemma( $dot );
144 $m->store( $tradition );
145 $stemmaid = scalar( $tradition->stemma_count ) - 1;
148 $c->stash->{'result'} = $tradition->stemma_count > $stemmaid
149 ? $tradition->stemma( $stemmaid )->as_svg( { size => [ 500, 375 ] } )
152 $c->forward('View::SVG');
157 GET /stemmadot/$textid
159 Returns the 'dot' format representation of the current stemma hypothesis.
163 sub stemmadot :Local :Args(1) {
164 my( $self, $c, $textid ) = @_;
165 my $m = $c->model('Directory');
166 my $tradition = $m->tradition( $textid );
167 my $ok = _check_permission( $c, $tradition );
170 $c->response->body( $tradition->stemma->editable );
171 $c->forward('View::Plain');
174 =head1 AJAX methods for index page
178 GET /textinfo/$textid
180 Returns information about a particular text.
184 sub textinfo :Local :Args(1) {
185 my( $self, $c, $textid ) = @_;
186 my $tradition = $c->model('Directory')->tradition( $textid );
187 my $ok = _check_permission( $c, $tradition );
190 # Need text name, witness list, scalar readings, scalar relationships, stemmata
193 traditionname => $tradition->name,
194 witnesses => [ map { $_->sigil } $tradition->witnesses ],
195 readings => scalar $tradition->collation->readings,
196 relationships => scalar $tradition->collation->relationships
198 my @stemmasvg = map { $_->as_svg({ size => [ 500, 375 ] }) } $tradition->stemmata;
199 map { $_ =~ s/\n/ /mg } @stemmasvg;
200 $textinfo->{stemmata} = \@stemmasvg;
201 $c->stash->{'result'} = $textinfo;
202 $c->forward('View::JSON');
205 # TODO alter text parameters
209 POST /newtradition { name: <name>, inputfile: <fileupload> }
211 Creates a new tradition belonging to the logged-in user, according to the detected
212 file type. Returns the ID and name of the new tradition.
216 sub newtradition :Local :Args(0) {
217 my( $self, $c ) = @_;
218 if( $c->user_exists ) {
219 my $user = $c->user->get_object;
220 # Grab the file upload, check its name/extension, and call the
221 # appropriate parser(s).
222 my $upload = $c->request->upload('file');
223 my $name = $c->request->param('name') || 'Uploaded tradition';
224 my( $ext ) = $upload->filename =~ /\.(\w+)$/;
227 'file' => $upload->tempname
231 if( $ext eq 'xml' ) {
232 # Try the different XML parsing options to see if one works.
233 foreach my $type ( qw/ CollateX CTE TEI / ) {
235 $tradition = Text::Tradition->new( %newopts, 'input' => $type );
236 } catch ( Text::Tradition::Error $e ) {
237 $errmsg = $e->message;
239 $errmsg = "Unexpected parsing error";
243 } elsif( $ext eq 'txt' || $ext eq 'csv' ) {
244 my $sep_char = $ext eq 'txt' ? "\t" : ',';
246 $tradition = Text::Tradition->new(
248 'input' => 'Tabular',
249 'sep_char' => $sep_char
251 } catch ( Text::Tradition::Error $e ) {
252 $errmsg = $e->message;
254 $errmsg = "Unexpected parsing error";
256 } elsif( $ext =~ /^xls(x)?$/ ) {
257 $c->stash->{'result'} =
258 { 'error' => "Excel parsing not supported yet" };
259 $c->response->status( 500 );
261 # Error unless we have a recognized filename extension
262 $c->stash->{'result'} =
263 { 'error' => "Unrecognized file type extension $ext" };
264 $c->response->status( 500 );
267 # Save the tradition if we have it, and return its data or else the
268 # error that occurred trying to make it.
270 my $m = $c->model('Directory');
271 $user->add_tradition( $tradition );
272 my $id = $c->model('Directory')->store( $tradition );
273 $c->model('Directory')->store( $user );
274 $c->stash->{'result'} = { 'id' => $id, 'name' => $tradition->name };
276 $c->stash->{'result'} =
277 { 'error' => "Error parsing tradition .$ext file: $errmsg" };
278 $c->response->status( 500 );
281 $c->stash->{'result'} =
282 { 'error' => 'Cannot save a tradition without being logged in' };
283 $c->response->status( 403 );
285 $c->forward('View::JSON');
288 sub _check_permission {
289 my( $c, $tradition ) = @_;
290 my $user = $c->user_exists ? $c->user->get_object : undef;
292 return 'full' if ( $user->is_admin ||
293 ( $tradition->has_user && $tradition->user->id eq $user->id ) );
295 # Text doesn't belong to us, so maybe it's public?
296 return 'readonly' if $tradition->public;
298 # ...nope. Forbidden!
299 $c->response->status( 403 );
300 $c->response->body( 'You do not have permission to view this tradition.' );
301 $c->detach( 'View::Plain' );
307 Standard 404 error page
312 my ( $self, $c ) = @_;
313 $c->response->body( 'Page not found' );
314 $c->response->status(404);
319 Attempt to render a view, if needed.
323 sub end : ActionClass('RenderView') {}
331 This library is free software. You can redistribute it and/or modify
332 it under the same terms as Perl itself.
336 __PACKAGE__->meta->make_immutable;