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

trying to finalise an API for actual testing usage.

4 files changed, 159 insertions, 26 deletions

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
+ => (
+    );
+}