Skip to content

Commit

Permalink
Improve parsing / add bridge / minimal state
Browse files Browse the repository at this point in the history
  • Loading branch information
nebulous committed Oct 8, 2024
1 parent daab4d5 commit a000bad
Show file tree
Hide file tree
Showing 3 changed files with 64 additions and 46 deletions.
55 changes: 36 additions & 19 deletions lib/CarBus.pm
Original file line number Diff line number Diff line change
Expand Up @@ -8,9 +8,13 @@ has fh => (is=>'ro', isa=>sub{
defined blessed($_[0]) and $_[0]->isa('IO::Handle');
});
has buffer => (is=>'rw', default=>'');
has name => (is=>'ro', lazy=>1, default => sub {
return join('-',ref($_[0]->fh), int(rand()*9999));
});

use constant MAX_BUFFER => 1024;
use constant MIN_FRAME => 10;
use constant MAX_FRAME => 266;
use constant MAX_BUFFER => 2*MAX_FRAME;

sub BUILDARGS {
my ( $class, @args ) = @_;
Expand All @@ -20,29 +24,32 @@ sub BUILDARGS {
return $argref;
};


sub get_frame {
my $self = shift;
my $string = shift;
$self->push_stream($string) if $string;

my $max_attempts = $self->buflen>MAX_BUFFER ? $self->buflen : MAX_BUFFER;
my $attempts = 0;
while ($attempts++<$max_attempts) {
if ($self->buflen < MIN_FRAME) {
$self->fh_fill();
next;
}
$self->fh_fill() unless $string;
return unless $self->buflen >= MIN_FRAME;

while ($attempts++ < $self->buflen) {
my $data_len = ord(substr($self->buffer,4,1));
my $frame_len = MIN_FRAME+$data_len;
if ($self->buflen >= $frame_len) {
my $frame_string = substr($self->buffer,0,$frame_len);
my $cbf = CarBus::Frame->new($frame_string);
if ($cbf->valid) {
$self->shift_stream($frame_len);
$self->handlers($cbf);
return $cbf;
if ($self->buflen >= $frame_len ) {
if (my $frame_string = substr($self->buffer,0,$frame_len)) {
my $cbf = CarBus::Frame->new($frame_string);
if ($cbf->valid) {
$self->shift_stream($frame_len);
$self->handlers($cbf);
$cbf->{busname} = $self->name;
return $cbf;
}
}
$self->shift_stream(1);
}
$self->fh_fill();
$self->fh_fill() unless $string;
}
return undef;
}
Expand All @@ -51,8 +58,8 @@ sub fh_fill {
my $self = shift;
return unless $self->fh;
my $buf = '';
my $len = $self->fh->sysread($buf, 1024);
$self->push_stream($buf);
my $len = $self->fh->sysread($buf, MAX_BUFFER-$self->buflen);
$self->push_stream($buf) if defined $len;
return $len;
}

Expand Down Expand Up @@ -80,7 +87,7 @@ sub shift_stream {
sub write {
my $self = shift;
my $frame = shift;
$self->fh->syswrite($frame->frame);
$self->fh->syswrite($frame->struct->{raw});
}

sub samreq {
Expand All @@ -98,17 +105,27 @@ sub samreq {
return $samframe;
}

has devices => (is=>'rw',default=>sub{{}});
has registers => (is=>'rw',default=>sub{{}});

sub handlers {
my $self = shift;
my $frame = shift;
my $fs = $frame->struct;
if (my $src = $fs->{src} and $fs->{cmd} eq 'reply') {
$self->devices->{$src}//={} ;
$self->devices->{$src}->{$fs->{reg_string}}//={ payload_hex=>$fs->{payload_hex} } if $fs->{reg_string};
$self->devices->{$src}->{$fs->{reg_string}}->{paylpad} = $fs->{payload} if $fs->{payload};
}
# mangle frame contents;
}



package CarBus::Bridge;
use Moo;

has buslist => (is=>'ro');
has routes => (is=>'rw', default=>sub{{}});

sub drive {
my $self = shift;
Expand Down
33 changes: 18 additions & 15 deletions lib/CarBus/Frame.pm
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@ use Try::Tiny;

my %device_classes = (
SystemInit => 0x1F,
SAM=>0x92,
SAM => 0x92,
FakeSAM => 0x93,
Broadcast => 0xF1,
_default_ => $DefaultPass
Expand Down Expand Up @@ -52,9 +52,14 @@ my $fp = Struct("CarFrame",
Value("as_hex", sub { unpack("H*",$_->ctx->{raw}) }),
Value("reg_string", sub { length($_->ctx->{payload_raw})>=3 ? substr($_->ctx->{as_hex}, 18,4) : undef}),
Value("gensum", sub { crc16(substr($_->ctx->{raw},0,-2)) }),
Value("valid", sub { $_->ctx->{gensum} == $_->ctx->{checksum} }),
Value("payload", sub { length($_->ctx->{payload_raw})<=3 ? undef
: subparser($_->ctx->{reg_string})->parse(substr($_->ctx->{payload_raw},3)) }),
Value("valid", sub { $_->ctx->{gensum} == $_->ctx->{checksum} ? 1 : 0 }),
Value("payload", sub {
return undef unless $_->ctx->{valid};
return undef if length($_->ctx->{payload_raw})<=3;
my $sp = subparser($_->ctx->{reg_string});
try { $sp->parse(substr($_->ctx->{payload_raw},3)) } || undef;
}),
Value("payload_hex", sub { unpack("H*", $_->ctx->{payload_raw}) }),

Value("reg_name", sub {
my $fh = $_->ctx;
Expand All @@ -76,8 +81,10 @@ around BUILDARGS => sub {
$init_frame = shift @args if (@args == 1 && !ref $args[0]);
$init_frame = pack("H*", $init_frame) if $init_frame =~ /^[0-9A-Fa-f]+$/;
my $struct = { valid=>0 };
try { $struct = $fp->parse($init_frame); };
$struct = {%$struct,@args};
try {
$struct = $fp->parse($init_frame);
$struct = {%$struct,@args};
};

return $class->$orig({struct=>$struct});
};
Expand All @@ -101,7 +108,7 @@ sub frame {
}
$self->struct($struct);

return $self->struct->{raw};
return $self->struct->{valid} ? $self->struct->{raw} : undef;
}

sub frame_hex {
Expand All @@ -123,7 +130,8 @@ sub frame_log {
$fh->{src},
$fh->{cmd},
$fh->{dst},
$fh->{reg_name}
$fh->{reg_name},
$fh->{valid}
);
}

Expand Down Expand Up @@ -156,7 +164,7 @@ my $parsers = {
PaddedString('reference', 24, paddir=>'right'),
),

'0202' => Struct('time', Byte('hour'), Byte('minute'), Enum(Byte('weekday'), 0=>'Sunday', 1=>'Monday', 2=>'Tuesday', 3=>'Wednesday', 4=>'Thursday', 5=>'Friday', 6=>'Saturday')),
'0202' => Struct('time', Byte('hour'), Byte('minute'), Enum(Byte('weekday'), Sunday=>0, Monday=>1, Tuesday=>2, Wednesday=>3, Thursday=>4, Friday=>6, Saturday=>6)),

'0203' => Struct('date', Byte('day'), Byte('month'), Byte('20xx'), Value('year', sub { 2000+int($_->ctx->{'20xx'}) })),

Expand All @@ -178,7 +186,7 @@ my $parsers = {
Enum(Nibble('mode'), heat=>0, cool=>1, auto=>2, eheat=>3, off=>4)
),
Array(2, Byte('unknown')),
Enum(Byte('weekday'), 0=>'Sunday', 1=>'Monday', 2=>'Tuesday', 3=>'Wednesday', 4=>'Thursday', 5=>'Friday', 6=>'Saturday'),
Enum(Byte('weekday'), Sunday=>0, Monday=>1, Tuesday=>2, Wednesday=>3, Thursday=>4, Friday=>6, Saturday=>6),
UBInt16('minutes_since_midnight'),
Byte('displayed_zone')
),
Expand Down Expand Up @@ -210,9 +218,6 @@ my $parsers = {
Byte('fan_mode')
),

#3B05
# contains: filterlevel,uvlevel,humidifierpadelvel, reminders for all

'3B05' => Struct('sam_accessories',
Padding(3),
Byte('filter_consumption'),
Expand All @@ -225,8 +230,6 @@ my $parsers = {
),


#3B06
# contains: deadband, dealer name, dealer phone
'3B06' => Struct('sam_dealer',
Byte('backlight'),
Byte('auto_mode'),
Expand Down
22 changes: 10 additions & 12 deletions lib/cbt.pl
Original file line number Diff line number Diff line change
@@ -1,23 +1,21 @@
#!/usr/bin/perl

use strict;
use feature 'say';
use CarBus;
use Data::Dumper;
use IO::File;
use IO::Socket::IP;
use IO::Termios;

my $carbus = new CarBus(async=>1);
#my $sfh = new IO::File("somedumpfile.raw"); # dumpfile
#my $sfh = IO::Termios->open("/dev/ttyUSB0","38400,8,n,1"); #serial port
my $sfh = IO::Socket::IP->new(PeerHost=>'192.168.1.47', PeerPort=>23); #tcp
#my $sfh = CarBus->new(IO::File->new("net.log",'r')); # dumpfile
my $net = CarBus->new(IO::Socket::IP->new(PeerHost=>'192.168.1.23', PeerPort=>23)); #tcp
my $sam = CarBus->new(IO::Termios->open("/dev/cu.usbserial-A7039O5G","38400,8,n,1")); #serial port

my $bridge = CarBus::Bridge->new(buslist=>[$sam,$net]);

my $buffer = '';
while(1) {
$sfh->recv($buffer, 128);
$carbus->push_stream($buffer);
my $frame = $carbus->get_frame();
unless ($frame->{error}) {
print Dumper($frame);
}
foreach my $frame ($bridge->drive) {
say $frame->frame_log;
}
}

0 comments on commit a000bad

Please sign in to comment.