initial hooks for Stemweb integration

[scpubgit/stemmatology.git] / analysis / lib / Text / Tradition / Stemma.pm

diff --git a/analysis/lib/Text/Tradition/Stemma.pm b/analysis/lib/Text/Tradition/Stemma.pm
index 764aa2f..a9203e1 100644 (file)
--- a/analysis/lib/Text/Tradition/Stemma.pm
+++ b/analysis/lib/Text/Tradition/Stemma.pm
@@ -148,20 +148,19 @@ has graph => (
     predicate => 'has_graph',
     );
     
-has is_undirected => (
+has identifier => (
        is => 'ro',
-       isa => 'Bool',
-       default => undef,
-       writer => 'set_undirected',
+       isa => 'Str',
+       writer => 'set_identifier',
+       predicate => 'has_identifier',
        );
-               
+    
 sub BUILD {
     my( $self, $args ) = @_;
     # If we have been handed a dotfile, initialize it into a graph.
     if( exists $args->{'dot'} ) {
         $self->_graph_from_dot( $args->{'dot'} );
-    } else {
-       }
+    } 
 }
 
 before 'graph' => sub {
@@ -176,7 +175,17 @@ before 'graph' => sub {
                                $g->set_vertex_attribute( $v, 'class', 'extant' );
                        }
                }
-               $self->set_undirected( $g->is_undirected );
+       }
+};
+
+after 'graph' => sub {
+       my $self = shift;
+       return unless @_;
+       unless( $self->has_identifier ) {
+               ## HORRIBLE HACK but there is no API access to graph attributes!
+               if( exists $_[0]->[4]->{'name'} ) {
+                       $self->set_identifier( $_[0]->[4]->{'name'} );
+               }
        }
 };
 
@@ -202,6 +211,12 @@ sub _graph_from_dot {
        $self->graph( $graph );
 }
 
+sub is_undirected {
+       my( $self ) = @_;
+       return undef unless $self->has_graph;
+       return $self->graph->is_undirected;
+}
+
 =head1 METHODS
 
 =head2 as_dot( \%options )
@@ -237,6 +252,7 @@ sub as_dot {
     # Get default and specified options
     my %graphopts = (
        # 'ratio' => 1,
+       'bgcolor' => 'transparent',
     );
     my %nodeopts = (
                'fontsize' => 11,
@@ -265,14 +281,11 @@ sub as_dot {
 
        # Add each of the nodes.
     foreach my $n ( $graph->vertices ) {
+       my %vattr = ( 'id' => $n );  # Set the SVG element ID to the sigil itself
         if( $graph->has_vertex_attribute( $n, 'label' ) ) {
-               my $ltext = $graph->get_vertex_attribute( $n, 'label' );
-               push( @dotlines, _make_dotline( $n, 'label' => $ltext ) );
-        } else {
-               # Use the default display settings.
-               $n = _dotquote( $n );
-            push( @dotlines, "  $n;" );
+               $vattr{'label'} = $graph->get_vertex_attribute( $n, 'label' );
         }
+               push( @dotlines, _make_dotline( $n, %vattr ) );
     }
     # Add each of our edges.
     foreach my $e ( $graph->edges ) {
@@ -451,52 +464,11 @@ sub as_svg {
     unshift( @cmd, $self->is_undirected ? 'neato' : 'dot' );
     my $svg;
     my $dotfile = File::Temp->new();
-    ## TODO REMOVE
-    # $dotfile->unlink_on_destroy(0);
     binmode $dotfile, ':utf8';
     print $dotfile $dot;
     close $dotfile;
     push( @cmd, $dotfile->filename );
     run( \@cmd, ">", binary(), \$svg );
-    # HACK: Parse the SVG and change the dimensions.
-    # Get rid of width and height attributes to allow scaling.
-    if( $opts->{'size'} ) {
-       require XML::LibXML;
-               my $parser = XML::LibXML->new( load_ext_dtd => 0 );
-               my $svgdoc;
-               eval {
-                       $svgdoc = $parser->parse_string( decode_utf8( $svg ) );
-               };
-               throw( "Could not reparse SVG: $@" ) if $@;
-       my( $ew, $eh ) = @{$opts->{'size'}};
-       # If the graph is wider than it is tall, set width to ew and remove height.
-       # Otherwise set height to eh and remove width.
-       # TODO Also scale the viewbox
-               my $width = $svgdoc->documentElement->getAttribute('width');
-               my $height = $svgdoc->documentElement->getAttribute('height');
-               $width =~ s/\D+//g;
-               $height =~ s/\D+//g;
-               my( $remove, $keep, $val, $viewbox );
-               if( $width > $height ) {
-                       $remove = 'height';
-                       $keep = 'width';
-                       $val = $ew . 'px';
-                       my $vbheight = $width / $ew * $height;
-                       $viewbox = "0.00 0.00 $width.00" . sprintf( "%.2f", $vbheight );
-               } else {
-                       $remove = 'width';
-                       $keep = 'height';
-                       $val = $eh . 'px';
-                       my $vbwidth = $height / $eh * $width;
-                       $viewbox = "0.00 0.00 " . sprintf( "%.2f", $vbwidth ) . " $height.00";
-               }
-               $svgdoc->documentElement->removeAttribute( $remove );
-               $svgdoc->documentElement->setAttribute( $keep, $val );
-               $svgdoc->documentElement->removeAttribute( 'viewBox' );
-               $svgdoc->documentElement->setAttribute( 'viewBox', $viewbox );
-               $svg = $svgdoc->toString();
-       }
-    # Return the result
     return decode_utf8( $svg );
 }