c33b9f07d1aa2d17a7c0795fe180215d4311ed09
[scpubgit/stemmatology.git] / stemmaweb / 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.  Eventually this will be available texts by user.
45
46 =cut
47 sub 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 = $m->traditionlist();
53     $c->stash->{texts} = \@textlist;
54         $c->stash->{template} = 'directory.tt';
55 }
56
57 =head2 variantgraph
58
59  GET /variantgraph/$textid
60  
61 Returns the variant graph for the text specified at $textid, in SVG form.
62
63 =cut
64
65 sub variantgraph :Local :Args(1) {
66         my( $self, $c, $textid ) = @_;
67         my $m = $c->model('Directory');
68         my $tradition = $m->tradition( $textid );
69         my $collation = $tradition->collation;
70         my $needsave = !$collation->has_cached_svg;
71         $c->stash->{'result'} = $collation->as_svg;
72         $m->save( $tradition );
73         $c->forward('View::SVG');
74 }
75         
76 =head2 alignment
77
78  GET /alignment/$textid
79
80 Returns an alignment table for the text specified at $textid.
81
82 =cut
83
84 sub alignment :Local :Args(1) {
85         my( $self, $c, $textid ) = @_;
86         my $m = $c->model('Directory');
87         my $collation = $m->tradition( $textid )->collation;
88         my $alignment = $collation->alignment_table;
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
110 Returns an SVG representation of the stemma hypothesis for the text.  If 
111 the URL is called with POST and a new dot string, updates the stemma and
112 returns the SVG as with GET.
113
114 =cut
115
116 sub 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         
128         $c->stash->{'result'} = $tradition->stemma_count
129                 ? $tradition->stemma(0)->as_svg
130                 : '';
131         $c->forward('View::SVG');
132 }
133
134 =head2 stemmadot
135
136  GET /stemmadot/$textid
137  
138 Returns the 'dot' format representation of the current stemma hypothesis.
139
140 =cut
141
142 sub 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
153 Standard 404 error page
154
155 =cut
156
157 sub default :Path {
158     my ( $self, $c ) = @_;
159     $c->response->body( 'Page not found' );
160     $c->response->status(404);
161 }
162
163 =head2 end
164
165 Attempt to render a view, if needed.
166
167 =cut
168
169 sub end : ActionClass('RenderView') {}
170
171 =head1 AUTHOR
172
173 Tara L Andrews
174
175 =head1 LICENSE
176
177 This library is free software. You can redistribute it and/or modify
178 it under the same terms as Perl itself.
179
180 =cut
181
182 __PACKAGE__->meta->make_immutable;
183
184 1;