1 package TreeOfTexts::Controller::Stemmagraph;
3 use namespace::autoclean;
6 use Text::Tradition::Collation;
7 use Text::Tradition::StemmaUtil qw/ character_input phylip_pars newick_to_svg /;
9 BEGIN { extends 'Catalyst::Controller' }
12 # Sets the actions in this controller to be registered with no prefix
13 # so they function identically to actions created in MyApp.pm
15 __PACKAGE__->config(namespace => '');
19 TreeOfTexts::Controller::Stemmagraph - Simple controller for stemma display
23 [enter your description here]
29 sub get_graph :Local {
31 # If called interactively, we have params 'display', 'output', 'witnesses'
32 # If called non-interactively, we look at headers and content.
33 # The body is actually a File::Temp object; this is undocumented but
37 if( $c->request->params->{'dot'} ) {
38 # Make a File::Temp object.
39 my $tmpfile = File::Temp->new( UNLINK => 0 );
40 print $tmpfile $c->request->params->{'dot'};
41 $dotfile = $tmpfile->filename;
44 $dotfile = $c->request->body;
48 # Render the dot in the given format.
49 my $collation = Text::Tradition::Collation->new();
50 my $stemma = Text::Tradition::Stemma->new( 'collation' => $collation, 'dot' => $dotfile );
51 unlink( $dotfile ) if $must_unlink;
52 $c->stash->{result} = $stemma->as_svg;
53 $c->forward( "View::SVG" );
56 =head2 character_matrix
58 Given an alignment table in JSON form, in the parameter 'alignment', returns a
59 character matrix suitable for input to Phylip PARS.
63 sub character_matrix :Local {
65 my $json = $c->request->params->{'alignment'};
66 $c->log->debug( $json );
67 my $table = from_json( $json );
68 my $matrix = character_input( $table );
69 $c->stash->{'result'} = { 'matrix' => $matrix };
70 $c->forward( 'View::JSON' );
75 Takes either an alignment table in JSON format (passed as the parameter 'alignment')
76 or a character matrix Phylip accepts (passed as the parameter 'matrix'). Returns
77 either the Newick-format answer or an SVG representation of the graph.
84 my $view = 'View::JSON';
86 if( $c->request->param('matrix') ) {
87 $matrix = $c->request->param('matrix');
88 } elsif( $c->request->param('alignment') ) {
89 # Make the matrix from the alignment
90 my $table = from_json( $c->request->param('alignment') );
91 $matrix = character_input( $table );
93 $error = "Must pass either an alignment or a matrix";
96 # Got the matrix, so try to run pars.
97 my( $result, $output );
99 ( $result, $output ) = phylip_pars( $matrix );
100 $error = $output unless( $result );
103 # Did we want newick or a graph?
105 my $format = 'newick';
106 $format = $c->request->param('format') if $c->request->param('format');
107 if( $format eq 'svg' ) {
109 $c->stash->{'result'} = newick_to_svg( $output );
111 } elsif( $format ne 'newick' ) {
112 $error = "Requested output format $format unknown";
114 $c->stash->{'result'} = { 'tree' => $output };
119 $c->stash->{'error'} = $error;
120 } # else the stash is populated.
121 $c->forward( $view );
130 This library is free software. You can redistribute it and/or modify
131 it under the same terms as Perl itself.
135 __PACKAGE__->meta->make_immutable;