lib/stemmaweb/Controller/Root.pm

   1 package stemmaweb::Controller::Root;
   2 use Moose;
   3 use namespace::autoclean;
   4 use Text::Tradition::Analysis qw/ run_analysis /;
   5 use TryCatch;
   6
   7
   8 BEGIN { extends 'Catalyst::Controller' }
   9
  10 #
  11 # Sets the actions in this controller to be registered with no prefix
  12 # so they function identically to actions created in MyApp.pm
  13 #
  14 __PACKAGE__->config(namespace => '');
  15
  16 =head1 NAME
  17
  18 stemmaweb::Controller::Root - Root Controller for stemmaweb
  19
  20 =head1 DESCRIPTION
  21
  22 Serves up the main container pages.
  23
  24 =head1 URLs
  25
  26 =head2 index
  27
  28 The root page (/).  Serves the main container page, from which the various
  29 components will be loaded.
  30
  31 =cut
  32
  33 sub index :Path :Args(0) {
  34     my ( $self, $c ) = @_;
  35
  36     $c->stash->{template} = 'index.tt';
  37 }
  38
  39 =head1 Elements of index page
  40
  41 =head2 directory
  42
  43  GET /directory
  44
  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.
  46
  47 =cut
  48
  49 sub directory :Local :Args(0) {
  50         my( $self, $c ) = @_;
  51     my $m = $c->model('Directory');
  52     # Is someone logged in?
  53     my %usertexts;
  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;
  60         }
  61         # List public (i.e. readonly) texts separately from any user (i.e.
  62         # full access) texts that exist. Admin users therefore have nothing
  63         # in this list.
  64         my @plist = grep { !$usertexts{$_->{id}} } $m->traditionlist('public');
  65         $c->stash->{publictexts} = \@plist;
  66         $c->stash->{template} = 'directory.tt';
  67 }
  68
  69 =head2 variantgraph
  70
  71  GET /variantgraph/$textid
  72
  73 Returns the variant graph for the text specified at $textid, in SVG form.
  74
  75 =cut
  76
  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 );
  81         return unless $ok;
  82
  83         my $collation = $tradition->collation;
  84         $c->stash->{'result'} = $collation->as_svg;
  85         $c->forward('View::SVG');
  86 }
  87
  88 =head2 alignment
  89
  90  GET /alignment/$textid
  91
  92 Returns an alignment table for the text specified at $textid.
  93
  94 =cut
  95
  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 );
 100         return unless $ok;
 101
 102         my $collation = $tradition->collation;
 103         my $alignment = $collation->alignment_table;
 104
 105         # Turn the table, so that witnesses are by column and the rows
 106         # are by rank.
 107         my $wits = [ map { $_->{'witness'} } @{$alignment->{'alignment'}} ];
 108         my $rows;
 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 } );
 113         }
 114         $c->stash->{'witnesses'} = $wits;
 115         $c->stash->{'table'} = $rows;
 116         $c->stash->{'template'} = 'alignment.tt';
 117 }
 118
 119 =head2 stemma
 120
 121  GET /stemma/$textid/$stemmaid
 122  POST /stemma/$textid, { 'dot' => $dot_string }
 123
 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.
 127
 128 =cut
 129
 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 );
 135         return unless $ok;
 136
 137         $stemmaid = 0 unless defined $stemmaid;
 138         $c->stash->{'result'} = '';
 139         if( $tradition ) {
 140                 if( $c->req->method eq 'POST' ) {
 141                         # Update the stemma
 142                         my $dot = $c->request->body_params->{'dot'};
 143                         $tradition->add_stemma( $dot );
 144                         $m->store( $tradition );
 145                         $stemmaid = scalar( $tradition->stemma_count ) - 1;
 146                 }
 147
 148                 $c->stash->{'result'} = $tradition->stemma_count > $stemmaid
 149                         ? $tradition->stemma( $stemmaid )->as_svg( { size => [ 500, 375 ] } )
 150                         : '';
 151         }
 152         $c->forward('View::SVG');
 153 }
 154
 155 =head2 stemmadot
 156
 157  GET /stemmadot/$textid
 158
 159 Returns the 'dot' format representation of the current stemma hypothesis.
 160
 161 =cut
 162
 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 );
 168         return unless $ok;
 169
 170         $c->response->body( $tradition->stemma->editable );
 171         $c->forward('View::Plain');
 172 }
 173
 174 =head1 AJAX methods for index page
 175
 176 =head2 textinfo
 177
 178  GET /textinfo/$textid
 179
 180 Returns information about a particular text.
 181
 182 =cut
 183
 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 );
 188         return unless $ok;
 189
 190         # Need text name, witness list, scalar readings, scalar relationships, stemmata
 191         my $textinfo = {
 192                 textid => $textid,
 193                 traditionname => $tradition->name,
 194                 witnesses => [ map { $_->sigil } $tradition->witnesses ],
 195                 readings => scalar $tradition->collation->readings,
 196                 relationships => scalar $tradition->collation->relationships
 197         };
 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');
 203 }
 204
 205 # TODO alter text parameters
 206
 207 =head2 new
 208
 209  POST /newtradition { name: <name>, inputfile: <fileupload> }
 210
 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.
 213
 214 =cut
 215
 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('inputfile');
 223                 my $name = $c->request->param('name') || 'Uploaded tradition';
 224                 my( $ext ) = $upload->filename =~ /\.(\w+)$/;
 225                 my %newopts = (
 226                         'name' => $name,
 227                         'file' => $upload->tempname,
 228                         'user' => $user
 229                         );
 230                 my $tradition;
 231                 my $errmsg;
 232                 if( $ext eq 'xml' ) {
 233                         # Try the different XML parsing options to see if one works.
 234                         foreach my $type ( qw/ CollateX CTE TEI / ) {
 235                                 try {
 236                                         $tradition = Text::Tradition->new( %newopts, 'input' => $type );
 237                                 } catch ( Text::Tradition::Error $e ) {
 238                                         $errmsg = $e->message;
 239                                 } catch {
 240                                         $errmsg = "Unexpected parsing error";
 241                                 }
 242                                 last if $tradition;
 243                         }
 244                 } elsif( $ext eq 'txt' || $ext eq 'csv' ) {
 245                         my $sep_char = $ext eq 'txt' ? "\t" : ',';
 246                         try {
 247                                 $tradition = Text::Tradition->new(
 248                                         %newopts,
 249                                         'input' => 'Tabular',
 250                                         'sep_char' => $sep_char
 251                                         );
 252                         } catch ( Text::Tradition::Error $e ) {
 253                                 $errmsg = $e->message;
 254                         } catch {
 255                                 $errmsg = "Unexpected parsing error";
 256                         }
 257                 } elsif( $ext =~ /^xls(x)?$/ ) {
 258                         $c->stash->{'result'} =
 259                                 { 'error' => "Excel parsing not supported yet" };
 260                         $c->response->status( 500 );
 261                 } else {
 262                         # Error unless we have a recognized filename extension
 263                         $c->stash->{'result'} =
 264                                 { 'error' => "Unrecognized file type extension $ext" };
 265                         $c->response->status( 500 );
 266                 }
 267
 268                 # Save the tradition if we have it, and return its data or else the
 269                 # error that occurred trying to make it.
 270                 if( $tradition ) {
 271                         my $id = $c->model('Directory')->store( $tradition );
 272                         $c->stash->{'result'} = { 'id' => $id, 'name' => $tradition->name };
 273                 } else {
 274                         $c->stash->{'result'} =
 275                                 { 'error' => "Error parsing tradition .$ext file: $errmsg" };
 276                         $c->response->status( 500 );
 277                 }
 278         } else {
 279                 $c->stash->{'result'} =
 280                         { 'error' => 'Cannot save a tradition without being logged in' };
 281                 $c->response->status( 403 );
 282         }
 283         $c->forward('View::JSON');
 284 }
 285
 286 sub _check_permission {
 287         my( $c, $tradition ) = @_;
 288     my $user = $c->user_exists ? $c->user->get_object : undef;
 289     if( $user ) {
 290         return 'full' if ( $user->is_admin || $tradition->user->id eq $user->id );
 291     } elsif( $tradition->public ) {
 292         return 'readonly';
 293     } else {
 294         # Forbidden!
 295         $c->response->status( 403 );
 296         $c->response->body( 'You do not have permission to view this tradition.' );
 297         $c->detach( 'View::Plain' );
 298         return 0;
 299     }
 300 }
 301
 302 =head2 default
 303
 304 Standard 404 error page
 305
 306 =cut
 307
 308 sub default :Path {
 309     my ( $self, $c ) = @_;
 310     $c->response->body( 'Page not found' );
 311     $c->response->status(404);
 312 }
 313
 314 =head2 end
 315
 316 Attempt to render a view, if needed.
 317
 318 =cut
 319
 320 sub end : ActionClass('RenderView') {}
 321
 322 =head1 AUTHOR
 323
 324 Tara L Andrews
 325
 326 =head1 LICENSE
 327
 328 This library is free software. You can redistribute it and/or modify
 329 it under the same terms as Perl itself.
 330
 331 =cut
 332
 333 __PACKAGE__->meta->make_immutable;
 334
 335 1;