1 package Text::Tradition::Collation::Segment;
5 use Text::Tradition::Collation::Position;
7 extends 'Graph::Easy::Node';
9 # A segment is a special 'invisible' node that is a set of Readings.
10 # We should never display these, but it is useful to have them
11 # available for many-to-many relationship mappings.
15 isa => 'ArrayRef[Text::Tradition::Collation::Reading]',
21 isa => 'Text::Tradition::Collation::Position',
22 predicate => 'has_position',
25 sub FOREIGNBUILDARGS {
29 # Name the segment after its member elements.
30 my $nodename = join( ' ', map { $_->name } @{$args{'members'}} );
31 return ( 'name', $nodename );
35 my( $self, $args ) = @_;
36 $self->set_attribute( 'class', 'segment' );
38 foreach my $r ( @{$args->{members}} ) {
39 my $seg_edge = $r->parent->add_edge( $r, $self, $ctr++ );
40 $seg_edge->set_attribute( 'class', 'segment' );
42 unless ( grep { !$_->has_position } @{$args->{members}} ) {
47 # We use our 'members' array for the initialization, but afterward we
48 # go by graph edges. This ensures that merged nodes stay merged.
49 around 'members' => sub {
53 foreach my $sl ( sort { $a->name <=> $b->name }
54 grep { $_->sub_class eq 'segment' } $self->incoming ) {
55 push( @members, $sl->from );
62 my( $common, $min, $max );
63 my $readings = $self->members;
64 foreach my $r ( @{$self->members} ) {
65 if( $r->has_position ) {
66 if( $common && $common != $r->position->common ) {
67 warn "Segment adding node with position skew";
69 $common = $r->position->common;
71 $min = $r->position->min unless $min && $min < $r->position->min;
72 $max = $r->position->max unless $max && $max > $r->position->max;
74 warn "Called set_position on segment which has an unpositioned reading";
77 $self->position( Text::Tradition::Collation::Position->new(
78 common => $common, min => $min, max => $max
81 sub neighbor_readings {
82 my( $self, $direction ) = @_;
83 $direction = 'both' unless $direction;
85 if( $direction !~ /^back/ ) {
86 # We want forward readings.
87 push( @answer, $self->members->[0]->neighbor_readings( 'forward' ) );
89 if( $direction ne 'forward' ) {
90 # We want backward readings.
91 push( @answer, $self->members->[0]->neighbor_readings( 'back' ) );
97 __PACKAGE__->meta->make_immutable;
101 ######################################################
102 ## copied from Graph::Easy::Parser docs
103 ######################################################
104 # when overriding nodes, we also need ::Anon
106 package Text::Tradition::Collation::Segment::Anon;
108 use MooseX::NonMoose;
109 extends 'Text::Tradition::Collation::Segment';
110 extends 'Graph::Easy::Node::Anon';
112 __PACKAGE__->meta->make_immutable;
115 # use base qw/Text::Tradition::Collation::Segment/;
116 # use base qw/Graph::Easy::Node::Anon/;
118 ######################################################
121 package Text::Tradition::Collation::Segment::Empty;
123 use MooseX::NonMoose;
124 extends 'Graph::Easy::Node::Empty';
126 __PACKAGE__->meta->make_immutable;
129 # use base qw/Text::Tradition::Collation::Segment/;
131 ######################################################