base/lib/Text/Tradition/Collation/Reading.pm

   1 package Text::Tradition::Collation::Reading;
   2
   3 use Moose;
   4 use Moose::Util qw/ does_role apply_all_roles /;
   5 use Text::Tradition::Datatypes;
   6 use Text::Tradition::Error;
   7 use XML::Easy::Syntax qw( $xml10_name_rx $xml10_namestartchar_rx );
   8 use overload '""' => \&_stringify, 'fallback' => 1;
   9
  10 # Enable plugin(s) if available
  11 eval { with 'Text::Tradition::Morphology'; };
  12 # Morphology package is not on CPAN, so don't warn of its absence
  13 # if( $@ ) {
  14 #       warn "Text::Tradition::Morphology not found: $@. Disabling lexeme functionality";
  15 # };
  16
  17 =head1 NAME
  18
  19 Text::Tradition::Collation::Reading - represents a reading (usually a word)
  20 in a collation.
  21
  22 =head1 DESCRIPTION
  23
  24 Text::Tradition is a library for representation and analysis of collated
  25 texts, particularly medieval ones.  A 'reading' refers to a unit of text,
  26 usually a word, that appears in one or more witnesses (manuscripts) of the
  27 tradition; the text of a given witness is composed of a set of readings in
  28 a particular sequence
  29
  30 =head1 METHODS
  31
  32 =head2 new
  33
  34 Creates a new reading in the given collation with the given attributes.
  35 Options include:
  36
  37 =over 4
  38
  39 =item collation - The Text::Tradition::Collation object to which this
  40 reading belongs.  Required.
  41
  42 =item id - A unique identifier for this reading. Required.
  43
  44 =item text - The word or other text of the reading.
  45
  46 =item is_lemma - The reading serves as a lemma for the constructed text.
  47
  48 =item is_start - The reading is the starting point for the collation.
  49
  50 =item is_end - The reading is the ending point for the collation.
  51
  52 =item is_lacuna - The 'reading' represents a known gap in the text.
  53
  54 =item is_ph - A temporary placeholder for apparatus parsing purposes.  Do
  55 not use unless you know what you are doing.
  56
  57 =item rank - The sequence number of the reading. This should probably not
  58 be set manually.
  59
  60 =back
  61
  62 One of 'text', 'is_start', 'is_end', or 'is_lacuna' is required.
  63
  64 =head2 collation
  65
  66 =head2 id
  67
  68 =head2 text
  69
  70 =head2 is_lemma
  71
  72 =head2 is_start
  73
  74 =head2 is_end
  75
  76 =head2 is_lacuna
  77
  78 =head2 rank( $new_rank )
  79
  80 Accessor methods for the given attributes.
  81
  82 =head2 alter_text
  83
  84 Changes the text of the reading.
  85
  86 =head2 make_lemma
  87
  88 Sets this reading as a lemma for the constructed text.
  89
  90 =cut
  91
  92 has 'collation' => (
  93         is => 'ro',
  94         isa => 'Text::Tradition::Collation',
  95         # required => 1,
  96         weak_ref => 1,
  97         );
  98
  99 has 'id' => (
 100         is => 'ro',
 101         isa => 'ReadingID',
 102         required => 1,
 103         );
 104
 105 has 'text' => (
 106         is => 'ro',
 107         isa => 'Str',
 108         required => 1,
 109         writer => 'alter_text',
 110         );
 111
 112 has 'is_lemma' => (
 113         is => 'ro',
 114         isa => 'Bool',
 115         default => undef,
 116         writer => 'make_lemma',
 117         );
 118
 119 has 'is_start' => (
 120         is => 'ro',
 121         isa => 'Bool',
 122         default => undef,
 123         );
 124
 125 has 'is_end' => (
 126         is => 'ro',
 127         isa => 'Bool',
 128         default => undef,
 129         );
 130
 131 has 'is_lacuna' => (
 132     is => 'ro',
 133     isa => 'Bool',
 134         default => undef,
 135     );
 136
 137 has 'is_ph' => (
 138         is => 'ro',
 139         isa => 'Bool',
 140         default => undef,
 141         );
 142
 143 has 'is_common' => (
 144         is => 'rw',
 145         isa => 'Bool',
 146         default => undef,
 147         );
 148
 149 has 'rank' => (
 150     is => 'rw',
 151     isa => 'Int',
 152     predicate => 'has_rank',
 153     clearer => 'clear_rank',
 154     );
 155
 156 ## For prefix/suffix readings
 157
 158 has 'join_prior' => (
 159         is => 'ro',
 160         isa => 'Bool',
 161         default => undef,
 162         writer => '_set_join_prior',
 163         );
 164
 165 has 'join_next' => (
 166         is => 'ro',
 167         isa => 'Bool',
 168         default => undef,
 169         writer => '_set_join_next',
 170         );
 171
 172
 173 around BUILDARGS => sub {
 174         my $orig = shift;
 175         my $class = shift;
 176         my $args;
 177         if( @_ == 1 ) {
 178                 $args = shift;
 179         } else {
 180                 $args = { @_ };
 181         }
 182
 183         # If one of our special booleans is set, we change the text and the
 184         # ID to match.
 185         if( exists $args->{'is_lacuna'} && $args->{'is_lacuna'} && !exists $args->{'text'} ) {
 186                 $args->{'text'} = '#LACUNA#';
 187         } elsif( exists $args->{'is_start'} && $args->{'is_start'} ) {
 188                 $args->{'id'} = '__START__';  # Change the ID to ensure we have only one
 189                 $args->{'text'} = '#START#';
 190                 $args->{'rank'} = 0;
 191         } elsif( exists $args->{'is_end'} && $args->{'is_end'} ) {
 192                 $args->{'id'} = '__END__';      # Change the ID to ensure we have only one
 193                 $args->{'text'} = '#END#';
 194         } elsif( exists $args->{'is_ph'} && $args->{'is_ph'} ) {
 195                 $args->{'text'} = $args->{'id'};
 196         }
 197
 198         # Backwards compatibility for non-XMLname IDs
 199         my $rid = $args->{'id'};
 200         $rid =~ s/\#/__/g;
 201         $rid =~ s/[\/,]/./g;
 202     if( $rid !~ /^$xml10_namestartchar_rx/ ) {
 203         $rid = 'r'.$rid;
 204     }
 205         $args->{'id'} = $rid;
 206
 207         $class->$orig( $args );
 208 };
 209
 210 # Look for a lexeme-string argument in the build args; if there, pull in the
 211 # morphology role if possible.
 212 sub BUILD {
 213         my( $self, $args ) = @_;
 214         if( exists $args->{'lexemes'} ) {
 215                 unless( $self->can( '_deserialize_lexemes' ) ) {
 216                         warn "No morphology package installed; DROPPING lexemes";
 217                         return;
 218                 }
 219                 $self->_deserialize_lexemes( $args->{'lexemes'} );
 220         }
 221 }
 222
 223 =head2
 224
 225 =cut
 226
 227 around make_lemma => sub {
 228         my $orig = shift;
 229         my $self = shift;
 230         my $val = shift;
 231
 232         my @altered = ( $self );
 233         if( $val ) {
 234                 # Unset the is_lemma flag for other readings at our rank
 235                 foreach my $rdg ( $self->collation->readings_at_rank( $self->rank ) ) {
 236                         next if $rdg eq $self;
 237                         if( $rdg->is_lemma ) {
 238                                 $rdg->$orig( 0 );
 239                                 push( @altered, $rdg );
 240                         }
 241                 }
 242                 # Call the morphology handler
 243                 if( $self->does( 'Text::Tradition::Morphology' ) ) {
 244                         push( @altered, $self->push_normal_form() );
 245                 }
 246         }
 247         $self->$orig( $val );
 248         return @altered;
 249 };
 250
 251 =head2 is_meta
 252
 253 A meta attribute (ha ha), which should be true if any of our 'special'
 254 booleans are true.  Implies that the reading does not represent a bit
 255 of text found in a witness.
 256
 257 =cut
 258
 259 sub is_meta {
 260         my $self = shift;
 261         return $self->is_start || $self->is_end || $self->is_lacuna || $self->is_ph;
 262 }
 263
 264 =head2 is_identical( $other_reading )
 265
 266 Returns true if the reading is identical to the other reading. The basic test
 267 is equality of ->text attributes, but this may be wrapped or overridden by
 268 extensions.
 269
 270 =cut
 271
 272 sub is_identical {
 273         my( $self, $other ) = @_;
 274         return $self->text eq $other->text;
 275 }
 276
 277 =head2 is_combinable
 278
 279 Returns true if the reading may in theory be combined into a multi-reading
 280 segment within the collation graph. The reading must not be a meta reading,
 281 and it must not have any relationships in its own right with any others.
 282 This test may be wrapped or overridden by extensions.
 283
 284 =cut
 285
 286 sub is_combinable {
 287         my $self = shift;
 288         return undef if $self->is_meta;
 289         return !$self->related_readings();
 290 }
 291
 292 # Not really meant for public consumption. Adopt the text of the other reading
 293 # into this reading.
 294 sub _combine {
 295         my( $self, $other, $joinstr ) = @_;
 296         $self->alter_text( join( $joinstr, $self->text, $other->text ) );
 297         # Change this reading to a joining one if necessary
 298         $self->_set_join_next( $other->join_next );
 299 }
 300
 301 =head1 Convenience methods
 302
 303 =head2 related_readings
 304
 305 Calls Collation's related_readings with $self as the first argument.
 306
 307 =cut
 308
 309 sub related_readings {
 310         my $self = shift;
 311         return $self->collation->related_readings( $self, @_ );
 312 }
 313
 314 =head2 witnesses
 315
 316 Calls Collation's reading_witnesses with $self as the first argument.
 317
 318 =cut
 319
 320 sub witnesses {
 321         my $self = shift;
 322         return $self->collation->reading_witnesses( $self, @_ );
 323 }
 324
 325 =head2 predecessors
 326
 327 Returns a list of Reading objects that immediately precede $self in the collation.
 328
 329 =cut
 330
 331 sub predecessors {
 332         my $self = shift;
 333         my @pred = $self->collation->sequence->predecessors( $self->id );
 334         return map { $self->collation->reading( $_ ) } @pred;
 335 }
 336
 337 =head2 successors
 338
 339 Returns a list of Reading objects that immediately follow $self in the collation.
 340
 341 =cut
 342
 343 sub successors {
 344         my $self = shift;
 345         my @succ = $self->collation->sequence->successors( $self->id );
 346         return map { $self->collation->reading( $_ ) } @succ;
 347 }
 348
 349 ## Utility methods
 350
 351 sub _stringify {
 352         my $self = shift;
 353         return $self->id;
 354 }
 355
 356 sub TO_JSON {
 357         my $self = shift;
 358         return $self->text;
 359 }
 360
 361 sub throw {
 362         Text::Tradition::Error->throw(
 363                 'ident' => 'Reading error',
 364                 'message' => $_[0],
 365                 );
 366 }
 367
 368 no Moose;
 369 __PACKAGE__->meta->make_immutable;
 370
 371 1;