Operations that change readings as side effect should return those readings. #38
Tara L Andrews [Tue, 21 Apr 2015 21:37:45 +0000 (23:37 +0200)]
base/lib/Text/Tradition/Collation.pm
base/lib/Text/Tradition/Collation/Reading.pm
base/lib/Text/Tradition/Parser/CollateText.pm
morphology/lib/Text/Tradition/Morphology.pm
morphology/t/text_tradition_morphology.t

index 3957762..08ac94f 100644 (file)
@@ -195,12 +195,15 @@ The readings may be specified by object or ID.
 
 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 
@@ -902,7 +905,7 @@ sub clear_witness {
 
 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 ) {
@@ -913,7 +916,10 @@ sub add_relationship {
        # 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 ) {
index 45040d1..323bd76 100644 (file)
@@ -43,6 +43,8 @@ reading belongs.  Required.
 
 =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.
@@ -65,16 +67,26 @@ One of 'text', 'is_start', 'is_end', or 'is_lacuna' is required.
 
 =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' => (
@@ -208,16 +220,32 @@ sub BUILD {
        }
 }
 
+=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
index 8413939..c27aba4 100644 (file)
@@ -614,4 +614,8 @@ sub rstr {
     return $str;
 }
 
-1;
\ No newline at end of file
+1;
+
+=back
+
+=cut
\ No newline at end of file
index 31a49ef..b6a9ef6 100644 (file)
@@ -79,14 +79,17 @@ around 'normal_form' => sub {
                # 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
@@ -98,15 +101,15 @@ strings ought to match the reading's normalized form.
 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.
 
@@ -114,7 +117,7 @@ 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
@@ -243,11 +246,15 @@ after '_combine' => sub {
        }
 };
 
-=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
@@ -263,14 +270,18 @@ my $c = $t->collation;
 # 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
@@ -281,18 +292,32 @@ $r3->normal_form('YAN');
 $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" );
 
@@ -309,8 +334,10 @@ $r6->normal_form('BAZ');
 $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
 
@@ -319,25 +346,30 @@ is( $r7->normal_form, 'QUUX', "normal form on grammatical relationship unchanged
 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;
index db7483f..9ba0f76 100644 (file)
@@ -21,14 +21,18 @@ my $c = $t->collation;
 # 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
@@ -39,18 +43,32 @@ $r3->normal_form('YAN');
 $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" );
 
@@ -67,8 +85,10 @@ $r6->normal_form('BAZ');
 $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" );
 }