lib/Text/Tradition/Collation/Reading.pm

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