#!/usr/bin/perl
# Bill Adams bill<at>evil<dot>inetarena<dot>com
# License: GNU GPL
# Version: 1.0.0
#
# perldoc basic_callerid_logger.pl for more info...
#
# 18 Feb 2000  baa  Added documentation.

use strict;
use DBI;
use POSIX;
use Fcntl ':flock';
use FileHandle;


#Some vars...
my( $log_file );

#=========================================================================
# C O N F I G
#=========================================================================

#If you are having problems, change this to equal 1 for more stdout 
#  feedback.
my $DEBUG = 0;

my $modem_dev   = '/dev/modem';

#What string turns on your callerID?  This works with my
# USR sporster voice.
my $modem_init  = 'at#cid=1'; 
my $modem_reset = 'ATZ';

#How many times to try to talk with the modem?  Make sure this is >=1!
my $modem_retry = 5;

#How many seconds to wait between reads?  100-250ms (.1-.25) 
#  is a good choice.
my $poll_delay  = 0.25; #That's in seconds.

#Do you want a log of the output?
$log_file = '/tmp/callerid.log';

#Do you want to fork the process?  This is needed for
#  a startup script e.g. redhat.
my $daemon = 1;

#Database...
my $dbi_driver   = 'mysql';
my $dbi_db       = 'calld';
my $dbi_user     = 'calld';
my $dbi_password = 'calld'; 

#-----------------
#END config
#=========================================================================

#Variable def's
my( $termios, $old_termios, $dbh, $sth, $is_child );


$dbh = DBI->connect( 'dbi:'.$dbi_driver.':'.$dbi_db,
		     $dbi_user, $dbi_password );
unless( $dbh ){ die "Could not connect to $dbi_db"; }


$DEBUG && print "Trying to open $modem_dev\n";
my $modem_fd = POSIX::open( $modem_dev, 
			    &POSIX::O_RDWR |
			    &POSIX::O_NONBLOCK 
			  );
$DEBUG && print "  Opened.\n";
#my $modem_fd = open( $modem_dev, O_RDWR | O_NDELAY );
my $modem_fh = new FileHandle $modem_dev, O_RDWR | O_NDELAY;

my( $log_fh );
if( $log_file ){
  $log_fh = new FileHandle;
  unless( $log_fh->open( ">>$log_file ")){
    die "Could not open '$log_file' for writing: $!"; }
  $DEBUG && print "Opened log file '$log_file'\n";
  $log_fh->autoflush( 1 );
  print $log_fh "\n$0 started on ".localtime( )."\n";
}

my $have_lock = 0;
unless( $modem_fd ){
  die "Could not open '$modem_dev': $!";
}

$SIG{INT} = sub{
		print "Sig INT...exit.\n";
		$log_fh && print $log_fh "Sig INT...exit.\n";
		exit( );
	      };
		
END{
  
  
  $dbh->disconnect( ) if $dbh;
  
  if( $have_lock ){
    $DEBUG && print "END: Unlocking $modem_dev.\n";
    flock( $modem_fh, LOCK_UN );
  }
  
  if( $old_termios && $modem_fd ){
    $DEBUG && print "END: Restore termios on $modem_dev\n";
    $old_termios->setattr( $old_termios );
  }
    POSIX::close( $modem_fd ) if $modem_fd;
  
  if( $log_fh ){
    print $log_fh "END: ".localtime( )."\n";
    $log_fh->close( );
  }
}


$DEBUG && print "Opened '$modem_dev'\n";


if( 1 ){
  unless( flock( $modem_fh, LOCK_EX | LOCK_NB )){
    die "Could not lock '$modem_dev': $!\n"; }
  $have_lock = 1;
  $DEBUG && print "Locked $modem_dev\n";
}


#-------------------------------------------------------
# Begin termios setup
#
#Setting the flags does not return a defined value on success as
#  the man page states.  This code is taken almost directly from
#  xcallerid.

$termios     = POSIX::Termios->new;
$old_termios = POSIX::Termios->new;

#Get the old settings for a later restore.
$old_termios->getattr( $modem_fd );

#Set the imput mode flags...
$termios->setiflag( &POSIX::IGNPAR | #Ignore framing and parity errors. 
		    &POSIX::ICRNL ); #Translate CR to NL on input.

$termios->setoflag( 0 ); #Clear the output flags.

#Set the control modes...
if( defined &POSIX::CTRCSTS ){ #We have ctrscts...
  $DEBUG && print "Have CTRCSTS\n";
  $termios->setcflag( &POSIX::CRTCSTS | #Flow control.
		      &POSIX::CS8 |     #Character size mask.
		      &POSIX::CREAD );  #Enable receiver.
} else {
  $termios->setcflag( &POSIX::CS8 | &POSIX::CREAD );
}

#set the local modes...
#Enable canonical mode.  Enables special characters e.g. EOF and
#  buffers by lines.
$termios->setlflag( &POSIX::ICANON ); 


#Flush both data received but not read, and data
#  written but not transmitted.
&POSIX::tcflush( $modem_fd, &TCIOFLUSH ); 

#Setting the speed to 'B0' instructs the modem to "hang up".
$termios->setospeed( &POSIX::B0 ); #output baud rate.
$termios->setispeed( &POSIX::B0 ); #input baud rate.

#TCSANOW -- The change occurs immediately.
unless( defined $termios->setattr( $modem_fd, &POSIX::TCSANOW )){
  warn "POSIX::Termios Failed? $!";}

sleep( 1 );
$termios->setospeed( &POSIX::B38400 );
$termios->setispeed( &POSIX::B38400 );
#TCSAFLUSH -- The change occurs after all output written to the fd
#  has been transmitted.  This should be used when changing parameters
#  that affect output.
unless( defined $termios->setattr( $modem_fd, &POSIX::TCSAFLUSH )){
  warn "POSIX::Termios Failed? $!";}

#END termios setup.
#-----------------------------------------------------------------


#Here, we try to reset the modem.  Sometimes it does not like to respond
#  so loop if desired.  Use blocks for lexical 'my' variables.
{
  my $retry = $modem_retry > 0 ? $modem_retry : 1;
  while( $retry-- ){
    if( &modem_writeLine( $modem_fd, $modem_reset )){
      $DEBUG && print "Reset modem with '$modem_reset'\n";
      print $log_fh "Reset modem with '$modem_reset'\n" if $log_fh;
      $retry = 1;
      last( );
    }
    print $log_fh "Modem Reset Timed Out ($retry more tries).\n" if $log_fh;
  }
  unless( $retry ){
    print $log_fh "Error: Could not reset '$modem_dev' with '$modem_reset'\n"
      if $log_fh;
    die "Could not reset the modem";
  }
}

&modem_writeLine( $modem_fd, $modem_init ) || die "Could not init the modem";

$log_fh && print $log_fh "Modem Reset and initialized at ".localtime( )."\n"; 


if( $daemon ){
  $log_fh && print $log_fh "Trying to fork...\n";
  #This is taken directly from the perlipc man page...
  chdir( '/' );
  open STDIN, '/dev/null'     or die "Can't read /dev/null: $!";
  open STDOUT, '>/dev/null'   or die "Can't write to /dev/null: $!";
  defined( my $pid = fork( )) or die "Can't fork: $!";
  exit( 0 ) if $pid;
  POSIX::setsid               or die "Can't start a new session: $!";
  open STDERR, '>&STDOUT'     or die "Can't dup stdout: $!";

  #Change the name of the program presented in ps
  $0 = 'basic_callerid_logger';
}


my $previous_key = '';
my $info = +{};
while( 1 ){
  #Use select for less than one second delays...
  select( undef, undef, undef, $poll_delay );
  if( my $response = &modem_read( $modem_fd )){
    $DEBUG && print "Modem Responds '$response'\n";
    if( $response eq 'RING' ){
      $info = +{}; #Clear the info.
    } elsif( $response =~ /(\w+)\s*=\s*(.+)/ ){
      $previous_key = $1;
      $DEBUG && print "[$1][$2]\n";
      $info->{$1} = $2;

      if( $1 eq 'NAME' ){
	#The last thing to arrive is the name field.  At least
	#  on my modem.
	my @now = localtime( );
	my $local_datetime = sprintf( "%04d-%02d-%02d %02d:%02d:%02d",
				      $now[5] + 1900,
				      $now[4] + 1,
				      $now[3],
				      $now[2],
				      $now[1],
				      $now[0] );
				     

	my @values;
	push @values, 
	$info->{NAME},
	$info->{NMBR},
	$info->{DATE},
	$info->{TIME},
	$local_datetime,
	;

	#Edit the values in place (this changes the @values array)...
	foreach ( @values ){ $_ = $dbh->quote( $_ ); }

	$DEBUG  && print "Adding Data...\n";
	$log_fh && print $log_fh "New Call on ".localtime( )."\n";
	my $query = join( ' ',
			  'INSERT INTO calld_calls (',
			  join( ',', qw( name number id_date id_time
					 local_datetime ) ),
			  ') VALUES (',
			  join( ',', @values ),
			  ')',
			);
	$log_fh && print $log_fh $query."\n";
	my $count = $dbh->do( $query );
	if( defined $count ){
	  $DEBUG  && print "Inserted $count rows.\n";
	  $log_fh && print $log_fh "  Inserted $count rows.\n";
	} else {
	  $log_fh && print $log_fh "Error: Could not insert data: $query\n";
	  $DEBUG  && warn "Could not insert data: '$query'";
	}
	$info = +{};
      }

    } elsif( $previous_key eq 'NMBR' && $response =~ /^\d+$/ ){
      #For some reason, the number gets split across lines?
      $info->{$previous_key} .= $response;
    
    } else {
      $log_fh && print $log_fh "Unknown Response: '$response'\n";
      $DEBUG  && print "Unknown Response: '$response'\n";
      
    }
  }
}

exit( );

#===================================
# S U B S
#-----------------------------------

my $had_write_timeout = 0;
sub write_timeout {
  print "modem_writeLine timeout...\n";
  $had_write_timeout = 1;
}


sub modem_writeLine( $$ ){
  my $fd = shift || die;
  my $message = shift;
  unless( $message ){
    $log_fh && print $log_fh "modem_writeLine: Error: No message passed\n";
    $DEBUG  && warn "modem_writeLine: Error: No message passed\n";
    return( 0 );
  }

  my $tmp_message = $message;
  #Add the \r for the modem
  $tmp_message .= "\r" unless $tmp_message =~ /\r$/;

  my $count;
  unless( $count = POSIX::write( $fd, $tmp_message, length( $tmp_message ))){
    $log_fh && print $log_fh "Could not write '$message' to $modem_dev\n";
    $DEBUG  && warn "Could not write '$message' to $modem_dev\n";
    return( 0 );
  }
  $DEBUG && print "modem_writeLine( ) -- Wrote $count bytes.\n";

  $had_write_timeout = 0;
  $SIG{ALRM} = \&write_timeout;
  alarm( 2 );
  while( modem_read( $modem_fd ) ne $message && !$had_write_timeout ){ ; }
  my $tmp_message = '';
  while( $tmp_message !~ /OK|VCON|CONNECT/ && !$had_write_timeout ){
    $tmp_message = modem_read( $modem_fd );
  }
  alarm( 0 );
  $SIG{ALRM} = undef;
  $DEBUG && print "modem_writeLine: Done writing '$message'.\n";
  return( $had_write_timeout ? 0 : 1 );
}


sub modem_read( $$ ){
  my $fd = shift || die;
  my $buffer;
  my $tmp = '';
  my $bytes = POSIX::read( $fd, $buffer, 512 );
  if( $bytes > 0 ){
    #print "Got $bytes bytes.\n";
    while( substr( $buffer, -1, 1 ) eq "\n" ){ chop( $buffer ); }
  } else {
    $buffer = '';
  }
  if( $DEBUG && $buffer ){ print "modem_read: Got '$buffer'\n";}
  return( $buffer );
}

__END__

MySQL TABLE

DROP TABLE IF EXISTS calld_calls;
CREATE TABLE calld_calls 
  (
   name char(32) NOT NULL DEFAULT '',
   number char(16) NOT NULL DEFAULT '',
   id_date char(4) NOT NULL DEFAULT '',
   id_time char(4) NOT NULL DEFAULT '',
   local_datetime datetime NOT NULL DEFAULT '0000-00-00 00:00:00',
   serial_cc integer NOT NULL AUTO_INCREMENT,
   PRIMARY KEY( serial_cc )
);

=head1 NAME 

basic_callerid_log.pl - log calls to a DBI/DBD database.


=head1 DESCRIPTION

This program provides basic caller-id logging to a database.  It was
written to use mysql but as long as you can generate the table 
for your own database, it should work fine.  It puts the data into the
table without any format changes:  The idea is that an auxiliary program
can make the format changes when it displays the data.

If you want a GUI caller-id program, please check out B<gnuvoice>
and B<xcallerid>.  More information on these programs can be found on
freshmeat ( http://freshmeat.net/ ).  These programs offer other features
like voicemail.  This program can be a daemon in the background when
no one is logged in.


=head1 REQUIREMENTS

The following modules are required for this program.  If you 
did not get them with your perl distribution, you can find them
on your favorite CPAN mirror.  Or try C<perl -MCPAN -e shell> as root.

=over4

=item I<Modem> -- Your modem has to support callerid and you also
have to have that service.  Usually the phone company charges for it.

=item I<DBI> -- The database independent interface.

=item I<DBD> -- A DBI driver for your favorite database (yfdb).

=item I<POSIX> -- For the termios stuff.

=item I<FileHandle> -- A IO abstraction layer. Standard with most installs 
of perl.

=item I<Fcntl>  -- For locking. Standard?

=item I<Database>  -- Some database for which you have installed 
the DBD module.  The 'CREATE TABLE' definitions are in the source 
code so do a 'more' on this program to find it.  If you design
a new schema, please send it to me so I can add it.  You can 
get MySQL from http://www.mysql.com/ .

=back

=head1 LICENSE

This program is released under the GNU GPL V2.  For the record
most of the modem interface code was ported directly from StdModem.C in 
xcallerid -- which is also a GPL program.


=head1 BUGS

Requires a bit of user intervention to set up.

=head1 AUTHOR

Bill Adams bill<at>evil<dot>inetarena<dot>com

The latest version of this can be found somewhere on 
http://evil.inetarena.com/.

=cut