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' };
19 # This contains an array of reading objects; the array is a pool,
20 # shared by the reading objects inside the pool. When a reading is
21 # added to the pool, all the same_as attributes should be updated.
24 isa => 'ArrayRef[Text::Tradition::Collation::Reading]',
27 # This is a hash mapping of 'relationship => reading'.
28 # TODO we should validate the relationships sometime.
29 has 'relationships' => (
31 isa => 'HashRef[Text::Tradition::Collation::Reading]',
32 default => sub { {} },
35 # Initialize the identity pool.
37 my( $self, $args ) = @_;
38 # $self->same_as( [ $self ] );
42 my( $self, $merged_node ) = @_;
43 # Adopt the identity pool of the other node.
44 my @now_identical = grep { $_ ne $merged_node } @{$merged_node->same_as};
45 my $new_pool = _merge_array_pool( \@now_identical, $self->same_as )
48 # Adopt the relationship attributes of the other node.
49 my $now_rel = $merged_node->relationships;
50 foreach my $key ( %$now_rel ) {
51 if( $self->has_relationship( $key ) ) {
52 my $related = $self->get_relationship( $key );
53 if( $now_rel->{$key} ne $related ) {
54 warn( sprintf( "Merged reading %s has relationship %s to reading %s instead of %s; skipping",
55 $merged_node->name, $key,
58 } # else no action needed
60 $self->set_relationship( $key, $now_rel->{$key} );
66 my( $self, $other_node ) = @_;
67 my $enlarged_pool = _merge_array_pool( $self->same_as,
68 $other_node->same_as );
70 # ...and set this node to point to the enlarged pool.
71 $self->set_same_as( $enlarged_pool );
74 sub _merge_array_pool {
75 my( $pool, $main_pool ) = @_;
77 foreach ( @$main_pool ) {
78 # Note which nodes are already in the main pool so that we
80 $poolhash{$_->name} = 1;
84 # Add the remaining nodes to the main pool...
85 push( @$main_pool, $_ ) unless $poolhash{$_->name};
90 # Much easier to do this with a hash than with an array of Relationship objects,
91 # which would be the proper OO method.
93 sub has_relationship {
94 my( $self, $rel ) = @_;
95 return exists( $self->relationships->{ $rel } );
98 sub get_relationship {
99 my( $self, $rel ) = @_;
100 if( $self->has_relationship( $rel ) ) {
101 return $self->relationships->{ $rel };
106 sub set_relationship {
107 my( $self, $rel, $value ) = @_;
108 $self->relationships->{ $rel } = $value;
112 __PACKAGE__->meta->make_immutable;
116 ######################################################
117 ## copied from Graph::Easy::Parser docs
118 ######################################################
119 # when overriding nodes, we also need ::Anon
121 package Text::Tradition::Collation::Reading::Anon;
123 use base qw/Text::Tradition::Collation::Reading/;
124 use base qw/Graph::Easy::Node::Anon/;
126 ######################################################
129 package Text::Tradition::Collation::Reading::Empty;
131 use base qw/Text::Tradition::Collation::Reading/;
133 ######################################################