Merge branch 'master' into insteon_fanlinc

bin/display_callers

@@ -1,5 +1,3 @@
-#!d:/perl/bin/perl.exe
-# -*- Perl -*-
 #!/usr/bin/perl
 #--------------------------------------------------------------------------- 
 #  File: 

bin/test_x10

@@ -1,4 +1,4 @@
-#!/bin/perl -w
+#!/usr/bin/perl -w
 
 # Use this as a stand-alone (outside of mh) way to
 # test a CM11 and/or CM17 X10  device

bin/xAP-festival.pl

@@ -1,4 +1,4 @@
-#!/bin/perl
+#!/usr/bin/perl
 
 =begin comment
 

lib/Insteon.pm

@@ -114,13 +114,12 @@ sub _get_next_linkscan
 			$current_scan_device->_aldb->{_aldb_unchanged_callback} = '&Insteon::_get_next_linkscan('.$skip_unchanged.')';
 			$current_scan_device->_aldb->{_aldb_changed_callback} = '&Insteon::_get_next_linkscan('.$skip_unchanged.', '.$current_scan_device->get_object_name.')';
 			$current_scan_device->_aldb->query_aldb_delta("check");
-			$current_scan_device = undef;
 			$checking = 1;
 		}
 	} else {
 		$current_scan_device = $changed_device;
 	}
-	if ($current_scan_device)
+	if ($current_scan_device && ($checking == 0))
         {
           	&main::print_log("[Scan all link tables] Now scanning: "
                 	. $current_scan_device->get_object_name . " ("

lib/Insteon/BaseInsteon.pm

@@ -289,7 +289,17 @@ sub is_acknowledged
 sub set_receive
 {
 	my ($self, $p_state, $p_setby, $p_response) = @_;
-	$self->SUPER::set($p_state, $p_setby, $p_response);
+	my $curr_milli = sprintf('%.0f', &main::get_tickcount);
+	my $window = 1000;
+	if (($p_state eq $self->state || $p_state eq $self->state_final)
+		&& ($curr_milli - $$self{set_milliseconds} < $window)){
+		::print_log("[Insteon::BaseObject] Ignoring duplicate set " . $p_state .
+			" state command for " . $self->get_object_name . " received in " .
+			"less than $window milliseconds") if $main::Debug{insteon}; 
+	} else {
+		$$self{set_milliseconds} = $curr_milli;
+		$self->SUPER::set($p_state, $p_setby, $p_response);
+	}
 }
 
 sub set_with_timer {
@@ -660,7 +670,7 @@ sub _process_message
 		{
 			main::print_log("[Insteon::BaseObject] WARN: Now calling message failure callback: "
 				. $p_setby->active_message->failure_callback) if $main::Debug{insteon};
-			$p_setby->active_message->failure_reason('NAK');
+			$self->failure_reason('NAK');
 			package main;
 			eval $p_setby->active_message->failure_callback;
 			main::print_log("[Insteon::BaseObject] problem w/ retry callback: $@") if $@;
@@ -698,12 +708,23 @@ sub _process_message
 		$p_state = $msg{command};
                 if ($msg{type} eq 'alllink')
                 {
-			$self->set($p_state, $self);
-			$$self{_pending_cleanup} = 1;
+			if ($msg{command} eq 'link_cleanup_report'){
+				if ($msg{extra} == 0){
+					::print_log("[Insteon::BaseObject] DEBUG Received AllLink Cleanup Success for "
+						. $self->{object_name}) if $main::Debug{insteon} >= 1;
+				} else {
+					::print_log("[Insteon::BaseObject] WARN " . $msg{extra} . " Device(s) failed to "
+						. "acknowledge the command from " . $self->{object_name});
+				}
+			} else {
+				$self->set($p_state, $self);
+				$$self{_pending_cleanup} = 1;
+			}
                 }
                 elsif ($msg{type} eq 'cleanup')
                 {
-                	if (lc($self->state) eq lc($p_state) and $$self{_pending_cleanup}){
+                	if (($self->state eq $p_state or $self->state_final eq $p_state)
+                		and $$self{_pending_cleanup}){
 				::print_log("[Insteon::BaseObject] Ignoring Received Direct AllLink Cleanup Message for " 
 					. $self->{object_name} . " since AllLink Broadcast Message was Received.") if $main::Debug{insteon};
                 	} else {
@@ -817,6 +838,26 @@ sub get_nack_msg_for {
    return $nack_messages{ $msg };
 }
 
+=item C<failure_reason>
+
+Stores the resaon for the most recent message failure [NAK | timeout].  Used to 
+process message callbacks after a message fails.  If called with no parameter 
+returns the saved failure reason.
+
+Parameters:
+	reason: failure reason
+
+Returns: failure reason
+
+=cut 
+
+sub failure_reason
+{
+        my ($self, $reason) = @_;
+        $$self{failure_reason} = $reason if $reason;
+        return $$self{failure_reason};
+}
+
 ####################################
 ###            #####################
 ### BaseObject #####################
@@ -1253,7 +1294,7 @@ Returns: nothing
 sub _get_engine_version_failure
 {
 	my ($self) = @_;
-	my $failure_reason = $self->interface->active_message->failure_reason();
+	my $failure_reason = $self->failure_reason();
 
 	main::print_log("[Insteon::BaseDevice::_get_engine_version_failure] DEBUG4: "
 		."failure reason: $failure_reason") if $main::Debug{insteon} >= 4;

lib/Insteon/BaseInterface.pm

@@ -52,6 +52,7 @@ sub new
 	my $self = {};
 	@{$$self{command_stack2}} = ();
 	@{$$self{command_history}} = ();
+	$$self{received_commands} = {};
 	bless $self, $class;
         $self->transmit_in_progress(0);
 #   	$self->debug(0) unless $self->debug;
@@ -249,20 +250,20 @@ sub process_queue
 					&main::print_log("[Insteon::BaseInterface] WARN! Unable to clear acknowledge for "
 						. ((defined($failed_message->setby)) ? $failed_message->setby->get_object_name : "undefined"));
 				}
-
+				# clear active message
+				$self->clear_active_message();
                                 # may instead want a "failure" callback separate from success callback
 				if ($failed_message->failure_callback)
                                 {
                                        	&::print_log("[Insteon::BaseInterface] WARN: Message Timeout:  Now calling callback: " .
                                                	$failed_message->failure_callback) if $main::Debug{insteon};
-					$failed_message->failure_reason('timeout');
+					$failed_message->setby->failure_reason('timeout') 
+						if (defined($failed_message->setby) and $failed_message->setby->can('failure_reason'));
 		       			package main;
 					eval $failed_message->failure_callback;
 					&::print_log("[Insteon::BaseInterface] problem w/ retry callback: $@") if $@;
 					package Insteon::BaseInterface;
 				}
-
-                		$self->clear_active_message();
                 		$self->process_queue();
                         }
 		}
@@ -330,20 +331,26 @@ sub on_standard_insteon_received
 {
         my ($self, $message_data) = @_;
 	my %msg = &Insteon::InsteonMessage::command_to_hash($message_data);
+	return if $self->_is_duplicate_received($message_data, %msg);
 	if (%msg)
         {
-		if ($msg{hopsleft} > 0) {
-			&::print_log("[Insteon::BaseInterface] DEBUG2: Message received with $msg{hopsleft} hops left, delaying next "
-			."transmit to avoid collisions with remaining hops.") if $main::Debug{insteon} >= 2;
-			$self->_set_timeout('xmit', $msg{hopsleft} * 100) #Standard msgs should only take 50 millis;			
-		}
-		else {
-			#This prevents the majority of corrupt messages on aldb scans
-			#For some reason duplicate messages arrive with the same hop count
-			#My theory is that they are created by bridging the powerline and rf
-			#A mere 50 millisecond pause seems to fix everything.
-			$self->_set_timeout('xmit', 50);
+		my $wait_time;
+		my $wait_message = "[Insteon::BaseInterface] DEBUG3: Message received "
+			."with $msg{hopsleft} hops left, ";
+		if (!$msg{is_ack} && !$msg{is_nack} && $msg{type} ne 'alllink' 
+			&& $msg{type} ne 'broadcast') {
+			#Wait for ACK to be delivered
+			$wait_time = $msg{maxhops};
+			$wait_message .= "plus ACK will take $msg{maxhops} to deliver, ";
 		}
+		$wait_time += $msg{hopsleft};
+		#Standard msgs should only take 50 millis, but in practice additional 
+		#time has been required. Extra 50 millis helps prevent dupes
+		$wait_time = ($wait_time * 100) + 50;
+		$wait_message .= "delaying next transmit by $wait_time milliseconds to avoid collisions.";
+		::print_log($wait_message) if ($main::Debug{insteon} >= 3 && $wait_time > 50);
+		$self->_set_timeout('xmit', $wait_time);			
+
 		# get the matching object
 		my $object = &Insteon::get_object($msg{source}, $msg{group});
 		if (defined $object)
@@ -476,20 +483,26 @@ sub on_extended_insteon_received
 {
         my ($self, $message_data) = @_;
 	my %msg = &Insteon::InsteonMessage::command_to_hash($message_data);
+	return if $self->_is_duplicate_received($message_data, %msg);
 	if (%msg)
         {
-		if ($msg{hopsleft} > 0) {
-			&::print_log("[Insteon::BaseInterface] DEBUG2: Message received with $msg{hopsleft} hops left, delaying next "
-			."transmit to avoid collisions with remaining hops.") if $main::Debug{insteon} >= 2;
-			$self->_set_timeout('xmit', $msg{hopsleft} * 200) #Extended msgs take longer to deliver;
+		my $wait_time;
+		my $wait_message = "[Insteon::BaseInterface] DEBUG3: Message received "
+			."with $msg{hopsleft} hops left, ";
+		if (!$msg{is_ack} && !$msg{is_nack} && $msg{type} ne 'alllink' 
+			&& $msg{type} ne 'broadcast') {
+			#Wait for ACK to be delivered
+			$wait_time = $msg{maxhops};
+			$wait_message .= "plus ACK will take $msg{maxhops} to deliver, ";
 		}
-                else {
-                        #This prevents the majority of corrupt messages on aldb scans
-                        #For some reason duplicate messages arrive with the same hop count
-                        #My theory is that they are created by bridging the powerline and rf
-                        #A mere 50 millisecond pause seems to fix everything.
-                        $self->_set_timeout('xmit', 50);
-                }
+		$wait_time += $msg{hopsleft};
+		#Standard msgs should only take 108 millis, but in practice additional 
+		#time has been required. Extra 50 millis helps prevent dupes
+		$wait_time = ($wait_time * 200) + 50;
+		$wait_message .= "delaying next transmit by $wait_time milliseconds to avoid collisions.";
+		::print_log($wait_message) if ($main::Debug{insteon} >= 3 && $wait_time > 50);
+		$self->_set_timeout('xmit', $wait_time);
+
 		# get the matching object
 		my $object = &Insteon::get_object($msg{source}, $msg{group});
 		if (defined $object)
@@ -555,5 +568,74 @@ sub _aldb
    return $$self{aldb};
 }
 
+# This function attempts to identify erroneous duplicative incoming messages 
+# while still permitting identical messages to arrive in close proximity.  For 
+# example, a valid identical message is the ACK of an extended aldb read which 
+# is always 2F00.
+#
+# Messages are deemed to be identical if, excluding the max_hops and hops_left
+# bits, they are otherwise the same.  Identical messages are deemed to be 
+# erroneous if they are received within a calculated message window, $delay.  
+#
+# The message window is calculated depending on whether the PLM is sending an ACK.
+#
+
+# Returns 1 if the received message is a duplicate message
+# See discussion at: https://github.com/hollie/misterhouse/issues/169
+sub _is_duplicate_received {
+	my ($self, $message_data, %msg) = @_;
+	my $is_duplicate;
+
+	my $curr_milli = sprintf('%.0f', &main::get_tickcount);
+
+	# $key will be set to $message_data with max hops and hops left set to 0
+	my $key = $message_data;
+	substr($key,13,1) = 0;
+
+	#Standard = 50 millis; Extended = 108 millis;
+	#In practice requires 75% more
+	my $message_time = (length($message_data) > 18) ? 183 : 87;
+
+	#Wait period before PLM can send ACK or next request
+	my $max_hops = $msg{hopsleft};
+
+	if (!$msg{is_ack} && !$msg{is_nack} && $msg{type} ne 'alllink' 
+		&& $msg{type} ne 'broadcast')
+	{
+		#ACK sent with same max hops plus 1 for initial timeslot
+		$max_hops += $msg{maxhops} + 1;
+		#Subsequent Reply, arrives in same number of hops + 1 for intial timeslot
+		$max_hops += ($msg{maxhops} - $msg{hopsleft}) + 1;
+	} else {
+		#Subsequent PLM request is sent with max hops + 1 for intial timeslot
+		$max_hops += $msg{maxhops} + 1;
+	}
+
+	my $delay = ($message_time * $max_hops);
+
+	#Clean hash of outdated entries
+	for (keys %{$$self{received_commands}}){
+		if ($$self{received_commands}{$_} < $curr_milli){
+			delete($$self{received_commands}{$_});
+		}
+	}
+
+	#Check if the message exists
+	if (exists($$self{received_commands}{$key})){
+		$is_duplicate = 1;
+		#Reset the time in case there are multiple duplicates
+		$$self{received_commands}{$key} = $curr_milli + $delay;
+		#Make a nicer name
+		my $source = $msg{source};
+		my $object = &Insteon::get_object($msg{source}, $msg{group});
+		$source = $object->get_object_name() if (defined $object);
+		::print_log("[Insteon::BaseInterface] WARN! Dropped duplicate incoming message "
+			. $message_data . ", from $source.") if $main::Debug{insteon};
+	} else {
+		#Message was not in hash, so add it
+		$$self{received_commands}{$key} = $curr_milli + $delay;
+	}
+	return $is_duplicate;
+}
 
 1

lib/Insteon/Message.pm

@@ -55,26 +55,6 @@ sub failure_callback
         return $$self{failure_callback};
 }
 
-=item C<failure_reason>
-
-Stores the resaon for the most recent message failure [NAK | timeout].  Used to 
-process message callbacks after a message fails.  If called with no parameter 
-returns the saved failure reason.
-
-Parameters:
-	reason: failure reason
-
-Returns: failure reason
-
-=cut 
-
-sub failure_reason
-{
-        my ($self, $reason) = @_;
-        $$self{failure_reason} = $reason if $reason;
-        return $$self{failure_reason};
-}
-
 sub send_attempts
 {
 	my ($self, $send_attempts) = @_;
@@ -135,10 +115,11 @@ sub send
                                 	$self->setby->default_hop_count($self->setby->default_hop_count + 1);
                                 }
                         }
-                        elsif (defined($$self{no_hop_increase}) && $main::Debug{insteon}
+                        elsif (defined($$self{no_hop_increase}) && ref $self->setby
                         	&& $self->setby->isa('Insteon::BaseObject')){
                         	&main::print_log("[Insteon::BaseMessage] Hop count not increased for "
-                        		. $self->setby->get_object_name . " because no_hop_increase flag was set.");
+                        		. $self->setby->get_object_name . " because no_hop_increase flag was set.")
+                        		if $main::Debug{insteon};
                         	$$self{no_hop_increase} = undef;
                         }
                 }

lib/Insteon/MessageDecoder.pm

@@ -115,7 +115,7 @@ my %plmcmdlen = (
 	'0258' => [3, 3],
 	'0260' => [2, 9],
 	'0261' => [5, 6],
-	'0262' => [8, 9], # could get 9 or 23 (Standard or Extended Message received)
+	'0262' => [8, 9, 22, 23], # could get 9 or 23 (Standard or Extended Message received)
 	'0263' => [4, 5],
 	'0264' => [4, 5],
 	'0265' => [2, 3],
@@ -896,10 +896,15 @@ sub insteon_decode_cmd {
 }
 
 
-#Takes a 2 byte hex cmd, 0 for send, 1, for rec and returns expected byte length
+#$plm_cmd is 2 byte hex cmd; $send_rec is 0 for send, 1, for rec; $is_extended is 1 if extended send
+#returns expected byte length
 sub insteon_cmd_len{
-	my ($plm_cmd, $send_rec) = @_;
-	return $plmcmdlen{$plm_cmd}->[$send_rec]
+	my ($plm_cmd, $send_rec, $is_extended) = @_;
+	if ($is_extended && $plmcmdlen{uc($plm_cmd)} > 2) {
+		return $plmcmdlen{uc($plm_cmd)}->[($send_rec+2)];
+	} else {
+		return $plmcmdlen{uc($plm_cmd)}->[$send_rec];
+	}
 }
 
 

lib/Insteon/MessageDecoder_test.pl

@@ -1,4 +1,5 @@
-
+#!/usr/bin/perl -w
+
 use strict;
 use lib "..";
 use Insteon::MessageDecoder;