From: Tara L Andrews <tla@mit.edu>
Date: Sun, 30 Oct 2011 21:17:22 +0000 (+0100)
Subject: remove deprecated Position and Segment modules
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=85bb98307e622f456a33b7d31342b2900d47b51d;p=scpubgit%2Fstemmatology.git

remove deprecated Position and Segment modules
---

diff --git a/lib/Text/Tradition/Collation/Position.pm b/lib/Text/Tradition/Collation/Position.pm
deleted file mode 100644
index 3fd77bd..0000000
--- a/lib/Text/Tradition/Collation/Position.pm
+++ /dev/null
@@ -1,141 +0,0 @@
-package Text::Tradition::Collation::Position;
-
-use Moose;
-
-has 'common' => (
-    is => 'rw',
-    isa => 'Int',
-    required => 1,
-    );
-
-has 'min' => (
-    is => 'rw',
-    isa => 'Int',
-    required => 1,
-    );
-
-has 'max' => (
-    is => 'rw',
-    isa => 'Int',
-    required => 1,
-    );
-
-# This gets set if we are tracking a more specifically-positioned
-# reading.
-has 'matched' => (
-    is => 'rw',
-    isa => 'Bool',
-    );
-
-around BUILDARGS => sub {
-    my $orig = shift;
-    my $class = shift;
-
-    # Two ways we can be called - with the arguments we expect, or with a
-    # single argument to be parsed out into a position.
-    my %args;
-    if( @_ == 1 ) {
-        my( $common, $min, $max ) = parse_reference( $_[0] );
-        %args = ( 'common' => $common,
-                  'min' => $min,
-                  'max' => $max );
-    } elsif ( 2 <= @_ && @_ <= 3 ) {
-        my( $common, $min, $max ) = @_;
-        $max = $min unless $max;
-        %args = ( 'common' => $common,
-                  'min' => $min,
-                  'max' => $max );
-    } else {
-        %args = @_;
-    }
-
-    return $class->$orig( %args );
-};
-
-sub BUILD {
-    my $self = shift;
-    if( $self->min > $self->max ) {
-        die "Position minimum cannot be higher than maximum";
-    }
-}
-
-sub parse_reference {
-    my( $ref ) = @_;
-    if( $ref =~ /^(\d+),(\d+)(\-(\d+))?$/ ) {
-        my( $common, $min, $max ) = ( $1, $2, $4 );
-        $max = $min unless defined $max;
-        return( $common, $min, $max );
-    } else {
-        warn "Bad argument $ref passed to Position constructor";
-        return undef;
-    }
-}
-
-# Instance method
-sub cmp_with {
-    my( $self, $other ) = @_;
-    return _cmp_bits( [ $self->common, $self->min, $self->max ],
-                      [ $other->common, $other->min, $other->max ] );
-}
-
-# Class method
-sub str_cmp {
-    my( $a, $b ) = @_;
-    my @abits = parse_reference( $a );
-    my @bbits = parse_reference( $b );
-    return _cmp_bits( \@abits, \@bbits );
-}
-
-sub _cmp_bits {
-    my( $a, $b ) = @_;
-    return $a->[0] <=> $b->[0]
-        unless $a->[0] == $b->[0];
-    return $a->[1] <=> $b->[1]
-        unless $a->[1] == $b->[1];
-    return $a->[2] <=> $b->[2];
-}
-
-sub minref {
-    my $self = shift;
-    return join(',', $self->common, $self->min );
-}
-
-sub maxref {
-    my $self = shift;
-    return join(',', $self->common, $self->max );
-}
-
-sub reference {
-    my $self = shift;
-    my $answer = join( ',', $self->common, $self->min );
-    $answer .= '-'. $self->max unless $self->min == $self->max;
-    return $answer;
-}
-
-sub fixed {
-    my $self = shift;
-    return $self->min == $self->max;
-}
-
-sub is_colocated {
-    my( $self, $other, $strict ) = @_;
-    if( $strict ) {
-        return $self->common == $other->common
-            && $self->min == $other->min
-            && $self->max == $other->max;
-    } else {
-        return $self->common == $other->common 
-            && $self->min <= $other->max
-            && $self->max >= $other->min;
-    }
-}
-
-# Return all the possible fixed position refs.
-sub possible_positions {
-    my $self = shift;
-    my @possible = map { join( ',', $self->common, $_ ) } ( $self->min .. $self->max );
-    return @possible;
-}
-
-no Moose;
-__PACKAGE__->meta->make_immutable;
diff --git a/lib/Text/Tradition/Collation/Reading.pm b/lib/Text/Tradition/Collation/Reading.pm
index 74e40b5..9591206 100644
--- a/lib/Text/Tradition/Collation/Reading.pm
+++ b/lib/Text/Tradition/Collation/Reading.pm
@@ -2,16 +2,9 @@ package Text::Tradition::Collation::Reading;
 
 use Moose;
 use MooseX::NonMoose;
-use Text::Tradition::Collation::Position;
 
 extends 'Graph::Easy::Node';
 
-has 'position' => (
-    is => 'rw',
-    isa => 'Text::Tradition::Collation::Position',
-    predicate => 'has_position',
-    );
-    
 has 'rank' => (
     is => 'rw',
     isa => 'Int',
@@ -44,20 +37,6 @@ around BUILDARGS => sub {
     }
 };
 
-# Take constructor args as well as a Position argument.
-around position => sub {
-    my $orig = shift;
-    my $self = shift;
-    return $self->$orig() unless @_;
-
-    my @args = @_;
-    unless( @_ == 1 && ref( $_[0] ) eq 'Text::Tradition::Collation::Position' ) {
-	# We have constructor arguments; pass them to Position.
-	@args = ( Text::Tradition::Collation::Position->new( @_ ) );
-    }
-    $self->$orig( @args );
-};
-
 # A lacuna node is also a meta node.
 before is_lacuna => sub {
 	my( $self, $arg ) = @_;
@@ -167,12 +146,6 @@ sub primary {
     return $self->same_as->[0];
 }
 
-sub is_at_position {
-    my $self = shift;
-    return undef unless $self->has_position;
-    return $self->position->is_colocated( @_ );
-}
-
 # Looks from the outside like an accessor for a Boolean, but really 
 # sets the node's class.  Should apply to start, end, and lacunae.
 
diff --git a/lib/Text/Tradition/Collation/Segment.pm b/lib/Text/Tradition/Collation/Segment.pm
deleted file mode 100644
index ddfec9e..0000000
--- a/lib/Text/Tradition/Collation/Segment.pm
+++ /dev/null
@@ -1,131 +0,0 @@
-package Text::Tradition::Collation::Segment;
-
-use Moose;
-use MooseX::NonMoose;
-use Text::Tradition::Collation::Position;
-
-extends 'Graph::Easy::Node';
-
-# A segment is a special 'invisible' node that is a set of Readings.
-# We should never display these, but it is useful to have them
-# available for many-to-many relationship mappings.
-
-has 'members' => (
-    is => 'rw',
-    isa => 'ArrayRef[Text::Tradition::Collation::Reading]',
-    required => 1,
-);
-
-has 'position' => (
-    is => 'rw',
-    isa => 'Text::Tradition::Collation::Position',
-    predicate => 'has_position',
-);
-
-sub FOREIGNBUILDARGS {
-    my $class = shift;
-    my %args = @_;
-
-    # Name the segment after its member elements.
-    my $nodename = join( ' ', map { $_->name } @{$args{'members'}} );
-    return ( 'name', $nodename );
-}
-
-sub BUILD {
-    my( $self, $args ) = @_;
-    $self->set_attribute( 'class', 'segment' );
-    my $ctr = 1;
-    foreach my $r ( @{$args->{members}} ) {
-        my $seg_edge = $r->parent->add_edge( $r, $self, $ctr++ );
-        $seg_edge->set_attribute( 'class', 'segment' );
-    }
-    unless ( grep { !$_->has_position } @{$args->{members}} ) {
-        $self->set_position;
-    }
-}
-
-# We use our 'members' array for the initialization, but afterward we
-# go by graph edges.  This ensures that merged nodes stay merged.
-around 'members' => sub {
-    my $orig = shift;
-    my $self = shift;
-    my @members;
-    foreach my $sl ( sort { $a->name <=> $b->name } 
-                     grep { $_->sub_class eq 'segment' } $self->incoming ) {
-        push( @members, $sl->from );
-    }
-    return \@members;
-};
-
-sub set_position {
-    my $self = shift;
-    my( $common, $min, $max );
-    my $readings = $self->members;
-    foreach my $r ( @{$self->members} ) {
-        if( $r->has_position ) {
-            if( $common && $common != $r->position->common ) {
-                warn "Segment adding node with position skew";
-            } elsif( !$common ) {
-                $common = $r->position->common;
-            }
-            $min = $r->position->min unless $min && $min < $r->position->min;
-            $max = $r->position->max unless $max && $max > $r->position->max;
-        } else {
-            warn "Called set_position on segment which has an unpositioned reading";
-        }
-    }
-    $self->position( Text::Tradition::Collation::Position->new( 
-        common => $common, min => $min, max => $max
-        ) );
-}
-sub neighbor_readings {
-    my( $self, $direction ) = @_;
-    $direction = 'both' unless $direction;
-    my @answer;
-    if( $direction !~ /^back/ ) {
-        # We want forward readings.
-        push( @answer, $self->members->[0]->neighbor_readings( 'forward' ) );
-    }
-    if( $direction ne 'forward' ) {
-        # We want backward readings.
-        push( @answer, $self->members->[0]->neighbor_readings( 'back' ) );
-    }
-    return @answer;
-}
-
-no Moose;
-__PACKAGE__->meta->make_immutable;
-
-1;
-
-######################################################
-## copied from Graph::Easy::Parser docs
-######################################################
-# when overriding nodes, we also need ::Anon
-
-package Text::Tradition::Collation::Segment::Anon;
-use Moose;
-use MooseX::NonMoose;
-extends 'Text::Tradition::Collation::Segment';
-extends 'Graph::Easy::Node::Anon';
-no Moose;
-__PACKAGE__->meta->make_immutable;
-
-1;
-# use base qw/Text::Tradition::Collation::Segment/;
-# use base qw/Graph::Easy::Node::Anon/;
-
-######################################################
-# and :::Empty
-
-package Text::Tradition::Collation::Segment::Empty;
-use Moose;
-use MooseX::NonMoose;
-extends 'Graph::Easy::Node::Empty';
-no Moose;
-__PACKAGE__->meta->make_immutable;
-
-1;
-# use base qw/Text::Tradition::Collation::Segment/;
-
-######################################################