Commit | Line | Data |
b8a92065 |
1 | package stemmaweb::Controller::Stexaminer; |
2 | use Moose; |
3 | use namespace::autoclean; |
be8bf746 |
4 | use Encode qw/ decode_utf8 /; |
b8a92065 |
5 | use File::Temp; |
6 | use JSON; |
0737e7dd |
7 | use Text::Tradition::Analysis qw/ run_analysis wit_stringify /; |
be8bf746 |
8 | use Text::Tradition::Stemma; |
b8a92065 |
9 | |
10 | BEGIN { extends 'Catalyst::Controller' } |
11 | |
2c4355b7 |
12 | has idp_solver_url => ( |
13 | is => 'ro', |
14 | isa => 'Str', |
15 | predicate => 'has_idp_solver_url', |
16 | ); |
17 | |
18 | has idp_calcdsn => ( |
19 | is => 'ro', |
20 | isa => 'Str', |
21 | predicate => 'has_idp_calcdsn', |
22 | ); |
b8a92065 |
23 | |
24 | =head1 NAME |
25 | |
26 | stemmaweb::Controller::Stexaminer - Simple controller for stemma display |
27 | |
28 | =head1 DESCRIPTION |
29 | |
30 | The stemma analysis tool with the pretty colored table. |
31 | |
32 | =head1 METHODS |
33 | |
be8bf746 |
34 | =head2 index |
35 | |
98a45925 |
36 | GET stexaminer/$textid/$stemmaid |
b8a92065 |
37 | |
98a45925 |
38 | Renders the application for the text identified by $textid, using the stemma |
39 | graph identified by $stemmaid. |
b8a92065 |
40 | |
b8a92065 |
41 | =cut |
42 | |
98a45925 |
43 | sub index :Path :Args(2) { |
44 | my( $self, $c, $textid, $stemid ) = @_; |
b8a92065 |
45 | my $m = $c->model('Directory'); |
d3cdef68 |
46 | $c->stash->{template} = 'stexaminer.tt'; |
47 | |
48 | # Make sure the tradition exists and is viewable |
b8a92065 |
49 | my $tradition = $m->tradition( $textid ); |
d3cdef68 |
50 | unless( $tradition ) { |
51 | $c->response->status( 404 ); |
52 | $c->stash->{'error'} = "No tradition with ID $textid"; |
53 | return; |
54 | } |
96eae440 |
55 | my $ok = _check_permission( $c, $tradition ); |
56 | return unless $ok; |
d3cdef68 |
57 | |
eae8de7a |
58 | if( $stemid eq 'help' ) { |
59 | # Just show the 'Help/About' popup. |
60 | $c->stash->{template} = 'stexaminer_help.tt'; |
61 | $c->stash->{text_id} = $textid; |
0844ddee |
62 | } elsif( $tradition->stemma_count ) { |
847e1ac6 |
63 | my $stemma = $tradition->stemma( $stemid ); |
f6bfb763 |
64 | my $svgstr = $stemma->as_svg(); |
65 | $svgstr =~ s/\n/ /g; |
66 | $c->stash->{svg} = $svgstr; |
be8bf746 |
67 | $c->stash->{graphdot} = $stemma->editable({ linesep => ' ' }); |
c655153c |
68 | $c->stash->{text_id} = $textid; |
9c2e7b80 |
69 | $c->stash->{text_title} = $tradition->name; |
0c236c96 |
70 | |
71 | # Get the analysis options |
72 | my( $use_type1, $ignore_sort ) = ( 0, 'none' ); |
ccbe9315 |
73 | $use_type1 = $c->req->param( 'show_type1' ) ? 1 : 0; |
74 | $ignore_sort = $c->req->param( 'ignore_variant' ) || ''; |
0c236c96 |
75 | $c->stash->{'show_type1'} = $use_type1; |
76 | $c->stash->{'ignore_variant'} = $ignore_sort; |
9c2e7b80 |
77 | # TODO Run the analysis as AJAX from the loaded page. |
98a45925 |
78 | my %analysis_options = ( |
79 | stemma_id => $stemid, |
80 | exclude_type1 => !$use_type1 ); |
0c236c96 |
81 | if( $ignore_sort eq 'spelling' ) { |
e816672a |
82 | $analysis_options{'merge_types'} = [ qw/ spelling orthographic / ]; |
0c236c96 |
83 | } elsif( $ignore_sort eq 'orthographic' ) { |
e816672a |
84 | $analysis_options{'merge_types'} = 'orthographic'; |
0c236c96 |
85 | } |
2c4355b7 |
86 | if( $self->has_idp_solver_url ) { |
87 | $analysis_options{'solver_url'} = $self->idp_solver_url; |
88 | } elsif( $self->has_idp_calcdsn ) { |
89 | $analysis_options{'calcdsn'} = $self->idp_calcdsn; |
90 | } |
ccbe9315 |
91 | |
0c236c96 |
92 | my $t = run_analysis( $tradition, %analysis_options ); |
0737e7dd |
93 | # Stringify the reading groups |
94 | foreach my $loc ( @{$t->{'variants'}} ) { |
95 | my $mst = wit_stringify( $loc->{'missing'} ); |
96 | $loc->{'missing'} = $mst; |
97 | foreach my $rhash ( @{$loc->{'readings'}} ) { |
98 | my $gst = wit_stringify( $rhash->{'group'} ); |
99 | $rhash->{'group'} = $gst; |
f7371955 |
100 | _stringify_element( $rhash, 'independent_occurrence' ); |
101 | _stringify_element( $rhash, 'reversions' ); |
5089c3b7 |
102 | unless( $rhash->{'text'} ) { |
103 | $rhash->{'text'} = $rhash->{'readingid'}; |
104 | } |
0737e7dd |
105 | } |
106 | } |
d5514865 |
107 | # Values for TT rendering |
9c2e7b80 |
108 | $c->stash->{variants} = $t->{'variants'}; |
109 | $c->stash->{total} = $t->{'variant_count'}; |
110 | $c->stash->{genealogical} = $t->{'genealogical_count'}; |
d5514865 |
111 | $c->stash->{conflict} = $t->{'conflict_count'}; |
112 | # Also make a JSON stash of the data for the statistics tables |
113 | $c->stash->{reading_statistics} = to_json( $t->{'variants'} ); |
9c2e7b80 |
114 | } else { |
115 | $c->stash->{error} = 'Tradition ' . $tradition->name |
116 | . 'has no stemma for analysis.'; |
117 | } |
b8a92065 |
118 | } |
119 | |
f7371955 |
120 | sub _stringify_element { |
121 | my( $hash, $key ) = @_; |
8603127a |
122 | return undef unless exists $hash->{$key}; |
123 | if( ref( $hash->{$key} ) eq 'ARRAY' ) { |
124 | my $str = join( ', ', @{$hash->{$key}} ); |
125 | $hash->{$key} = $str; |
126 | } |
f7371955 |
127 | } |
128 | |
96eae440 |
129 | sub _check_permission { |
130 | my( $c, $tradition ) = @_; |
131 | my $user = $c->user_exists ? $c->user->get_object : undef; |
132 | if( $user ) { |
847e1ac6 |
133 | return 'full' if ( $user->is_admin || |
134 | ( $tradition->has_user && $tradition->user->id eq $user->id ) ); |
135 | } |
136 | # Text doesn't belong to us, so maybe it's public? |
137 | return 'readonly' if $tradition->public; |
138 | |
139 | # ...nope. Forbidden! |
080f8a02 |
140 | $c->response->status( 403 ); |
d3cdef68 |
141 | $c->stash->{'error'} = 'You do not have permission to view this tradition'; |
080f8a02 |
142 | return 0; |
96eae440 |
143 | } |
144 | |
be8bf746 |
145 | =head2 graphsvg |
146 | |
147 | POST stexaminer/graphsvg |
148 | dot: <stemmagraph dot string> |
149 | layerwits: [ <a.c. witnesses ] |
150 | |
151 | Returns an SVG string of the given graph, extended to include the given |
152 | layered witnesses. |
153 | |
154 | =cut |
155 | |
156 | sub graphsvg :Local { |
157 | my( $self, $c ) = @_; |
158 | my $dot = $c->request->param('dot'); |
159 | my @layerwits = $c->request->param('layerwits[]'); |
6cf17f04 |
160 | my $tempstemma = Text::Tradition::Stemma->new( 'dot' => $dot ); |
f6bfb763 |
161 | my $svgopts = {}; |
be8bf746 |
162 | if( @layerwits ) { |
163 | $svgopts->{'layerwits'} = \@layerwits; |
164 | } |
165 | $c->stash->{'result'} = $tempstemma->as_svg( $svgopts ); |
166 | $c->forward('View::SVG'); |
167 | } |
168 | |
b8a92065 |
169 | =head2 end |
170 | |
171 | Attempt to render a view, if needed. |
172 | |
173 | =cut |
174 | |
175 | sub end : ActionClass('RenderView') {} |
176 | |
177 | =head1 AUTHOR |
178 | |
179 | Tara L Andrews |
180 | |
181 | =head1 LICENSE |
182 | |
183 | This library is free software. You can redistribute it and/or modify |
184 | it under the same terms as Perl itself. |
185 | |
186 | =cut |
187 | |
188 | __PACKAGE__->meta->make_immutable; |
189 | |
190 | 1; |