/usr/share/doc/libdevice-serialport-perl/examples/example7.txt is in libdevice-serialport-perl 1.04-3build2.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 | #!/usr/bin/perl -w
# cross-platform example7
use strict;
use vars qw( $OS_win $ob $file );
BEGIN {
$OS_win = ($^O eq "MSWin32") ? 1 : 0;
if ($OS_win) {
eval "use Win32::SerialPort 0.13";
die "$@\n" if ($@);
}
else {
eval "use Device::SerialPort";
die "$@\n" if ($@);
}
} # End BEGIN
$file = 'tpj4.cfg';
if ($OS_win) {
$ob = Win32::SerialPort->start ($file);
}
else {
$ob = Device::SerialPort->start ($file);
}
die "Can't open serial port from $file: $^E\n" unless ($ob);
sub waitfor {
my $timeout=$ob->get_tick_count + (1000 * shift);
$ob->lookclear; # clear buffers
my $gotit = "";
for (;;) {
return unless (defined ($gotit = $ob->lookfor));
if ($gotit ne "") {
my ($found, $end) = $ob->lastlook;
return $gotit.$found;
}
return if ($ob->reset_error);
return if ($ob->get_tick_count > $timeout);
}
}
# =============== execution begins here =======================
$ob->error_msg(1); # use built-in error messages
$ob->user_msg(1);
$ob->are_match("BUSY","CONNECT","OK","NO DIALTONE","ERROR","RING",
"NO CARRIER","NO ANSWER");
$ob->write("ATE0X4\r");
printf "%s\n", waitfor(1); # 1 second
print "\nStarting Dial\n";
$ob->write("ATDT5551234\r"); # Use a different number!
printf "%s\n", waitfor(20);
print "\n5 seconds to failure..\n";
waitfor(5) || print "Timed Out\n";
undef $ob;
|