get rid of SVG cache
Tara L Andrews [Tue, 17 Jul 2012 11:43:54 +0000 (13:43 +0200)]
1  2 
lib/Text/Tradition/Collation.pm

@@@ -11,8 -11,6 +11,6 @@@ use Text::Tradition::Collation::Reading
  use Text::Tradition::Collation::RelationshipStore;
  use Text::Tradition::Error;
  use XML::Easy::Syntax qw( $xml10_namestartchar_rx $xml10_namechar_rx );
- use XML::LibXML;
- use XML::LibXML::XPathContext;
  use Moose;
  
  has 'sequence' => (
@@@ -102,6 -100,13 +100,6 @@@ has 'end' => 
        weak_ref => 1,
        );
        
 -has 'cached_svg' => (
 -      is => 'rw',
 -      isa => 'Str',
 -      predicate => 'has_cached_svg',
 -      clearer => 'wipe_svg',
 -      );
 -      
  has 'cached_table' => (
        is => 'rw',
        isa => 'HashRef',
@@@ -441,6 -446,15 +439,15 @@@ sub compress_readings 
        # readings.
        my %gobbled;
        foreach my $rdg ( sort { $a->rank <=> $b->rank } $self->readings ) {
+               # While we are here, get rid of any extra wordforms from a disambiguated
+               # reading.
+               if( $rdg->disambiguated ) {
+                       foreach my $lex ( $rdg->lexemes ) {
+                               $lex->clear_matching_forms();
+                               $lex->add_matching_form( $lex->form );
+                       }
+               }
+               # Now look for readings that can be joined to their successors.
                next if $rdg->is_meta;
                next if $gobbled{$rdg->id};
                next if $rdg->grammar_invalid || $rdg->is_nonsense;
@@@ -634,17 -648,22 +641,17 @@@ sub as_svg 
      my $want_subgraph = exists $opts->{'from'} || exists $opts->{'to'};
      $self->calculate_ranks() 
        unless( $self->_graphcalc_done || $opts->{'nocalc'} || !$self->linear );
 -    if( !$self->has_cached_svg || $opts->{'recalc'}   || $want_subgraph ) {        
 -              my @cmd = qw/dot -Tsvg/;
 -              my( $svg, $err );
 -              my $dotfile = File::Temp->new();
 -              ## USE FOR DEBUGGING
 -              # $dotfile->unlink_on_destroy(0);
 -              binmode $dotfile, ':utf8';
 -              print $dotfile $self->as_dot( $opts );
 -              push( @cmd, $dotfile->filename );
 -              run( \@cmd, ">", binary(), \$svg );
 -              $svg = decode_utf8( $svg );
 -              $self->cached_svg( $svg ) unless $want_subgraph;
 -              return $svg;
 -      } else {
 -              return $self->cached_svg;
 -      }
 +      my @cmd = qw/dot -Tsvg/;
 +      my( $svg, $err );
 +      my $dotfile = File::Temp->new();
 +      ## USE FOR DEBUGGING
 +      # $dotfile->unlink_on_destroy(0);
 +      binmode $dotfile, ':utf8';
 +      print $dotfile $self->as_dot( $opts );
 +      push( @cmd, $dotfile->filename );
 +      run( \@cmd, ">", binary(), \$svg );
 +      $svg = decode_utf8( $svg );
 +      return $svg;
  }
  
  
@@@ -1009,6 -1028,7 +1016,7 @@@ sub as_graphml 
          'http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd';
  
      # Create the document and root node
+     require XML::LibXML;
      my $graphml = XML::LibXML->createDocument( "1.0", "UTF-8" );
      my $root = $graphml->createElementNS( $graphml_ns, 'graphml' );
      $graphml->setDocumentElement( $root );
        'RelationshipScope' => 'string',
      );
      
 -    # List of attribute names *not* to save on our objects.
 -    # We will also not save any attribute beginning with _.
 -    my %skipsave;
 -    map { $skipsave{$_} = 1 } qw/ cached_svg /;
 -
      # Add the data keys for the graph. Include an extra key 'version' for the
      # GraphML output version.
      my %graph_data_keys;
        map { $gattr_from{$_->name} = 'Collation' } $cmeta->get_all_attributes;
        foreach my $attr ( ( $tmeta->get_all_attributes, $cmeta->get_all_attributes ) ) {
                next if $attr->name =~ /^_/;
--              next if $skipsave{$attr->name};
                next unless $save_types{$attr->type_constraint->name};
                $graph_attributes{$attr->name} = $save_types{$attr->type_constraint->name};
        }
      my $rmeta = Text::Tradition::Collation::Reading->meta;
      foreach my $attr( $rmeta->get_all_attributes ) {
                next if $attr->name =~ /^_/;
--              next if $skipsave{$attr->name};
                next unless $save_types{$attr->type_constraint->name};
                $reading_attributes{$attr->name} = $save_types{$attr->type_constraint->name};
        }
      my $pmeta = Text::Tradition::Collation::Relationship->meta;
      foreach my $attr( $pmeta->get_all_attributes ) {
                next if $attr->name =~ /^_/;
--              next if $skipsave{$attr->name};
                next unless $save_types{$attr->type_constraint->name};
                $edge_attributes{$attr->name} = $save_types{$attr->type_constraint->name};
        }
@@@ -1626,7 -1651,7 +1631,7 @@@ sub calculate_ranks 
          }
      }
      # Do we need to invalidate the cached data?
 -    if( $self->has_cached_svg || $self->has_cached_table ) {
 +    if( $self->has_cached_table ) {
        foreach my $r ( $self->readings ) {
                next if defined( $existing_ranks{$r} ) 
                        && $existing_ranks{$r} == $r->rank;
  
  sub _clear_cache {
        my $self = shift;
 -      $self->wipe_svg if $self->has_cached_svg;
        $self->wipe_table if $self->has_cached_table;
  }