OWX_FRM: fix async delays

git-svn-id: svn://svn.code.sf.net/p/fhem/code/trunk@5417 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
ntruchsess
2014-04-02 21:53:34 +00:00
parent 1c8ca6f40b
commit 3fa6a4feff

View File

@@ -28,41 +28,43 @@ use warnings;
#add FHEM/lib to @INC if it's not allready included. Should rather be in fhem.pl than here though...
BEGIN {
if (!grep(/FHEM\/lib$/,@INC)) {
foreach my $inc (grep(/FHEM$/,@INC)) {
push @INC,$inc."/lib";
};
};
if ( !grep( /FHEM\/lib$/, @INC ) ) {
foreach my $inc ( grep( /FHEM$/, @INC ) ) {
push @INC, $inc . "/lib";
};
};
};
use Device::Firmata::Constants qw/ :all /;
use Time::HiRes qw(gettimeofday tv_interval);
sub new() {
my ($class) = @_;
my ($class) = @_;
return bless {
interface => "firmata",
#-- module version
version => 4.0
}, $class;
return bless {
interface => "firmata",
#-- module version
version => 4.0
}, $class;
}
sub Define($$) {
my ($self,$hash,$def) = @_;
$self->{name} = $hash->{NAME};
$self->{hash} = $hash;
my ( $self, $hash, $def ) = @_;
my @a = split("[ \t][ \t]*", $def);
my $u = "wrong syntax: define <name> FRM_XXX pin";
return $u unless int(@a) > 0;
$self->{pin} = $a[2];
$self->{id} = 0;
return undef;
my @a = split( "[ \t][ \t]*", $def );
my $u = "wrong syntax: define <name> FRM_XXX pin";
return $u unless int(@a) > 0;
$self->{pin} = $a[2];
$self->{id} = 0;
$self->{name} = $hash->{NAME};
$self->{hash} = $hash;
$self->{delayed} = {};
return undef;
}
########################################################################################
#
#
# Init - Initialize the 1-wire device
#
# Parameter hash = hash of bus master
@@ -74,93 +76,93 @@ sub Define($$) {
sub initialize($)
{
my ($self,$hash) = @_;
main::LoadModule("FRM");
my $pin = $self->{pin};
my $ret = main::FRM_Init_Pin_Client($hash,[$pin],PIN_ONEWIRE);
die $ret if (defined $ret);
my $firmata = main::FRM_Client_FirmataDevice($hash);
$firmata->observe_onewire($pin,\&FRM_OWX_observer,$self);
$self->{devs} = [];
if ( main::AttrVal($hash->{NAME},"buspower","") eq "parasitic" ) {
$firmata->onewire_config($pin,1);
}
$firmata->onewire_search($pin);
return $self;
my ( $self, $hash ) = @_;
main::LoadModule("FRM");
my $pin = $self->{pin};
my $ret = main::FRM_Init_Pin_Client( $hash, [$pin], PIN_ONEWIRE );
die $ret if ( defined $ret );
my $firmata = main::FRM_Client_FirmataDevice($hash);
$firmata->observe_onewire( $pin, \&FRM_OWX_observer, $self );
$self->{devs} = [];
if ( main::AttrVal( $hash->{NAME}, "buspower", "" ) eq "parasitic" ) {
$firmata->onewire_config( $pin, 1 );
}
$firmata->onewire_search($pin);
return $self;
}
sub Disconnect($)
{
my ($hash) = @_;
$hash->{STATE} = "disconnected";
my ($hash) = @_;
$hash->{STATE} = "disconnected";
};
sub FRM_OWX_observer
{
my ( $data,$self ) = @_;
my $command = $data->{command};
COMMAND_HANDLER: {
$command eq "READ_REPLY" and do {
my $id = $data->{id};
my $request = (defined $id) ? $self->{requests}->{$id} : undef;
unless (defined $request) {
return unless (defined $data->{device});
my $owx_device = FRM_OWX_firmata_to_device($data->{device});
my %requests = %{$self->{requests}};
foreach my $key (keys %requests) {
if ($requests{$key}->{device} eq $owx_device) {
$request = $requests{$key};
$id = $key;
last;
};
};
};
return unless (defined $request);
my $owx_data = pack "C*",@{$data->{data}};
my $owx_device = $request->{device};
my $context = $request->{context};
my $writedata = pack "C*",@{$request->{command}->{'write'}} if (defined $request->{command}->{'write'});
main::OWX_ASYNC_AfterExecute( $self->{hash},$context,1,$request->{'reset'}, $owx_device, $writedata, $request->{'read'}, $owx_data );
delete $self->{requests}->{$id};
last;
};
($command eq "SEARCH_REPLY" or $command eq "SEARCH_ALARMS_REPLY") and do {
my @owx_devices = ();
foreach my $device (@{$data->{devices}}) {
push @owx_devices, FRM_OWX_firmata_to_device($device);
};
if ($command eq "SEARCH_REPLY") {
$self->{devs} = \@owx_devices;
main::OWX_ASYNC_AfterSearch($self->{hash},\@owx_devices);
} else {
$self->{alarmdevs} = \@owx_devices;
main::OWX_ASYNC_AfterAlarms($self->{hash},\@owx_devices);
};
last;
};
};
my ( $data, $self ) = @_;
my $command = $data->{command};
COMMAND_HANDLER: {
$command eq "READ_REPLY" and do {
my $id = $data->{id};
my $request = ( defined $id ) ? $self->{requests}->{$id} : undef;
unless ( defined $request ) {
return unless ( defined $data->{device} );
my $owx_device = FRM_OWX_firmata_to_device( $data->{device} );
my %requests = %{ $self->{requests} };
foreach my $key ( keys %requests ) {
if ( $requests{$key}->{device} eq $owx_device ) {
$request = $requests{$key};
$id = $key;
last;
};
};
};
return unless ( defined $request );
my $owx_data = pack "C*", @{ $data->{data} };
my $owx_device = $request->{device};
my $context = $request->{context};
my $writedata = pack "C*", @{ $request->{command}->{'write'} } if ( defined $request->{command}->{'write'} );
main::OWX_ASYNC_AfterExecute( $self->{hash}, $context, 1, $request->{'reset'}, $owx_device, $writedata, $request->{'read'}, $owx_data );
delete $self->{requests}->{$id};
last;
};
( $command eq "SEARCH_REPLY" or $command eq "SEARCH_ALARMS_REPLY" ) and do {
my @owx_devices = ();
foreach my $device ( @{ $data->{devices} } ) {
push @owx_devices, FRM_OWX_firmata_to_device($device);
};
if ( $command eq "SEARCH_REPLY" ) {
$self->{devs} = \@owx_devices;
main::OWX_ASYNC_AfterSearch( $self->{hash}, \@owx_devices );
} else {
$self->{alarmdevs} = \@owx_devices;
main::OWX_ASYNC_AfterAlarms( $self->{hash}, \@owx_devices );
};
last;
};
};
};
########### functions implementing interface to OWX ##########
sub FRM_OWX_device_to_firmata
{
my @device;
foreach my $hbyte (unpack "A2xA2A2A2A2A2A2xA2", shift) {
push @device, hex $hbyte;
}
return {
family => shift @device,
crc => pop @device,
identity => \@device,
}
my @device;
foreach my $hbyte ( unpack "A2xA2A2A2A2A2A2xA2", shift ) {
push @device, hex $hbyte;
}
return {
family => shift @device,
crc => pop @device,
identity => \@device,
}
}
sub FRM_OWX_firmata_to_device
{
my $device = shift;
return sprintf ("%02X.%02X%02X%02X%02X%02X%02X.%02X",$device->{family},@{$device->{identity}},$device->{crc});
my $device = shift;
return sprintf( "%02X.%02X%02X%02X%02X%02X%02X.%02X", $device->{family}, @{ $device->{identity} }, $device->{crc} );
}
########################################################################################
@@ -170,133 +172,157 @@ sub FRM_OWX_firmata_to_device
########################################################################################
sub discover($) {
my ($self,$hash) = @_;
my $success = undef;
eval {
if (my $firmata = main::FRM_Client_FirmataDevice($hash) and my $pin = $self->{pin} ) {
$firmata->onewire_search($pin);
$success = 1;
};
};
if ($@) {
main::Log(5,$@);
$self->exit($hash);
};
return $success;
my ( $self, $hash ) = @_;
my $success = undef;
eval {
if ( my $firmata = main::FRM_Client_FirmataDevice($hash) and my $pin = $self->{pin} ) {
$firmata->onewire_search($pin);
$success = 1;
};
};
if ($@) {
main::Log( 5, $@ );
$self->exit($hash);
};
return $success;
};
sub alarms($) {
my ($self,$hash) = @_;
my $success = undef;
eval {
if (my $firmata = main::FRM_Client_FirmataDevice($hash) and my $pin = $self->{pin} ) {
$firmata->onewire_search_alarms($pin);
$success = 1;
};
};
if ($@) {
$self->exit($hash);
};
return $success;
my ( $self, $hash ) = @_;
my $success = undef;
eval {
if ( my $firmata = main::FRM_Client_FirmataDevice($hash) and my $pin = $self->{pin} ) {
$firmata->onewire_search_alarms($pin);
$success = 1;
};
};
if ($@) {
$self->exit($hash);
};
return $success;
};
sub execute($$$$$$$) {
my ( $self, $hash, $context, $reset, $owx_dev, $data, $numread, $delay ) = @_;
my ( $self, $hash, $context, $reset, $owx_dev, $data, $numread, $delay ) = @_;
my $delayed = $self->{delayed};
if ($owx_dev and my $queue = $delayed->{$owx_dev}) {
if ($context or $reset or $data or $numread or $delay) {
push @$queue->{items}, {
my $queue = $delayed->{$owx_dev} if defined $owx_dev;
if ( $queue and @{$queue->{items}} ) {
if ( $context or $reset or $data or $numread or $delay ) {
push @{$queue->{items}}, {
context => $context,
'reset' => $reset,
device => $owx_dev,
data => $data,
numread => $numread,
delay => $delay
};
}
if (tv_interval($queue->{'until'}) >= 0) {
my $item = shift @$queue->{items};
};
};
if (!( defined $queue->{'until'} ) or ( tv_interval( $queue->{'until'} ) >= 0 ) ) {
my $item = shift @{$queue->{items}};
$context = $item->{context};
$reset = $item->{'reset'};
$data = $item->{data};
$numread = $item->{numread};
$delay = $item->{delay};
delete $self->{delayed}->{$owx_dev} unless (@$queue);
} else {
return 1;
}
}
my $success = undef;
eval {
if (my $firmata = main::FRM_Client_FirmataDevice($hash) and my $pin = $self->{pin} ) {
my @data = unpack "C*", $data if defined $data;
my $id = $self->{id} if ($numread);
my $ow_command = {
'reset' => $reset,
'skip' => defined ($owx_dev) ? undef : 1,
'select' => defined ($owx_dev) ? FRM_OWX_device_to_firmata($owx_dev) : undef,
'read' => $numread,
'write' => @data ? \@data : undef,
'delay' => undef,
'id' => $numread ? $id : undef
};
if ($numread) {
$owx_dev = '00.000000000000.00' unless defined $owx_dev;
$self->{requests}->{$id} = {
context => $context,
command => $ow_command,
device => $owx_dev
};
$self->{id} = (($id+1) & 0xFFFF);
};
$firmata->onewire_command_series( $pin, $ow_command );
$success = 1;
};
};
if ($@) {
$self->exit($hash);
};
if ($success and $delay and $owx_dev) {
unless ($delayed->{$owx_dev}) {
$delayed->{$owx_dev} = { items => [] };
}
my ($seconds,$micros) = gettimeofday;
my $len = length ($delay); #delay is millis, tv_address works with [sec,micros]
if ($len>3) {
$seconds += substr($delay,0,$len-3);
$micros += (substr ($delay,$len-8).000);
} else {
$micros += ($delay.000);
}
$delayed->{$owx_dev}->{'until'} = [$seconds,$micros];
main::InternalTimer("$seconds.$micros","OWX_ASYNC_Poll",$hash,1);
}
return $success;
return 1 unless ( $context or $reset or $data or $numread or $delay );
my $success = undef;
eval {
if ( my $firmata = main::FRM_Client_FirmataDevice($hash) and my $pin = $self->{pin} ) {
my @data = unpack "C*", $data if defined $data;
my $id = $self->{id} if ($numread);
my $ow_command = {
'reset' => $reset,
'skip' => defined($owx_dev) ? undef : 1,
'select' => defined($owx_dev) ? FRM_OWX_device_to_firmata($owx_dev) : undef,
'read' => $numread,
'write' => @data ? \@data : undef,
'delay' => undef,
'id' => $numread ? $id : undef
};
if ($numread) {
$owx_dev = '00.000000000000.00' unless defined $owx_dev;
$self->{requests}->{$id} = {
context => $context,
command => $ow_command,
device => $owx_dev
};
$self->{id} = ( ( $id + 1 ) & 0xFFFF );
};
$firmata->onewire_command_series( $pin, $ow_command );
$success = 1;
};
};
if ($@) {
$self->exit($hash);
};
if ($delay and $success) {
unless ($queue) {
$queue = { items => [] } ;
$delayed->{$owx_dev} = $queue;
}
my ( $seconds, $micros ) = gettimeofday;
my $len = length($delay); #delay is millis, tv_address works with [sec,micros]
if ( $len > 3 ) {
$seconds += substr( $delay, 0, $len - 3 );
$micros += ( substr( $delay, $len - 3 ) * 1000 );
} else {
$micros += ( $delay * 1000 );
}
$queue->{'until'} = [ $seconds, $micros ];
main::InternalTimer( "$seconds.$micros", "OWX_ASYNC_Poll", $hash, 0 );
} else {
if ($queue) {
if (@{$queue->{items}}) {
delete( $queue->{'until'} );
} else {
delete $delayed->{$owx_dev};
}
}
}
return $success;
};
sub exit($) {
my ($self,$hash) = @_;
main::OWX_ASYNC_Disconnected($hash);
my ( $self, $hash ) = @_;
main::OWX_ASYNC_Disconnected($hash);
};
sub poll($) {
my ($self,$hash) = @_;
if (my $frm = $hash->{IODev} ) {
my ( $self, $hash ) = @_;
if ( my $frm = $hash->{IODev} ) {
main::FRM_poll($frm);
my $delayed = $self->{delayed};
foreach my $address (keys %$delayed) {
next if (tv_interval($delayed->{$address}->{'until'}) < 0);
my @delayed_items = @{$delayed->{$address}->{'items'}};
my $item = shift @delayed_items;
delete $delayed->{$address} unless scalar(@delayed_items);# or $item->{delay};
$self->execute($hash,$item->{context},$item->{'reset'},$item->{device},$item->{data},$item->{numread},$item->{delay});
main::FRM_poll($frm);
last;
foreach my $address ( keys %{$self->{delayed}} ) {
$self->execute( $hash, undef, undef, $address, undef, undef, undef );
main::FRM_poll($frm);
}
}
}
};
1;
#sub printqueues($$) {
# my ($self,$hash,$calledfrom) = @_;
# my $name = $hash->{NAME};
# main::Log3 $name,5,"OWX_ASYNC all queues, called from :".$calledfrom;
# my $delayed = $self->{delayed};
#
# foreach my $address ( keys %$delayed ) {
# my $msg = $address.": until: ";
# $msg .= $delayed->{$address}->{'until'} ? $delayed->{$address}->{'until'}->[0].",".$delayed->{$address}->{'until'}->[1] : "---";
# $msg .= " items: [";
# foreach my $item (@{$delayed->{$address}->{'items'}}) {
# $msg .= $item->{context}.",";
# }
# $msg .= "]";
# main::Log3 $name,5,$msg;
# }
#}
1;