package stemmaweb::Controller::Root;
use Moose;
use namespace::autoclean;
-use Text::Tradition::Analysis qw/ run_analysis /;
+use JSON qw ();
+use LWP::UserAgent;
use TryCatch;
use XML::LibXML;
use XML::LibXML::XPathContext;
#
__PACKAGE__->config(namespace => '');
+my $STEMWEB_BASE_URL = 'http://slinkola.users.cs.helsinki.fi';
+
=head1 NAME
stemmaweb::Controller::Root - Root Controller for stemmaweb
if( $c->req->param('withtradition') ) {
$c->stash->{'withtradition'} = $c->req->param('withtradition');
}
+ # Get the current list of Stemweb algorithms
+ my $ua = LWP::UserAgent->new();
+ my $resp = $ua->get( $STEMWEB_BASE_URL . '/algorithms/available' );
+ if( $resp->is_success ) {
+ $c->stash->{'stemweb_algorithms'} = $resp->content;
+ } else {
+ $c->stash->{'stemweb_algorithms'} = '{}';
+ }
$c->stash->{template} = 'index.tt';
}
if( exists $params->{'owner'} ) {
# Only admins can update user / owner
my $newownerid = delete $params->{'owner'};
+ if( $tradition->has_user && !$tradition->user ) {
+ $tradition->clear_user;
+ }
unless( !$newownerid ||
( $tradition->has_user && $tradition->user->email eq $newownerid ) ) {
unless( $c->user->get_object->is_admin ) {
my $textinfo = {
textid => $textid,
name => $tradition->name,
- #language => $tradition->language,
public => $tradition->public || 0,
owner => $tradition->user ? $tradition->user->email : undef,
witnesses => [ map { $_->sigil } $tradition->witnesses ],
if( $tradition->can('language') ) {
$textinfo->{'language'} = $tradition->language;
}
- my @stemmasvg = map { $_->as_svg() } $tradition->stemmata;
+ if( $tradition->can('stemweb_jobid') ) {
+ $textinfo->{'stemweb_jobid'} = $tradition->stemweb_jobid || 0;
+ }
+ my @stemmasvg = map { {
+ name => $_->identifier,
+ directed => _json_bool( !$_->is_undirected ),
+ svg => $_->as_svg() } }
+ $tradition->stemmata;
map { $_ =~ s/\n/ /mg } @stemmasvg;
$textinfo->{stemmata} = \@stemmasvg;
$c->stash->{'result'} = $textinfo;
my $dot = $c->request->body_params->{'dot'};
# Graph::Reader::Dot does not handle bare unicode. We get around this
# by wrapping all words in double quotes, as long as they aren't already
- # wrapped, and as long as they aren't the initial 'digraph stemma'.
+ # wrapped, and as long as they aren't the initial '(di)?graph .*'.
# Horrible HACK.
- $dot =~ s/(?<!")\b(?!(?:digraph|stemma)\b)(\w+)\b(?!")/"$1"/g;
+ my @dlines = split( "\n", $dot );
+ my $wdot = '';
+ foreach( @dlines ) {
+ unless( /^(di)?graph/ ) { # Skip the first line
+ s/(?<!")\b(\w+)\b(?!")/"$1"/g;
+ }
+ $wdot .= "$_\n";
+ }
+ # $dot =~ s/(?<!")\b(?!(?:digraph|stemma)\b)(\w+)\b(?!")/"$1"/g;
+ $dot = $wdot;
+ print STDERR "$dot\n";
try {
if( $stemmaid eq 'n' ) {
# We are adding a new stemma.
$c->forward('View::SVG');
} else { # JSON
$stemma_xml =~ s/\n/ /mg;
- $c->stash->{'result'} = { 'stemmaid' => $stemmaid, 'stemmasvg' => $stemma_xml };
+ $c->stash->{'result'} = {
+ 'stemmaid' => $stemmaid,
+ 'name' => $stemma->identifier,
+ 'directed' => _json_bool( !$stemma->is_undirected ),
+ 'svg' => $stemma_xml };
$c->forward('View::JSON');
}
}
return 0;
}
+sub _json_bool {
+ return $_[0] ? JSON::true : JSON::false;
+}
+
=head2 default
Standard 404 error page