lib/Text/Tradition/Collation/Segment.pm

   1 package Text::Tradition::Collation::Segment;
   2
   3 use Moose;
   4 use MooseX::NonMoose;
   5 use Text::Tradition::Collation::Position;
   6
   7 extends 'Graph::Easy::Node';
   8
   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.
  12
  13 has 'members' => (
  14     is => 'rw',
  15     isa => 'ArrayRef[Text::Tradition::Collation::Reading]',
  16     required => 1,
  17 );
  18
  19 has 'position' => (
  20     is => 'rw',
  21     isa => 'Text::Tradition::Collation::Position',
  22     predicate => 'has_position',
  23 );
  24
  25 sub FOREIGNBUILDARGS {
  26     my $class = shift;
  27     my %args = @_;
  28
  29     # Name the segment after its member elements.
  30     my $nodename = join( ' ', map { $_->name } @{$args{'members'}} );
  31     return ( 'name', $nodename );
  32 }
  33
  34 sub BUILD {
  35     my( $self, $args ) = @_;
  36     $self->set_attribute( 'class', 'segment' );
  37     my $ctr = 1;
  38     foreach my $r ( @{$args->{members}} ) {
  39         my $seg_edge = $r->parent->add_edge( $r, $self, $ctr++ );
  40         $seg_edge->set_attribute( 'class', 'segment' );
  41     }
  42     unless ( grep { !$_->has_position } @{$args->{members}} ) {
  43         $self->set_position;
  44     }
  45 }
  46
  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 {
  50     my $orig = shift;
  51     my $self = shift;
  52     my @members;
  53     foreach my $sl ( sort { $a->name <=> $b->name }
  54                      grep { $_->sub_class eq 'segment' } $self->incoming ) {
  55         push( @members, $sl->from );
  56     }
  57     return \@members;
  58 };
  59
  60 sub set_position {
  61     my $self = shift;
  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";
  68             } elsif( !$common ) {
  69                 $common = $r->position->common;
  70             }
  71             $min = $r->position->min unless $min && $min < $r->position->min;
  72             $max = $r->position->max unless $max && $max > $r->position->max;
  73         } else {
  74             warn "Called set_position on segment which has an unpositioned reading";
  75         }
  76     }
  77     $self->position( Text::Tradition::Collation::Position->new(
  78         common => $common, min => $min, max => $max
  79         ) );
  80 }
  81 sub neighbor_readings {
  82     my( $self, $direction ) = @_;
  83     $direction = 'both' unless $direction;
  84     my @answer;
  85     if( $direction !~ /^back/ ) {
  86         # We want forward readings.
  87         push( @answer, $self->members->[0]->neighbor_readings( 'forward' ) );
  88     }
  89     if( $direction ne 'forward' ) {
  90         # We want backward readings.
  91         push( @answer, $self->members->[0]->neighbor_readings( 'back' ) );
  92     }
  93     return @answer;
  94 }
  95
  96 no Moose;
  97 __PACKAGE__->meta->make_immutable;
  98
  99 1;
 100
 101 ######################################################
 102 ## copied from Graph::Easy::Parser docs
 103 ######################################################
 104 # when overriding nodes, we also need ::Anon
 105
 106 package Text::Tradition::Collation::Segment::Anon;
 107 use Moose;
 108 use MooseX::NonMoose;
 109 extends 'Text::Tradition::Collation::Segment';
 110 extends 'Graph::Easy::Node::Anon';
 111 no Moose;
 112 __PACKAGE__->meta->make_immutable;
 113
 114 1;
 115 # use base qw/Text::Tradition::Collation::Segment/;
 116 # use base qw/Graph::Easy::Node::Anon/;
 117
 118 ######################################################
 119 # and :::Empty
 120
 121 package Text::Tradition::Collation::Segment::Empty;
 122 use Moose;
 123 use MooseX::NonMoose;
 124 extends 'Graph::Easy::Node::Empty';
 125 no Moose;
 126 __PACKAGE__->meta->make_immutable;
 127
 128 1;
 129 # use base qw/Text::Tradition::Collation::Segment/;
 130
 131 ######################################################