From: tla <tla@mit.edu>
Date: Sat, 19 Oct 2013 13:51:21 +0000 (+0200)
Subject: initial hooks for Stemweb integration
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=98f2239031bacaa896383837d0cddc578791bd88;p=scpubgit%2Fstemmatology.git

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
--- 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
--- 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
--- 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;