Start fleshing out some of these classes

diff --git a/lib/Text/Tradition.pm b/lib/Text/Tradition.pm
index a7ccf2d..d376c86 100644 (file)
--- 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 (file)
--- 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 (file)
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 (file)
--- 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;