Ключевые слова:perl, example, modem, serial, script, (найти похожие документы)
Date: Tue, 13 Nov 2001 16:12:22 +0000 (UTC)
From: [email protected]
Newsgroups: fido7.ru.perl
Subject: Пример скрипта работающего с модемом через serial port
СГ>ну киньте живой пример общения с модемом.
Вот такое пойдет? Толстовать для фидо конечно, но зато заведомо
живое и может кому еще пригодится. Писалось и отлаживалось под Linux,
но с точностью до имен устройств под любой другой нормальной системой
тоже должно работать.
==begin mphonebook script===
#!/usr/bin/perl -T
use Getopt::Std;
=head1 NAME
mphonebook - manages mobile phone phonebook
=head1 SYNOPSIS
mphonebook [-p device]
mphonebook [-p device] -a comment phone
mphonebook [-p device] -rNN comment phone
mphonebook [-p device] -dNN
mphonebook [-p device] -l [filename]
=head1 DESCRIPTION
This utility manages phonebook in mobile phone, connected by
GSM-compliant modem interface. By default it assumes that your phone
is connected via first IRDA port B</dev/ircommnew0>.
When invoked without arguments it just lists all the phonebook entries
to the stdout.
when invoked with B<-l> option, loads file in the same format as it
outputs, int phone, erasing any entries which can be there (thus
allowing you to edit your phonebook with your favorite text editor).
Options B<-a>,B<-r> and B<-d> allows to manage phone book entries
individually.
Program does proper UUCP-style locking to interoperate correctly
with other dial-out software.
=head1 OPTIONS
=over 4
=item B<-a> I<comment> I<phone>
Adds given I<phone> with given I<comment> into the first empty slot of
phonebook and prints a slot nubmer.
=item B<-d>I<NN>
Deletes an entry from slot number NN
=item B<-l>
Loads a phonebook from file(s) or B<stdin> if no files specified.
=item B<-p>I<device>
Allows to specify device name to communicate instead of default
B</dev/ircommnew0>.
=item B<-r>I<NN> I<comment> I<phone>
Replaces contents of slot I<NN< with given I<phone> and I<comment>
=back
=head1 BUGS AND LIMITATIONS
Only one of B<-a>, B<-r> or B<-d> option may be specified in one command
line.
=head1 LICENSE
This program is distributed under GNU General Public License
=head1 AUTHOR
Victor B. Wagner E<lt>[email protected]<gt>.
=cut
my $port = "/dev/ircommnew0";
my $lock_dir="/var/lock";
use strict;
use Fcntl;
use vars qw($opt_D $opt_d $opt_a $opt_r $opt_l $opt_p);
getopts("Dd:ar:lp:");
if ($opt_p) {
$opt_p =~/^(.*)$/;
$port =$1;
}
my $exclusives=0;
for (($opt_a, $opt_r ,$opt_d ,$opt_l)) {
$exclusives++ if $_;
}
if ($exclusives >=2) {
print STDERR "Two or more mutually exclusive options are specified\n";
exit 1;
}
lock($port);
open F,"+<$port" or die $!;
print STDERR "Opened\n";
select F;
$|=1;
select STDOUT;
# Common initialization
modemcmd('ATZ');
modemcmd('AT+CSCS="8859-1"');
my ($bookinfo)= modemcmd('AT+CPBR=?');
$bookinfo=~/\+CPBR:\s*\((\d+)-(\d+)\),(\d+),(\d+)/;
my $bookfirst=$1 || 1;
my $booklast=$2 ||10;
my $phonemax=$3 ||20;
my $commentmax=$4 ||20;
my $format="%3d:\%-${commentmax}s \%-${phonemax}s\n";
print STDERR "Initialized\n";
my ($comment,$phone)=("","");
for (($opt_r,$opt_d)) {
next unless $_;
die "Invalid phonebook index"
if ($_ !~/^\d+$/ || $_ < $bookfirst || $_>$booklast);
}
if ($opt_r || $opt_a) {
$comment = shift @ARGV;
$phone = shift @ARGV;
if (length($comment)>$commentmax) {
die "Comment too long\n";
}
if (length($phone) > $phonemax) {
die "Phone number too long\n";
}
store_phone($opt_r||"",$comment,$phone);
unlock();
exit;
} elsif ($opt_d) {
delete_phone($opt_d);
unlock();
exit;
}
my %used;
my @book=modemcmd("AT+CPBR=$bookfirst,$booklast");
for (@book) {
if (/\+CPBR:\s*(\d+),"([^"]+)",(\d+),"([^"]+)"/) {
my $position=$1;
my $number=$2;
my $type=$3;
my $comment=$4;
printf $format,$position,$comment,$number unless $opt_l;
$used{$position}++;
}
}
unless ($opt_l) {
unlock(); exit;
}
while(<>) {
next unless /^\s*(\d+):(.*?)\s+(.*)$/;
delete $used{$1};
store_phone($1,$2,$3);
}
for (keys %used) {
delete_phone($_);
}
unlock();
sub store_phone {
my ($pos,$comment,$phone)=@_;
my $mode = 129;
$mode = 145 if $phone=~/\+/;
$comment=~s/["\\\010]/sprintf('\%02X',ord($1))/eg;
modemcmd("AT+CPBW=$pos,\"$phone\",$mode,\"$comment\"");
}
sub delete_phone {
my $index=shift;
modemcmd("AT+CPBW=$index");
}
# Sends its argument to modem
# ignores first line of input, and reads until OK or error is got
sub modemcmd {
my $cmd = shift;
print F "$cmd\r" or die $!;
my $echo = <F>;
print $echo if $opt_D;
my @responce;
while (<F>) {
print $_ if $opt_D;
die "Modem error\n" if /^ERROR\r?$/;
return @responce if /^OK\r?$/;
push @responce,$_;
}
die "EOF from modem;";
}
my $lockfile;
sub lock {
my $port = shift;
$port=~/\/(\w+)$/;
$lockfile = $lock_dir ."/LCK..$1";
sysopen(F,$lockfile,O_RDWR|O_CREAT|O_EXCL) ||
die "Cannot lock $port:$!\n";
print F $$,"\n";
close F;
$SIG{__DIE__}=\&unlock;
}
sub unlock {
unlink $lockfile;
}
==end mphonebook script
--
Victor Wagner [email protected]
Chief Technical Officer Office:7-(095)-748-53-88
Communiware.Net Home: 7-(095)-135-46-61
http://www.communiware.nethttp://www.ice.ru/~vitus
Отправлено через сервер Talk.Ru - http://www.talk.ru
