aboutsummaryrefslogtreecommitdiffstats
path: root/testing/lib/Test
diff options
context:
space:
mode:
Diffstat (limited to 'testing/lib/Test')
-rw-r--r--testing/lib/Test/Irssi.pm314
-rw-r--r--testing/lib/Test/Irssi/Callbacks.pm123
-rw-r--r--testing/lib/Test/Irssi/Driver.pm258
-rw-r--r--testing/lib/Test/Irssi/Misc.pm35
-rw-r--r--testing/lib/Test/Irssi/Test.pm308
-rw-r--r--testing/lib/Test/Irssi/VirtualIrssi.pm32
6 files changed, 1070 insertions, 0 deletions
diff --git a/testing/lib/Test/Irssi.pm b/testing/lib/Test/Irssi.pm
new file mode 100644
index 0000000..0db7ee0
--- /dev/null
+++ b/testing/lib/Test/Irssi.pm
@@ -0,0 +1,314 @@
+use strictures 1;
+use MooseX::Declare;
+
+our $VERSION = 0.02;
+
+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::Test;
+
+ has 'generate_tap'
+ => (
+ is => 'rw',
+ isa => 'Bool',
+ required => 1,
+ default => 1,
+ );
+
+ has 'irssi_binary'
+ => (
+ is => 'ro',
+ isa => 'Str',
+ required => 1,
+ );
+
+ has 'irssi_homedir'
+ => (
+ is => 'ro',
+ isa => 'Str',
+ required => 1,
+ );
+
+ has 'terminal_width'
+ => (
+ is => 'ro',
+ isa => 'Int',
+ required => 1,
+ default => 80,
+ );
+
+ has 'terminal_height'
+ => (
+ is => 'ro',
+ isa => 'Int',
+ required => 1,
+ default => 24,
+ );
+
+ has 'vt'
+ => (
+ is => 'ro',
+ isa => 'Term::VT102',
+ required => 1,
+ lazy => 1,
+ builder => '_build_vt_obj',
+ );
+
+ has 'logfile'
+ => (
+ is => 'ro',
+ isa => 'Str',
+ required => 1,
+ default => 'irssi-test.log',
+ );
+
+ has '_logfile_fh'
+ => (
+ is => 'ro',
+ isa => 'IO::File',
+ required => 1,
+ lazy => 1,
+ builder => '_build_logfile_fh',
+ );
+
+ has 'driver'
+ => (
+ is => 'ro',
+ isa => 'Test::Irssi::Driver',
+ required => 1,
+ lazy => 1,
+ builder => '_build_driver_obj',
+ handles => {
+ run_headless => 'headless',
+ }
+ );
+
+ has '_callbacks'
+ => (
+ is => 'ro',
+ isa => 'Test::Irssi::Callbacks',
+ required => 1,
+ lazy => 1,
+ builder => '_build_callback_obj',
+ );
+
+ has 'pending_tests'
+ => (
+ is => 'ro',
+ isa => "ArrayRef",
+ required => 1,
+ default => sub { [] },
+ traits => [qw/Array/],
+ handles => {
+ add_pending_test => 'push',
+ next_pending_test => 'shift',
+ tests_remaining => 'count',
+ }
+ );
+
+ has 'completed_tests'
+ => (
+ is => 'ro',
+ isa => "ArrayRef",
+ required => 1,
+ default => sub { [] },
+ traits => [qw/Array/],
+ handles => {
+ add_completed_test => 'push',
+ tests_completed => 'count',
+ },
+ );
+
+ has 'active_test'
+ => (
+ is => 'rw',
+ isa => 'Test::Irssi::Test',
+ );
+
+ sub new_test {
+ my ($self, $name, @params) = @_;
+ my $new = Test::Irssi::Test->new(name => $name,
+ parent => $self,
+ @params);
+ $self->add_pending_test($new);
+ return $new;
+ }
+
+ method _build_callback_obj {
+ Test::Irssi::Callbacks->new(parent => $self);
+ }
+
+ method _build_driver_obj {
+ Test::Irssi::Driver->new(parent => $self);
+ }
+
+ method _build_vt_obj {
+ my $rows = $self->terminal_height;
+ my $cols = $self->terminal_width;
+
+ Term::VT102->new($cols, $rows);
+ }
+
+ method _build_logfile_fh {
+
+ my $logfile = $self->logfile;
+
+ my $fh = IO::File->new($logfile, 'w');
+ die "Couldn't open $logfile for writing: $!" unless defined $fh;
+ $fh->autoflush(1);
+
+ 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 screenshot {
+ my $data = '';
+ my $vt = $self->vt;
+ foreach my $row (1 .. $vt->rows) {
+ $data .= $vt->row_plaintext($row) . "\n";
+ }
+ return $data;
+ }
+
+ method complete_test {
+ # put the completed one onto the completed pile
+ my $old_test = $self->active_test;
+ $self->add_completed_test($old_test);
+
+ # TAP: print status.
+ if ($self->generate_tap) {
+ my $pass = $old_test->passed;
+ my $tap = sprintf("%s %d - %s", $pass?'ok':'not ok',
+ $self->tests_completed,
+ $old_test->description);
+ say STDOUT $tap;
+ if (not $pass) {
+ $old_test->details;
+ $self->log("-------------------");
+ $self->log($self->screenshot);
+ $self->log("-------------------");
+
+ }
+ }
+ }
+
+ method run_test {
+ # and make the next pending one active.
+ my $test = $self->next_pending_test;
+ $self->active_test($test);
+
+ # signal to the driver to start executing it.
+ $poe_kernel->post(IrssiTestDriver => execute_test => $test);
+ }
+
+ method run {
+
+ $self->driver->setup;
+ $self->_vt_setup;
+ $self->log("Driver setup complete");
+ ### Start a session to encapsulate the previous features.
+
+ # TAP: print number of tests.
+ if ($self->generate_tap) {
+ print STDOUT "1.." . $self->tests_remaining . "\n";
+ }
+
+ $poe_kernel->run();
+ }
+
+ sub apply_delay {
+ my ($self, $delay, $next_index) = @_;
+ $poe_kernel->post(IrssiTestDriver
+ => create_delay
+ => $delay, $next_index);
+ }
+
+ # TODO: pick one.
+ 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_topic_line {
+ return $self->vt->row_plaintext(1);
+ }
+
+ 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);
+ }
+
+ method get_window_contents {
+ my $buf = '';
+ for (2..$self->terminal_height() - 2) {
+ $buf .= $self->vt->row_plaintext($_);
+ }
+ return $buf;
+ }
+
+ method get_cursor_position {
+ return ($self->vt->x(), $self->vt->y());
+ }
+
+ method load_script {
+ my ($script_name) = @_;
+
+ }
+
+ method summarise_test_results {
+ foreach my $test (@{$self->completed_tests}) {
+ my $name = $test->name;
+ printf("Test %s\t\t-\t%s\n", $name, $test->passed?"pass":"fail");
+ $test->details();
+ }
+ }
+
+ sub log {
+ my ($self, $msg) = @_;
+ $self->_logfile_fh->say($msg);
+ }
+
+}
+
+ __END__
+
+=head1 NAME
+
+Test::Irssi - A cunning testing system for Irssi scripts
+
+=head1 SYNOPSIS
+
+blah blah blah
diff --git a/testing/lib/Test/Irssi/Callbacks.pm b/testing/lib/Test/Irssi/Callbacks.pm
new file mode 100644
index 0000000..8321ace
--- /dev/null
+++ b/testing/lib/Test/Irssi/Callbacks.pm
@@ -0,0 +1,123 @@
+use strictures 1;
+
+package Test::Irssi::Callbacks;
+
+use Moose;
+use Data::Dump qw/dump/;
+use Data::Dumper;
+
+has 'parent'
+ => (
+ is => 'ro',
+ isa => 'Test::Irssi',
+ required => 1,
+ );
+
+sub register_callbacks {
+ my ($self) = @_;
+
+ my $vt = $self->parent->vt;
+ $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 ($self, $vt, $cb_name, $cb_data) = @_;
+ $self->log( "OUTPUT: " . dump([@_[1..$#_]]));
+}
+
+sub vt_rowchange {
+ my $self = shift;
+ my ($vt, $cb_name, $arg1, $arg2) = @_;
+
+ $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 $self = shift;
+ my ($vt, $cb_name, $arg1, $arg2) = @_;
+ $arg1 //= '?';
+ $arg2 //= '?';
+
+ $self->log( "VT Cleared");
+}
+
+sub vt_scr_dn {
+ my $self = shift;
+ my ($vt, $cb_name, $arg1, $arg2) = @_;
+ $arg1 //= '?';
+ $arg2 //= '?';
+
+ $self->log( "Scroll Down");
+}
+
+sub vt_scr_up {
+ my $self = shift;
+ my ($vt, $cb_name, $arg1, $arg2) = @_;
+ $arg1 //= '?';
+ $arg2 //= '?';
+
+ $self->log( "Scroll Up");
+}
+
+
+sub vt_goto {
+ my $self = shift;
+ my ($vt, $cb_name, $arg1, $arg2) = @_;
+ $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;
+
+
+
+# # delegate to Callbacks.
+# sub vt_dump {
+# my ($self) = @_;
+# my $cb = $self->parent->_callbacks->vt_dump();
+# }
diff --git a/testing/lib/Test/Irssi/Driver.pm b/testing/lib/Test/Irssi/Driver.pm
new file mode 100644
index 0000000..6b4e5e5
--- /dev/null
+++ b/testing/lib/Test/Irssi/Driver.pm
@@ -0,0 +1,258 @@
+use strictures 1;
+
+package Test::Irssi::Driver;
+
+use Moose;
+use lib $ENV{HOME} . "/projects/poe/lib";
+
+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',
+ required => 1,
+ );
+
+has 'headless'
+ => (
+ is => 'rw',
+ isa => 'Bool',
+ default => 0,
+ );
+
+sub START {
+ my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
+
+ $kernel->alias_set("IrssiTestDriver");
+
+ $self->log("Start handler called");
+
+ $self->save_term_settings($heap);
+
+ # Set a signal handler.
+ $kernel->sig(CHLD => "got_sigchld");
+
+ $self->make_raw_terminal;
+
+ my @stdio_options =
+ (
+ InputHandle => \*STDIN,
+ OutputHandle => \*STDOUT,
+ 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;
+
+ my @program_options =
+ (
+ Program => $self->parent->irssi_binary,
+ ProgramArgs => ['--noconnect', '--home=' . $self->parent->irssi_homedir ],
+ Conduit => "pty",
+ Winsize => [$rows, $cols, 0, 0],
+ StdoutEvent => "got_child_stdout",
+ 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");
+ $poe_kernel->yield('testing_ready');
+}
+
+sub STOP {
+ my ($self, $heap) = @_[OBJECT,HEAP];
+ $self->log("STOP called");
+ $self->restore_term_settings($heap);
+ $self->parent->_logfile_fh->close();
+
+ if (not $self->parent->generate_tap) {
+ $self->parent->summarise_test_results();
+ }
+}
+
+### Handle terminal STDIN. Send it to the background program's STDIN.
+### If the user presses ^C, then echo a little string
+
+sub terminal_stdin {
+ my ($self, $heap, $input) = @_[OBJECT, HEAP, ARG0];
+
+ if ($input =~ m/\003/g) { # C-c
+ $input = "/echo I like cakes\n";
+ } elsif ($input =~ m/\x17/g) { # C-w
+ $input = "/quit\n";
+ }
+
+ $heap->{program}->put($input);
+}
+
+### Handle STDOUT from the child program.
+sub child_stdout {
+ my ($self, $heap, $input) = @_[OBJECT, HEAP, ARG0];
+ # process via vt
+ $self->parent->vt->process($input);
+
+ if (not $self->headless) {
+ # send to terminal
+ $heap->{stdio}->put($input);
+ }
+}
+
+### Handle SIGCHLD. Shut down if the exiting child process was the
+### one we've been managing.
+
+sub shutdown {
+ my ($self, $heap, $kernel) = @_[OBJECT, HEAP, KERNEL];
+ $self->log("Shutdown called");
+ $heap->{program}->kill(15);
+ $kernel->alias_remove("IrssiTestDriver");
+}
+
+sub CHILD {
+ my ($self, $heap, $child_pid) = @_[OBJECT, HEAP, ARG1];
+ if ($child_pid == $heap->{program}->PID) {
+ delete $heap->{program};
+ delete $heap->{stdio};
+ }
+ return 0;
+}
+
+sub setup {
+ my $self = shift;
+
+ my @states =
+ (
+ object_states =>
+ [ $self =>
+ {
+ _start => 'START',
+ _stop => 'STOP',
+ got_sigchld => 'CHILD',
+
+ got_terminal_stdin => 'terminal_stdin',
+ got_child_stdout => 'child_stdout',
+
+ got_delay => 'timer_expired',
+ create_delay => 'timer_created',
+
+
+ testing_ready => 'testing_ready',
+ test_complete => 'test_complete',
+ execute_test => 'execute_test',
+
+ shutdown => 'shutdown',
+ }
+ ]
+ );
+ $self->log("creating root session");
+
+ POE::Session->create(@states);
+ $self->log("session created");
+
+}
+
+sub testing_ready {
+ my ($self) = $_[OBJECT];
+ # begin by fetching a test from the pending queue.
+ $self->log("Starting to run tests");
+ $self->log("-" x 80);
+ $self->parent->run_test;
+}
+
+sub execute_test {
+ my ($self, $heap, $kernel, $test) = @_[OBJECT,HEAP, KERNEL, ARG0];
+ # do some stuff here to evaluate it.
+
+ $test->evaluate_test;
+
+}
+
+sub test_complete {
+ my ($self, $kernel) = @_[OBJECT, KERNEL];
+
+ $self->parent->complete_test;
+
+ if ($self->parent->tests_remaining) {
+ $self->parent->run_test;
+ }
+
+ # otherwise, we're done, and can shutdown.
+ #kernel->yield('shutdown');
+
+}
+
+sub timer_created {
+ my ($self, $heap, $kernel, $duration) = @_[OBJECT, HEAP, KERNEL, ARG0];
+ $kernel->delay(got_delay => $duration);
+ $self->log("Timer created for $duration");
+}
+
+sub timer_expired {
+ my ($self, $data) = @_[OBJECT,ARG0];
+ $self->log("Timeout invoking test again.");
+ $self->parent->active_test->resume_from_timer;
+}
+
+sub save_term_settings {
+ my ($self, $heap) = @_;
+ # Save the original terminal settings so they can be restored later.
+ $heap->{stdin_tio} = POSIX::Termios->new();
+ $heap->{stdin_tio}->getattr(0);
+ $heap->{stdout_tio} = POSIX::Termios->new();
+ $heap->{stdout_tio}->getattr(1);
+ $heap->{stderr_tio} = POSIX::Termios->new();
+ $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) = @_;
+ # Put the terminal into raw input mode. Otherwise discrete
+ # keystrokes will not be read immediately.
+ my $tio = POSIX::Termios->new();
+ $tio->getattr(0);
+ my $lflag = $tio->getlflag;
+ $lflag &= ~(ECHO | ECHOE | ECHOK | ECHONL | ICANON | IEXTEN | ISIG);
+ $tio->setlflag($lflag);
+ my $iflag = $tio->getiflag;
+ $iflag &= ~(BRKINT | INPCK | ISTRIP | IXON);
+ $tio->setiflag($iflag);
+ my $cflag = $tio->getcflag;
+ $cflag &= ~(CSIZE | PARENB);
+ $tio->setcflag($cflag);
+ $tio->setattr(0, TCSANOW);
+}
+
+sub log {
+ my ($self, $msg) = @_;
+ my $fh = $self->parent->_logfile_fh;
+ $fh->say($msg);
+}
+
+
+__PACKAGE__->meta->make_immutable;
+
+no Moose;
+
diff --git a/testing/lib/Test/Irssi/Misc.pm b/testing/lib/Test/Irssi/Misc.pm
new file mode 100644
index 0000000..a6339e0
--- /dev/null
+++ b/testing/lib/Test/Irssi/Misc.pm
@@ -0,0 +1,35 @@
+package Test::Irssi::Misc;
+use strictures 1;
+
+
+
+sub keycombo_to_code {
+ my ($key_combo) = @_;
+ my $output = '';
+ my $ctrl = 0;
+ my $meta = 0;
+ if ($key_combo =~ m/[cC](?:trl)?-(.+)/) {
+ $ctrl = 1;
+ _parse_rest($1);
+ }
+ if ($key_combo =~ m/[Mm](?:eta)?-(.+)/) {
+ $meta = 1;
+ _parse_rest($1);
+ }
+}
+
+sub _parse_key {
+ my ($rest) = @_;
+ my $special = {
+ left => '',
+ right => '',
+ up => '',
+ down => '',
+ tab => '',
+ space => '',
+ spc => '',
+ };
+}
+
+
+1;
diff --git a/testing/lib/Test/Irssi/Test.pm b/testing/lib/Test/Irssi/Test.pm
new file mode 100644
index 0000000..cd0a6f9
--- /dev/null
+++ b/testing/lib/Test/Irssi/Test.pm
@@ -0,0 +1,308 @@
+use strictures 1;
+use MooseX::Declare;
+
+class Test::Irssi::Test {
+
+ use POE;
+ use Test::Irssi;
+ use Test::Irssi::Driver;
+ use feature qw/say/;
+ use Data::Dump qw/dump/;
+
+ has 'parent'
+ => (
+ is => 'ro',
+ isa => 'Test::Irssi',
+ required => 1,
+ );
+
+ has 'name'
+ => (
+ is => 'ro',
+ isa => 'Str',
+ required => 1,
+ );
+
+ has 'description'
+ => (
+ is => 'rw',
+ isa => 'Str',
+ default => '',
+ );
+
+ has 'states'
+ => (
+ is => 'ro',
+ isa => 'ArrayRef',
+ traits => [qw/Array/],
+ default => sub { [] },
+ lazy => 1,
+ handles => {
+ add_state => 'push',
+ state_count => 'count',
+ get_state => 'get',
+ },
+ );
+
+ has 'results'
+ => (
+ is => 'ro',
+ isa => 'ArrayRef',
+ default => sub { [] },
+ );
+
+ has 'complete'
+ => (
+ is => 'rw',
+ isa => 'Bool',
+ default => 0,
+ );
+
+
+ has '_next_state'
+ => (
+ is => 'rw',
+ isa => 'Int',
+ default => 0,
+ traits => [qw/Counter/],
+ handles => {
+ _increment_state_counter => 'inc',
+ _clear_state => 'reset',
+ },
+ );
+
+ # TODO: should only be valid when complete is set.
+ sub passed {
+ my $self = shift;
+ my $pass = 0;
+ foreach my $result (@{$self->results}) {
+ $pass = $result;
+ }
+ return $pass and $self->complete;
+ }
+
+ sub failed {
+ my $self = shift;
+ return not $self->passed;
+ }
+
+
+ sub details {
+ my ($self) = shift;
+ my $state_count = $self->state_count;
+ for (0..$state_count-1) {
+ my $state = $self->states->[$_];
+ my $result = $self->results->[$_];
+ say( "#\t" . $state->{type} . " - " . $state->{desc} . " "
+ . " = " .( $result?"ok":"not ok"));
+ }
+ }
+ ############# API FUNCTIONS ##########################################
+
+
+ method add_input_sequence(Str $input) {
+ $self->add_state({type => 'command',
+ of => 'input',
+ input => $input,
+ desc => 'input'});
+
+ $self->log("Adding $input as input");
+ }
+
+ method add_delay (Num $delay) {
+ $self->add_state({type => 'command',
+ of => 'delay',
+ desc => 'delay',
+ delay => $delay });
+ $self->log("Adding $delay as delay");
+
+ }
+
+ method add_keycode(Str $code) {
+ my $input = $self->translate_keycode($code);
+ $self->add_state({type => 'command',
+ desc => 'input',
+ input => $input });
+ $self->log("Adding $input ($code) as input");
+
+ }
+ sub add_diag {
+ my ($self, $diag) = @_;
+ $self->add_state({type => 'command',
+ of => 'diag',
+ desc => $diag });
+ }
+
+ sub add_pattern_match {
+ my ($self, $pattern, $constraints, $desc) = @_;
+ $self->add_state({type => 'test',
+ of => 'pattern',
+ pattern => $pattern,
+ constraints => $constraints,
+ desc => $desc});
+
+ $self->log("Adding $pattern as output match ");
+ }
+
+ sub test_cursor_position {
+ my ($self, $x, $y, $desc) = @_;
+ $self->add_state({type => 'test',
+ of => 'cursor',
+ x => $x,
+ y => $y,
+ desc => $desc });
+ $self->log("Adding cursor [$x, $y] test ");
+
+ }
+
+ sub add_evaluation_function {
+ my ($self, $coderef, $desc) = @_;
+ $self->add_state({type => 'test',
+ of => 'function',
+ code => $coderef,
+ desc => $desc});
+ }
+
+
+ ############# END OF API FUNCTIONS ####################################
+
+
+
+ method translate_keycode(Str $code) {
+ my $seq = '';
+ if ($code =~ m/M-([a-z])/i) {
+ $seq = "\x1b" . $1;
+ } elsif ($code =~ m/C-([a-z])/i) {
+ $seq = chr ( ord(lc $1) - 64 );
+ }
+ return $seq;
+ }
+
+ method this_state {
+ return $self->_next_state - 1;
+ }
+
+ sub check_output {
+ my ($self, $data) = @_;
+
+ my ($pattern, $constraints) = ($data->{pattern}, $data->{constraints});
+
+ my $ok = 0;
+ my $line = '';
+ if ($constraints eq 'prompt') {
+ $line = $self->parent->get_prompt_line;
+ } elsif ($constraints eq 'window_sbar') {
+ $line = $self->parent->get_window_statusbar_line;
+ } elsif ($constraints eq 'window') {
+ # NOTE: not actually a line.
+ $line = $self->parent->get_window_contents;
+ } elsif ($constraints eq 'topic') {
+ $line = $self->parent->get_topic_line;
+ }
+
+ $self->log("Testing pattern against: '$line'");
+
+ if ($line =~ m/$pattern/) {
+ $self->log("Pattern $pattern passed");
+ $self->results->[$self->this_state] = 1;
+ } else {
+ $self->log("Pattern $pattern failed");
+ $self->results->[$self->this_state] = 0;;
+ }
+ }
+
+ sub get_next_state {
+ my ($self) = @_;
+ my $item = $self->get_state($self->_next_state);
+ $self->_increment_state_counter;
+
+ return $item;
+ }
+
+ sub evaluate_test {
+ my ($self) = @_;
+
+ while (my $state = $self->get_next_state) {
+
+ $self->log("Evaluating Test: " . dump($state));
+
+ my $type = $state->{type};
+
+ if ($type eq 'command') {
+ my $subtype = $state->{of};
+
+ if ($subtype eq 'diag') {
+ if ($self->parent->generate_tap) {
+ say STDOUT '#' . $state->{desc};
+ }
+ }
+ if ($subtype eq 'input') {
+ $self->parent->inject_text($state->{input});
+ $self->log("input: ". $state->{input});
+ }
+ if ($subtype eq 'delay') {
+ $self->log("inserting delay");
+ $self->parent->apply_delay($state->{delay});
+ $self->results->[$self->this_state] = 1;
+ return;
+ }
+
+ # all commands are considered to succeed.
+ $self->results->[$self->this_state] = 1;
+
+ } elsif ($type eq 'test') {
+
+ my $test_type = $state->{of};
+
+ if ($test_type eq 'pattern') {
+ my $pattern = $state->{pattern};
+ $self->check_output($state);
+ }
+ if ($test_type eq 'cursor') {
+ my ($curs_x, $curs_y) = $self->parent->get_cursor_position;
+
+ my $ret = 0;
+ if ($state->{x} == $curs_x and $state->{y} == $curs_y) {
+ $ret = 1;
+ }
+
+ $self->results->[$self->this_state] = $ret;
+
+ }
+
+ if ($test_type eq 'function') {
+ # code evaluation
+ my @args = ($self, $self->parent, $self->parent->vt);
+ my $ret = $state->{code}->(@args);
+ $ret //= 0; # ensure that undef failures are
+ # marked as such.
+ $self->results->[$self->this_state] = $ret;
+ }
+ } else {
+ # wtf?
+ }
+ }
+
+ $poe_kernel->post(IrssiTestDriver => 'test_complete');
+
+ $self->complete(1);
+
+ $self->log("Test Execution Finished");
+ }
+
+ sub resume_from_timer {
+ my ($self) = @_;
+ $self->log("Resuming after timeout");
+ $self->evaluate_test;
+ }
+ sub log {
+ my ($self, $msg) = @_;
+ $self->parent->_logfile_fh->say($msg);
+ }
+
+ sub _all { $_ || return 0 for @_; 1 }
+}
+
+
+
+ __END__
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
+ => (
+ );
+}
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 16:30:44 +0000