File Coverage

blib/lib/Graph/Easy/Parser/Graph6.pm
Criterion Covered Total %
statement 45 45 100.0
branch 7 8 87.5
condition 5 5 100.0
subroutine 14 14 100.0
pod 2 2 100.0
total 73 74 98.6


line stmt bran cond sub pod time code
1             # Copyright 2015, 2016, 2017 Kevin Ryde
2             #
3             # This file is part of Graph-Graph6.
4             #
5             # Graph-Graph6 is free software; you can redistribute it and/or modify it under
6             # the terms of the GNU General Public License as published by the Free
7             # Software Foundation; either version 3, or (at your option) any later
8             # version.
9             #
10             # Graph-Graph6 is distributed in the hope that it will be useful, but WITHOUT
11             # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
12             # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
13             # more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with Graph-Graph6. If not, see .
17              
18             package Graph::Easy::Parser::Graph6;
19 1     1   100441 use 5.006; # Graph::Easy is 5.008 anyway
  1         3  
20 1     1   5 use strict;
  1         2  
  1         17  
21 1     1   5 use warnings;
  1         2  
  1         22  
22 1     1   420 use Graph::Graph6;
  1         2  
  1         36  
23 1     1   6 use Graph::Easy::Parser;
  1         2  
  1         367  
24              
25             our $VERSION = 7;
26             our @ISA = ('Graph::Easy::Parser');
27              
28             # uncomment this to run the ### lines
29             # use Smart::Comments;
30              
31              
32             sub _default_vertex_name_func {
33 43     43   75 my ($n, $num_vertices) = @_;
34 43         139 return sprintf '%0*d', length($num_vertices-1), $n;
35             }
36             sub _init {
37 7     7   3602 my ($self, $args) = @_;
38              
39             # this undocumented yet ...
40 7   100     40 $self->{'vertex_name_func'} = delete $args->{'vertex_name_func'}
41             || \&_default_vertex_name_func;
42              
43 7         24 return $self->SUPER::_init($args);
44             }
45              
46             sub from_file {
47 2     2 1 44 my ($self, $filename_or_fh) = @_;
48 2 100       9 return _read_graph6($self,
49             (ref $filename_or_fh
50             ? (fh => $filename_or_fh)
51             : (filename => $filename_or_fh)));
52             }
53             sub from_text {
54 5     5 1 811 my ($self, $str) = @_;
55 5         12 return _read_graph6($self, str => $str);
56             }
57              
58             sub _read_graph6 {
59 7     7   18 my ($self, @options) = @_;
60              
61 7 100       18 if (! ref $self) { $self = $self->new; } # class method
  1         4  
62 7         38 $self->reset;
63              
64 7         788 my $graph = $self->{'_graph'};
65 7         16 my $num_vertices;
66 7         14 my $vertex_name_func = $self->{'vertex_name_func'};
67              
68             my $ret = Graph::Graph6::read_graph
69             (@options,
70             format_func => sub {
71 7     7   14 my ($format) = @_;
72 7 50       19 unless ($format eq 'digraph6') {
73 7         18 $graph->set_attribute (type => 'undirected');
74             }
75             },
76             num_vertices_func => sub {
77 5     5   8 my ($n) = @_;
78             ### num_vertices_func(): $n
79 5         10 $num_vertices = $n;
80 5         12 foreach my $i (0 .. $n-1) {
81 32         1328 my $name = $vertex_name_func->($i,$num_vertices);
82 32         99 $graph->add_node($name);
83             }
84             },
85             edge_func => sub {
86 13     13   24 my ($from, $to) = @_;
87             ### edge_func() ...
88             ### $from
89             ### $to
90 13         26 $graph->add_edge($vertex_name_func->($from,$num_vertices),
91             $vertex_name_func->($to, $num_vertices));
92             },
93             error_func => sub {
94 1     1   4 $self->error(@_);
95 7         59 });
96             ### $ret
97              
98 7 100 100     90 if (defined $ret && $ret == 0) {
99 1         4 return undef; # EOF
100             }
101              
102             # When fatal_errors is false Graph::Easy::Parser returns a partial graph,
103             # though its docs suggest undef. Try to follow its behaviour.
104 6         23 return $graph;
105             }
106              
107             1;
108             __END__