Make stemma data return consistent; refrain from assuming digraph in edit box. Fixes #28

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

diff --git a/lib/stemmaweb/Controller/Root.pm b/lib/stemmaweb/Controller/Root.pm
index f2488ad..c50a660 100644 (file)
--- a/lib/stemmaweb/Controller/Root.pm
+++ b/lib/stemmaweb/Controller/Root.pm
@@ -3,6 +3,8 @@ use Moose;
 use namespace::autoclean;
 use Text::Tradition::Analysis qw/ run_analysis /;
 use TryCatch;
+use XML::LibXML;
+use XML::LibXML::XPathContext;
 
 
 BEGIN { extends 'Catalyst::Controller' }
@@ -132,18 +134,40 @@ sub newtradition :Local :Args(0) {
        my $tradition;
        my $errmsg;
        if( $ext eq 'xml' ) {
-               # Try the different XML parsing options to see if one works.
-               foreach my $type ( qw/ CollateX CTE TEI / ) {
+               my $type;
+               # Parse the XML to see which flavor it is.
+               my $parser = XML::LibXML->new();
+               my $doc;
+               try {
+                       $doc = $parser->parse_file( $newopts{'file'} );
+               } catch( $err ) {
+                       $errmsg = "XML file parsing error: $err";
+               }
+               if( $doc ) {
+                       if( $doc->documentElement->nodeName eq 'GraphML' ) {
+                               $type = 'CollateX';
+                       } elsif( $doc->documentElement->nodeName ne 'TEI' ) {
+                               $errmsg = 'Unrecognized XML type ' . $doc->documentElement->nodeName;
+                       } else {
+                               my $xpc = XML::LibXML::XPathContext->new( $doc->documentElement );
+                               my $venc = $xpc->findvalue( '/TEI/teiHeader/encodingDesc/variantEncoding/attribute::method' );
+                               if( $venc && $venc eq 'double-end-point' ) {
+                                       $type = 'CTE';
+                               } else {
+                                       $type = 'TEI';
+                               }
+                       }
+               }
+               # Try the relevant XML parsing option.
+               if( $type ) {
+                       delete $newopts{'file'};
+                       $newopts{'xmlobj'} = $doc;
                        try {
                                $tradition = Text::Tradition->new( %newopts, 'input' => $type );
                        } catch ( Text::Tradition::Error $e ) {
                                $errmsg = $e->message;
-                       } catch {
-                               $errmsg = "Unexpected parsing error";
-                       }
-                       if( $tradition ) {
-                               $errmsg = undef;
-                               last;
+                       } catch ( $e ) {
+                               $errmsg = "Unexpected parsing error: $e";
                        }
                }
        } elsif( $ext =~ /^(txt|csv|xls(x)?)$/ ) {
@@ -161,8 +185,8 @@ sub newtradition :Local :Args(0) {
                                );
                } catch ( Text::Tradition::Error $e ) {
                        $errmsg = $e->message;
-               } catch {
-                       $errmsg = "Unexpected parsing error";
+               } catch ( $e ) {
+                       $errmsg = "Unexpected parsing error: $e";
                }
        } else {
                # Error unless we have a recognized filename extension
@@ -255,6 +279,9 @@ sub textinfo :Local :Args(1) {
                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 ) {
@@ -295,7 +322,8 @@ sub textinfo :Local :Args(1) {
        if( $tradition->can('language') ) {
                $textinfo->{'language'} = $tradition->language;
        }
-       my @stemmasvg = map { $_->as_svg() } $tradition->stemmata;
+       my @stemmasvg = map { { name => $_->identifier, svg => $_->as_svg() } } 
+               $tradition->stemmata;
        map { $_ =~ s/\n/ /mg } @stemmasvg;
        $textinfo->{stemmata} = \@stemmasvg;
        $c->stash->{'result'} = $textinfo;
@@ -352,10 +380,20 @@ sub stemma :Local :Args(2) {
                if( $ok eq 'full' ) {
                        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, but then we have to undo it
-                       # for the initial 'digraph stemma' statement. Horrible hack.
-                       $dot =~ s/\b(\w+)\b/"$1"/g;
-                       $dot =~ s/"(digraph|stemma)"/$1/g;
+                       # by wrapping all words in double quotes, as long as they aren't already
+                       # wrapped, and as long as they aren't the initial '(di)?graph .*'.
+                       # Horrible HACK.
+                       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.
@@ -407,7 +445,10 @@ 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,
+                       'svg' => $stemma_xml };
                $c->forward('View::JSON');
        }
 }