File Coverage

blib/lib/Test/Run/Straps/StrapsTotalsObj.pm

Criterion	Covered	Total	%
statement	115	120	95.8
branch	22	26	84.6
condition	15	18	83.3
subroutine	38	39	97.4
pod	7	7	100.0
total	197	210	93.8

package Test::Run::Straps::StrapsTotalsObj;

use strict;
use warnings;

=head1 NAME

Test::Run::Straps::StrapsTotalsObj - an object representing the totals of the
straps class.

=head1 FIELDS

=cut

use Test::Run::Straps::StrapsDetailsObj;

use Moose;

extends('Test::Run::Straps::Base');

has 'bonus' => (is => "rw", isa => "Num");
has 'details' => (is => "rw", isa => "ArrayRef");
has '_enormous_num_cb' => (is => "rw", isa => "Maybe[CodeRef]");
has 'exit' => (is => "rw", isa => "Num");
has 'filename' => (is => "rw", isa => "Str");
has '_is_vms' => (is => "rw", isa => "Bool");
has 'max' => (is => "rw", isa => "Num");
has 'ok' => (is => "rw", isa => "Num");
has 'passing' => (is => "rw", isa => "Bool");
has 'seen' => (is => "rw", isa => "Num");
has 'skip' => (is => "rw", isa => "Num");
has 'skip_all' => (is => "rw", isa => "Str");
has 'skip_reason' => (is => "rw", isa => "Str");
has 'todo' => (is => "rw", isa => "Num");
has 'wait' => (is => "rw", isa => "Num");

=head1 METHODS

=head2 $self->_calc_passing()

Calculates whether the test file has passed.

=cut

sub _is_skip_all
{
    my $self = shift;

    return (($self->max() == 0) && defined($self->skip_all()));
}

sub _is_all_tests_passed
{
    my $self = shift;

    return
    (
        $self->max && $self->seen
        && ($self->max == $self->seen)
        && ($self->max == $self->ok)
    );
}

sub _calc_passing
{
    my $self = shift;

    return ($self->_is_skip_all() || $self->_is_all_tests_passed());
}

=head2 $self->determine_passing()

Calculates whether the test file has passed and caches it in the passing()
slot.

=cut

sub determine_passing
{
    my $self = shift;
    $self->passing($self->_calc_passing() ? 1 : 0);
}

=head2 $self->last_detail()

Returns the last detail.

=cut

sub last_detail
{
    my $self = shift;

    return $self->details->[-1];
}

sub _calc_enormous_event_num
{
    my $self = shift;

    return 100_000;
}

sub _is_enormous_event_num
{
    my $self = shift;

    my $large_num = $self->_calc_enormous_event_num();

    return
        +($self->_event->number > $large_num)
            &&
         ($self->_event->number > ($self->max || $large_num))
        ;
}

sub _init_details_obj_instance
{
    my ($self, $args) = @_;
    return Test::Run::Straps::StrapsDetailsObj->new($args);
}

sub _handle_event_main
{
    my $self = shift;

    $self->_inc_seen();
    $self->_update_by_labeled_test_event();
    $self->_update_if_pass();
    $self->_update_details_wrapper();
}

sub _def_or_blank
{
    my $value = shift;

    return defined($value) ? $value : "";
}

sub _defined_hash_values
{
    my ($self, $hash) = @_;

    return
    {
        map
        { $_ => _def_or_blank($hash->{$_}) }
        keys(%$hash)
    };
}

sub _calc_always_def_details_initializer
{
    my $self = shift;

    my $event = $self->_event;

    return
    {
        actual_ok => scalar($event->is_ok()),
        name => $event->description,
        type => lc($event->directive),
        reason => $event->explanation,
    };
}

sub _calc_defined_details
{
    my $self = shift;

    $self->_defined_hash_values(
        $self->_calc_always_def_details_initializer()
    );
}

sub _calc_details
{
    my $self = shift;

    return
        $self->_init_details_obj_instance(
            {
                ok => $self->_is_event_pass(),
                %{$self->_calc_defined_details()},
            }
        );
}

sub _update_details
{
    my ($self) = @_;

    $self->details->[$self->_event->number - 1] = $self->_calc_details();

    return ;
}

sub _update_skip_event
{
    my $self = shift;

    $self->inc_field('skip');

    return;
}

sub _update_if_pass
{
    my $self = shift;

    if ($self->_is_event_pass())
    {
        $self->inc_field('ok');
    }
}

sub _handle_enormous_event_num
{
    my $self = shift;

    return $self->_enormous_num_cb->();
}

sub _update_todo_event
{
    my $self = shift;

    $self->inc_field('todo');

    if ($self->_event->is_actual_ok())
    {
        $self->inc_field('bonus');
    }

    return;
}


sub _inc_seen
{
    my $self = shift;

    $self->inc_field('seen');
}

=head2 $self->handle_event({event => $event, enormous_num_cb => sub {...}});

Updates the state of the details using a new TAP::Parser event - $event .
C<enormous_num_cb> points to a subroutine reference that is the callback for
handling enormous numbers.

=cut

sub _setup_event
{
	my ($self, $args) = @_;

	$self->_event($args->{event});
    $self->_enormous_num_cb($args->{enormous_num_cb});

	return ;
}

sub _detach_event
{
    my ($self) = @_;

	$self->_event(undef);
    $self->_enormous_num_cb(undef);
}

sub handle_event
{
    my ($self, $args) = @_;

    $self->_setup_event($args);

    $self->_handle_event_main();

    $self->_detach_event();
}

sub _update_details_wrapper
{
    my $self = shift;

    if ($self->_is_enormous_event_num())
    {
        $self->_handle_enormous_event_num();
    }
    else
    {
        $self->_update_details();
    }
}

sub _update_by_labeled_test_event
{
    my $self = shift;

    if ($self->_event->has_todo())
    {
        $self->_update_todo_event();
    }
    elsif ($self->_event->has_skip())
    {
        $self->_update_skip_event();
    }

    return;
}

=head2 $self->update_skip_reason($detail)

Updates the skip reason according to the detail $detail.

=cut

sub _get_skip_reason
{
    my ($self, $detail) = @_;

    if (!defined($self->skip_reason))
    {
        return $detail->reason();
    }
    elsif ($self->skip_reason ne $detail->reason())
    {
        return "various reasons";
    }
    else
    {
        return $self->skip_reason;
    }
}

sub _real_update_skip_reason
{
    my ($self, $detail) = @_;

    $self->skip_reason($self->_get_skip_reason($detail));
}

sub update_skip_reason
{
    my ($self, $detail) = @_;

    if ($detail->type eq "skip")
    {
        $self->_real_update_skip_reason($detail);
    }
}

sub _get_failed_details
{
    my $self = shift;

    my $details = $self->details;

    return [ grep {! $details->[$_-1]->{ok} } (1 .. @$details) ];
}

=head2 $self->get_failed_obj_params

Returns a key value array ref of params for initializing the failed-object.

=cut

sub get_failed_obj_params
{
    my $self = shift;

    return
        [
            estat => $self->exit(),
            wstat => $self->wait(),
            name  => $self->filename(),
        ];
}

=head2 $self->update_based_on_last_detail()

Check if the last_detail is OK, and if so update the skip_reason
based on it.

=cut

sub update_based_on_last_detail
{
    my $self = shift;

    my $detail = $self->last_detail();

    if ( $detail->ok() )
    {
        $self->update_skip_reason($detail);
    }

    return;
}

=head2 $self->in_the_middle()

Checks if the tests are in the middle - already some were seen but the
end was not reached.

=cut

sub in_the_middle
{
    my $self = shift;

    return ($self->seen() && ($self->seen() > $self->max()));
}

sub _wait2exit_POSIX
{
    my ($self, $wait) = @_;

    return POSIX::WEXITSTATUS($wait);
}

sub _wait2exit_no_POSIX
{
    my ($self, $wait) = @_;

    return ($wait >> 8);
}

eval { require POSIX; POSIX::WEXITSTATUS($?); };

*_wait2exit = ($@ ? \&_wait2exit_no_POSIX : \&_wait2exit_POSIX);

sub _calc_all_process_status
{
    my $self = shift;

    # TODO - factor out the code.
    $self->wait($?);

    if ($self->wait() && $self->_is_vms())
    {
        eval q{use vmsish "status"; $self->exit($?);};
    }
    else
    {
        $self->exit($self->_wait2exit($self->wait()));
    }
    # It is possible $? is set agains because of the use vmsish
    # call.
    if ($? != 0)
    {
        $self->passing(0);
    }

    return;
}

=head2 $self->bonus()

Number of TODO tests that unexpectedly passed.

=head2 $self->details()

An array containing the details of the individual checks in the test file.

=head2 $self->exit()

The exit code of the test script.

=head2 $self->filename()

The filename of the test script.

=head2 $self->max()

The number of planned tests.

=head2 $self-ok()

The number of tests that passed.

=head2 $self->passing()

A boolean value that indicates whether the entire test script is considered
a success or not.

=head2 $self->seen()

The number of tests that were actually run.

=head2 $self->skip()

The number of skipped tests.

=head2 $self->skip_all()

This field will contain the reason for why the entire test script was skipped,
in cases when it was.

=head2 $self->skip_reason()

The skip reason for the last skipped test that specified such a reason.

=head2 $self->todo()

The number of "Todo" tests that were encountered.

=head2 $self->wait()

The wait code of the test script.

=head1 SEE ALSO

L<Test::Run::Base::Struct>, L<Test::Run::Obj>, L<Test::Run::Core>

=head1 LICENSE

This file is licensed under the MIT X11 License:

http://www.opensource.org/licenses/mit-license.php

=head1 AUTHOR

Shlomi Fish, L<http://www.shlomifish.org/>.

=cut

1;