SCX/Reader.pm

   1 #!/usr/bin/perl -w
   2
   3 package SCX::Reader;
   4
   5 use Time::HiRes qw(gettimeofday tv_interval);
   6 use FileHandle;
   7 use SCX::CRC;
   8
   9 our $PACKET_SIZE = 10;
  10 our $LOG_ROTATE  = 600;
  11
  12 sub new {
  13         my ($class, $args) = @_;
  14
  15         my $callback = $args->{callback}
  16                 or die "callback arg not defined";
  17
  18         my $portname = $args->{portname}
  19                 or die "portname not specified";
  20
  21         system 'stty', '-F', $portname, '115200', 'raw';
  22         if ($?) {
  23                 die "stty died with code $? (no permissions?)";
  24         }
  25
  26         open my $tty, '<:raw', $portname
  27                 or die "Can't open $portname: $!";
  28
  29         my $logfile = $args->{logfile};
  30         my $log_gen = 0;
  31
  32         open my $logfh, '>', "$logfile.$log_gen"
  33         or die "Can't open $logfile.$log_gen: $!";
  34
  35         my $now = gettimeofday;
  36
  37         my $self = {
  38                 portname  => $portname,
  39                 fh        => $tty,
  40                 logfile   => $logfile,
  41                 logfh     => $logfh,
  42                 log_gen   => $log_gen,
  43                 log_start => $now,
  44                 starttime => $now,
  45                 callback  => $callback,
  46                 bytes     => [],
  47         };
  48
  49         bless $self, $class;
  50
  51         return $self;
  52 }
  53
  54 sub fh { return shift->{fh}; }
  55
  56 sub read {
  57         my ($self) = @_;
  58
  59         my $data;
  60         my $bytes_read = sysread $self->fh, $data, $PACKET_SIZE;
  61         die "Read error on $self->{portname}: $!"
  62                 if !$bytes_read;
  63
  64         my $now = gettimeofday;
  65         if ($now - $self->{log_start} >= $LOG_ROTATE) {
  66                 close $self->{logfh};
  67                 $self->{log_gen} = $self->{log_gen} ? 0 : 1;
  68                 open my $fh, '>', $logfile . '.' . $self->{log_gen}
  69                         or die "Can't open $logfile.$self->{log_gen}: $!";
  70                 $self->{logfh} = $fh;
  71                 $self->{log_start} = $now;
  72         }
  73
  74         my @bytes = unpack("C*", $data);
  75
  76         $self->{logfh}->print(sprintf('% 10.3f', $now - $self->{starttime}),
  77                 (map { sprintf(" %02x", $_) } @bytes),
  78                 "\n");
  79
  80         push @{ $self->{bytes} }, @bytes;
  81         @bytes = @{ $self->{bytes} };
  82
  83         my @bad_bytes;
  84
  85         while (@bytes >= 2) {
  86                 if ($bytes[0] != 0x55) {
  87                         push @bad_bytes, shift @bytes;
  88                         next;
  89                 }
  90                 my $cmd = $bytes[1];
  91
  92                 my $packet_size = $cmd >= 0x40 && $cmd <= 0x46 ? 4 : 9;
  93                 last if @bytes <= $packet_size;
  94
  95                 if ($bytes[$packet_size] != 0x05
  96                         || SCX::CRC::digest(@bytes[0..$packet_size-2])
  97                                 != $bytes[$packet_size-1]) {
  98                         push @bad_bytes, shift @bytes;
  99                         next;
 100                 }
 101
 102                 if (@bad_bytes) {
 103                         $self->{logfh}->print("Cannot parse bytes",
 104                                 (map { sprintf(' %02x', $_) } @bad_bytes),
 105                                 "\n");
 106                         @bad_bytes = ();
 107                 }
 108
 109                 $self->{logfh}->print("Callback\n");
 110                 &{ $self->{callback} }(@bytes[1..$packet_size]);
 111                 splice @bytes, 0, $packet_size+1;
 112         }
 113         if (@bad_bytes) {
 114                 $self->{logfh}->print("Cannot parse bytes",
 115                         (map { sprintf(' %02x', $_) } @bad_bytes),
 116                         "\n");
 117                 @bad_bytes = ();
 118         }
 119
 120         @{ $self->{bytes} } = @bytes;
 121 }
 122
 123 1;
 124