File Coverage

blib/lib/Graph/Reader/Graph6.pm

Criterion	Covered	Total	%
statement	46	47	97.8
branch	5	6	83.3
condition	4	5	80.0
subroutine	12	12	100.0
pod	1	1	100.0
total	68	71	95.7

# Copyright 2015, 2016, 2017 Kevin Ryde
#
# This file is part of Graph-Graph6.
#
# Graph-Graph6 is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Graph-Graph6 is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
# more details.
#
# You should have received a copy of the GNU General Public License along
# with Graph-Graph6.  If not, see .

package Graph::Reader::Graph6;
use 5.004;
use strict;
use Carp 'croak';
use Graph::Reader;

use vars '@ISA','$VERSION';
@ISA = ('Graph::Reader');
$VERSION = 7;

use Graph::Graph6;


# Not using the base class read_graph() since want Graph->new to follow the
# directed-ness of the format read.
#
# This misses the Graph::Reader::read_graph() warn() on unable to open file,
# but think something in the return would be better than a warn message
# anyway.
#
sub read_graph {
  my ($self, $filename_or_fh) = @_;
  require Graph;

  my $width = 1;
  # this vertex_name_func not a documented feature yet ...
  my $vertex_name_func = $self->{'vertex_name_func'}
    || sub {
      my ($n) = @_;
      return sprintf '%0*d', $width, $n;
    };

  my $graph;
  my $check_countedged;
  if (Graph::Graph6::read_graph
      ((ref $filename_or_fh ? 'fh' : 'filename') => $filename_or_fh,
       format_func => sub {
         my ($format) = @_;
         $graph = Graph->new(undirected => ($format ne 'digraph6'));
         $check_countedged = ($format eq 'sparse6');
       },
       num_vertices_func => sub {
         my ($n) = @_;
         $width = length($n-1);
         foreach my $i (0 .. $n-1) {
           my $name = $vertex_name_func->($i);
           $graph->add_vertex($name);
         }
       },
       edge_func => sub {
         my ($from, $to) = @_;
         $from = $vertex_name_func->($from);
         $to   = $vertex_name_func->($to);
         if ($check_countedged && $graph->has_edge($from,$to)) {
           $graph = _countedged_copy($graph);
           undef $check_countedged;
         }
         $graph->add_edge($from,$to);
       })) {
    return $graph;
  } else {
    return 0;
  }
}

# $graph is a Graph.pm.
# Return a copy which is countedged.
sub _countedged_copy {
  my ($graph) = @_;
  my $new_graph = Graph->new (undirected => $graph->is_undirected,
                              countedged => 1);
  $new_graph->add_vertices($graph->vertices);
  $new_graph->add_edges($graph->edges);
  return $new_graph;
}

1;
__END__