empty data fields before re-appending
[scpubgit/stemmatology.git] / stemmaweb / lib / stemmaweb / Controller / Root.pm
CommitLineData
5c9ecf66 1package stemmaweb::Controller::Root;
dbcf12a6 2use Moose;
3use namespace::autoclean;
3837c155 4use Text::Tradition::Analysis qw/ run_analysis /;
5
dbcf12a6 6
7BEGIN { 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
5c9ecf66 17stemmaweb::Controller::Root - Root Controller for stemmaweb
dbcf12a6 18
19=head1 DESCRIPTION
20
6b70c348 21Serves up the main container pages.
dbcf12a6 22
6b70c348 23=head1 URLs
dbcf12a6 24
25=head2 index
26
6b70c348 27The root page (/). Serves the main container page, from which the various
28components will be loaded.
dbcf12a6 29
30=cut
31
32sub index :Path :Args(0) {
33 my ( $self, $c ) = @_;
34
6b70c348 35 $c->stash->{template} = 'index.tt';
36}
37
38=head1 Elements of index page
39
40=head2 directory
41
42 GET /directory
43
7c256818 44Serves 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.
6b70c348 45
46=cut
7c256818 47
2376359f 48sub directory :Local :Args(0) {
6b70c348 49 my( $self, $c ) = @_;
3837c155 50 my $m = $c->model('Directory');
27a20fbe 51 # Is someone logged in?
3524c08f 52 my %usertexts;
27a20fbe 53 if( $c->user_exists ) {
54 my $user = $c->user->get_object;
3524c08f 55 my @list = $m->traditionlist( $user );
56 map { $usertexts{$_->{id}} = 1 } @list;
57 $c->stash->{usertexts} = \@list;
27a20fbe 58 $c->stash->{is_admin} = 1 if $user->is_admin;
59 }
3524c08f 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;
6b70c348 65 $c->stash->{template} = 'directory.tt';
66}
67
3524c08f 68=head2 textinfo
69
70 GET /textinfo/$textid
71
72Returns the page element populated with information about a particular text.
73
74=cut
75
76sub 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
cf9626aa 94=head2 variantgraph
95
96 GET /variantgraph/$textid
97
98Returns the variant graph for the text specified at $textid, in SVG form.
99
100=cut
101
102sub variantgraph :Local :Args(1) {
103 my( $self, $c, $textid ) = @_;
3524c08f 104 my $tradition = $c->model('Directory')->tradition( $textid );
b365fbae 105 my $collation = $tradition->collation;
cf9626aa 106 $c->stash->{'result'} = $collation->as_svg;
107 $c->forward('View::SVG');
108}
109
6b70c348 110=head2 alignment
111
112 GET /alignment/$textid
113
114Returns an alignment table for the text specified at $textid.
115
116=cut
117
2376359f 118sub alignment :Local :Args(1) {
6b70c348 119 my( $self, $c, $textid ) = @_;
3524c08f 120 my $tradition = $c->model('Directory')->tradition( $textid );
121 my $collation = $tradition->collation;
7f52eac8 122 my $alignment = $collation->alignment_table;
6b70c348 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 }
6b70c348 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
143Returns an SVG representation of the stemma hypothesis for the text. If
144the URL is called with POST and a new dot string, updates the stemma and
145returns the SVG as with GET.
146
147=cut
148
2376359f 149sub stemma :Local :Args(1) {
6b70c348 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
3e420a82 161 $c->stash->{'result'} = $tradition->stemma_count
91b888ed 162 ? $tradition->stemma(0)->as_svg( { size => [ 500, 375 ] } )
80dad2e3 163 : '';
6b70c348 164 $c->forward('View::SVG');
dbcf12a6 165}
166
6b70c348 167=head2 stemmadot
12720144 168
6b70c348 169 GET /stemmadot/$textid
170
171Returns the 'dot' format representation of the current stemma hypothesis.
172
173=cut
174
2376359f 175sub stemmadot :Local :Args(1) {
6b70c348 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}
12720144 183
dbcf12a6 184=head2 default
185
186Standard 404 error page
187
188=cut
189
190sub default :Path {
191 my ( $self, $c ) = @_;
192 $c->response->body( 'Page not found' );
193 $c->response->status(404);
194}
195
196=head2 end
197
198Attempt to render a view, if needed.
199
200=cut
201
202sub end : ActionClass('RenderView') {}
203
204=head1 AUTHOR
205
206Tara L Andrews
207
208=head1 LICENSE
209
210This library is free software. You can redistribute it and/or modify
211it under the same terms as Perl itself.
212
213=cut
214
215__PACKAGE__->meta->make_immutable;
216
2171;