add SVG caching
[scpubgit/stemmaweb.git] / lib / stemmaweb / Controller / Root.pm
CommitLineData
b8a92065 1package stemmaweb::Controller::Root;
2use Moose;
3use namespace::autoclean;
4use Text::Tradition::Analysis qw/ run_analysis /;
5
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
17stemmaweb::Controller::Root - Root Controller for stemmaweb
18
19=head1 DESCRIPTION
20
21Serves up the main container pages.
22
23=head1 URLs
24
25=head2 index
26
27The root page (/). Serves the main container page, from which the various
28components will be loaded.
29
30=cut
31
32sub 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
44Serves a snippet of HTML that lists the available texts. Eventually this will be available texts by user.
45
46=cut
47sub directory :Local :Args(0) {
48 my( $self, $c ) = @_;
49 my $m = $c->model('Directory');
50 # TODO not used yet, will load user texts later
51 my $user = $c->request->param( 'user' ) || 'ALL';
52 my @textlist;
96e44262 53 $m->scan( sub {
54 push( @textlist, {
55 'id' => $m->object_to_id( @_ ),
56 'name' => $_[0]->name } )
57 } );
b8a92065 58 $c->stash->{texts} = \@textlist;
59 $c->stash->{template} = 'directory.tt';
60}
61
fb6e49b3 62=head2 variantgraph
63
64 GET /variantgraph/$textid
65
66Returns the variant graph for the text specified at $textid, in SVG form.
67
68=cut
69
70sub variantgraph :Local :Args(1) {
71 my( $self, $c, $textid ) = @_;
72 my $m = $c->model('Directory');
b9a04e24 73 my $tradition = $m->tradition( $textid );
74 my $collation = $tradition->collation;
75 my $needsave = !$collation->has_cached_svg;
fb6e49b3 76 $c->stash->{'result'} = $collation->as_svg;
b9a04e24 77 $m->save( $tradition );
fb6e49b3 78 $c->forward('View::SVG');
79}
80
b8a92065 81=head2 alignment
82
83 GET /alignment/$textid
84
85Returns an alignment table for the text specified at $textid.
86
87=cut
88
89sub alignment :Local :Args(1) {
90 my( $self, $c, $textid ) = @_;
91 my $m = $c->model('Directory');
92 my $collation = $m->tradition( $textid )->collation;
93 my $alignment = $collation->make_alignment_table;
94
95 # Turn the table, so that witnesses are by column and the rows
96 # are by rank.
97 my $wits = [ map { $_->{'witness'} } @{$alignment->{'alignment'}} ];
98 my $rows;
99 foreach my $i ( 0 .. $alignment->{'length'} - 1 ) {
100 my @rankrdgs = map { $_->{'tokens'}->[$i]->{'t'} }
101 @{$alignment->{'alignment'}};
102 push( @$rows, { 'rank' => $i+1, 'readings' => \@rankrdgs } );
103 }
104 $c->log->debug( Dumper( $rows ) );
105 $c->stash->{'witnesses'} = $wits;
106 $c->stash->{'table'} = $rows;
107 $c->stash->{'template'} = 'alignment.tt';
108}
109
110=head2 stemma
111
112 GET /stemma/$textid
113 POST /stemma/$textid, { 'dot' => $dot_string }
114
115Returns an SVG representation of the stemma hypothesis for the text. If
116the URL is called with POST and a new dot string, updates the stemma and
117returns the SVG as with GET.
118
119=cut
120
121sub stemma :Local :Args(1) {
122 my( $self, $c, $textid ) = @_;
123 my $m = $c->model('Directory');
124 my $tradition = $m->tradition( $textid );
125
126 if( $c->req->method eq 'POST' ) {
127 # Update the stemma
128 my $dot = $c->request->body_params->{'dot'};
129 $tradition->add_stemma( $dot );
130 $m->store( $tradition );
131 }
132
a86eba5d 133 $c->stash->{'result'} = $tradition->stemma_count
134 ? $tradition->stemma(0)->as_svg
96e44262 135 : '';
b8a92065 136 $c->forward('View::SVG');
137}
138
139=head2 stemmadot
140
141 GET /stemmadot/$textid
142
143Returns the 'dot' format representation of the current stemma hypothesis.
144
145=cut
146
147sub stemmadot :Local :Args(1) {
148 my( $self, $c, $textid ) = @_;
149 my $m = $c->model('Directory');
150 my $tradition = $m->tradition( $textid );
151
152 $c->response->body( $tradition->stemma->editable );
153 $c->forward('View::Plain');
154}
155
156=head2 default
157
158Standard 404 error page
159
160=cut
161
162sub default :Path {
163 my ( $self, $c ) = @_;
164 $c->response->body( 'Page not found' );
165 $c->response->status(404);
166}
167
168=head2 end
169
170Attempt to render a view, if needed.
171
172=cut
173
174sub end : ActionClass('RenderView') {}
175
176=head1 AUTHOR
177
178Tara L Andrews
179
180=head1 LICENSE
181
182This library is free software. You can redistribute it and/or modify
183it under the same terms as Perl itself.
184
185=cut
186
187__PACKAGE__->meta->make_immutable;
188
1891;