From 2dc34ae882623c06117a5fd63bb71dfdacf9c765 Mon Sep 17 00:00:00 2001 From: Tom Feist Date: Mon, 21 Feb 2011 06:07:22 +0000 Subject: mostly working except for callback handling. Removed original auto-testing script. Started work on some more tests --- testing/lib/Test/Irssi/Callbacks.pm | 113 ++++++++++++++++++++++++++++++++++++ testing/lib/Test/Irssi/Driver.pm | 89 ++++++++++++++++++++-------- 2 files changed, 177 insertions(+), 25 deletions(-) (limited to 'testing/lib/Test/Irssi') 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) = @_; -- cgit v1.2.3