add support for direct SQL query of directory
[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';
b85f745a 52 my @textlist = $m->traditionlist();
b8a92065 53 $c->stash->{texts} = \@textlist;
54 $c->stash->{template} = 'directory.tt';
55}
56
fb6e49b3 57=head2 variantgraph
58
59 GET /variantgraph/$textid
60
61Returns the variant graph for the text specified at $textid, in SVG form.
62
63=cut
64
65sub variantgraph :Local :Args(1) {
66 my( $self, $c, $textid ) = @_;
67 my $m = $c->model('Directory');
b9a04e24 68 my $tradition = $m->tradition( $textid );
69 my $collation = $tradition->collation;
70 my $needsave = !$collation->has_cached_svg;
fb6e49b3 71 $c->stash->{'result'} = $collation->as_svg;
b9a04e24 72 $m->save( $tradition );
fb6e49b3 73 $c->forward('View::SVG');
74}
75
b8a92065 76=head2 alignment
77
78 GET /alignment/$textid
79
80Returns an alignment table for the text specified at $textid.
81
82=cut
83
84sub alignment :Local :Args(1) {
85 my( $self, $c, $textid ) = @_;
86 my $m = $c->model('Directory');
87 my $collation = $m->tradition( $textid )->collation;
ce956045 88 my $alignment = $collation->alignment_table;
b8a92065 89
90 # Turn the table, so that witnesses are by column and the rows
91 # are by rank.
92 my $wits = [ map { $_->{'witness'} } @{$alignment->{'alignment'}} ];
93 my $rows;
94 foreach my $i ( 0 .. $alignment->{'length'} - 1 ) {
95 my @rankrdgs = map { $_->{'tokens'}->[$i]->{'t'} }
96 @{$alignment->{'alignment'}};
97 push( @$rows, { 'rank' => $i+1, 'readings' => \@rankrdgs } );
98 }
99 $c->log->debug( Dumper( $rows ) );
100 $c->stash->{'witnesses'} = $wits;
101 $c->stash->{'table'} = $rows;
102 $c->stash->{'template'} = 'alignment.tt';
103}
104
105=head2 stemma
106
107 GET /stemma/$textid
108 POST /stemma/$textid, { 'dot' => $dot_string }
109
110Returns an SVG representation of the stemma hypothesis for the text. If
111the URL is called with POST and a new dot string, updates the stemma and
112returns the SVG as with GET.
113
114=cut
115
116sub stemma :Local :Args(1) {
117 my( $self, $c, $textid ) = @_;
118 my $m = $c->model('Directory');
119 my $tradition = $m->tradition( $textid );
120
121 if( $c->req->method eq 'POST' ) {
122 # Update the stemma
123 my $dot = $c->request->body_params->{'dot'};
124 $tradition->add_stemma( $dot );
125 $m->store( $tradition );
126 }
127
a86eba5d 128 $c->stash->{'result'} = $tradition->stemma_count
129 ? $tradition->stemma(0)->as_svg
96e44262 130 : '';
b8a92065 131 $c->forward('View::SVG');
132}
133
134=head2 stemmadot
135
136 GET /stemmadot/$textid
137
138Returns the 'dot' format representation of the current stemma hypothesis.
139
140=cut
141
142sub stemmadot :Local :Args(1) {
143 my( $self, $c, $textid ) = @_;
144 my $m = $c->model('Directory');
145 my $tradition = $m->tradition( $textid );
146
147 $c->response->body( $tradition->stemma->editable );
148 $c->forward('View::Plain');
149}
150
151=head2 default
152
153Standard 404 error page
154
155=cut
156
157sub default :Path {
158 my ( $self, $c ) = @_;
159 $c->response->body( 'Page not found' );
160 $c->response->status(404);
161}
162
163=head2 end
164
165Attempt to render a view, if needed.
166
167=cut
168
169sub end : ActionClass('RenderView') {}
170
171=head1 AUTHOR
172
173Tara L Andrews
174
175=head1 LICENSE
176
177This library is free software. You can redistribute it and/or modify
178it under the same terms as Perl itself.
179
180=cut
181
182__PACKAGE__->meta->make_immutable;
183
1841;