#!/usr/bin/perl
#
# Example script showing how to use Term::VT102 with Net::Telnet. Telnets to
# localhost and dumps what Term::VT102 thinks should be on the screen. Or
# you can pass it a host and a port and it will telnet there instead.
#
# Note that this script doesn't pass the terminal size through to the remote
# end, so you might have to do "stty rows 24 cols 80" to make things work
# (the default is generally 80x24 anyway though).
#
# Logs all terminal output to STDERR if STDERR is redirected to a file.
#
use Net::Telnet qw(TELOPT_TTYPE);
use Term::VT102;
use IO::Handle;
use strict;
$| = 1;
my ($host, $port) = @ARGV;
$host = 'localhost' if (not defined $host);
$port = 23 if (not defined $port);
my $t = new Net::Telnet (
'Host' => $host,
'Port' => $port,
'Errmode' => 'return',
'Timeout' => 1,
'Output_record_separator' => '',
);
die "failed to connect to $host:$port" if (not defined $t);
$t->option_callback (\&opt_callback);
$t->option_accept ('Do' => TELOPT_TTYPE);
$t->suboption_callback (\&subopt_callback);
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);
# 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 Net::Telnet - see its definition below.
#
$vt->callback_set ('OUTPUT', \&vt_output, $t);
# 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);
my ($telnetbuf, $io, $stdinbuf, $prevxy);
$io = new IO::Handle;
$io->fdopen (fileno(STDIN), 'r');
$io->blocking (0);
system 'stty raw -echo';
$prevxy = '';
while (1) {
last if ($t->eof ());
my ($rin, $win, $ein, $rout, $wout, $eout, $nr, $delay, $didout);
($rin, $win, $ein) = ('', '', '');
vec ($rin, fileno ($t), 1) = 1;
vec ($rin, fileno ($io), 1) = 1;
# If we have any changed rows on the screen still waiting to be
# output, we only wait a short time for activity, otherwise we wait
# a full second. This is so that batched-up screen updates get
# processed in a timely fashion.
#
$delay = 1;
$delay = 0.05 if ((scalar keys %$changedrows) > 0);
select ($rout=$rin, $wout=$win, $eout=$ein, $delay);
$telnetbuf = undef;
if (vec ($rout, fileno ($t), 1)) {
$telnetbuf = $t->get ('Timeout' => 1);
if (defined $telnetbuf) {
$vt->process ($telnetbuf);
print STDERR $telnetbuf if (! -t STDERR);
}
}
$telnetbuf = '' if (not defined $telnetbuf);
# 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 telnet stream, we take
# the data coming back from Net::Telnet and pass it to the Term::VT102
# object, any changed rows of which we dump to the screen.
# Read key presses from standard input and pass them to Net::Telnet.
#
$stdinbuf = '';
if (vec ($rout, fileno ($io), 1)) {
if (defined $io->sysread ($stdinbuf, 16)) {
$t->print ($stdinbuf);
}
}
# 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);
}
}
$t->close ();
print "\e[24H\r\n";
system 'stty sane';
# Callback for "DO" handling - for Net::Telnet.
#
sub opt_callback {
my ($obj,$opt,$is_remote,$is_enabled,$was_enabled,$buf_position) = @_;
if ($opt == TELOPT_TTYPE and $is_enabled and !$is_remote) {
#
# Perhaps do something if we get TELOPT_TTYPE switched on?
#
}
return 1;
}
# Callback for sub-option handling - for Net::Telnet.
#
sub subopt_callback {
my ($obj, $opt, $parameters) = @_;
my ($ors_old, $otm_old);
# Respond to TELOPT_TTYPE with "I'm a VT100".
#
if ($opt == TELOPT_TTYPE) {
$ors_old = $obj->output_record_separator ('');
$otm_old = $obj->telnetmode (0);
$obj->print (
"\xff\xfa",
pack ('CC', $opt, 0),
'vt100',
"\xff\xf0"
);
$obj->telnetmode ($otm_old);
$obj->output_record_separator ($ors_old);
}
return 1;
}
# Callback for OUTPUT events - for Term::VT102.
#
sub vt_output {
my ($vtobject, $type, $arg1, $arg2, $private) = @_;
if ($type eq 'OUTPUT') {
$private->print ($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