#!/usr/bin/perl
# $Id: smdr 772 2006-10-28 13:25:28Z jhealy $
# smdr
#
# Reads call accounting data from Panasonic KX-TA616 over a serial
# terminal, parses the output, ans stores in a relational database for
# reporting.
#
# Jason Healy <jhealy@suffieldacademy.org>
#
# See http://web.suffieldacademy.org/ils/netadmin/software/smdr/
# for more information about this script.
#
# Adjustments for Panasonic KX-TA616 from Hauke Luckow <hauke.luckow@gmail.com>
#
use warnings;
use strict;
# Try to figure out our own hostname
use Sys::Hostname;
# Include modules for accessing the serial port directly
use Device::SerialPort;
# Database connection modules
use DBI;
# Date parsing
use Time::Local;
# Log errors to syslog instead of console
use Unix::Syslog qw(:macros :subs);
# Dump out data that won't go in the DB
use Data::Dumper;
# Use POSIX to allow for disassociation from terminal
use POSIX 'setsid';
# get our hostname
my $HOSTNAME = hostname;
# Serial port to listen on
my $PORT = '/dev/ttyS0';
# Number of bytes to read for each record
my $RECORD_BYTES = 81;
# PID file to write to
#my $PIDFILE = '/var/run/smdr';
my $PIDFILE = '/var/run/smdr';
# Set to 0 to stop running
my $RUNNING = 1;
# Sleep time (use a binary backoff algorithm)
my $snooze = 1;
# Check for debug flag
my $DEBUG = 0;
if ($#ARGV > -1 && $ARGV[0] eq '-D') {
  $DEBUG = 1;
  print "Started in debug mode\n";
}
# Database settings
my $DBHOST = '<YourHostName>';
my $DBNAME = 'smdr';
my $DBUSER = 'smdr';
# read the SQL database password from a file
my $DBPASS_FILE = '/etc/smdr_pwd';
my $DBPASS = '';
open(DBPASS, $DBPASS_FILE) or
  die "Couldn't read Postgres password file '$DBPASS_FILE': $1\n";
chomp($DBPASS = <DBPASS>);
close(DBPASS);
# Samples call accounting line Panasonic TA-KX616:
#
# Line:   4/14/08   8:30AM 104  04 0123456789                            00:30'14" ....  
# Line:  14/14/08 *11:30PM 111  03   <    incoming    >                  02:10'04" ....  
# Count: 123456789112345678921234567893123456789412345678951234567896123456789712345678981
#                 0         0         0         0         0         0         0         0
#
# Sample call format:
# 1-2		MM	Call start month (1- or 2-digit)		START_MONTH	$1
# 3		/	Separator
# 4-5		DD	Call start day (1- or 2-digit)			START_DAY 	$2
# 6		/	Separator
# 7-8		YY	Call start year (2-digit)			START_YEAR	$3
# 9			White space (1-digit)
# 10		*	Transfer (* or White space)			TRANSFER	$4
# 11-12		HH	Call start hour (1- or 2-digit)			START_HOUR	$5
# 13		:	Separator
# 14-15		MM	Call start minute (2-digit)			START_MINUTE	$6
# 16-17		AM	Day part (AM or PM)				DAY_PART	$7
# 18			White space (1-digit)
# 19-21		101	Extention / (Linie intern)			STATION		$8
# 22-23			White space (2-digit)
# 24-25		01	Line / Trunk / (Linie extern)			LINE		$9
# 26			White space (1-digit)
# 27-64			Dialed number or "<    incoming    >"		NUMBER		$10
# 65-66		HH	Call duration hour				CALL_HOUR	$11
# 67		:	Separator
# 68-69		MM	Call duration minute				CALL_MINUTE	$12
# 70		'	Separator
# 71-72 	SS	Call duration second				CALL_SECOND	$13
# 73		"	Separator
# 74-75			White space (1-digit)
# 76-80		1234	Access code (1- to 4-digit rest ....)		ACCESS		$14
# 81			carriage return
#
# Here's the pattern that matches these bytes:
my $RECORD_PATTERN = '(\ \d|\d{2})\/(\ \d|\d{2})\/(\d{2})\ (\ |\*)(\ \d|\d{2})\:(\d{2})(AM|PM)\ (\d{3})\ {2}(\d{2})\ (\d{2,38}\ {0,36}|\ {2}\<\ {4}incoming\ {4}\>\ {18})(\d{2})\:(\d{2})\'(\d{2})\"\ (\.{0,4}\d{0,4})\ {2}\r';
#			   $1	        $2           $3	      $4       $5	  $6	  $7	  $8	      $9	              $10	                           $11      $12      $13             $14
#
# Here are constants that name all the portions of the match
my $START_DAY = 'startDay';
my $START_MONTH = 'startMonth';
my $START_YEAR = 'startYear';
my $TRANSFER = 'transfer';
my $START_HOUR = 'startHour';
my $START_MINUTE = 'startMinute';
my $DAY_PART = 'dayPart';
my $STATION = 'station';
my $LINE = 'line';
my $NUMBER = 'number';
my $CALL_HOUR = 'callHour';
my $CALL_MINUTE = 'callMinute';
my $CALL_SECOND = 'callSecond';
my $ACCESS = 'access';
# Other constants
my $START_SECOND = 'startSecond';
my $START = 'start';
my $DURATION = 'duration';
my $DIRECTION = 'direction';
# Log messages to syslog
sub logWarn($;$) {
  my $message = shift(@_);
  my $level = shift(@_) || LOG_NOTICE;
  if ($DEBUG) {
    print "Log: $message\n";
  }
  else {
    openlog "smdr", LOG_PID, LOG_DAEMON;
    syslog $level, "%s", $message;
    closelog;
  }
}

# Log errors and try to clean up before death
local $SIG{__DIE__} = sub { unlink $PIDFILE; logWarn($_[0], LOG_ERR); };
# parse a single line of output into a record
sub parseRecord($;) {
  my $r = shift(@_);
  my %record = ();
  if (length($r) != $RECORD_BYTES) {
    logWarn("Invalid record length: " . length($r) . " ('$r')\n");
  }
  elsif ($r =~ /^$RECORD_PATTERN$/x) {
    %record = (
		$START_MONTH => int($1),
		$START_DAY => int($2),
		$START_YEAR => int($3),
		$TRANSFER => $4,
		$START_HOUR => int($5),
		$START_MINUTE => int($6),
		$DAY_PART => $7,
		$STATION => int($8),
		$LINE => int($9),
		$NUMBER => $10,
		$CALL_HOUR => int($11),
		$CALL_MINUTE => int($12),
		$CALL_SECOND => int($13),
		$ACCESS => $14
	      );
    
    # the number might be blank (incoming), so only convert it if numeric
    if ($record{$NUMBER} =~ /(\d+)/) {
      $record{$NUMBER} = $1;
      $record{$DIRECTION} = 'O';	
    }
    else {
      $record{$NUMBER} = undef;
      $record{$DIRECTION} = 'I';	
    }
    # was the call a transfer?
    if ($record{$TRANSFER} eq '*') {
      $record{$TRANSFER} = 'Y';
    }
    else {
      $record{$TRANSFER} = 'N';
    }
    
    # Determine START_YEAR
    $record{$START_YEAR} = $record{$START_YEAR} + 2000;
    # Determine START_HOUR
    if (($record{$DAY_PART} eq 'PM') && ($record{$START_HOUR} < 12)) {
      $record{$START_HOUR} = $record{$START_HOUR} + 12;
    }
    # Determine START_SECOND
    $START_SECOND = 00;
    # parse full time and date into single strings
    $record{$START} = $record{$START_YEAR} . '-' . $record{$START_MONTH} .
      '-' . $record{$START_DAY} . ' ' . $record{$START_HOUR} .
	':' . $record{$START_MINUTE} . ':' . $START_SECOND;
    # get duration (in seconds)
    $record{$DURATION} = $record{$CALL_HOUR} * 3600 + $record{$CALL_MINUTE} * 60 + $record{$CALL_SECOND};
  }
  else {
    my $hex = "";
    for my $c (split("", $r)) {
      my $p = pack "a", $c;
      my $u = unpack "H*", $p;
      $hex .= "$u ";
    }
	logWarn("Invalid record format:\n'$r'\n($hex)\n");
  }
  return %record;
}

# Connect to the database and insert a record
my $INSERT_CALL = "INSERT INTO calls(number, start_time, duration, direction, station, line, transfer, access) " .
  "VALUES(?, ?, ?, ?, ?, ?, ?, ?)";
my $dbh;
my $insertCall;
sub insertRecord(%;) {
  my %rec = @_;
  if (!defined($dbh) || !$dbh->ping) {
    logWarn("Database handle no longer valid; reconnecting...", LOG_DEBUG);
    # (re-)connect to the database
    $dbh = DBI->connect("dbi:Pg:dbname=$DBNAME;host=$DBHOST",
			$DBUSER, $DBPASS, {
					   AutoCommit => 1,
					   RaiseError => 0
					  })
      or die ("Could not connect to database: " . $dbh->errstr . "\n");
    # prepare the statements so they're ready to execute
    $insertCall = $dbh->prepare($INSERT_CALL) or
      die "Could not prepare INSERT_CALL statement: " . $dbh->errstr . "\n";
  }
  # try to insert our own copy of the record
  if ($insertCall->execute
	 ($rec{$NUMBER}, $rec{$START}, $rec{$DURATION}, $rec{$DIRECTION},
	  $rec{$STATION}, $rec{$LINE}, $rec{$TRANSFER}, $rec{$ACCESS})
	 ) {
	if ($DEBUG) {
	  print "\n\nInserted record:\n\n";
	  for my $key (sort keys %rec) {
	    print "\t$key\t$rec{$key}\n" if defined($rec{$key});
	  }
       }
    }
    elsif ($DEBUG) {
	print "Unable to insert our own call record: " . $dbh->err . "\n";
    	# attempt to save record to local disk
	my $tmp = `mktemp -t smdr.XXXXXXXXXX`;
	if (open(DUMP, ">$tmp")) {
	  print DUMP Dumper(\%rec);
	  logWarn("Uninserted record dumped to $tmp");
	  close(DUMP);
	  }
	else {
	  logWarn("Could not open file $tmp to save uninserted record: $!\n");
	  }
    }
}
# signal handlers; clean up safely when its time to quit
sub quit {
  my $signal = shift;
  $RUNNING = 0;
  $snooze = 0;
  logWarn("Caught signal $signal, cleaning up");
}
$SIG{INT}  = \&quit;
$SIG{TERM} = \&quit;

############################################################################
###                               MAIN                                   ###
############################################################################
if ($DEBUG) {
  print "Not disconnecting from terminal\n";
  print "Not writing PID file\n";
}
else {
  # disassociate from controlling terminal
  chdir '/'                 or die "Can't chdir to /: $!";
  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 if $pid;
  setsid                    or die "Can't start a new session: $!";
  open STDERR, '>&STDOUT'   or die "Can't dup stdout: $!";
  # now log the PID so we can be killed later
  open(PID, ">$PIDFILE") or logWarn("Couldn't open PID file: $!\n", LOG_ERR);
  print PID $$;
  close(PID);
}
# open serial port connection
my $port = Device::SerialPort->new($PORT) or
  die "Can't open serial port $PORT: $!";
$port->baudrate(9600)       or die "failed setting baudrate";
$port->parity("none")       or die "failed setting parity";
$port->databits(7)          or die "failed setting databits";
$port->stopbits(1)          or die "failed setting stopbits";
$port->handshake("rts")     or die "failed setting handshake";
$port->write_settings       or die "failed writing settings";

logWarn("Started and ready to process data");
# buffer to hold data until we have a full record
my $buffer = '';
# loop forever and process data
while ($RUNNING) {
  my ($count, $data) = $port->read($RECORD_BYTES);
  if ($count == 0) {
    if ($DEBUG) {
      print "No data available, sleeping for $snooze\n";
    }
    sleep $snooze;
    # binary backoff; double each time
    if ($snooze < 30) {
      $snooze = $snooze * 2;
    }
  }
  else {
    if ($DEBUG) {
      print "Read $count bytes: '$data'\n";
    }
    # add data to the buffer
    $buffer .= $data;
    
    # (1) Delete page header
    # '\r  Date      Time  Ext. CO      Dial number                      Duration  Code  '
    # '\r--------------------------------------------------------------------------------'
    # (2) Delete uncomplete dataset
    #	
    # check if min. length of dataset in buffer 8-digits (' 1/ 1/01' = 8)
    # and check if date stands at the beginning of the dataset
    while ((length($buffer) >= 8) and (not $buffer =~ m/^(\ \d|\d{2})\/(\ \d|\d{2})\/\d{2}/)) {
       if ($buffer =~ m/\r/) {
         # delete all before first CR (carriage return) (e.g. uncomplete dataset: date starts in the middle of the dataset)
         substr($buffer, 0, length($`)+1, '');
       }
       else {
         # there is no date in the dataset (e.g. header) => delete all
         $buffer = '';
       }
    }
    # if the buffer is big enough, read out a record
    if (length($buffer) >= $RECORD_BYTES) {
      # read out the number of bytes, and clobber what was there
      my $record = substr($buffer, 0, $RECORD_BYTES, '');
      if ($DEBUG) {
	print "Buffer has enough for a record, parsing this line:\n'$record'\n";
      }
      my %rec = parseRecord($record);
      # insert the record into the database
      insertRecord(%rec);
    }
    # reset snooze on successful read
    $snooze = 1;
  }
}
# delete the PID file
unlink $PIDFILE;
logWarn("Exiting");