Merge branch 'master' into richoH-dev

18 files changed, 1397 insertions, 0 deletions

diff --git a/testing/.gitignore b/testing/.gitignore
new file mode 100644
index 0000000..119fe08
--- /dev/null
+++ b/testing/.gitignore
@@ -0,0 +1,5 @@
+Makefile
+Makefile.old
+blib/
+irssi.log
+pm_to_blib
diff --git a/testing/Changes b/testing/Changes
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/testing/Changes
diff --git a/testing/MANIFEST b/testing/MANIFEST
new file mode 100644
index 0000000..1810c3e
--- /dev/null
+++ b/testing/MANIFEST
@@ -0,0 +1,13 @@
+Makefile.PL
+MANIFEST
+MANIFEST.SKIP
+README
+Changes
+
+t/001-use.t
+t/002-init.t
+
+lib/Test/Irssi.pm
+lib/Test/Irssi/Callbacks.pm
+lib/Test/Irssi/Driver.pm
+lib/Test/Irssi/Test.pm
\ No newline at end of file
diff --git a/testing/MANIFEST.SKIP b/testing/MANIFEST.SKIP
new file mode 100644
index 0000000..1bfcbf3
--- /dev/null
+++ b/testing/MANIFEST.SKIP
@@ -0,0 +1,9 @@
+.*\.git.*
+pm_to_blib
+.*\.old
+.*\.bak
+.*\.swp
+blib/.*
+^Makefile$
+\d+_local_
+
diff --git a/testing/Makefile.PL b/testing/Makefile.PL
new file mode 100644
index 0000000..3312c95
--- /dev/null
+++ b/testing/Makefile.PL
@@ -0,0 +1,30 @@
+use strict;
+use warnings;
+use Cwd;
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+
+WriteMakefile(
+              NAME              => 'Test::Irssi',
+              AUTHOR            => 'shabble <shabble+cpan@metavore.org>',
+              VERSION_FROM      => 'lib/Test/Irssi.pm', # finds $VERSION
+              ABSTRACT_FROM     => 'lib/Test/Irssi.pm',
+              PL_FILES          => {},
+              # LIBS              => ["-L/opt/local/lib -lcprops"],
+              # INC               => "-I/opt/local/include/cprops",
+              PREREQ_PM         => {
+                                    'Test::More'        => 0,
+                                    'Carp'              => 0,
+                                    'MooseX::Declare'   => 0,
+                                    'IO::File'          => 0,
+                                    'Term::VT102'       => 0,
+                                    'Term::Terminfo'    => 0,
+                                    'strictures'        => 0,
+                                    'Data::Dump'        => 0,
+                                   },
+              dist                => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+              # clean               => {
+              #                         FILES => 'CProps-Trie-* Trie.inl _Inline'
+              #                        },
+             );
diff --git a/testing/README b/testing/README
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/testing/README
diff --git a/testing/lib/Test/Irssi.pm b/testing/lib/Test/Irssi.pm
new file mode 100644
index 0000000..0db7ee0
--- /dev/null
+++ b/testing/lib/Test/Irssi.pm
@@ -0,0 +1,314 @@
+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
diff --git a/testing/lib/Test/Irssi/Callbacks.pm b/testing/lib/Test/Irssi/Callbacks.pm
new file mode 100644
index 0000000..8321ace
--- /dev/null
+++ b/testing/lib/Test/Irssi/Callbacks.pm
@@ -0,0 +1,123 @@
+use strictures 1;
+
+package Test::Irssi::Callbacks;
+
+use Moose;
+use Data::Dump qw/dump/;
+use Data::Dumper;
+
+has 'parent'
+  => (
+      is       => 'ro',
+      isa      => 'Test::Irssi',
+      required => 1,
+     );
+
+sub register_callbacks {
+    my ($self) = @_;
+
+    my $vt = $self->parent->vt;
+    $self->log("Callbacks registered");
+
+    $vt->callback_set(OUTPUT      => sub { $self->vt_output(@_)    }, undef);
+    $vt->callback_set(ROWCHANGE   => sub { $self->vt_rowchange(@_) }, undef);
+    $vt->callback_set(CLEAR       => sub { $self->vt_clear(@_)     }, undef);
+    $vt->callback_set(SCROLL_DOWN => sub { $self->vt_scr_up(@_)    }, undef);
+    $vt->callback_set(SCROLL_UP   => sub { $self->vt_scr_dn(@_)    }, undef);
+    $vt->callback_set(GOTO        => sub { $self->vt_goto(@_)      }, undef);
+
+}
+
+sub vt_output {
+    my ($self, $vt, $cb_name, $cb_data) = @_;
+    $self->log( "OUTPUT: " . dump([@_[1..$#_]]));
+}
+
+sub vt_rowchange {
+    my $self = shift;
+    my ($vt, $cb_name, $arg1, $arg2) = @_;
+
+    $arg1 //= '?';
+    $arg2 //= '?';
+
+    $self->log( "-" x 100);
+    $self->log( "Row $arg1 changed: ");
+
+    my $bottom_line = $vt->rows();
+
+    $self->log( "-" x 100);
+    $self->log( "Window Line");
+    $self->log( "-" x 100);
+    $self->log(  $vt->row_plaintext($bottom_line - 1));
+    $self->log( "-" x 100);
+    $self->log( "Prompt line");
+    $self->log( "-" x 100);
+    $self->log(  $vt->row_plaintext($bottom_line));
+
+}
+
+sub vt_clear {
+    my $self = shift;
+    my ($vt, $cb_name, $arg1, $arg2) = @_;
+    $arg1 //= '?';
+    $arg2 //= '?';
+
+    $self->log( "VT Cleared");
+}
+
+sub vt_scr_dn {
+    my $self = shift;
+    my ($vt, $cb_name, $arg1, $arg2) = @_;
+    $arg1 //= '?';
+    $arg2 //= '?';
+
+    $self->log( "Scroll Down");
+}
+
+sub vt_scr_up {
+    my $self = shift;
+    my ($vt, $cb_name, $arg1, $arg2) = @_;
+    $arg1 //= '?';
+    $arg2 //= '?';
+
+    $self->log( "Scroll Up");
+}
+
+
+sub vt_goto {
+    my $self = shift;
+    my ($vt, $cb_name, $arg1, $arg2) = @_;
+    $arg1 //= '?';
+    $arg2 //= '?';
+
+    $self->log( "Goto: $arg1, $arg2");
+}
+
+sub vt_dump {
+    my ($self) = @_;
+    my $vt = $self->parent->vt;
+    my $rows = $self->parent->terminal_height;
+    my $str = '';
+    for my $y (1..$rows) {
+        $str .= $vt->row_sgrtext($y) . "\n";
+    }
+
+    return $str;
+}
+
+sub log {
+    my ($self, $msg) = @_;
+    #$self->parent->_logfile_fh->say($msg);
+}
+
+__PACKAGE__->meta->make_immutable;
+
+no Moose;
+
+
+
+# # delegate to Callbacks.
+# sub vt_dump {
+#     my ($self) = @_;
+#     my $cb = $self->parent->_callbacks->vt_dump();
+# }
diff --git a/testing/lib/Test/Irssi/Driver.pm b/testing/lib/Test/Irssi/Driver.pm
new file mode 100644
index 0000000..6b4e5e5
--- /dev/null
+++ b/testing/lib/Test/Irssi/Driver.pm
@@ -0,0 +1,258 @@
+use strictures 1;
+
+package Test::Irssi::Driver;
+
+use Moose;
+use lib $ENV{HOME} . "/projects/poe/lib";
+
+use POE qw( Wheel::ReadWrite Wheel::Run Filter::Stream );
+use POSIX;
+use feature qw/say/;
+use Data::Dump qw/dump/;
+
+has 'parent'
+  => (
+      is       => 'ro',
+      isa      => 'Test::Irssi',
+      required => 1,
+     );
+
+has 'headless'
+  => (
+      is      => 'rw',
+      isa     => 'Bool',
+      default => 0,
+     );
+
+sub  START {
+    my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
+
+    $kernel->alias_set("IrssiTestDriver");
+
+    $self->log("Start handler called");
+
+    $self->save_term_settings($heap);
+
+    # Set a signal handler.
+    $kernel->sig(CHLD => "got_sigchld");
+
+    $self->make_raw_terminal;
+
+    my @stdio_options =
+      (
+       InputHandle  => \*STDIN,
+       OutputHandle => \*STDOUT,
+       InputEvent   => "got_terminal_stdin",
+       Filter       => POE::Filter::Stream->new(),
+      );
+
+    $self->log("stdio options: " . dump(@stdio_options));
+
+    # Start the terminal reader/writer.
+    $heap->{stdio} = POE::Wheel::ReadWrite->new(@stdio_options);
+
+    $self->log("Created stdio wheel");
+
+    my $rows = $self->parent->terminal_height;
+    my $cols = $self->parent->terminal_width;
+
+    my @program_options =
+      (
+       Program     => $self->parent->irssi_binary,
+       ProgramArgs => ['--noconnect', '--home=' . $self->parent->irssi_homedir ],
+       Conduit     => "pty",
+       Winsize     => [$rows, $cols, 0, 0],
+       StdoutEvent => "got_child_stdout",
+       StdioFilter => POE::Filter::Stream->new(),
+      );
+
+    $self->log("wheel options: " . dump(@program_options));
+
+    # Start the asynchronous child process.
+    $heap->{program} = POE::Wheel::Run->new(@program_options);
+
+    $self->log("Created child run wheel");
+    $poe_kernel->yield('testing_ready');
+}
+
+sub STOP {
+    my ($self, $heap) = @_[OBJECT,HEAP];
+    $self->log("STOP called");
+    $self->restore_term_settings($heap);
+    $self->parent->_logfile_fh->close();
+
+    if (not $self->parent->generate_tap) {
+        $self->parent->summarise_test_results();
+    }
+}
+
+### Handle terminal STDIN.  Send it to the background program's STDIN.
+### If the user presses ^C, then echo a little string
+
+sub terminal_stdin {
+    my ($self, $heap, $input) = @_[OBJECT, HEAP, ARG0];
+
+    if ($input =~ m/\003/g) { # C-c
+        $input = "/echo I like cakes\n";
+    } elsif ($input =~ m/\x17/g) { # C-w
+        $input = "/quit\n";
+    }
+
+    $heap->{program}->put($input);
+}
+
+### Handle STDOUT from the child program.
+sub child_stdout {
+    my ($self, $heap, $input) = @_[OBJECT, HEAP, ARG0];
+    # process via vt
+    $self->parent->vt->process($input);
+
+    if (not $self->headless) {
+        # send to terminal
+        $heap->{stdio}->put($input);
+    }
+}
+
+### Handle SIGCHLD.  Shut down if the exiting child process was the
+### one we've been managing.
+
+sub shutdown {
+    my ($self, $heap, $kernel) = @_[OBJECT, HEAP, KERNEL];
+    $self->log("Shutdown called");
+    $heap->{program}->kill(15);
+    $kernel->alias_remove("IrssiTestDriver");
+}
+
+sub CHILD {
+    my ($self, $heap, $child_pid) = @_[OBJECT, HEAP, ARG1];
+    if ($child_pid == $heap->{program}->PID) {
+        delete $heap->{program};
+        delete $heap->{stdio};
+    }
+    return 0;
+}
+
+sub setup {
+    my $self = shift;
+
+    my @states =
+      (
+       object_states =>
+       [ $self =>
+         {
+          _start             => 'START',
+          _stop              => 'STOP',
+          got_sigchld        => 'CHILD',
+
+          got_terminal_stdin => 'terminal_stdin',
+          got_child_stdout   => 'child_stdout',
+
+          got_delay          => 'timer_expired',
+          create_delay       => 'timer_created',
+
+
+          testing_ready      => 'testing_ready',
+          test_complete      => 'test_complete',
+          execute_test       => 'execute_test',
+
+          shutdown           => 'shutdown',
+         }
+       ]
+      );
+    $self->log("creating root session");
+
+    POE::Session->create(@states);
+    $self->log("session created");
+
+}
+
+sub testing_ready {
+    my ($self) = $_[OBJECT];
+    # begin by fetching a test from the pending queue.
+    $self->log("Starting to run tests");
+    $self->log("-" x 80);
+    $self->parent->run_test;
+}
+
+sub execute_test {
+    my ($self, $heap, $kernel, $test) = @_[OBJECT,HEAP, KERNEL, ARG0];
+    # do some stuff here to evaluate it.
+
+    $test->evaluate_test;
+
+}
+
+sub test_complete {
+    my ($self, $kernel) = @_[OBJECT, KERNEL];
+
+    $self->parent->complete_test;
+
+    if ($self->parent->tests_remaining) {
+        $self->parent->run_test;
+    }
+
+    # otherwise, we're done, and can shutdown.
+   #kernel->yield('shutdown');
+
+}
+
+sub timer_created {
+    my ($self, $heap, $kernel, $duration) = @_[OBJECT, HEAP, KERNEL, ARG0];
+    $kernel->delay(got_delay => $duration);
+    $self->log("Timer created for $duration");
+}
+
+sub timer_expired {
+    my ($self, $data) = @_[OBJECT,ARG0];
+    $self->log("Timeout invoking test again.");
+    $self->parent->active_test->resume_from_timer;
+}
+
+sub save_term_settings {
+    my ($self, $heap) = @_;
+    # Save the original terminal settings so they can be restored later.
+    $heap->{stdin_tio} = POSIX::Termios->new();
+    $heap->{stdin_tio}->getattr(0);
+    $heap->{stdout_tio} = POSIX::Termios->new();
+    $heap->{stdout_tio}->getattr(1);
+    $heap->{stderr_tio} = POSIX::Termios->new();
+    $heap->{stderr_tio}->getattr(2);
+}
+
+sub restore_term_settings {
+    my ($self, $heap) = @_;
+
+    $heap->{stdin_tio}->setattr (0, TCSANOW);
+    $heap->{stdout_tio}->setattr(1, TCSANOW);
+    $heap->{stderr_tio}->setattr(2, TCSANOW);
+}
+
+sub make_raw_terminal {
+    my ($self) = @_;
+    # Put the terminal into raw input mode.  Otherwise discrete
+    # keystrokes will not be read immediately.
+    my $tio = POSIX::Termios->new();
+    $tio->getattr(0);
+    my $lflag = $tio->getlflag;
+    $lflag &= ~(ECHO | ECHOE | ECHOK | ECHONL | ICANON | IEXTEN | ISIG);
+    $tio->setlflag($lflag);
+    my $iflag = $tio->getiflag;
+    $iflag &= ~(BRKINT | INPCK | ISTRIP | IXON);
+    $tio->setiflag($iflag);
+    my $cflag = $tio->getcflag;
+    $cflag &= ~(CSIZE | PARENB);
+    $tio->setcflag($cflag);
+    $tio->setattr(0, TCSANOW);
+}
+
+sub log {
+    my ($self, $msg) = @_;
+    my $fh = $self->parent->_logfile_fh;
+    $fh->say($msg);
+}
+
+
+__PACKAGE__->meta->make_immutable;
+
+no Moose;
+
diff --git a/testing/lib/Test/Irssi/Misc.pm b/testing/lib/Test/Irssi/Misc.pm
new file mode 100644
index 0000000..a6339e0
--- /dev/null
+++ b/testing/lib/Test/Irssi/Misc.pm
@@ -0,0 +1,35 @@
+package Test::Irssi::Misc;
+use strictures 1;
+
+
+
+sub keycombo_to_code {
+    my ($key_combo) = @_;
+    my $output = '';
+    my $ctrl = 0;
+    my $meta = 0;
+    if ($key_combo =~ m/[cC](?:trl)?-(.+)/) {
+        $ctrl = 1;
+        _parse_rest($1);
+    }
+    if ($key_combo =~ m/[Mm](?:eta)?-(.+)/) {
+        $meta = 1;
+        _parse_rest($1);
+    }
+}
+
+sub _parse_key {
+    my ($rest) = @_;
+    my $special = {
+                   left => '',
+                   right => '',
+                   up => '',
+                   down => '',
+                   tab => '',
+                   space => '',
+                   spc => '',
+                  };
+}
+
+
+1;
diff --git a/testing/lib/Test/Irssi/Test.pm b/testing/lib/Test/Irssi/Test.pm
new file mode 100644
index 0000000..cd0a6f9
--- /dev/null
+++ b/testing/lib/Test/Irssi/Test.pm
@@ -0,0 +1,308 @@
+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__
diff --git a/testing/lib/Test/Irssi/VirtualIrssi.pm b/testing/lib/Test/Irssi/VirtualIrssi.pm
new file mode 100644
index 0000000..dc3bfc7
--- /dev/null
+++ b/testing/lib/Test/Irssi/VirtualIrssi.pm
@@ -0,0 +1,32 @@
+use strictures 1;
+use MooseX::Declare;
+
+class Test::Irssi::VirtualIrssi {
+
+# class that pretends to be irssi which you can pull out various data from.
+
+
+has cursor
+ => (
+     is      => 'ro',
+     writer  => '_set_cursor',
+     isa     => 'ArrayRef[Int]',
+     default => sub { [0, 0] },
+    );
+
+has topic_row
+ => (
+    );
+
+has window_row
+ => (
+    );
+
+has prompt_row
+ => (
+    );
+
+has window
+ => (
+    );
+}
diff --git a/testing/t/001-use.t b/testing/t/001-use.t
new file mode 100755
index 0000000..6ebbb5a
--- /dev/null
+++ b/testing/t/001-use.t
@@ -0,0 +1,27 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Data::Dumper;
+
+BEGIN {
+    use_ok 'Test::Irssi';
+}
+
+
+my $test = new_ok 'Test::Irssi',
+  [irssi_binary => 'null', irssi_homedir => 'null'];
+
+my @methods = qw/logfile terminal_height terminal_width irssi_homedir irssi_binary/;
+can_ok($test, @methods);
+
+undef $test;
+
+done_testing;
+
+__END__
+
+
+
diff --git a/testing/t/002-init.t b/testing/t/002-init.t
new file mode 100755
index 0000000..b688f9f
--- /dev/null
+++ b/testing/t/002-init.t
@@ -0,0 +1,33 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Data::Dumper;
+
+BEGIN {
+    use_ok 'Test::Irssi';
+}
+
+
+my $test = new_ok 'Test::Irssi',
+  [irssi_binary  => "/opt/stow/repo/irssi-debug/bin/irssi",
+   irssi_homedir => $ENV{HOME} . "/projects/tmp/test/irssi-debug"];
+
+if (-f $test->logfile) {
+    ok(unlink $test->logfile, 'deleted old logfile');
+}
+
+my $drv = $test->driver;
+isa_ok($drv, 'Test::Irssi::Driver', 'driver created ok');
+
+diag "Starting POE session";
+$test->run();
+
+done_testing;
+
+__END__
+
+
+
diff --git a/testing/test-shim.pl b/testing/test-shim.pl
new file mode 100644
index 0000000..628f7af
--- /dev/null
+++ b/testing/test-shim.pl
@@ -0,0 +1,114 @@
+use strict;
+use warnings;
+
+use Irssi;
+use Irssi::Irc;
+use Irssi::TextUI;
+
+use Data::Dumper;
+use POSIX;
+use Time::HiRes qw/sleep/;
+use JSON::Any;
+
+
+our $VERSION = '0.1';
+our %IRSSI = (
+              authors     => 'shabble',
+              contact     => 'shabble+irssi@metavore.org',
+              name        => 'test-shim',
+              description => '',
+              license     => 'Public Domain',
+             );
+
+
+my $forked = 0;
+
+sub pipe_and_fork {
+    my ($read_handle, $write_handle);
+    pipe($read_handle, $write_handle);
+
+    my $oldfh = select($write_handle);
+    $| = 1;
+    select $oldfh;
+
+    return if $forked;
+
+    my $pid = fork();
+
+    if (not defined $pid) {
+        _error("Can't fork: Aborting");
+        close($read_handle);
+        close($write_handle);
+        return;
+    }
+
+    $forked = 1;
+
+    if ($pid > 0) { # this is the parent (Irssi)
+        close ($write_handle);
+        Irssi::pidwait_add($pid);
+        my $job = $pid;
+        my $tag;
+        my @args = ($read_handle, \$tag, $job);
+        $tag = Irssi::input_add(fileno($read_handle),
+                                      Irssi::INPUT_READ,
+                                      \&child_input,
+                                      \@args);
+
+    } else { # child
+        child_process($write_handle);
+        close $write_handle;
+
+        POSIX::_exit(1);
+    }
+}
+sub _cleanup_child {
+    my ($read_handle, $input_tag_ref) = @_;
+    close $read_handle;
+    Irssi::input_remove($$input_tag_ref);
+    _msg("child finished");
+    $forked = 0;
+}
+sub child_input {
+    my $args = shift;
+    my ($read_handle, $input_tag_ref, $job) = @$args;
+
+    my $input = <$read_handle>;
+    my $data = JSON::Any::jsonToObj($input);
+    if (ref $data  ne 'HASH') { 
+        _error("Invalid data received: $input");
+        _cleanup_child($read_handle, $input_tag_ref);
+    }
+
+    if (exists $data->{connection}) {
+        if ($data->{connection} eq 'close') {
+            _cleanup_child($read_handle, $input_tag_ref);
+        }
+    } else {
+        parent_process_response($data);
+    }
+}
+
+sub parent_process_response {
+    my ($data) = @_;
+}
+
+
+sub child_process {
+    my ($handle) = @_;
+
+}
+
+sub _error {
+    my ($msg) = @_;
+    my $win = Irssi::active_win();
+    $win->print($msg, Irssi::MSGLEVEL_CLIENTERROR);
+}
+
+sub _msg {
+    my ($msg) = @_;
+    my $win = Irssi::active_win();
+    $win->print($msg, Irssi::MSGLEVEL_CLIENTCRAP);
+}
+
+Irssi::command_bind("start_pipes", \&pipe_and_fork);
diff --git a/testing/test.pl b/testing/test.pl
new file mode 100755
index 0000000..bf01530
--- /dev/null
+++ b/testing/test.pl
@@ -0,0 +1,17 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use feature qw/say/;
+#use lib 'blib/lib';
+
+use TAP::Harness;
+my $harness = TAP::Harness->new({ verbosity => 1,
+                                  lib => 'blib/lib',
+                                  color => 1,
+                                });
+
+my @tests = glob($ARGV[0]);
+say "Tests: " . join (", ", @tests);
+$harness->runtests(@tests);
diff --git a/testing/tests/001-basic.t b/testing/tests/001-basic.t
new file mode 100755
index 0000000..60578d8
--- /dev/null
+++ b/testing/tests/001-basic.t
@@ -0,0 +1,50 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use feature qw/say/;
+use Test::Irssi;
+
+my $tester = Test::Irssi->new
+  (irssi_binary  => "/opt/stow/repo/irssi-debug/bin/irssi",
+   irssi_homedir => $ENV{HOME} . "/projects/tmp/test/irssi-debug");
+
+if (exists $ENV{IRSSI_TEST_HEADLESS} and $ENV{IRSSI_TEST_NOHEADLESS} == 1) {
+    $tester->run_headless(0);
+    $tester->generate_tap(0);
+} else {
+    $tester->run_headless(1);
+    $tester->generate_tap(1);
+}
+
+my $test = $tester->new_test('test1');
+$test->description("simple echo tests");
+
+$test->add_input_sequence("/echo Hello cats\n");
+$test->add_delay(1);
+$test->add_input_sequence("/echo Hello Again\n");
+$test->add_input_sequence("this is a long test");
+$test->add_delay(0.5);
+$test->add_pattern_match(qr/long/, 'prompt', 'prompt contains long');
+$test->add_delay(1);
+
+$test->add_pattern_match(qr/this is a .*? test/, 'prompt', 'prompt matches');
+
+my $test2 = $tester->new_test('test2');
+$test2->description("cursor movement and deletion");
+
+$test2->add_delay(1);
+$test2->add_input_sequence("\x01");
+$test2->add_delay(0.1);
+$test2->add_input_sequence("\x0b");
+$test2->add_delay(0.1);
+$test2->add_input_sequence("/clear\n");
+$test2->add_delay(0.1);
+$test2->add_input_sequence("/echo moo\n");
+
+my $quit = $tester->new_test('quit');
+$quit->description('quitting');
+$quit->add_input_sequence("/quit\n");
+
+$tester->run;
diff --git a/testing/tests/002-cursor-test.t b/testing/tests/002-cursor-test.t
new file mode 100755
index 0000000..eb35170
--- /dev/null
+++ b/testing/tests/002-cursor-test.t
@@ -0,0 +1,29 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use feature qw/say/;
+use Test::Irssi;
+
+my $tester = Test::Irssi->new
+  (irssi_binary  => "/opt/stow/repo/irssi-debug/bin/irssi",
+   irssi_homedir => $ENV{HOME} . "/projects/tmp/test/irssi-debug");
+
+if (exists $ENV{IRSSI_TEST_HEADLESS} and $ENV{IRSSI_TEST_NOHEADLESS} == 1) {
+    $tester->run_headless(0);
+    $tester->generate_tap(0);
+} else {
+    $tester->run_headless(1);
+    $tester->generate_tap(1);
+}
+
+my $test = $tester->new_test('test1');
+$test->description("simple echo tests");
+$test->add_diag("Testing 123");
+
+my $quit = $tester->new_test('quit');
+$quit->description('quitting');
+$quit->add_input_sequence("/quit\n");
+
+$tester->run;