Returns all Relationship objects in the collation.
-=head2 add_relationship( $reading, $other_reading, $options )
+=head2 add_relationship( $reading, $other_reading, $options, $changed_readings )
Adds a new relationship of the type given in $options between the two readings,
which may be specified by object or ID. Returns a value of ( $status, @vectors)
where $status is true on success, and @vectors is a list of relationship edges
-that were ultimately added.
+that were ultimately added. If an array reference is passed in as $changed_readings,
+then any readings that were altered due to the relationship creation are added to
+the array.
+
See L<Text::Tradition::Collation::Relationship> for the available options.
=cut
sub add_relationship {
my $self = shift;
- my( $source, $target, $opts ) = $self->_stringify_args( @_ );
+ my( $source, $target, $opts, $altered_readings ) = $self->_stringify_args( @_ );
my( @vectors ) = $self->relations->add_relationship( $source, $target, $opts );
my $did_recalc;
foreach my $v ( @vectors ) {
# If it's a spelling or orthographic relationship, and one is marked
# as a lemma, set the normal form on the non-lemma to reflect that.
if( $r1->does( 'Text::Tradition::Morphology' ) ) {
- $r1->relationship_added( $r2, $rel );
+ my @changed = $r1->relationship_added( $r2, $rel );
+ if( ref( $altered_readings ) eq 'ARRAY' ) {
+ push( @$altered_readings, @changed );
+ }
}
next if $did_recalc;
if( $r1->has_rank && $r2->has_rank && $r1->rank ne $r2->rank ) {
=item text - The word or other text of the reading.
+=item is_lemma - The reading serves as a lemma for the constructed text.
+
=item is_start - The reading is the starting point for the collation.
=item is_end - The reading is the ending point for the collation.
=head2 text
+=head2 is_lemma
+
=head2 is_start
=head2 is_end
=head2 is_lacuna
-=head2 rank
+=head2 rank( $new_rank )
Accessor methods for the given attributes.
+=head2 alter_text
+
+Changes the text of the reading.
+
+=head2 make_lemma
+
+Sets this reading as a lemma for the constructed text.
+
=cut
has 'collation' => (
}
}
+=head2
+
+=cut
+
around make_lemma => sub {
my $orig = shift;
my $self = shift;
my $val = shift;
- # TODO unset the lemma from any other reading at the same rank.
- if( $val && $self->does( 'Text::Tradition::Morphology' )) {
- $self->push_normal_form();
+ my @altered = ( $self );
+ if( $val ) {
+ # Unset the is_lemma flag for other readings at our rank
+ foreach my $rdg ( $self->collation->readings_at_rank( $self->rank ) ) {
+ next if $rdg eq $self;
+ if( $rdg->is_lemma ) {
+ $rdg->$orig( 0 );
+ push( @altered, $rdg );
+ }
+ }
+ # Call the morphology handler
+ if( $self->does( 'Text::Tradition::Morphology' ) ) {
+ push( @altered, $self->push_normal_form() );
+ }
}
$self->$orig( $val );
+ return @altered;
};
=head2 is_meta
return $str;
}
-1;
\ No newline at end of file
+1;
+
+=back
+
+=cut
\ No newline at end of file
# return the right default
return $self->_has_normal_form ? $self->$orig() : $self->text;
}
+ # If we are setting a new normal form, we return a list of the
+ # readings that were changed.
my $arg = shift;
+ my @altered = ( $self );
if( $arg && $arg eq $self->text ) {
$self->_clear_normal_form;
} else {
$self->$orig( $arg );
+ push( @altered, $self->push_normal_form() ) if $self->is_lemma;
}
- $self->push_normal_form() if $self->is_lemma;
- return $arg;
+ return @altered;
};
=head1 READING METHODS
See L<Text::Tradition::Collation::Reading::Lexeme> for more information
on Lexeme objects and their attributes.
-=head2 has_lexemes
+=head2 has_lexemes()
Returns a true value if the reading has any attached lexemes.
-=head2 lexemes
+=head2 lexemes()
Returns the Lexeme objects (if any) attached to the reading.
-=head2 clear_lexemes
+=head2 clear_lexemes()
Wipes any associated Lexeme objects out of the reading.
Adds the Lexeme in $lexobj to the list of lexemes.
-=head2 lemmatize
+=head2 lemmatize()
If the language of the reading is set, this method will use the appropriate
Language model to determine the lexemes that belong to this reading. See
}
};
-=head2 relationship_added
+=head2 relationship_added( $related_reading, $relationship )
To be called when a relationship is set, to implement the consequences of
certain relationships.
+=head2 push_normal_form()
+
+Copy the normal form of a reading to all its orthographically related readings.
+
=begin testing
# Test that normal form follows lemma setting. Draws on code both here and in
# First try lemmatizing and then adding a relationship
my $r1 = $c->reading('w42');
my $r2 = $c->reading('w44');
-$r1->normal_form('FOO');
+my @changed = $r1->normal_form('FOO');
+is_deeply( \@changed, [ $r1 ], "Normal form change produced no side effect" );
$r2->normal_form('BAR');
-$r1->make_lemma( 1 );
+@changed = $r1->make_lemma( 1 );
+is_deeply( \@changed, [ $r1 ], "Lemma flag changed only the concerned reading" );
is( $r1->normal_form, 'FOO', "nothing changed yet" );
is( $r2->normal_form, 'BAR', "nothing changed yet" );
-$c->add_relationship( $r1, $r2, { type => 'spelling' } );
+@changed = ();
+$c->add_relationship( $r1, $r2, { type => 'spelling' }, \@changed );
+is_deeply( \@changed, [ $r2 ], "We were informed that reading 2 changed" );
is( $r2->normal_form, 'FOO', "Normal form followed lemma" );
# Now try setting relationships and then lemmatizing
$r4->normal_form('TAN');
$r5->normal_form('TETHERA');
-$c->add_relationship( $r3, $r4, { type => 'orthographic', propagate => 1 } );
-$c->add_relationship( $r3, $r5, { type => 'orthographic', propagate => 1 } );
+@changed = ();
+$c->add_relationship( $r3, $r4, { type => 'orthographic', propagate => 1 }, \@changed );
+$c->add_relationship( $r3, $r5, { type => 'orthographic', propagate => 1 }, \@changed );
+is( scalar( @changed ), 0, "No reading side effects yet" );
is( $r3->normal_form, 'YAN', "nothing changed yet" );
is( $r4->normal_form, 'TAN', "nothing changed yet" );
is( $r5->normal_form, 'TETHERA', "nothing changed yet" );
-$r3->make_lemma( 1 );
+@changed = $r3->make_lemma( 1 );
+my %present;
+map { $present{$_->id} = 1 } @changed;
+ok( $present{$r3->id}, "Informed of change to reading 3" );
+ok( $present{$r4->id}, "Informed of change to reading 4" );
+ok( $present{$r5->id}, "Informed of change to reading 5" );
+is( scalar keys %present, 3, "Not informed of further changes" );
is( $r4->normal_form, 'YAN', "normal form propagated" );
is( $r5->normal_form, 'YAN', "normal form propagated" );
# Now try modifying the normal form and making sure the change is propagated
-$r3->normal_form( 'JIGGIT' );
+@changed = $r3->normal_form( 'JIGGIT' );
+%present = ();
+map { $present{$_->id} = 1 } @changed;
+ok( $present{$r3->id}, "Informed of change to reading 3" );
+ok( $present{$r4->id}, "Informed of change to reading 4" );
+ok( $present{$r5->id}, "Informed of change to reading 5" );
+is( scalar keys %present, 3, "Not informed of further changes" );
is( $r4->normal_form, 'JIGGIT', "new normal form propagated" );
is( $r5->normal_form, 'JIGGIT', "new normal form propagated" );
$r7->normal_form('QUUX');
$r6->make_lemma( 1 );
-$c->add_relationship( $r6, $r7, { type => 'grammatical' } );
+@changed = ();
+$c->add_relationship( $r6, $r7, { type => 'grammatical' }, \@changed );
is( $r7->normal_form, 'QUUX', "normal form on grammatical relationship unchanged" );
+is( scalar @changed, 0, "No readings were marked as changed" );
=end testing
sub relationship_added {
my( $rdg1, $rdg2, $rel ) = @_;
my $lemma = $rdg1->is_lemma ? $rdg1 : ( $rdg2->is_lemma ? $rdg2 : undef );
- if( $rel->type =~ /^(spelling|orthographic)$/ && $lemma ) {
- my $other = $lemma->id eq $rdg1->id ? $rdg2 : $rdg1;
- # Set the normal form on $other to match $lemma.
- $other->normal_form( $lemma->normal_form );
+ my @altered_readings;
+ if( $lemma ) {
+ @altered_readings = $lemma->push_normal_form();
}
+ return @altered_readings;
}
sub push_normal_form {
my $self = shift;
# Set the normal form on all orthographically related readings to match
# the normal form on this one.
+ my @altered_readings;
my $filter = sub {
my $rl = shift;
my $rltype = $self->collation->relations->type( $rl->type );
return $rltype->bindlevel < 2
};
foreach my $r ( $self->related_readings( $filter ) ) {
- $r->normal_form( $self->normal_form );
+ if( $r->normal_form ne $self->normal_form ) {
+ $r->normal_form( $self->normal_form );
+ push( @altered_readings, $r );
+ }
}
+ return @altered_readings;
}
1;
# First try lemmatizing and then adding a relationship
my $r1 = $c->reading('w42');
my $r2 = $c->reading('w44');
-$r1->normal_form('FOO');
+my @changed = $r1->normal_form('FOO');
+is_deeply( \@changed, [ $r1 ], "Normal form change produced no side effect" );
$r2->normal_form('BAR');
-$r1->make_lemma( 1 );
+@changed = $r1->make_lemma( 1 );
+is_deeply( \@changed, [ $r1 ], "Lemma flag changed only the concerned reading" );
is( $r1->normal_form, 'FOO', "nothing changed yet" );
is( $r2->normal_form, 'BAR', "nothing changed yet" );
-$c->add_relationship( $r1, $r2, { type => 'spelling' } );
+@changed = ();
+$c->add_relationship( $r1, $r2, { type => 'spelling' }, \@changed );
+is_deeply( \@changed, [ $r2 ], "We were informed that reading 2 changed" );
is( $r2->normal_form, 'FOO', "Normal form followed lemma" );
# Now try setting relationships and then lemmatizing
$r4->normal_form('TAN');
$r5->normal_form('TETHERA');
-$c->add_relationship( $r3, $r4, { type => 'orthographic', propagate => 1 } );
-$c->add_relationship( $r3, $r5, { type => 'orthographic', propagate => 1 } );
+@changed = ();
+$c->add_relationship( $r3, $r4, { type => 'orthographic', propagate => 1 }, \@changed );
+$c->add_relationship( $r3, $r5, { type => 'orthographic', propagate => 1 }, \@changed );
+is( scalar( @changed ), 0, "No reading side effects yet" );
is( $r3->normal_form, 'YAN', "nothing changed yet" );
is( $r4->normal_form, 'TAN', "nothing changed yet" );
is( $r5->normal_form, 'TETHERA', "nothing changed yet" );
-$r3->make_lemma( 1 );
+@changed = $r3->make_lemma( 1 );
+my %present;
+map { $present{$_->id} = 1 } @changed;
+ok( $present{$r3->id}, "Informed of change to reading 3" );
+ok( $present{$r4->id}, "Informed of change to reading 4" );
+ok( $present{$r5->id}, "Informed of change to reading 5" );
+is( scalar keys %present, 3, "Not informed of further changes" );
is( $r4->normal_form, 'YAN', "normal form propagated" );
is( $r5->normal_form, 'YAN', "normal form propagated" );
# Now try modifying the normal form and making sure the change is propagated
-$r3->normal_form( 'JIGGIT' );
+@changed = $r3->normal_form( 'JIGGIT' );
+%present = ();
+map { $present{$_->id} = 1 } @changed;
+ok( $present{$r3->id}, "Informed of change to reading 3" );
+ok( $present{$r4->id}, "Informed of change to reading 4" );
+ok( $present{$r5->id}, "Informed of change to reading 5" );
+is( scalar keys %present, 3, "Not informed of further changes" );
is( $r4->normal_form, 'JIGGIT', "new normal form propagated" );
is( $r5->normal_form, 'JIGGIT', "new normal form propagated" );
$r7->normal_form('QUUX');
$r6->make_lemma( 1 );
-$c->add_relationship( $r6, $r7, { type => 'grammatical' } );
+@changed = ();
+$c->add_relationship( $r6, $r7, { type => 'grammatical' }, \@changed );
is( $r7->normal_form, 'QUUX', "normal form on grammatical relationship unchanged" );
+is( scalar @changed, 0, "No readings were marked as changed" );
}
projects / scpubgit/stemmatology.git / commitdiff