X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FText%2FTradition%2FCollation.pm;h=022c2bc4e413d684f57444e18b2ac305a5171964;hb=db61303b93ba08ca97778858ee56ad31747dc308;hp=67cbfb072b51955e6accb5be46facafa7e1672d0;hpb=144d845bf7f7c1a72c065e84235422f18af84ca3;p=scpubgit%2Fstemmatology.git diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm index 67cbfb0..022c2bc 100644 --- a/lib/Text/Tradition/Collation.pm +++ b/lib/Text/Tradition/Collation.pm @@ -7,34 +7,51 @@ use File::Which; use Graph; use IPC::Run qw( run binary ); use Text::CSV; +use Text::Tradition::Collation::Data; use Text::Tradition::Collation::Reading; use Text::Tradition::Collation::RelationshipStore; use Text::Tradition::Error; use XML::Easy::Syntax qw( $xml10_namestartchar_rx $xml10_namechar_rx ); +use XML::LibXML; +use XML::LibXML::XPathContext; use Moose; -has 'sequence' => ( - is => 'ro', - isa => 'Graph', - default => sub { Graph->new() }, - handles => { - paths => 'edges', - }, - ); - -has 'relations' => ( - is => 'ro', - isa => 'Text::Tradition::Collation::RelationshipStore', - handles => { - relationships => 'relationships', - related_readings => 'related_readings', - get_relationship => 'get_relationship', - del_relationship => 'del_relationship', - equivalence => 'equivalence', - equivalence_graph => 'equivalence_graph', - }, - writer => '_set_relations', - ); +has _data => ( + isa => 'Text::Tradition::Collation::Data', + is => 'ro', + required => 1, + handles => [ qw( + sequence + paths + _set_relations + relations + _set_start + _set_end + ac_label + has_cached_table + relationships + related_readings + get_relationship + del_relationship + equivalence + equivalence_graph + readings + reading + _add_reading + del_reading + has_reading + wit_list_separator + baselabel + linear + wordsep + start + end + cached_table + _graphcalc_done + has_cached_svg + wipe_table + )] +); has 'tradition' => ( is => 'ro', @@ -43,77 +60,6 @@ has 'tradition' => ( weak_ref => 1, ); -has 'readings' => ( - isa => 'HashRef[Text::Tradition::Collation::Reading]', - traits => ['Hash'], - handles => { - reading => 'get', - _add_reading => 'set', - del_reading => 'delete', - has_reading => 'exists', -# reading_keys => 'keys', - readings => 'values', - }, - default => sub { {} }, - ); - -has 'wit_list_separator' => ( - is => 'rw', - isa => 'Str', - default => ', ', - ); - -has 'baselabel' => ( - is => 'rw', - isa => 'Str', - default => 'base text', - ); - -has 'linear' => ( - is => 'rw', - isa => 'Bool', - default => 1, - ); - -has 'ac_label' => ( - is => 'rw', - isa => 'Str', - default => ' (a.c.)', - ); - -has 'wordsep' => ( - is => 'rw', - isa => 'Str', - default => ' ', - ); - -has 'start' => ( - is => 'ro', - isa => 'Text::Tradition::Collation::Reading', - writer => '_set_start', - weak_ref => 1, - ); - -has 'end' => ( - is => 'ro', - isa => 'Text::Tradition::Collation::Reading', - writer => '_set_end', - weak_ref => 1, - ); - -has 'cached_table' => ( - is => 'rw', - isa => 'HashRef', - predicate => 'has_cached_table', - clearer => 'wipe_table', - ); - -has '_graphcalc_done' => ( - is => 'rw', - isa => 'Bool', - default => undef, - ); - =head1 NAME Text::Tradition::Collation - a software model for a text collation @@ -264,6 +210,20 @@ See L for the available options. =cut +sub BUILDARGS { + my ( $class, @args ) = @_; + my %args = @args == 1 ? %{ $args[0] } : @args; + # TODO determine these from the Moose::Meta object + my @delegate_attrs = qw(sequence relations readings wit_list_separator baselabel + linear wordsep start end cached_table _graphcalc_done); + my %data_args; + for my $attr (@delegate_attrs) { + $data_args{$attr} = delete $args{$attr} if exists $args{$attr}; + } + $args{_data} = Text::Tradition::Collation::Data->new(%data_args); + return \%args; +} + sub BUILD { my $self = shift; $self->_set_relations( Text::Tradition::Collation::RelationshipStore->new( 'collation' => $self ) ); @@ -1321,8 +1281,6 @@ sub _make_witness_row { map { $char_hash{$_} = undef } @$positions; my $debug = 0; foreach my $rdg ( @$path ) { - my $rtext = $rdg->text; - $rtext = '#LACUNA#' if $rdg->is_lacuna; say STDERR "rank " . $rdg->rank if $debug; # say STDERR "No rank for " . $rdg->id unless defined $rdg->rank; $char_hash{$rdg->rank} = { 't' => $rdg };