lib/Text/Tradition/Collation/Reading.pm

   1 package Text::Tradition::Collation::Reading;
   2
   3 use Moose;
   4 use Moose::Util::TypeConstraints;
   5 use MooseX::NonMoose;
   6 use Text::Tradition::Collation::Relationship;
   7
   8 extends 'Graph::Easy::Node';
   9
  10 subtype 'Position'
  11     => as 'Str',
  12     => where { $_ =~ /^\d+\,\d+$/ },
  13     message { 'Position must be of the form x,y' };
  14
  15 has 'position' => (
  16     is => 'rw',
  17     isa => 'Position',
  18     predicate => 'has_position',
  19     );
  20
  21 # This contains an array of reading objects; the array is a pool,
  22 # shared by the reading objects inside the pool.  When a reading is
  23 # added to the pool, all the same_as attributes should be updated.
  24 has 'same_as' => (
  25     is => 'rw',
  26     isa => 'ArrayRef[Text::Tradition::Collation::Reading]',
  27     );
  28
  29 # Deal with the non-arg option for Graph::Easy's constructor.
  30 around BUILDARGS => sub {
  31     my $orig = shift;
  32     my $class = shift;
  33
  34     my %args;
  35     if( @_ == 1 && ref( $_[0] ) ne 'HASH' ) {
  36         return $class->$orig( 'name' => $_[0] );
  37     } else {
  38         return $class->$orig( @_ );
  39     }
  40 };
  41
  42 # Initialize the identity pool.
  43 sub BUILD {
  44     my( $self, $args ) = @_;
  45     $self->same_as( [ $self ] );
  46 }
  47
  48 sub text {
  49     # Wrapper function around 'label' attribute.
  50     my $self = shift;
  51     if( @_ ) {
  52         $self->set_attribute( 'label', $_[0] );
  53     }
  54     return $self->get_attribute( 'label' );
  55 }
  56
  57 sub merge_from {
  58     my( $self, $merged_node ) = @_;
  59     # Adopt the identity pool of the other node.
  60     my @now_identical = grep { $_ ne $merged_node } @{$merged_node->same_as};
  61     my $new_pool = _merge_array_pool( \@now_identical, $self->same_as )
  62         if @now_identical;
  63
  64     # TODO Adopt the relationship attributes of the other node.
  65 }
  66
  67 ## Dealing with transposed readings.  These methods are only really
  68 ## applicable if we have a linear collation graph.
  69
  70 sub set_identical {
  71     my( $self, $other_node ) = @_;
  72     my $enlarged_pool = _merge_array_pool( $self->same_as,
  73                                            $other_node->same_as );
  74
  75     # ...and set this node to point to the enlarged pool.
  76     $self->same_as( $enlarged_pool );
  77 }
  78
  79 sub identical_readings {
  80     my $self = shift;
  81     my @same = grep { $_ ne $self } @{$self->same_as};
  82     return @same;
  83 }
  84
  85 sub _merge_array_pool {
  86     my( $pool, $main_pool ) = @_;
  87     my %poolhash;
  88     foreach ( @$main_pool ) {
  89         # Note which nodes are already in the main pool so that we
  90         # don't re-add them.
  91         $poolhash{$_->name} = 1;
  92     }
  93
  94     foreach( @$pool ) {
  95         # Add the remaining nodes to the main pool...
  96         push( @$main_pool, $_ ) unless $poolhash{$_->name};
  97     }
  98     return $main_pool;
  99 }
 100
 101 sub has_primary {
 102     my $self = shift;
 103     my $pool = $self->same_as;
 104     return $pool->[0]->name ne $self->name;
 105 }
 106
 107 sub primary {
 108     my $self = shift;
 109     return $self->same_as->[0];
 110 }
 111
 112 ## Keep track of which readings are unchanged across witnesses.
 113
 114 sub is_common {
 115     my( $self ) = shift;
 116     return $self->get_attribute( 'class' ) eq 'common';
 117 }
 118
 119 sub make_common {
 120     my( $self ) = shift;
 121     $self->set_attribute( 'class', 'common' );
 122 }
 123
 124 sub make_variant {
 125     my( $self ) = shift;
 126     $self->set_attribute( 'class', 'variant' );
 127 }
 128
 129 no Moose;
 130 __PACKAGE__->meta->make_immutable;
 131
 132 1;
 133
 134 ######################################################
 135 ## copied from Graph::Easy::Parser docs
 136 ######################################################
 137 # when overriding nodes, we also need ::Anon
 138
 139 package Text::Tradition::Collation::Reading::Anon;
 140 use Moose;
 141 use MooseX::NonMoose;
 142 extends 'Text::Tradition::Collation::Reading';
 143 extends 'Graph::Easy::Node::Anon';
 144 no Moose;
 145 __PACKAGE__->meta->make_immutable;
 146
 147 1;
 148 # use base qw/Text::Tradition::Collation::Reading/;
 149 # use base qw/Graph::Easy::Node::Anon/;
 150
 151 ######################################################
 152 # and :::Empty
 153
 154 package Text::Tradition::Collation::Reading::Empty;
 155 use Moose;
 156 use MooseX::NonMoose;
 157 extends 'Graph::Easy::Node::Empty';
 158 no Moose;
 159 __PACKAGE__->meta->make_immutable;
 160
 161 1;
 162 # use base qw/Text::Tradition::Collation::Reading/;
 163
 164 ######################################################