serial-dump

#!/usr/bin/perl

use strict;
use warnings;

use Device::SerialPort;
use File::Temp qw/tempfile/;
use ADBOS::DB;
use ADBOS::Config;
use Any::Daemon;
use Log::Report      qw(adbos);

my $config = simple_config;
my $db     = ADBOS::DB->new($config);

my $port;
my $dev = "/dev/ttyS0";

if ($port = Device::SerialPort->new($dev))
{
    $port->databits(7);
    $port->baudrate(9600);
    $port->parity("odd");
    $port->stopbits(1);
    $port->handshake("off");
}
else
{
    die "Failed to open serial port";
}

my $STALL_DEFAULT=1000; # how many seconds to wait for new input

$port->read_char_time(0);     # don't wait for each character
$port->read_const_time(1000); # 1 second per unfulfilled "read" call

my $chars=0;
my $buffer="";

my $cache = $config->{queuedir};

my $daemon = Any::Daemon->new
  ( user     => $config->{user}
  , group    => $config->{group}
  , pid_file => $config->{piddump}
  , workdir  => $cache
  );

dispatcher SYSLOG => 'syslog'
  , identity => 'serial-dump'
  , facility => "local0"
  , flags    => "pid ndelay nowait"
  , mode     => 1;

info __x"Listening for signals on $dev...";

$daemon->run
  ( max_childs => 1
  , child_task => \&dump_messages
  );

sub dump_messages()
{

  $SIG{TERM} = \&close;
  $SIG{INT}  = \&close;

  while (1) {
      my ($count,$saw)=$port->read(255); # will read _up to_ 255 chars

      if ($count > 0) {
          $chars+=$count;
          $buffer.=$saw;

          info __x"DATA RX";
          if ($buffer =~ /\RNNNN/)
          {
              (my $message, $buffer) = split /\RNNNN/, $buffer;
              info __x"MESSAGE FOUND";
              $message =~ s/\r\n/\n/g;
              $message =~ s/(\n|.)*VZCZC//g;

              # Dump to disk
              my ($fh) = tempfile(DIR => $cache);
              print $fh $message;
              close $fh;
              
              # Update status
              $db->statusSet({ last_signal => \'NOW()' });
              $db->sequenceSet($1)
                  if ($message =~ m/JCT(\d\d\d)/m);
          }
      }
  }
}

sub close()
{
    info __x"Stopping listening on $dev...";
    $port->close if $port;
    undef $port;
}