devops/perl/lib/Graph-Easy-0.76/t/gv.t

#!/usr/bin/perl -w

use Test::More;
use strict;
use File::Spec;

sub _write_utf8_file
{
    my ($out_path, $contents) = @_;

    open my $out_fh, '>:encoding(utf8)', $out_path
        or die "Cannot open '$out_path' for writing - $!";

    print {$out_fh} $contents;

    close($out_fh);

    return;
}

# test graphviz (dot) file input => ASCII output
# and back to as_txt() again

BEGIN
   {
   plan tests => 140;
   chdir 't' if -d 't';
   use lib '../lib';
   use_ok ("Graph::Easy") or die($@);
   use_ok ("Graph::Easy::Parser") or die($@);
   use_ok ("Graph::Easy::Parser::Graphviz") or die($@);
   };

my @warnings;

#############################################################################
# override the warn method to catch warnigs

{
 no warnings 'redefine';

 package Graph::Easy::Base;

 sub warn {
   my ($self,$msg) = @_;
   push @warnings, $msg;
 }

}

#############################################################################
# parser object

my $def_parser = Graph::Easy::Parser->new(debug => 0);

is (ref($def_parser), 'Graph::Easy::Parser');
is ($def_parser->error(), '', 'no error yet');

my $dot_parser = Graph::Easy::Parser::Graphviz->new(debug => 0);
is (ref($dot_parser), 'Graph::Easy::Parser::Graphviz');
is ($dot_parser->error(), '', 'no error yet');

my $dir = File::Spec->catdir('in','dot');

opendir DIR, $dir or die ("Cannot read dir '$dir': $!");
my @files = readdir(DIR); closedir(DIR);

opendir DIR, 'dot' or die ("Cannot read dir 'dot': $!");
push @files, readdir(DIR); closedir(DIR);

binmode (STDERR, ':utf8') or die ("Cannot do binmode(':utf8') on STDERR: $!");
binmode (STDOUT, ':utf8') or die ("Cannot do binmode(':utf8') on STDOUT: $!");

eval { require Test::Differences; };

foreach my $f (sort {
  $a =~ /^(\d+)/; my $a1 = $1 || '1';
  $b =~ /^(\d+)/; my $b1 = $1 || '1';
  $a1 <=> $b1 || $a cmp $b;
  } @files)
  {
  my $file = File::Spec->catfile($dir,$f);
  my $parser = $def_parser;
  if (!-f $file)
    {
    $file = File::Spec->catfile('dot',$f);
    next unless -f $file; 			# only files
    # for files in t/dot, we need to use the Graphviz parser as they
    # look like Graph::Easy text to the normal parser, which then fails
    $parser = $dot_parser;
    }

  next unless $f =~ /\.dot/;			# ignore anything else

  print "# at $f\n";
  my $txt = readfile($file);
  $parser->reset();
  my $graph = $parser->from_text($txt);		# reuse parser object

  $f =~ /^(\d+)/;
  my $nodes = $1;

  if (!defined $graph)
    {
    fail ("Graphviz input was invalid: " . $parser->error());
    next;
    }
  is (scalar $graph->nodes(), $nodes, "$nodes nodes");

  # for slow testing machines
  $graph->timeout(20);
  my $ascii = $graph->as_ascii();

  my $of = $f; $of =~ s/\.dot/\.txt/;
  my $out_path = File::Spec->catfile('out','dot',$of);
  my $out = readfile($out_path);
  $out =~ s/(^|\n)#[^# ]{2}.*\n//g;		# remove comments
  $out =~ s/\n\n\z/\n/mg;			# remove empty lines

# print "txt: $txt\n";
# print "ascii: $ascii\n";
# print "should: $out\n";

  if (!
      is ($ascii, $out, "from $f"))
  {
      if ($ENV{__SHLOMIF__UPDATE_ME})
      {
          _write_utf8_file($out_path, $ascii);
      }
      if (defined $Test::Differences::VERSION)
      {
          Test::Differences::eq_or_diff ($ascii, $out);
      }
      else
      {
          fail ("Test::Differences not installed");
      }
  }

  # if the txt output differes, read it in
  my $f_txt = File::Spec->catfile('txt','dot',$of);
  if (-f $f_txt)
    {
    $txt = readfile($f_txt);
    }

  $graph->debug(1);

  if (!
      is ($graph->as_txt(), $txt, "$f as_txt"))
  {
      if ($ENV{__SHLOMIF__UPDATE_ME})
      {
          _write_utf8_file($f_txt, scalar( $graph->as_txt() ));
      }
      if (defined $Test::Differences::VERSION)
      {
          Test::Differences::eq_or_diff ($graph->as_txt(), $txt);
      }
      else
      {
          fail ("Test::Differences not installed");
      }
  }

  # print a debug output
  my $debug = $ascii;
  $debug =~ s/\n/\n# /g;
  print "# Generated:\n#\n# $debug\n";
  }

# check that only the expected warnings were generated
use Data::Dumper;

print STDERR Dumper(\@warnings) unless
  is (scalar @warnings, 6, 'Got exactly 6 warnings');

my $i = 0;
for my $name (qw/bar foo pname fname bar brabble/)
  {
  like ($warnings[$i], qr/Ignoring unknown attribute '$name' for class/,
	"Got warning about $name");
  $i++;
  }

1;

sub readfile
  {
  my ($file) = @_;

  open my $FILE, $file or die ("Cannot read file $file: $!");
  binmode ($FILE, ':utf8') or die ("Cannot do binmode(':utf8') on $FILE: $!");
  local $/ = undef;				# slurp mode
  my $doc = <$FILE>;
  close $FILE;

  $doc;
  }