1 package Text::Tradition::Collation::Reading;
4 use Moose::Util::TypeConstraints;
7 extends 'Graph::Easy::Node';
11 => where { $_ =~ /^\d+\,\d+$/ },
12 message { 'Position must be of the form x,y' };
17 predicate => 'has_position',
20 # This contains an array of reading objects; the array is a pool,
21 # shared by the reading objects inside the pool. When a reading is
22 # added to the pool, all the same_as attributes should be updated.
25 isa => 'ArrayRef[Text::Tradition::Collation::Reading]',
28 # # This is a hash mapping of 'relationship => reading'.
29 # # TODO we should validate the relationships sometime.
30 has 'relationships' => (
32 isa => 'HashRef[Text::Tradition::Collation::Reading]',
33 default => sub { {} },
36 # Deal with the non-arg option for Graph::Easy's constructor.
37 around BUILDARGS => sub {
42 if( @_ == 1 && ref( $_[0] ) ne 'HASH' ) {
43 return $class->$orig( 'name' => $_[0] );
45 return $class->$orig( @_ );
49 # Initialize the identity pool.
51 my( $self, $args ) = @_;
52 $self->same_as( [ $self ] );
56 my( $self, $merged_node ) = @_;
57 # Adopt the identity pool of the other node.
58 my @now_identical = grep { $_ ne $merged_node } @{$merged_node->same_as};
59 my $new_pool = _merge_array_pool( \@now_identical, $self->same_as )
62 # Adopt the relationship attributes of the other node.
63 my $now_rel = $merged_node->relationships;
64 foreach my $key ( %$now_rel ) {
65 if( $self->has_relationship( $key ) ) {
66 my $related = $self->get_relationship( $key );
67 if( $now_rel->{$key} ne $related ) {
68 warn( sprintf( "Merged reading %s has relationship %s to reading %s instead of %s; skipping",
69 $merged_node->name, $key,
72 } # else no action needed
74 $self->set_relationship( $key, $now_rel->{$key} );
80 my( $self, $other_node ) = @_;
81 my $enlarged_pool = _merge_array_pool( $self->same_as,
82 $other_node->same_as );
84 # ...and set this node to point to the enlarged pool.
85 $self->same_as( $enlarged_pool );
88 sub _merge_array_pool {
89 my( $pool, $main_pool ) = @_;
91 foreach ( @$main_pool ) {
92 # Note which nodes are already in the main pool so that we
94 $poolhash{$_->name} = 1;
98 # Add the remaining nodes to the main pool...
99 push( @$main_pool, $_ ) unless $poolhash{$_->name};
106 my $pool = $self->same_as;
107 return $pool->[0]->name eq $self->name;
112 return $self->same_as->[0];
115 # Much easier to do this with a hash than with an array of Relationship objects,
116 # which would be the proper OO method.
118 sub has_relationship {
119 my( $self, $rel ) = @_;
120 return exists( $self->relationships->{ $rel } );
123 sub get_relationship {
124 my( $self, $rel ) = @_;
125 if( $self->has_relationship( $rel ) ) {
126 return $self->relationships->{ $rel };
131 sub set_relationship {
132 my( $self, $rel, $value ) = @_;
133 $self->relationships->{ $rel } = $value;
138 return $self->get_attribute( 'class' ) eq 'common';
143 $self->set_attribute( 'class', 'common' );
148 $self->set_attribute( 'class', 'variant' );
152 __PACKAGE__->meta->make_immutable;
156 ######################################################
157 ## copied from Graph::Easy::Parser docs
158 ######################################################
159 # when overriding nodes, we also need ::Anon
161 package Text::Tradition::Collation::Reading::Anon;
163 use MooseX::NonMoose;
164 extends 'Text::Tradition::Collation::Reading';
165 extends 'Graph::Easy::Node::Anon';
167 __PACKAGE__->meta->make_immutable;
170 # use base qw/Text::Tradition::Collation::Reading/;
171 # use base qw/Graph::Easy::Node::Anon/;
173 ######################################################
176 package Text::Tradition::Collation::Reading::Empty;
178 use MooseX::NonMoose;
179 extends 'Graph::Easy::Node::Empty';
181 __PACKAGE__->meta->make_immutable;
184 # use base qw/Text::Tradition::Collation::Reading/;
186 ######################################################