view release on metacpan or  search on metacpan

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

package App::Ikaros::Planner;
use strict;
use warnings;
use parent qw/Class::Accessor::Fast/;
use List::Util qw/shuffle/;
use List::MoreUtils qw/part/;
use App::Ikaros::PathMaker;
use App::Ikaros::Helper qw/load_from_yaml/;
use Data::Dumper;
use constant {
    PROVE_STATE_FILE => '.prove',
};

__PACKAGE__->mk_accessors(qw/
    prove_tests
    forkprove_tests
    saved_tests
    sorted_tests
/);

sub new {
    my ($class, $hosts, $args) = @_;
    unless ($args->{prove_tests} || $args->{forkprove_tests}) {
        die "must be set 'prove_tests' and 'forkprove_tests(optional)'";
    }
    my $self = $class->SUPER::new({ %$args });
    $self->__load_prove_state([ @{$args->{prove_tests}}, @{$args->{forkprove_tests}} ])
        if (-f PROVE_STATE_FILE);
    $self->__setup_testing_cluster($hosts);
    return $self;
}

sub planning {
    my ($self, $host, $args) = @_;
    my $commands = $self->__make_command($args, $host);
    $host->plan($commands);
}

sub __load_prove_state {
    my ($self, $tests) = @_;

    my %tests_map;
    $tests_map{$_}++ foreach @$tests;
    my $saved_tests = (load_from_yaml PROVE_STATE_FILE)->{tests};

    my %elapsed_times;
    foreach my $saved_test (keys %$saved_tests) {
        next unless exists $tests_map{$saved_test};
        my $elapsed_time = $saved_tests->{$saved_test}->{elapsed};
        $elapsed_times{$saved_test} = $elapsed_time + 0;
    }
    my @elapsed_times = reverse sort {
        $elapsed_times{$a} <=> $elapsed_times{$b}
    } keys %elapsed_times;
    $self->saved_tests(\%elapsed_times);
    $self->sorted_tests(\@elapsed_times);
}

sub __setup_testing_cluster {
    my ($self, $hosts) = @_;

    my ($prove_host_num, $forkprove_host_num);
    foreach my $host (@$hosts) {
        if ($host->runner eq 'prove') {
            $prove_host_num++;
        } elsif ($host->runner eq 'forkprove') {
            $forkprove_host_num++;
        } else {
            die "unknown keyword at runner [$host->{runner}]";
        }
    }

    my $prove_test_clusters     = $self->__make_test_cluster($self->prove_tests, $prove_host_num);
    my $forkprove_test_clusters = $self->__make_test_cluster($self->forkprove_tests, $forkprove_host_num);

    foreach my $host (@$hosts) {
        if ($host->runner eq 'prove') {
            $host->tests(shift @$prove_test_clusters);
        } else {
            $host->tests(shift @$forkprove_test_clusters);
        }
    }
}

sub __make_test_cluster {
    my ($self, $tests, $host_num) = @_;