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
   6
   7 BEGIN { extends 'Catalyst::Controller' }
   8
   9 #
  10 # Sets the actions in this controller to be registered with no prefix
  11 # so they function identically to actions created in MyApp.pm
  12 #
  13 __PACKAGE__->config(namespace => '');
  14
  15 =head1 NAME
  16
  17 stemmaweb::Controller::Root - Root Controller for stemmaweb
  18
  19 =head1 DESCRIPTION
  20
  21 Serves up the main container pages.
  22
  23 =head1 URLs
  24
  25 =head2 index
  26
  27 The root page (/).  Serves the main container page, from which the various
  28 components will be loaded.
  29
  30 =cut
  31
  32 sub index :Path :Args(0) {
  33     my ( $self, $c ) = @_;
  34
  35     $c->stash->{template} = 'index.tt';
  36 }
  37
  38 =head1 Elements of index page
  39
  40 =head2 directory
  41
  42  GET /directory
  43
  44 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.
  45
  46 =cut
  47
  48 sub directory :Local :Args(0) {
  49         my( $self, $c ) = @_;
  50     my $m = $c->model('Directory');
  51     # Is someone logged in?
  52     my %usertexts;
  53     if( $c->user_exists ) {
  54         my $user = $c->user->get_object;
  55         my @list = $m->traditionlist( $user );
  56         map { $usertexts{$_->{id}} = 1 } @list;
  57                 $c->stash->{usertexts} = \@list;
  58                 $c->stash->{is_admin} = 1 if $user->is_admin;
  59         }
  60         # List public (i.e. readonly) texts separately from any user (i.e.
  61         # full access) texts that exist. Admin users therefore have nothing
  62         # in this list.
  63         my @plist = grep { !$usertexts{$_->{id}} } $m->traditionlist('public');
  64         $c->stash->{publictexts} = \@plist;
  65         $c->stash->{template} = 'directory.tt';
  66 }
  67
  68 =head2 textinfo
  69
  70  GET /textinfo/$textid
  71
  72 Returns the page element populated with information about a particular text.
  73
  74 =cut
  75
  76 sub textinfo :Local :Args(1) {
  77         my( $self, $c, $textid ) = @_;
  78         my $tradition = $c->model('Directory')->tradition( $textid );
  79         # Need text name, witness list, scalar readings, scalar relationships, stemmata
  80         my $textinfo = {
  81                 textid => $textid,
  82                 traditionname => $tradition->name,
  83                 witnesses => [ map { $_->sigil } $tradition->witnesses ],
  84                 readings => scalar $tradition->collation->readings,
  85                 relationships => scalar $tradition->collation->relationships
  86         };
  87         my @stemmasvg = map { $_->as_svg({ size => [ 500, 375 ] }) } $tradition->stemmata;
  88         map { $_ =~ s/\n/ /mg } @stemmasvg;
  89         $textinfo->{stemmata} = \@stemmasvg;
  90         $c->stash->{'result'} = $textinfo;
  91         $c->forward('View::JSON');
  92 }
  93
  94 =head2 variantgraph
  95
  96  GET /variantgraph/$textid
  97
  98 Returns the variant graph for the text specified at $textid, in SVG form.
  99
 100 =cut
 101
 102 sub variantgraph :Local :Args(1) {
 103         my( $self, $c, $textid ) = @_;
 104         my $tradition = $c->model('Directory')->tradition( $textid );
 105         my $collation = $tradition->collation;
 106         $c->stash->{'result'} = $collation->as_svg;
 107         $c->forward('View::SVG');
 108 }
 109
 110 =head2 alignment
 111
 112  GET /alignment/$textid
 113
 114 Returns an alignment table for the text specified at $textid.
 115
 116 =cut
 117
 118 sub alignment :Local :Args(1) {
 119         my( $self, $c, $textid ) = @_;
 120         my $tradition = $c->model('Directory')->tradition( $textid );
 121         my $collation = $tradition->collation;
 122         my $alignment = $collation->alignment_table;
 123
 124         # Turn the table, so that witnesses are by column and the rows
 125         # are by rank.
 126         my $wits = [ map { $_->{'witness'} } @{$alignment->{'alignment'}} ];
 127         my $rows;
 128         foreach my $i ( 0 .. $alignment->{'length'} - 1 ) {
 129                 my @rankrdgs = map { $_->{'tokens'}->[$i]->{'t'} }
 130                         @{$alignment->{'alignment'}};
 131                 push( @$rows, { 'rank' => $i+1, 'readings' => \@rankrdgs } );
 132         }
 133         $c->stash->{'witnesses'} = $wits;
 134         $c->stash->{'table'} = $rows;
 135         $c->stash->{'template'} = 'alignment.tt';
 136 }
 137
 138 =head2 stemma
 139
 140  GET /stemma/$textid
 141  POST /stemma/$textid, { 'dot' => $dot_string }
 142
 143 Returns an SVG representation of the stemma hypothesis for the text.  If
 144 the URL is called with POST and a new dot string, updates the stemma and
 145 returns the SVG as with GET.
 146
 147 =cut
 148
 149 sub stemma :Local :Args(1) {
 150         my( $self, $c, $textid ) = @_;
 151         my $m = $c->model('Directory');
 152         my $tradition = $m->tradition( $textid );
 153
 154         if( $c->req->method eq 'POST' ) {
 155                 # Update the stemma
 156                 my $dot = $c->request->body_params->{'dot'};
 157                 $tradition->add_stemma( $dot );
 158                 $m->store( $tradition );
 159         }
 160
 161         $c->stash->{'result'} = $tradition->stemma_count
 162                 ? $tradition->stemma(0)->as_svg( { size => [ 500, 375 ] } )
 163                 : '';
 164         $c->forward('View::SVG');
 165 }
 166
 167 =head2 stemmadot
 168
 169  GET /stemmadot/$textid
 170
 171 Returns the 'dot' format representation of the current stemma hypothesis.
 172
 173 =cut
 174
 175 sub stemmadot :Local :Args(1) {
 176         my( $self, $c, $textid ) = @_;
 177         my $m = $c->model('Directory');
 178         my $tradition = $m->tradition( $textid );
 179
 180         $c->response->body( $tradition->stemma->editable );
 181         $c->forward('View::Plain');
 182 }
 183
 184 =head2 default
 185
 186 Standard 404 error page
 187
 188 =cut
 189
 190 sub default :Path {
 191     my ( $self, $c ) = @_;
 192     $c->response->body( 'Page not found' );
 193     $c->response->status(404);
 194 }
 195
 196 =head2 end
 197
 198 Attempt to render a view, if needed.
 199
 200 =cut
 201
 202 sub end : ActionClass('RenderView') {}
 203
 204 =head1 AUTHOR
 205
 206 Tara L Andrews
 207
 208 =head1 LICENSE
 209
 210 This library is free software. You can redistribute it and/or modify
 211 it under the same terms as Perl itself.
 212
 213 =cut
 214
 215 __PACKAGE__->meta->make_immutable;
 216
 217 1;