_add_graphml_data( $node_el, $node_data_keys{'rank'}, $n->rank )
if $n->has_rank;
_add_graphml_data( $node_el, $node_data_keys{'class'}, $n->sub_class );
+ $DB::single = 1 if $n->has_primary && $n->primary ne $n;
_add_graphml_data( $node_el, $node_data_keys{'identical'}, $n->primary->name )
if $n->has_primary && $n->primary ne $n;
}
my @all_pos = ( 0 .. $self->end->rank - 1 );
foreach my $wit ( $self->tradition->witnesses ) {
# print STDERR "Making witness row(s) for " . $wit->sigil . "\n";
- my @row = _make_witness_row( $wit->path, \@all_pos, $noderefs );
+ my @wit_path = $self->reading_sequence( $self->start, $self->end, $wit->sigil );
+ my @row = _make_witness_row( \@wit_path, \@all_pos, $noderefs );
unshift( @row, $wit->sigil );
push( @$table, \@row );
- if( $wit->has_ante_corr ) {
- my @ac_row = _make_witness_row( $wit->uncorrected_path, \@all_pos, $noderefs );
+ if( $wit->is_layered ) {
+ my @wit_ac_path = $self->reading_sequence( $self->start, $self->end,
+ $wit->sigil.$self->ac_label, $wit->sigil );
+ my @ac_row = _make_witness_row( \@wit_ac_path, \@all_pos, $noderefs );
unshift( @ac_row, $wit->sigil . $self->ac_label );
push( @$table, \@ac_row );
}
## INITIALIZATION METHODS - for use by parsers
-# Walk the paths for each witness in the graph, and return the nodes
-# that the graph has in common. If $using_base is true, some
-# different logic is needed.
-# NOTE This does not create paths; it merely finds common readings.
-
-sub walk_witness_paths {
- my( $self ) = @_;
- # For each witness, walk the path through the graph.
- # Then we need to find the common nodes.
- # TODO This method is going to fall down if we have a very gappy
- # text in the collation.
- my $paths = {};
- my @common_readings;
- foreach my $wit ( $self->tradition->witnesses ) {
- my $curr_reading = $self->start;
- my @wit_path = $self->reading_sequence( $self->start, $self->end,
- $wit->sigil );
- $wit->path( \@wit_path );
-
- # Detect the common readings.
- @common_readings = _find_common( \@common_readings, \@wit_path );
- }
-
- # Mark all the nodes as either common or not.
- foreach my $cn ( @common_readings ) {
- print STDERR "Setting " . $cn->name . " / " . $cn->label
- . " as common node\n";
- $cn->make_common;
- }
- foreach my $n ( $self->readings() ) {
- $n->make_variant unless $n->is_common;
- }
- # Return an array of the common nodes in order.
- return @common_readings;
-}
-
-sub _find_common {
- my( $common_readings, $new_path ) = @_;
- my @cr;
- if( @$common_readings ) {
- foreach my $n ( @$new_path ) {
- push( @cr, $n ) if grep { $_ eq $n } @$common_readings;
- }
- } else {
- push( @cr, @$new_path );
- }
- return @cr;
-}
-
-sub _remove_common {
- my( $common_readings, $divergence ) = @_;
- my @cr;
- my %diverged;
- map { $diverged{$_->name} = 1 } @$divergence;
- foreach( @$common_readings ) {
- push( @cr, $_ ) unless $diverged{$_->name};
- }
- return @cr;
-}
-
# For use when a collation is constructed from a base text and an apparatus.
# We have the sequences of readings and just need to add path edges.
+# When we are done, clear out the witness path attributes, as they are no
+# longer needed.
+# TODO Find a way to replace the witness path attributes with encapsulated functions?
sub make_witness_paths {
my( $self ) = @_;
foreach my $idx ( 0 .. $#chain-1 ) {
$self->add_path( $chain[$idx], $chain[$idx+1], $sig );
}
- if( $wit->has_ante_corr ) {
+ if( $wit->is_layered ) {
@chain = @{$wit->uncorrected_path};
foreach my $idx( 0 .. $#chain-1 ) {
my $source = $chain[$idx];
unless $self->has_path( $source, $target, $sig );
}
}
+ $wit->clear_path;
+ $wit->clear_uncorrected_path;
}
sub calculate_ranks {
enum 'RelationshipType' => qw( spelling orthographic grammatical repetition lexical );
-subtype 'RelationshipVector',
- => as 'ArrayRef',
- => where { @$_ == 2
- && $_->[0]->isa( 'Graph::Easy::Node' )
- && $_->[1]->isa( 'Graph::Easy::Node' )
- },
- message { 'Argument should be [ SourceReading, TargetReading ]' };
-
-subtype 'RelationshipTokenVector',
- => as 'ArrayRef',
- => where { @$_ == 2 },
- message { 'Argument should be [ \'source\', \'target\' ]' };
-
no Moose::Util::TypeConstraints; ## see comment above
has 'type' => (
required => 1,
);
-has 'this_relation' => (
- is => 'rw',
- isa => 'RelationshipVector',
- required => 1,
-);
-
-has 'primary_relation' => (
- is => 'rw',
- isa => 'RelationshipTokenVector',
-);
-
has 'global' => (
is => 'rw',
isa => 'Bool',
$self->set_attribute( 'class', 'relationship' );
- unless( $self->primary_relation ) {
- $self->primary_relation( [ $self->this_relation->[0]->label,
- $self->this_relation->[1]->label ] );
- }
}
no Moose;
use strict;
use warnings;
-use Text::Tradition::Parser::GraphML qw/ graphml_parse populate_witness_path /;
+use Text::Tradition::Parser::GraphML qw/ graphml_parse /;
=head1 NAME
}
}
- # Set the $witness->path arrays for each wit.
- populate_witness_path( $tradition );
-
# Rank the readings.
$collation->calculate_ranks() if $collation->linear;
}
use XML::LibXML;
use XML::LibXML::XPathContext;
-@EXPORT_OK = qw/ graphml_parse populate_witness_path /;
+@EXPORT_OK = qw/ graphml_parse /;
=head1 NAME
return $graph_hash;
}
-=head2 B<populate_witness_path>( $tradition )
-
-Given a tradition, populate the 'path' and 'uncorrected_path' attributes
-of all of its witnesses. Useful for all formats based on the graph itself.
-
-=cut
-
-sub populate_witness_path {
- my ( $tradition, $ante_corr ) = @_;
- my $c = $tradition->collation;
- print STDERR "Walking paths for witnesses\n";
- foreach my $wit ( $tradition->witnesses ) {
- my @path = $c->reading_sequence( $c->start, $c->end, $wit->sigil );
- $wit->path( \@path );
- if( $ante_corr->{$wit->sigil} ) {
- # Get the uncorrected path too
- my @uc = $c->reading_sequence( $c->start, $c->end,
- $wit->sigil . $c->ac_label, $wit->sigil );
- $wit->uncorrected_path( \@uc );
- }
- }
-}
sub _lookup_node_data {
my( $xmlnode, $key ) = @_;
use strict;
use warnings;
-use Text::Tradition::Parser::GraphML qw/ graphml_parse populate_witness_path /;
+use Text::Tradition::Parser::GraphML qw/ graphml_parse /;
=head1 NAME
# Now add the edges.
print STDERR "Adding graph edges\n";
- my $has_ante_corr = {};
foreach my $e ( @{$graph_data->{'edges'}} ) {
my $from = $e->{$SOURCE_KEY};
my $to = $e->{$TARGET_KEY};
$tradition->add_witness( sigil => $wit );
$witnesses{$wit} = 1;
}
- $has_ante_corr->{$wit} = 1 if $extra;
+ $tradition->witness( $wit )->is_layered( 1 ) if $extra;
} elsif( $class eq 'relationship' ) {
# We need the metadata about the relationship.
my $opts = { 'type' => $e->{$RELATIONSHIP_KEY} };
}
}
}
-
- # Set the $witness->path arrays for each wit.
- populate_witness_path( $tradition, $has_ante_corr );
}
1;
$c->add_path( $source, $rdg, $sig );
$source = $rdg;
}
- $tradition->witness( $sig )->path( \@real_sequence );
# See if we need to make an a.c. version of the witness.
if( exists $app_ac->{$sig} ) {
my @uncorrected;
$source = $rdg;
}
print STDERR "Adding a.c. version for witness $sig\n";
- $tradition->witness( $sig )->uncorrected_path( \@uncorrected );
+ $tradition->witness( $sig )->is_layered( 1 );
}
}
Accessor method for the general witness description.
-=head2 path
+=head2 is_layered
-An array of Text::Tradition::Collation::Reading objects which, taken in
-sequence, represent the text.
-
-=head2 uncorrected_path
-
-An array of Text::Tradition::Collation::Reading objects which, taken in
-sequence, represent the text before any scribal corrections were made.
+Boolean method to note whether the witness has layers (e.g. pre-correction
+readings) in the collation.
=begin testing
predicate => 'has_source',
);
-# Path. This is an array of Reading nodes that should mirror the
-# text above.
+# Path. This is an array of Reading nodes that can be saved during
+# initialization, but should be cleared before saving in a DB.
has 'path' => (
is => 'rw',
isa => 'ArrayRef[Text::Tradition::Collation::Reading]',
predicate => 'has_path',
+ clearer => 'clear_path',
);
has 'uncorrected_path' => (
is => 'rw',
isa => 'ArrayRef[Text::Tradition::Collation::Reading]',
- predicate => 'has_ante_corr',
+ clearer => 'clear_uncorrected_path',
+ );
+
+has 'is_layered' => (
+ is => 'rw',
+ isa => 'Bool',
);
# Manuscript name or similar
isa => 'Str',
);
+# If we set an uncorrected path, ever, remember that we did so.
+around 'uncorrected_path' => sub {
+ my $orig = shift;
+ my $self = shift;
+
+ $self->is_layered( 1 );
+ $self->$orig( @_ );
+};
sub BUILD {
my $self = shift;
$self->$orig( @_ );
};
+
no Moose;
__PACKAGE__->meta->make_immutable;
opendir( DIR, $dir ) or die "Could not open directory $dir";
while( readdir DIR ) {
next unless /\.xml$/;
- my $stemmafile = "$dir/" . $stemma_map{$_};
+ print STDERR "Looking at $_\n";
my $tradition = Text::Tradition->new(
'input' => 'Self',
'file' => "$dir/$_",
'linear' => 1,
);
- open my $stemma_fh, '<', $stemmafile or die "Could not read stemma file $stemmafile";
- my $stemma = Text::Tradition::Stemma->new(
- 'collation' => $tradition->collation,
- 'dot' => $stemma_fh,
- );
+ my $stemma;
+ if( exists $stemma_map{$_} ) {
+ my $stemmafile = "$dir/" . $stemma_map{$_};
+ open my $stemma_fh, '<', $stemmafile or die "Could not read stemma file $stemmafile";
+ $stemma = Text::Tradition::Stemma->new(
+ 'collation' => $tradition->collation,
+ 'dot' => $stemma_fh,
+ );
+ }
my $scope = $kdb->new_scope;
my $tid = $kdb->store( $tradition );
- my $sid = $kdb->store( $stemma );
-
- print STDERR "Stored tradition and stemma for " . $tradition->name
- . ", got $tid / $sid as the ref\n";
+ my $sid = $kdb->store( $stemma ) if $stemma;
+ print STDERR "Stored tradition for " . $tradition->name . " at $tid\n";
+ print STDERR "\tand stemma at $sid\n" if $stemma;
}
}
projects / scpubgit/stemmatology.git / commitdiff