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 = 9; # 9 bytes + 0x05
  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 @bytes = unpack("C*", $data);
  65
  66         push @{ $self->{bytes} }, @bytes;
  67         @bytes = @{ $self->{bytes} };
  68
  69         my @bad_bytes;
  70
  71         while (@bytes > $PACKET_SIZE) {
  72                 if ($bytes[0] != 0x55) {
  73                         push @bad_bytes, shift @bytes;
  74                         next;
  75                 }
  76                 my $cmd = $bytes[1];
  77
  78                 if ($bytes[$PACKET_SIZE] != 0x05
  79                         || SCX::CRC::digest(@bytes[0..$PACKET_SIZE-2])
  80                                 != $bytes[$PACKET_SIZE-1]) {
  81                         push @bad_bytes, shift @bytes;
  82                         next;
  83                 }
  84
  85                 if (@bad_bytes) { # Report previous bad bytes first
  86                         $self->log_bytes(\@bad_bytes, "Cannot parse packet");
  87                         @bad_bytes = ();
  88                 }
  89
  90                 my @packet = splice @bytes, 0, $PACKET_SIZE+1;
  91                 my $rv = &{ $self->{callback} }(@packet[1..$PACKET_SIZE]);
  92                 $self->log_bytes(@packet, $rv);
  93         }
  94         $self->log_bad_bytes(\@bad_bytes, "Cannot parse packet");
  95
  96         @{ $self->{bytes} } = @bytes;
  97 }
  98
  99 sub log_bytes {
 100         my ($self, $bytes, $msg) = @_;
 101
 102         return if !@$bytes;
 103
 104         $msg = defined $msg ? ' # ' . $msg : '';
 105
 106         my $now = gettimeofday;
 107
 108         if ($now - $self->{log_start} >= $LOG_ROTATE) {
 109                 close $self->{logfh};
 110                 $self->{log_gen} = $self->{log_gen} ? 0 : 1;
 111                 open my $fh, '>', $logfile . '.' . $self->{log_gen}
 112                         or die "Can't open $logfile.$self->{log_gen}: $!";
 113                 $self->{logfh} = $fh;
 114                 $self->{log_start} = $now;
 115         }
 116
 117         $self->{logfh}->print(sprintf('% 10.3f', $now - $self->{starttime}),
 118                 (map { sprintf(" %02x", $_) } @bytes),
 119                 $msg, "\n");
 120 }
 121
 122 1;
 123