File Coverage

blib/lib/Graph/Writer/Graph6.pm
Criterion Covered Total %
statement 38 38 100.0
branch 4 4 100.0
condition 6 6 100.0
subroutine 9 9 100.0
pod n/a
total 57 57 100.0


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::Writer::Graph6;
19 2     2   9877 use 5.004;
  2         8  
20 2     2   14 use strict;
  2         16  
  2         45  
21 2     2   933 use Graph::Graph6;
  2         6  
  2         72  
22 2     2   13 use Graph::Writer;
  2         4  
  2         48  
23              
24 2     2   9 use vars '@ISA','$VERSION';
  2         4  
  2         632  
25             @ISA = ('Graph::Writer');
26             $VERSION = 7;
27              
28              
29             sub _init {
30 18     18   8031 my ($self,%param) = @_;
31 18         67 $self->SUPER::_init();
32 18         114 %$self = (format => 'graph6',
33             %$self,
34             %param);
35             }
36              
37             # $graph is a Graph.pm object
38             # return true if there is an edge either direction between $v1 and $v2
39             sub _has_edge_either_directed {
40 7     7   14 my ($graph, $v1, $v2) = @_;
41 7   100     17 return ($graph->has_edge($v1,$v2) || $graph->has_edge($v2,$v1));
42             }
43              
44             sub _write_graph {
45 18     18   1419 my ($self, $graph, $fh) = @_;
46              
47 18         68 my @vertices = sort $graph->vertices;
48 18         1061 my @edge_options;
49 18         38 my $format = $self->{'format'};
50 18 100       41 if ($format eq 'sparse6') {
51 8         45 my @edges = $graph->edges; # [ $from_name, $to_name ]
52             ### @edges
53              
54             # as [$from,$to] numbers
55 8         723 my %vertex_to_num = map { $vertices[$_] => $_ } 0 .. $#vertices;
  28         73  
56 8         18 @edges = map { my $from = $vertex_to_num{$_->[0]};
  17         26  
57 17         26 my $to = $vertex_to_num{$_->[1]};
58 17         36 [$from, $to]
59             } @edges;
60 8         23 @edge_options = (edge_aref => \@edges);
61             } else {
62 10 100 100     26 my $has_edge_either = ($graph->is_directed && $format ne 'digraph6'
63             ? \&_has_edge_either_directed
64              
65             # graph undirected, or directed and format digraph
66             : 'has_edge');
67             @edge_options
68             = (edge_predicate => sub {
69 76     76   117 my ($from, $to) = @_;
70 76         185 return $graph->$has_edge_either($vertices[$from], $vertices[$to]);
71 10         137 });
72             }
73              
74             Graph::Graph6::write_graph
75             (format => $format,
76 18         84 header => $self->{'header'},
77             fh => $fh,
78             num_vertices => scalar(@vertices),
79             @edge_options);
80 18         85 return 1;
81             }
82              
83             1;
84             __END__