#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; # for fixed version of P:W:R use lib $ENV{HOME} . "/projects/poe/lib"; sub PROGRAM () { "/opt/stow/repo/irssi-debug/bin/irssi" } 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/; use Data::Dumper; use IO::File; my $logfile = "irssi.log"; my $logfh = IO::File->new($logfile, 'w'); die "Couldn't open $logfile for writing: $!" unless defined $logfh; $logfh->autoflush(1); my $ti = Term::Terminfo->new(); my $vt = Term::VT102->new(rows => ROWS, cols => COLS); vt_configure_callbacks($vt); sub vt_output { my ($vt, $cb_name, $cb_data, $priv_data) = @_; say $logfh "OUTPUT: " . Dumper([@_[1..$#_]]); } sub vt_rowchange { my ($vt, $cb_name, $arg1, $arg2, $priv_data) = @_; #say $logfh "ROWCHANGE: " . Dumper(\@_); #say $logfh "Row $arg1 changed: "; #say $logfh $vt->row_plaintext($arg1); my $bottom_line = $vt->rows(); say $logfh "-" x 100; say $logfh "Window Line"; say $logfh $vt->row_plaintext($bottom_line - 1); say $logfh "-" x 100; say $logfh "Prompt line"; say $logfh $vt->row_plaintext($bottom_line); say $logfh "-" x 100; # print $ti->getstr("clear"); # print vt_dump(); } sub vt_clear { my ($vt, $cb_name, $arg1, $arg2, $priv_data) = @_; say $logfh "VT Cleared"; } sub vt_scr_dn { my ($vt, $cb_name, $arg1, $arg2, $priv_data) = @_; say $logfh "Scroll Down"; } sub vt_scr_up { my ($vt, $cb_name, $arg1, $arg2, $priv_data) = @_; say $logfh "Scroll Up"; } sub vt_goto { my ($vt, $cb_name, $arg1, $arg2, $priv_data) = @_; say $logfh "Goto: $arg1, $arg2"; } sub vt_dump { my $str = ''; for my $y (1..ROWS) { $str .= $vt->row_sgrtext($y) . "\n"; } 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;