diff options
Diffstat (limited to 'testing')
| -rw-r--r-- | testing/MANIFEST | 6 | ||||
| -rw-r--r-- | testing/MANIFEST.SKIP | 9 | ||||
| -rwxr-xr-x | testing/auto-testing.pl | 130 | ||||
| -rw-r--r-- | testing/lib/Test/Irssi.pm | 73 | ||||
| -rw-r--r-- | testing/lib/Test/Irssi/Callbacks.pm | 0 | ||||
| -rw-r--r-- | testing/lib/Test/Irssi/Driver.pm | 153 | 
6 files changed, 231 insertions, 140 deletions
| diff --git a/testing/MANIFEST b/testing/MANIFEST index 8548d92..09749a9 100644 --- a/testing/MANIFEST +++ b/testing/MANIFEST @@ -1,8 +1,12 @@  Makefile.PL  MANIFEST +MANIFEST.SKIP  README  Changes -t/001-use.t +t/001-use.t  lib/Test/Irssi.pm +lib/Test/Irssi/Callbacks.pm + +auto-testing.pl 
\ No newline at end of file diff --git a/testing/MANIFEST.SKIP b/testing/MANIFEST.SKIP new file mode 100644 index 0000000..1bfcbf3 --- /dev/null +++ b/testing/MANIFEST.SKIP @@ -0,0 +1,9 @@ +.*\.git.* +pm_to_blib +.*\.old +.*\.bak +.*\.swp +blib/.* +^Makefile$ +\d+_local_ + diff --git a/testing/auto-testing.pl b/testing/auto-testing.pl index 9f47b6c..69a855e 100755 --- a/testing/auto-testing.pl +++ b/testing/auto-testing.pl @@ -2,9 +2,6 @@  #package Test::Irssi; -# requires the latest pre-release POE from -# https://github.com/rcaputo/poe until a new release is...released. -  use warnings;  use strict; @@ -17,10 +14,6 @@ sub IRSSI_HOME () { $ENV{HOME} . "/projects/tmp/test/irssi-debug" }  sub ROWS () { 24 }  sub COLS () { 80 } -use POSIX; - -use POE qw( Wheel::ReadWrite Wheel::Run Filter::Stream ); -  use Term::VT102;  use Term::TermInfo;  use feature qw/say switch/; @@ -89,137 +82,14 @@ sub vt_dump {      return $str;  } -### Handle the _start event.  This sets things in motion. -sub handle_start { -  my ($kernel, $heap) = @_[KERNEL, HEAP]; - -  save_term_settings($heap); - -  # Set a signal handler. -  $kernel->sig(CHLD => "got_sigchld"); - -  make_raw(); - -  # Start the terminal reader/writer. -  $heap->{stdio} = POE::Wheel::ReadWrite->new( -    InputHandle  => \*STDIN, -    OutputHandle => \*STDOUT, -    InputEvent   => "got_terminal_stdin", -    Filter       => POE::Filter::Stream->new(), -  ); - -  # Start the asynchronous child process. -  $heap->{program} = POE::Wheel::Run->new( -    Program     => PROGRAM, -    ProgramArgs => ['--noconnect', '--home=' . IRSSI_HOME ], -    Conduit     => "pty", -    Winsize     => [ROWS, COLS, 0, 0], -    StdoutEvent => "got_child_stdout", -    StdioFilter => POE::Filter::Stream->new(), -  ); -} - -### Handle the _stop event.  This restores the original terminal -### settings when we're done.  That's very important. -sub handle_stop { -  my $heap = $_[HEAP]; -  $heap->{stdin_tio}->setattr (0, TCSANOW); -  $heap->{stdout_tio}->setattr(1, TCSANOW); -  $heap->{stderr_tio}->setattr(2, TCSANOW); -  $logfh->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 { -  my ($heap, $input) = @_[HEAP, ARG0]; -  if ($input =~ m/\003/g) { -      $input = "/echo I like cakes\n"; -  } elsif ($input =~ m/\004/g) { -      say $logfh vt_dump(); -  } -  $heap->{program}->put($input); -} -## -### Handle STDOUT from the child program. -sub handle_child_stdout { -  my ($heap, $input) = @_[HEAP, ARG0]; -  # process via vt -  $vt->process($input); -  # send to terminal -  $heap->{stdio}->put($input); -} -### Handle SIGCHLD.  Shut down if the exiting child process was the -### one we've been managing. -sub handle_sigchld { -  my ($heap, $child_pid) = @_[HEAP, ARG1]; -  if ($child_pid == $heap->{program}->PID) { -    delete $heap->{program}; -    delete $heap->{stdio}; -  } -  return 0; -} - - -### Start a session to encapsulate the previous features. -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 make_raw { - -  # 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 save_term_settings { -    my ($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 vt_configure_callbacks {      my ($vt) = @_; -    $vt->callback_set(OUTPUT      => \&vt_output,    undef); -    $vt->callback_set(ROWCHANGE   => \&vt_rowchange, undef); -    $vt->callback_set(CLEAR       => \&vt_clear,     undef); -    $vt->callback_set(SCROLL_DOWN => \&vt_scr_dn,    undef); -    $vt->callback_set(SCROLL_UP   => \&vt_scr_up,    undef); -    $vt->callback_set(GOTO        => \&vt_goto,      undef); -    # options -    $vt->option_set(LINEWRAP => 1); -    $vt->option_set(LFTOCRLF => 1);  }  ### Start POE's main loop, which runs the session until it's done. -$poe_kernel->run();  exit 0; diff --git a/testing/lib/Test/Irssi.pm b/testing/lib/Test/Irssi.pm index cb350ee..f4acb71 100644 --- a/testing/lib/Test/Irssi.pm +++ b/testing/lib/Test/Irssi.pm @@ -1,5 +1,5 @@  use strictures 1; -use MooseX::Declare +use MooseX::Declare;  our $VERSION = 0.01; @@ -10,6 +10,12 @@ class Test::Irssi {      use feature qw/say switch/;      use Data::Dump;      use IO::File; +    use Test::Irssi::Driver; + +    # requires the latest pre-release POE from +    # https://github.com/rcaputo/poe until a new release is...released. +    use POE; +      has 'irssi_binary'        => ( @@ -41,6 +47,15 @@ class Test::Irssi {            default => 24,           ); +    has 'vt' +      => ( +          is => 'ro', +          isa => 'Term::VT102', +          required => 1, +          lazy => 1, +          builder => '_build_vt102', +         ); +      has 'logfile'        => (            is => 'ro', @@ -58,9 +73,46 @@ class Test::Irssi {            builder => '_build_logfile_fh',           ); +    has '_driver' +      => ( +          is => 'ro', +          isa => 'Test::Irssi::Driver', +          required => 1, +          lazy => 1, +          builder => '_build_driver', +         ); + +    method _build_driver { +        my $drv = Test::Irssi::Driver->new(parent => $self); +        return $drv; +    } + +    method _build_vt102 { +        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); + +        # callbacks +        $vt->callback_set(OUTPUT      => \&vt_output,    undef); +        $vt->callback_set(ROWCHANGE   => \&vt_rowchange, undef); +        $vt->callback_set(CLEAR       => \&vt_clear,     undef); +        $vt->callback_set(SCROLL_DOWN => \&vt_scr_dn,    undef); +        $vt->callback_set(SCROLL_UP   => \&vt_scr_up,    undef); +        $vt->callback_set(GOTO        => \&vt_goto,      undef); + +        return $vt; +    }      method _build_logfile_fh { -        my $fh = IO::File->new($self->logfile, 'w'); + +        my $logfile = $self->logfile; + +        my $fh = IO::File->new($logfile, 'w');          die "Couldn't open $logfile for writing: $!" unless defined $fh;          $fh->autoflush(1); @@ -68,22 +120,25 @@ class Test::Irssi {      } +    method log (Str $msg) { +        $self->_logfile_fh->say($msg); +    } +    method run { -    method log (Str $msg) { -        say $self->_logfile_fh $msg; +        ### Start a session to encapsulate the previous features. +        $poe_kernel->run();      }  } -__END__ -=head1 NAME -Test::Irssi -=head1 ABSTRACT +__END__ + +=head1 NAME -Abstract goes here +Test::Irssi - A cunning testing system for Irssi scripts  =head1 SYNOPSIS diff --git a/testing/lib/Test/Irssi/Callbacks.pm b/testing/lib/Test/Irssi/Callbacks.pm new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/testing/lib/Test/Irssi/Callbacks.pm diff --git a/testing/lib/Test/Irssi/Driver.pm b/testing/lib/Test/Irssi/Driver.pm new file mode 100644 index 0000000..8aa547a --- /dev/null +++ b/testing/lib/Test/Irssi/Driver.pm @@ -0,0 +1,153 @@ +use strictures 1; + +package Test::Irssi::Driver; + +use Moose; +use MooseX::POE; +use POE qw( Wheel::ReadWrite Wheel::Run Filter::Stream ); +use POSIX; + +has 'parent' +  => ( +      is => 'ro', +      isa => 'Test::Irssi', +      required => 1, +     ); + + +sub  START { +    my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP]; + +    $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(), +      ); + +    # Start the terminal reader/writer. +    $heap->{stdio} = POE::Wheel::ReadWrite->new(@stdio_options); + +    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(), +      ); + +    # Start the asynchronous child process. +    $heap->{program} = POE::Wheel::Run->new(@program_options); +} + + + +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(); +} + +### 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 { +    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()); +    } +    $heap->{program}->put($input); +} +## +### Handle STDOUT from the child program. +sub handle_child_stdout { +    my ($self, $heap, $input) = @_[OBJECT, HEAP, ARG0]; +    # process via vt +    $self->parent->vt->process($input); +    # send to terminal +    $heap->{stdio}->put($input); +} + +### Handle SIGCHLD.  Shut down if the exiting child process was the +### one we've been managing. + +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 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 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 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; + | 
