path: root/testing/lib/Test/Irssi/Test.pm

use strictures 1;
use MooseX::Declare;

class Test::Irssi::Test {

    use POE;
    use Test::Irssi;
    use Test::Irssi::Driver;
    use feature qw/say/;
    use Data::Dump qw/dump/;

    has 'parent'
      => (
          is       => 'ro',
          isa      => 'Test::Irssi',
          required => 1,
         );

    has 'name'
      => (
          is       => 'ro',
          isa      => 'Str',
          required => 1,
         );

    has 'description'
      => (
          is      => 'rw',
          isa     => 'Str',
          default => '',
         );

    has 'states'
      => (
          is      => 'ro',
          isa     => 'ArrayRef',
          traits  => [qw/Array/],
          default => sub { [] },
          lazy    => 1,
          handles => {
                      add_state   => 'push',
                      state_count => 'count',
                      get_state   => 'get',
                     },
         );

    has 'results'
      => (
          is      => 'ro',
          isa     => 'ArrayRef',
          default => sub { [] },
         );

    has 'complete'
      => (
          is      => 'rw',
          isa     => 'Bool',
          default => 0,
         );


    has '_next_state'
      => (
          is      => 'rw',
          isa     => 'Int',
          default => 0,
          traits  => [qw/Counter/],
          handles => {
                      _increment_state_counter => 'inc',
                      _clear_state             => 'reset',
                     },
         );

    # TODO: should only be valid when complete is set.
    sub passed {
        my $self = shift;
        my $pass = 0;
        foreach my $result (@{$self->results}) {
            $pass = $result;
        }
        return $pass and $self->complete;
    }

    sub failed {
        my $self = shift;
        return not $self->passed;
    }


    sub details {
        my ($self) = shift;
        my $state_count = $self->state_count;
        for (0..$state_count-1) {
            my $state  = $self->states->[$_];
            my $result = $self->results->[$_];
            say( "#\t" . $state->{type} . " - " . $state->{desc} . " "
              . " = " .( $result?"ok":"not ok"));
        }
    }
    ############# API FUNCTIONS ##########################################


    method add_input_sequence(Str $input) {
        $self->add_state({type  => 'command',
                          of    => 'input',
                          input => $input,
                          desc  => 'input'});

        $self->log("Adding $input as input");
    }

    method add_delay (Num $delay) {
        $self->add_state({type  => 'command',
                          of    => 'delay',
                          desc  => 'delay',
                          delay => $delay });
        $self->log("Adding $delay as delay");

    }

    method add_keycode(Str $code) {
        my $input = $self->translate_keycode($code);
        $self->add_state({type  => 'command',
                          desc  => 'input',
                          input => $input });
        $self->log("Adding $input ($code) as input");

    }
    sub add_diag {
        my ($self, $diag) = @_;
        $self->add_state({type => 'command',
                          of   => 'diag',
                          desc => $diag });
    }

    sub add_pattern_match {
        my ($self, $pattern, $constraints, $desc) = @_;
        $self->add_state({type        => 'test',
                          of          => 'pattern',
                          pattern     => $pattern,
                          constraints => $constraints,
                          desc        => $desc});

        $self->log("Adding $pattern as output match ");
    }

    sub test_cursor_position {
        my ($self, $x, $y, $desc) = @_;
        $self->add_state({type => 'test',
                          of   => 'cursor',
                          x    => $x,
                          y    => $y,
                          desc => $desc });
        $self->log("Adding cursor [$x, $y] test ");

    }

    sub add_evaluation_function {
        my ($self, $coderef, $desc) = @_;
        $self->add_state({type => 'test',
                          of   => 'function',
                          code => $coderef,
                          desc => $desc});
    }


    ############# END OF API FUNCTIONS ####################################



    method translate_keycode(Str $code) {
        my $seq = '';
        if ($code =~ m/M-([a-z])/i) {
            $seq = "\x1b" . $1;
        } elsif ($code =~ m/C-([a-z])/i) {
            $seq = chr ( ord(lc $1) - 64 );
        }
        return $seq;
    }

    method this_state {
        return $self->_next_state - 1;
    }

    sub check_output {
        my ($self, $data) = @_;

        my ($pattern, $constraints) = ($data->{pattern}, $data->{constraints});

        my $ok = 0;
        my $line = '';
        if ($constraints eq 'prompt') {
            $line = $self->parent->get_prompt_line;
        } elsif ($constraints eq 'window_sbar') {
            $line = $self->parent->get_window_statusbar_line;
        } elsif ($constraints eq 'window') {
            # NOTE: not actually a line.
            $line = $self->parent->get_window_contents;
        } elsif ($constraints eq 'topic') {
            $line = $self->parent->get_topic_line;
        }

        $self->log("Testing pattern against: '$line'");

        if ($line =~ m/$pattern/) {
            $self->log("Pattern $pattern passed");
            $self->results->[$self->this_state] = 1;
        } else {
            $self->log("Pattern $pattern failed");
            $self->results->[$self->this_state] = 0;;
        }
    }

    sub get_next_state {
        my ($self) = @_;
        my $item = $self->get_state($self->_next_state);
        $self->_increment_state_counter;

        return $item;
    }

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

        while (my $state = $self->get_next_state) {

            $self->log("Evaluating Test: " . dump($state));

            my $type = $state->{type};

            if ($type eq 'command') {
                my $subtype = $state->{of};

                if ($subtype eq 'diag') {
                    if ($self->parent->generate_tap) {
                        say STDOUT '#' . $state->{desc};
                    }
                }
                if ($subtype eq 'input') {
                    $self->parent->inject_text($state->{input});
                    $self->log("input: ". $state->{input});
                }
                if ($subtype eq 'delay') {
                    $self->log("inserting delay");
                    $self->parent->apply_delay($state->{delay});
                    $self->results->[$self->this_state] = 1;
                    return;
                }

                # all commands are considered to succeed.
                $self->results->[$self->this_state] = 1;

            } elsif ($type eq 'test') {

                my $test_type = $state->{of};

                if ($test_type eq 'pattern') {
                    my $pattern = $state->{pattern};
                    $self->check_output($state);
                }
                if ($test_type eq 'cursor') {
                    my ($curs_x, $curs_y) = $self->parent->get_cursor_position;

                    my $ret = 0;
                    if ($state->{x} == $curs_x and $state->{y} == $curs_y) {
                        $ret = 1;
                    }

                    $self->results->[$self->this_state] = $ret;

                }

                if ($test_type eq 'function') {
                    # code evaluation
                    my @args = ($self, $self->parent, $self->parent->vt);
                    my $ret = $state->{code}->(@args);
                    $ret //= 0; # ensure that undef failures are
                    # marked as such.
                    $self->results->[$self->this_state] = $ret;
                }
            } else {
                # wtf?
            }
        }

        $poe_kernel->post(IrssiTestDriver => 'test_complete');

        $self->complete(1);

        $self->log("Test Execution Finished");
    }

    sub resume_from_timer {
        my ($self) = @_;
        $self->log("Resuming after timeout");
        $self->evaluate_test;
    }
    sub log {
        my ($self, $msg) = @_;
        $self->parent->_logfile_fh->say($msg);
    }

  sub _all { $_ || return 0 for @_; 1 }
}



  __END__