9 use Text::Tradition::Analysis qw/ run_analysis /;
11 binmode STDOUT, ':utf8';
12 binmode STDERR, ':utf8';
13 eval { no warnings; binmode $DB::OUT, ':utf8'; $DB::deep = 1000 };
15 my $tradition = Text::Tradition->new(
17 'file' => 't/data/besoin.xml' );
18 $tradition->add_stemma( 'dotfile' => 't/data/besoin.dot' );
20 # Run the analysis of the tradition
21 ## TODO Make proper test db
22 my $calcdsn = 'dbi:SQLite:dbname=t/data/analysis.db';
23 my $results = run_analysis( $tradition, calcdsn => $calcdsn );
89 # Look through the results
90 my $display = $ARGV[0];
91 my $c = $tradition->collation;
92 foreach my $row ( @{$results->{'variants'}} ) {
94 say sprintf( "=== Looking at rank %d (%s) ===", $row->{'id'},
95 $row->{'genealogical'} ? 'genealogical' : 'not genealogical' );
96 foreach my $rdg ( @{$row->{'readings'}} ) {
97 my $parents = $rdg->{'reading_parents'};
98 say sprintf( "Reading %s: %s", $rdg->{'readingid'},
99 $rdg->{'conflict'} ? '(conflicted)' : '' );
100 if( $parents && @$parents ) {
101 say "\tParent reading(s) " . join( ', ', @$parents );
102 foreach my $p ( @$parents ) {
103 # Is there a relationship here?
104 my $rel = $c->get_relationship( $rdg->{'readingid'}, $p );
106 say sprintf( "\t* Relationship %s %s to parent %s",
108 $rel->annotation ? '('.$rel->annotation.')' : '',
113 say sprintf( "\t%d independent, %d followed, %d changed, %d unknown",
114 $rdg->{'independent_occurrence'}, $rdg->{'followed'},
115 $rdg->{'not_followed'}, $rdg->{'follow_unknown'} );
118 # If not displaying, we're testing.
119 # HACK to cope with formerly unuseful rows
120 unless( exists $expected{$row->{'id'}} ) {
121 $expected{$row->{'id'}} = 1;
123 my $gen_bool = $row->{'genealogical'} ? 1 : '';
124 is( $gen_bool, $expected{$row->{'id'}},
125 "Got expected genealogical result for rank " . $row->{'id'} );
126 # If the row is genealogical, there should be one reading with no parents,
127 # every reading should independently occur exactly once, and the total
128 # number of changes + maybe-changes should equal the total number of
129 # readings who have that one as a parent.
130 if( $row->{'genealogical'} ) {
131 # Make the mapping of parent -> child readings
134 foreach my $rdg ( @{$row->{'readings'}} ) {
135 my $parents = $rdg->{'reading_parents'} || {};
136 foreach my $p ( keys %$parents ) {
137 push( @{$is_parent{$p}}, $rdg->{'readingid'} );
139 push( @has_no_parent, $rdg->{'readingid'} ) unless keys %$parents;
142 foreach my $rdg ( @{$row->{'readings'}} ) {
143 is( @{$rdg->{'independent_occurrence'}}, 1,
144 "Genealogical reading originates exactly once" );
146 is( @has_no_parent, 1, "Only one genealogical reading lacks a parent" );
150 done_testing() unless $display;