Commit | Line | Data |
b49c4318 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; use warnings; |
4 | use Test::More; |
5 | use lib 'lib'; |
8e1394aa |
6 | use Text::Tradition; |
b49c4318 |
7 | use XML::LibXML; |
8 | use XML::LibXML::XPathContext; |
9 | |
10 | my $datafile = 't/data/Collatex-16.xml'; |
11 | |
12 | open( GRAPHFILE, $datafile ) or die "Could not open $datafile"; |
13 | my @lines = <GRAPHFILE>; |
14 | close GRAPHFILE; |
8e1394aa |
15 | my $tradition = Text::Tradition->new( 'GraphML' => join( '', @lines ) ); |
16 | my $collation = $tradition->collation; |
b49c4318 |
17 | |
18 | # Test the svg creation |
19 | my $parser = XML::LibXML->new(); |
20 | $parser->load_ext_dtd( 0 ); |
8e1394aa |
21 | my $svg = $parser->parse_string( $collation->as_svg() ); |
b49c4318 |
22 | is( $svg->documentElement->nodeName(), 'svg', 'Got an svg document' ); |
23 | |
24 | # Test for the correct number of nodes in the SVG |
25 | my $svg_xpc = XML::LibXML::XPathContext->new( $svg->documentElement() ); |
26 | $svg_xpc->registerNs( 'svg', 'http://www.w3.org/2000/svg' ); |
27 | my @svg_nodes = $svg_xpc->findnodes( '//svg:g[@class="node"]' ); |
c557b209 |
28 | is( scalar @svg_nodes, 24, "Correct number of nodes in the graph" ); |
b49c4318 |
29 | |
30 | # Test for the correct number of edges |
31 | my @svg_edges = $svg_xpc->findnodes( '//svg:g[@class="edge"]' ); |
c557b209 |
32 | is( scalar @svg_edges, 30, "Correct number of edges in the graph" ); |
b49c4318 |
33 | |
8e1394aa |
34 | __END__ |
35 | |
b49c4318 |
36 | # Test for the correct common nodes |
c557b209 |
37 | my @expected_nodes = map { [ $_, 1 ] } qw/ #START# n1 n5 n6 n7 n12 n13 |
38 | n16 n19 n20 n23 n27 /; |
39 | foreach my $idx ( qw/2 3 4 8 11 13 16 18/ ) { |
b49c4318 |
40 | splice( @expected_nodes, $idx, 0, [ "node_null", undef ] ); |
41 | } |
8e1394aa |
42 | my @active_nodes = $collation->active_nodes(); |
b49c4318 |
43 | # is_deeply( \@active_nodes, \@expected_nodes, "Initial common points" ); |
44 | subtest 'Initial common points' => \&compare_active; |
c557b209 |
45 | my $string = '# when ... ... ... showers sweet with ... fruit the ... of ... has pierced ... the ... #'; |
b49c4318 |
46 | is( make_text( @active_nodes ), $string, "Got the right starting text" ); |
47 | |
48 | sub compare_active { |
49 | is( scalar( @active_nodes ), scalar ( @expected_nodes ), |
50 | "Arrays are same length" ); |
51 | |
52 | foreach ( 0 .. scalar(@active_nodes)-1 ) { |
53 | is( $active_nodes[$_]->[1], $expected_nodes[$_]->[1], |
54 | "Element has same toggle value" ); |
55 | if( defined $active_nodes[$_]->[1] ) { |
56 | is( $active_nodes[$_]->[0], $expected_nodes[$_]->[0], |
57 | "Active or toggled element has same node name" ); |
58 | } |
59 | } |
60 | } |
61 | |
62 | sub make_text { |
63 | my @words; |
64 | foreach my $n ( @_ ) { |
65 | if( $n->[1] ) { |
8e1394aa |
66 | push( @words, $collation->text_of_node( $n->[0] ) ); |
b49c4318 |
67 | } elsif ( !defined $n->[1] ) { |
68 | push( @words, '...' ); |
69 | } |
70 | } |
71 | return join( ' ', @words ); |
72 | } |
73 | |
74 | # Test the manuscript paths |
75 | my $wit_a = '# when april with his showers sweet with fruit the drought of march has pierced unto the root #'; |
76 | my $wit_b = '# when showers sweet with april fruit the march of drought has pierced to the root #'; |
77 | my $wit_c = '# when showers sweet with april fruit the drought of march has pierced the rood #'; |
8e1394aa |
78 | is( $collation->text_for_witness( "A" ), $wit_a, "Correct path for witness A" ); |
79 | is( $collation->text_for_witness( "B" ), $wit_b, "Correct path for witness B" ); |
80 | is( $collation->text_for_witness( "C" ), $wit_c, "Correct path for witness C" ); |
b49c4318 |
81 | |
82 | # Test the transposition identifiers |
c557b209 |
83 | my $transposition_pools = [ [ 'n2', 'n11' ], [ 'n14', 'n18' ], |
84 | [ 'n17', 'n15' ] ]; |
85 | my $transposed_nodes = { 'n2' => $transposition_pools->[0], |
86 | 'n11' => $transposition_pools->[0], |
87 | 'n14' => $transposition_pools->[1], |
88 | 'n15' => $transposition_pools->[2], |
89 | 'n17' => $transposition_pools->[2], |
90 | 'n18' => $transposition_pools->[1], |
b49c4318 |
91 | }; |
8e1394aa |
92 | foreach my $n ( $collation->readings() ) { |
c2d16875 |
93 | $transposed_nodes->{ $n->name() } = [ $n->name() ] |
94 | unless exists $transposed_nodes->{ $n->name() }; |
95 | } |
8e1394aa |
96 | is_deeply( $collation->{'identical_nodes'}, $transposed_nodes, "Found the right transpositions" ); |
b49c4318 |
97 | |
98 | # Test turning on a node |
8e1394aa |
99 | my @off = $collation->toggle_node( 'n25' ); |
c557b209 |
100 | $expected_nodes[ 18 ] = [ "n25", 1 ]; |
8e1394aa |
101 | @active_nodes = $collation->active_nodes( @off ); |
b49c4318 |
102 | subtest 'Turned on node for new location' => \&compare_active; |
c557b209 |
103 | $string = '# when ... ... ... showers sweet with ... fruit the ... of ... has pierced ... the rood #'; |
b49c4318 |
104 | is( make_text( @active_nodes ), $string, "Got the right text" ); |
105 | |
106 | # Test the toggling effects of same-column |
8e1394aa |
107 | @off = $collation->toggle_node( 'n26' ); |
c557b209 |
108 | splice( @expected_nodes, 18, 1, ( [ "n25", 0 ], [ "n26", 1 ] ) ); |
8e1394aa |
109 | @active_nodes = $collation->active_nodes( @off ); |
b49c4318 |
110 | subtest 'Turned on other node in that location' => \&compare_active; |
c557b209 |
111 | $string = '# when ... ... ... showers sweet with ... fruit the ... of ... has pierced ... the root #'; |
b49c4318 |
112 | is( make_text( @active_nodes ), $string, "Got the right text" ); |
113 | |
114 | # Test the toggling effects of transposition |
115 | |
8e1394aa |
116 | @off = $collation->toggle_node( 'n14' ); |
b49c4318 |
117 | # Add the turned on node |
c557b209 |
118 | $expected_nodes[ 11 ] = [ "n14", 1 ]; |
58a3c424 |
119 | # Remove the 'off' for the previous node |
c557b209 |
120 | splice( @expected_nodes, 18, 1 ); |
8e1394aa |
121 | @active_nodes = $collation->active_nodes( @off ); |
b49c4318 |
122 | subtest 'Turned on transposition node' => \&compare_active; |
c557b209 |
123 | $string = '# when ... ... ... showers sweet with ... fruit the drought of ... has pierced ... the root #'; |
b49c4318 |
124 | is( make_text( @active_nodes ), $string, "Got the right text" ); |
125 | |
8e1394aa |
126 | @off = $collation->toggle_node( 'n18' ); |
58a3c424 |
127 | # Toggle on the new node |
c557b209 |
128 | $expected_nodes[ 13 ] = [ "n18", 1 ]; |
58a3c424 |
129 | # Toggle off the transposed node |
c557b209 |
130 | $expected_nodes[ 11 ] = [ "n14", undef ]; |
8e1394aa |
131 | @active_nodes = $collation->active_nodes( @off ); |
b49c4318 |
132 | subtest 'Turned on that node\'s partner' => \&compare_active; |
c557b209 |
133 | $string = '# when ... ... ... showers sweet with ... fruit the ... of drought has pierced ... the root #'; |
b49c4318 |
134 | is( make_text( @active_nodes ), $string, "Got the right text" ); |
135 | |
8e1394aa |
136 | @off = $collation->toggle_node( 'n14' ); |
58a3c424 |
137 | # Toggle on the new node |
c557b209 |
138 | $expected_nodes[ 11 ] = [ "n14", 1 ]; |
58a3c424 |
139 | # Toggle off the transposed node |
c557b209 |
140 | $expected_nodes[ 13 ] = [ "n18", undef ]; |
8e1394aa |
141 | @active_nodes = $collation->active_nodes( @off ); |
b49c4318 |
142 | subtest 'Turned on the original node' => \&compare_active; |
c557b209 |
143 | $string = '# when ... ... ... showers sweet with ... fruit the drought of ... has pierced ... the root #'; |
b49c4318 |
144 | is( make_text( @active_nodes ), $string, "Got the right text" ); |
145 | |
8e1394aa |
146 | @off = $collation->toggle_node( 'n15' ); |
58a3c424 |
147 | # Toggle on the new node, and off with the old |
c557b209 |
148 | splice( @expected_nodes, 11, 1, [ "n14", 0 ], [ "n15", 1 ] ); |
8e1394aa |
149 | @active_nodes = $collation->active_nodes( @off ); |
58a3c424 |
150 | subtest 'Turned on the colocated node' => \&compare_active; |
c557b209 |
151 | $string = '# when ... ... ... showers sweet with ... fruit the march of ... has pierced ... the root #'; |
58a3c424 |
152 | is( make_text( @active_nodes ), $string, "Got the right text" ); |
153 | |
8e1394aa |
154 | @off = $collation->toggle_node( 'n3' ); |
58a3c424 |
155 | # Toggle on the new node |
c557b209 |
156 | splice( @expected_nodes, 3, 1, [ "n3", 1 ] ); |
58a3c424 |
157 | # Remove the old toggle-off |
c557b209 |
158 | splice( @expected_nodes, 11, 1 ); |
8e1394aa |
159 | @active_nodes = $collation->active_nodes( @off ); |
b49c4318 |
160 | subtest 'Turned on a singleton node' => \&compare_active; |
c557b209 |
161 | $string = '# when ... with ... showers sweet with ... fruit the march of ... has pierced ... the root #'; |
b49c4318 |
162 | is( make_text( @active_nodes ), $string, "Got the right text" ); |
163 | |
8e1394aa |
164 | @off = $collation->toggle_node( 'n3' ); |
58a3c424 |
165 | # Toggle off this node |
c557b209 |
166 | splice( @expected_nodes, 3, 1, [ "n3", 0 ] ); |
8e1394aa |
167 | @active_nodes = $collation->active_nodes( @off ); |
b49c4318 |
168 | subtest 'Turned off a singleton node' => \&compare_active; |
c557b209 |
169 | $string = '# when ... ... showers sweet with ... fruit the march of ... has pierced ... the root #'; |
58a3c424 |
170 | is( make_text( @active_nodes ), $string, "Got the right text" ); |
171 | |
8e1394aa |
172 | @off = $collation->toggle_node( 'n21' ); |
c557b209 |
173 | splice( @expected_nodes, 16, 1, [ "n21", 1 ] ); |
8e1394aa |
174 | @active_nodes = $collation->active_nodes( @off ); |
58a3c424 |
175 | subtest 'Turned on a new node after singleton switchoff' => \&compare_active; |
c557b209 |
176 | $string = '# when ... ... showers sweet with ... fruit the march of ... has pierced unto the root #'; |
b49c4318 |
177 | is( make_text( @active_nodes ), $string, "Got the right text" ); |
178 | |
179 | done_testing(); |