some more rehoming of functionality

[scpubgit/stemmatology.git] / lib / Text / Tradition / Collation / Reading.pm

diff --git a/lib/Text/Tradition/Collation/Reading.pm b/lib/Text/Tradition/Collation/Reading.pm
index 86b2869..e3d6d6d 100644 (file)
--- a/lib/Text/Tradition/Collation/Reading.pm
+++ b/lib/Text/Tradition/Collation/Reading.pm
@@ -14,6 +14,7 @@ subtype 'Position'
 has 'position' => (
     is => 'rw',
     isa => 'Position',
+    predicate => 'has_position',
     );
 
 # This contains an array of reading objects; the array is a pool,
@@ -24,18 +25,31 @@ has 'same_as' => (
     isa => 'ArrayRef[Text::Tradition::Collation::Reading]',
     );
 
-# This is a hash mapping of 'relationship => reading'.
-# TODO we should validate the relationships sometime.
+# # This is a hash mapping of 'relationship => reading'.
+# # TODO we should validate the relationships sometime.
 has 'relationships' => (
     is => 'ro',
     isa => 'HashRef[Text::Tradition::Collation::Reading]',
     default => sub { {} },
     );
 
+# Deal with the non-arg option for Graph::Easy's constructor.
+around BUILDARGS => sub {
+    my $orig = shift;
+    my $class = shift;
+
+    my %args;
+    if( @_ == 1 && ref( $_[0] ) ne 'HASH' ) {
+       return $class->$orig( 'name' => $_[0] );
+    } else {
+       return $class->$orig( @_ );
+    }
+};
+
 # Initialize the identity pool. 
 sub BUILD {
     my( $self, $args ) = @_;
-#    $self->same_as( [ $self ] );
+    $self->same_as( [ $self ] );
 }
 
 sub merge_from {
@@ -68,7 +82,7 @@ sub set_identical {
                                           $other_node->same_as );
 
     # ...and set this node to point to the enlarged pool.
-    $self->set_same_as( $enlarged_pool );
+    $self->same_as( $enlarged_pool );
 }   
 
 sub _merge_array_pool {
@@ -87,6 +101,17 @@ sub _merge_array_pool {
     return $main_pool;
 }
 
+sub has_primary {
+    my $self = shift;
+    my $pool = $self->same_as;
+    return $pool->[0]->name eq $self->name;
+}
+
+sub primary {
+    my $self = shift;
+    return $self->same_as->[0];
+}
+
 # Much easier to do this with a hash than with an array of Relationship objects,
 # which would be the proper OO method.
 
@@ -108,6 +133,21 @@ sub set_relationship {
     $self->relationships->{ $rel } = $value;
 }
 
+sub is_common {
+    my( $self ) = shift;
+    return $self->get_attribute( 'class' ) eq 'common';
+}
+
+sub make_common {
+    my( $self ) = shift;
+    $self->set_attribute( 'class', 'common' );
+}
+
+sub make_variant {
+    my( $self ) = shift;
+    $self->set_attribute( 'class', 'variant' );
+}
+
 no Moose;
 __PACKAGE__->meta->make_immutable;
 
@@ -119,15 +159,28 @@ __PACKAGE__->meta->make_immutable;
 # when overriding nodes, we also need ::Anon
 
 package Text::Tradition::Collation::Reading::Anon;
+use Moose;
+use MooseX::NonMoose;
+extends 'Text::Tradition::Collation::Reading';
+extends 'Graph::Easy::Node::Anon';
+no Moose;
+__PACKAGE__->meta->make_immutable;
 
-use base qw/Text::Tradition::Collation::Reading/;
-use base qw/Graph::Easy::Node::Anon/;
+1;
+# use base qw/Text::Tradition::Collation::Reading/;
+# use base qw/Graph::Easy::Node::Anon/;
 
 ######################################################
 # and :::Empty
 
 package Text::Tradition::Collation::Reading::Empty;
+use Moose;
+use MooseX::NonMoose;
+extends 'Graph::Easy::Node::Empty';
+no Moose;
+__PACKAGE__->meta->make_immutable;
 
-use base qw/Text::Tradition::Collation::Reading/;
+1;
+# use base qw/Text::Tradition::Collation::Reading/;
 
 ######################################################