diff --git a/lib/CarBus.pm b/lib/CarBus.pm index 88023c0..5bb5d66 100644 --- a/lib/CarBus.pm +++ b/lib/CarBus.pm @@ -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 ) = @_; @@ -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; } @@ -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; } @@ -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 { @@ -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; diff --git a/lib/CarBus/Frame.pm b/lib/CarBus/Frame.pm index b415058..da74528 100644 --- a/lib/CarBus/Frame.pm +++ b/lib/CarBus/Frame.pm @@ -6,7 +6,7 @@ use Try::Tiny; my %device_classes = ( SystemInit => 0x1F, - SAM=>0x92, + SAM => 0x92, FakeSAM => 0x93, Broadcast => 0xF1, _default_ => $DefaultPass @@ -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; @@ -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}); }; @@ -101,7 +108,7 @@ sub frame { } $self->struct($struct); - return $self->struct->{raw}; + return $self->struct->{valid} ? $self->struct->{raw} : undef; } sub frame_hex { @@ -123,7 +130,8 @@ sub frame_log { $fh->{src}, $fh->{cmd}, $fh->{dst}, - $fh->{reg_name} + $fh->{reg_name}, + $fh->{valid} ); } @@ -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'}) })), @@ -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') ), @@ -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'), @@ -225,8 +230,6 @@ my $parsers = { ), -#3B06 -# contains: deadband, dealer name, dealer phone '3B06' => Struct('sam_dealer', Byte('backlight'), Byte('auto_mode'), diff --git a/lib/cbt.pl b/lib/cbt.pl index bdecf1c..9416deb 100644 --- a/lib/cbt.pl +++ b/lib/cbt.pl @@ -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; + } }