1 package Text::Tradition::Parser::Self;
5 use Text::Tradition::Parser::GraphML qw/ graphml_parse /;
9 Text::Tradition::Parser::GraphML
15 my $t_from_file = Text::Tradition->new(
18 'file' => '/path/to/tradition.xml'
21 my $t_from_string = Text::Tradition->new(
24 'string' => $tradition_xml,
29 Parser module for Text::Tradition to read in its own GraphML output format.
30 GraphML is a relatively simple graph description language; a 'graph' element
31 can have 'node' and 'edge' elements, and each of these can have simple 'data'
32 elements for attributes to be saved.
34 The graph itself has attributes as in the Collation object:
44 =item * wit_list_separator
48 The node objects have the following attributes:
64 The edge objects have the following attributes:
70 =item * witness (for 'path' class edges)
72 =item * extra (for 'path' class edges)
74 =item * relationship (for 'relationship' class edges)
76 =item * equal_rank (for 'relationship' class edges)
78 =item * non_correctable (for 'relationship' class edges)
80 =item * non_independent (for 'relationship' class edges)
88 parse( $graph, $opts );
90 Takes an initialized Text::Tradition object and a set of options; creates
91 the appropriate nodes and edges on the graph. The options hash should
92 include either a 'file' argument or a 'string' argument, depending on the
93 source of the XML to be parsed.
98 binmode STDOUT, ":utf8";
99 binmode STDERR, ":utf8";
100 eval { no warnings; binmode $DB::OUT, ":utf8"; };
102 my $tradition = 't/data/florilegium_graphml.xml';
103 my $t = Text::Tradition->new(
106 'file' => $tradition,
109 is( ref( $t ), 'Text::Tradition', "Parsed GraphML version 2" );
111 is( scalar $t->collation->readings, 319, "Collation has all readings" );
112 is( scalar $t->collation->paths, 376, "Collation has all paths" );
113 is( scalar $t->witnesses, 13, "Collation has all witnesses" );
116 # TODO add a relationship, write graphml, reparse it, check that the rel
118 $t->language('Greek');
119 $t->collation->add_relationship( 'w12', 'w13',
120 { 'type' => 'grammatical', 'scope' => 'global',
121 'annotation' => 'This is some note' } );
122 ok( $t->collation->get_relationship( 'w12', 'w13' ), "Relationship set" );
123 my $graphml_str = $t->collation->as_graphml;
125 my $newt = Text::Tradition->new( 'input' => 'Self', 'string' => $graphml_str );
126 is( ref( $newt ), 'Text::Tradition', "Parsed current GraphML version" );
128 is( scalar $newt->collation->readings, 319, "Collation has all readings" );
129 is( scalar $newt->collation->paths, 376, "Collation has all paths" );
130 is( scalar $newt->witnesses, 13, "Collation has all witnesses" );
131 is( scalar $newt->collation->relationships, 1, "Collation has added relationship" );
132 is( $newt->language, 'Greek', "Tradition has correct language setting" );
133 my $rel = $newt->collation->get_relationship( 'w12', 'w13' );
134 ok( $rel, "Found set relationship" );
135 is( $rel->annotation, 'This is some note', "Relationship has its properties" );
144 my( $tradition, $opts ) = @_;
146 # Collation data is in the first graph; relationship-specific stuff
148 my( $graph_data, $rel_data ) = graphml_parse( $opts );
150 my $collation = $tradition->collation;
153 # print STDERR "Setting graph globals\n";
154 $tradition->name( $graph_data->{'name'} );
156 my $tmeta = $tradition->meta;
157 my $cmeta = $collation->meta;
158 foreach my $gkey ( keys %{$graph_data->{'global'}} ) {
159 my $val = $graph_data->{'global'}->{$gkey};
160 if( $gkey eq 'version' ) {
162 } elsif( $tmeta->has_attribute( $gkey ) ) {
163 $tradition->$gkey( $val );
165 $collation->$gkey( $val );
169 # Add the nodes to the graph.
171 # print STDERR "Adding collation readings\n";
172 foreach my $n ( @{$graph_data->{'nodes'}} ) {
173 # If it is the start or end node, we already have one, so
174 # grab the rank and go.
175 next if( defined $n->{'is_start'} );
176 if( defined $n->{'is_end'} ) {
177 $collation->end->rank( $n->{'rank'} );
180 my $gnode = $collation->add_reading( $n );
184 # print STDERR "Adding collation path edges\n";
185 foreach my $e ( @{$graph_data->{'edges'}} ) {
186 my $from = $collation->reading( $e->{'source'}->{'id'} );
187 my $to = $collation->reading( $e->{'target'}->{'id'} );
189 warn "No witness label on path edge!" unless $e->{'witness'};
190 my $label = $e->{'witness'} . ( $e->{'extra'} ? $collation->ac_label : '' );
191 $collation->add_path( $from, $to, $label );
193 # Add the witness if we don't have it already.
194 unless( $witnesses{$e->{'witness'}} ) {
195 $tradition->add_witness( sigil => $e->{'witness'} );
196 $witnesses{$e->{'witness'}} = 1;
198 $tradition->witness( $e->{'witness'} )->is_layered( 1 ) if $e->{'extra'};
201 ## Done with the main graph, now look at the relationships.
202 # Nodes are added via the call to add_reading above. We only need
203 # add the relationships themselves.
204 # TODO check that scoping does trt
205 $rel_data->{'edges'} ||= []; # so that the next line doesn't break on no rels
206 foreach my $e ( sort { _layersort_rel( $a, $b ) } @{$rel_data->{'edges'}} ) {
207 my $from = $collation->reading( $e->{'source'}->{'id'} );
208 my $to = $collation->reading( $e->{'target'}->{'id'} );
209 delete $e->{'source'};
210 delete $e->{'target'};
211 # The remaining keys are relationship attributes.
212 # Backward compatibility...
213 if( $use_version eq '2.0' || $use_version eq '3.0' ) {
214 delete $e->{'class'};
215 $e->{'type'} = delete $e->{'relationship'} if exists $e->{'relationship'};
217 # Add the specified relationship unless we already have done.
219 if( $e->{'scope'} ne 'local' ) {
220 my $relobj = $collation->get_relationship( $from, $to );
221 if( $relobj && $relobj->scope eq $e->{'scope'}
222 && $relobj->type eq $e->{'type'} ) {
226 $collation->add_relationship( $from, $to, $e ) unless $rel_exists;
229 # Save the text for each witness so that we can ensure consistency
231 $collation->text_from_paths();
234 ## Return the relationship that comes first in priority.
243 my $key = exists $a->{'type'} ? 'type' : 'relationship';
244 my $at = $LAYERS{$a->{$key}} || 99;
245 my $bt = $LAYERS{$b->{$key}} || 99;
255 =item * Make this into a stream parser with GraphML
257 =item * Simply field -> attribute correspondence for nodes and edges
259 =item * Share key name constants with Collation.pm
265 This package is free software and is provided "as is" without express
266 or implied warranty. You can redistribute it and/or modify it under
267 the same terms as Perl itself.
271 Tara L Andrews E<lt>aurum@cpan.orgE<gt>