Commit | Line | Data |
5c9ecf66 |
1 | package stemmaweb::Controller::Stexaminer; |
2376359f |
2 | use Moose; |
3 | use namespace::autoclean; |
f8d13166 |
4 | use Encode qw/ decode_utf8 /; |
2376359f |
5 | use File::Temp; |
6 | use JSON; |
a44aaf2a |
7 | use Text::Tradition::Analysis qw/ run_analysis wit_stringify /; |
f8d13166 |
8 | use Text::Tradition::Collation; |
9 | use Text::Tradition::Stemma; |
2376359f |
10 | |
11 | BEGIN { extends 'Catalyst::Controller' } |
12 | |
13 | |
14 | =head1 NAME |
15 | |
5c9ecf66 |
16 | stemmaweb::Controller::Stexaminer - Simple controller for stemma display |
2376359f |
17 | |
18 | =head1 DESCRIPTION |
19 | |
20 | The stemma analysis tool with the pretty colored table. |
21 | |
22 | =head1 METHODS |
23 | |
f8d13166 |
24 | =head2 index |
25 | |
2376359f |
26 | GET stexaminer/$textid |
27 | |
28 | Renders the application for the text identified by $textid. |
29 | |
2376359f |
30 | =cut |
31 | |
32 | sub index :Path :Args(1) { |
33 | my( $self, $c, $textid ) = @_; |
34 | my $m = $c->model('Directory'); |
35 | my $tradition = $m->tradition( $textid ); |
1c0900ef |
36 | if( $tradition->stemma_count ) { |
37 | my $stemma = $tradition->stemma(0); |
f8d13166 |
38 | $c->stash->{svg} = $stemma->as_svg( { size => [ 600, 350 ] } ); |
39 | $c->stash->{graphdot} = $stemma->editable({ linesep => ' ' }); |
1c0900ef |
40 | $c->stash->{text_title} = $tradition->name; |
41 | $c->stash->{template} = 'stexaminer.tt'; |
e217c221 |
42 | |
43 | # Get the analysis options |
44 | my( $use_type1, $ignore_sort ) = ( 0, 'none' ); |
45 | if( $c->req->method eq 'POST' ) { |
46 | $use_type1 = $c->req->param( 'show_type1' ) eq 'on' ? 1 : 0; |
47 | $ignore_sort = $c->req->param( 'ignore_variant' ); |
48 | } |
49 | $c->stash->{'show_type1'} = $use_type1; |
50 | $c->stash->{'ignore_variant'} = $ignore_sort; |
1c0900ef |
51 | # TODO Run the analysis as AJAX from the loaded page. |
e217c221 |
52 | my %analysis_options; |
53 | $analysis_options{'exclude_type1'} = !$use_type1; |
54 | if( $ignore_sort eq 'spelling' ) { |
55 | $analysis_options{'collapse'} = [ qw/ spelling orthographic / ]; |
56 | } elsif( $ignore_sort eq 'orthographic' ) { |
57 | $analysis_options{'collapse'} = 'orthographic'; |
58 | } |
59 | |
60 | my $t = run_analysis( $tradition, %analysis_options ); |
a44aaf2a |
61 | # Stringify the reading groups |
62 | foreach my $loc ( @{$t->{'variants'}} ) { |
63 | my $mst = wit_stringify( $loc->{'missing'} ); |
64 | $loc->{'missing'} = $mst; |
65 | foreach my $rhash ( @{$loc->{'readings'}} ) { |
66 | my $gst = wit_stringify( $rhash->{'group'} ); |
67 | $rhash->{'group'} = $gst; |
e41080b6 |
68 | my $roots = join( ', ', @{$rhash->{'independent_occurrence'}} ); |
69 | $rhash->{'independent_occurrence'} = $roots; |
70 | unless( $rhash->{'text'} ) { |
71 | $rhash->{'text'} = $rhash->{'readingid'}; |
72 | } |
a44aaf2a |
73 | } |
74 | } |
23306161 |
75 | # Values for TT rendering |
1c0900ef |
76 | $c->stash->{variants} = $t->{'variants'}; |
77 | $c->stash->{total} = $t->{'variant_count'}; |
78 | $c->stash->{genealogical} = $t->{'genealogical_count'}; |
23306161 |
79 | $c->stash->{conflict} = $t->{'conflict_count'}; |
80 | # Also make a JSON stash of the data for the statistics tables |
81 | $c->stash->{reading_statistics} = to_json( $t->{'variants'} ); |
1c0900ef |
82 | } else { |
83 | $c->stash->{error} = 'Tradition ' . $tradition->name |
84 | . 'has no stemma for analysis.'; |
85 | } |
2376359f |
86 | } |
87 | |
f8d13166 |
88 | =head2 graphsvg |
89 | |
90 | POST stexaminer/graphsvg |
91 | dot: <stemmagraph dot string> |
92 | layerwits: [ <a.c. witnesses ] |
93 | |
94 | Returns an SVG string of the given graph, extended to include the given |
95 | layered witnesses. |
96 | |
97 | =cut |
98 | |
99 | sub graphsvg :Local { |
100 | my( $self, $c ) = @_; |
101 | my $dot = $c->request->param('dot'); |
102 | my @layerwits = $c->request->param('layerwits[]'); |
103 | open my $stemma_fh, '<', \$dot; |
104 | binmode( $stemma_fh, ':encoding(UTF-8)' ); |
105 | my $emptycoll = Text::Tradition::Collation->new(); |
106 | my $tempstemma = Text::Tradition::Stemma->new( |
107 | collation => $emptycoll, 'dot' => $stemma_fh ); |
108 | my $svgopts = { size => [ 600, 350 ] }; |
109 | if( @layerwits ) { |
110 | $svgopts->{'layerwits'} = \@layerwits; |
111 | } |
112 | $c->stash->{'result'} = $tempstemma->as_svg( $svgopts ); |
113 | $c->forward('View::SVG'); |
114 | } |
115 | |
2376359f |
116 | =head2 end |
117 | |
118 | Attempt to render a view, if needed. |
119 | |
120 | =cut |
121 | |
122 | sub end : ActionClass('RenderView') {} |
123 | |
124 | =head1 AUTHOR |
125 | |
126 | Tara L Andrews |
127 | |
128 | =head1 LICENSE |
129 | |
130 | This library is free software. You can redistribute it and/or modify |
131 | it under the same terms as Perl itself. |
132 | |
133 | =cut |
134 | |
135 | __PACKAGE__->meta->make_immutable; |
136 | |
137 | 1; |