mostly working except for callback handling. Removed original auto-testing

script. Started work on some more tests

2 files changed, 177 insertions, 25 deletions

diff --git a/testing/lib/Test/Irssi/Callbacks.pm b/testing/lib/Test/Irssi/Callbacks.pm
index e69de29..eb33039 100644
--- a/testing/lib/Test/Irssi/Callbacks.pm
+++ b/testing/lib/Test/Irssi/Callbacks.pm
@@ -0,0 +1,113 @@
+use strictures 1;
+
+package Test::Irssi::Callbacks;
+
+use Moose;
+use Data::Dump qw/dump/;
+
+has 'parent'
+  => (
+      is       => 'ro',
+      isa      => 'Test::Irssi',
+      required => 1,
+     );
+
+sub register_vt_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);
+}
+
+sub vt_output {
+    my ($vt, $cb_name, $cb_data, $self) = @_;
+    $self->log( "OUTPUT: " . dump([@_[1..$#_]]));
+}
+
+sub vt_rowchange {
+    my ($vt, $cb_name, $arg1, $arg2, $self) = @_;
+
+    $self->log("Type of param is: " . ref($_)) for (@_);
+
+    $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 ($vt, $cb_name, $arg1, $arg2, $self) = @_;
+    $arg1 //= '?';
+    $arg2 //= '?';
+
+    $self->log( "VT Cleared");
+}
+
+sub vt_scr_dn {
+    my ($vt, $cb_name, $arg1, $arg2, $self) = @_;
+    $arg1 //= '?';
+    $arg2 //= '?';
+
+    $self->log( "Scroll Down");
+}
+
+sub vt_scr_up {
+    my ($vt, $cb_name, $arg1, $arg2, $self) = @_;
+    $arg1 //= '?';
+    $arg2 //= '?';
+
+    $self->log( "Scroll Up");
+}
+
+
+sub vt_goto {
+    my ($vt, $cb_name, $arg1, $arg2, $self) = @_;
+    $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;
+
diff --git a/testing/lib/Test/Irssi/Driver.pm b/testing/lib/Test/Irssi/Driver.pm
index 8aa547a..0ff90e9 100644
--- a/testing/lib/Test/Irssi/Driver.pm
+++ b/testing/lib/Test/Irssi/Driver.pm
@@ -3,14 +3,18 @@ use strictures 1;
 package Test::Irssi::Driver;
 
 use Moose;
-use MooseX::POE;
+use lib $ENV{HOME} . "/projects/poe/lib";
+
+#use MooseX::POE;
 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',
+      is       => 'ro',
+      isa      => 'Test::Irssi',
       required => 1,
      );
 
@@ -18,6 +22,8 @@ has 'parent'
 sub  START {
     my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
 
+    $self->log("Start handler called");
+
     $self->save_term_settings($heap);
 
     # Set a signal handler.
@@ -32,10 +38,13 @@ sub  START {
        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;
 
@@ -49,35 +58,47 @@ sub  START {
        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");
 
+}
 
 sub STOP {
     my ($self, $heap) = @_[OBJECT,HEAP];
-    $heap->{stdin_tio}->setattr (0, TCSANOW);
-    $heap->{stdout_tio}->setattr(1, TCSANOW);
-    $heap->{stderr_tio}->setattr(2, TCSANOW);
-    $self->_logfile_fh->close();
+    $self->log("STOP called");
+    $self->restore_term_settings($heap);
+    $self->parent->_logfile_fh->close();
 }
 
 ### Handle terminal STDIN.  Send it to the background program's STDIN.
 ### If the user presses ^C, then echo a little string
 
-sub handle_terminal_stdin {
+sub terminal_stdin {
     my ($self, $heap, $input) = @_[OBJECT, HEAP, ARG0];
+
     if ($input =~ m/\003/g) {
         $input = "/echo I like cakes\n";
-    } elsif ($input =~ m/\004/g) {
-        $self->log( vt_dump());
+    } elsif ($input =~ m/\005/g) {
+        $self->log( $self->vt_dump());
+    } elsif ($input =~ m/\x17/g) {
+        $input = "/quit\n";
     }
+
     $heap->{program}->put($input);
 }
-##
+
+# delegate to Callbacks.
+sub vt_dump {
+    my ($self) = @_;
+    my $cb = $self->parent->_callbacks->vt_dump();
+}
+
 ### Handle STDOUT from the child program.
-sub handle_child_stdout {
+sub child_stdout {
     my ($self, $heap, $input) = @_[OBJECT, HEAP, ARG0];
     # process via vt
     $self->parent->vt->process($input);
@@ -85,10 +106,11 @@ sub handle_child_stdout {
     $heap->{stdio}->put($input);
 }
 
+
 ### Handle SIGCHLD.  Shut down if the exiting child process was the
 ### one we've been managing.
 
-sub  CHILD {
+sub CHILD {
     my ($self, $heap, $child_pid) = @_[OBJECT, HEAP, ARG1];
     if ($child_pid == $heap->{program}->PID) {
         delete $heap->{program};
@@ -97,17 +119,27 @@ sub  CHILD {
     return 0;
 }
 
-sub bacon { 
-    POE::Session->create
-        (
-         inline_states => {
-                           _start             => \&handle_start,
-                           _stop              => \&handle_stop,
-                           got_terminal_stdin => \&handle_terminal_stdin,
-                           got_child_stdout   => \&handle_child_stdout,
-                           got_sigchld        => \&handle_sigchld,
-                          },
-        );
+sub setup {
+    my $self = shift;
+
+    my @states =
+      (
+       object_states =>
+       [ $self =>
+         {
+          _start => 'START',
+          _stop  => 'STOP',
+          got_terminal_stdin => 'terminal_stdin',
+          got_child_stdout   => 'child_stdout',
+          got_sigchld        => 'CHILD',
+         }
+       ]
+      );
+    $self->log("creating root session");
+
+    POE::Session->create(@states);
+    $self->log("session created");
+
 }
 
 sub save_term_settings {
@@ -121,6 +153,13 @@ sub save_term_settings {
     $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) = @_;