1#! perl -w 2 3use lib './blib/lib','../blib/lib'; # can run from here or distribution base 4 5######################### We start with some black magic to print on failure. 6 7BEGIN { $| = 1; print "demo2.plx loaded "; } 8END {print "not ok 1\n" unless $loaded;} 9use Device::SerialPort 0.05; 10$loaded = 1; 11print "ok 1\n"; 12 13######################### End of black magic. 14 15# starts configuration created by test1.pl 16 17use strict; 18 19my $file = "/dev/ttyS0"; 20my $tc = 2; # next test number 21my $pass; 22my $fail; 23my $in; 24my $in2; 25my @necessary_param = Device::SerialPort->set_test_mode_active; 26 27# 2: Constructor 28 29my $ob = Device::SerialPort->new ($file) || die "Can't open $file: $!"; 30 31$ob->baudrate(9600) || die "fail setting baudrate"; 32$ob->parity("none") || die "fail setting parity"; 33$ob->databits(8) || die "fail setting databits"; 34$ob->stopbits(1) || die "fail setting stopbits"; 35$ob->handshake("none") || die "fail setting handshake"; 36 37$ob->write_settings || die "no settings"; 38 39# 3: Prints Prompts to Port and Main Screen 40 41my $out= "\r\n\r\n++++++++++++++++++++++++++++++++++++++++++\r\n"; 42my $tick= "Very Simple Half-Duplex Chat Demo\r\n\r\n"; 43my $tock= "type CAPITAL-Q on either terminal to quit\r\n"; 44my $e="\r\n....Bye\r\n"; 45my $loc="\r\n"; 46 47print $out, $tick, $tock; 48$pass=$ob->write($out); 49$pass=$ob->write($tick); 50$pass=$ob->write($tock); 51 52$out= "Your turn first"; 53$tick= "\r\nterminal>"; 54$tock= "\r\n\r\nperl>"; 55 56$pass=$ob->write($out); 57## $_ = <STDIN>; # flush it out (shell dependent) 58 59$ob->error_msg(1); # use built-in error messages 60$ob->user_msg(1); 61 62$fail=0; 63while (not $fail) { 64 $pass=$ob->write($tick); 65 $in = 1; 66 while ($in) { 67 if (($_ = $ob->input) ne "") { 68 $ob->write($_); 69 print $_; 70 if (/\cM/) { $ob->write($loc); $in--; } 71 if (/Q/) { $ob->write($loc); $in--; $fail++; } 72 if ($ob->reset_error) { $ob->write($loc); $in--; $fail++; } 73 } 74 } 75 unless ($fail) { 76 print $tock; 77 $_ = <STDIN>; 78 last unless (defined $_); 79 print "\n"; 80 $fail++ if (/Q/); 81 $ob->write($loc); 82 $ob->write($_) unless ($_ eq ""); 83 } 84} 85print $e; 86$pass=$ob->write($e); 87 88sleep 1; 89 90undef $ob; 91