lib/Text/Tradition/Collation/Reading.pm

   1 package Text::Tradition::Collation::Reading;
   2
   3 use Moose;
   4 use Moose::Util::TypeConstraints;
   5 use JSON qw/ from_json /;
   6 use Module::Load;
   7 use Text::Tradition::Error;
   8 use XML::Easy::Syntax qw( $xml10_name_rx $xml10_namestartchar_rx );
   9 use YAML::XS;
  10 use overload '""' => \&_stringify, 'fallback' => 1;
  11
  12 subtype 'ReadingID',
  13         as 'Str',
  14         where { $_ =~ /\A$xml10_name_rx\z/ },
  15         message { 'Reading ID must be a valid XML attribute string' };
  16
  17 no Moose::Util::TypeConstraints;
  18
  19 =head1 NAME
  20
  21 Text::Tradition::Collation::Reading - represents a reading (usually a word)
  22 in a collation.
  23
  24 =head1 DESCRIPTION
  25
  26 Text::Tradition is a library for representation and analysis of collated
  27 texts, particularly medieval ones.  A 'reading' refers to a unit of text,
  28 usually a word, that appears in one or more witnesses (manuscripts) of the
  29 tradition; the text of a given witness is composed of a set of readings in
  30 a particular sequence
  31
  32 =head1 METHODS
  33
  34 =head2 new
  35
  36 Creates a new reading in the given collation with the given attributes.
  37 Options include:
  38
  39 =over 4
  40
  41 =item collation - The Text::Tradition::Collation object to which this
  42 reading belongs.  Required.
  43
  44 =item id - A unique identifier for this reading. Required.
  45
  46 =item text - The word or other text of the reading.
  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_start
  71
  72 =head2 is_end
  73
  74 =head2 is_lacuna
  75
  76 =head2 rank
  77
  78 Accessor methods for the given attributes.
  79
  80 =cut
  81
  82 has 'collation' => (
  83         is => 'ro',
  84         isa => 'Text::Tradition::Collation',
  85         # required => 1,
  86         weak_ref => 1,
  87         );
  88
  89 has 'id' => (
  90         is => 'ro',
  91         isa => 'ReadingID',
  92         required => 1,
  93         );
  94
  95 has 'text' => (
  96         is => 'ro',
  97         isa => 'Str',
  98         required => 1,
  99         writer => 'alter_text',
 100         );
 101
 102 has 'language' => (
 103         is => 'ro',
 104         isa => 'Str',
 105         predicate => 'has_language',
 106         );
 107
 108 has 'is_start' => (
 109         is => 'ro',
 110         isa => 'Bool',
 111         default => undef,
 112         );
 113
 114 has 'is_end' => (
 115         is => 'ro',
 116         isa => 'Bool',
 117         default => undef,
 118         );
 119
 120 has 'is_lacuna' => (
 121     is => 'ro',
 122     isa => 'Bool',
 123         default => undef,
 124     );
 125
 126 has 'is_ph' => (
 127         is => 'ro',
 128         isa => 'Bool',
 129         default => undef,
 130         );
 131
 132 has 'is_common' => (
 133         is => 'rw',
 134         isa => 'Bool',
 135         default => undef,
 136         );
 137
 138 has 'rank' => (
 139     is => 'rw',
 140     isa => 'Int',
 141     predicate => 'has_rank',
 142     clearer => 'clear_rank',
 143     );
 144
 145 ## For morphological analysis
 146
 147 has 'grammar_invalid' => (
 148         is => 'rw',
 149         isa => 'Bool',
 150         default => undef,
 151         );
 152
 153 has 'is_nonsense' => (
 154         is => 'rw',
 155         isa => 'Bool',
 156         default => undef,
 157         );
 158
 159 has 'normal_form' => (
 160         is => 'rw',
 161         isa => 'Str',
 162         predicate => '_has_normal_form',
 163         clearer => '_clear_normal_form',
 164         );
 165
 166 # Holds the lexemes for the reading.
 167 has 'reading_lexemes' => (
 168         traits => ['Array'],
 169         isa => 'ArrayRef[Text::Tradition::Collation::Reading::Lexeme]',
 170         handles => {
 171                 lexeme => 'get',
 172                 lexemes => 'elements',
 173                 has_lexemes => 'count',
 174                 clear_lexemes => 'clear',
 175                 add_lexeme => 'push',
 176                 },
 177         default => sub { [] },
 178         );
 179
 180 ## For prefix/suffix readings
 181
 182 has 'join_prior' => (
 183         is => 'ro',
 184         isa => 'Bool',
 185         default => undef,
 186         writer => '_set_join_prior',
 187         );
 188
 189 has 'join_next' => (
 190         is => 'ro',
 191         isa => 'Bool',
 192         default => undef,
 193         writer => '_set_join_next',
 194         );
 195
 196
 197 around BUILDARGS => sub {
 198         my $orig = shift;
 199         my $class = shift;
 200         my $args;
 201         if( @_ == 1 ) {
 202                 $args = shift;
 203         } else {
 204                 $args = { @_ };
 205         }
 206
 207         # If one of our special booleans is set, we change the text and the
 208         # ID to match.
 209         if( exists $args->{'is_lacuna'} && $args->{'is_lacuna'} && !exists $args->{'text'} ) {
 210                 $args->{'text'} = '#LACUNA#';
 211         } elsif( exists $args->{'is_start'} && $args->{'is_start'} ) {
 212                 $args->{'id'} = '__START__';  # Change the ID to ensure we have only one
 213                 $args->{'text'} = '#START#';
 214                 $args->{'rank'} = 0;
 215         } elsif( exists $args->{'is_end'} && $args->{'is_end'} ) {
 216                 $args->{'id'} = '__END__';      # Change the ID to ensure we have only one
 217                 $args->{'text'} = '#END#';
 218         } elsif( exists $args->{'is_ph'} && $args->{'is_ph'} ) {
 219                 $args->{'text'} = $args->{'id'};
 220         }
 221
 222         # Backwards compatibility for non-XMLname IDs
 223         my $rid = $args->{'id'};
 224         $rid =~ s/\#/__/g;
 225         $rid =~ s/[\/,]/./g;
 226     if( $rid !~ /^$xml10_namestartchar_rx/ ) {
 227         $rid = 'r'.$rid;
 228     }
 229         $args->{'id'} = $rid;
 230
 231         $class->$orig( $args );
 232 };
 233
 234 # Look for a lexeme-string argument in the build args.
 235 sub BUILD {
 236         my( $self, $args ) = @_;
 237         if( exists $args->{'lexemes'} ) {
 238                 $self->_deserialize_lexemes( $args->{'lexemes'} );
 239         }
 240 }
 241
 242 # Make normal_form default to text, transparently.
 243 around 'normal_form' => sub {
 244         my $orig = shift;
 245         my $self = shift;
 246         my( $arg ) = @_;
 247         if( $arg && $arg eq $self->text ) {
 248                 $self->_clear_normal_form;
 249                 return $arg;
 250         } elsif( !$arg && !$self->_has_normal_form ) {
 251                 return $self->text;
 252         } else {
 253                 $self->$orig( @_ );
 254         }
 255 };
 256
 257 =head2 is_meta
 258
 259 A meta attribute (ha ha), which should be true if any of our 'special'
 260 booleans are true.  Implies that the reading does not represent a bit
 261 of text found in a witness.
 262
 263 =cut
 264
 265 sub is_meta {
 266         my $self = shift;
 267         return $self->is_start || $self->is_end || $self->is_lacuna || $self->is_ph;
 268 }
 269
 270 =head1 Convenience methods
 271
 272 =head2 related_readings
 273
 274 Calls Collation's related_readings with $self as the first argument.
 275
 276 =cut
 277
 278 sub related_readings {
 279         my $self = shift;
 280         return $self->collation->related_readings( $self, @_ );
 281 }
 282
 283 =head2 witnesses
 284
 285 Calls Collation's reading_witnesses with $self as the first argument.
 286
 287 =cut
 288
 289 sub witnesses {
 290         my $self = shift;
 291         return $self->collation->reading_witnesses( $self, @_ );
 292 }
 293
 294 =head2 predecessors
 295
 296 Returns a list of Reading objects that immediately precede $self in the collation.
 297
 298 =cut
 299
 300 sub predecessors {
 301         my $self = shift;
 302         my @pred = $self->collation->sequence->predecessors( $self->id );
 303         return map { $self->collation->reading( $_ ) } @pred;
 304 }
 305
 306 =head2 successors
 307
 308 Returns a list of Reading objects that immediately follow $self in the collation.
 309
 310 =cut
 311
 312 sub successors {
 313         my $self = shift;
 314         my @succ = $self->collation->sequence->successors( $self->id );
 315         return map { $self->collation->reading( $_ ) } @succ;
 316 }
 317
 318 =head2 set_identical( $other_reading)
 319
 320 Backwards compatibility method, to add a transposition relationship
 321 between $self and $other_reading.  Don't use this.
 322
 323 =cut
 324
 325 sub set_identical {
 326         my( $self, $other ) = @_;
 327         return $self->collation->add_relationship( $self, $other,
 328                 { 'type' => 'transposition' } );
 329 }
 330
 331 sub _stringify {
 332         my $self = shift;
 333         return $self->id;
 334 }
 335
 336 =head1 MORPHOLOGY
 337
 338 Methods for the morphological information (if any) attached to readings.
 339 A reading may be made up of multiple lexemes; the concatenated lexeme
 340 strings ought to match the reading's normalized form.
 341
 342 See L<Text::Tradition::Collation::Reading::Lexeme> for more information
 343 on Lexeme objects and their attributes.
 344
 345 =head2 has_lexemes
 346
 347 Returns a true value if the reading has any attached lexemes.
 348
 349 =head2 lexemes
 350
 351 Returns the Lexeme objects (if any) attached to the reading.
 352
 353 =head2 clear_lexemes
 354
 355 Wipes any associated Lexeme objects out of the reading.
 356
 357 =head2 add_lexeme( $lexobj )
 358
 359 Adds the Lexeme in $lexobj to the list of lexemes.
 360
 361 =head2 lemmatize
 362
 363 If the language of the reading is set, this method will use the appropriate
 364 Language model to determine the lexemes that belong to this reading.  See
 365 L<Text::Tradition::lemmatize> if you wish to lemmatize an entire tradition.
 366
 367 =cut
 368
 369 sub lemmatize {
 370         my $self = shift;
 371         unless( $self->has_language ) {
 372                 warn "Please set a language to lemmatize a tradition";
 373                 return;
 374         }
 375         my $mod = "Text::Tradition::Language::" . $self->language;
 376         load( $mod );
 377         $mod->can( 'reading_lookup' )->( $self );
 378
 379 }
 380
 381 # For graph serialization. Return a JSON representation of the associated
 382 # reading lexemes.
 383 sub _serialize_lexemes {
 384         my $self = shift;
 385         my $json = JSON->new->allow_blessed(1)->convert_blessed(1);
 386         return $json->encode( [ $self->lexemes ] );
 387 }
 388
 389 # Given a JSON representation of the lexemes, instantiate them and add
 390 # them to the reading.
 391 sub _deserialize_lexemes {
 392         my( $self, $json ) = @_;
 393         my $data = from_json( $json );
 394         return unless @$data;
 395
 396         # Need to have the lexeme module in order to have lexemes.
 397         eval { use Text::Tradition::Collation::Reading::Lexeme; };
 398         throw( $@ ) if $@;
 399
 400         # Good to go - add the lexemes.
 401         my @lexemes;
 402         foreach my $lexhash ( @$data ) {
 403                 push( @lexemes, Text::Tradition::Collation::Reading::Lexeme->new(
 404                         'JSON' => $lexhash ) );
 405         }
 406         $self->clear_lexemes;
 407         $self->add_lexeme( @lexemes );
 408 }
 409
 410 sub disambiguated {
 411         my $self = shift;
 412         return 0 unless $self->has_lexemes;
 413         return !grep { !$_->is_disambiguated } $self->lexemes;
 414 }
 415
 416 ## Utility methods
 417
 418 sub TO_JSON {
 419         my $self = shift;
 420         return $self->text;
 421 }
 422
 423 sub throw {
 424         Text::Tradition::Error->throw(
 425                 'ident' => 'Reading error',
 426                 'message' => $_[0],
 427                 );
 428 }
 429
 430 no Moose;
 431 __PACKAGE__->meta->make_immutable;
 432
 433 1;