1#!/usr/bin/perl -w 2 3use lib './t','../t','./blib/lib','../blib/lib'; 4 # can run from here or distribution base 5 6use Device::SerialPort 0.06; 7require "DefaultPort.pm"; 8use Carp; 9use strict; 10 11# tests start using file created by test1.t unless overridden 12 13my $file = "/dev/ttyS0"; 14if ($SerialJunk::Makefile_Test_Port) { 15 $file = $SerialJunk::Makefile_Test_Port; 16} 17if (exists $ENV{Makefile_Test_Port}) { 18 $file = $ENV{Makefile_Test_Port}; 19} 20if (@ARGV) { 21 $file = shift @ARGV; 22} 23 24my $cfgfile = $file."_test.cfg"; 25$cfgfile =~ s/.*\///; 26 27if (-e "../t/$cfgfile") { $cfgfile = "../t/$cfgfile"; } 28elsif (-e "../$cfgfile") { $cfgfile = "../$cfgfile"; } 29elsif (-e "t/$cfgfile") { $cfgfile = "t/$cfgfile"; } 30else { die "$cfgfile not found" unless (-e $cfgfile); } 31 32my $ob; 33my $pass; 34my @wanted; 35my $before; 36my $did_match; 37my $stty_onlcr; 38 39sub nextline { 40 my $delay = 0; 41 my $prompt; 42 $delay = shift if (@_); 43 if (@_) { $prompt = shift; } 44 else { $prompt = ""; } 45 my $timeout=$ob->get_tick_count + (1000 * $delay); 46 my $gotit = ""; 47 my $fmatch = ""; 48 my @junk; 49 # this count wraps every 49 days or so 50 51## $ob->is_prompt($prompt); 52 $prompt =~ s/\n/\r\n/ogs if ($ob->stty_opost && $stty_onlcr); 53 $ob->write($prompt); 54 55 for (;;) { 56 return unless (defined ($gotit = $ob->lookfor)); 57 if ($gotit ne "") { 58 ($fmatch, @junk) = $ob->lastlook; 59 return ($gotit, $fmatch); 60 } 61 $fmatch = $ob->matchclear; 62 return ("", $fmatch) if ($fmatch); 63 return if ($ob->reset_error); 64 select undef, undef, undef, 0.05; # 20/sec. 65 return if ($ob->get_tick_count > $timeout); 66 } 67} 68 69sub waitfor { 70 croak "parameter problem" unless (@_ == 1); 71 $ob->lookclear; 72 nextline ( shift ); 73} 74 75sub stty_char { 76 my $pos = shift; 77 return '%%%%' unless ($pos); 78## return $pos if (2 >= length($pos)); 79 my $n_char = chr $pos; 80 if ($pos < 32) { 81 $n_char = "^".chr($pos + 64); 82 } 83 if ($pos == 127) { 84 $n_char = "DEL"; 85 } 86 return $n_char; 87} 88 89# starts configuration created by test1.pl 90 91# =============== execution begins here ======================= 92 93# 2: Constructor 94 95$ob = Device::SerialPort->start ($cfgfile) or die "Can't start $cfgfile\n"; 96 # next test will die at runtime unless $ob 97 98### setup for dumb terminal, your mileage may vary 99$ob->stty_echo(1); 100$ob->stty_icrnl(1); 101$stty_onlcr = 1; 102$ob->stty_opost(1); 103### 104 105my $intr = stty_char($ob->is_stty_intr); 106my $quit = stty_char($ob->is_stty_quit); 107my $eof = stty_char($ob->is_stty_eof); 108my $eol = stty_char($ob->is_stty_eol); 109my $erase = stty_char($ob->is_stty_erase); 110my $kill = stty_char($ob->is_stty_kill); 111my $echo = ($ob->stty_echo ? "" : "-")."echo"; 112my $echoe = ($ob->stty_echoe ? "" : "-")."echoe"; 113my $echok = ($ob->stty_echok ? "" : "-")."echok"; 114my $echonl = ($ob->stty_echonl ? "" : "-")."echonl"; 115## my $echoke = ($ob->stty_echoke ? "" : "-")."echoke"; 116## my $echoctl = ($ob->stty_echoctl ? "" : "-")."echoctl"; 117my $istrip = ($ob->stty_istrip ? "" : "-")."istrip"; 118my $icrnl = ($ob->stty_icrnl ? "" : "-")."icrnl"; 119## my $ocrnl = ($ob->stty_ocrnl ? "" : "-")."ocrnl"; 120my $igncr = ($ob->stty_igncr ? "" : "-")."igncr"; 121my $inlcr = ($ob->stty_inlcr ? "" : "-")."inlcr"; 122my $onlcr = ($stty_onlcr ? "" : "-")."onlcr"; 123my $opost = ($ob->stty_opost ? "" : "-")."opost"; 124my $isig = $ob->stty_isig ? "enabled" : "disabled"; 125my $icanon = $ob->stty_icanon ? "enabled" : "disabled"; 126 127 128# 3: Prints Prompts to Port and Main Screen 129 130my $head = "\r\n\r\n++++++++++++++++++++++++++++++++++++++++++\r\n"; 131my $e="\r\n....Bye\r\n"; 132 133my $tock = <<TOCK_END; 134Simple Serial Terminal with lookfor 135 136Terminal CONTROL Keys Supported: 137 quit = $quit; intr = $intr; $isig 138 erase = $erase; kill = $kill; $icanon 139 eol = $eol; eof = $eof; 140 141Terminal FUNCTIONS Supported: 142 $istrip $igncr $echok $echonl 143 $echo $echoe 144 145Terminal Character Conversions Supported: 146 $icrnl $inlcr $onlcr $opost 147 148TOCK_END 149# 150 151print $head, $tock; 152$tock =~ s/\n/\r\n/ogs if ($ob->stty_opost && $stty_onlcr); 153$pass=$ob->write($head); 154$pass=$ob->write($tock); 155 156$ob->error_msg(1); # use built-in error messages 157$ob->user_msg(1); 158 159my $match1 = "YES"; 160my $match2 = "NO"; 161my $prompt1 = "Type $match1 or $match2 or <ENTER> exactly to continue\r\n"; 162 163$pass=$ob->write($prompt1) if ($ob->stty_echo); 164 165$ob->are_match($match1, $match2, "\n"); 166($before, $did_match) = waitfor (30); 167my ($found, $end, $patt, $instead) = $ob->lastlook; 168if (defined $before) { 169 if ("\n" eq $did_match) { $did_match = "newline"; } 170 print "\ngot: $before...followed by: $did_match...\n"; 171} 172else { 173 print "\r\nAborted or Timed Out\r\n"; 174 print "actually received: $instead...\n"; 175} 176 177print $head; 178$pass=$ob->write($head); 179 180$ob->lookclear; 181($before, $did_match) = nextline (60, "\nPROMPT:"); 182if (defined $before) { 183 if ("\n" eq $did_match) { $did_match = "newline"; } 184 print "\ngot: $before...followed by: $did_match...\n"; 185} 186else { 187 ($found, $end, $patt, $instead) = $ob->lastlook; 188 print "\r\nAborted or Timed Out\r\n"; 189 print "actually received: $instead...\n"; 190} 191 192sleep 2; 193($before, $did_match) = nextline (60, "\nPROMPT2:"); 194if (defined $before) { 195 if ("\n" eq $did_match) { $did_match = "newline"; } 196 print "\ngot2: $before...followed by: $did_match...\n"; 197} 198else { 199 ($found, $end, $patt, $instead) = $ob->lastlook; 200 print "\r\nAborted or Timed Out\r\n"; 201 print "actually received: $instead...\n"; 202} 203 204sleep 2; 205@wanted = ("BYE"); 206$ob->are_match(@wanted); 207($before, $did_match) = nextline (60, "\ntype 'BYE' to quit:"); 208if (defined $before) { 209 print "\ngot3: $before...followed by: $did_match...\n"; 210} 211else { 212 ($found, $end, $patt, $instead) = $ob->lastlook; 213 print "\r\nAborted or Timed Out\r\n"; 214 print "actually received: $instead...\n"; 215} 216 217### example from the docs 218 219 $ob->are_match("text", "\n"); # possible end strings 220 $ob->lookclear; # empty buffers 221 $ob->write("\r\nFeed Me:"); # initial prompt 222## $ob->is_prompt("More Food:"); # new prompt after "kill" char 223 224 my $gotit = ""; 225 $match1 = ""; 226 until ("" ne $gotit) { 227 $gotit = $ob->lookfor; # poll until data ready 228 die "Aborted without match\n" unless (defined $gotit); 229 last if ($gotit); 230 $match1 = $ob->matchclear; # match is first thing received 231 last if ($match1); 232 sleep 1; # polling sample time 233 } 234 235 printf "gotit = %s...\n", $gotit; # input BEFORE the match 236 ($found, $end, $patt, $instead) = $ob->lastlook; 237 # input that MATCHED, input AFTER the match, PATTERN that matched 238 # input received INSTEAD when timeout without match 239 240 if ($match1) { 241 $found = $match1; 242 } 243 print "lastlook-match = $found...\n" if ($found); 244 print "lastlook-after = $end...\n" if ($end); 245 print "lastlook-pattern = $patt...\n" if ($patt); 246 print "lastlook-instead = $instead...\n" if ($instead); 247 248### 249print $e; 250$pass=$ob->write($e); 251 252sleep 1; 253 254undef $ob; 255