aboutsummaryrefslogtreecommitdiffstats
path: root/testing/lib/Test/Irssi
diff options
context:
space:
mode:
authorTom Feist <shabble@metavore.org>2011-02-24 01:59:38 +0000
committerTom Feist <shabble@metavore.org>2011-02-24 01:59:38 +0000
commit754328bfe7acbc9409fd4d38340d76aabf96845c (patch)
tree8f8ec9ab17dce112c9b3e4f0c8a24ba45ffc2d2c /testing/lib/Test/Irssi
parentadded test and launcher script (diff)
downloadirssi-scripts-754328bfe7acbc9409fd4d38340d76aabf96845c.tar.gz
irssi-scripts-754328bfe7acbc9409fd4d38340d76aabf96845c.zip
more work on testing system for irssi. Most of the screenscraping now works,
trying to finalise an API for actual testing usage.
Diffstat (limited to '')
-rw-r--r--testing/lib/Test/Irssi.pm141
-rw-r--r--testing/lib/Test/Irssi/API.pm80
-rw-r--r--testing/lib/Test/Irssi/Callbacks.pm41
-rw-r--r--testing/lib/Test/Irssi/Driver.pm32
-rw-r--r--testing/lib/Test/Irssi/VirtualIrssi.pm32
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
+ => (
+ );
+}