Isolate Stemweb calls into own controller; guard against server being down. #29

[scpubgit/stemmaweb.git] / lib / stemmaweb / Controller / Root.pm

diff --git a/lib/stemmaweb/Controller/Root.pm b/lib/stemmaweb/Controller/Root.pm
index f66dcd5..0315867 100644 (file)
--- a/lib/stemmaweb/Controller/Root.pm
+++ b/lib/stemmaweb/Controller/Root.pm
@@ -1,7 +1,7 @@
 package stemmaweb::Controller::Root;
 use Moose;
 use namespace::autoclean;
-use Text::Tradition::Analysis qw/ run_analysis /;
+use JSON qw ();
 use TryCatch;
 use XML::LibXML;
 use XML::LibXML::XPathContext;
@@ -314,7 +314,6 @@ sub textinfo :Local :Args(1) {
        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 ],
@@ -322,7 +321,14 @@ sub textinfo :Local :Args(1) {
        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;
@@ -380,9 +386,19 @@ sub stemma :Local :Args(2) {
                        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.
@@ -434,7 +450,11 @@ sub stemma :Local :Args(2) {
                $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');
        }
 }
@@ -518,6 +538,10 @@ sub _json_error {
        return 0;
 }
 
+sub _json_bool {
+       return $_[0] ? JSON::true : JSON::false;
+}
+
 =head2 default
 
 Standard 404 error page