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

use strictures 1;
use MooseX::Declare;

our $VERSION = 0.02;

class Test::Irssi {

    # requires the latest pre-release POE from
    # https://github.com/rcaputo/poe until a new release is...released.
    use lib $ENV{HOME} . "/projects/poe/lib";
    use POE;

    use Term::VT102;
    use Term::Terminfo;
    use feature qw/say switch/;
    use Data::Dump;
    use IO::File;

    use Test::Irssi::Driver;
    use Test::Irssi::Callbacks;
    use Test::Irssi::Test;

    has 'generate_tap'
      => (
          is       => 'rw',
          isa      => 'Bool',
          required => 1,
          default  => 1,
         );

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

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

    has 'terminal_width'
      => (
          is       => 'ro',
          isa      => 'Int',
          required => 1,
          default  => 80,
         );

    has 'terminal_height'
      => (
          is       => 'ro',
          isa      => 'Int',
          required => 1,
          default  => 24,
         );

    has 'vt'
      => (
          is       => 'ro',
          isa      => 'Term::VT102',
          required => 1,
          lazy     => 1,
          builder  => '_build_vt_obj',
         );

    has 'logfile'
      => (
          is       => 'ro',
          isa      => 'Str',
          required => 1,
          default  => 'irssi-test.log',
         );

    has '_logfile_fh'
      => (
          is       => 'ro',
          isa      => 'IO::File',
          required => 1,
          lazy     => 1,
          builder  => '_build_logfile_fh',
         );

    has 'driver'
      => (
          is       => 'ro',
          isa      => 'Test::Irssi::Driver',
          required => 1,
          lazy     => 1,
          builder  => '_build_driver_obj',
          handles  => {
                       run_headless => 'headless',
                      }
         );

    has '_callbacks'
      => (
          is       => 'ro',
          isa      => 'Test::Irssi::Callbacks',
          required => 1,
          lazy     => 1,
          builder  => '_build_callback_obj',
         );

    has 'pending_tests'
      => (
          is       => 'ro',
          isa      => "ArrayRef",
          required => 1,
          default  => sub { [] },
          traits   => [qw/Array/],
          handles  => {
                       add_pending_test  => 'push',
                       next_pending_test => 'shift',
                       tests_remaining   => 'count',
                      }
         );

    has 'completed_tests'
      => (
          is       => 'ro',
          isa      => "ArrayRef",
          required => 1,
          default  => sub { [] },
          traits   => [qw/Array/],
          handles  => {
                       add_completed_test => 'push',
                       tests_completed => 'count',
                      },
         );

    has 'active_test'
      => (
          is  => 'rw',
          isa => 'Test::Irssi::Test',
         );

    sub new_test {
        my ($self, $name, @params) = @_;
        my $new = Test::Irssi::Test->new(name => $name, 
                                         parent => $self,
                                         @params);
        $self->add_pending_test($new);
        return $new;
    }

    method _build_callback_obj {
        Test::Irssi::Callbacks->new(parent => $self);
    }

    method _build_driver_obj {
        Test::Irssi::Driver->new(parent => $self);
    }

    method _build_vt_obj {
        my $rows = $self->terminal_height;
        my $cols = $self->terminal_width;

        Term::VT102->new($cols, $rows);
    }

    method _build_logfile_fh {

        my $logfile = $self->logfile;

        my $fh = IO::File->new($logfile, 'w');
        die "Couldn't open $logfile for writing: $!" unless defined $fh;
        $fh->autoflush(1);

        return $fh;
    }

    method _vt_setup {
        # options
        my $vt = $self->vt;

        $vt->option_set(LINEWRAP => 1);
        $vt->option_set(LFTOCRLF => 1);

        $self->_callbacks->register_callbacks;

    }
    method screenshot {
        my $data = '';
        my $vt = $self->vt;
        foreach my $row (1 .. $vt->rows) {
            $data .= $vt->row_plaintext($row) . "\n";
        }
        return $data;
    }

    method complete_test {
        # put the completed one onto the completed pile
        my $old_test = $self->active_test;
        $self->add_completed_test($old_test);

        # TAP: print status.
        if ($self->generate_tap) {
            my $pass = $old_test->passed;
            my $tap = sprintf("%s %d - %s", $pass?'ok':'not ok',
                              $self->tests_completed,
                              $old_test->description);
            say STDOUT $tap;
            if (not $pass) {
                $old_test->details;
                $self->log("-------------------");
                $self->log($self->screenshot);
                $self->log("-------------------");

            }
        }
    }

    method run_test {
        # and make the next pending one active.
        my $test = $self->next_pending_test;
        $self->active_test($test);

        # signal to the driver to start executing it.
        $poe_kernel->post(IrssiTestDriver => execute_test => $test);
    }

    method run {

        $self->driver->setup;
        $self->_vt_setup;
        $self->log("Driver setup complete");
        ### Start a session to encapsulate the previous features.

        # TAP: print number of tests.
        if ($self->generate_tap) {
            print STDOUT "1.." . $self->tests_remaining . "\n";
        }

        $poe_kernel->run();
    }

    sub apply_delay {
        my ($self, $delay, $next_index) = @_;
        $poe_kernel->post(IrssiTestDriver
                          => create_delay
                          => $delay, $next_index);
    }

    # TODO: pick one.
    sub inject_text {
        my ($self, $text) = @_;
        $poe_kernel->post(IrssiTestDriver => got_terminal_stdin
                          => $text);
    }

    sub simulate_keystroke {
        my ($self, $text) = @_;
        $poe_kernel->post(IrssiTestDriver => got_terminal_stdin
                          => $text);

    }

    method get_topic_line {
        return $self->vt->row_plaintext(1);
    }

    method get_prompt_line {
        return $self->vt->row_plaintext($self->terminal_height);
    }

    method get_window_statusbar_line {
        return $self->vt->row_plaintext($self->terminal_height() - 1);
    }

    method get_window_contents {
        my $buf = '';
        for (2..$self->terminal_height() - 2) {
            $buf .=  $self->vt->row_plaintext($_);
        }
        return $buf;
    }

    method get_cursor_position {
        return ($self->vt->x(), $self->vt->y());
    }

    method load_script {
        my ($script_name) = @_;

    }

    method summarise_test_results {
        foreach my $test (@{$self->completed_tests}) {
            my $name = $test->name;
            printf("Test %s\t\t-\t%s\n", $name, $test->passed?"pass":"fail");
            $test->details();
        }
    }

    sub log {
        my ($self, $msg) = @_;
        $self->_logfile_fh->say($msg);
    }

}

  __END__

=head1 NAME

Test::Irssi - A cunning testing system for Irssi scripts

=head1 SYNOPSIS

blah blah blah