Term-VT102-0.91/0000700000076400007640000000000011105652417010724 5ustar awawTerm-VT102-0.91/t/0000700000076400007640000000000011105652417011167 5ustar awawTerm-VT102-0.91/t/07-colour.t0000644000076400007640000000237011102154072013106 0ustar awaw#!/usr/bin/perl -w # # Make sure the VT102 module can handle ANSI colour, underline, bold, etc. # # Copyright (C) Andrew Wood # NO WARRANTY - see COPYING. # require Term::VT102; require 't/testbase'; run_tests ([( # (F,B,b,f,s,u,F,r) [ 7, 4, "\e[m0\e[1m1\e[2m2\e[4m3\e[5m4\e[7m5\e[m6\r\n", "0123456", [ [7,0,0,0,0,0,0,0], [7,0,1,0,0,0,0,0], [7,0,0,1,0,0,0,0], [7,0,0,1,0,1,0,0], [7,0,0,1,0,1,1,0], [7,0,0,1,0,1,1,1], [7,0,0,0,0,0,0,0] ], ], [ 7, 4, "\e[41;35m0\e[1m1\e[2m2\e[4m3\e[5m4\e[7m5\e[m6\r\n", "0123456", [ [5,1,0,0,0,0,0,0], [5,1,1,0,0,0,0,0], [5,1,0,1,0,0,0,0], [5,1,0,1,0,1,0,0], [5,1,0,1,0,1,1,0], [5,1,0,1,0,1,1,1], [7,0,0,0,0,0,0,0] ], ], [ 8, 4, "\e[33;42m0\e[1m1\e[21m2\e[2m3\e[22m4\e[38m5\e[39m6\e[49m7\r\n", "01234567",[ [3,2,0,0,0,0,0,0], [3,2,1,0,0,0,0,0], [3,2,0,0,0,0,0,0], [3,2,0,1,0,0,0,0], [3,2,0,0,0,0,0,0], [7,2,0,0,0,1,0,0], [7,2,0,0,0,0,0,0], [7,0,0,0,0,0,0,0] ], ], )]); # EOF Term-VT102-0.91/t/testbase0000644000076400007640000000531111102154072012725 0ustar awaw#!/usr/bin/perl # # Basic functions used by most of the test scripts. # sub run_tests { my ($testref) = @_; my @tests = @$testref; my ($nt, $i); $nt = scalar @tests; # number of sub-tests foreach $i (1 .. $nt) { my $testref = shift @tests; my ($cols, $rows, $text, @output) = @$testref; my ($ncols, $nrows, $row, $col, $settings); my ($line, $aline, $alineref, $galine, $passed); $settings = undef; if (ref $cols) { ($settings, $cols, $rows, $text, @output) = @$testref; } print "$i..$nt\n"; my $vt = Term::VT102->new ('cols' => $cols, 'rows' => $rows); ($ncols, $nrows) = $vt->size (); if (($cols != $ncols) or ($rows != $nrows)) { print "not ok $i\n"; warn "returned size: $ncols x $nrows, wanted $cols x $rows\n"; next; } if (defined $settings) { foreach (keys %$settings) { if ( !defined $vt->option_set ($_,$settings->{$_}) ) { print "not ok $i\n"; warn "failed to set option: $_"; } } } $vt->process ($text); $row = 0; $passed = 1; while ($#output > 0) { $line = shift @output; if (ref $output[0]) { $alineref = shift @output; $aline = ""; foreach (@$alineref) { $aline .= $vt->attr_pack (@$_); } } else { $alineref = undef; } $row ++; if ($vt->row_text ($row) ne $line) { $passed = 0; print STDERR "test $i: row $row incorrect, got '" . show_text ($vt->row_text ($row)) . "', expected '" . show_text ($line) . "'\n"; next; } next if (not defined $alineref); $galine = $vt->row_attr ($row); for ($col = 0; $col < $cols; $col ++) { if (substr ($aline, 2 * $col, 2) ne substr ($galine, 2 * $col, 2)) { $passed = 0; print STDERR "test $i: row $row col " . ($col + 1) . " attributes incorrect, got '" . show_attr ($vt, substr ($galine, 2 * $col, 2)) . "', expected '" . show_attr ($vt, substr ($aline, 2 * $col, 2)) . "'\n"; next; } } } if ($passed == 0) { print "not ok $i\n"; print STDERR "screen contents ($cols x $rows):\n"; for (my $dumprow = 1; $dumprow <= $rows; $dumprow++) { print STDERR "[" . $vt->row_plaintext ($dumprow) . "]\n"; } } else { print "ok $i\n"; } } } sub show_text { my ($text) = @_; return "" if (not defined $text); $text =~ s/([^\040-\176])/sprintf ("\\%o", ord ($1))/ge; return $text; } sub show_attr { my ($vt, $attr) = @_; my ($fg,$bg,$bo,$fa,$st,$ul,$bl,$rv) = $vt->attr_unpack ($attr); my $str = "$fg-$bg"; $str .= "b" if ($bo != 0); $str .= "f" if ($fa != 0); $str .= "s" if ($st != 0); $str .= "u" if ($ul != 0); $str .= "F" if ($bl != 0); $str .= "r" if ($rv != 0); return $str . "-" . sprintf ("%04X", unpack ('S', $attr)); } 1; # EOF Term-VT102-0.91/t/02-setsize.t0000644000076400007640000000131211102154072013257 0ustar awaw#!/usr/bin/perl -w # # Make sure the VT102 module can set its size OK. # # Copyright (C) Andrew Wood # NO WARRANTY - see COPYING. # require Term::VT102; @testsizes = ( 1, 1, 80, 24, 0, 0, -1000, -1000, 1000, 1000 ); $nt = ($#testsizes + 1) / 2; # number of sub-tests foreach $i (1 .. $nt) { print "$i..$nt\n"; $cols = shift @testsizes; $rows = shift @testsizes; my $vt = Term::VT102->new ('cols' => $cols, 'rows' => $rows); ($ncols, $nrows) = $vt->size (); $cols = 80 if ($cols < 1); $rows = 24 if ($rows < 1); if (($cols != $ncols) or ($rows != $nrows)) { print "not ok $i\n"; warn "returned size: $ncols x $nrows, wanted $cols x $rows\n"; } else { print "ok $i\n"; } } # EOF Term-VT102-0.91/t/13-xonxoff.t0000644000076400007640000000213311102154072013264 0ustar awaw#!/usr/bin/perl -w # # Test XOFF and XON. # # Copyright (C) Andrew Wood # NO WARRANTY - see COPYING. # require Term::VT102; require 't/testbase'; run_tests ([( # (F,B,b,f,s,u,F,r) [ { 'IGNOREXOFF' => 0 }, 6, 2, "foo\023bar\e[1m\021baz", "foobaz", [ [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0] ], "\0\0\0\0\0\0", [ [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0] ], ], [ { 'IGNOREXOFF' => 1 }, 9, 1, "foo\023bar\e[1m\021baz", "foobarbaz", [ [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,1,0,0,0,0,0], [7,0,1,0,0,0,0,0], [7,0,1,0,0,0,0,0] ], ], )]); # EOF Term-VT102-0.91/t/12-cupsvrs.t0000644000076400007640000000145011102154072013302 0ustar awaw#!/usr/bin/perl -w # # Test CUPSV and CUPRS. # # Copyright (C) Andrew Wood # NO WARRANTY - see COPYING. # require Term::VT102; require 't/testbase'; run_tests ([( # (F,B,b,f,s,u,F,r) [ 5, 3, "\e[41;33mtest\e[s\e[2H\e[42;34mgrok\e[s\e[m\e[3Hfoo\e[u2\e[u1", "test1", [ [3,1,0,0,0,0,0,0], [3,1,0,0,0,0,0,0], [3,1,0,0,0,0,0,0], [3,1,0,0,0,0,0,0], [7,0,0,0,0,0,0,0] ], "grok2", [ [4,2,0,0,0,0,0,0], [4,2,0,0,0,0,0,0], [4,2,0,0,0,0,0,0], [4,2,0,0,0,0,0,0], [7,0,0,0,0,0,0,0] ], "foo\0\0", [ [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0] ], ], )]); # EOF Term-VT102-0.91/t/09-callback.t0000644000076400007640000000375411102177273013360 0ustar awaw#!/usr/bin/perl -w # # Make sure the VT102 module's callbacks work. # # Copyright (C) Andrew Wood # NO WARRANTY - see COPYING. # require Term::VT102; my $nt = 5; my $i = 1; my ($testarg1, $testarg2, $testpriv) = (0, 0, 0); print "$i..$nt\n"; my $vt = Term::VT102->new ('cols' => 80, 'rows' => 25); # Test 1 - ROWCHANGE callback runs at all $vt->callback_call ('ROWCHANGE', 0, 0); print "ok $i\n"; $i ++; # Test 2 - ROWCHANGE callback sets private data $vt->callback_set ('ROWCHANGE', \&testcallback, 123); $vt->callback_call ('ROWCHANGE', 0, 0); if ($testpriv != 123) { print "not ok $i\n"; } else { print "ok $i\n"; } $vt->callback_set ('ROWCHANGE', undef); $i ++; # Test 3 - STRING callback reports ESC _ values OK $vt->callback_set ('STRING', \&testcallback, $i); $vt->process ("\033_Test String\033\\test"); if (($testarg1 ne 'APC') || ($testarg2 ne 'Test String') || ($testpriv != $i)) { print "not ok $i\n"; print STDERR "\nTest $i: arg1=[$testarg1], arg2=[$testarg2], priv=[$testpriv]\n"; } else { print "ok $i\n"; } $vt->callback_set ('STRING', undef); $i ++; # Test 4 - XICONNAME callback reports X icon name changes $vt->callback_set ('XICONNAME', \&testcallback, $i); $vt->process ("\033]1;Test Icon Name\033\\test"); if (($testarg1 ne 'Test Icon Name') || ($testpriv != $i)) { print "not ok $i\n"; print STDERR "\nTest $i: arg1=[$testarg1], arg2=[$testarg2], priv=[$testpriv]\n"; } else { print "ok $i\n"; } $vt->callback_set ('XICONNAME', undef); $i ++; # Test 5 - XWINTITLE callback reports X title changes $vt->callback_set ('XWINTITLE', \&testcallback, $i); $vt->process ("\033]2;Test Title\033\\test"); if (($testarg1 ne 'Test Title') || ($testpriv != $i)) { print "not ok $i\n"; print STDERR "\nTest $i: arg1=[$testarg1], arg2=[$testarg2], priv=[$testpriv]\n"; } else { print "ok $i\n"; } $vt->callback_set ('XWINTITLE', undef); $i ++; sub testcallback { my ($vtobj, $callname, $arg1, $arg2, $privdata) = @_; ($testarg1, $testarg2, $testpriv) = ($arg1, $arg2, $privdata); } # EOF Term-VT102-0.91/t/04-cursor.t0000644000076400007640000000367111102154072013122 0ustar awaw#!/usr/bin/perl -w # # Make sure the VT102 module can handle cursor positioning. # # Copyright (C) Andrew Wood # NO WARRANTY - see COPYING. # require Term::VT102; require 't/testbase'; run_tests ([( [ 20, 5, "\e[2;4Hline 1\r\nline 2", # CUP - ESC [ y ; x H "\0" x 20, ("\0" x 3) . "line 1" . ("\0" x 11), "line 2" . ("\0" x 14), ], [ 20, 5, "\e[3Hline 1\nline 2", # CUP - ESC [ y H "\0" x 20, "\0" x 20, "line 1" . ("\0" x 14), ("\0" x 6) . "line 2" . ("\0" x 8), ], [ 20, 5, "\e[2Hline 1\nline 2\e[1Hline 3", # CUP, CUP, LF "line 3" . ("\0" x 14), "line 1" . ("\0" x 14), ("\0" x 6) . "line 2" . ("\0" x 8), ], [ 10, 4, "\e[2;6Hline 1\r\nline 2\eM\eMtop", # CUP, CR, LF, RI (ESC M) ("\0" x 6) . "top" . "\0", ("\0" x 5) . "line ", "line 2" . ("\0" x 4), ("\0" x 10), ], [ 20, 8, "\e[4;10Hmiddle\e[Htop line\eD" . # IND, NEL, CUU, CUF "row 2\eE\rrow 3\e[A\e[8Cmark", "top line" . ("\0" x 12), ("\0" x 8) . "row 2mark" . ("\0" x 3), "row 3" . ("\0" x 15), ("\0" x 9) . "middle" . ("\0" x 5), ], [ 20, 4, "row 1\e[Brow 2\e[7Da\e[2Erow 4", # CUD, CUB, CNL "row 1" . ("\0" x 15), ("\0" x 3) . "a\0row 2" . ("\0" x 10), "\0" x 20, "row 4" . ("\0" x 15), ], [ 20, 4, "\e[3;4Hrow 3\e[2Frow 1" . # CPL, CHA, HPR, VPA "\e[9Gmiddle 1\e[2aa\e[2db", "row 1" . ("\0" x 3) . "middle 1" . ("\0" x 2) . "a\0", ("\0" x 19) . "b", ("\0" x 3) . "row 3" . ("\0" x 12), ], [ 20, 3, "\e[2erow 3\e[2;4frow 2\e[15\`mark", # VPR, HVP, HPA ("\0" x 20), ("\0" x 3) . "row 2" . ("\0" x 6) . "mark" . ("\0" x 2), "row 3" . ("\0" x 15), ], [ 10, 5, "\e[999;999HR\e[GL\e[Hl\e[999Gr", "l" . ("\0" x 8) . "r", ("\0" x 10), ("\0" x 10), ("\0" x 10), "L" . ("\0" x 8) . "R", ], [ 20, 8, "Trap\e[CLog\e[CDisplay", # reported by Paul Stoddard "Trap\0Log\0Display" . ("\0" x 4), ("\0" x 20), ], )]); # EOF Term-VT102-0.91/t/10-decaln.t0000644000076400007640000000140311102154072013017 0ustar awaw#!/usr/bin/perl -w # # Test DECALN. # # Copyright (C) Andrew Wood # NO WARRANTY - see COPYING. # require Term::VT102; require 't/testbase'; run_tests ([( # (F,B,b,f,s,u,F,r) [ 5, 3, "b\e[41;33mlah\nblah\r\nblah\e#8test", "testE", [ [3,1,0,0,0,0,0,0], [3,1,0,0,0,0,0,0], [3,1,0,0,0,0,0,0], [3,1,0,0,0,0,0,0], [7,0,0,0,0,0,0,0] ], "EEEEE", [ [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0] ], "EEEEE", [ [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0] ], ], )]); # EOF Term-VT102-0.91/t/05-scrolling.t0000644000076400007640000000535511102154072013603 0ustar awaw#!/usr/bin/perl -w # # Make sure the VT102 module can handle scrolling up and down. # # Copyright (C) Andrew Wood # NO WARRANTY - see COPYING. # require Term::VT102; require 't/testbase'; my $fill = "0123456789\r\n" . "1234567890\r\n" . "2345678901\r\n" . "3456789012\e[H"; my $fill2 = "0123456789\r\n" . "1234567890\r\n" . "2345678901\r\n" . "3456789012\e[2;3r\e[2H"; run_tests ([( [ 10, 4, $fill . "", # 1: nothing "0123456789", "1234567890", "2345678901", "3456789012", ], [ 10, 4, $fill . "\e[4H\ntest", # 2: LF "1234567890", "2345678901", "3456789012", "test" . ("\0" x 6), ], [ 10, 4, $fill . "\eMtest", # 3: RI "test" . ("\0" x 6), "0123456789", "1234567890", "2345678901", ], [ 10, 4, $fill . "\e[4H\eDtest", # 4: IND "1234567890", "2345678901", "3456789012", "test" . ("\0" x 6), ], [ 10, 4, $fill . "\e[4H\eEtest", # 5: NEL "1234567890", "2345678901", "3456789012", "test" . ("\0" x 6), ], [ 10, 4, $fill . "\e[2Atest", # 6: CUU "test" . ("\0" x 6), "\0" x 10, "0123456789", "1234567890", ], [ 10, 4, $fill . "\e[8Atest", # 7: CUU "test" . ("\0" x 6), "\0" x 10, "\0" x 10, "\0" x 10, ], [ 10, 4, $fill . "\e[4H\e[2Btest", # 8: CUD "2345678901", "3456789012", "\0" x 10, "test" . ("\0" x 6), ], [ 10, 4, $fill . "\e[4H\e[2Etest", # 9: CNL "2345678901", "3456789012", "\0" x 10, "test" . ("\0" x 6), ], [ 10, 4, $fill . "\e[4H\e[9Etest", # 10: CNL "\0" x 10, "\0" x 10, "\0" x 10, "test" . ("\0" x 6), ], [ 10, 4, $fill . "\e[2Ftest", # 11: CPL "test" . ("\0" x 6), "\0" x 10, "0123456789", "1234567890", ], [ 10, 4, $fill2 . "", # 12: nothing (with DECSTBM) "0123456789", "1234567890", "2345678901", "3456789012", ], [ 10, 4, $fill2 . "\e[3H\e[Etest", # 13: DECSTBM CNL "0123456789", "2345678901", "test" . ("\0" x 6), "3456789012", ], [ 10, 4, $fill2 . "\e[Ftest", # 14: DECSTBM CPL "0123456789", "test" . ("\0" x 6), "1234567890", "3456789012", ], [ 10, 4, $fill2 . "\e[3H\e[2Etest", # 15: DECSTBM CNL 2 "0123456789", "\0" x 10, "test" . ("\0" x 6), "3456789012", ], [ 10, 4, $fill2 . "\e[2Ftest", # 16: DECSTBM CPL 2 "0123456789", "test" . ("\0" x 6), "\0" x 10, "3456789012", ], [ 10, 4, $fill2 . "\e[3H\e[4Etest", # 17: DECSTBM CNL 4 "0123456789", "\0" x 10, "test" . ("\0" x 6), "3456789012", ], [ 10, 4, $fill2 . "\e[4Ftest", # 18: DECSTBM CPL 4 "0123456789", "test" . ("\0" x 6), "\0" x 10, "3456789012", ], )]); # EOF Term-VT102-0.91/t/11-decscrc.t0000644000076400007640000000144411102154072013205 0ustar awaw#!/usr/bin/perl -w # # Test DECSC and DECRC. # # Copyright (C) Andrew Wood # NO WARRANTY - see COPYING. # require Term::VT102; require 't/testbase'; run_tests ([( # (F,B,b,f,s,u,F,r) [ 5, 3, "\e[41;33mtest\e7\e[2H\e[42;34mgrok\e7\e[m\e[3Hfoo\e82\e81", "test1", [ [3,1,0,0,0,0,0,0], [3,1,0,0,0,0,0,0], [3,1,0,0,0,0,0,0], [3,1,0,0,0,0,0,0], [3,1,0,0,0,0,0,0] ], "grok2", [ [4,2,0,0,0,0,0,0], [4,2,0,0,0,0,0,0], [4,2,0,0,0,0,0,0], [4,2,0,0,0,0,0,0], [4,2,0,0,0,0,0,0] ], "foo\0\0", [ [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0], [7,0,0,0,0,0,0,0] ], ], )]); # EOF Term-VT102-0.91/t/06-insdel.t0000644000076400007640000001115211102154072013056 0ustar awaw#!/usr/bin/perl -w # # Make sure the VT102 module can handle line and character insertion and # deletion, and line/screen clearing. # # Copyright (C) Andrew Wood # NO WARRANTY - see COPYING. # require Term::VT102; require 't/testbase'; my $fill = "0123456789\r\n" . "1234567890\r\n" . "2345678901\r\n" . "3456789012\e[H"; run_tests ([( [ 10, 4, $fill . "", # 1: nothing "0123456789", "1234567890", "2345678901", "3456789012", ], [ 10, 4, $fill . "\e[P", # 2: DCH 1 "123456789\0", "1234567890", "2345678901", "3456789012", ], [ 10, 4, $fill . "\e[2;8H\e[2P", # 3: DCH 2 "0123456789", "12345670\0\0", "2345678901", "3456789012", ], [ 10, 4, $fill . "\e[3;7H\e[9P", # 4: DCH 9 "0123456789", "1234567890", "234567\0\0\0\0", "3456789012", ], [ 10, 4, $fill . "\e[X", # 5: ECH 1 "\0" . "123456789", "1234567890", "2345678901", "3456789012", ], [ 10, 4, $fill . "\e[2;8H\e[2X", # 6: ECH 2 "0123456789", "1234567\0\0" . "0", "2345678901", "3456789012", ], [ 10, 4, $fill . "\e[3;7H\e[9X", # 7: ECH 9 "0123456789", "1234567890", "234567\0\0\0\0", "3456789012", ], [ 10, 4, $fill . "\e[@", # 8: ICH 1 "\0" . "012345678", "1234567890", "2345678901", "3456789012", ], [ 10, 4, $fill . "\e[2;8H\e[2@", # 9: ICH 2 "0123456789", "1234567\0\0" . "8", "2345678901", "3456789012", ], [ 10, 4, $fill . "\e[3;7H\e[9@", # 10: ICH 9 "0123456789", "1234567890", "234567\0\0\0\0", "3456789012", ], [ 10, 4, $fill . "\e[2;4H\e[J", # 11: ED 0 "0123456789", "123" . ("\0" x 7), ("\0" x 10), ("\0" x 10), ], [ 10, 4, $fill . "\e[2;4H\e[1J", # 12: ED 1 ("\0" x 10), ("\0" x 4) . "567890", "2345678901", "3456789012", ], [ 10, 4, $fill . "\e[2;4H\e[2J", # 13: ED 2 ("\0" x 10), ("\0" x 10), ("\0" x 10), ("\0" x 10), ], [ 10, 4, $fill . "\e[2;4H\e[K", # 14: EL 0 "0123456789", "123" . ("\0" x 7), "2345678901", "3456789012", ], [ 10, 4, $fill . "\e[2;4H\e[1K", # 15: EL 1 "0123456789", ("\0" x 4) . "567890", "2345678901", "3456789012", ], [ 10, 4, $fill . "\e[2;4H\e[2K", # 16: EL 2 "0123456789", ("\0" x 10), "2345678901", "3456789012", ], [ 10, 4, $fill . "\e[2;4H\e[LAbC", # 17: IL 1 "0123456789", ("\0" x 3) . "AbC" . ("\0" x 4), "1234567890", "2345678901", ], [ 10, 4, $fill . "\e[2;4H\e[2LAbC", # 18: IL 2 "0123456789", ("\0" x 3) . "AbC" . ("\0" x 4), ("\0" x 10), "1234567890", ], [ 10, 4, $fill . "\e[2;4H\e[9LAbC", # 19: IL 3 "0123456789", ("\0" x 3) . "AbC" . ("\0" x 4), ("\0" x 10), ("\0" x 10), ], [ 10, 4, $fill . "\e[1;1H\e[2LAbC", # 20: IL 4 "AbC" . ("\0" x 7), ("\0" x 10), "0123456789", "1234567890", ], [ 10, 4, $fill . "\e[2;4H\e[MAbC", # 21: DL 1 "0123456789", "234AbC8901", "3456789012", ("\0" x 10), ], [ 10, 4, $fill . "\e[2;4H\e[2MAbC", # 22: DL 2 "0123456789", "345AbC9012", ("\0" x 10), ("\0" x 10), ], [ 10, 4, $fill . "\e[2;4H\e[9MAbC", # 23: DL 3 "0123456789", ("\0" x 3) . "AbC" . ("\0" x 4), ("\0" x 10), ("\0" x 10), ], [ 10, 4, $fill . "\e[1;1H\e[2MAbC", # 24: DL 4 "AbC5678901", "3456789012", ("\0" x 10), ("\0" x 10), ], [ 10, 4, $fill . "\e[2;3r\e[2;4H\e[LAbC", # 25: DECSTBM IL 1 "0123456789", ("\0" x 3) . "AbC" . ("\0" x 4), "1234567890", "3456789012", ], [ 10, 4, $fill . "\e[2;3r\e[2;4H\e[2LAbC", # 26: DECSTBM IL 2 "0123456789", ("\0" x 3) . "AbC" . ("\0" x 4), ("\0" x 10), "3456789012", ], [ 10, 4, $fill . "\e[2;3r\e[2;4H\e[9LAbC", # 27: DECSTBM IL 3 "0123456789", ("\0" x 3) . "AbC" . ("\0" x 4), ("\0" x 10), "3456789012", ], [ 10, 4, $fill . "\e[2;3r\e[1;1H\e[2LAbC", # 28: DECSTBM IL 4 "AbC" . ("\0" x 7), "1234567890", "2345678901", "3456789012", ], [ 10, 4, $fill . "\e[2;3r\e[2;4H\e[MAbC", # 29: DECSTBM DL 1 "0123456789", "234AbC8901", ("\0" x 10), "3456789012", ], [ 10, 4, $fill . "\e[2;3r\e[2;4H\e[2MAbC", # 30: DECSTBM DL 2 "0123456789", ("\0" x 3) . "AbC" . ("\0" x 4), ("\0" x 10), "3456789012", ], [ 10, 4, $fill . "\e[2;3r\e[2;4H\e[9MAbC", # 31: DECSTBM DL 3 "0123456789", ("\0" x 3) . "AbC" . ("\0" x 4), ("\0" x 10), "3456789012", ], [ 10, 4, $fill . "\e[2;3r\e[1;1H\e[2MAbC", # 32: DECSTBM DL 4 "AbC" . ("\0" x 7), "1234567890", "2345678901", "3456789012", ], )]); # EOF Term-VT102-0.91/t/14-tabstop.t0000644000076400007640000000355111102334215013256 0ustar awaw#!/usr/bin/perl -w # # Make sure the VT102 module can handle tabs and tab stops. # # Copyright (C) Andrew Wood # NO WARRANTY - see COPYING. # require Term::VT102; require 't/testbase'; my $tabs = "a\tb\tc\td\te\tf\tg\th\ti\tj\tk"; run_tests ([( [ 80, 9, "Line 1\r". $tabs ."\r\nLine 2\e[3g\r\nLine 3\r" . $tabs . "\r\n" . "Line 4\e[3g\e[9G\eHt\e[17G\eHt\e[25G\eHt\e[33G\eHt\e[41G\eHt\e[49G\eHt\e[57G\eHt\e[65G\eHt\e[73G\eHt\r\n" . "Line 5\r" . $tabs . "\r\n" . "Line 6\e[17G\e[gT\r" . $tabs . "\r\n" . "Line 7\e[3g\e[5G\eHt\e[10G\eHt\e[15G\eHt\e[20G\eHt\r\n" . "Line 8\r" . $tabs . "\r\n", "aine 1\0\0b\0\0\0\0\0\0\0c\0\0\0\0\0\0\0d\0\0\0\0\0\0\0e\0\0\0\0\0\0\0f\0\0\0\0\0\0\0g\0\0\0\0\0\0\0h\0\0\0\0\0\0\0i\0\0\0\0\0\0\0j\0\0\0\0\0\0k", "Line 2\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0", "aine 3\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0k", "Line 4\0\0t\0\0\0\0\0\0\0t\0\0\0\0\0\0\0t\0\0\0\0\0\0\0t\0\0\0\0\0\0\0t\0\0\0\0\0\0\0t\0\0\0\0\0\0\0t\0\0\0\0\0\0\0t\0\0\0\0\0\0\0t\0\0\0\0\0\0\0", "aine 5\0\0b\0\0\0\0\0\0\0c\0\0\0\0\0\0\0d\0\0\0\0\0\0\0e\0\0\0\0\0\0\0f\0\0\0\0\0\0\0g\0\0\0\0\0\0\0h\0\0\0\0\0\0\0i\0\0\0\0\0\0\0j\0\0\0\0\0\0k", "aine 6\0\0b\0\0\0\0\0\0\0T\0\0\0\0\0\0\0c\0\0\0\0\0\0\0d\0\0\0\0\0\0\0e\0\0\0\0\0\0\0f\0\0\0\0\0\0\0g\0\0\0\0\0\0\0h\0\0\0\0\0\0\0i\0\0\0\0\0\0k", "Linet7\0\0\0t\0\0\0\0t\0\0\0\0t\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0", "aineb8\0\0\0c\0\0\0\0d\0\0\0\0e\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0k", "\0" x 80 ] )]); # EOF Term-VT102-0.91/t/01-load.t0000644000076400007640000000051311102154072012511 0ustar awaw#!/usr/bin/perl -w # # Make sure the VT102 module loads OK and can return its version number. # # Copyright (C) Andrew Wood # NO WARRANTY - see COPYING. # BEGIN { print "1..1\n"; } require Term::VT102; my $vt = Term::VT102->new ('cols' => 80, 'rows' => 25); print "Version: " . $vt->version () . "\n"; print "ok 1\n"; # EOF Term-VT102-0.91/t/03-text.t0000644000076400007640000000151711102154072012565 0ustar awaw#!/usr/bin/perl -w # # Make sure the VT102 module can process basic text OK. # # Copyright (C) Andrew Wood # NO WARRANTY - see COPYING. # require Term::VT102; require 't/testbase'; run_tests ([( [ 10, 5, "line 1\r\n line 2\r\n line 3\r\nline 4", "line 1" . ("\0" x 4), " line 2" . ("\0" x 2), " line 3" . ("\0" x 2), "line 4" . ("\0" x 4), ], [ 80, 25, " line 1 \n line 2\n line 3\n line 4 ", " line 1 " . ("\0" x 72), ("\0" x 8) . " line 2" . ("\0" x 62), ("\0" x 18) . " line 3" . ("\0" x 52), ("\0" x 28) . " line 4 " . ("\0" x 44), ], [ 40, 5, "line 1\ttab 1\r\n line 2\ttab 2\ttab 3\r\n line 3\r\nline 4", "line 1\0\0tab 1" . ("\0" x 27), " line 2\0\0\0\0\0\0\0\0tab 2\0\0\0tab 3" . ("\0" x 11), " line 3" . ("\0" x 32), "line 4" . ("\0" x 34), ], )]); # EOF Term-VT102-0.91/t/08-options.t0000644000076400007640000000101311102154072013270 0ustar awaw#!/usr/bin/perl -w # # Make sure the VT102 module's option settings work. # # Copyright (C) Andrew Wood # NO WARRANTY - see COPYING. # require Term::VT102; require 't/testbase'; run_tests ([( [ { 'LFTOCRLF' => 1 }, 10, 5, "line 1\n line 2\n line 3\nline 4", "line 1" . ("\0" x 4), " line 2" . ("\0" x 2), " line 3" . ("\0" x 2), "line 4" . ("\0" x 4), ], [ { 'LINEWRAP' => 1 }, 10, 5, "abcdefghijklmnopqrstuvwxyz", "abcdefghij", "klmnopqrst", "uvwxyz" . ("\0" x 4), ], )]); # EOF Term-VT102-0.91/MANIFEST0000644000076400007640000000070211102367657012074 0ustar awawCOPYING Changes INSTALL MANIFEST Makefile.PL README TODO VT102.pm VT102/examples/sanitize-dump.pl VT102/examples/ssh-usage.pl VT102/examples/telnet-usage.pl t/01-load.t t/02-setsize.t t/03-text.t t/04-cursor.t t/05-scrolling.t t/06-insdel.t t/07-colour.t t/08-options.t t/09-callback.t t/10-decaln.t t/11-decscrc.t t/12-cupsvrs.t t/13-xonxoff.t t/14-tabstop.t t/testbase META.yml Module meta-data (added by MakeMaker) Term-VT102-0.91/VT102/0000700000076400007640000000000011105652417011500 5ustar awawTerm-VT102-0.91/VT102/examples/0000700000076400007640000000000011105652417013316 5ustar awawTerm-VT102-0.91/VT102/examples/ssh-usage.pl0000644000076400007640000001432111102357235015562 0ustar awaw;#!/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 Term-VT102-0.91/VT102/examples/sanitize-dump.pl0000644000076400007640000000301611102367551016455 0ustar awaw;#!/usr/bin/perl # # Example script that sanitizes a log file, such as that created by # screen(1) or script(1) (or even one of Term::VT102's other example # scripts). # # Any cursor positioning and other control codes are removed, leaving only # complete lines of text, optionally including ANSI/ECMA-48 colour and # attribute change sequences. # # Arguments are [colour|plain] - if nothing is provided, # the default is to assume an 80x24 terminal with colour output. # # Data is read from standard input and written to standard output. # use Term::VT102; use strict; my ($width, $height, $colour) = @ARGV; $width = 80 if ((not defined $width) || ($width !~ /^\d+$/)); $height = 24 if ((not defined $height) || ($height !~ /^\d+$/)); $colour = (defined $colour && $colour !~ /^(colour|color)$/) ? 0 : 1; my $vt = Term::VT102->new ('cols' => $width, 'rows' => $height); $vt->option_set ('LFTOCRLF', 1); $vt->option_set ('LINEWRAP', 1); $vt->callback_set ('GOTO', \&vt_callback, $colour); $vt->callback_set ('LINEFEED', \&vt_callback, $colour); while () { $vt->process ($_); } sub vt_callback { my ($vtobject, $type, $arg1, $arg2, $private) = @_; if ($type eq 'GOTO') { $arg2 = $vtobject->rows if ($arg2 > $vtobject->rows); return if ($arg2 <= $vtobject->y); for (my $y = $vtobject->y; $y < $arg2; $y++) { print "\n"; } } elsif ($type eq 'LINEFEED') { my $line = $private ? $vtobject->row_sgrtext ($arg1) : $vtobject->row_plaintext ($arg1); $line =~ s/\s+$//; print '' . $line . "\n"; } } # EOF Term-VT102-0.91/VT102/examples/telnet-usage.pl0000644000076400007640000001320211102355204016247 0ustar awaw#!/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 Term-VT102-0.91/Changes0000644000076400007640000000321511105651761012233 0ustar awawChanges that have been made over time: 0.91 - 9 November 2008 - patch from Joerg Walter to fix Unicode handling - minor escape sequence processing cleanup - properly ignore / process sequences ending in ESC \ - new callback STRING for receiving strings from the above - new method to return row text with SGR colour/attributes - fixed line wrapping to wrap AFTER last column filled - implemented tab stops - added example script that strips control codes from log files - new GOTO and LINEFEED callbacks 0.82 - 29 September 2004 - added example script showing how to use Term::VT102 with SSH - minor undef warning fix in SM/RM handling 0.80 - 25 April 2004 - implemented XON/XOFF and added new option IGNOREXOFF 0.79 - 9 December 2003 - documentation additions - investigated bug reported by Paul Stoddard - very minor code cleanups 0.78 - 13 December 2002 - partial implementation of SM/RM - DECTCEM (cursor on/off) 0.77 - 27 November 2002 - implemented DECSC/DECRC (state save/restore) - implemented CUPSV/CUPRS (cursor position save/restore) 0.75 - 4 August 2002 - corrected attribute behaviour when lines inserted/deleted/scrolled - example script showing how to use Term::VT102 with Net::Telnet - added optional column params to row_attr(), row_text(), row_plaintext() - implemented DECALN 0.74 - 29 April 2002 - imported into CVS - directory structure flattened (no more pointless lib/Term directory) - created files TODO and Changes - code formatting changes (i.e. use TABs for indent, spaces for formatting) - fixed silly TAB handling problem - no longer write spaces when TABbing 0.73 - 2 November 2001 Term-VT102-0.91/Makefile.PL0000644000076400007640000000052311102154072012677 0ustar awaw#!/usr/bin/perl -w # # Call MakeMaker and get it to build the Makefile. # use lib "lib"; use ExtUtils::MakeMaker; use strict; WriteMakefile ( 'NAME' => 'Term::VT102', 'VERSION_FROM' => 'VT102.pm', 'ABSTRACT' => 'emulate a DEC VT102 terminal', 'AUTHOR' => 'Andrew Wood ' ); # EOF Term-VT102-0.91/VT102.pm0000644000076400007640000021607511102370125012051 0ustar awaw# Term::VT102 - module for VT102 emulation in Perl # # Copyright (C) Andrew Wood # NO WARRANTY - see COPYING. # package Term::VT102; use strict; BEGIN { use Exporter (); use vars qw($VERSION @ISA); $VERSION = '0.91'; @ISA = qw(Exporter); } # Return the packed version of a set of attributes fg, bg, bo, fa, st, ul, # bl, rv. # sub attr_pack { shift if ref($_[0]); # called in object context, ditch the object my ($fg, $bg, $bo, $fa, $st, $ul, $bl, $rv) = @_; my $num = 0; $num = ($fg & 7) | (($bg & 7) << 4) | ($bo << 8) | ($fa << 9) | ($st << 10) | ($ul << 11) | ($bl << 12) | ($rv << 13); return pack ('S', $num); } # Return the unpacked version of a packed attribute. # sub attr_unpack { shift if ref($_[0]); # called in object context, ditch the object my $data = shift; my ($num, $fg, $bg, $bo, $fa, $st, $ul, $bl, $rv); $num = unpack ('S', $data); ($fg, $bg, $bo, $fa, $st, $ul, $bl, $rv) = ( $num & 7, ($num >> 4) & 7, ($num >> 8) & 1, ($num >> 9) & 1, ($num >> 10) & 1, ($num >> 11) & 1, ($num >> 12) & 1, ($num >> 13) & 1 ); return ($fg, $bg, $bo, $fa, $st, $ul, $bl, $rv); } # Default attribute set (in both packed and unpacked flavors) # use constant DEFAULT_ATTR => (7, 0, 0, 0, 0, 0, 0, 0); use constant DEFAULT_ATTR_PACKED => attr_pack(&DEFAULT_ATTR); # Constructor function. # sub new { my ($proto, %init) = @_; my $class = ref ($proto) || $proto; my $self = {}; $self->{'_ctlseq'} = { ( # control characters "\000" => 'NUL', # ignored "\005" => 'ENQ', # trigger answerback message "\007" => 'BEL', # beep "\010" => 'BS', # backspace one column "\011" => 'HT', # horizontal tab to next tab stop "\012" => 'LF', # line feed "\013" => 'VT', # line feed "\014" => 'FF', # line feed "\015" => 'CR', # carriage return "\016" => 'SO', # activate G1 character set & newline "\017" => 'SI', # activate G0 character set "\021" => 'XON', # resume transmission "\023" => 'XOFF', # stop transmission, ignore characters "\030" => 'CAN', # interrupt escape sequence "\032" => 'SUB', # interrupt escape sequence "\033" => 'ESC', # start escape sequence "\177" => 'DEL', # ignored "\233" => 'CSI' # equivalent to ESC [ ) }; $self->{'_escseq'} = { ( # escape sequences 'c' => 'RIS', # reset 'D' => 'IND', # line feed 'E' => 'NEL', # newline 'H' => 'HTS', # set tab stop at current column 'M' => 'RI', # reverse line feed 'Z' => 'DECID', # DEC private ID; return ESC [ ? 6 c (VT102) '7' => 'DECSC', # save state (position, charset, attributes) '8' => 'DECRC', # restore most recently saved state '[' => 'CSI', # control sequence introducer '[[' => 'IGN', # ignored control sequence '%@' => 'CSDFL', # select default charset (ISO646/8859-1) '%G' => 'CSUTF8', # select UTF-8 '%8' => 'CSUTF8', # select UTF-8 (obsolete) '#8' => 'DECALN', # DEC alignment test - fill screen with E's '(8' => 'G0DFL', # G0 charset = default mapping (ISO8859-1) '(0' => 'G0GFX', # G0 charset = VT100 graphics mapping '(U' => 'G0ROM', # G0 charset = null mapping (straight to ROM) '(K' => 'G0USR', # G0 charset = user defined mapping '(B' => 'G0TXT', # G0 charset = ASCII mapping ')8' => 'G1DFL', # G1 charset = default mapping (ISO8859-1) ')0' => 'G1GFX', # G1 charset = VT100 graphics mapping ')U' => 'G1ROM', # G1 charset = null mapping (straight to ROM) ')K' => 'G1USR', # G1 charset = user defined mapping ')B' => 'G1TXT', # G1 charset = ASCII mapping '*8' => 'G2DFL', # G2 charset = default mapping (ISO8859-1) '*0' => 'G2GFX', # G2 charset = VT100 graphics mapping '*U' => 'G2ROM', # G2 charset = null mapping (straight to ROM) '*K' => 'G2USR', # G2 charset = user defined mapping '+8' => 'G3DFL', # G3 charset = default mapping (ISO8859-1) '+0' => 'G3GFX', # G3 charset = VT100 graphics mapping '+U' => 'G3ROM', # G3 charset = null mapping (straight to ROM) '+K' => 'G3USR', # G3 charset = user defined mapping '>' => 'DECPNM', # set numeric keypad mode '=' => 'DECPAM', # set application keypad mode 'N' => 'SS2', # select G2 charset for next char only 'O' => 'SS3', # select G3 charset for next char only 'P' => 'DCS', # device control string (ended by ST) 'X' => 'SOS', # start of string '^' => 'PM', # privacy message (ended by ST) '_' => 'APC', # application program command (ended by ST) "\\" => 'ST', # string terminator 'n' => 'LS2', # invoke G2 charset 'o' => 'LS3', # invoke G3 charset '|' => 'LS3R', # invoke G3 charset as GR '}' => 'LS2R', # invoke G2 charset as GR '~' => 'LS1R', # invoke G1 charset as GR ']' => 'OSC', # operating system command 'g' => 'BEL', # alternate BEL ) }; $self->{'_csiseq'} = { ( # ECMA-48 CSI sequences '[' => 'IGN', # ignored control sequence '@' => 'ICH', # insert blank characters 'A' => 'CUU', # move cursor up 'B' => 'CUD', # move cursor down 'C' => 'CUF', # move cursor right 'D' => 'CUB', # move cursor left 'E' => 'CNL', # move cursor down and to column 1 'F' => 'CPL', # move cursor up and to column 1 'G' => 'CHA', # move cursor to column in current row 'H' => 'CUP', # move cursor to row, column 'J' => 'ED', # erase display 'K' => 'EL', # erase line 'L' => 'IL', # insert blank lines 'M' => 'DL', # delete lines 'P' => 'DCH', # delete characters on current line 'X' => 'ECH', # erase characters on current line 'a' => 'HPR', # move cursor right 'c' => 'DA', # return ESC [ ? 6 c (VT102) 'd' => 'VPA', # move to row (current column) 'e' => 'VPR', # move cursor down 'f' => 'HVP', # move cursor to row, column 'g' => 'TBC', # clear tab stop (CSI 3 g = clear all stops) 'h' => 'SM', # set mode 'l' => 'RM', # reset mode 'm' => 'SGR', # set graphic rendition 'n' => 'DSR', # device status report 'q' => 'DECLL', # set keyboard LEDs 'r' => 'DECSTBM', # set scrolling region to (top, bottom) rows 's' => 'CUPSV', # save cursor position 'u' => 'CUPRS', # restore cursor position '`' => 'HPA' # move cursor to column in current row ) }; $self->{'_modeseq'} = { ( # ANSI/DEC specified modes for SM/RM # ANSI Specified Modes '0' => 'IGN', # Error (Ignored) '1' => 'GATM', # guarded-area transfer mode (ignored) '2' => 'KAM', # keyboard action mode (always reset) '3' => 'CRM', # control representation mode (always reset) '4' => 'IRM', # insertion/replacement mode (always reset) '5' => 'SRTM', # status-reporting transfer mode '6' => 'ERM', # erasure mode (always set) '7' => 'VEM', # vertical editing mode (ignored) '10' => 'HEM', # horizontal editing mode '11' => 'PUM', # positioning unit mode '12' => 'SRM', # send/receive mode (echo on/off) '13' => 'FEAM', # format effector action mode '14' => 'FETM', # format effector transfer mode '15' => 'MATM', # multiple area transfer mode '16' => 'TTM', # transfer termination mode '17' => 'SATM', # selected area transfer mode '18' => 'TSM', # tabulation stop mode '19' => 'EBM', # editing boundary mode '20' => 'LNM', # Line Feed / New Line Mode # DEC Private Modes '?0' => 'IGN', # Error (Ignored) '?1' => 'DECCKM', # Cursorkeys application (set); Cursorkeys normal (reset) '?2' => 'DECANM', # ANSI (set); VT52 (reset) '?3' => 'DECCOLM', # 132 columns (set); 80 columns (reset) '?4' => 'DECSCLM', # Jump scroll (set); Smooth scroll (reset) '?5' => 'DECSCNM', # Reverse screen (set); Normal screen (reset) '?6' => 'DECOM', # Sets relative coordinates (set); Sets absolute coordinates (reset) '?7' => 'DECAWM', # Auto Wrap '?8' => 'DECARM', # Auto Repeat '?9' => 'DECINLM', # Interlace '?18' => 'DECPFF', # Send FF to printer after print screen (set); No char after PS (reset) '?19' => 'DECPEX', # Print screen: prints full screen (set); prints scroll region (reset) '?25' => 'DECTCEM', # Cursor on (set); Cursor off (reset) ) }; $self->{'_funcs'} = { ( # supported character sequences 'BS' => \&_code_BS, # backspace one column 'CR' => \&_code_CR, # carriage return 'DA' => \&_code_DA, # return ESC [ ? 6 c (VT102) 'DL' => \&_code_DL, # delete lines 'ED' => \&_code_ED, # erase display 'EL' => \&_code_EL, # erase line 'FF' => \&_code_LF, # line feed 'HT' => \&_code_HT, # horizontal tab to next tab stop 'IL' => \&_code_IL, # insert blank lines 'LF' => \&_code_LF, # line feed 'PM' => \&_code_PM, # privacy message (ended by ST) 'RI' => \&_code_RI, # reverse line feed 'RM' => \&_code_RM, # reset mode 'SI' => undef, # activate G0 character set 'SM' => \&_code_SM, # set mode 'SO' => undef, # activate G1 character set & CR 'ST' => undef, # string terminator 'VT' => \&_code_LF, # line feed 'APC' => \&_code_APC, # application program command (ended by ST) 'BEL' => \&_code_BEL, # beep 'CAN' => \&_code_CAN, # interrupt escape sequence 'CHA' => \&_code_CHA, # move cursor to column in current row 'CNL' => \&_code_CNL, # move cursor down and to column 1 'CPL' => \&_code_CPL, # move cursor up and to column 1 'CRM' => undef, # control representation mode 'CSI' => \&_code_CSI, # equivalent to ESC [ 'CUB' => \&_code_CUB, # move cursor left 'CUD' => \&_code_CUD, # move cursor down 'CUF' => \&_code_CUF, # move cursor right 'CUP' => \&_code_CUP, # move cursor to row, column 'CUU' => \&_code_CUU, # move cursor up 'DCH' => \&_code_DCH, # delete characters on current line 'DCS' => \&_code_DCS, # device control string (ended by ST) 'DEL' => \&_code_IGN, # ignored 'DSR' => \&_code_DSR, # device status report 'EBM' => undef, # editing boundary mode 'ECH' => \&_code_ECH, # erase characters on current line 'ENQ' => undef, # trigger answerback message 'ERM' => undef, # erasure mode 'ESC' => \&_code_ESC, # start escape sequence 'HEM' => undef, # horizontal editing mode 'HPA' => \&_code_CHA, # move cursor to column in current row 'HPR' => \&_code_CUF, # move cursor right 'HTS' => \&_code_HTS, # set tab stop at current column 'HVP' => \&_code_CUP, # move cursor to row, column 'ICH' => \&_code_ICH, # insert blank characters 'IGN' => \&_code_IGN, # ignored control sequence 'IND' => \&_code_LF, # line feed 'IRM' => undef, # insert/replace mode 'KAM' => undef, # keyboard action mode 'LNM' => undef, # line feed / newline mode 'LS2' => undef, # invoke G2 charset 'LS3' => undef, # invoke G3 charset 'NEL' => \&_code_NEL, # newline 'NUL' => \&_code_IGN, # ignored 'OSC' => \&_code_OSC, # operating system command 'PUM' => undef, # positioning unit mode 'RIS' => \&_code_RIS, # reset 'SGR' => \&_code_SGR, # set graphic rendition 'SOS' => undef, # start of string 'SRM' => undef, # send/receive mode (echo on/off) 'SS2' => undef, # select G2 charset for next char only 'SS3' => undef, # select G3 charset for next char only 'SUB' => \&_code_CAN, # interrupt escape sequence 'TBC' => \&_code_TBC, # clear tab stop (CSI 3 g = clear all stops) 'TSM' => undef, # tabulation stop mode 'TTM' => undef, # transfer termination mode 'VEM' => undef, # vertical editing mode 'VPA' => \&_code_VPA, # move to row (current column) 'VPR' => \&_code_CUD, # move cursor down 'XON' => \&_code_XON, # resume transmission 'FEAM' => undef, # format effector action mode 'FETM' => undef, # format effector transfer mode 'GATM' => undef, # guarded-area transfer mode 'LS1R' => undef, # invoke G1 charset as GR 'LS2R' => undef, # invoke G2 charset as GR 'LS3R' => undef, # invoke G3 charset as GR 'MATM' => undef, # multiple area transfer mode 'SATM' => undef, # selected area transfer mode 'SRTM' => undef, # status-reporting transfer mode 'XOFF' => \&_code_XOFF, # stop transmission, ignore characters 'CSDFL' => undef, # select default charset (ISO646/8859-1) 'CUPRS' => \&_code_CUPRS, # restore cursor position 'CUPSV' => \&_code_CUPSV, # save cursor position 'DECID' => \&_code_DA, # DEC private ID; return ESC [ ? 6 c (VT102) 'DECLL' => undef, # set keyboard LEDs 'DECOM' => undef, # relative/absolute coordinate mode 'DECRC' => \&_code_DECRC, # restore most recently saved state 'DECSC' => \&_code_DECSC, # save state (position, charset, attributes) 'G0DFL' => undef, # G0 charset = default mapping (ISO8859-1) 'G0GFX' => undef, # G0 charset = VT100 graphics mapping 'G0ROM' => undef, # G0 charset = null mapping (straight to ROM) 'G0TXT' => undef, # G0 charset = ASCII mapping 'G0USR' => undef, # G0 charset = user defined mapping 'G1DFL' => undef, # G1 charset = default mapping (ISO8859-1) 'G1GFX' => undef, # G1 charset = VT100 graphics mapping 'G1ROM' => undef, # G1 charset = null mapping (straight to ROM) 'G1TXT' => undef, # G1 charset = ASCII mapping 'G1USR' => undef, # G1 charset = user defined mapping 'G2DFL' => undef, # G2 charset = default mapping (ISO8859-1) 'G2GFX' => undef, # G2 charset = VT100 graphics mapping 'G2ROM' => undef, # G2 charset = null mapping (straight to ROM) 'G2USR' => undef, # G2 charset = user defined mapping 'G3DFL' => undef, # G3 charset = default mapping (ISO8859-1) 'G3GFX' => undef, # G3 charset = VT100 graphics mapping 'G3ROM' => undef, # G3 charset = null mapping (straight to ROM) 'G3USR' => undef, # G3 charset = user defined mapping 'CSUTF8' => undef, # select UTF-8 (obsolete) 'DECALN' => \&_code_DECALN,# DEC alignment test - fill screen with E's 'DECANM' => undef, # ANSI/VT52 mode 'DECARM' => undef, # auto repeat mode 'DECAWM' => undef, # auto wrap mode 'DECCKM' => undef, # cursor key mode 'DECPAM' => undef, # set application keypad mode 'DECPEX' => undef, # print screen / scrolling region 'DECPFF' => undef, # sent FF after print screen, or not 'DECPNM' => undef, # set numeric keypad mode 'DECCOLM' => undef, # 132 column mode 'DECINLM' => undef, # interlace mode 'DECSCLM' => undef, # jump/smooth scroll mode 'DECSCNM' => undef, # reverse/normal screen mode 'DECSTBM' => \&_code_DECSTBM, # set scrolling region 'DECTCEM' => \&_code_DECTCEM, # Cursor on (set); Cursor off (reset) ) }; $self->{'_callbacks'} = { ( # available callbacks 'BELL' => undef, # bell character received 'CLEAR' => undef, # screen cleared 'OUTPUT' => undef, # data to be sent back to originator 'ROWCHANGE' => undef, # screen row changed 'SCROLL_DOWN' => undef, # text about to move up (par=top row) 'SCROLL_UP' => undef, # text about to move down (par=bott.) 'UNKNOWN' => undef, # unknown character / sequence 'STRING' => undef, # string received 'XICONNAME' => undef, # xterm icon name changed 'XWINTITLE' => undef, # xterm window title changed 'LINEFEED' => undef, # line feed about to be processed ) }; $self->{'_callbackarg'} = { () }; # stored arguments for callbacks $self->{'_decsc'} = [ () ]; # saved state for DECSC/DECRC $self->{'_cupsv'} = [ () ]; # saved state for CUPSV/CUPRS $self->{'_xon'} = 1; # state is XON (characters accepted) $self->{'cols'} = 80; # default: 80 columns $self->{'rows'} = 24; # default: 24 rows $self->{'_tabstops'} = []; # tab stops $self->{'cols'} = $init{'cols'} if ((defined $init{'cols'}) && ($init{'cols'} > 0)); $self->{'rows'} = $init{'rows'} if ((defined $init{'rows'}) && ($init{'rows'} > 0)); bless ($self, $class); $self->reset (); return $self; } # Call a callback function with the given parameters. # sub callback_call { my ($self, $callback, $par1, $par2) = (@_); my ($func, $arg); $func = $self->{'_callbacks'}->{$callback}; return if (not defined $func); $arg = $self->{'_callbackarg'}->{$callback}; &{$func} ($self, $callback, $par1, $par2, $arg); } # Set a callback function. # sub callback_set { my ($self, $callback, $ref, $arg) = (@_); $self->{'_callbacks'}->{$callback} = $ref; $self->{'_callbackarg'}->{$callback} = $arg; } # Reset the terminal to "power-on" values. # sub reset { my $self = shift; my ($a, $b, $i); $self->{'x'} = 1; # default X position: 1 $self->{'y'} = 1; # default Y position: 1 $self->{'attr'} = DEFAULT_ATTR_PACKED; $self->{'ti'} = ''; # default: blank window title $self->{'ic'} = ''; # default: blank icon title $self->{'srt'} = 1; # scrolling region top: row 1 $self->{'srb'} = $self->{'rows'}; # scrolling region bottom $self->{'opts'} = {}; # blank all options $self->{'opts'}->{'LINEWRAP'} = 0; # line wrapping off $self->{'opts'}->{'LFTOCRLF'} = 0; # don't map LF -> CRLF $self->{'opts'}->{'IGNOREXOFF'} = 1; # ignore XON/XOFF by default $self->{'scrt'} = [ () ]; # blank screen text $self->{'scra'} = [ () ]; # blank screen attributes $a = "\000" x $self->{'cols'}; # set text to NUL $b = $self->{'attr'} x $self->{'cols'}; # set attributes to default foreach $i (1 .. $self->{'rows'}) { ($self->{'scrt'}->[$i], $self->{'scra'}->[$i]) = ($a, $b); } $self->{'_tabstops'} = []; # reset tab stops for ($i = 1; $i < $self->{'cols'}; $i += 8) { $self->{'_tabstops'}->[$i] = 1; } $self->{'_buf'} = undef; # blank the esc-sequence buffer $self->{'_inesc'} = ''; # not in any escape sequence $self->{'_xon'} = 1; # state is XON (chars accepted) $self->{'cursor'} = 1; # turn cursor on } # Resize the terminal. # sub resize { my $self = shift; my $cols = shift; my $rows = shift; $self->callback_call ('CLEAR', 0, 0); $self->{'cols'} = $cols; $self->{'rows'} = $rows; $self->reset (); } # Return the package version. # sub version { return $VERSION; } # Return the current number of columns. # sub cols { my $self = shift; return $self->{'cols'}; } # Return the current number of rows. # sub rows { my $self = shift; return $self->{'rows'}; } # Return the current terminal size. # sub size { my $self = shift; return ( $self->{'cols'}, $self->{'rows'} ); } # Return the current cursor X co-ordinate. # sub x { my $self = shift; return $self->{'x'}; } # Return the current cursor Y co-ordinate. # sub y { my $self = shift; return $self->{'y'}; } # Return the current cursor state (1=on, 0=off). # sub cursor { my $self = shift; return $self->{'cursor'}; } # Return the current xterm title text. # sub xtitle { my $self = shift; return $self->{'ti'}; } # Return the current xterm icon text. # sub xicon { my $self = shift; return $self->{'ic'}; } # Return the current terminal status. # sub status { my $self = shift; return ( $self->{'x'}, # cursor X position $self->{'y'}, # cursor Y position $self->{'attr'}, # packed attributes $self->{'ti'}, # xterm title text $self->{'ic'} # xterm icon text ); } # Process the given string, updating the terminal object and calling any # necessary callbacks on the way. # sub process { my $self = shift; my ($string) = @_; return if (not defined $string); while (length $string > 0) { if (defined $self->{'_buf'}) { # in escape sequence if ($string =~ s/^(.)//s) { my $ch = $1; if ($ch =~ /[\x00-\x1F]/s) { $self->_process_ctl ($ch); } else { $self->{'_buf'} .= $ch; $self->_process_escseq (); } } } else { # not in escape sequence if ($string =~ s/^([^\x00-\x1F\x7F\x9B]+)//s) { $self->_process_text ($1); } elsif ($string =~ s/^(.)//s) { $self->_process_ctl ($1); } } } } # Return the current value of the given option, or undef if it doesn't exist. # sub option_read { my $self = shift; my ($option) = @_; return undef if (not defined $option); return $self->{'opts'}->{$option}; } # Set the value of the given option to the given value, returning the old # value or undef if an invalid option was given. # sub option_set { my $self = shift; my ($option, $value) = @_; my $prev; return undef if (not defined $option); return undef if (not defined $value); return undef if (not defined $self->{'opts'}->{$option}); $prev = $self->{'opts'}->{$option}; $self->{'opts'}->{$option} = $value; return $prev; } # Return the attributes of the given row, or undef if out of range. # sub row_attr { my $self = shift; my ($row, $startcol, $endcol) = @_; my ($data); return undef if ($row < 1); return undef if ($row > $self->{'rows'}); $data = $self->{'scra'}->[$row]; if (defined $startcol && defined $endcol) { $data = substr ( $data, ($startcol - 1) * 2, (($endcol - $startcol) + 1) * 2 ); } return $data; } # Return the textual contents of the given row, or undef if out of range. # sub row_text { my $self = shift; my ($row, $startcol, $endcol) = @_; my $text; return undef if ($row < 1); return undef if ($row > $self->{'rows'}); $text = $self->{'scrt'}->[$row]; if (defined $startcol && defined $endcol) { $text = substr ( $text, $startcol - 1, ($endcol - $startcol) + 1 ); } return $text; } # Return the textual contents of the given row, or undef if out of range, # with unused characters represented as a space instead of \0. # sub row_plaintext { my $self = shift; my ($row, $startcol, $endcol) = @_; my $text; return undef if ($row < 1); return undef if ($row > $self->{'rows'}); $text = $self->{'scrt'}->[$row]; $text =~ s/\0/ /g; if (defined $startcol && defined $endcol) { $text = substr ( $text, $startcol - 1, ($endcol - $startcol) + 1 ); } return $text; } # Return a set of SGR escape sequences that will change colours and # attributes from "source" to "dest" (packed attributes). # sub sgr_change { shift if ref($_[0]); my ($source, $dest) = @_; my ($out, %off, %on) = ('', (), ()); $source = DEFAULT_ATTR_PACKED if (not defined $source); $dest = DEFAULT_ATTR_PACKED if (not defined $dest); return '' if ($source eq $dest); return "\e[m" if ($dest eq DEFAULT_ATTR_PACKED); my ($sfg, $sbg, $sbo, $sfa, $sst, $sul, $sbl, $srv) = attr_unpack ($source); my ($dfg, $dbg, $dbo, $dfa, $dst, $dul, $dbl, $drv) = attr_unpack ($dest); if (($sfg != $dfg) || ($sbg != $dbg)) { $out .= sprintf ("\e[m\e[3%d;4%dm", $dfg, $dbg); ($sbo, $sfa, $sst, $sul, $sbl, $srv) = (0, 0, 0, 0, 0, 0); } if (($sbo > $dbo) || ($sfa > $dfa)) { $off{'22'} = 1; ($sbo, $sfa) = (0, 0); } $off{'24'} = 1 if ($sul > $dul); $off{'25'} = 1 if ($sbl > $dbl); $off{'27'} = 1 if ($srv > $drv); if (scalar keys %off > 2) { $out .= "\e[m"; ($sbo, $sfa, $sst, $sul, $sbl, $srv) = (0, 0, 0, 0, 0, 0); } elsif (scalar keys %off > 0) { $out .= "\e[" . join (';', keys %off) . "m"; } $on{'1'} = 1 if ($dbo > $sbo); $on{'2'} = 1 if (($dfa > $sfa) && !($dbo > $sbo)); $on{'4'} = 1 if ($dul > $sul); $on{'5'} = 1 if ($dbl > $sbl); $on{'7'} = 1 if ($drv > $srv); $out .= "\e[" . join (';', keys %on) . "m" if (scalar keys %on > 0); return $out; } # Return the textual contents of the given row, or undef if out of range, # with unused characters represented as a space instead of \0, and any # colour or attribute changes expressed by the relevant SGR escape # sequences. # sub row_sgrtext { my ($self, $row, $startcol, $endcol) = @_; my ($row_text, $row_attr, $text, $char, $attr_cur, $attr_next); return undef if ($row < 1); return undef if ($row > $self->{'rows'}); $startcol = 1 if (not defined $startcol); $endcol = $self->{'cols'} if (not defined $endcol); return undef if (($startcol < 1) || ($startcol > $self->{'cols'})); return undef if (($endcol < 1) || ($endcol > $self->{'cols'})); return undef if ($endcol < $startcol); $row_text = $self->{'scrt'}->[$row]; $row_attr = $self->{'scra'}->[$row]; $text = ''; $attr_cur = DEFAULT_ATTR_PACKED; for (; $startcol <= $endcol; $startcol++) { $char = substr ($row_text, $startcol - 1, 1); $char =~ s/\0/ /g; $char = ' ' if ($char !~ /./); $attr_next = substr ($row_attr, ($startcol - 1) * 2, 2); $text .= $self->sgr_change ($attr_cur, $attr_next) . $char; $attr_cur = $attr_next; } $attr_next = DEFAULT_ATTR_PACKED; $text .= $self->sgr_change ($attr_cur, $attr_next); return $text; } # Process a string of plain text, with no special characters in it. # sub _process_text { my $self = shift; my ($text) = @_; my ($width, $segment); return if ($self->{'_xon'} == 0); $width = ($self->{'cols'} + 1) - $self->{'x'}; if ($self->{'opts'}->{'LINEWRAP'} == 0) { # no line wrap - truncate return if ($width < 1); $text = substr ($text, 0, $width); substr ( $self->{'scrt'}->[$self->{'y'}], $self->{'x'} - 1, length $text ) = $text; substr ( $self->{'scra'}->[$self->{'y'}], 2 * ($self->{'x'} - 1), 2 * (length $text) ) = $self->{'attr'} x (length $text); $self->{'x'} += length $text; $self->{'x'} = $self->{'cols'} if ($self->{'x'} > $self->{'cols'}); $self->callback_call ('ROWCHANGE', $self->{'y'}, 0); return; } while (length $text > 0) { # line wrapping enabled if ($width > 0) { $segment = substr ($text, 0, $width, ''); substr ( $self->{'scrt'}->[$self->{'y'}], $self->{'x'} - 1, length $segment ) = $segment; substr ( $self->{'scra'}->[$self->{'y'}], 2 * ($self->{'x'} - 1), 2 * (length $segment) ) = $self->{'attr'} x (length $segment); $self->{'x'} += length $segment; } else { if ($self->{'x'} > $self->{'cols'}) { # wrap to next line $self->callback_call ('ROWCHANGE', $self->{'y'}, 0); $self->callback_call ('LINEFEED', $self->{'y'}, 0); $self->{'x'} = 1; $self->_move_down; } } $width = ($self->{'cols'} + 1) - $self->{'x'}; } $self->callback_call ('ROWCHANGE', $self->{'y'}, 0); } # Process a control character. # sub _process_ctl { my $self = shift; my $ctl = shift; my ($name, $func); $name = $self->{'_ctlseq'}->{$ctl}; return if (not defined $name); # ignore unknown characters # If we're in XOFF mode, ignore anything other than XON # if ($self->{'_xon'} == 0) { return if ($name ne 'XON'); } $func = $self->{'_funcs'}->{$name}; if (not defined $func) { # do nothing if unsupported $self->callback_call ('UNKNOWN', $name, $ctl); } else { # call handler function &{$func} ($self, $name); } } # Check the escape-sequence buffer, and process it if necessary. # sub _process_escseq { my $self = shift; my ($prefix, $suffix, $func, $name, $dat); my @params; return if (not defined $self->{'_buf'}); return if (length $self->{'_buf'} < 1); return if ($self->{'_xon'} == 0); if ($self->{'_inesc'} eq 'OSC') { # in OSC sequence if ( $self->{'_buf'} =~ /^0;([^\007]*)(?:\007|\033\\)/ ) { # icon & window $dat = $1; $self->callback_call ('XWINTITLE', $dat, 0); $self->callback_call ('XICONNAME', $dat, 0); $self->{'ic'} = $dat; $self->{'ti'} = $dat; $self->{'_buf'} = undef; $self->{'_inesc'} = ''; } elsif ( $self->{'_buf'} =~ /^1;([^\007]*)(?:\007|\033\\)/ ) { # set icon name $dat = $1; $self->callback_call ('XICONNAME', $dat, 0); $self->{'ic'} = $dat; $self->{'_buf'} = undef; $self->{'_inesc'} = ''; } elsif ( $self->{'_buf'} =~ /^2;([^\007]*)(?:\007|\033\\)/ ) { # set window title $dat = $1; $self->callback_call ('XWINTITLE', $dat, 0); $self->{'ti'} = $dat; $self->{'_buf'} = undef; $self->{'_inesc'} = ''; } elsif ( $self->{'_buf'} =~ /^\d+;([^\007]*)(?:\007|\033\\)/ ) { # unknown OSC $self->callback_call ( 'UNKNOWN', 'OSC', "\033]" . $self->{'_buf'} ); $self->{'_buf'} = undef; $self->{'_inesc'} = ''; } elsif ( length $self->{'_buf'} > 1024 ) { # OSC too long $self->callback_call ( 'UNKNOWN', 'OSC', "\033]" . $self->{'_buf'} ); $self->{'_buf'} = undef; $self->{'_inesc'} = ''; } } elsif ($self->{'_inesc'} eq 'CSI') { # in CSI sequence foreach $suffix (keys %{$self->{'_csiseq'}}) { next if (length $self->{'_buf'} < length $suffix); next if ( substr ( $self->{'_buf'}, (length $self->{'_buf'}) - (length $suffix), length $suffix ) ne $suffix ); $self->{'_buf'} = substr ( $self->{'_buf'}, 0, (length $self->{'_buf'}) - (length $suffix) ); $name = $self->{'_csiseq'}->{$suffix}; $func = $self->{'_funcs'}->{$name}; if (not defined $func) { # unsupported sequence $self->callback_call ( 'UNKNOWN', $name, "\033[" . $self->{'_buf'} . $suffix ); $self->{'_buf'} = undef; $self->{'_inesc'} = ''; return; } @params = split (';', $self->{'_buf'}); $self->{'_buf'} = undef; $self->{'_inesc'} = ''; &{$func} ($self, @params); return; } if ( length $self->{'_buf'} > 64 ) { # abort CSI sequence if too long $self->callback_call ( 'UNKNOWN', 'CSI', "\033[" . $self->{'_buf'} ); $self->{'_buf'} = undef; $self->{'_inesc'} = ''; } } elsif ($self->{'_inesc'} =~ /_ST$/) { if ($self->{'_buf'} =~ s/\033\\$//) { $self->{'_inesc'} =~ s/_ST$//; $self->callback_call ( 'STRING', $self->{'_inesc'}, $self->{'_buf'} ); $self->{'_buf'} = undef; $self->{'_inesc'} = ''; $self->{'_buf'} = undef; $self->{'_inesc'} = ''; } elsif ( length $self->{'_buf'} > 1024 ) { # string too long $self->{'_inesc'} =~ s/_ST$//; $self->callback_call ( 'STRING', $self->{'_inesc'}, $self->{'_buf'} ); $self->{'_buf'} = undef; $self->{'_inesc'} = ''; } } else { # in ESC sequence foreach $prefix ( keys %{$self->{'_escseq'}} ) { next if ( substr ($self->{'_buf'}, 0, length $prefix) ne $prefix ); $name = $self->{'_escseq'}->{$prefix}; $func = $self->{'_funcs'}->{$name}; if (not defined $func) { # unsupported sequence $self->callback_call ( 'UNKNOWN', $name, "\033" . $self->{'_buf'} ); $self->{'_buf'} = undef; $self->{'_inesc'} = ''; return; } $self->{'_buf'} = undef; $self->{'_inesc'} = ''; &{$func} ($self); return; } if ( length $self->{'_buf'} > 8 ) { # abort ESC sequence if too long $self->callback_call ( 'UNKNOWN', 'ESC', "\033" . $self->{'_buf'} ); $self->{'_buf'} = undef; $self->{'_inesc'} = ''; } } } # Scroll the scrolling region up such that the text in the scrolling region # moves down, by the given number of lines. # sub _scroll_up { my $self = shift; my $lines = shift; my ($attr, $a, $b, $i); return if ($lines < 1); $self->callback_call ('SCROLL_UP', $self->{'srb'}, $lines); for ($i = $self->{'srb'}; $i >= ($self->{'srt'} + $lines); $i --) { $self->{'scrt'}->[$i] = $self->{'scrt'}->[$i - $lines]; $self->{'scra'}->[$i] = $self->{'scra'}->[$i - $lines]; } $a = "\000" x $self->{'cols'}; # set text to NUL $attr = DEFAULT_ATTR_PACKED; $b = $attr x $self->{'cols'}; # set attributes to default for ( $i = $self->{'srt'}; ($i <= $self->{'srb'}) && ($i < ($self->{'srt'} + $lines)); $i ++ ) { $self->{'scrt'}->[$i] = $a; # blank new lines $self->{'scra'}->[$i] = $b; # wipe attributes of new lines } } # Scroll the scrolling region down such that the text in the scrolling region # moves up, by the given number of lines. # sub _scroll_down { my $self = shift; my $lines = shift; my ($a, $b, $i, $attr); $self->callback_call ('SCROLL_DOWN', $self->{'srt'}, $lines); for ($i = $self->{'srt'}; $i <= ($self->{'srb'} - $lines); $i ++) { $self->{'scrt'}->[$i] = $self->{'scrt'}->[$i + $lines]; $self->{'scra'}->[$i] = $self->{'scra'}->[$i + $lines]; } $a = "\000" x $self->{'cols'}; # set text to NUL $attr = DEFAULT_ATTR_PACKED; $b = $attr x $self->{'cols'}; # set attributes to default for ( $i = $self->{'srb'}; ($i >= $self->{'srt'}) && ($i > ($self->{'srb'} - $lines)); $i -- ) { $self->{'scrt'}->[$i] = $a; # blank new lines $self->{'scra'}->[$i] = $b; # wipe attributes of new lines } } # Move the cursor up the given number of lines, without triggering a GOTO callback, taking scrolling into account. # sub _move_up { my $self = shift; my $num = shift; $num = 1 if (not defined $num); $num = 1 if ($num < 1); $self->{'y'} -= $num; return if ($self->{'y'} >= $self->{'srt'}); $self->_scroll_up ($self->{'srt'} - $self->{'y'}); # scroll $self->{'y'} = $self->{'srt'}; } # Move the cursor down the given number of lines, without triggering a GOTO # callback, taking scrolling into account. # sub _move_down { my $self = shift; my $num = shift; $num = 1 if (not defined $num); $num = 1 if ($num < 1); $self->{'y'} += $num; return if ($self->{'y'} <= $self->{'srb'}); $self->_scroll_down ($self->{'y'} - $self->{'srb'}); # scroll $self->{'y'} = $self->{'srb'}; } sub _code_BEL { # beep my $self = shift; if ((defined $self->{'_buf'}) && ($self->{'_inesc'} eq 'OSC')) { # CSI OSC can be terminated with a BEL $self->{'_buf'} .= "\007"; $self->_process_escseq (); } else { $self->callback_call ('BELL', 0, 0); } } sub _code_BS { # move left 1 character my $self = shift; $self->{'x'} --; $self->{'x'} = 1 if ($self->{'x'} < 1); } sub _code_CAN { # cancel escape sequence my $self = shift; $self->{'_inesc'} = ''; $self->{'_buf'} = undef; } sub _code_TBC { # clear tab stop (CSI 3 g = clear all stops) my $self = shift; my $num = shift; if ((defined $num) && ($num eq '3')) { $self->{'_tabstops'} = []; } else { $self->{'_tabstops'}->[$self->{'x'}] = undef; } } sub _code_CHA { # move to column in current row my $self = shift; my $col = shift; $col = 1 if (not defined $col); return if ($self->{'x'} == $col); $self->callback_call ('GOTO', $col, $self->{'y'}); $self->{'x'} = $col; $self->{'x'} = 1 if ($self->{'x'} < 1); $self->{'x'} = $self->{'cols'} if ($self->{'x'} > $self->{'cols'}); } sub _code_CNL { # move cursor down and to column 1 my $self = shift; my $num = shift; $num = 1 if (not defined $num); $self->callback_call ('GOTO', 1, $self->{'y'} + $num); $self->{'x'} = 1; $self->_move_down ($num); } sub _code_CPL { # move cursor up and to column 1 my $self = shift; my $num = shift; $num = 1 if (not defined $num); $self->callback_call ('GOTO', $self->{'x'}, $self->{'y'} - $num); $self->{'x'} = 1; $self->_move_up ($num); } sub _code_CR { # carriage return my $self = shift; $self->{'x'} = 1; } sub _code_CSI { # ESC [ my $self = shift; $self->{'_buf'} = ''; # restart ESC buffering $self->{'_inesc'} = 'CSI'; # ...for a CSI, not an ESC } sub _code_CUB { # move cursor left my $self = shift; my $num = shift; $num = 1 if (not defined $num); $num = 1 if ($num < 1); $self->callback_call ('GOTO', $self->{'x'} - $num, $self->{'y'}); $self->{'x'} -= $num; $self->{'x'} = 1 if ($self->{'x'} < 1); } sub _code_CUD { # move cursor down my $self = shift; my $num = shift; $num = 1 if (not defined $num); $num = 1 if ($num < 1); $self->callback_call ('GOTO', $self->{'x'}, $self->{'y'} + $num); $self->_move_down ($num); } sub _code_CUF { # move cursor right my $self = shift; my $num = shift; $num = 1 if (not defined $num); $num = 1 if ($num < 1); $self->callback_call ('GOTO', $self->{'x'} + $num, $self->{'y'}); $self->{'x'} += $num; $self->{'x'} = $self->{'cols'} if ($self->{'x'} > $self->{'cols'}); } sub _code_CUP { # move cursor to row, column my $self = shift; my ($row, $col) = (@_); $row = 1 if (not defined $row); $col = 1 if (not defined $col); $row = 1 if ($row < 1); $col = 1 if ($col < 1); $row = $self->{'rows'} if ($row > $self->{'rows'}); $col = $self->{'cols'} if ($col > $self->{'cols'}); $self->callback_call ('GOTO', $col, $row); $self->{'x'} = $col; $self->{'y'} = $row; } sub _code_RI { # reverse line feed my $self = shift; $self->callback_call ('GOTO', $self->{'x'}, $self->{'y'} - 1); $self->_move_up; } sub _code_CUU { # move cursor up my $self = shift; my $num = shift; $num = 1 if (not defined $num); $num = 1 if ($num < 1); $self->callback_call ('GOTO', $self->{'x'}, $self->{'y'} - $num); $self->_move_up ($num); } sub _code_DA { # return ESC [ ? 6 c (VT102) my $self = shift; $self->callback_call ('OUTPUT', "\033[?6c", 0); } sub _code_DCH { # delete characters on current line my $self = shift; my $num = shift; my ($width, $todel, $line, $lsub, $rsub, $attr); $num = 1 if (not defined $num); $num = 1 if ($num < 1); $width = $self->{'cols'} + 1 - $self->{'x'}; $todel = $num; $todel = $width if ($todel > $width); $line = $self->{'scrt'}->[$self->{'y'}]; ($lsub, $rsub) = ("", ""); $lsub = substr ($line, 0, $self->{'x'} - 1) if ($self->{'x'} > 1); $rsub = substr ($line, $self->{'x'} - 1 + $todel); $self->{'scrt'}->[$self->{'y'}] = $lsub . $rsub . ("\0" x $todel); $attr = DEFAULT_ATTR_PACKED; $line = $self->{'scra'}->[$self->{'y'}]; ($lsub, $rsub) = ("", ""); $lsub = substr ($line, 0, 2 * ($self->{'x'} - 1)) if ($self->{'x'} > 1); $rsub = substr ($line, 2 * ($self->{'x'} - 1 + $todel)); $self->{'scra'}->[$self->{'y'}] = $lsub . $rsub . ($attr x $todel); $self->callback_call ('ROWCHANGE', $self->{'y'}, 0); } sub _code_DCS { # device control string (ignored) my $self = shift; $self->{'_buf'} = ''; $self->{'_inesc'} = 'DCS_ST'; } sub _code_DECSTBM { # set scrolling region my $self = shift; my ($top, $bottom) = (@_); $top = 1 if (not defined $top); $bottom = $self->{'rows'} if (not defined $bottom); $top = 1 if ($top < 1); $bottom = 1 if ($bottom < 1); $top = $self->{'rows'} if ($top > $self->{'rows'}); $bottom = $self->{'rows'} if ($bottom > $self->{'rows'}); if ($bottom < $top) { my $a = $bottom; $bottom = $top; $top = $a; } $self->{'srt'} = $top; $self->{'srb'} = $bottom; } sub _code_DECTCEM { # Cursor on (set); Cursor off (reset) my $self = shift; $self->{'cursor'} = shift; } sub _code_IGN { # ignored control sequence } sub _code_DL { # delete lines my $self = shift; my $lines = shift; my ($attr, $scrb, $row); $lines = 1 if (not defined $lines); $lines = 1 if ($lines < 1); $attr = DEFAULT_ATTR_PACKED; $scrb = $self->{'srb'}; $scrb = $self->{'rows'} if ($self->{'y'} > $self->{'srb'}); $scrb = $self->{'srt'} - 1 if ($self->{'y'} < $self->{'srt'}); for ($row = $self->{'y'}; $row <= ($scrb - $lines); $row ++) { $self->{'scrt'}->[$row] = $self->{'scrt'}->[$row + $lines]; $self->{'scra'}->[$row] = $self->{'scra'}->[$row + $lines]; $self->callback_call ('ROWCHANGE', $row, 0); } for ( $row = $scrb; ($row > ($scrb - $lines)) && ($row >= ($self->{'y'})); $row -- ) { $self->{'scrt'}->[$row] = "\000" x $self->{'cols'}; $self->{'scra'}->[$row] = $attr x $self->{'cols'}; $self->callback_call ('ROWCHANGE', $row, 0); } } sub _code_DSR { # device status report my $self = shift; my $num = shift; $num = 5 if (not defined $num); if ($num == 6) { # CPR - cursor position report $self->callback_call ( 'OUTPUT', "\e[" . $self->{'y'} . ";" . $self->{'x'} . "R", 0 ); } elsif ($num == 5) { # DSR - reply ESC [ 0 n $self->callback_call ('OUTPUT', "\e[0n", 0); } } sub _code_ECH { # erase characters on current line my $self = shift; my $num = shift; my ($width, $todel, $line, $lsub, $rsub, $attr); $num = 1 if (not defined $num); $num = 1 if ($num < 1); $width = $self->{'cols'} + 1 - $self->{'x'}; $todel = $num; $todel = $width if ($todel > $width); $line = $self->{'scrt'}->[$self->{'y'}]; ($lsub, $rsub) = ("", ""); $lsub = substr ($line, 0, $self->{'x'} - 1) if ($self->{'x'} > 1); $rsub = substr ($line, $self->{'x'} - 1 + $todel); $self->{'scrt'}->[$self->{'y'}] = $lsub . ("\0" x $todel) . $rsub; $attr = DEFAULT_ATTR_PACKED; $line = $self->{'scra'}->[$self->{'y'}]; ($lsub, $rsub) = ("", ""); $lsub = substr ($line, 0, 2 * ($self->{'x'} - 1)) if ($self->{'x'} > 1); $rsub = substr ($line, 2 * ($self->{'x'} - 1 + $todel)); $self->{'scra'}->[$self->{'y'}] = $lsub . ($attr x $todel) . $rsub; $self->callback_call ('ROWCHANGE', $self->{'y'}, 0); } sub _code_ED { # erase display my $self = shift; my $num = shift; my ($row, $attr); $num = 0 if (not defined $num); $attr = DEFAULT_ATTR_PACKED; # Wipe-cursor-to-end is the same as clear-whole-screen if cursor at top left # $num = 2 if (($num == 0) && ($self->{'x'} == 1) && ($self->{'y'} == 1)); if ($num == 0) { # 0 = cursor to end $self->{'scrt'}->[$self->{'y'}] = substr ( $self->{'scrt'}->[$self->{'y'}], 0, $self->{'x'} - 1 ) . ("\0" x ($self->{'cols'} + 1 - $self->{'x'})); $self->{'scra'}->[$self->{'y'}] = substr ( $self->{'scra'}->[$self->{'y'}], 0, 2 * ($self->{'x'} - 1) ) . ($attr x ($self->{'cols'} + 1 - $self->{'x'})); $self->callback_call ('ROWCHANGE', $self->{'y'}, 0); for ( $row = $self->{'y'} + 1; $row <= $self->{'rows'}; $row ++ ) { $self->{'scrt'}->[$row] = "\0" x $self->{'cols'}; $self->{'scra'}->[$row] = $attr x $self->{'cols'}; $self->callback_call ('ROWCHANGE', $row, 0); } } elsif ($num == 1) { # 1 = start to cursor for ( $row = 1; $row < $self->{'y'}; $row ++ ) { $self->{'scrt'}->[$row] = "\0" x $self->{'cols'}; $self->{'scra'}->[$row] = $attr x $self->{'cols'}; $self->callback_call ('ROWCHANGE', $row, 0); } $self->{'scrt'}->[$self->{'y'}] = ("\0" x $self->{'x'}) . substr ($self->{'scrt'}->[$self->{'y'}], $self->{'x'}); $self->{'scra'}->[$self->{'y'}] = ($attr x $self->{'x'}) . substr ($self->{'scra'}->[$self->{'y'}], 2 * $self->{'x'}); $self->callback_call ('ROWCHANGE', $self->{'y'}, 0); } else { # 2 = whole display $self->callback_call ('CLEAR', 0, 0); for ($row = 1; $row <= $self->{'rows'}; $row ++) { $self->{'scrt'}->[$row] = "\0" x $self->{'cols'}; $self->{'scra'}->[$row] = $attr x $self->{'cols'}; } } } sub _code_EL { # erase line my $self = shift; my $num = shift; my $attr; $num = 0 if (not defined $num); $attr = DEFAULT_ATTR_PACKED; if ($num == 0) { # 0 = cursor to end of line $self->{'scrt'}->[$self->{'y'}] = substr ( $self->{'scrt'}->[$self->{'y'}], 0, $self->{'x'} - 1 ) . ("\0" x ($self->{'cols'} + 1 - $self->{'x'})); $self->{'scra'}->[$self->{'y'}] = substr ( $self->{'scra'}->[$self->{'y'}], 0, 2 * ($self->{'x'} - 1) ) . ($attr x ($self->{'cols'} + 1 - $self->{'x'})); $self->callback_call ('ROWCHANGE', $self->{'y'}, 0); } elsif ($num == 1) { # 1 = start of line to cursor $self->{'scrt'}->[$self->{'y'}] = ("\0" x $self->{'x'}) . substr ($self->{'scrt'}->[$self->{'y'}], $self->{'x'}); $self->{'scra'}->[$self->{'y'}] = ($attr x $self->{'x'}) . substr ($self->{'scra'}->[$self->{'y'}], 2 * $self->{'x'}); $self->callback_call ('ROWCHANGE', $self->{'y'}, 0); } else { # 2 = whole line $self->{'scrt'}->[$self->{'y'}] = "\0" x $self->{'cols'}; $self->{'scra'}->[$self->{'y'}] = $attr x $self->{'cols'}; $self->callback_call ('ROWCHANGE', $self->{'y'}, 0); } } sub _code_ESC { # start escape sequence my $self = shift; if ((defined $self->{'_buf'}) && ($self->{'_inesc'} =~ /OSC|_ST/)) { # Some sequences are terminated with an ST $self->{'_buf'} .= "\033"; $self->_process_escseq (); return; } $self->{'_buf'} = ''; # set ESC buffer $self->{'_inesc'} = 'ESC'; # ...for ESC, not CSI } sub _code_LF { # line feed my $self = shift; $self->_code_CR () # cursor to start of line if ($self->{'opts'}->{'LFTOCRLF'} != 0); $self->callback_call ('LINEFEED', $self->{'y'}, 0); $self->_move_down (); } sub _code_NEL { # newline my $self = shift; $self->_code_CR (); # cursor always to start $self->_code_LF (); # standard line feed } sub _code_HT { # horizontal tab to next tab stop my $self = shift; my ($newx, $spaces, $width); if ( ($self->{'opts'}->{'LINEWRAP'} != 0) && ($self->{'x'} >= $self->{'cols'}) ) { $self->callback_call ('LINEFEED', $self->{'y'}, 0); $self->{'x'} = 1; $self->_move_down; } $newx = $self->{'x'} + 1; while ($newx < $self->{'cols'} && not $self->{'_tabstops'}->[$newx]) { $newx++; } $width = ($self->{'cols'} + 1) - $self->{'x'}; $spaces = $newx - $self->{'x'}; $spaces = $width + 1 if ($spaces > $width); if ($spaces > 0) { $self->{'x'} += $spaces; $self->{'x'} = $self->{'cols'} if ($self->{'x'} > $self->{'cols'}); } } sub _code_HTS { # set tab stop at current column my $self = shift; $self->{'_tabstops'}->[$self->{'x'}] = 1; } sub _code_ICH { # insert blank characters my $self = shift; my $num = shift; my ($width, $toins, $line, $lsub, $rsub, $attr); $num = 1 if (not defined $num); $num = 1 if ($num < 1); $width = $self->{'cols'} + 1 - $self->{'x'}; $toins = $num; $toins = $width if ($toins > $width); $line = $self->{'scrt'}->[$self->{'y'}]; ($lsub, $rsub) = ("", ""); $lsub = substr ($line, 0, $self->{'x'} - 1) if ($self->{'x'} > 1); $rsub = substr ($line, $self->{'x'} - 1, $width - $toins); $self->{'scrt'}->[$self->{'y'}] = $lsub . ("\0" x $toins) . $rsub; $attr = DEFAULT_ATTR_PACKED; $line = $self->{'scra'}->[$self->{'y'}]; ($lsub, $rsub) = ("", ""); $lsub = substr ($line, 0, 2 * ($self->{'x'} - 1)) if ($self->{'x'} > 1); $rsub = substr ($line, 2 * ($self->{'x'} - 1), 2 * ($width - $toins)); $self->{'scra'}->[$self->{'y'}] = $lsub . ($attr x $toins) . $rsub; $self->callback_call ('ROWCHANGE', $self->{'y'}, 0); } sub _code_IL { # insert blank lines my $self = shift; my $lines = shift; my ($attr, $scrb, $row); $lines = 1 if (not defined $lines); $lines = 1 if ($lines < 1); $attr = DEFAULT_ATTR_PACKED; $scrb = $self->{'srb'}; $scrb = $self->{'rows'} if ($self->{'y'} > $self->{'srb'}); $scrb = $self->{'srt'} - 1 if ($self->{'y'} < $self->{'srt'}); for ($row = $scrb; $row >= ($self->{'y'} + $lines); $row --) { $self->{'scrt'}->[$row] = $self->{'scrt'}->[$row - $lines]; $self->{'scra'}->[$row] = $self->{'scra'}->[$row - $lines]; $self->callback_call ('ROWCHANGE', $row, 0); } for ( $row = $self->{'y'}; ($row <= $scrb) && ($row < ($self->{'y'} + $lines)); $row ++ ) { $self->{'scrt'}->[$row] = "\000" x $self->{'cols'}; $self->{'scra'}->[$row] = $attr x $self->{'cols'}; $self->callback_call ('ROWCHANGE', $row, 0); } } sub _code_PM { # privacy message (ignored) my $self = shift; $self->{'_buf'} = ''; $self->{'_inesc'} = 'PM_ST'; } sub _code_APC { # application program command (ignored) my $self = shift; $self->{'_buf'} = ''; $self->{'_inesc'} = 'APC_ST'; } sub _code_OSC { # operating system command my $self = shift; $self->{'_buf'} = ''; # restart buffering $self->{'_inesc'} = 'OSC'; # ...for OSC, not ESC or CSI } sub _code_RIS { # reset my $self = shift; $self->reset (); } sub _toggle_mode { # set/reset modes my $self = shift; my ($flag, @modes) = @_; foreach my $mode (@modes) { my $name = $self->{'_modeseq'}->{$mode}; my $func = undef; $func = $self->{'_funcs'}->{$name} if (defined $name); if (not defined $func) { # unsupported seq. $self->callback_call ( 'UNKNOWN', $name, "\033[${mode}" . ($flag ? "h" : "l") ); $self->{'_buf'} = undef; $self->{'_inesc'} = ''; return; } $self->{'_buf'} = undef; $self->{'_inesc'} = ''; &{$func} ($self, $flag); return; } } sub _code_RM { # reset mode my $self = shift; $self->_toggle_mode(0, @_); } sub _code_SM { # set mode my $self = shift; $self->_toggle_mode(1, @_); } sub _code_SGR { # set graphic rendition my $self = shift; my (@parms) = (@_); my ($val, $fg, $bg, $bo, $fa, $st, $ul, $bl, $rv); ($fg, $bg, $bo, $fa, $st, $ul, $bl, $rv) = $self->attr_unpack ($self->{'attr'}); @parms = (0) if ($#parms < 0); # ESC [ m = ESC [ 0 m while (defined ($val = shift @parms)) { if ($val == 0) { # reset all attributes ($fg, $bg, $bo, $fa, $st, $ul, $bl, $rv) = DEFAULT_ATTR; } elsif ($val == 1) { # bold ON ($bo, $fa) = (1, 0); } elsif ($val == 2) { # faint ON ($bo, $fa) = (0, 1); } elsif ($val == 4) { # underline ON $ul = 1; } elsif ($val == 5) { # blink ON $bl = 1; } elsif ($val == 7) { # reverse video ON $rv = 1; } elsif ($val == 21) { # normal intensity ($bo, $fa) = (0, 0); } elsif ($val == 22) { # normal intensity ($bo, $fa) = (0, 0); } elsif ($val == 24) { # underline OFF $ul = 0; } elsif ($val == 25) { # blink OFF $bl = 0; } elsif ($val == 27) { # reverse video OFF $rv = 0; } elsif (($val >= 30) && ($val <= 37)) {# set foreground colour $fg = $val - 30; } elsif ($val == 38) { # underline on, default fg ($ul, $fg) = (1, 7); } elsif ($val == 39) { # underline off, default fg ($ul, $fg) = (0, 7); } elsif (($val >= 40) && ($val <= 47)) {# set background colour $bg = $val - 40; } elsif ($val == 49) { # default background $bg = 0; } } $self->{'attr'} = $self->attr_pack ($fg, $bg, $bo, $fa, $st, $ul, $bl, $rv); } sub _code_VPA { # move to row (current column) my $self = shift; my $row = shift; $row = 1 if (not defined $row); return if ($self->{'y'} == $row); $self->{'y'} = $row; $self->{'y'} = 1 if ($self->{'y'} < 1); $self->{'y'} = $self->{'rows'} if ($self->{'y'} > $self->{'rows'}); } sub _code_DECALN { # fill screen with E's my $self = shift; my ($row, $attr); $attr = DEFAULT_ATTR_PACKED; for ($row = 1; $row <= $self->{'rows'}; $row ++) { $self->{'scrt'}->[$row] = 'E' x $self->{'cols'}; $self->{'scra'}->[$row] = $attr x $self->{'cols'}; $self->callback_call ('ROWCHANGE', $self->{'y'}, 0); } $self->{'x'} = 1; $self->{'y'} = 1; } sub _code_DECSC { # save state my $self = shift; my @state; @state = @{$self->{'_decsc'}}; push ( @state, [ $self->{'x'}, $self->{'y'}, $self->{'attr'}, $self->{'ti'}, $self->{'ic'}, $self->{'cursor'} ] ); $self->{'_decsc'} = [ @state ]; } sub _code_DECRC { # restore most recently saved state my $self = shift; my @state; my $ref; @state = @{$self->{'_decsc'}}; return if ($#state < 0); $ref = pop @state; ( $self->{'x'}, $self->{'y'}, $self->{'attr'}, $self->{'ti'}, $self->{'ic'}, $self->{'cursor'} ) = @$ref; $self->{'_decsc'} = [ @state ]; } sub _code_CUPSV { # save cursor position my $self = shift; my @state; @state = @{$self->{'_cupsv'}}; push ( @state, [ $self->{'x'}, $self->{'y'} ] ); $self->{'_cupsv'} = [ @state ]; } sub _code_CUPRS { # restore cursor position my $self = shift; my @state; my $ref; @state = @{$self->{'_cupsv'}}; return if ($#state < 0); $ref = pop @state; ( $self->{'x'}, $self->{'y'} ) = @$ref; $self->{'_cupsv'} = [ @state ]; } sub _code_XON { # resume character processing my $self = shift; $self->{'_xon'} = 1; } sub _code_XOFF { # stop character processing my $self = shift; return if ($self->{'opts'}->{'IGNOREXOFF'}); $self->{'_xon'} = 0; } 1; __END__ =head1 NAME Term::VT102 - a class to emulate a DEC VT102 terminal =head1 SYNOPSIS use Term::VT102; my $vt = Term::VT102->new ('cols' => 80, 'rows' => 24); while (<>) { $vt->process ($_); } =head1 DESCRIPTION The VT102 class provides emulation of most of the functions of a DEC VT102 terminal. Once initialised, data passed to a VT102 object is processed and the in-memory "screen" modified accordingly. This "screen" can be interrogated by the external program in a variety of ways. This allows your program to interface with full-screen console programs by running them in a subprocess and passing their output to a VT102 class. You can then see what the application has written on the screen by querying the class appropriately. =head1 OPTIONS Setting B or B in the B hash allows you to change the size of the terminal being emulated. If you do not specify a size, the default is 80 columns by 24 rows. After initialisation, you can read and set the following terminal options using the B and B methods: LINEWRAP line wrapping; 1=on, 0=off. Default is OFF. LFTOCRLF treat LF (\n) as CRLF (\r\n); 1=on, 0=off. Default OFF. IGNOREXOFF ignore XON/XOFF characters; 1=on (ignore). Default ON. =head1 METHODS The following methods are provided: =over 4 =item B (I<$fg>,I<$bg>,I<$bo>,I<$fa>,I<$st>,I<$ul>,I<$bl>,I<$rv>) Returns the packed version of the given attribute settings, which are given in the same order as returned by B. The packed version will be a binary string not longer than 2 bytes. =item B (I<$data>) Returns a list of the contents of the given packed attribute settings, of the form (I<$fg>,I<$bg>,I<$bo>,I<$fa>,I<$st>,I<$ul>,I<$bl>,I<$rv>). I<$fg> and I<$bg> are the ANSI foreground and background text colours, and I<$bo>, I<$fa>, I<$st>, I<$ul>, I<$bl>, and I<$rv> are flags (1 = on, 0 = off) for bold, faint, standout, underline, blink and reverse respectively. =item B (I<$name>, I<$par1>, I<$par2>) Calls the callback I<$name> (eg B<'ROWCHANGE'>) with parameters I<$par1> and I<$par2>, as if the VT102 module had called it. Does nothing if that callback has not been set with B. =item B (I<$callback>, I<$ref>, I<$private>) Sets the callback I to function reference I with private data I<$private>. See the section on B below. =item B (I<%config>) Returns a new VT102 object with options specified in I<%config> (see the B section for details). =item B (I<$option>) Returns the current value of terminal option I<$option> (see B for details), or I if that option does not exist. Note that you cannot read the terminal size with this call; use B for that. =item B (I<$option>, I<$value>) Sets the current value of terminal option I<$option> to I<$value>, returning the old value or I if no such terminal option exists or you have specified an undefined I<$value>. Note that you cannot resize the terminal with this call; use B for that. =item B (I<$string>) Processes the string I<$string> (which can be zero-length), updating the VT102 object accordingly and calling any necessary callbacks on the way. =item B (I<$cols>, I<$rows>) Resizes the VT102 terminal to I columns by I rows, eg B<$vt->>B. The virtual screen is cleared first. =item B () Resets the object to its "power-on" state. =item B (I<$row>, [I<$startcol>, I<$endcol>]) Returns the attributes for row I<$row> (or I if out of range) as a string of packed attributes, each character cell's attributes being 2 bytes long. To unpack the attributes for a given cell, use B, eg B<$attr=substr($row,4,2)> would set I<$attr> to the attributes for cell 3 (steps of 2: 0 .. 2 .. 4, so 4 means the 3rd character). You would then use the B method to unpack that character cell's attributes. If I<$startcol> and I<$endcol> are defined, only returns the part of the row between columns I<$startcol> and I<$endcol> inclusive instead of the whole row. =item B (I<$row>, [I<$startcol>, I<$endcol>]) Returns the textual contents of row I<$row> (or I if out of range), with totally unused characters being represented as NULL (\0). If I<$startcol> and I<$endcol> are defined, only returns the part of the row between columns I<$startcol> and I<$endcol> inclusive instead of the whole row. =item B (I<$row>, [I<$startcol>, I<$endcol>]) Returns the textual contents of row I<$row> (or I if out of range), with unused characters being represented as spaces. If I<$startcol> and I<$endcol> are defined, only returns the part of the row between columns I<$startcol> and I<$endcol> inclusive instead of the whole row. =item B (I<$row>, [I<$startcol>, I<$endcol>]) Returns the textual contents of row I<$row> (or I if out of range), with unused characters being represented as spaces, and ANSI/ECMA-48 escape sequences (CSI SGR) used to set the colours and attributes as appropriate. If I<$startcol> and I<$endcol> are defined, only returns the part of the row between columns I<$startcol> and I<$endcol> inclusive instead of the whole row. Use B to get a row if you want to output it to a real terminal and preserve all colours, bold, etc. =item B (I<$source>, I<$dest>) Returns a string containing ANSI/ECMA-48 escape sequences to change colours and attributes from I<$source> to I<$dest>, which are both packed attributes (see B). This is used internally by B. =item B () Return the number of columns in the VT102 object. =item B () Return the number of rows in the VT102 object. =item B () Return a pair of values (I,I) denoting the size of the terminal in the VT102 object. =item B () Return the current cursor X co-ordinate (1 being leftmost). B It is possible for the current X co-ordinate to be 1 more than the number of columns. This happens when the end of a row is reached such that the next character would wrap on to the next row. =item B () Return the current cursor Y co-ordinate (1 being topmost). =item B () Return the current cursor state (1 being on, 0 being off). =item B () Return the current xterm window title. =item B () Return the current xterm window icon name. =item B () Return a list of values (I<$x>,I<$y>,I<$attr>,I<$ti>,I<$ic>), where I<$x> and I<$y> are the cursor co-ordinates (1,1 = top left), I<$attr> is a packed version of the current attributes (see B), I<$ti> is the xterm window title, and I<$ic> is the xterm window icon name. =item B () Return the version of the VT102 module being used. =back =head1 CALLBACKS Callbacks are the processing loop's way of letting your main program know that something has happened. They are called while in a B loop. To specify a callback, use the B interface, giving a reference to the function to call. Your function should take five scalar arguments: the VT102 object being processed, the name of the callback, and two arguments whose value depends on the callback, as shown below. The final argument is the private data scalar you passed when you called B. The name of the callback is passed to the callback function so that you can have one function to handle all callbacks if you wish. Available callback names are: BELL BEL (beep, \007) character received CLEAR screen about to be cleared OUTPUT data (arg1) to be sent back to data source ROWCHANGE screen row (row number is argument 1) content has changed SCROLL_DOWN about to scroll down (arg1=top row, arg2=num to scroll) SCROLL_UP about to scroll up (ditto) UNKNOWN unknown/unsupported code (arg1=name, arg2=code/sequence) STRING string received (arg1=source, eg PM, APC, arg2=string) XICONNAME xterm icon name to be changed to arg1 XWINTITLE xterm title name to be changed to arg1 LINEFEED line feed about to be processed (arg1=row) GOTO cursor about to be moved (args=new pos) Note that the wording of the above is significant in terms of exactly B the callback is called. For instance, B is called just before the screen is cleared, whereas B is called I the given row has been changed. A good callback handler for B is to simply B argument 1 to your data source - eg if you're reading from a telnet session, write that argument straight to it. It is used for cursor position request responses and suchlike. Note that B is called when scrolling down, so text is about to move UP the screen; I will be the row number of the bottom of the scrolling region, and I will be the number of rows to be scrolled. Likewise, B is called when text is about to move down; I will be the row number of the top of the scrolling region. The B callback is called for escape sequences that contain a string that would otherwise be ignored, such as DSC, PM, and APC. The first argument is the escape sequence that contained the string, such as DSC, and the second argument is the string itself. This callback doesn't get called for OSC strings. The B callback can be thought of as "line completed", it's called when LF, NEL or IND are about to be processed or just before a line wraps, so it generally indicates that an application has finished updating a particular line on the screen. Handy for scrollback buffer processing. The B callback is only called just before the cursor is explicitly moved, by one of CUU, CUD, VPR, CUF, HPR, CUB, CNL, CPL, CHA, HPA, CUP, HVP. The parameters give the destination column and row, without taking scrolling and boundaries into account. Finally, note that B is only triggered when text is being entered; screen scrolling or screen clearance does not trigger it, that would trigger a B or B or B. Line or character insertion or deletion will cause one or more B callbacks, however. =head1 SUPPORTED CODES The following sequences are supported: 007 (BEL) beep 010 (BS) backspace 011 (HT) horizontal tab to next tab stop 012 (LF) line feed 013 (VT) line feed 014 (FF) line feed 015 (CR) carriage return 021 (XON) resume transmission (only if option IGNOREXOFF is cleared) 023 (XOFF) stop transmission (only if option IGNOREXOFF is cleared) 030 (CAN) interrupt escape sequence 032 (SUB) interrupt escape sequence 033 (ESC) start escape sequence 177 (DEL) ignored 233 (CSI) same as ESC [ ESC 7 (DECSC) save state ESC 8 (DECRC) restore most recently saved state ESC H (HTS) set tab stop at current column ESC g visual beep - treated as BEL ESC # 8 (DECALN) DEC screen alignment test - fill screen with E's CSI @ (ICH) insert blank characters CSI A (CUU) move cursor up CSI B (CUD) move cursor down CSI C (CUF) move cursor right CSI D (CUB) move cursor left CSI E (CNL) move cursor down and to column 1 CSI F (CPL) move cursor up and to column 1 CSI G (CHA) move cursor to column in current row CSI H (CUP) move cursor to row, column CSI J (ED) erase display CSI K (EL) erase line CSI L (IL) insert blank lines CSI M (DL) delete lines CSI P (DCH) delete characters on current line CSI X (ECH) erase characters on current line CSI a (HPR) move cursor right CSI c (DA) return ESC [ ? 6 c (VT102) CSI d (VPA) move to row (current column) CSI e (VPR) move cursor down CSI f (HVP) move cursor to row, column CSI m (SGR) set graphic rendition CSI n (DSR) device status report CSI r (DECSTBM) set scrolling region to (top, bottom) rows CSI s (CUPSV) save cursor position CSI u (CUPRS) restore cursor position CSI ` (HPA) move cursor to column in current row CSI g (TBC) clear tab stop (CSI 3 g = clear all stops) =head1 LIMITATIONS Unknown escape sequences and control characters are ignored. All escape sequences pertaining to character sets are ignored. The following known control characters / sequences are ignored: 005 (ENQ) trigger answerback message 016 (SO) activate G1 charset, carriage return 017 (SI) activate G0 charset The following known escape sequences are ignored: ESC %@ (CSDFL) select default charset (ISO646/8859-1) ESC %G (CSUTF8) select UTF-8 ESC %8 (CSUTF8) select UTF-8 (obsolete) ESC (8 (G0DFL) G0 charset = default mapping (ISO8859-1) ESC (0 (G0GFX) G0 charset = VT100 graphics mapping ESC (U (G0ROM) G0 charset = null mapping (straight to ROM) ESC (K (G0USR) G0 charset = user defined mapping ESC (B (G0TXT) G0 charset = ASCII mapping ESC )8 (G1DFL) G1 charset = default mapping (ISO8859-1) ESC )0 (G1GFX) G1 charset = VT100 graphics mapping ESC )U (G1ROM) G1 charset = null mapping (straight to ROM) ESC )K (G1USR) G1 charset = user defined mapping ESC )B (G1TXT) G1 charset = ASCII mapping ESC *8 (G2DFL) G2 charset = default mapping (ISO8859-1) ESC *0 (G2GFX) G2 charset = VT100 graphics mapping ESC *U (G2ROM) G2 charset = null mapping (straight to ROM) ESC *K (G2USR) G2 charset = user defined mapping ESC +8 (G3DFL) G3 charset = default mapping (ISO8859-1) ESC +0 (G3GFX) G3 charset = VT100 graphics mapping ESC +U (G3ROM) G3 charset = null mapping (straight to ROM) ESC +K (G3USR) G3 charset = user defined mapping ESC > (DECPNM) set numeric keypad mode ESC = (DECPAM) set application keypad mode ESC N (SS2) select G2 charset for next char only ESC O (SS3) select G3 charset for next char only ESC P (DCS) device control string (ended by ST) ESC X (SOS) start of string ESC ^ (PM) privacy message (ended by ST) ESC _ (APC) application program command (ended by ST) ESC \ (ST) string terminator ESC n (LS2) invoke G2 charset ESC o (LS3) invoke G3 charset ESC | (LS3R) invoke G3 charset as GR ESC } (LS2R) invoke G2 charset as GR ESC ~ (LS1R) invoke G1 charset as GR The following known CSI (ESC [) sequences are ignored: CSI q (DECLL) set keyboard LEDs The following known CSI (ESC [) sequences are only partially supported: CSI h (SM) set mode (only support CSI ? 25 h, cursor on/off) CSI l (RM) reset mode (as above) =head1 EXAMPLES For some examples, including how to interface Term::VT102 with Net::Telnet or a command such as SSH, please see the B directory in the distribution. =head1 AUTHORS Copyright (C) 2003 Andrew Wood Candrew dot wood at ivarch dot comE>. Distributed under the terms of the Artistic License 2.0. Credit is also due to: Charles Harker - reported and helped to diagnose a bug in the handling of TABs Steve van der Burg - supplied basis for an example script using Net::Telnet Chris R. Donnelly - added support for DECTCEM, partial support for SM/RM Paul L. Stoddard - reported a possible bug in cursor movement handling Joerg Walter - provided a patch for Unicode handling =head1 THINGS TO WATCH OUT FOR Make sure that your code understands NULL (\000) - you will get this in strings where nothing has been printed on the screen. For instance, the sequence "12\e[C34" ("12", "CUF (move right)", "34") you might think would yield the string "12 34", but in fact it can also yield "12\00034" - that is, "12" followed by a zero byte followed by "34". This is because the screen's contents defaults to zeroes, not spaces. To avoid that, use B, which will convert NULLs to spaces, instead of B. Different types of terminal disagree on certain corner cases. For example, B and B handle TAB stops and TABbing past the end of the screen in slightly different ways. Term::VT102 is closer to B in the way it handles this sort of thing. =head1 SEE ALSO B(4), B(3) =cut # EOF Term-VT102-0.91/README0000644000076400007640000000244511102154072011612 0ustar awawThis is the README file for Term::VT102, a Perl module which provides emulation of a VT102 terminal. Like the "expect" Tcl extension, this module is intended primarily for use as a way of automating processes; for instance, you can write a script which connects via telnet to a full-screen service of some kind (such as a router, or a telephone switch), uses this module to parse the output, and therefore can tell what is currently "on the screen" and react accordingly. "Expect" cannot really do this, as it is stream-oriented, rather than being able to tell you, say, what's on the top row of the screen. For installation instructions, see the INSTALL file. Please send bug reports, comments, and whatnot to the project maintainer, Andrew Wood . Credit is also due to: Charles Harker - reported and helped to diagnose a bug in the handling of TABs Steve van der Burg - supplied basis for an example script using Net::Telnet Chris R. Donnelly - added support for DECTCEM, partial support for SM/RM Paul L. Stoddard - reported a possible bug in cursor movement handling Joerg Walter - provided a patch for Unicode handling Term-VT102-0.91/TODO0000644000076400007640000000014311102334276011421 0ustar awawThings still to do: - functions for Expect-like behaviour Any assistance would be appreciated. Term-VT102-0.91/META.yml0000600000076400007640000000044711105652420012176 0ustar awaw# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Term-VT102 version: 0.91 version_from: VT102.pm installdirs: site requires: distribution_type: module generated_by: ExtUtils::MakeMaker version 6.30 Term-VT102-0.91/INSTALL0000644000076400007640000000064111102154072011757 0ustar awawTo install Term::VT102, simply unpack the distribution archive (something like "tar xzvf Term-VT102-x.y.tar.gz" should do it), enter the top-level directory, and do: perl Makefile.PL make make test (this step is optional) make install You should then be able to use the Term::VT102 module in your Perl scripts. See the README file for an introduction and do "perldoc Term::VT102" for API details. Term-VT102-0.91/COPYING0000644000076400007640000001251211102154072011761 0ustar awaw The "Artistic License" Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: * "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. * "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. * "Copyright Holder" is whoever is named in the copyright or copyrights for the package. * "You" is you, if you're thinking about copying or distributing this Package. * "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) * "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End