1 package Text::Tradition::Parser::GraphML;
6 use XML::LibXML::XPathContext;
10 Text::Tradition::Parser::GraphML
14 Parser module for Text::Tradition, given a GraphML file that describes
15 a collation graph. For further information on the GraphML format for
16 text collation, see http://gregor.middell.net/collatex/
24 parse( $graph, $graphml_string );
26 Takes an initialized Text::Tradition::Graph object and a string
27 containing the GraphML; creates the appropriate nodes and edges on the
32 use vars qw/ $xpc $nodedata /;
34 map { $nodedata->{'CollateX'}->{$_} = undef } qw/ number token identical ranking /;
35 map { $nodedata->{'Text::Tradition'}->{$_} = undef } qw/ name reading identical position /;
38 my( $tradition, $graphml_str, $generator ) = @_;
39 $generator = 'CollateX' unless $generator;
41 my $collation = $tradition->collation;
42 my $parser = XML::LibXML->new();
43 my $doc = $parser->parse_string( $graphml_str );
44 my $graphml = $doc->documentElement();
45 $xpc = XML::LibXML::XPathContext->new( $graphml );
46 $xpc->registerNs( 'g', 'http://graphml.graphdrawing.org/xmlns' );
48 # First get the ID keys, for witnesses and for collation data
50 foreach my $k ( $xpc->findnodes( '//g:key' ) ) {
51 # Each key has a 'for' attribute; the edge keys are witnesses, and
52 # the node keys contain an ID and string for each node.
53 my $keyid = $k->getAttribute( 'id' );
54 my $keyname = $k->getAttribute( 'attr.name' );
56 if( $k->getAttribute( 'for' ) eq 'node' ) {
57 # The node data keys we expect are:
58 # 'number|name' -> unique node identifier
59 # 'token|reading' -> reading for the node
60 # 'identical' -> the node of which this node is
61 # a transposed version
62 # 'position' -> a calculated position for the node
63 warn( "No data key $keyname defined for $generator GraphML" )
64 unless exists( $nodedata->{$generator}->{$keyname} );
65 $nodedata->{$generator}->{$keyname} = $keyid;
67 $witnesses{ $keyid } = $keyname;
71 my $has_explicit_positions = defined $nodedata->{$generator}->{'position'};
73 # Add the witnesses that we have found
74 foreach my $wit ( values %witnesses ) {
75 $tradition->add_witness( 'sigil' => $wit );
78 my $graph_el = $xpc->find( '/g:graphml/g:graph' )->[0];
80 # Add the nodes to the graph. First delete the start node, because
81 # GraphML graphs will have their own start nodes.
82 $collation->del_reading( $collation->start() );
83 # Map from XML IDs to node name/identity
85 # Keep track of whatever extra info we're passed
87 my @nodes = $xpc->findnodes( '//g:node' );
88 foreach my $n ( @nodes ) {
89 # Could use a better way of registering these
90 my $nodeid_key = $generator eq 'CollateX' ? 'number' : 'name';
91 my $reading_key = $generator eq 'CollateX' ? 'token' : 'reading';
92 my $id = _lookup_node_data( $n, $nodeid_key, $generator );
93 my $token = _lookup_node_data( $n, $reading_key, $generator );
94 my $gnode = $collation->add_reading( $id );
95 $node_name{ $n->getAttribute('id') } = $id;
96 $gnode->text( $token );
98 # Now get the rest of the data, i.e. not the ID or label
100 foreach my $k ( keys %{$nodedata->{$generator}} ) {
101 next if $k eq $nodeid_key || $k eq $reading_key;
102 next unless $nodedata->{$generator}->{$k};
103 $extra->{ $k } = _lookup_node_data( $n, $k, $generator );
105 $extra_data->{ $id } = $extra;
109 my @edges = $xpc->findnodes( '//g:edge' );
110 foreach my $e ( @edges ) {
111 my $from = $node_name{ $e->getAttribute('source') };
112 my $to = $node_name{ $e->getAttribute('target') };
113 # Label according to the witnesses present.
114 my @wit_ids = $xpc->findnodes( './g:data/attribute::key', $e );
115 my @wit_names = map { $witnesses{ $_->getValue() } } @wit_ids;
116 # One path per witness
117 foreach( @wit_names ) {
118 $collation->add_path( $from, $to, $_ );
120 # Only a single path between two readings
121 # my $label = $collation->path_label( @wit_names );
122 # $collation->add_path( $from, $to, $label );
125 ## Reverse the node_name hash so that we have two-way lookup.
126 my %node_id = reverse %node_name;
128 ## Record the nodes that are marked as transposed.
129 my $tr_xpath = '//g:node[g:data[@key="' . $nodedata->{$generator}->{'identical'} . '"]]';
130 my $transposition_nodes = $xpc->find( $tr_xpath );
131 foreach my $tn ( @$transposition_nodes ) {
132 my $id_xpath = sprintf( './g:data[@key="%s"]/text()',
133 $nodedata->{$generator}->{'identical'} );
134 my $tn_reading = $collation->reading( $node_id{ $tn->getAttribute( 'id' ) } );
135 my $main_reading = $collation->reading( $node_name{ $xpc->findvalue( $id_xpath, $tn ) } );
136 if( $collation->linear ) {
137 $tn_reading->set_identical( $main_reading );
139 $collation->merge_readings( $main_reading, $tn_reading );
143 # Find the beginning and end nodes of the graph. The beginning node
144 # has no incoming edges; the end node has no outgoing edges.
145 my( $begin_node, $end_node );
146 foreach my $gnode ( $collation->readings() ) {
147 # print STDERR "Checking node " . $gnode->name . "\n";
148 my @outgoing = $gnode->outgoing();
149 my @incoming = $gnode->incoming();
151 unless( scalar @incoming ) {
152 warn "Already have a beginning node" if $begin_node;
153 $begin_node = $gnode;
154 $collation->start( $gnode );
156 unless( scalar @outgoing ) {
157 warn "Already have an ending node" if $end_node;
162 my @common_nodes = $collation->walk_witness_paths( $end_node );
163 # Now we have added the witnesses and their paths, so have also
164 # implicitly marked the common nodes. Now we can calculate their
165 # explicit permissions. This is separate because it won't always
166 # be necessary with the GraphML parsing.
167 if( $has_explicit_positions ) {
168 # Record the positions that came with each graph node.
169 # TODO we really need to translate these into our own style of
170 # position identifier. That's why we defer this until now.
171 foreach my $node_id ( keys %$extra_data ) {
172 my $pos = $extra_data->{$node_id}->{'position'};
173 $collation->reading( $node_name{$node_id} )->position( $pos );
176 # Calculate a position for each graph node.
177 $collation->calculate_positions( @common_nodes );
181 sub _lookup_node_data {
182 my( $xmlnode, $key, $generator ) = @_;
183 return undef unless exists $nodedata->{$generator}->{$key};
184 my $lookup_xpath = './g:data[@key="%s"]/child::text()';
185 my $data = $xpc->findvalue( sprintf( $lookup_xpath, $nodedata->{$generator}->{$key} ),
194 This package is free software and is provided "as is" without express
195 or implied warranty. You can redistribute it and/or modify it under
196 the same terms as Perl itself.
200 Tara L Andrews, aurum@cpan.org