Commit | Line | Data |
d047cd52 |
1 | package Text::Tradition::Collation::Relationship; |
2 | |
3 | use Moose; |
4 | use Moose::Util::TypeConstraints; |
3265b0ce |
5 | ## CAREFUL in our use of Moose::Util::TypeConstraints. That 'from' |
6 | ## clashes with Graph::Easy::Edge 'from', so we'll need to unimport |
7 | ## TypeConstraints after defining the types. Or else we would have to |
8 | ## finally split out our types into another module. |
9 | use MooseX::NonMoose; |
d047cd52 |
10 | |
3265b0ce |
11 | extends 'Graph::Easy::Edge'; |
d047cd52 |
12 | |
ef9d481f |
13 | enum 'RelationshipType' => qw( spelling orthographic grammatical repetition lexical ); |
3265b0ce |
14 | |
15 | subtype 'RelationshipVector', |
16 | => as 'ArrayRef', |
17 | => where { @$_ == 2 |
b15511bf |
18 | && $_->[0]->isa( 'Graph::Easy::Node' ) |
19 | && $_->[1]->isa( 'Graph::Easy::Node' ) |
3265b0ce |
20 | }, |
21 | message { 'Argument should be [ SourceReading, TargetReading ]' }; |
22 | |
23 | subtype 'RelationshipTokenVector', |
24 | => as 'ArrayRef', |
25 | => where { @$_ == 2 }, |
26 | message { 'Argument should be [ \'source\', \'target\' ]' }; |
27 | |
28 | no Moose::Util::TypeConstraints; ## see comment above |
29 | |
4cdd82f1 |
30 | has 'type' => ( |
d047cd52 |
31 | is => 'rw', |
32 | isa => 'RelationshipType', |
33 | required => 1, |
34 | ); |
35 | |
4cdd82f1 |
36 | has 'this_relation' => ( |
d047cd52 |
37 | is => 'rw', |
3265b0ce |
38 | isa => 'RelationshipVector', |
d047cd52 |
39 | required => 1, |
40 | ); |
41 | |
4cdd82f1 |
42 | has 'primary_relation' => ( |
3265b0ce |
43 | is => 'rw', |
44 | isa => 'RelationshipTokenVector', |
45 | ); |
46 | |
d047cd52 |
47 | has 'global' => ( |
48 | is => 'rw', |
49 | isa => 'Bool', |
3265b0ce |
50 | default => 0, |
d047cd52 |
51 | ); |
52 | |
b15511bf |
53 | has 'non_correctable' => ( |
54 | is => 'rw', |
55 | isa => 'Bool', |
56 | ); |
57 | |
58 | has 'non_independent' => ( |
59 | is => 'rw', |
60 | isa => 'Bool', |
61 | ); |
62 | |
3265b0ce |
63 | sub FOREIGNBUILDARGS { |
64 | my $class = shift; |
65 | my %args = @_; |
66 | |
4cdd82f1 |
67 | # Make the label match our 'type' attribute. |
3265b0ce |
68 | my @superclass_args; |
4cdd82f1 |
69 | if( exists $args{'type'} ) { |
70 | push( @superclass_args, 'label', $args{'type'} ); |
3265b0ce |
71 | } |
72 | return @superclass_args; |
73 | } |
74 | |
75 | sub BUILD { |
76 | my( $self, $args ) = @_; |
77 | |
78 | $self->set_attribute( 'class', 'relationship' ); |
79 | |
4cdd82f1 |
80 | my( $source, $target ) = @{$self->this_relation}; |
81 | if( $source->has_position && $target->has_position ) { |
82 | # Harmonize the positions. |
83 | $source->match_position( $target ); |
3265b0ce |
84 | } |
4cdd82f1 |
85 | unless( $self->primary_relation ) { |
86 | $self->primary_relation( [ $self->this_relation->[0]->label, |
87 | $self->this_relation->[1]->label ] ); |
3265b0ce |
88 | } |
89 | } |
90 | |
91 | no Moose; |
92 | __PACKAGE__->meta->make_immutable; |