TreeOfTexts/lib/TreeOfTexts/Controller/Stemmagraph.pm

   1 package TreeOfTexts::Controller::Stemmagraph;
   2 use Moose;
   3 use namespace::autoclean;
   4 use File::Temp;
   5 use JSON;
   6 use Text::Tradition::Collation;
   7 use Text::Tradition::StemmaUtil qw/ phylip_pars_input /;
   8
   9 BEGIN { extends 'Catalyst::Controller' }
  10
  11 #
  12 # Sets the actions in this controller to be registered with no prefix
  13 # so they function identically to actions created in MyApp.pm
  14 #
  15 __PACKAGE__->config(namespace => '');
  16
  17 =head1 NAME
  18
  19 TreeOfTexts::Controller::Stemmagraph - Simple controller for stemma display
  20
  21 =head1 DESCRIPTION
  22
  23 [enter your description here]
  24
  25 =head1 METHODS
  26
  27 =cut
  28
  29 sub get_graph :Local {
  30         my( $self, $c ) = @_;
  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
  34         # so it seems to be.
  35         my $dotfile;
  36         my $must_unlink = 0;
  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;
  42             $must_unlink = 1;
  43         } else {
  44             $dotfile = $c->request->body;
  45         }
  46         my $format = 'svg';
  47
  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" );
  54 }
  55
  56 =head2 character_matrix
  57
  58 Given an alignment table in JSON form, in the parameter 'alignment', returns a
  59 character matrix suitable for input to Phylip PARS.
  60
  61 =cut
  62
  63 sub character_matrix :Local {
  64         my( $self, $c ) = @_;
  65         my $json = $c->request->params->{'alignment'};
  66         $c->log->debug( $json );
  67         my $table = from_json( $json );
  68         my $matrix = phylip_pars_input( $table );
  69         $c->stash->{'result'} = { 'matrix' => $matrix };
  70         $c->forward( 'View::JSON' );
  71 }
  72 =head2 end
  73
  74 Attempt to render a view, if needed.
  75
  76 =cut
  77
  78 sub end : ActionClass('RenderView') {}
  79
  80 =head1 AUTHOR
  81
  82 Tara L Andrews
  83
  84 =head1 LICENSE
  85
  86 This library is free software. You can redistribute it and/or modify
  87 it under the same terms as Perl itself.
  88
  89 =cut
  90
  91 __PACKAGE__->meta->make_immutable;
  92
  93 1;