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