package Text::Tradition::Collation::Reading;
use Moose;
-use overload '""' => \&_stringify;
+use overload '""' => \&_stringify, 'fallback' => 1;
use Text::Tradition::Collation;
=head1 NAME
is( ref( $t ), 'Text::Tradition', "Parsed parallel-segmentation TEI" );
if( $t ) {
is( scalar $t->collation->readings, 319, "Collation has all readings" );
- is( scalar $t->collation->paths, 2854, "Collation has all paths" );
+ is( scalar $t->collation->paths, 374, "Collation has all paths" );
}
=end testing
}
my $source = $c->start;
foreach my $rdg ( @uncorrected ) {
- my $has_base = grep { $_->label eq $sig } $source->edges_to( $rdg );
+ my $has_base = grep { $_ eq $sig } $c->reading_witnesses( $rdg );
if( $rdg ne $c->start && !$has_base ) {
print STDERR sprintf( "Adding path %s from %s -> %s\n",
- $sig.$c->ac_label, $source->name, $rdg->name );
+ $sig.$c->ac_label, $source->id, $rdg->id );
$c->add_path( $source, $rdg, $sig.$c->ac_label );
}
$source = $rdg;
my( $arr, $start, $end, @new ) = @_;
my( $start_idx, $end_idx );
foreach my $i ( 0 .. $#{$arr} ) {
- $start_idx = $i if( $arr->[$i]->name eq $start );
- if( $arr->[$i]->name eq $end ) {
+ $start_idx = $i if( $arr->[$i]->id eq $start );
+ if( $arr->[$i]->id eq $end ) {
$end_idx = $i;
last;
}
# passed a reading object, return the object.
my $wantobj = ref( $rdg ) eq 'Text::Tradition::Collation::Reading';
my $real = $rdg;
- if( exists $substitutions->{ $wantobj ? $rdg->name : $rdg } ) {
- $real = $substitutions->{ $wantobj ? $rdg->name : $rdg };
- $real = $real->name unless $wantobj;
+ if( exists $substitutions->{ $wantobj ? $rdg->id : $rdg } ) {
+ $real = $substitutions->{ $wantobj ? $rdg->id : $rdg };
+ $real = $real->id unless $wantobj;
}
return $real;
}
next if $w !~ /[[:alnum:]]/;
my $rdg = _make_reading( $tradition->collation, $w );
push( @new_readings, $rdg );
- unless( $in_var ) {
- $rdg->make_common;
- }
foreach ( @cur_wits ) {
warn "Empty wit!" unless $_;
warn "Empty reading!" unless $rdg;
my $xml_id = $xn->getAttribute( 'xml:id' );
my $rdg = _make_reading( $tradition->collation, $xn->textContent, $xml_id );
push( @new_readings, $rdg );
- unless( $in_var ) {
- $rdg->make_common;
- }
foreach( @cur_wits ) {
warn "Empty wit!" unless $_;
warn "Empty reading!" unless $rdg;
# Return the entire set of unique readings.
my %unique;
foreach my $s ( @sets ) {
- map { $unique{$_->name} = $_ } @$s;
+ map { $unique{$_->id} = $_ } @$s;
}
push( @new_readings, values( %unique ) );
# Exit the current app.
# Add the reading set to the app anchors for each witness
# or put in placeholders for empty p.c. readings
foreach ( @rdg_wits ) {
- my $start = @words ? $words[0]->name : "PH-$current_app";
- my $end = @words ? $words[-1]->name : "PH-$current_app";
+ my $start = @words ? $words[0]->id : "PH-$current_app";
+ my $end = @words ? $words[-1]->id : "PH-$current_app";
$app_anchors->{$current_app}->{$_}->{'start'} = $start;
$app_anchors->{$current_app}->{$_}->{'end'} = $end;
push( @{$text->{$_}}, $start ) unless @words;
my $i = 0;
foreach my $sig ( keys %$text ) {
next if $active_wits{$sig};
- my $l = $tradition->collation->add_lacuna( $current_app . "_$i" );
+ my $l = $tradition->collation->add_reading( {
+ 'collation' => $tradition->collation,
+ 'id' => $current_app . "_$i",
+ 'is_lacuna' => 1 } );
$i++;
push( @{$text->{$sig}}, $l );
}
unless( $seen_apps == $app_count ) {
foreach my $i ( 0 .. $#cur_wits ) {
my $w = $cur_wits[$i];
- my $l = $tradition->collation->add_lacuna( $current_app . "_$i" );
+ my $l = $tradition->collation->add_reading( {
+ 'collation' => $tradition->collation,
+ 'id' => $current_app . "_$i",
+ 'is_lacuna' => 1 } );
push( @{$text->{$w}}, $l );
}
}
$xml_id = $try_id;
}
}
- my $rdg = $graph->add_reading( $xml_id );
- $rdg->text( $word );
+ my $rdg = $graph->add_reading(
+ { 'collation' => $graph,
+ 'id' => $xml_id,
+ 'text' => $word }
+ );
$used_nodeids{$xml_id} = $rdg;
return $rdg;
}
my @l = $diff->Items( 1 );
my @v = $diff->Items( 2 );
foreach my $i ( 0 .. $#l ) {
- if( !$merged{$l[$i]->name} ) {
+ if( !$merged{$l[$i]->id} ) {
next if $v[$i] eq $l[$i];
print STDERR sprintf( "Merging %s into %s\n",
- $v[$i]->name,
- $l[$i]->name );
+ $v[$i]->id,
+ $l[$i]->id );
$collation->merge_readings( $l[$i], $v[$i] );
- $merged{$l[$i]->name} = 1;
- $substitutions->{$v[$i]->name} = $l[$i];
+ $merged{$l[$i]->id} = 1;
+ $substitutions->{$v[$i]->id} = $l[$i];
} else {
- print STDERR "Would have double merged " . $l[$i]->name . "\n";
+ print STDERR "Would have double merged " . $l[$i]->id . "\n";
}
}
# splice the lemma nodes into the variant set
my %merged;
foreach my $idx ( 0 .. $#{$variant_set} ) {
my $vw = $variant_set->[$idx];
- my @same = grep { cmp_str( $_ ) eq $vw->label } @unique;
+ my @same = grep { cmp_str( $_ ) eq $vw->text } @unique;
my $matched;
if( @same ) {
foreach my $i ( 0 .. $#same ) {
- unless( $merged{$same[$i]->name} ) {
+ unless( $merged{$same[$i]->id} ) {
#print STDERR sprintf( "Merging %s into %s\n",
- # $vw->name,
- # $same[$i]->name );
+ # $vw->id,
+ # $same[$i]->id );
$collation->merge_readings( $same[$i], $vw );
- $merged{$same[$i]->name} = 1;
+ $merged{$same[$i]->id} = 1;
$matched = $i;
$variant_set->[$idx] = $same[$i];
- $substitutions->{$vw->name} = $same[$i];
+ $substitutions->{$vw->id} = $same[$i];
}
}
}
sub cmp_str {
my( $reading ) = @_;
- my $word = $reading->label();
+ my $word = $reading->text();
$word = lc( $word );
$word =~ s/\W//g;
$word =~ s/v/u/g;
my %unique;
my @repeated;
foreach ( @seq ) {
- if( exists $unique{$_->name} ) {
- push( @repeated, $_->name );
+ if( exists $unique{$_->id} ) {
+ push( @repeated, $_->id );
} else {
- $unique{$_->name} = 1;
+ $unique{$_->id} = 1;
}
}
return @repeated;
my( @readings ) = @_;
my( $common, $min, $max ) = ( -1, -1, -1 );
foreach my $rdg ( @readings ) {
-# print STDERR "Checking reading " . $rdg->name . "/" . $rdg->text . " - "
+# print STDERR "Checking reading " . $rdg->id . "/" . $rdg->text . " - "
# . $rdg->position->reference ."\n";
return 0 if $rdg->position->common < $common;
if( $rdg->position->common == $common ) {
}
}
-=begin testing
-
-use Text::Tradition;
-
-my $simple = 't/data/simple.txt';
-my $s = Text::Tradition->new(
- 'name' => 'inline',
- 'input' => 'Tabular',
- 'file' => $simple,
- );
-my $wit_c = $s->witness( 'C' );
-is( ref( $wit_c ), 'Text::Tradition::Witness' ),;
-if( $wit_c ) {
- ok( !$wit_c->has_text, "Text property not yet set" );
- my $c_arr = $wit_c->text;
- is( $c_arr->[0], 'Je', "Text constructed from path" );
- ok( $wit_c->has_text, "Text property now set" );
-}
-
-=end testing
-
-=cut
-
-# If the text is not present, and the path is, and this is a 'get'
-# request, generate text from path.
-around text => sub {
- my $orig = shift;
- my $self = shift;
-
- if( $self->has_path && !$self->has_text && !@_ ) {
- my @words = map { $_->label } grep { !$_->is_meta } @{$self->path};
- $self->$orig( \@words );
- }
-
- $self->$orig( @_ );
-};
-
-
no Moose;
__PACKAGE__->meta->make_immutable;
my $c = $tradition->collation;
is( scalar $c->readings, 319, "Collation has all readings" );
-is( scalar $c->paths, 2854, "Collation has all paths" );
+is( scalar $c->paths, 374, "Collation has all paths" );
is( scalar $c->relationships, 0, "Collation has all relationships" );
done_testing;
\ No newline at end of file
#!/usr/bin/perl
use strict; use warnings;
-use Test::More;
+use Test::More skip_all => "lemmatization disabled for now";
use lib 'lib';
use Text::Tradition;
use XML::LibXML;
is( ref( $t ), 'Text::Tradition', "Parsed parallel-segmentation TEI" );
if( $t ) {
is( scalar $t->collation->readings, 319, "Collation has all readings" );
- is( scalar $t->collation->paths, 2854, "Collation has all paths" );
+ is( scalar $t->collation->paths, 374, "Collation has all paths" );
}
}
-# =begin testing
-{
-use Text::Tradition;
-
-my $simple = 't/data/simple.txt';
-my $s = Text::Tradition->new(
- 'name' => 'inline',
- 'input' => 'Tabular',
- 'file' => $simple,
- );
-my $wit_c = $s->witness( 'C' );
-is( ref( $wit_c ), 'Text::Tradition::Witness' ),;
-if( $wit_c ) {
- ok( !$wit_c->has_text, "Text property not yet set" );
- my $c_arr = $wit_c->text;
- is( $c_arr->[0], 'Je', "Text constructed from path" );
- ok( $wit_c->has_text, "Text property now set" );
-}
-}
-
-
-
1;
projects / scpubgit/stemmatology.git / commitdiff