;#!/usr/bin/perl
#
# Example script showing how to use Term::VT102 with an SSH command. SSHs to
# localhost and runs a shell, and dumps what Term::VT102 thinks should be on
# the screen.
#
# Logs all terminal output to STDERR if STDERR is redirected to a file.
#

use Term::VT102;
use IO::Handle;
use POSIX ':sys_wait_h';
use IO::Pty;
use strict;

$| = 1;

my $cmd = 'ssh -v -t localhost';

# Create the terminal object.
#
my $vt = Term::VT102->new (
  'cols' => 80,
  'rows' => 24,
);

# Convert linefeeds to linefeed + carriage return.
#
$vt->option_set ('LFTOCRLF', 1);

# Make sure line wrapping is switched on.
#
$vt->option_set ('LINEWRAP', 1);

# Create a pty for the SSH command to run on.
#
my $pty = new IO::Pty;
my $tty_name = $pty->ttyname ();
if (not defined $tty_name) {
	die "Could not assign a pty";
}
$pty->autoflush ();

# Run the SSH command in a child process.
#
my $pid = fork;
if (not defined $pid) {
	die "Cannot fork: $!";
} elsif ($pid == 0) {
	#
	# Child process - set up stdin/out/err and run the command.
	#

	# Become process group leader.
	#
	if (not POSIX::setsid ()) {
		warn "Couldn't perform setsid: $!";
	}

	# Get details of the slave side of the pty.
	#
	my $tty = $pty->slave ();
	$tty_name = $tty->ttyname();

# Linux specific - commented out, we'll just use stty below.
#
#	# Set the window size - this may only work on Linux.
#	#
#	my $winsize = pack ('SSSS', $vt->rows, $vt->cols, 0, 0);
#	ioctl ($tty, &IO::Tty::Constant::TIOCSWINSZ, $winsize);

	# File descriptor shuffling - close the pty master, then close
	# stdin/out/err and reopen them to point to the pty slave.
	#
	close ($pty);
	close (STDIN);
	close (STDOUT);
	open (STDIN, "<&" . $tty->fileno ())
	|| die "Couldn't reopen " . $tty_name . " for reading: $!";
	open (STDOUT, ">&" . $tty->fileno())
	|| die "Couldn't reopen " . $tty_name . " for writing: $!";
	close (STDERR);
	open (STDERR, ">&" . $tty->fileno())
	|| die "Couldn't redirect STDERR: $!";

	# Set sane terminal parameters.
	#
	system 'stty sane';

	# Set the terminal size with stty.
	#
	system 'stty rows ' . $vt->rows;
	system 'stty cols ' . $vt->cols;

	# Finally, run the command, and die if we can't.
	#
	exec $cmd;
	die "Cannot exec '$cmd': $!";
}

my ($cmdbuf, $stdinbuf, $iot, $eof, $prevxy, $died);

# IO::Handle for standard input - unbuffered.
#
$iot = new IO::Handle;
$iot->fdopen (fileno(STDIN), 'r');

# Removed - from Perl 5.8.0, setvbuf isn't available by default.
# $iot->setvbuf (undef, _IONBF, 0);

# Set up the callback for OUTPUT; this callback function simply sends
# whatever the Term::VT102 module wants to send back to the terminal and
# sends it to the child process - see its definition below.
#
$vt->callback_set ('OUTPUT', \&vt_output, $pty);

# Set up a callback for row changes, so we can process updates and display
# them without having to redraw the whole screen every time. We catch CLEAR,
# SCROLL_UP, and SCROLL_DOWN with another function that triggers a
# whole-screen repaint. You could process SCROLL_UP and SCROLL_DOWN more
# elegantly, but this is just an example.
#
my $changedrows = {};
$vt->callback_set ('ROWCHANGE', \&vt_rowchange, $changedrows);
$vt->callback_set ('CLEAR', \&vt_changeall, $changedrows);
$vt->callback_set ('SCROLL_UP', \&vt_changeall, $changedrows);
$vt->callback_set ('SCROLL_DOWN', \&vt_changeall, $changedrows);

# Set stdin's terminal to raw mode so we can pass all keypresses straight
# through immediately.
#
system 'stty raw -echo';

$eof = 0;
$prevxy = '';
$died = 0;

while (not $eof) {
	my ($rin, $win, $ein, $rout, $wout, $eout, $nr, $didout);

	($rin, $win, $ein) = ('', '', '');
	vec ($rin, $pty->fileno, 1) = 1;
	vec ($rin, $iot->fileno, 1) = 1;

	select ($rout=$rin, $wout=$win, $eout=$ein, 1);

	# Read from the SSH command if there is anything coming in, and
	# pass any data on to the Term::VT102 object.
	#
	$cmdbuf = '';
	$nr = 0;
	if (vec ($rout, $pty->fileno, 1)) {
		$nr = $pty->sysread ($cmdbuf, 1024);
		$eof = 1 if ((defined $nr) && ($nr == 0));
		if ((defined $nr) && ($nr > 0)) {
			$vt->process ($cmdbuf);
			syswrite STDERR, $cmdbuf if (! -t STDERR);
		}
	}

	# End processing if we've gone 1 round after SSH died with no
	# output.
	#
	$eof = 1 if ($died && $cmdbuf eq '');

# Do your stuff here - use $vt->row_plaintext() to see what's on various
# rows of the screen, for instance, or before this main loop you could set
# up a ROWCHANGE callback which checks the changed row, or whatever.
#
# In this example, we just pass standard input to the SSH command, and we
# take the data coming back from SSH and pass it to the Term::VT102 object,
# and then we repeatedly dump the Term::VT102 screen.

	# Read key presses from standard input and pass them to the command
	# running in the child process.
	#
	$stdinbuf = '';
	if (vec ($rout, $iot->fileno, 1)) {
		$nr = $iot->sysread ($stdinbuf, 16);
		$eof = 1 if ((defined $nr) && ($nr == 0));
		$pty->syswrite ($stdinbuf, $nr) if ((defined $nr) && ($nr > 0));
	}

	# Dump what Term::VT102 thinks is on the screen. We only output rows
	# we know have changed, to avoid generating too much output.
	#
	$didout = 0;
	foreach my $row (sort keys %$changedrows) {
		printf "\e[%dH%s\r", $row, $vt->row_sgrtext ($row);
		delete $changedrows->{$row};
		$didout ++;
	}
	if (($didout > 0) || ($prevxy != ''.$vt->x.','.$vt->y)) {
		printf "\e[%d;%dH", $vt->y, ($vt->x > $vt->cols ? $vt->cols : $vt->x);
	}

	# Make sure the child process has not died.
	#
	$died = 1 if (waitpid ($pid, &WNOHANG) > 0);
}

print "\e[24H\r\n";
$pty->close;

# Reset the terminal parameters.
#
system 'stty sane';


# Callback for OUTPUT events - for Term::VT102.
#
sub vt_output {
	my ($vtobject, $type, $arg1, $arg2, $private) = @_;

	if ($type eq 'OUTPUT') {
		$pty->syswrite ($arg1, length $arg1);
	}
}


# Callback for ROWCHANGE events. This just sets a time value for the changed
# row using the private data as a hash reference - the time represents the
# earliest that row was changed since the last screen update.
#
sub vt_rowchange {
	my ($vtobject, $type, $arg1, $arg2, $private) = @_;
	$private->{$arg1} = time if (not exists $private->{$arg1});
}


# Callback to trigger a full-screen repaint.
#
sub vt_changeall {
	my ($vtobject, $type, $arg1, $arg2, $private) = @_;
	for (my $row = 1; $row <= $vtobject->rows; $row++) {
		$private->{$row} = 0;
	}
}

# EOF