The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
# -*- perl -*-

use strict;
no warnings;

my $skip; 
BEGIN {
    eval "use Moose";
    if ($@) { $skip = 'Moose required for this test' }
};

use Config;
use YAML::Syck;
use File::Slurp;
use IPC::Run3;
use Test::More $skip ? (skip_all => $skip) : ();

my $script = 'script/umlclass.pl';
my @cmd = ($^X, '-Ilib', $script);
my ($stdout, $stderr);

{
    my $outfile = 'moouseish.yml';
    unlink $outfile if -f $outfile;
    ok run3( [@cmd, qw(-M Moose -p Moouseish -o), $outfile, qw(-r t)], \undef, \$stdout, \$stderr ),
        "umlclass -M Moose -p Moouseish -o $outfile -r t";
    is $stdout, "Moouseish::Bar\nMoouseish::Baz\nMoouseish::Foo\nMoouseish::Garply\nMoouseish::Quux\nMoouseish::Zot\n\n$outfile generated.\n",
        "stdout ok - $outfile generated.";
    # will generate warnings on stderr, we don't care
    ok -f $outfile, "$outfile exists";
    my $yml = read_file($outfile);
    like $yml, qr/^\s*- Moouseish::Garply/m, 'yml caught role consumer';
}

# Check --no-methods

{
    my $outfile = 'nomethods.dot';
    unlink $outfile if -f $outfile;
    ok run3( [@cmd, qw(-M Moose -p Moouseish -o), $outfile, qw(--no-methods -r t)], \undef, \$stdout, \$stderr ),
        "umlclass -M Moose -p Moouseish -o $outfile --no-methods -r t";
    is $stdout, "Moouseish::Bar\nMoouseish::Baz\nMoouseish::Foo\nMoouseish::Garply\nMoouseish::Quux\nMoouseish::Zot\n\n$outfile generated.\n",
        "stdout ok - $outfile generated.";
    # will generate warnings on stderr, we don't care
    ok -f $outfile, "$outfile exists";
    my $yml = read_file($outfile);
    like $yml, qr/<td port="methods"\s*>\s*<\/td>/m, 'empty methods port'
}

# Check --no-inheritance

{
    my $outfile = 'noinheritance.dot';
    unlink $outfile if -f $outfile;
    ok run3( [@cmd, qw(-M Moose -p Moouseish -o), $outfile, qw(--no-inheritance -r t)], \undef, \$stdout, \$stderr ),
        "umlclass -M Moose -p Moouseish -o $outfile --no-inheritance -r t";
    is $stdout, "Moouseish::Bar\nMoouseish::Baz\nMoouseish::Foo\nMoouseish::Garply\nMoouseish::Quux\nMoouseish::Zot\n\n$outfile generated.\n",
        "stdout ok - $outfile generated.";
    # will generate warnings on stderr, we don't care
    ok -f $outfile, "$outfile exists";
    my $yml = read_file($outfile);
    unlike $yml, qr/class.*->.*class/, 'no edges from class to class';
}


# Check --moose-roles

{
    my $outfile = 'rolesonly.dot';
    unlink $outfile if -f $outfile;
    ok run3( [@cmd, qw(-M Moose -p Moouseish -o), $outfile, qw(--no-inheritance --moose-roles -r t)], \undef, \$stdout, \$stderr ),
        "umlclass -M Moose -p Moouseish -o $outfile --no-inheritance --moose-roles -r t";
    is $stdout, "Moouseish::Bar\nMoouseish::Baz\nMoouseish::Foo\nMoouseish::Garply\nMoouseish::Quux\nMoouseish::Zot\n\n$outfile generated.\n",
        "stdout ok - $outfile generated.";
    # will generate warnings on stderr, we don't care
    ok -f $outfile, "$outfile exists";
    my $yml = read_file($outfile);
    like $yml, qr/edge.*blue/, 'role edge color';
    like $yml, qr/node.*triangle.*orange/, 'role node color';
    like $yml, qr/angle_\d.*->.*class_\d/, 'at least one role provider';
    like $yml, qr/class_\d.*->.*angle_\d/, 'at least one role consumer';
}


done_testing();