From 754328bfe7acbc9409fd4d38340d76aabf96845c Mon Sep 17 00:00:00 2001 From: Tom Feist Date: Thu, 24 Feb 2011 01:59:38 +0000 Subject: more work on testing system for irssi. Most of the screenscraping now works, trying to finalise an API for actual testing usage. --- testing/MANIFEST | 5 +- testing/lib/Test/Irssi.pm | 141 +++++++++++++++++++++------------ testing/lib/Test/Irssi/API.pm | 80 +++++++++++++++++++ testing/lib/Test/Irssi/Callbacks.pm | 41 +++++----- testing/lib/Test/Irssi/Driver.pm | 32 ++++++-- testing/lib/Test/Irssi/VirtualIrssi.pm | 32 ++++++++ testing/test.pl | 9 +++ 7 files changed, 260 insertions(+), 80 deletions(-) create mode 100644 testing/lib/Test/Irssi/API.pm create mode 100644 testing/lib/Test/Irssi/VirtualIrssi.pm diff --git a/testing/MANIFEST b/testing/MANIFEST index 09749a9..4d67b37 100644 --- a/testing/MANIFEST +++ b/testing/MANIFEST @@ -5,8 +5,9 @@ README Changes t/001-use.t +t/002-init.t lib/Test/Irssi.pm lib/Test/Irssi/Callbacks.pm - -auto-testing.pl \ No newline at end of file +lib/Test/Irssi/Driver.pm +lib/Test/Irssi/API.pm \ No newline at end of file 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 + => ( + ); +} diff --git a/testing/test.pl b/testing/test.pl index b062160..5d2c1dd 100755 --- a/testing/test.pl +++ b/testing/test.pl @@ -8,6 +8,7 @@ use feature qw/say/; use lib 'blib/lib'; use Test::Irssi; +use Test::Irssi::API; my $test = Test::Irssi->new (irssi_binary => "/opt/stow/repo/irssi-debug/bin/irssi", @@ -15,4 +16,12 @@ my $test = Test::Irssi->new say "Created test instance"; +my $api = $test->api; + +$api->create_test('test1', 'bacon'); +$api->simulate_input("test1", "/echo This is a test\n"); +$api->simulate_delay("test1", 0.5); +$api->expect_output("test1", qr/is a test/); + +$api->run_tests; $test->run; -- cgit v1.2.3