From 3fa6a4feffab384a8be20f5451c9248dd82e7beb Mon Sep 17 00:00:00 2001
From: ntruchsess <ntruchsess@2b470e98-0d58-463d-a4d8-8e2adae1ed80>
Date: Wed, 2 Apr 2014 21:53:34 +0000
Subject: [PATCH] OWX_FRM: fix async delays

git-svn-id: svn://svn.code.sf.net/p/fhem/code/trunk@5417 2b470e98-0d58-463d-a4d8-8e2adae1ed80
---
 fhem/FHEM/11_OWX_FRM.pm | 400 +++++++++++++++++++++-------------------
 1 file changed, 213 insertions(+), 187 deletions(-)

diff --git a/fhem/FHEM/11_OWX_FRM.pm b/fhem/FHEM/11_OWX_FRM.pm
index f1838b723..e5c572803 100644
--- a/fhem/FHEM/11_OWX_FRM.pm
+++ b/fhem/FHEM/11_OWX_FRM.pm
@@ -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;
\ No newline at end of file
+#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;