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