view release on metacpan or  search on metacpan

lib/App/Ikaros/Reporter.pm  view on Meta::CPAN

package App::Ikaros::Reporter;
use strict;
use warnings;
use parent qw/Class::Accessor::Fast/;
use utf8;
use TAP::Harness::JUnit;
use IPC::Run;
use XML::Simple;
use List::MoreUtils qw/all/;
use Encode qw/encode decode/;
use YAML::XS qw/LoadFile Dump/;
use File::Copy::Recursive qw/rcopy/;
use App::Ikaros::Profiler;
use constant { DEBUG => 0 };
use Data::Dumper;

__PACKAGE__->mk_accessors(qw/
    recovery_testing_command
    enable_profile
    profiler
    output_filename
    verbose
    tests
/);

sub new {
    my ($class, $options) = @_;
    my $reporter = $class->SUPER::new({
        recovery_testing_command => $options->{recovery_testing_command},
        enable_profile  => $options->{enable_profile} || 0,
        profiler        => App::Ikaros::Profiler->new,
        output_filename => $options->{output_filename} || 'ikaros_output.xml',
        verbose  => $options->{verbose} || 0,
        tests    => +{}
    });
    $reporter->__setup_mangled_name_for_junit($options->{tests});
    return $reporter;
}

sub __setup_mangled_name_for_junit {
    my ($self, $tests) = @_;
    foreach my $test_name (@$tests) {
        my $mangled_name = $test_name;
        $mangled_name =~ s/^[\.\/]*//;
        $mangled_name =~ s/-/_/g;
        $mangled_name =~ s/\./_/g;
        $mangled_name =~ s/\//_/g;
        $self->tests->{$mangled_name} = $test_name;
    }
}

sub __setup_testsuites {
    my ($self, $testsuites, $xml_data, $failed) = @_;

    my $testsuite = $xml_data->{testsuite};
    foreach my $test (@$testsuite) {
        my $mangled_name = $test->{name};
        my $name = $self->tests->{$mangled_name};
        unless ($test->{failures} eq '0' && $test->{errors} eq '0') {
            if ($name) {
                $failed->{$name}++;
            } else {
                warn "nothing include $mangled_name";
            }
        } else {
            #$test->{testcase} = [];
        }
        $testsuites->{$name} = $test if ($name);
    }
}

sub __setup_dot_prove {
    my ($self, $host, $dot_prove) = @_;

    my $loaded_data = LoadFile $host->dot_prove_filename;
    $dot_prove->{last_run_time} = $loaded_data->{last_run_time};
    $dot_prove->{generation} = $loaded_data->{generation};
    $dot_prove->{version} = $loaded_data->{version};
    $dot_prove->{tests}{$_} = $loaded_data->{tests}{$_} foreach keys %{$loaded_data->{tests}};
    $self->profiler->add_profile($host, $loaded_data) if ($self->enable_profile);
}

sub report {
    my ($self, $hosts) = @_;
    my (%testsuites, %failed, %dot_prove, %cover_db);
    my $verbose = $self->verbose;

    foreach my $host (@$hosts) {