PDA

View Full Version : کالر آی دی با پرل



ARA
چهارشنبه 23 خرداد 1386, 17:57 عصر
سلام از اونجایی که من خیلی دوست دارم در رابطه با پرل بیشتر کارکنم ولی مشغله کاری نمیگذاره و هر از چند گاهی که به این قسمت هم سر میزنم که میبینم خبری نیست

حالا یک کد جالب برای کار با at command های مودم پیدا کردم میگذارم اینجا که خواستین چکش کننین هنوز خودم چکش نکردم :چشمک:





<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML><HEAD>
<META http-equiv=Content-Type content="text/html; charset=windows-1256"></HEAD>
<BODY><PRE>#!/usr/local/bin/perl5 -w
#
# Caller-ID-logger, by jwz (19-Jan-97)
# Modified: 22-Sep-99
#
# Opens the modem and waits for it to print caller-ID data. When it does,
# it logs it to a file, parses it, and pops up a window using "xmessage".
# If the number is present in your .bbdb file, it shows the name (or company)
# associated with it.
#
# Todo:
# Currently BBDB only gets the phone number, not the name. It should look
# up the name if the number doesn't match.
#
# Modems other than ZyXELs have different caller-ID formats, and this doesn't
# deal with those.
################################################## ############################
#
# Some variables you might want to set...

# Set this to the device that your modem is attached to.
#
$modem_device = "/dev/ttyd1";
# kludge...
if ( ! $ENV{HOME} ) { $ENV{HOME} = "/u/jwz"; }
# This is your .bbdb file. (Set it to null if you don't want to do BBDB
# lookups at all, but why would you want to go and do a thing like that?)
#
$bbdb_file = "$ENV{HOME}/.bbdb";
# A shell command to use to cause emacs to pop up the BBDB buffer
# (bbdb-srv.pl is a good choice, so it defaults to the value of the
# shell environment variable $NS_MSG_DISPLAY_HOOK.)
#
$bbdb_cmd = $ENV{NS_MSG_DISPLAY_HOOK};
# If you want the $bbdb_cmd to be run on a different host, set it here.
#
$bbdb_host = "grendel";
$rsh_command = "ssh";
# If this script runs as root, and you want it to `su' before running bbdb,
# set this to the user name.
#
$bbdb_uid = 0;
#$bbdb_uid = "jwz";
# If you want each call to be logged to a file as well, name it here.
#
$logfile = "/usr/local/etc/cid-log";
# For verbosity...
$debug = 1;
# How to pop up a dialog box.
#
$xmessage_cmd = "xmessage";
@xmessage_args = ("-display", ":0",
"-name", "Caller ID",
# SGI lossage
"-xrm", "*useSchemes: none",
# roughly centered on my screen; YMMV.
# "-geometry", "+400+400",
"-geometry", "+260+320",
# "-xrm", "*Font: -*-new cent*-bold-r-normal-*-240-*",
"-xrm",
"*Font: -*-new cent*-bold-r-normal-*-*-512-*-*-*-*-*-*",
"-xrm", "*Foreground: black",
"-xrm", "*Background: lightgreen",
# no buttons on the window: dismiss it by clicking in it.
"-button", "",
"-xrm", "*form.Translations: #override &lt;BtnDown&gt;: exit(0)",
# "-xrm", "*Command.Font: -*-new cent*-bold-r-normal-*-120-*",
"-xrm",
"*Command.Font: -*-new cent*-bold-r-normal-*-*-240-*-*-*-*-*-*",
"-xrm", "*Command.horizDistance: 200",
"-xrm", "*internalWidth: 25",
"-xrm", "*internalHeight:25"
);
# Do you want to turn off the screensaver before popping up the window?
# I've decided that I don't.
#
#$pre_dialog_cmd = "xscreensaver-command -deactivate";
$pre_dialog_cmd = 0;
# To make the computer do intelligent ringing instead of the phone.
# (This could work better.)
#
$ring_cmd = "/u/jwz/src/cid/ring.sh";

# commands (and their expected responses) used to initialize the modem.
#
@modem_init = ( "AT", "OK", # ping
"ATZ", "OK", # reset
"ATE0", "OK", # don't echo commands
"ATM0", "OK", # turn off speaker
"ATN0", "OK", # turn off ringer
"ATS40.2=1", "OK", # turn on caller ID
);

# for diagnostics: if the modem ever asynchronously prints something that
# doesn't match this, we issue a warning.
#
$expected_responses = "^CALLER NUMBER" . "|" .
"^CALLER NAME" . "|" .
"^REASON FOR NO CALLER " . "|" .
"^RING\$" . "|" .
"^TIME: [-0-9: ]+\$";

################################################## ############################
#
# Talking to the serial port...
#
#
if ( $ debug ) {
use diagnostics;
}

sub DEBUG {
if ( $debug ) {
my ($str) = @_;
my $d = localtime;
print STDERR "$d: $str\n";
}
}
sub open_modem {
use IPC::Open2;
# Close the terminal streams before forking `cu', because otherwise
# it fucks around with the stty settings.
#
# 8-Dec-98 -- for some reason this doesn't work any more; it makes the
# forked "cu" no longer function. What changed? All I can think of is that
# I installed a newer version of perl.
# open(SAVEIN, "&lt;&amp;STDIN") || die("can't dup stdin");
# open(SAVEOUT, "&gt;&amp;STDOUT") || die("can't dup stdout");
# open(SAVEERR, "&gt;&amp;STDERR") || die("can't dup stderr");
# close(STDIN);
# close(STDOUT);
# close(STDERR);
my $cu_pid = open2( \*MODEM_IN, \*MODEM_OUT,
"cu -l$modem_device -s2400 2&gt;&amp;1");
# Now that cu has been launched, we can restore them.
#
# open(STDIN, "&lt;&amp;SAVEIN") || die("can't restore stdin");
# open(STDOUT, "&gt;&amp;SAVEOUT") || die("can't restore stdout");
# open(STDERR, "&gt;&amp;SAVEERR") || die("can't restore stderr");
# close(SAVEIN);
# close(SAVEOUT);
# close(SAVEERR);
# The following doesn't seem to work and I don't know why...
#
# Set up a signal handler to try and kill off the cu process
# when we exit, instead of waiting ~30 seconds for it to notice
# that the pipe is gone...
#
# $SIG{INT} = sub { my $signame = shift;
# DEBUG "sending $signame to $cu_pid";
# }
# print MODEM_OUT "\r\n~.\r\n";
# close MODEM_OUT;
# close MODEM_IN;
# kill ($signame, $cu_pid);
# exit (1);
# };
$_ = &lt;MODEM_IN&gt;;
chop;
if ( !m/^Connected/ ) {
DEBUG "$0: cu printed `$_' instead of `Connected'";
}
}
sub read_line {
$_ = &lt;MODEM_IN&gt;;
$_ || die("got eof on modem");
s/[\r\n]+$//;
if ( $_ eq "" ) {
$_ = &lt;MODEM_IN&gt;;
$_ || die("got eof on modem");
s/[\r\n]+$//;
}
return $_;
}
sub command {
my ( $command, $expected_response) = @_;
if ( $debug ) {
DEBUG "sending: $command";
}
print MODEM_OUT "$command\r\n";
my $line = read_line();
if ( $line eq $command ) {
if ( $debug ) {
DEBUG " got echo: reading next line too...";
}
$line = read_line();
}
if ( $line ne $expected_response ) {
DEBUG " got: $line ; expected: $expected_response";
} elsif ( $debug ) {
DEBUG " got: $line";
}
}
sub init_modem {
open_modem;
my $len = $#modem_init + 1;
my $i;
for ($i = 0; $i &lt; $len; $i += 2) {
command($modem_init[$i], $modem_init[$i+1]);
}
}
sub handle_async_line {
local ( $_ ) = @_;
if (!m/$expected_responses/) {
DEBUG "modem turd: $_";
} elsif (m/CALLER NUMBER/) {
if ( $debug ) {
DEBUG "number: $_";
}
handle_cid_line($_);
} elsif (m/CALLER NAME/) {
if ( $debug ) {
DEBUG "name: $_";
}
handle_cname_line($_);
} elsif (m/^RING$/) {
if ( $debug ) {
DEBUG "ring: $_";
}
handle_ring_line($_);
} elsif ( $debug ) {
if ( $_ eq '' ) {
DEBUG "ignored: blank line";
} else {
DEBUG "ignored: $_";
}
}
}

################################################## ############################
#
# Parsing BBDB and CID data...
#
sub find_bbdb_record {
my ( $area, $exchange, $suffix ) = @_;
if ( ! $bbdb_file ) {
return undef;
}
# strip off leading 0's, to match the way it's stored in .bbdb.
$area =~ s/^0+(.)/$1/;
$exchange =~ s/^0+(.)/$1/;
$suffix =~ s/^0+(.)/$1/;
my $which = undef;
my $bbdb_rec = undef;
my $pat = "\\[\"([^\"]+)\ (file://\\[\)" $area $exchange $suffix (nil|[0-9]+)\\]";
open(BBDB, "&lt;$bbdb_file") || die("error opening $bbdb_file: $!\n");
while (&lt;BBDB&gt;) {
if ( m/$pat/ ) {
$bbdb_rec = $_;
$which = $1;
last;
}
}
close(BBDB);
return ($bbdb_rec, $which);
}

# note: global (kludge!)
$pretty_number = 0;
sub make_message_string {
my ( $number, $date, $fn, $ln, $co, $which, $caller_name, $error ) = @_;
my $msg_date;
my $msg_name;
my $msg_name2;
my $msg_number;
my $line_prefix = " ";
my $line_suffix = " ";

if ( $caller_name &amp;&amp; $caller_name eq "" ) {
$caller_name = 0;
}
# First reformat the date.
#
$_ = $date;
my ( $dotw, $mon, $day, $hr, $min, $sec, $year ) =
m/^([^ ]+) +([^ ]+) +([^ ]+) +([^:]+):([^:]+):([^:]+) +([^ ]+) *$/;
$year =~ s/^..(..)/$1/;
$day =~ s/^0//;
$hr =~ s/^0//;
if ($hr &lt; 12) {
$ampm = "am";
if ($hr == 0) { $hr = 12; };
} else {
$ampm = "pm";
if ($hr &gt; 12) { $hr -= 12; };
}
$msg_date = "$hr:$min$ampm, $day $mon ($dotw)";

# Next format the caller name, company, or error message.
# (This is the BBDB version of the name.)
#
if ( $error ) {
$msg_name = "$error";
} elsif ( $co &amp;&amp; !$fn &amp;&amp; !$ln ) {
$msg_name = "$co";
} elsif ( $fn || $ln ) {
$msg_name = "$fn $ln";
}
# Next format the telephone company's version of the name.
# (This is the version we read off the line, if any.)
#
$msg_name2 = "";
if ( $caller_name ) {
$_ = $caller_name;
s/(\w+)/\u\L$1/g; # capitalize line.
s/^([^ ]+) (.+)$/$2 $1/; # move first word to end.
if ( ! $fn ) { $fn = ""; }
if ( ! $ln ) { $ln = ""; }
if ( ! m/^$fn $ln$/i ) { # skip if exact match
$msg_name2 = "$_";
}
}
# Next format the phone number.
#
$pretty_number = 0;
if ( $number ) {
my $area = 0;
my $exchange = 0;
my $suffix = 0;
$_ = $number;
( $area, $exchange, $suffix ) =
m/^([0-9][0-9][0-9])([0-9][0-9][0-9])([0-9][0-9][0-9][0-9]+)/;
# note: global (kludge!)
$pretty_number = "($area) $exchange-$suffix";
}
if ($which) {
if (length($which) &gt;= 8) {
$pretty_number .= "$line_suffix\n$line_prefix($which)";
} else {
$pretty_number .= " ($which)";
}
}
my $msg;
my $short_msg;
$msg = $line_prefix . $msg_date . $line_suffix;
$msg .= "\n" . $line_prefix . $msg_name . $line_suffix;
$short_msg = "$msg_date: $msg_name";
if ( $msg_name2 &amp;&amp; $msg_name2 ne "" ) {
$msg .= "\n" . $line_prefix . "($msg_name2)" . $line_suffix;
$short_msg .= " ($msg_name2)";
}
if ( $pretty_number &amp;&amp; $pretty_number ne "" ) {
$msg .= "\n" . $line_prefix . $pretty_number . $line_suffix;
$short_msg .= "; $pretty_number";
}
# Log the short message too...
#
if ( $logfile ) {
if (open(LOG, "&gt;&gt;$logfile")) {
print LOG "** $short_msg\n";
close LOG;
} else {
DEBUG "error opening $logfile: $!";
}
}

return $msg;
}
use POSIX;
sub reaper {
$SIG{CHLD} = \&amp;reaper; # loathe sysV
my $signame = shift;
if ( $debug &gt;= 2 ) {
DEBUG " (got SIG$signame...)";
}
my $child;
while ( ( $child = waitpid(-1,WNOHANG) ),
$child &gt; 0 ) {
if ( $debug &gt;= 2 ) {
DEBUG " (pid $child exited with $?)";
}
}
}
sub fork_and_exec {
my @cmd_list = @_;
$SIG{CHLD} = \&amp;reaper;
if ( $debug &gt;= 2 ) {
$_ = $cmd_list[0];
s/ .*//;
DEBUG "forking for " . $_ . " at " . (localtime) . ".";
}
my $pid;
if ($pid = fork()) {
# parent
} elsif (!defined $pid) {
DEBUG "$0: fork failed: $!";
} else {
# child
if ( $debug ) {
$_ = $cmd_list[0];
s/ .*//;
DEBUG "exec'ing $_ in pid $$.";
}
close(STDIN);
# close(STDOUT);
# close(STDERR);
exec @cmd_list;
}
}

sub fork_and_exec_for_bbdb {
my @cmd_list = @_;
my $number = shift @cmd_list;
$SIG{CHLD} = \&amp;reaper;
if ( $debug &gt;= 2 ) {
$_ = $cmd_list[0];
s/ .*//;
DEBUG "forking for " . $_ . " at " . (localtime) . ".";
}
my $pid;
if ($pid = fork()) {
# parent
} elsif (!defined $pid) {
DEBUG "$0: fork failed: $!";
exit (1);
} else {
# child
if ( $debug ) {
$_ = $cmd_list[0];
s/ .*//;
DEBUG "exec'ing $_ in pid $$.";
}
if ( system @cmd_list ) {
my $cmd = "gnudoit -q '(bbdb-srv-add-phone \"$pretty_number\")'";
if ( $bbdb_host ) {
$cmd =~ s/([()\"])/\\$1/g;
$cmd = "$rsh_command $bbdb_host $cmd";
}
# if ( $bbdb_uid ) {
# $cmd =~ s/([()\"])/\\$1/g;
# $cmd = "su - $bbdb_uid -c \"$cmd\"";
# }
if ( $debug &gt; 1 ) {
DEBUG "command: $cmd";
}
exec $cmd;
}
exit (0);
}
}

sub pop_up_dialog {
my ( $msg, $buttonp, $number ) = @_;
if ( $pre_dialog_cmd ) {
fork_and_exec $pre_dialog_cmd;
}
# $msg = "\n$msg\n\n";
if ( ! $buttonp ) {
fork_and_exec $xmessage_cmd, @xmessage_args, $msg;
} else {
my @args = ( @xmessage_args, "-button", "Add To BBDB" );
fork_and_exec_for_bbdb $number, $xmessage_cmd, @args, $msg;
}
}
sub pop_up_bbdb_buffer {
my ( $caller ) = @_;
if ( $bbdb_cmd ) {
my $cmd = $bbdb_cmd;
if ( $bbdb_host ) {
$cmd = "$rsh_command $bbdb_host $cmd";
}
if ( $bbdb_uid ) {
$cmd = "su - $bbdb_uid -c '$cmd'";
}
$caller =~ s/\\/\\\\/g;
$caller =~ s/\"/\\\\\"/g;
$cmd = "echo \"Path:\nFrom: \\\"$caller\\\" &lt;&gt;\" | $cmd &gt;&amp;- 2&gt;&amp;- &amp;";
if ( $debug &gt; 1 ) {
DEBUG "executing: $cmd";
}
system $cmd;
}
}

sub handle_cid_line {
my($line) = @_;
my $date = localtime;
# Log the call...
#
if ( $logfile ) {
if (open(LOG, "&gt;&gt;$logfile")) {
print LOG "$date\t$line\n";
close LOG;
} else {
DEBUG "error opening $logfile: $!";
}
}
# Pull the phone number out of the message...
#
my $number = "";
my $error = "";
$_ = $line;
if ( m/^CALLER NUMBER/ ) {
( $number ) = m/^[^:]+: *(.*) *$/;
} else {
$error = $line;
}
my $caller = undef;
my $fn = undef;
my $ln = undef;
my $co = undef;
my $which = undef;
my $buttonp = 0;
if ( !$number || $number eq "" ) {
$error =~ tr#A-Z#a-z#;
$error =~ s/^REASON FOR NO CALLER (NUMBER|NAME)/Caller unknown/i;
} else {
$_ = $number;
my $area = 0;
my $exchange = 0;
my $suffix = 0;
( $area, $exchange, $suffix ) =
m/^([0-9][0-9][0-9])([0-9][0-9][0-9])([0-9][0-9][0-9][0-9]+)/;
my $bbdb_rec;
($bbdb_rec, $which) = find_bbdb_record($area, $exchange, $suffix);
if ( $bbdb_rec ) {
my $junk = 0;
$_ = $bbdb_rec;
# This will lose if names or aliases have double-quotes in them.
# No doubt there's some hairier regexp magic that handles that...
( $fn, $ln ) = m/^[\[]\"([^\"]*)\" *\"([^\"]*)\"/;
# handle folks with only one name
if ( !$fn &amp;&amp; !$ln ) {
( $fn ) = m/^[\[]\"([^\"]*)\" nil /;
if ($fn) { $ln = ""; }
}
( $junk, $junk, $junk, $co ) =
m/^[[](nil|\"[^\"]*\") *(nil|\"[^\"]*\") (nil|[(][^)]*[)]) \"([^\"]*)\"/;
if ( $fn || $ln ) {
$caller = "$fn $ln";
}
if ( $which ) {
$_ = $which;
s/[ \t][ \t]+/ /g; # compress whitespace
s/\(cid\)//g; # lose "cid" in parens
s/\bcid\b//g; # lose "cid" as a word
s/^ *\((.*)\) *$/$1/; # "(foo)" =&gt; "foo"
s/\(.*?\)//g; # lose anything in parens
s/[ \t][ \t]+/ /g; # compress whitespace
s/^ //; s/ $//; # lose leading/trailing whitespace
$which = $_;
if ($which =~ /^$/) {
$which = undef;
}
}
} else {
$buttonp = 1;
}
}
my $msg = make_message_string($number, $date, $fn, $ln, $co, $which,
$caller_name, $error);
pop_up_dialog($msg, $buttonp, $pretty_number);
if ( $caller ) {
pop_up_bbdb_buffer($caller);
}
# clear it for next time
$caller_name = "";
}
sub handle_cname_line {
my($line) = @_;
my $date = localtime;
# Log the call...
#
if ( $logfile ) {
if (open(LOG, "&gt;&gt;$logfile")) {
print LOG "$date\t$line\n";
close LOG;
} else {
DEBUG "error opening $logfile: $!";
}
}
# Pull the caller name out of the message...
#
$caller_name = "";
$_ = $line;
if ( m/^CALLER NAME/ ) {
( $caller_name ) = m/^[^:]+: *(.*) *$/;
$caller_name =~ s/[ \r\n]*$//;
}
}

# Make a phone-ringing sound.
#
# Rather than just letting ring.sh decide how loud to ring it each time,
# ask ring.sh how loud it would do it the first time, then do all the
# rings at that volume. That's because the answer will change when we
# turn off the screensaver...
#
# Wait N minutes before asking again, where N is hopefully longer than
# the screensaver timeout value -- and therefore, if the console is idle,
# the screensaver will have reactivated before we ask again.
#
# The other way in which this sucks is that the rings that the computer
# makes are delayed by about two seconds from the rings that the phone
# would make. This is is because the modem doesn't actually print a
# "RING" line until the ring has *completed*.
#
# TODO: Given that we don't end up processing the first RING line until just
# before we process the caller ID info (they come within 1/8 second of
# each other) we might as well ring differently for different cid info,
# right? Like, "don't ring if privacy or out-of-area" or something.
#
# The hard part here is, how do you detect "end of call"? Maybe by
# noticing that more than N seconds has passed between RING lines?
# That would only do the wrong thing if one call came right on the
# tail of another (but the second cid line would be the clue there.)
my $be_quiet = 0;
my $be_quiet_time = 0;
sub handle_ring_line {
my($line) = @_;
if ( $pre_dialog_cmd ) {
my $minutes = 6; # duration of cache
if ( $be_quiet_time &lt; (time - ($minutes * 60)) ) {
$be_quiet_time = time;
my $q = `$ring_cmd -query`;
chop $q;
$be_quiet = ( "$q" eq "quiet" );
}
if ( $ring_cmd ) {
if ( $be_quiet ) {
fork_and_exec "$ring_cmd -quiet";
} else {
fork_and_exec "$ring_cmd -loud";
}
}
} else { # the simple way...
fork_and_exec "$ring_cmd";
}
}


################################################## ############################
#
# hey ho. let's go.
#
sub main {
init_modem();
while (1) {
handle_async_line(read_line());
}
exit (1);
}
main();
</PRE></BODY></HTML>