Here is the script with a Tk-interface, the main routine lifted from the examples, but... it does not work(it does dial, but does not capture what comes back)
#!/usr/bin/perl -w
# cross-platform example7, use LF-only on Un*x
###TODO: Can we autodetect port?
use strict;
use Tk;
require('dumpvar.pl');
use vars qw( $OS_win $ob $file $port);
my $min; my $max;
$file = 'MODEM_CONFIG_PARAMS';
BEGIN {
$OS_win = ($^O eq "MSWin32") ? 1 : 0;
if ($OS_win) {
eval "use Win32::SerialPort 0.13";
die "$@\n" if ($@);
$port = 'COM2';
$ob = Win32::SerialPort->new ($port);
}
else {
eval "use Device::SerialPort";
die "$@\n" if ($@);
$port = '/dev/modem';
$ob = Device::SerialPort->new ($port);
}
} # End BEGIN
my $top= MainWindow->new();
$top->title("Modem checker Configuration Menu");
my $menubar = $top->Frame;
$menubar ->pack(-side =>'top', -fill =>'x');
$menubar ->configure (-fg =>'red', -bg =>'blue', -relief =>'raised');
my $filemenu =$menubar->Menubutton(-text =>'File', -underline =>0);
$filemenu ->command(-label => 'Quit', -underline =>0, -command =>sub{$top->destroy()});
$filemenu->pack(-side =>'left');
$filemenu->configure(-fg =>'red', -bg =>'blue', -relief =>'raised');
my $frame=$top->Frame(-bg=>'aquamarine',-relief=>'sunken')->pack();
my $label0=$frame->Label(-text=>'Enter Phone Number Ranges to scan')->grid(-row=>0, -column=>0); ;
my $label=$frame->Label(-text=>'Starting number:')->grid(-row=>1,-column=>0);
my $entry=$frame->Entry(-textvariable=>\$min)->grid(-row=>1,-column=>1);
my $label2=$frame->Label(-text=>'Ending number:')->grid(-row=>2,-column=>0);
my $entry2=$frame->Entry(-textvariable=>\$max)->grid(-row=>2,-column=>1);
my $label3=$frame->Label(-text=>'Port for modem of the computer used to perform the scan(present computer)')->grid(-row=>3,-column=>0);
my $entry3=$frame->Entry(-textvariable=>\$port)->grid(-row=>3,-column=>1);
my $button=$frame->Button(-bg=>'firebrick1',-text=>'Start the scan',
-command=>sub{
#first, error handler
if ($min=~/\D/ or $max=~/\D/){
my $TOP=MainWindow->new();
$TOP->title('Error Message in range specification');
$TOP->Label(-text=>"Invalid(nondigit) input $min and $max",-bg=>'firebrick1')->pack();
my $buttoner=$TOP->Button(-bg=>'salmon1',-text=>'Ok',
-command=>sub{$TOP->destroy();});
&MainLoop();
}#if min or max=~/D
if (-e $file){
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);
}#file exists
else {# file does not exist, create it!
if ($OS_win) {
$port = 'COM2';
$ob = Win32::SerialPort->new ($port);
}
else {
$port = '/dev/modem';
$ob = Device::SerialPort->new ($port);
}
unless($ob){
my $TOPob=MainWindow->new();
$TOPob->title("cannot open Serial Port $port");
$TOPob->Label(-text=>"cannot open Serial Port $port",-bg=>'firebrick1')->pack();
my $buttonob=$TOPob->Button(-bg=>'salmon1',-text=>'Ok',
-command=>sub{$TOPob->destroy();});
&MainLoop();
}#unless $ob
$ob->user_msg(1); # misc. warnings
$ob->error_msg(1); # hardware and data errors
$ob->baudrate(38400);
$ob->parity("none");
## $ob->parity_enable(1); # for any parity except "none"
$ob->databits(8);
$ob->stopbits(1);
$ob->handshake('rts');
$ob->write_settings;
$ob->save("$file");
print "wrote configuration file $file\n";
}#create it!
$ob->are_match("BUSY","CONNECT","OK","NO DIALTONE","ERROR","RING",
"NO CARRIER","NO ANSWER");
open(OUT,">DETECTED_MODEMS") or die "cannot open file DETECTED_MODEMS for writing\n";
if($min>$max){my $tmp=$min; $min=$max; $max=$tmp;
print "min and max entered in wrong order, revered them...\n";}
my $dialled_no;
for ($dialled_no=$min; $dialled_no<=$max; $dialled_no++ ){
&dial($dialled_no,$ob); }
close(OUT);
})->grid(-row=>4,-column=>1);
my $quitbut= $frame->Button(-bg=>'blue',-text=>'Stop the scan', -command=>sub{
$top->destroy();
})->grid(-row=>5,-column=>1);
&MainLoop();
sub waitfor {
my $ob=shift; 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 =======================
#print "\n5 seconds to failure..\n";
#waitfor(5) || print "Timed Out\n";
#undef $ob;
#------ get parameters
sub dial{my $phone=shift; my $ob=shift;
$ob->write("ATE0X4\r");
printf "%s\n", waitfor($ob,1); # 1 second
print "\nStarting Dial\n";
$ob->write("ATDT$phone\r") || die "Could Not Dial\n";
print "%s\n", waitfor($ob,20);
&main::dumpValue($ob);
printf "%s\n", waitfor($ob,20);
print "\n5 seconds to failure..\n";
waitfor($ob,5) || print "Timed Out\n";
my $match; my $after; my $instead;
my $result = $ob->input;
print "result = $result\n";
print "Starting 500 character background read\n";
my $in; print "oswin=$OS_win\n";
$in = $ob->read_bg(500) if ($OS_win);
print "in=$in\n" if ($OS_win);
#Next, capture response and look for connect
my $waiter=0;
while($waiter<20){
my $con1='CONNECT';
($match,$after,$con1,$instead)=$ob->lastlook;
if($match){#found a CONNECT
print OUT "found a modem for phone $phone match=$match\n";
}
sleep(2); $waiter++;}
$ob->write("ATZ\r") || die "Could Not reset \n";
}
