#!/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.
#

use Net::Telnet qw(TELOPT_TTYPE);
use Term::VT102;
use IO::Handle;
use strict;

$| = 1;

my ($host, $port) = ('localhost', 23);

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' => 23,
);

# 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);

my ($telnetbuf, $io, $stdinbuf);

$io = new IO::Handle;
$io->fdopen (fileno(STDIN), 'r');
$io->blocking (0);

while (1) {
	$telnetbuf = $t->get ('Timeout' => 1);

	last if ($t->eof ());

	$vt->process ($telnetbuf) if (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, and then we repeatedly dump the Term::VT102 screen.
#
# Note that using this example as a telnet program isn't really a good idea
# since reading standard input as well as reading from Net::Telnet is a bit
# fiddly and we're doing it wrong here. This is just proof-of-concept stuff.

	# Read key presses from standard input (you'll probably need to hit
	# Return before anything appears, though) and pass them to
	# Net::Telnet.
	#
	$stdinbuf = '';
	if (defined $io->sysread ($stdinbuf, 16)) {
		$t->print ($stdinbuf);
	}

	# Dump what Term::VT102 thinks is on the screen.
	#
	print "\e[H";	# return to the top left of the (real) screen
	for (my $row = 1; $row <= $vt->rows (); $row++) {
		printf "%s\n", $vt->row_plaintext ($row);
	}
	printf "Cursor position: (%d, %d)",
	  $vt->x (),
	  $vt->y ();
}

$t->close ();
print "\n";


# 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 VT102".
	#
	if ($opt == TELOPT_TTYPE) {
		$ors_old = $obj->output_record_separator ('');
		$otm_old = $obj->telnetmode (0);
		$obj->print (
		  "\xff\xfa",
		  pack ('CC', $opt, 0),
		  'vt102',
		  "\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);
	}
}

# EOF