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         );
 164
 165 # Holds the lexemes for the reading.
 166 has 'reading_lexemes' => (
 167         traits => ['Array'],
 168         isa => 'ArrayRef[Text::Tradition::Collation::Reading::Lexeme]',
 169         handles => {
 170                 lexemes => 'elements',
 171                 has_lexemes => 'count',
 172                 clear_lexemes => 'clear',
 173                 add_lexeme => 'push',
 174                 },
 175         default => sub { [] },
 176         );
 177
 178 ## For prefix/suffix readings
 179
 180 has 'join_prior' => (
 181         is => 'ro',
 182         isa => 'Bool',
 183         default => undef,
 184         );
 185
 186 has 'join_next' => (
 187         is => 'ro',
 188         isa => 'Bool',
 189         default => undef,
 190         );
 191
 192
 193 around BUILDARGS => sub {
 194         my $orig = shift;
 195         my $class = shift;
 196         my $args;
 197         if( @_ == 1 ) {
 198                 $args = shift;
 199         } else {
 200                 $args = { @_ };
 201         }
 202
 203         # If one of our special booleans is set, we change the text and the
 204         # ID to match.
 205         if( exists $args->{'is_lacuna'} && !exists $args->{'text'} ) {
 206                 $args->{'text'} = '#LACUNA#';
 207         } elsif( exists $args->{'is_start'} ) {
 208                 $args->{'id'} = '__START__';  # Change the ID to ensure we have only one
 209                 $args->{'text'} = '#START#';
 210                 $args->{'rank'} = 0;
 211         } elsif( exists $args->{'is_end'} ) {
 212                 $args->{'id'} = '__END__';      # Change the ID to ensure we have only one
 213                 $args->{'text'} = '#END#';
 214         } elsif( exists $args->{'is_ph'} ) {
 215                 $args->{'text'} = $args->{'id'};
 216         }
 217
 218         # Backwards compatibility for non-XMLname IDs
 219         my $rid = $args->{'id'};
 220         $rid =~ s/\#/__/g;
 221         $rid =~ s/[\/,]/./g;
 222     if( $rid !~ /^$xml10_namestartchar_rx/ ) {
 223         $rid = 'r'.$rid;
 224     }
 225         $args->{'id'} = $rid;
 226
 227         $class->$orig( $args );
 228 };
 229
 230 # Look for a lexeme-string argument in the build args.
 231 sub BUILD {
 232         my( $self, $args ) = @_;
 233         if( exists $args->{'lexemes'} ) {
 234                 $self->_deserialize_lexemes( $args->{'lexemes'} );
 235         }
 236 }
 237
 238 =head2 is_meta
 239
 240 A meta attribute (ha ha), which should be true if any of our 'special'
 241 booleans are true.  Implies that the reading does not represent a bit
 242 of text found in a witness.
 243
 244 =cut
 245
 246 sub is_meta {
 247         my $self = shift;
 248         return $self->is_start || $self->is_end || $self->is_lacuna || $self->is_ph;
 249 }
 250
 251 =head1 Convenience methods
 252
 253 =head2 related_readings
 254
 255 Calls Collation's related_readings with $self as the first argument.
 256
 257 =cut
 258
 259 sub related_readings {
 260         my $self = shift;
 261         return $self->collation->related_readings( $self, @_ );
 262 }
 263
 264 =head2 witnesses
 265
 266 Calls Collation's reading_witnesses with $self as the first argument.
 267
 268 =cut
 269
 270 sub witnesses {
 271         my $self = shift;
 272         return $self->collation->reading_witnesses( $self, @_ );
 273 }
 274
 275 =head2 predecessors
 276
 277 Returns a list of Reading objects that immediately precede $self in the collation.
 278
 279 =cut
 280
 281 sub predecessors {
 282         my $self = shift;
 283         my @pred = $self->collation->sequence->predecessors( $self->id );
 284         return map { $self->collation->reading( $_ ) } @pred;
 285 }
 286
 287 =head2 successors
 288
 289 Returns a list of Reading objects that immediately follow $self in the collation.
 290
 291 =cut
 292
 293 sub successors {
 294         my $self = shift;
 295         my @succ = $self->collation->sequence->successors( $self->id );
 296         return map { $self->collation->reading( $_ ) } @succ;
 297 }
 298
 299 =head2 set_identical( $other_reading)
 300
 301 Backwards compatibility method, to add a transposition relationship
 302 between $self and $other_reading.  Don't use this.
 303
 304 =cut
 305
 306 sub set_identical {
 307         my( $self, $other ) = @_;
 308         return $self->collation->add_relationship( $self, $other,
 309                 { 'type' => 'transposition' } );
 310 }
 311
 312 sub _stringify {
 313         my $self = shift;
 314         return $self->id;
 315 }
 316
 317 =head1 MORPHOLOGY
 318
 319 Methods for the morphological information (if any) attached to readings.
 320 A reading may be made up of multiple lexemes; the concatenated lexeme
 321 strings ought to match the reading's normalized form.
 322
 323 See L<Text::Tradition::Collation::Reading::Lexeme> for more information
 324 on Lexeme objects and their attributes.
 325
 326 =head2 has_lexemes
 327
 328 Returns a true value if the reading has any attached lexemes.
 329
 330 =head2 lexemes
 331
 332 Returns the Lexeme objects (if any) attached to the reading.
 333
 334 =head2 clear_lexemes
 335
 336 Wipes any associated Lexeme objects out of the reading.
 337
 338 =head2 add_lexeme( $lexobj )
 339
 340 Adds the Lexeme in $lexobj to the list of lexemes.
 341
 342 =head2 lemmatize
 343
 344 If the language of the reading is set, this method will use the appropriate
 345 Language model to determine the lexemes that belong to this reading.  See
 346 L<Text::Tradition::lemmatize> if you wish to lemmatize an entire tradition.
 347
 348 =cut
 349
 350 sub lemmatize {
 351         my $self = shift;
 352         unless( $self->has_language ) {
 353                 warn "Please set a language to lemmatize a tradition";
 354                 return;
 355         }
 356         my $mod = "Text::Tradition::Language::" . $self->language;
 357         load( $mod );
 358         $mod->can( 'reading_lookup' )->( $self );
 359
 360 }
 361
 362 # For graph serialization. Return a JSON representation of the associated
 363 # reading lexemes.
 364 sub _serialize_lexemes {
 365         my $self = shift;
 366         my $json = JSON->new->allow_blessed(1)->convert_blessed(1);
 367         return $json->encode( [ $self->lexemes ] );
 368 }
 369
 370 # Given a JSON representation of the lexemes, instantiate them and add
 371 # them to the reading.
 372 sub _deserialize_lexemes {
 373         my( $self, $json ) = @_;
 374         my $data = from_json( $json );
 375         return unless @$data;
 376
 377         # Need to have the lexeme module in order to have lexemes.
 378         eval { use Text::Tradition::Collation::Reading::Lexeme; };
 379         throw( $@ ) if $@;
 380
 381         # Good to go - add the lexemes.
 382         my @lexemes;
 383         foreach my $lexhash ( @$data ) {
 384                 push( @lexemes, Text::Tradition::Collation::Reading::Lexeme->new(
 385                         'JSON' => $lexhash ) );
 386         }
 387         $self->clear_lexemes;
 388         $self->add_lexeme( @lexemes );
 389 }
 390
 391 ## Utility methods
 392
 393 sub TO_JSON {
 394         my $self = shift;
 395         return $self->text;
 396 }
 397
 398 sub throw {
 399         Text::Tradition::Error->throw(
 400                 'ident' => 'Reading error',
 401                 'message' => $_[0],
 402                 );
 403 }
 404
 405 no Moose;
 406 __PACKAGE__->meta->make_immutable;
 407
 408 1;