X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FText%2FTradition%2FCollation%2FReading.pm;h=d1c69f7a449fb4bbb78ba1136f1bce3aaa306283;hb=7f52eac8cd00b160ea9e828790cbd093dc444feb;hp=e16818c3d5cac9d74a8a8bcacf54ff1dced9742b;hpb=df6d9812785bb672a94d3b90baf5f03abc30ba36;p=scpubgit%2Fstemmatology.git diff --git a/lib/Text/Tradition/Collation/Reading.pm b/lib/Text/Tradition/Collation/Reading.pm index e16818c..d1c69f7 100644 --- a/lib/Text/Tradition/Collation/Reading.pm +++ b/lib/Text/Tradition/Collation/Reading.pm @@ -1,164 +1,233 @@ package Text::Tradition::Collation::Reading; use Moose; -use Moose::Util::TypeConstraints; -use MooseX::NonMoose; -use Text::Tradition::Collation::Relationship; +use overload '""' => \&_stringify, 'fallback' => 1; -extends 'Graph::Easy::Node'; +=head1 NAME -subtype 'Position' - => as 'Str', - => where { $_ =~ /^\d+\,\d+$/ }, - message { 'Position must be of the form x,y' }; +Text::Tradition::Collation::Reading - represents a reading (usually a word) in a collation. + +=head1 DESCRIPTION -has 'position' => ( - is => 'rw', - isa => 'Position', - predicate => 'has_position', - ); +Text::Tradition is a library for representation and analysis of collated +texts, particularly medieval ones. A 'reading' refers to a unit of text, +usually a word, that appears in one or more witnesses (manuscripts) of the +tradition; the text of a given witness is composed of a set of readings in +a particular sequence + +=head1 METHODS + +=head2 new + +Creates a new reading in the given collation with the given attributes. +Options include: + +=over 4 + +=item collation - The Text::Tradition::Collation object to which this reading belongs. Required. + +=item id - A unique identifier for this reading. Required. + +=item text - The word or other text of the reading. + +=item is_start - The reading is the starting point for the collation. + +=item is_end - The reading is the ending point for the collation. + +=item is_lacuna - The 'reading' represents a known gap in the text. + +=item is_ph - A temporary placeholder for apparatus parsing purposes. Do not use unless you know what you are doing. + +=item rank - The sequence number of the reading. This should probably not be set manually. + +=back + +One of 'text', 'is_start', 'is_end', or 'is_lacuna' is required. + +=head2 collation + +=head2 id + +=head2 text + +=head2 is_start + +=head2 is_end + +=head2 is_lacuna + +=head2 rank + +Accessor methods for the given attributes. + +=cut + +has 'collation' => ( + is => 'ro', + isa => 'Text::Tradition::Collation', + # required => 1, + weak_ref => 1, + ); + +has 'id' => ( + is => 'ro', + isa => 'Str', + required => 1, + ); + +has 'text' => ( + is => 'ro', + isa => 'Str', + required => 1, + writer => 'alter_text', + ); + +has 'is_start' => ( + is => 'ro', + isa => 'Bool', + default => undef, + ); -# This contains an array of reading objects; the array is a pool, -# shared by the reading objects inside the pool. When a reading is -# added to the pool, all the same_as attributes should be updated. -has 'same_as' => ( +has 'is_end' => ( + is => 'ro', + isa => 'Bool', + default => undef, + ); + +has 'is_lacuna' => ( + is => 'ro', + isa => 'Bool', + default => undef, + ); + +has 'is_ph' => ( + is => 'ro', + isa => 'Bool', + default => undef, + ); + +has 'is_common' => ( + is => 'rw', + isa => 'Bool', + default => undef, + ); + +has 'rank' => ( is => 'rw', - isa => 'ArrayRef[Text::Tradition::Collation::Reading]', + isa => 'Int', + predicate => 'has_rank', ); -# Deal with the non-arg option for Graph::Easy's constructor. + around BUILDARGS => sub { - my $orig = shift; - my $class = shift; - - my %args; - if( @_ == 1 && ref( $_[0] ) ne 'HASH' ) { - return $class->$orig( 'name' => $_[0] ); - } else { - return $class->$orig( @_ ); - } + my $orig = shift; + my $class = shift; + my $args; + if( @_ == 1 ) { + $args = shift; + } else { + $args = { @_ }; + } + + # If one of our special booleans is set, we change the text and the + # ID to match. + if( exists $args->{'is_lacuna'} && !exists $args->{'text'} ) { + $args->{'text'} = '#LACUNA#'; + } elsif( exists $args->{'is_start'} ) { + $args->{'id'} = '#START#'; # Change the ID to ensure we have only one + $args->{'text'} = '#START#'; + $args->{'rank'} = 0; + } elsif( exists $args->{'is_end'} ) { + $args->{'id'} = '#END#'; # Change the ID to ensure we have only one + $args->{'text'} = '#END#'; + } elsif( exists $args->{'is_ph'} ) { + $args->{'text'} = $args->{'id'}; + } + + $class->$orig( $args ); }; -# Initialize the identity pool. -sub BUILD { - my( $self, $args ) = @_; - $self->same_as( [ $self ] ); -} +=head2 is_meta -sub text { - # Wrapper function around 'label' attribute. - my $self = shift; - if( @_ ) { - $self->set_attribute( 'label', $_[0] ); - } - return $self->get_attribute( 'label' ); -} +A meta attribute (ha ha), which should be true if any of our 'special' +booleans are true. Implies that the reading does not represent a bit +of text found in a witness. -sub merge_from { - my( $self, $merged_node ) = @_; - # Adopt the identity pool of the other node. - my @now_identical = grep { $_ ne $merged_node } @{$merged_node->same_as}; - my $new_pool = _merge_array_pool( \@now_identical, $self->same_as ) - if @now_identical; +=cut - # TODO Adopt the relationship attributes of the other node. +sub is_meta { + my $self = shift; + return $self->is_start || $self->is_end || $self->is_lacuna || $self->is_ph; } -## Dealing with transposed readings. These methods are only really -## applicable if we have a linear collation graph. +=head1 Convenience methods -sub set_identical { - my( $self, $other_node ) = @_; - my $enlarged_pool = _merge_array_pool( $self->same_as, - $other_node->same_as ); - - # ...and set this node to point to the enlarged pool. - $self->same_as( $enlarged_pool ); -} - -sub identical_readings { - my $self = shift; - my @same = grep { $_ ne $self } @{$self->same_as}; - return @same; -} +=head2 related_readings -sub _merge_array_pool { - my( $pool, $main_pool ) = @_; - my %poolhash; - foreach ( @$main_pool ) { - # Note which nodes are already in the main pool so that we - # don't re-add them. - $poolhash{$_->name} = 1; - } - - foreach( @$pool ) { - # Add the remaining nodes to the main pool... - push( @$main_pool, $_ ) unless $poolhash{$_->name}; - } - return $main_pool; -} +Calls Collation's related_readings with $self as the first argument. -sub has_primary { - my $self = shift; - my $pool = $self->same_as; - return $pool->[0]->name ne $self->name; -} +=cut -sub primary { - my $self = shift; - return $self->same_as->[0]; +sub related_readings { + my $self = shift; + return $self->collation->related_readings( $self, @_ ); } -## Keep track of which readings are unchanged across witnesses. +=head2 witnesses -sub is_common { - my( $self ) = shift; - return $self->get_attribute( 'class' ) eq 'common'; -} +Calls Collation's reading_witnesses with $self as the first argument. -sub make_common { - my( $self ) = shift; - $self->set_attribute( 'class', 'common' ); +=cut + +sub witnesses { + my $self = shift; + return $self->collation->reading_witnesses( $self, @_ ); } -sub make_variant { - my( $self ) = shift; - $self->set_attribute( 'class', 'variant' ); +=head2 predecessors + +Returns a list of Reading objects that immediately precede $self in the collation. + +=cut + +sub predecessors { + my $self = shift; + my @pred = $self->collation->sequence->predecessors( $self->id ); + return map { $self->collation->reading( $_ ) } @pred; } -no Moose; -__PACKAGE__->meta->make_immutable; +=head2 successors -1; +Returns a list of Reading objects that immediately follow $self in the collation. -###################################################### -## copied from Graph::Easy::Parser docs -###################################################### -# when overriding nodes, we also need ::Anon +=cut -package Text::Tradition::Collation::Reading::Anon; -use Moose; -use MooseX::NonMoose; -extends 'Text::Tradition::Collation::Reading'; -extends 'Graph::Easy::Node::Anon'; -no Moose; -__PACKAGE__->meta->make_immutable; +sub successors { + my $self = shift; + my @succ = $self->collation->sequence->successors( $self->id ); + return map { $self->collation->reading( $_ ) } @succ; +} -1; -# use base qw/Text::Tradition::Collation::Reading/; -# use base qw/Graph::Easy::Node::Anon/; +=head2 set_identical( $other_reading) -###################################################### -# and :::Empty +Backwards compatibility method, to add a transposition relationship +between $self and $other_reading. Don't use this. + +=cut + +sub set_identical { + my( $self, $other ) = @_; + return $self->collation->add_relationship( $self, $other, + { 'type' => 'transposition' } ); +} + +sub _stringify { + my $self = shift; + return $self->id; +} -package Text::Tradition::Collation::Reading::Empty; -use Moose; -use MooseX::NonMoose; -extends 'Graph::Easy::Node::Empty'; no Moose; __PACKAGE__->meta->make_immutable; 1; -# use base qw/Text::Tradition::Collation::Reading/; -######################################################