File Coverage

blib/lib/Graph/Reader/XML.pm
Criterion Covered Total %
statement 15 17 88.2
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 21 23 91.3


line stmt bran cond sub pod time code
1             #
2             # Graph::Reader::XML - perl class for reading directed graphs from XML
3             #
4             package Graph::Reader::XML;
5             $Graph::Reader::XML::VERSION = '2.08';
6 1     1   132499 use 5.006;
  1         4  
7 1     1   5 use strict;
  1         1  
  1         20  
8 1     1   5 use warnings;
  1         2  
  1         26  
9              
10 1     1   775 use parent 'Graph::Reader';
  1         282  
  1         5  
11 1     1   50 use Carp;
  1         2  
  1         56  
12 1     1   1502 use XML::Parser;
  0            
  0            
13              
14              
15             #=======================================================================
16             #
17             # _init()
18             #
19             # initialisation private method, invoked by the constructor.
20             # First call the superclass initialiser, then create an
21             # instance of XML::Parser, which does most of the work for us.
22             #
23             #=======================================================================
24             sub _init
25             {
26             my $self = shift;
27              
28             $self->SUPER::_init();
29              
30             #-------------------------------------------------------------------
31             # use closures to associate the $self reference with the handler
32             # function which will get invoked by the XML::Parser
33             #-------------------------------------------------------------------
34             $self->{PARSER} = XML::Parser->new(Handlers =>
35             {
36             Start => sub { handle_start($self, @_); },
37             End => sub { handle_end($self, @_); },
38             });
39             }
40              
41             #=======================================================================
42             #
43             # _read_graph
44             #
45             # private method where the business is done. Just invoke the
46             # parse method on the XML::Parser instance. The real business is
47             # done in the handle_start() and handle_end() "methods", which
48             # are invoked by the XML parser.
49             #
50             #=======================================================================
51             sub _read_graph
52             {
53             my $self = shift;
54             my $graph = shift;
55             my $FILE = shift;
56              
57              
58             $self->{CONTEXT} = [];
59             $self->{GRAPH} = $graph;
60             $self->{PARSER}->parse($FILE);
61              
62             return 1;
63             }
64              
65             #=======================================================================
66             #
67             # handle_start
68             #
69             # XML parser handler for the start of an element.
70             #
71             #=======================================================================
72             sub handle_start
73             {
74             my ($self, $p, $el, %attr) = @_;
75             my $graph = $self->{GRAPH};
76              
77              
78             if ($el eq 'attribute')
79             {
80             if (exists $attr{name} && exists $attr{value})
81             {
82             $self->set_attribute($attr{name}, $attr{value});
83             }
84             else
85             {
86             carp "attribute should have name and value - ignoring\n";
87             }
88             }
89             elsif ($el eq 'node')
90             {
91             $graph->add_vertex($attr{id});
92             push(@{$self->{CONTEXT}}, [$el, $attr{id}]);
93             }
94             elsif ($el eq 'edge')
95             {
96             $graph->add_edge($attr{from}, $attr{to});
97             push(@{$self->{CONTEXT}}, [$el, $attr{from}, $attr{to}]);
98             }
99             elsif ($el eq 'graph')
100             {
101             push(@{$self->{CONTEXT}}, [$el]);
102             }
103             else
104             {
105             carp "unknown element \"$el\"\n";
106             }
107             }
108              
109             #=======================================================================
110             #
111             # handle_end
112             #
113             # XML parser handler for the end of an element.
114             #
115             #=======================================================================
116             sub handle_end
117             {
118             my ($self, $p, $el) = @_;
119              
120             if ($el eq 'node' || $el eq 'edge' || $el eq 'graph')
121             {
122             pop(@{$self->{CONTEXT}});
123             }
124             }
125              
126             #=======================================================================
127             #
128             # set_attribute
129             #
130             # Performs the actual setting of an attribute. Looks at the saved
131             # context to determine what we're setting an attribute of, and sets
132             # it on the Graph instance.
133             #
134             #=======================================================================
135             sub set_attribute
136             {
137             my ($self, $name, $value) = @_;
138              
139              
140             if (@{$self->{CONTEXT}} == 0)
141             {
142             carp "attribute element with no context - ignoring!\n";
143             return;
144             }
145              
146             my $graph = $self->{GRAPH};
147             my ($el, @args) = @{ (@{$self->{CONTEXT}})[-1] };
148              
149             if ($el eq 'node')
150             {
151             $graph->set_vertex_attribute($args[0], $name, $value);
152             }
153             elsif ($el eq 'edge')
154             {
155             $graph->set_edge_attribute($args[0], $args[1], $name, $value);
156             }
157             elsif ($el eq 'graph')
158             {
159             $graph->set_graph_attribute($name, $value);
160             }
161             else
162             {
163             carp "unexpected context for attribute\n";
164             }
165             }
166              
167             1;
168              
169             =head1 NAME
170              
171             Graph::Reader::XML - class for reading a Graph instance from XML
172              
173             =head1 SYNOPSIS
174              
175             use Graph::Reader::XML;
176             use Graph;
177              
178             $reader = Graph::Reader::XML->new();
179             $graph = $reader->read_graph('mygraph.xml');
180              
181             =head1 DESCRIPTION
182              
183             B is a perl class used to read a directed graph
184             stored as XML, and return an instance of the B class.
185              
186             The XML format is designed to support the Graph classes:
187             it can be used to represent a single graph with a collection
188             of nodes, and edges between those nodes.
189             The graph, nodes, and edges can all have attributes specified,
190              
191             B is a subclass of B,
192             which defines the generic interface for Graph reader classes.
193              
194             =head1 METHODS
195              
196             =head2 new()
197              
198             Constructor - generate a new reader instance.
199              
200             $reader = Graph::Reader::XML->new();
201              
202             This doesn't take any arguments.
203              
204             =head2 read_graph()
205              
206             Read a graph from a file:
207              
208             $graph = $reader->read_graph( $file );
209              
210             The C<$file> argument can be either a filename
211             or a filehandle of a previously opened file.
212              
213             =head1 KNOWN BUGS
214              
215             Attribute values must be scalar. If they're not,
216             well, you're on your own.
217              
218             =head1 SEE ALSO
219              
220             =over 4
221              
222             =item Graph::Reader
223              
224             The base class for B.
225              
226             =item Graph::Writer::XML
227              
228             Used to serialise a Graph instance as XML.
229              
230             =item Graph
231              
232             Jarkko Hietaniemi's classes for representing directed graphs.
233              
234             =back
235              
236             =head1 REPOSITORY
237              
238             L
239              
240             =head1 AUTHOR
241              
242             Neil Bowers Eneil@bowers.comE
243              
244             =head1 COPYRIGHT
245              
246             Copyright (c) 2001-2012, Neil Bowers. All rights reserved.
247             Copyright (c) 2001, Canon Research Centre Europe. All rights reserved.
248              
249             This module is free software; you can redistribute it and/or modify
250             it under the same terms as Perl itself.
251              
252             =cut
253