From: tla <tla@mit.edu>
Date: Fri, 13 May 2011 15:44:11 +0000 (+0200)
Subject: Start fleshing out some of these classes
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=784877d9f8a915367c1015df8383fc65b49e156b;p=scpubgit%2Fstemmatology.git

Start fleshing out some of these classes
---

diff --git a/lib/Text/Tradition.pm b/lib/Text/Tradition.pm
index a7ccf2d..d376c86 100644
--- a/lib/Text/Tradition.pm
+++ b/lib/Text/Tradition.pm
@@ -1,5 +1,3 @@
-#!/usr/bin/env perl
-
 package Text::Tradition;
 
 use Text::Tradition::Witness;
diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm
index 4bb96ca..3d6b612 100644
--- a/lib/Text/Tradition/Collation.pm
+++ b/lib/Text/Tradition/Collation.pm
@@ -1,26 +1,21 @@
-#!/usr/bin/env perl
-
 package Text::Tradition::Collation;
 use Moose;
 
 has 'graph' => (
 		is => 'ro',
-		isa => 'Text::Tradition::Graph',
+		isa => 'Graph::Easy',
+		writer => '_init_graph',
+		handles => {
+		    add_node => 'add_reading',
+		    del_node => 'del_reading',
+		    add_edge => 'add_path',
+		    del_edge => 'del_path',
+		    nodes => 'readings',
+		    edges => 'paths',
 		);
+		
 
-# The graph is full of nodes, which have positions and equivalences.
-# These have to be stored externally to the graph itself.
-has 'positions' => (
-		    is => 'ro';
-		    isa => 'Text::Tradition::Graph::Position',
-		    );
-
-has 'equivalences' => (
-		       is => 'rw';
-		       isa => 'Text::Tradition::Graph::Equivalence',
-		       );
-
-# We need a way to access the parent object.
+# TODO do we not have a way to access the parent object?
 has 'tradition' => (
 		    is => 'ro',
 		    isa => 'Text::Tradition',
@@ -41,5 +36,18 @@ has 'tradition' => (
 # constructor will also need to make the witness objects, if we didn't
 # come through option 1.
 
+# TODO BUILDARGS
+
+# Wrappers around some methods
+
+sub merge_readings {
+    my $self = shift;
+    my $first_node = shift;
+    my $second_node = shift;
+    $first_node->merge_from( $second_node );
+    unshift( @_, $first_node, $second_node );
+    return $self->graph->merge_nodes( @_ );
+}
+
 no Moose;
 __PACKAGE__->meta->make_immutable;
diff --git a/lib/Text/Tradition/Collation/Reading.pm b/lib/Text/Tradition/Collation/Reading.pm
new file mode 100644
index 0000000..54cd005
--- /dev/null
+++ b/lib/Text/Tradition/Collation/Reading.pm
@@ -0,0 +1,82 @@
+package Text::Tradition::Collation::Reading;
+
+use Moose;
+use MooseX::NonMoose;
+
+extends 'Graph::Easy::Node';
+
+subtype 'Position'
+    => as 'Str',
+    => where { $_ =~ /^\d+\,\d+$/ },
+    message { 'Position must be of the form x,y' };
+
+has 'position' => (
+		   is => 'rw',
+		   isa => 'Position',
+		   );
+
+# This contains an array of reading objects; the array is a pool,
+# shared by the reading objects inside the pool.  When a reading is
+# added to the pool, all the same_as attributes should be updated.
+has 'same_as' => (
+		  is => 'rw',
+		  isa => 'ArrayRef[Text::Tradition::Collation::Reading]',
+		  default => [ $self ],
+		  );
+
+# This is a hash mapping of 'relationship => reading'.
+# TODO we should validate the relationships sometime.
+has 'equivalence' => (
+		      is => 'ro',
+		      isa => 'HashRef[Text::Tradition::Collation::Reading]',
+		      default => {},
+		      );
+
+sub merge_from {
+    my( $self, $merged_node ) = @_;
+    # Adopt the identity pool of the other node.
+    my @now_identical = grep { $_ ne $merged_node } @{$merged_node->same_as};
+    my $new_pool = _merge_array_pool( \@now_identical, $self->same_as )
+	if @now_identical;
+
+    # Adopt the equivalence attributes of the other node.
+    my $now_equiv = $merged_node->equivalence;
+    foreach my $key ( %$now_equiv ) {
+	if( $self->has_relationship( $key ) ) {
+	    my $related = $self->get_relationship( $key );
+	    if( $now_equiv->{$key} ne $related ) {
+		warn( sprintf( "Merged reading %s has relationship %s to reading %s instead of %s; skipping",
+			       $merged_node->name, $key,
+			       $now_equiv->{$key},
+			       $related) );
+	    } # else no action needed
+	} else {
+	    $self->set_relationship( $key, $now_equiv->{$key} );
+	}
+    }
+}
+
+sub set_identical {
+    my( $self, $other_node ) = @_; 
+    my $enlarged_pool = _merge_array_pool( $self->same_as, 
+					   $other_node->same_as );
+
+    # ...and set this node to point to the enlarged pool.
+    $self->set_same_as( $enlarged_pool );
+}   
+
+sub _merge_array_pool {
+    my( $pool, $main_pool ) = @_;
+    my %poolhash;
+    foreach ( @$main_pool ) {
+	# Note which nodes are already in the main pool so that we
+	# don't re-add them.
+	$poolhash{$_->name} = 1;
+    }
+
+    foreach( @$pool ) {
+	# Add the remaining nodes to the main pool...
+	push( @$main_pool, $_ ) unless $poolhash{$_->name};
+    }
+    return $main_pool;
+}
diff --git a/lib/Text/Tradition/Witness.pm b/lib/Text/Tradition/Witness.pm
index a647bc3..4215f87 100644
--- a/lib/Text/Tradition/Witness.pm
+++ b/lib/Text/Tradition/Witness.pm
@@ -1,17 +1,42 @@
-#!/usr/bin/env perl
-
 package Text::Tradition::Witness;
 use Moose;
 
+# Sigil. Required identifier for a witness.
 has 'sigil' => (
-		is => 'rw',
+		is => 'ro',
 		isa => 'Str',
 		);
 
+# Text.  This might be an array of strings, but it might also be an
+# array of graph nodes.
 has 'text' => (
 	       is => 'rw',
 	       isa => 'Array',
 	       );
 
+# File.  This is where we read in the witness, if not from a
+# pre-prepared collation.
+has 'file' => (
+	       is => 'ro',
+	       isa => 'Str',
+	       );
+
+sub BUILD {
+    my $self = shift;
+    if( $self->has_file ) {
+	# Read the file and initialize the text.
+	open( WITNESS, $self->file ) or die "Could not open " 
+	    . $self->file . "for reading";
+	# TODO support TEI as well as plaintext, sometime
+	my @words;
+	while(<WITNESS>) {
+	    chomp;
+	    push( @words, split( /\s+/, $_ ) );
+	}
+	close WITNESS;
+	$self->text( @words );
+    }
+}
+
 no Moose;
 __PACKAGE__->meta->make_immutable;