more work on testing system for irssi. Most of the screenscraping now works,

trying to finalise an API for actual testing usage.

5 files changed, 248 insertions, 78 deletions

diff --git a/testing/lib/Test/Irssi.pm b/testing/lib/Test/Irssi.pm
index be87dcf..dbb2505 100644
--- a/testing/lib/Test/Irssi.pm
+++ b/testing/lib/Test/Irssi.pm
@@ -5,120 +5,125 @@ our $VERSION = 0.01;
 
 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::API;
+
 
-    # 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;
 
 
     has 'irssi_binary'
       => (
-          is => 'ro',
-          isa => 'Str',
+          is       => 'ro',
+          isa      => 'Str',
           required => 1,
          );
 
     has 'irssi_homedir'
       => (
-          is => 'ro',
-          isa => 'Str',
+          is       => 'ro',
+          isa      => 'Str',
           required => 1,
          );
 
     has 'terminal_width'
       => (
-          is => 'ro',
-          isa => 'Int',
+          is       => 'ro',
+          isa      => 'Int',
           required => 1,
-          default => 80,
+          default  => 80,
          );
 
     has 'terminal_height'
       => (
-          is => 'ro',
-          isa => 'Int',
+          is       => 'ro',
+          isa      => 'Int',
           required => 1,
-          default => 24,
+          default  => 24,
          );
 
     has 'vt'
       => (
-          is => 'ro',
-          isa => 'Term::VT102',
+          is       => 'ro',
+          isa      => 'Term::VT102',
           required => 1,
-          lazy => 1,
-          builder => '_build_vt102',
+          lazy     => 1,
+          builder  => '_build_vt_obj',
          );
 
     has 'logfile'
       => (
-          is => 'ro',
-          isa => 'Str',
+          is       => 'ro',
+          isa      => 'Str',
           required => 1,
-          default => 'irssi-test.log',
+          default  => 'irssi-test.log',
          );
 
     has '_logfile_fh'
       => (
-          is => 'ro',
-          isa => 'IO::File',
+          is       => 'ro',
+          isa      => 'IO::File',
           required => 1,
-          lazy => 1,
-          builder => '_build_logfile_fh',
+          lazy     => 1,
+          builder  => '_build_logfile_fh',
          );
 
     has '_driver'
       => (
-          is => 'ro',
-          isa => 'Test::Irssi::Driver',
+          is       => 'ro',
+          isa      => 'Test::Irssi::Driver',
           required => 1,
-          lazy => 1,
-          builder => '_build_driver',
+          lazy     => 1,
+          builder  => '_build_driver_obj',
          );
 
     has '_callbacks'
       => (
+          is       => 'ro',
+          isa      => 'Test::Irssi::Callbacks',
+          required => 1,
+          lazy     => 1,
+          builder  => '_build_callback_obj',
+         );
+
+    has 'api'
+      => (
           is => 'ro',
-          isa => 'Test::Irssi::Callbacks',
+          isa => "Test::Irssi::API",
           required => 1,
           lazy => 1,
-          builder => '_build_callback_obj',
+          builder => "_build_api"
          );
 
-    method _build_callback_obj {
-        my $cbo = Test::Irssi::Callbacks->new(parent => $self);
-
-        $self->log("Going to register vt callbacks");
-        $cbo->register_vt_callbacks;
+    method _build_api {
+        Test::Irssi::API->new(parent => $self);
+    }
 
-        return $cbo;
+    method _build_callback_obj {
+        Test::Irssi::Callbacks->new(parent => $self);
     }
 
-    method _build_driver {
-        my $drv = Test::Irssi::Driver->new(parent => $self);
-        return $drv;
+    method _build_driver_obj {
+        Test::Irssi::Driver->new(parent => $self);
     }
 
-    method _build_vt102 {
+    method _build_vt_obj {
         my $rows = $self->terminal_height;
         my $cols = $self->terminal_width;
 
-        my $vt = Term::VT102->new($cols, $rows);
-
-        # options
-        $vt->option_set(LINEWRAP => 1);
-        $vt->option_set(LFTOCRLF => 1);
-
-
-        return $vt;
+        Term::VT102->new($cols, $rows);
     }
 
     method _build_logfile_fh {
@@ -132,18 +137,50 @@ class Test::Irssi {
         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 log (Str $msg) {
-        $self->_logfile_fh->say($msg);
     }
 
+    sub log {
+        my ($self, $msg) = @_;
+        $self->_logfile_fh->say($msg);
+    }
 
     method run {
-        $self->_driver->setup();
+        $self->_driver->setup;
+        $self->_vt_setup;
         $self->log("Driver setup complete");
         ### Start a session to encapsulate the previous features.
         $poe_kernel->run();
     }
+
+    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_prompt_line {
+        return $self->vt->row_plaintext($self->terminal_height)
+    }
+
+    method get_window_statusbar_line {
+        return $self->vt->row_plaintext($self->terminal_height() - 1)
+    }
 }
 
 __END__
diff --git a/testing/lib/Test/Irssi/API.pm b/testing/lib/Test/Irssi/API.pm
new file mode 100644
index 0000000..3a659ed
--- /dev/null
+++ b/testing/lib/Test/Irssi/API.pm
@@ -0,0 +1,80 @@
+use strictures 1;
+use MooseX::Declare;
+
+class Test::Irssi::API {
+
+    use POE;
+    use Data::Dumper;
+
+    has 'parent'
+      => (
+          is       => 'ro',
+          isa      => 'Test::Irssi',
+          required => 1,
+         );
+
+
+    has 'tests'
+      => (
+          traits => [qw/Hash/],
+          is => 'rw',
+          isa => 'HashRef',
+          default => sub { {} },
+          handles => {
+                      test_names => 'keys',
+                     },
+         );
+
+
+    sub create_test {
+        my ($self, $name, $desc) = @_;
+        $self->tests->{$name} = {desc => $desc, input => [], output => []};
+    }
+
+    sub simulate_input {
+        my ($self, $name, $input) = @_;
+        push @{ $self->tests->{$name}->{input} }, { input => $input };
+    }
+
+    sub simulate_delay {
+        my ($self, $name, $delay) = @_;
+        push @{ $self->tests->{$name}->{input} }, { delay => $delay };
+
+    }
+
+    sub expect_output {
+        my ($self, $name, $regex, $line) = @_; # line is optional?
+        push @{ $self->tests->{$name}->{output} }, { regex => $regex, line => $line };
+    }
+
+    sub run_test {
+        my ($self, $test_name) = @_;
+        my $data = $self->tests->{$test_name};
+        foreach my $entry (@{ $data->{input} }) {
+            if (exists $entry->{input}) {
+                my $text = $entry->{input};
+                $self->parent->inject_text($text);
+            } elsif (exists $entry->{delay}) {
+                my $delay = $entry->{delay};
+                _do_delay($delay);
+            } else {
+                die "What: " . Dumper($entry);
+            }
+        }
+    }
+
+    sub run_tests {
+        my ($self) = @_;
+        foreach my $test_name ($self->test_names) {
+            my $test = $self->tests->{$test_name};
+            print "Going to prcess: $test_name";
+            print Dumper($test);
+
+        }
+    }
+
+
+    sub _do_delay {
+        $poe_kernel->post('IrssiTestDriver' => create_delay => 5);
+    }
+}
diff --git a/testing/lib/Test/Irssi/Callbacks.pm b/testing/lib/Test/Irssi/Callbacks.pm
index eb33039..adceb65 100644
--- a/testing/lib/Test/Irssi/Callbacks.pm
+++ b/testing/lib/Test/Irssi/Callbacks.pm
@@ -4,6 +4,7 @@ package Test::Irssi::Callbacks;
 
 use Moose;
 use Data::Dump qw/dump/;
+use Data::Dumper;
 
 has 'parent'
   => (
@@ -12,31 +13,29 @@ has 'parent'
       required => 1,
      );
 
-sub register_vt_callbacks {
+sub register_callbacks {
     my ($self) = @_;
 
-    $self->log("Callbacks registered");
     my $vt = $self->parent->vt;
-    # callbacks
-    $self->log("VT is " . ref($vt));
-
-    $vt->callback_set(OUTPUT      => sub { \&vt_output    }, $self);
-    $vt->callback_set(ROWCHANGE   => sub { \&vt_rowchange }, $self);
-    $vt->callback_set(CLEAR       => sub { \&vt_clear     }, $self);
-    $vt->callback_set(SCROLL_DOWN => sub { \&vt_scr_dn    }, $self);
-    $vt->callback_set(SCROLL_UP   => sub { \&vt_scr_up    }, $self);
-    $vt->callback_set(GOTO        => sub { \&vt_goto      }, $self);
+    $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 ($vt, $cb_name, $cb_data, $self) = @_;
+    my ($self, $vt, $cb_name, $cb_data) = @_;
     $self->log( "OUTPUT: " . dump([@_[1..$#_]]));
 }
 
 sub vt_rowchange {
-    my ($vt, $cb_name, $arg1, $arg2, $self) = @_;
-
-    $self->log("Type of param is: " . ref($_)) for (@_);
+    my $self = shift;
+    my ($vt, $cb_name, $arg1, $arg2) = @_;
 
     $arg1 //= '?';
     $arg2 //= '?';
@@ -58,7 +57,8 @@ sub vt_rowchange {
 }
 
 sub vt_clear {
-    my ($vt, $cb_name, $arg1, $arg2, $self) = @_;
+    my $self = shift;
+    my ($vt, $cb_name, $arg1, $arg2) = @_;
     $arg1 //= '?';
     $arg2 //= '?';
 
@@ -66,7 +66,8 @@ sub vt_clear {
 }
 
 sub vt_scr_dn {
-    my ($vt, $cb_name, $arg1, $arg2, $self) = @_;
+    my $self = shift;
+    my ($vt, $cb_name, $arg1, $arg2) = @_;
     $arg1 //= '?';
     $arg2 //= '?';
 
@@ -74,7 +75,8 @@ sub vt_scr_dn {
 }
 
 sub vt_scr_up {
-    my ($vt, $cb_name, $arg1, $arg2, $self) = @_;
+    my $self = shift;
+    my ($vt, $cb_name, $arg1, $arg2) = @_;
     $arg1 //= '?';
     $arg2 //= '?';
 
@@ -83,7 +85,8 @@ sub vt_scr_up {
 
 
 sub vt_goto {
-    my ($vt, $cb_name, $arg1, $arg2, $self) = @_;
+    my $self = shift;
+    my ($vt, $cb_name, $arg1, $arg2) = @_;
     $arg1 //= '?';
     $arg2 //= '?';
 
diff --git a/testing/lib/Test/Irssi/Driver.pm b/testing/lib/Test/Irssi/Driver.pm
index 0ff90e9..9d39d44 100644
--- a/testing/lib/Test/Irssi/Driver.pm
+++ b/testing/lib/Test/Irssi/Driver.pm
@@ -22,6 +22,8 @@ has 'parent'
 sub  START {
     my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
 
+    $kernel->alias_set("IrssiTestDriver");
+
     $self->log("Start handler called");
 
     $self->save_term_settings($heap);
@@ -64,7 +66,7 @@ sub  START {
     $heap->{program} = POE::Wheel::Run->new(@program_options);
 
     $self->log("Created child run wheel");
-
+    $poe_kernel->yield('testing_ready');
 }
 
 sub STOP {
@@ -80,11 +82,11 @@ sub STOP {
 sub terminal_stdin {
     my ($self, $heap, $input) = @_[OBJECT, HEAP, ARG0];
 
-    if ($input =~ m/\003/g) {
+    if ($input =~ m/\003/g) { # C-c
         $input = "/echo I like cakes\n";
-    } elsif ($input =~ m/\005/g) {
+    } elsif ($input =~ m/\005/g) { # C-e
         $self->log( $self->vt_dump());
-    } elsif ($input =~ m/\x17/g) {
+    } elsif ($input =~ m/\x17/g) { # C-w
         $input = "/quit\n";
     }
 
@@ -106,7 +108,6 @@ sub child_stdout {
     $heap->{stdio}->put($input);
 }
 
-
 ### Handle SIGCHLD.  Shut down if the exiting child process was the
 ### one we've been managing.
 
@@ -127,11 +128,14 @@ sub setup {
        object_states =>
        [ $self =>
          {
-          _start => 'START',
-          _stop  => 'STOP',
+          _start             => 'START',
+          _stop              => 'STOP',
           got_terminal_stdin => 'terminal_stdin',
           got_child_stdout   => 'child_stdout',
           got_sigchld        => 'CHILD',
+          got_delay          => 'timer_expired',
+          create_delay       => 'timer_created',
+          testing_ready      => 'start_tests',
          }
        ]
       );
@@ -142,6 +146,20 @@ sub setup {
 
 }
 
+sub start_tests {
+    my ($self) = $_[OBJECT];
+    $self->parent->api->run_test('test1');
+}
+
+sub timer_created {
+    my ($heap, $kernel, $duration) = @_[HEAP, KERNEL, ARG0];
+    $kernel->delay(got_delay => $duration, 0);
+}
+
+sub timer_expired {
+    die "Timer Expired";
+}
+
 sub save_term_settings {
     my ($self, $heap) = @_;
     # Save the original terminal settings so they can be restored later.
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
+ => (
+    );
+}