initial hooks for Stemweb integration

diff --git a/analysis/lib/Text/Tradition/HasStemma.pm b/analysis/lib/Text/Tradition/HasStemma.pm
index 70bab13..6e6ccd8 100644 (file)
--- a/analysis/lib/Text/Tradition/HasStemma.pm
+++ b/analysis/lib/Text/Tradition/HasStemma.pm
@@ -4,6 +4,7 @@ use strict;
 use warnings;
 use Moose::Role;
 use Text::Tradition::Stemma;
+use Text::Tradition::StemmaUtil qw/ parse_newick /;
 
 =head1 NAME
 
@@ -36,6 +37,20 @@ Return the L<Text::Tradition::Stemma> object identified by the given index.
 
 Delete all stemma hypotheses associated with this tradition.
 
+=head2 has_stemweb_jobid
+
+Returns true if there is currently a Stemweb job ID, indicating that a
+stemma tree calculation from the Stemweb service is in process.
+
+=head2 stemweb_jobid
+
+Return the currently-running job ID (if any) for calculation of Stemweb 
+trees.
+
+=head2 set_stemweb_jobid( $jobid )
+
+Record a job ID for a Stemweb calculation.
+
 =cut
 
 has 'stemmata' => (
@@ -51,6 +66,21 @@ has 'stemmata' => (
        default => sub { [] },
        );
   
+has 'stemweb_jobid' => (
+       is => 'ro',
+       isa => 'Str',
+       writer => 'set_stemweb_jobid',
+       predicate => 'has_stemweb_jobid',
+       clearer => '_clear_stemweb_jobid',
+       );
+       
+before 'set_stemweb_jobid' => sub {
+       my( $self ) = shift;
+       if( $self->has_stemweb_jobid ) {
+               $self->throw( "Tradition already has a Stemweb jobid: "
+                       . $self->stemweb_jobid );
+       }
+};
 
 =head2 add_stemma( $dotfile )
 
@@ -96,6 +126,30 @@ sub add_stemma {
        return $stemma;
 }
 
+=head2 record_stemweb_result( $format, $data )
+
+Records the result returned by a Stemweb calculation, and clears any
+existing job ID.
+
+TODO Test!
+
+=cut
+
+sub record_stemweb_result {
+       my( $self, $format, $data ) = @_;
+       if( $format eq 'dot' ) {
+               $self->add_stemma( dot => $data );
+       } elsif( $format eq 'newick' ) {
+               my $stemmata = parse_newick( $data );
+               foreach my $stemma ( @$stemmata ) {
+                       $self->_add_stemma( $stemma );
+               }
+               $self->_clear_stemweb_jobid();
+       } else {
+               $self->throw( "Cannot parse tree results with format $format" );
+       }
+}
+
 1;
 
 =head1 LICENSE

diff --git a/analysis/lib/Text/Tradition/Stemma.pm b/analysis/lib/Text/Tradition/Stemma.pm
index 3427029..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 )

diff --git a/analysis/lib/Text/Tradition/StemmaUtil.pm b/analysis/lib/Text/Tradition/StemmaUtil.pm
index a345b29..8007af6 100644 (file)
--- a/analysis/lib/Text/Tradition/StemmaUtil.pm
+++ b/analysis/lib/Text/Tradition/StemmaUtil.pm
@@ -231,8 +231,7 @@ sub parse_newick {
     # Turn the tree into a graph, starting with the root node
     foreach my $tree ( @{$forest->get_entities} ) {
         my $stemma = Text::Tradition::Stemma->new(
-               graph => _graph_from_bio( $tree ),
-               is_undirected => 1 );
+               graph => _graph_from_bio( $tree ) );
         push( @stemmata, $stemma );
     }
     return \@stemmata;