use strictures 1; package Test::Irssi::Driver; use Moose; use lib $ENV{HOME} . "/projects/poe/lib"; #use MooseX::POE; 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, ); 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(); } ### 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/\005/g) { # C-e $self->log( $self->vt_dump()); } elsif ($input =~ m/\x17/g) { # C-w $input = "/quit\n"; } $heap->{program}->put($input); } # delegate to Callbacks. sub vt_dump { my ($self) = @_; my $cb = $self->parent->_callbacks->vt_dump(); } ### Handle STDOUT from the child program. sub 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 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 => 'start_tests', } ] ); $self->log("creating root session"); POE::Session->create(@states); $self->log("session created"); } sub start_tests { my ($self) = $_[OBJECT]; $self->log("Starting to run tests"); $self->log("-" x 80); $self->parent->run_tests(); } sub timer_created { my ($self, $heap, $kernel, $duration) = @_[OBJECT, HEAP, KERNEL, ARG0]; $kernel->delay(got_delay => $duration); $self->log("Timer created"); } 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;