diff --git a/bin/mh.ini b/bin/mh.ini index f13fe6f3a..a0cd44f5d 100644 --- a/bin/mh.ini +++ b/bin/mh.ini @@ -1211,7 +1211,6 @@ viavoice_voice = male @ sleep mode @ - pocketsphinx_timeout_response: This is what is said (or played) when the awake @ timer expires. -@ - pocketsphinx_cmudict Pocketsphinx full english dictionary file location. @ - pocketsphinx_hmm Pocketsphinx Human Markov Model directory location. @ - pocketsphinx_rate Audio Sample rate @ - pocketsphinx_continuous Program location for pocketsphinx_continuous diff --git a/code/common/insteon_item_commands.pl b/code/common/insteon_item_commands.pl deleted file mode 100644 index 907f38fc3..000000000 --- a/code/common/insteon_item_commands.pl +++ /dev/null @@ -1,270 +0,0 @@ -# Category=Insteon - -#@ This module creates voice commands for all Insteon_Device, Insteon_Link and Insteon_PLM items. - -my (@_insteon_plm,@_insteon_device,@_insteon_link,@_scannable_link,$_scan_cnt,$_scan_failure_cnt,$_sync_cnt,$_sync_failure_cnt); - -$_scan_link_tables_v = new Voice_Cmd 'Scan all link tables'; - -if ($_scan_link_tables_v->state_now()) { - &_get_next_linkscan(); # unless $_scan_cnt; # prevent multiple concurrent scans -} - -sub _get_next_linkscan -{ - my ($current_name, $prior_failure) = @_; - if ($prior_failure) { - $_scan_failure_cnt++; - } else { - $_scan_failure_cnt = 0; - } - my @devices = (); - push @devices,@_insteon_plm; - push @devices,@_insteon_device; - push @devices,@_scannable_link; - my $dev_cnt = @devices; - my $return_next = ($current_name) ? 0 : 1; - my $next_name = undef; - - if ($current_name) { - for (my $i=0; $i<$dev_cnt; $i++) { - if ($devices[$i] eq $current_name) { - if ($_scan_failure_cnt == 0) { - # get the next - $next_name = $devices[$i+1] if $i+1 < $dev_cnt; - $_scan_cnt = $i + 2; - # remove the queue_timer_callback - my $current_obj = $objects_by_object_name{$current_name}; - if (!($current_obj->isa('Insteon_PLM'))) { - $current_obj->queue_timer_callback(''); - } - # don't try to scan devices that are not responders - my $next_obj = $objects_by_object_name{$next_name}; - if (ref $next_obj and $next_obj->isa('Insteon_Device') - and !($next_obj->is_responder) and !($next_obj->is_plm_controlled)) { - &main::print_log("[Scan all link tables] $next_name is not a candidate for scanning. Moving to next"); - $current_name = $next_name; - # move on - next; - } - } elsif ($_scan_failure_cnt == 1) { - # try again - $next_name = $current_name; - &main::print_log("[Scan all link tables] WARN: failure occurred when scanning $current_name. Trying again..."); - $_scan_cnt = $i + 1; - } else { - # skip because this is a repeat failure - $next_name = $devices[$i+1] if $i+1 < $dev_cnt; - &main::print_log("[Scan all link tables] WARN: failure occurred when scanning $current_name. Moving on..."); - $_scan_failure_cnt = 0; # reset failure counter - $_scan_cnt = $i + 2; - # remove the queue_timer_callback - my $current_obj = $objects_by_object_name{$current_name}; - if (!($current_obj->isa('Insteon_PLM'))) { - $current_obj->queue_timer_callback(''); - } - } - last; - } - } - } else { - if ($dev_cnt) { - $next_name = $devices[0]; - $_scan_cnt = 1; - } - } - - if ($next_name) { - my $obj = $objects_by_object_name{$next_name}; - if ($obj) { - &main::print_log("[Scan all link tables] Now scanning: " . $obj->get_object_name . " ($_scan_cnt of $dev_cnt)"); - $obj->queue_timer_callback('&main::_get_next_linkscan(\'' . $next_name . '\',1)') unless $obj->isa('Insteon_PLM'); - $obj->scan_link_table('&main::_get_next_linkscan(\'' . $next_name . '\')'); - } - } else { - $_scan_cnt = 0; - return undef; - } -} - -$_sync_links_v = new Voice_Cmd 'Sync all links'; - -if ($_sync_links_v->state_now()) { - &_process_sync_links(); # unless $_sync_cnt; -} - -sub _process_sync_links -{ - my ($current_name, $prior_failure) = @_; - if ($prior_failure) { - $_sync_failure_cnt++; - } else { - $_sync_failure_cnt = 0; - } - my @devices = (); - push @devices,@_insteon_link; - my $dev_cnt = @devices; - my $return_next = ($current_name) ? 0 : 1; - my $next_name = undef; - - if ($current_name) { - for (my $i=0; $i<$dev_cnt; $i++) { - if ($devices[$i] eq $current_name) { - if ($_sync_failure_cnt ==0) { - # get the next - $next_name = $devices[$i+1] if $i+1 < $dev_cnt; - $_sync_cnt = $i + 2; - # remove the queue_timer_callback - my $current_obj = $objects_by_object_name{$current_name}; - if (!($current_obj->isa('Insteon_PLM'))) { - $current_obj->queue_timer_callback(''); - } - # don't try to scan devices that are not responders - my $next_obj = $objects_by_object_name{$next_name}; - if (ref $next_obj and $next_obj->isa('Insteon_Device') - and !($next_obj->is_responder) and !($next_obj->is_plm_controlled)) { - &main::print_log("[Sync all links] $next_name is not a candidate for syncing. Moving to next"); - $current_name = $next_name; - # move on - next; - } - } elsif ($_sync_cnt == 1) { - #try again - $next_name = $current_name; - &main::print_log("[Sync all links] WARN: failure occurred when syncing $current_name. Trying again..."); - $_sync_cnt = $i + 1; - } else { - # skip because this is a repeat failure - $next_name = $devices[$i+1] if $i+1 < $dev_cnt; - &main::print_log("[Sync all links] WARN: failure occurred when syncing $current_name. Moving on..."); - $_sync_failure_cnt = 0; # reset failure counter - $_sync_cnt = $i + 2; - # remove the queue_timer_callback - my $current_obj = $objects_by_object_name{$current_name}; - if (!($current_obj->isa('Insteon_PLM'))) { - $current_obj->queue_timer_callback(''); - } - } - } - } - } elsif ($dev_cnt) { - $next_name = $devices[0]; - $_sync_cnt = 1; - } - - if ($next_name) { - my $obj = $objects_by_object_name{$next_name}; - if ($obj) { - &main::print_log("[Sync all links] Now syncing links: " . $obj->get_object_name . " ($_sync_cnt of $dev_cnt)"); - $obj->queue_timer_callback('&main::_process_sync_links(\'' . $next_name . '\',1)') unless $obj->isa('Insteon_PLM'); - $obj->sync_links('&main::_process_sync_links(\'' . $next_name . '\')'); - } - } else { - $_sync_cnt = 0; - return undef; - } -} - - -sub uninstall_insteon_item_commands { - &trigger_delete('scan insteon link tables'); -} - -if ($Reload) { - - # initialize scan and sync counters - $_scan_cnt = 0; - $_sync_cnt = 0; - - # create trigger - my $trig_cmd = "time_cron '00 02 * * *'"; - &trigger_set($trig_cmd,'&_get_next_linkscan()','NoExpire','scan insteon link tables') - unless &trigger_get('scan insteon link tables'); - - @_insteon_plm = (); - @_insteon_device = (); - @_insteon_link = (); - my $insteon_menu_states = $config_parms{insteon_menu_states} if $config_parms{insteon_menu_states}; - &::print_log("Generating Voice commands for all Insteon objects"); - my $object_string; - for my $object_name (keys %objects_by_object_name) { - my $object = $objects_by_object_name{$object_name}; - next unless $object->isa('Insteon_Device') or $object->isa('Insteon_Link') or $object->isa('Insteon_PLM'); - # ignore the thermostat - next if $object->isa('Insteon_Thermostat'); - my $command = $object_name; - $command =~ s/^\$//; - $command =~ tr/_/ /; - my $object_name_v = $object_name . '_v'; - $object_string .= "use vars '${object_name}_v';\n"; - my $states = 'on,off'; - my $group = ($object->isa('Insteon_PLM')) ? '' : $object->group; - if ($object->isa('Insteon_Link')) { - $states = 'on,off,sync links'; #,resume,enroll,unenroll,manual'; - my $cmd_states = $states; - if ($object->is_plm_controlled) { - $cmd_states .= ',initiate linking as controller,cancel linking'; - } else { - $cmd_states .= ",link to interface,unlink with interface"; - } - if ($object->is_root and !($object->is_plm_controlled)) { - $cmd_states .= ",status,scan link table,log links"; - push @_scannable_link, $object_name; - } - $object_string .= "$object_name_v = new Voice_Cmd '$command [$cmd_states]';\n"; - if ($object->is_plm_controlled) { - $object_string .= "$object_name_v -> tie_event('$object_name->initiate_linking_as_controller(\"$group\")', 'initiate linking as controller');\n\n"; - $object_string .= "$object_name_v -> tie_event('$object_name->interface()->cancel_linking','cancel linking');\n\n"; - } else { - $object_string .= "$object_name_v -> tie_event('$object_name->link_to_interface','link to interface');\n\n"; - $object_string .= "$object_name_v -> tie_event('$object_name->unlink_to_interface','unlink with interface');\n\n"; - } - if ($object->is_root and !($object->is_plm_controlled)) { - $object_string .= "$object_name_v -> tie_event('$object_name->request_status','status');\n\n"; - $object_string .= "$object_name_v -> tie_event('$object_name->scan_link_table(\"" . '\$self->log_alllink_table' . "\")','scan link table');\n\n"; - $object_string .= "$object_name_v -> tie_event('$object_name->log_alllink_table()','log links');\n\n"; - } - $object_string .= "$object_name_v -> tie_event('$object_name->sync_links()','sync links');\n\n"; - $object_string .= "$object_name_v -> tie_items($object_name, 'on');\n\n"; - $object_string .= "$object_name_v -> tie_items($object_name, 'off');\n\n"; - $object_string .= &store_object_data($object_name_v, 'Voice_Cmd', 'Insteon', 'Insteon_link_commands'); - push @_insteon_link, $object_name; - } elsif ($object->isa('Insteon_Device')) { - $states = $insteon_menu_states if $insteon_menu_states; - my $cmd_states = "$states,status,scan link table,log links,update onlevel/ramprate"; #,on level,ramp rate"; - $cmd_states .= ",link to interface,unlink with interface" if $object->is_controller; - $object_string .= "$object_name_v = new Voice_Cmd '$command [$cmd_states]';\n"; - foreach my $state (split(/,/,$states)) { - $object_string .= "$object_name_v -> tie_items($object_name, '$state');\n\n"; - } - $object_string .= "$object_name_v -> tie_event('$object_name->log_alllink_table()','log links');\n\n"; - $object_string .= "$object_name_v -> tie_event('$object_name->request_status','status');\n\n"; - $object_string .= "$object_name_v -> tie_event('$object_name->update_local_properties','update onlevel/ramprate');\n\n"; - $object_string .= "$object_name_v -> tie_event('$object_name->scan_link_table(\"" . '\$self->log_alllink_table' . "\")','scan link table');\n\n"; - if ($object->is_controller) { - $object_string .= "$object_name_v -> tie_event('$object_name->link_to_interface','link to interface');\n\n"; - $object_string .= "$object_name_v -> tie_event('$object_name->unlink_to_interface','unlink with interface');\n\n"; - } -# the remote_set_button_taps provide incorrect/inconsistent results -# $object_string .= "$object_name_v -> tie_event('$object_name->remote_set_button_tap(1)','on level');\n\n"; -# $object_string .= "$object_name_v -> tie_event('$object_name->remote_set_button_tap(2)','ramp rate');\n\n"; - $object_string .= &store_object_data($object_name_v, 'Voice_Cmd', 'Insteon', 'Insteon_item_commands'); - push @_insteon_device, $object_name if $group eq '01'; # don't allow non-base items to participate - } elsif ($object->isa('Insteon_PLM')) { - my $cmd_states = "complete linking as responder,cancel linking,delete link with PLM,scan link table,log links,delete orphan links,reset serial"; - $object_string .= "$object_name_v = new Voice_Cmd '$command [$cmd_states]';\n"; - $object_string .= "$object_name_v -> tie_event('$object_name->complete_linking_as_responder','complete linking as responder');\n\n"; - $object_string .= "$object_name_v -> tie_event('$object_name->initiate_unlinking_as_controller','initiate unlinking');\n\n"; - $object_string .= "$object_name_v -> tie_event('$object_name->cancel_linking','cancel linking');\n\n"; - $object_string .= "$object_name_v -> tie_event('$object_name->log_alllink_table','log links');\n\n"; - $object_string .= "$object_name_v -> tie_event('$object_name->scan_link_table(\"" . '\$self->log_alllink_table' . "\")','scan link table');\n\n"; - $object_string .= "$object_name_v -> tie_event('$object_name->delete_orphan_links','delete orphan links');\n\n"; - $object_string .= "$object_name_v -> tie_event('$object_name->reset_serial_object','reset serial');\n\n"; - $object_string .= &store_object_data($object_name_v, 'Voice_Cmd', 'Insteon', 'Insteon_PLM_commands'); - push @_insteon_plm, $object_name; - } - } - eval $object_string; - print "Error in insteon_item_commands: $@\n" if $@; -} - diff --git a/code/support/hai-omnistat/hai_web/menu.html b/code/support/hai-omnistat/hai_web/menu.html index 94aef6534..609edaad9 100644 --- a/code/support/hai-omnistat/hai_web/menu.html +++ b/code/support/hai-omnistat/hai_web/menu.html @@ -8,8 +8,8 @@ -
-
+
+
diff --git a/code/support/hai-omnistat/omnistat.pl b/code/support/hai-omnistat/omnistat.pl index 6490a9b93..dd23ca76b 100644 --- a/code/support/hai-omnistat/omnistat.pl +++ b/code/support/hai-omnistat/omnistat.pl @@ -9,8 +9,8 @@ # Originally by Kent Noonan, Joel Davidson & Dan Arnold # Close to full rewrite/overhaul by Marc MERLIN 2009/07/22 - -use vars qw(@omnilist @omnistat @omniname @omnioffset $stat_cool_temp $stat_heat_temp $stat_mode $stat_fan $stat_hold +# +use vars qw(%omnicache @omnilist @omnistat @omniname @omnioffset $stat_cool_temp $stat_heat_temp $stat_mode $stat_fan $stat_hold $stat_indoor_temp $cmd $stat_model @v_omnistat_fan @v_omnistat_resume @v_omnistat_hold @v_omnistat_mode @v_omnistat_cool_sp @v_omnistat_heat_sp @v_omnistat_setting @stat_reset_timer $house_stat $mbr_stat $test_stat @v_omnistat_background); @@ -104,6 +104,17 @@ # we make the extended group1 call that also retreives the stat's output status my ($cool_sp, $heat_sp, $mode, $fan, $hold, $temp, $output) = $omnistat[$omnistat]->read_group1("true"); my $stat_type = $omnistat[$omnistat]->get_stat_type; + # Remember the queried values in our own cache so that we don't query this from other places unless + # necessary (this is important in a multiple thermostat sharing the same cable situation + # where querying two stats in code later will cause collisions on the cable). + $omnicache{$omniname[$omnistat]}->{'cool_sp'} = $cool_sp; + $omnicache{$omniname[$omnistat]}->{'heat_sp'} = $heat_sp; + $omnicache{$omniname[$omnistat]}->{'mode'} = $mode; + $omnicache{$omniname[$omnistat]}->{'fan'} = $fan; + $omnicache{$omniname[$omnistat]}->{'hold'} = $hold; + $omnicache{$omniname[$omnistat]}->{'temp'} = $temp; + $omnicache{$omniname[$omnistat]}->{'output'} = $output; + $omnicache{$omniname[$omnistat]}->{'stat_type'} = $stat_type; # This mashes $hold and $mode together from registers cached in the group1 call and outputs a combined string $mode = $omnistat[$omnistat]->get_mode; @@ -215,10 +226,14 @@ } } - if ($state = $omnistat[$omnistat]->state_now) { - # this may or many not be useful to you, you can comment it out if you're not planning on using state changes for coding - Omnistat::omnistat_log("".$omniname[$omnistat]." Omnistat State set to: $state", 3); - } + # WARNING: Reading state_now here empties the 'state_now' flag. If you need it elsewhere, that won't work. + # For debugging, Omnistat.pl will also output state changes like so: + # 25/11/2011 23:30:37 Omnistat[2]->read_reg: set state->now to temp_change + + # If you plan on using state_now elsewhere in your code, you should leave this commented this out: + # if ($state = $omnistat[$omnistat]->state_now) { + # Omnistat::omnistat_log("".$omniname[$omnistat]." Omnistat State set to: $state", 3); + # } } #vim:sts=4:sw=4 diff --git a/lib/Generic_Item.pm b/lib/Generic_Item.pm index 6468d3e28..314ca665b 100644 --- a/lib/Generic_Item.pm +++ b/lib/Generic_Item.pm @@ -1195,6 +1195,7 @@ with the lexical variables $state and $object getting set. The code is a string that will be eval'd and the variables are available to it, but not to any subroutines called by it unless you pass them. You can also set the state variable explicitly since you usually know the item. +The code is a string that will be eval'd. (optional) Setting state limits this tied code to run only when the given state is set. diff --git a/lib/Insteon.pm b/lib/Insteon.pm new file mode 100755 index 000000000..e65106b9a --- /dev/null +++ b/lib/Insteon.pm @@ -0,0 +1,509 @@ +package Insteon; + +use strict; + +# Category=Insteon + +#@ This module creates voice commands for all insteon related items. + +my (@_insteon_plm,@_insteon_device,@_insteon_link,@_scannable_link,$_scan_cnt,$_sync_cnt,$_sync_failure_cnt); +my $init_complete; +my (@_scan_devices,@_scan_device_failures,$current_scan_device); +my (@_sync_devices,@_sync_device_failures,$current_sync_device); + +sub scan_all_linktables +{ + if ($current_scan_device) + { + &main::print_log("[Scan all linktables] WARN: link already underway. Ignoring request for new scan ..."); + return; + } + my @candidate_devices = (); + # clear @_scan_devices + @_scan_devices = (); + @_scan_device_failures = (); + $current_scan_device = undef; + # alwayws include the active interface (e.g., plm) + push @_scan_devices, &Insteon::active_interface; + + push @candidate_devices, &Insteon::find_members("Insteon::BaseDevice"); + + # don't try to scan devices that are not responders + if (@candidate_devices) + { + foreach (@candidate_devices) + { + my $candidate_object = $_; + if ($candidate_object->is_root and + !($candidate_object->isa('Insteon::RemoteLinc') + or $candidate_object->isa('Insteon::InterfaceController') + or $candidate_object->isa('Insteon::MotionSensor'))) + { + push @_scan_devices, $candidate_object; + &main::print_log("[Scan all linktables] INFO1: " + . $candidate_object->get_object_name + . " will be scanned.") if $main::Debug{insteon} >= 1; + } + else + { + &main::print_log("[Scan all linktables] INFO: !!! " + . $candidate_object->get_object_name + . " is NOT a candidate for scanning."); + } + } + } + else + { + &main::print_log("[Scan all linktables] WARN: No insteon devices could be found"); + } + $_scan_cnt = scalar @_scan_devices; + + &_get_next_linkscan(); +} + +sub _get_next_linkscan_failure +{ + push @_scan_device_failures, $current_scan_device; + &main::print_log("[Scan all link tables] WARN: failure occurred when scanning " + . $current_scan_device->get_object_name . ". Moving on..."); + &_get_next_linkscan(); + +} + +sub _get_next_linkscan +{ + $current_scan_device = shift @_scan_devices; + + if ($current_scan_device) + { + &main::print_log("[Scan all link tables] Now scanning: " + . $current_scan_device->get_object_name . " (" + . ($_scan_cnt - scalar @_scan_devices) + . " of $_scan_cnt)"); + # pass first the success callback followed by the failure callback + $current_scan_device->scan_link_table('&Insteon::_get_next_linkscan()','&Insteon::_get_next_linkscan_failure()'); + } else { + &main::print_log("[Scan all link tables] All tables have completed scanning"); + my $_scan_failure_cnt = scalar @_scan_device_failures; + if ($_scan_failure_cnt) + { + &main::print_log("[Scan all link tables] However, some failures were noted:"); + for my $failed_obj (@_scan_device_failures) + { + &main::print_log("[Scan all link tables] WARN: failure occurred when scanning " + . $failed_obj->get_object_name); + } + } + + } +} + + +sub sync_all_links +{ + my ($audit_mode) = @_; + &main::print_log("[Sync all links] Starting now!"); + @_sync_devices = (); + # iterate over all registered objects and compare whether the link tables match defined scene linkages in known Insteon_Links + for my $obj (&Insteon::find_members('Insteon::BaseController')) + { + if ($obj->isa('Insteon::RemoteLinc') or $obj->isa('Insteon::MotionSensor')) + { + &main::print_log("[Sync all links] Ignoring links from 'deaf' device: " . $obj->get_object_name); + } + elsif(!($obj->isa('Insteon::InterfaceController')) && ($obj->_aldb->health eq 'unknown')) + { + &main::print_log("[Sync all links] Skipping links from 'unreachable' device: " + . $obj->get_object_name . ". Consider rescanning the link table of this device"); + } + else + { + my %sync_req = ('sync_object' => $obj, 'audit_mode' => ($audit_mode) ? 1 : 0); + &main::print_log("[Sync all links] Adding " . $obj->get_object_name + . " to sync queue"); + push @_sync_devices, \%sync_req + }; + } + + $_sync_cnt = scalar @_sync_devices; + + &_get_next_linksync(); +} + +sub _get_next_linksync +{ + $current_scan_device = shift @_scan_devices; + my $sync_req_ptr = shift(@_sync_devices); + my %sync_req = ($sync_req_ptr) ? %$sync_req_ptr : undef; + if (%sync_req) + { + + $current_sync_device = $sync_req{'sync_object'}; + } + else + { + $current_sync_device = undef; + } + + if ($current_sync_device) + { + &main::print_log("[Sync all links] Now syncing: " + . $current_sync_device->get_object_name . " (" + . ($_sync_cnt - scalar @_sync_devices) + . " of $_sync_cnt)"); + # pass first the success callback followed by the failure callback + $current_sync_device->sync_links($sync_req{'audit_mode'}, '&Insteon::_get_next_linksync()','&Insteon::_get_next_linksync_failure()'); + } + else + { + &main::print_log("[Sync all links] All links have completed syncing"); + my $_sync_failure_cnt = scalar @_sync_device_failures; + if ($_sync_failure_cnt) + { + &main::print_log("[Sync all links] However, some failures were noted:"); + for my $failed_obj (@_sync_device_failures) + { + &main::print_log("[Sync all links] WARN: failure occurred when syncing " + . $failed_obj->get_object_name); + } + } + + } + +} + +sub _get_next_linksync_failure +{ + push @_sync_device_failures, $current_sync_device; + &main::print_log("[Sync all links] WARN: failure occurred when scanning " + . $current_sync_device->get_object_name . ". Moving on..."); + &_get_next_linksync(); + +} + + +sub init { + + # only run once + return if $init_complete; + $init_complete = 1; + + # initialize scan and sync counters + $_scan_cnt = 0; + $_sync_cnt = 0; + @_scan_devices = (); + + ################################################################# + ## Trigger creation + ################################################################# + my ($trigger_event, $trigger_code, $trigger_type); + + my @trigger_info = &main::trigger_get('scan insteon link tables'); + if (@trigger_info) { + # Trigger exists; modify just the minimum so the trigger continues + # to work if we change the trigger code, but respect everything + # else (trigger type and time to run). This prevents unconditionally + # re-enabling the trigger if the user has disabled it. + $trigger_event = $trigger_info[0]; + $trigger_type = $trigger_info[2]; + } else { + # Trigger does not exist; create one with our default values. + $trigger_event = "time_cron '00 02 * * *'"; + $trigger_type = 'NoExpire'; + } + + $trigger_code = '&Insteon::scan_all_linktables()'; + + # Create/update trigger for a nightly link table scan + &main::trigger_set($trigger_event, $trigger_code, $trigger_type, + 'scan insteon link tables', 1); + ################################################################# + + @_insteon_plm = (); + @_insteon_device = (); + @_insteon_link = (); + +} + +sub generate_voice_commands +{ + + my $insteon_menu_states = $main::config_parms{insteon_menu_states} if $main::config_parms{insteon_menu_states}; + &main::print_log("Generating Voice commands for all Insteon objects"); + my $object_string; + for my $object (&main::list_all_objects) { + next unless ref $object; + next unless $object->isa('Insteon::BaseInterface') or $object->isa('Insteon::BaseObject'); + my $object_name = $object->get_object_name; + # ignore the thermostat + next if $object->isa('Insteon_Thermostat'); + my $command = $object_name; + $command =~ s/^\$//; + $command =~ tr/_/ /; + my $object_name_v = $object_name . '_v'; + $object_string .= "use vars '${object_name}_v';\n"; + my $states = 'on,off'; + my $group = ($object->isa('Insteon_PLM')) ? '' : $object->group; + if ($object->isa('Insteon::BaseController')) { + $states = 'on,off,sync links'; #,resume,enroll,unenroll,manual'; + my $cmd_states = $states; + if ($object->isa('Insteon::InterfaceController')) { + $cmd_states .= ',initiate linking as controller,cancel linking'; + } else { + $cmd_states .= ",link to interface,unlink with interface"; + } + if ($object->is_root and !($object->isa('Insteon::InterfaceController'))) { + $cmd_states .= ",status,get engine version,scan link table,log links"; + push @_scannable_link, $object_name; + } + $object_string .= "$object_name_v = new Voice_Cmd '$command [$cmd_states]';\n"; + $object_string .= "$object_name_v -> tie_event('$object_name->initiate_linking_as_controller(\"$group\")', 'initiate linking as controller');\n\n"; + $object_string .= "$object_name_v -> tie_event('$object_name->interface()->cancel_linking','cancel linking');\n\n"; + if ($object->is_root and !($object->isa('Insteon::InterfaceController'))) { + $object_string .= "$object_name_v -> tie_event('$object_name->request_status','status');\n\n"; + $object_string .= "$object_name_v -> tie_event('$object_name->get_engine_version','get engine version');\n\n"; + $object_string .= "$object_name_v -> tie_event('$object_name->scan_link_table(\"" . '\$self->log_alllink_table' . "\")','scan link table');\n\n"; + $object_string .= "$object_name_v -> tie_event('$object_name->log_alllink_table()','log links');\n\n"; + } + $object_string .= "$object_name_v -> tie_event('$object_name->sync_links(0)','sync links');\n\n"; + $object_string .= "$object_name_v -> tie_items($object_name, 'on');\n\n"; + $object_string .= "$object_name_v -> tie_items($object_name, 'off');\n\n"; + $object_string .= &main::store_object_data($object_name_v, 'Voice_Cmd', 'Insteon', 'Insteon_link_commands'); + push @_insteon_link, $object_name; + } elsif ($object->isa('Insteon::BaseDevice')) { + $states = $insteon_menu_states if $insteon_menu_states + && ($object->can('is_dimmable') && $object->is_dimmable); + my $cmd_states = "$states,status,get engine version,scan link table,log links,update onlevel/ramprate"; #,on level,ramp rate"; + $cmd_states .= ",link to interface,unlink with interface" if $object->isa("Insteon::BaseController") || $object->is_controller; + $object_string .= "$object_name_v = new Voice_Cmd '$command [$cmd_states]';\n"; + foreach my $state (split(/,/,$states)) { + $object_string .= "$object_name_v -> tie_items($object_name, '$state');\n\n"; + } + $object_string .= "$object_name_v -> tie_event('$object_name->log_alllink_table()','log links');\n\n"; + $object_string .= "$object_name_v -> tie_event('$object_name->request_status','status');\n\n"; + $object_string .= "$object_name_v -> tie_event('$object_name->get_engine_version','get engine version');\n\n"; + $object_string .= "$object_name_v -> tie_event('$object_name->update_local_properties','update onlevel/ramprate');\n\n"; + $object_string .= "$object_name_v -> tie_event('$object_name->scan_link_table(\"" . '\$self->log_alllink_table' . "\")','scan link table');\n\n"; + if ($object->isa("Insteon::BaseController") || $object->is_controller) { + $object_string .= "$object_name_v -> tie_event('$object_name->link_to_interface','link to interface');\n\n"; + $object_string .= "$object_name_v -> tie_event('$object_name->unlink_to_interface','unlink with interface');\n\n"; + } +# the remote_set_button_taps provide incorrect/inconsistent results +# $object_string .= "$object_name_v -> tie_event('$object_name->remote_set_button_tap(1)','on level');\n\n"; +# $object_string .= "$object_name_v -> tie_event('$object_name->remote_set_button_tap(2)','ramp rate');\n\n"; + $object_string .= &main::store_object_data($object_name_v, 'Voice_Cmd', 'Insteon', 'Insteon_item_commands'); + push @_insteon_device, $object_name if $group eq '01'; # don't allow non-base items to participate + } elsif ($object->isa('Insteon_PLM')) { + my $cmd_states = "complete linking as responder,cancel linking,delete link with PLM,scan link table,show link table to log,delete orphan links,AUDIT - delete orphan links,scan all device link tables,sync all links,AUDIT - sync all links"; + $object_string .= "$object_name_v = new Voice_Cmd '$command [$cmd_states]';\n"; + $object_string .= "$object_name_v -> tie_event('$object_name->complete_linking_as_responder','complete linking as responder');\n\n"; + $object_string .= "$object_name_v -> tie_event('$object_name->initiate_unlinking_as_controller','initiate unlinking');\n\n"; + $object_string .= "$object_name_v -> tie_event('$object_name->cancel_linking','cancel linking');\n\n"; + $object_string .= "$object_name_v -> tie_event('$object_name->log_alllink_table','show link table to log');\n\n"; + $object_string .= "$object_name_v -> tie_event('$object_name->scan_link_table(\"" . '\$self->log_alllink_table' . "\")','scan link table');\n\n"; + $object_string .= "$object_name_v -> tie_event('$object_name->delete_orphan_links','delete orphan links');\n\n"; + $object_string .= "$object_name_v -> tie_event('$object_name->delete_orphan_links(1)','AUDIT - delete orphan links');\n\n"; + $object_string .= "$object_name_v -> tie_event('&Insteon::scan_all_linktables','scan all device link tables');\n\n"; + $object_string .= "$object_name_v -> tie_event('&Insteon::sync_all_links(0)','sync all links');\n\n"; + $object_string .= "$object_name_v -> tie_event('&Insteon::sync_all_links(1)','AUDIT - sync all links');\n\n"; + $object_string .= &main::store_object_data($object_name_v, 'Voice_Cmd', 'Insteon', 'Insteon_PLM_commands'); + push @_insteon_plm, $object_name; + } + } + + package main; + eval $object_string; + print "Error in insteon_item_commands: $@\n" if $@; + package Insteon; +} + +sub add +{ + my ($object) = @_; + + my $insteon_manager = InsteonManager->instance(); + if ($insteon_manager->remove_item($object)) { + # print out debug info + } + $insteon_manager->add_item($object); +} + +sub find_members +{ + my ($name) = @_; + + my $insteon_manager = InsteonManager->instance(); + return $insteon_manager->find_members($name); +} + + +sub get_object +{ + my ($p_deviceid, $p_group) = @_; + + my $retObj = undef; + + my $insteon_manager = InsteonManager->instance(); + my @search_objects = (); + push @search_objects, $insteon_manager->find_members('Insteon::BaseObject'); + for my $obj (@search_objects) + { + #Match on Insteon objects only + # if ($obj->isa("Insteon::Insteon_Device")) + # { + if (lc $obj->device_id() eq lc $p_deviceid) + { + if ($p_group) + { + if (lc $p_group eq lc $obj->group) + { + $retObj = $obj; + last; + } + } else { + $retObj = $obj; + last; + } + } + # } + } + + return $retObj; +} + +sub active_interface +{ + my ($interface) = @_; + my $insteon_manager = InsteonManager->instance(); + + $insteon_manager->_active_interface($interface) + if $interface && ref $interface && $interface->isa('Insteon::BaseInterface'); +#print "############### active interface is: " . $insteon_manager->_active_interface->get_object_name . "\n"; + return $insteon_manager->_active_interface; + +} + +package InsteonManager; + +use strict; +use base 'Class::Singleton'; + +sub _new_instance +{ + my $class = shift; + my $self = bless {}, $class; + + return $self; +} + +sub _active_interface +{ + my ($self, $interface) = @_; + # setup hooks the first time that an interface is made active + if (!($$self{active_interface}) and $interface) { + &main::print_log("[Insteon] Setting up initialization hooks") if $main::Debug{insteon}; + &main::MainLoop_pre_add_hook(\&Insteon::BaseInterface::check_for_data, 1); + &main::Reload_post_add_hook(\&Insteon::BaseInterface::poll_all, 1); + $Insteon::init_complete = 0; + &main::MainLoop_pre_add_hook(\&Insteon::init, 1); + &main::Reload_post_add_hook(\&Insteon::generate_voice_commands, 1); + } + $$self{active_interface} = $interface if $interface; + return $$self{active_interface}; +} + +sub add +{ + my ($self,@p_objects) = @_; + + my @l_objects; + + for my $l_object (@p_objects) { + if ($l_object->isa('Group_Item') ) { + @l_objects = $$l_object{members}; + for my $obj (@l_objects) { + $self->add($obj); + } + } else { + $self->add_item($l_object); + } + } +} + +sub add_item +{ + my ($self,$p_object) = @_; + + push @{$$self{objects}}, $p_object; + if ($p_object->isa('Insteon::BaseInterface') and !($self->_active_interface)) { + $self->_active_interface($p_object); + } + return $p_object; +} + +sub remove_all_items { + my ($self) = @_; + + if (ref $$self{objects}) { + foreach (@{$$self{objects}}) { + # $_->untie_items($self); + } + } + delete $self->{objects}; +} + +sub add_item_if_not_present { + my ($self, $p_object) = @_; + + if (ref $$self{objects}) { + foreach (@{$$self{objects}}) { + if ($_->equals($p_object)) { + return 0; + } + } + } + $self->add_item($p_object); + return 1; +} + +sub remove_item { + my ($self, $p_object) = @_; + return 0 unless $p_object and ref $p_object; + if (ref $$self{objects}) { + for (my $i = 0; $i < scalar(@{$$self{objects}}); $i++) { + if ($p_object->equals($$self{objects}->[$i])) { + splice @{$$self{objects}}, $i, 1; + return 1; + } + } + } + return 0; +} + + +sub is_member { + my ($self, $p_object) = @_; + + my @l_objects = @{$$self{objects}}; + for my $l_object (@l_objects) { + if ($l_object->equals($p_object)) { + return 1; + } + } + return 0; +} + +sub find_members { + my ($self,$p_type) = @_; + + my @l_found; + my @l_objects = @{$$self{objects}}; + for my $l_object (@l_objects) { + if ($l_object->isa($p_type)) { + push @l_found, $l_object; + } + } + return @l_found; +} + +1 diff --git a/lib/Insteon/AllLinkDatabase.pm b/lib/Insteon/AllLinkDatabase.pm new file mode 100755 index 000000000..63d436edc --- /dev/null +++ b/lib/Insteon/AllLinkDatabase.pm @@ -0,0 +1,2175 @@ +=begin comment +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ + +File: + AllLinkDatabase.pm + +Description: + Generic class implementation of an insteon device's all link database. + +Author(s): + Gregg Liming / gregg@limings.net + +License: + This free software is licensed under the terms of the GNU public license. + + +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +=cut + + +package Insteon::AllLinkDatabase; + +use strict; +use Insteon; +use Insteon::Lighting; + +# @Insteon::AllLinkDatabase::ISA = ('Generic_Item'); + + +sub new +{ + my ($class, $device) = @_; + my $self={}; + bless $self,$class; + $$self{device} = $device; + $self->health("unknown"); # unknown + return $self; +} + +sub _send_cmd +{ + my ($self, $msg) = @_; + $$self{device}->_send_cmd($msg); +} + +sub health +{ + # corrupt + # unknown + # empty + # good + my ($self, $health) = @_; + $$self{health} = $health if defined $health; + return $$self{health}; +} + +sub scandatetime +{ + my ($self, $scandatetime) = @_; + $$self{scandatetime} = $scandatetime if defined $scandatetime; + return $$self{scandatetime}; +} + +sub restore_string +{ + my ($self) = @_; + my $restore_string = ''; + if ($$self{aldb}) { + my $aldb = ''; + foreach my $aldb_key (keys %{$$self{aldb}}) { + next unless $aldb_key eq 'empty' || $aldb_key eq 'duplicates' || $$self{aldb}{$aldb_key}{inuse}; + $aldb .= '|' if $aldb; # separate sections + my $record = ''; + if ($aldb_key eq 'empty') { + foreach my $address (@{$$self{aldb}{empty}}) { + $record .= ';' if $record; + $record .= $address; + } + $record = 'empty=' . $record; + } elsif ($aldb_key eq 'duplicates') { + my $duplicate_record = ''; + foreach my $address (@{$$self{aldb}{duplicates}}) { + $duplicate_record .= ';' if $duplicate_record; + $duplicate_record .= $address; + } + $record = 'duplicates=' . $duplicate_record; + } else { + my %aldb_record = %{$$self{aldb}{$aldb_key}}; + foreach my $record_key (keys %aldb_record) { + next unless $aldb_record{$record_key}; + $record .= ',' if $record; + $record .= $record_key . '=' . $aldb_record{$record_key}; + } + } + $aldb .= $record; + } +# &::print_log("[AllLinkDataBase] aldb restore string: $aldb") if $main::Debug{insteon}; + if (defined $self->scandatetime) + { + $restore_string .= $$self{device}->get_object_name . "->_aldb->scandatetime(q~" . $self->scandatetime . "~) if " + . $$self{device}->get_object_name . "->_aldb;\n"; + } + $restore_string .= $$self{device}->get_object_name . "->_aldb->health(q~" . $self->health . "~) if " + . $$self{device}->get_object_name . "->_aldb;\n"; + $restore_string .= $$self{device}->get_object_name . "->_aldb->restore_aldb(q~$aldb~) if " . $$self{device}->get_object_name . "->_aldb;\n"; + } + return $restore_string; +} + +sub restore_aldb +{ + my ($self,$aldb) = @_; + if ($aldb) { + foreach my $aldb_section (split(/\|/,$aldb)) { + my %aldb_record = (); + my @aldb_empty = (); + my @aldb_duplicates = (); + my $deviceid = ''; + my $groupid = '01'; + my $is_controller = 0; + my $subaddress = '00'; + foreach my $aldb_entry (split(/,/,$aldb_section)) { + my ($key,$value) = split(/=/,$aldb_entry); + next unless $key and defined($value) and $value ne ''; + if ($key eq 'empty') { + @aldb_empty = split(/;/,$value); + } elsif ($key eq 'duplicates') { + @aldb_duplicates = split(/;/,$value); + } else { + $deviceid = lc $value if ($key eq 'deviceid'); + $groupid = lc $value if ($key eq 'group'); + $is_controller = $value if ($key eq 'is_controller'); + $subaddress = $value if ($key eq 'data3'); + $aldb_record{$key} = $value if $key and defined($value); + } + } + if (@aldb_empty) { + @{$$self{aldb}{empty}} = @aldb_empty; + } elsif (@aldb_duplicates) { + @{$$self{aldb}{duplicates}} = @aldb_duplicates; + } elsif (scalar %aldb_record) { + next unless $deviceid; + my $aldbkey = $deviceid . $groupid . $is_controller; + # append the device "sub-address" (e.g., a non-root button on a keypadlinc) if it exists + if ($subaddress ne '00' and $subaddress ne '01') { + $aldbkey .= $subaddress; + } + %{$$self{aldb}{$aldbkey}} = %aldb_record; + } + } +# $self->log_alllink_table(); + } +} + + + + +package Insteon::ALDB_i1; + +use strict; +use Insteon; +use Insteon::Lighting; +use Insteon::Message; + +@Insteon::ALDB_i1::ISA = ('Insteon::AllLinkDatabase'); + +sub new +{ + my ($class,$device) = @_; + + my $self = new Insteon::AllLinkDatabase($device); + bless $self,$class; + return $self; +} + +sub _on_poke +{ + my ($self,%msg) = @_; + my $message = new Insteon::InsteonMessage('insteon_send', $$self{device}, 'peek'); + if (($$self{_mem_activity} eq 'update') or ($$self{_mem_activity} eq 'add')) + { + if ($$self{_mem_action} eq 'aldb_flag') + { + $$self{_mem_action} = 'aldb_group'; + $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); + $message->extra($$self{_mem_lsb}); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + elsif ($$self{_mem_action} eq 'aldb_group') + { + $$self{_mem_action} = 'aldb_devhi'; + $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); + $message->extra($$self{_mem_lsb}); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + elsif ($$self{_mem_action} eq 'aldb_devhi') + { + $$self{_mem_action} = 'aldb_devmid'; + $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); + $message->extra($$self{_mem_lsb}); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + elsif ($$self{_mem_action} eq 'aldb_devmid') + { + $$self{_mem_action} = 'aldb_devlo'; + $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); + $message->extra($$self{_mem_lsb}); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + elsif ($$self{_mem_action} eq 'aldb_devlo') + { + $$self{_mem_action} = 'aldb_data1'; + $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); + $message->extra($$self{_mem_lsb}); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + elsif ($$self{_mem_action} eq 'aldb_data1') + { + $$self{_mem_action} = 'aldb_data2'; + $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); + $message->extra($$self{_mem_lsb}); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + elsif ($$self{_mem_action} eq 'aldb_data2') + { + $$self{_mem_action} = 'aldb_data3'; + $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); + $message->extra($$self{_mem_lsb}); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + elsif ($$self{_mem_action} eq 'aldb_data3') + { + ## update the aldb records w/ the changes that were made + my $aldbkey = $$self{pending_aldb}{deviceid} + . $$self{pending_aldb}{group} + . $$self{pending_aldb}{is_controller}; + # append the device "sub-address" (e.g., a non-root button on a keypadlinc) if it exists + my $subaddress = $$self{pending_aldb}{data3}; + if (($subaddress ne '00') and ($subaddress ne '01')) + { + $aldbkey .= $subaddress; + } + $$self{aldb}{$aldbkey}{data1} = $$self{pending_aldb}{data1}; + $$self{aldb}{$aldbkey}{data2} = $$self{pending_aldb}{data2}; + $$self{aldb}{$aldbkey}{data3} = $$self{pending_aldb}{data3}; + $$self{aldb}{$aldbkey}{inuse} = 1; # needed so that restore string will preserve record + if ($$self{_mem_activity} eq 'add') + { + $$self{aldb}{$aldbkey}{is_controller} = $$self{pending_aldb}{is_controller}; + $$self{aldb}{$aldbkey}{deviceid} = lc $$self{pending_aldb}{deviceid}; + $$self{aldb}{$aldbkey}{group} = lc $$self{pending_aldb}{group}; + $$self{aldb}{$aldbkey}{address} = $$self{pending_aldb}{address}; + } + # clear out mem_activity flag + $$self{_mem_activity} = undef; + if (defined $$self{_success_callback}) + { + my $callback = $$self{_success_callback}; + # clear it out *before* the eval + $$self{_success_callback} = undef; + package main; + eval ($callback); + package Insteon::ALDB_i1; + &::print_log("[Insteon::ALDB_i1] error in link callback: " . $@) + if $@ and $main::Debug{insteon}; + } + } + } + elsif ($$self{_mem_activity} eq 'update_local') + { + if ($$self{_mem_action} eq 'local_onlevel') + { + $$self{_mem_lsb} = '21'; + $$self{_mem_action} = 'local_ramprate'; + $message->extra($$self{_mem_lsb}); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + elsif ($$self{_mem_action} eq 'local_ramprate') + { + if ($$self{device}->isa('Insteon::KeyPadLincRelay') or $$self{device}->isa('Insteon::KeyPadLinc')) + { + # update from eeprom--only a kpl issue + $message = new Insteon::InsteonMessage('insteon_send', $$self{device}, 'do_read_ee'); + $self->_send_cmd($message); + } + } + } + elsif ($$self{_mem_activity} eq 'update_flags') + { + # update from eeprom--only a kpl issue + $message = new Insteon::InsteonMessage('insteon_send', $$self{device}, 'do_read_ee'); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + elsif ($$self{_mem_activity} eq 'delete') + { + # clear out mem_activity flag + $$self{_mem_activity} = undef; + # add the address of the deleted link to the empty list + $self->add_empty_address($$self{pending_aldb}{address}); + # and, remove from the duplicates list (if it is a member) + $self->delete_duplicate_link_address($$self{pending_aldb}{address}); + if (exists $$self{pending_aldb}{deviceid}) + { + my $key = lc $$self{pending_aldb}{deviceid} + . $$self{pending_aldb}{group} + . $$self{pending_aldb}{is_controller}; + # append the device "sub-address" (e.g., a non-root button on a keypadlinc) if it exists + my $subaddress = $$self{pending_aldb}{data3}; + if ($subaddress ne '00' and $subaddress ne '01') + { + $key .= $subaddress; + } + delete $$self{aldb}{$key}; + } + + if (defined $$self{_success_callback}) + { + my $callback = $$self{_success_callback}; + # clear it out *before* the eval + $$self{_success_callback} = undef; + package main; + eval ($callback); + &::print_log("[Insteon::ALDB_i1] error in link callback: " . $@) + if $@ and $main::Debug{insteon}; + package Insteon::ALDB_i1; + } + } +} + +sub _on_peek +{ + my ($self,%msg) = @_; + my $message = new Insteon::InsteonMessage('insteon_send', $$self{device}, 'peek'); + if ($msg{is_extended}) { + &::print_log("[Insteon::ALDB_i1]: extended peek for " . $$self{device}->{object_name} + . " is " . $msg{extra}) if $main::Debug{insteon}; + } + else + { + if ($$self{_mem_action} eq 'aldb_peek') + { + if ($$self{_mem_activity} eq 'scan') + { + $$self{_mem_action} = 'aldb_flag'; + # if the device is responding to the peek, then init the link table + # if at the very start of a scan + if (lc $$self{_mem_msb} eq '0f' and lc $$self{_mem_lsb} eq 'f8') + { + # reinit the aldb hash as there will be a new one + $$self{aldb} = undef; + # reinit the empty address list + @{$$self{aldb}{empty}} = (); + # and, also the duplicates list + @{$$self{aldb}{duplicates}} = (); + } + } + elsif ($$self{_mem_activity} eq 'update') + { + $$self{_mem_action} = 'aldb_data1'; + } + elsif ($$self{_mem_activity} eq 'update_local') + { + $$self{_mem_action} = 'local_onlevel'; + } + elsif ($$self{_mem_activity} eq 'update_flags') + { + $$self{_mem_action} = 'update_flags'; + } + elsif ($$self{_mem_activity} eq 'delete') + { + $$self{_mem_action} = 'aldb_flag'; + } + elsif ($$self{_mem_activity} eq 'add') + { + $$self{_mem_action} = 'aldb_flag'; + } + $message->extra($$self{_mem_lsb}); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + elsif ($$self{_mem_action} eq 'aldb_flag') + { + if ($$self{_mem_activity} eq 'scan') + { + &::print_log("[Insteon::ALDB_i1] DEBUG3: " . $$self{device}->get_object_name + . " [0x" . $$self{_mem_msb} . $$self{_mem_lsb} . "] received: " + . lc $msg{extra} . " for " . $$self{_mem_action}) if $main::Debug{insteon} >= 3; + my $flag = hex($msg{extra}); + $$self{pending_aldb}{inuse} = ($flag & 0x80) ? 1 : 0; + $$self{pending_aldb}{is_controller} = ($flag & 0x40) ? 1 : 0; + $$self{pending_aldb}{highwater} = ($flag & 0x02) ? 1 : 0; + if (!($$self{pending_aldb}{highwater})) + { + # since this is the last unused memory location, then add it to the empty list + $self->add_empty_address($$self{_mem_msb} . $$self{_mem_lsb}); + $$self{_mem_action} = undef; + # clear out mem_activity flag + $$self{_mem_activity} = undef; + if (lc $$self{_mem_msb} eq '0f' and lc $$self{_mem_lsb} eq 'f8') + { + # set health as empty for now + $self->health("empty"); + } + else + { + $self->health("good"); + } + + &::print_log("[Insteon::ALDB_i1] " . $$self{device}->get_object_name . " completed link memory scan") + if $main::Debug{insteon}; + if (defined $$self{_success_callback}) + { + my $callback = $$self{_success_callback}; + # clear it out *before* the eval + $$self{_success_callback} = undef; + package main; + eval ($callback); + &::print_log("[Insteon::ALDB_i1] " . $$self{device}->get_object_name . ": error during scan callback $@") + if $@ and $main::Debug{insteon}; + package Insteon::ALDB_i1; + } + } + else + { + $$self{pending_aldb}{flag} = $msg{extra}; + ## confirm that we have a high-water mark; otherwise stop + $$self{pending_aldb}{address} = $$self{_mem_msb} . $$self{_mem_lsb}; + $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); + $$self{_mem_action} = 'aldb_group'; + $message->extra($$self{_mem_lsb}); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + } + elsif ($$self{_mem_activity} eq 'add') + { + # TO-DO!!! Eventually add the ability to set the highwater mark + # the below flags never reset the highwater mark so that + # the scanner will continue scanning extra empty records + my $flag = ($$self{pending_aldb}{is_controller}) ? 'E2' : 'A2'; + $$self{pending_aldb}{flag} = $flag; + $message = new Insteon::InsteonMessage('insteon_send', $$self{device}, 'poke'); + $message->extra($flag); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + elsif ($$self{_mem_activity} eq 'delete') + { + $message = new Insteon::InsteonMessage('insteon_send', $$self{device}, 'poke'); + $message->extra('02'); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + } + elsif ($$self{_mem_action} eq 'aldb_group') + { + if ($$self{_mem_activity} eq 'scan') + { + &::print_log("[Insteon::ALDB_i1] DEBUG3: " . $$self{device}->get_object_name + . " [0x" . $$self{_mem_msb} . $$self{_mem_lsb} . "] received: " + . lc $msg{extra} . " for " . $$self{_mem_action}) if $main::Debug{insteon} >= 3; + $$self{pending_aldb}{group} = lc $msg{extra}; + $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); + $$self{_mem_action} = 'aldb_devhi'; + $message->extra($$self{_mem_lsb}); + } + else + { + $message = new Insteon::InsteonMessage('insteon_send', $$self{device}, 'poke'); + $message->extra($$self{pending_aldb}{group}); + } + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + elsif ($$self{_mem_action} eq 'aldb_devhi') + { + if ($$self{_mem_activity} eq 'scan') + { + &::print_log("[Insteon::ALDB_i1] DEBUG3: " . $$self{device}->get_object_name + . " [0x" . $$self{_mem_msb} . $$self{_mem_lsb} . "] received: " + . lc $msg{extra} . " for " . $$self{_mem_action}) if $main::Debug{insteon} >= 3; + $$self{pending_aldb}{deviceid} = lc $msg{extra}; + $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); + $$self{_mem_action} = 'aldb_devmid'; + $message->extra($$self{_mem_lsb}); + } + elsif ($$self{_mem_activity} eq 'add') + { + my $devid = substr($$self{pending_aldb}{deviceid},0,2); + $message = new Insteon::InsteonMessage('insteon_send', $$self{device}, 'poke'); + $message->extra($devid); + } + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + elsif ($$self{_mem_action} eq 'aldb_devmid') + { + if ($$self{_mem_activity} eq 'scan') + { + &::print_log("[Insteon::ALDB_i1] DEBUG3: " . $$self{device}->get_object_name + . " [0x" . $$self{_mem_msb} . $$self{_mem_lsb} . "] received: " + . lc $msg{extra} . " for " . $$self{_mem_action}) if $main::Debug{insteon} >= 3; + $$self{pending_aldb}{deviceid} .= lc $msg{extra}; + $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); + $$self{_mem_action} = 'aldb_devlo'; + $message->extra($$self{_mem_lsb}); + } + elsif ($$self{_mem_activity} eq 'add') + { + my $devid = substr($$self{pending_aldb}{deviceid},2,2); + $message = new Insteon::InsteonMessage('insteon_send', $$self{device}, 'poke'); + $message->extra($devid); + } + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + elsif ($$self{_mem_action} eq 'aldb_devlo') + { + if ($$self{_mem_activity} eq 'scan') + { + &::print_log("[Insteon::ALDB_i1] DEBUG3: " . $$self{device}->get_object_name + . " [0x" . $$self{_mem_msb} . $$self{_mem_lsb} . "] received: " + . lc $msg{extra} . " for " . $$self{_mem_action}) if $main::Debug{insteon} >= 3; + $$self{pending_aldb}{deviceid} .= lc $msg{extra}; + $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); + $$self{_mem_action} = 'aldb_data1'; + $message->extra($$self{_mem_lsb}); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + elsif ($$self{_mem_activity} eq 'add') + { + my $devid = substr($$self{pending_aldb}{deviceid},4,2); + $message = new Insteon::InsteonMessage('insteon_send', $$self{device}, 'poke'); + $message->extra($devid); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + } + elsif ($$self{_mem_action} eq 'aldb_data1') + { + if ($$self{_mem_activity} eq 'scan') + { + &::print_log("[Insteon::ALDB_i1] DEBUG3: " . $$self{device}->get_object_name + . " [0x" . $$self{_mem_msb} . $$self{_mem_lsb} . "] received: " + . lc $msg{extra} . " for " . $$self{_mem_action}) if $main::Debug{insteon} >= 3; + $$self{_mem_action} = 'aldb_data2'; + $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); + $$self{pending_aldb}{data1} = $msg{extra}; + $message->extra($$self{_mem_lsb}); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + elsif ($$self{_mem_activity} eq 'update' or $$self{_mem_activity} eq 'add') + { + # poke the new value + $message = new Insteon::InsteonMessage('insteon_send', $$self{device}, 'poke'); + $message->extra($$self{pending_aldb}{data1}); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + } + elsif ($$self{_mem_action} eq 'aldb_data2') + { + if ($$self{_mem_activity} eq 'scan') + { + &::print_log("[Insteon::ALDB_i1] DEBUG3: " . $$self{device}->get_object_name + . " [0x" . $$self{_mem_msb} . $$self{_mem_lsb} . "] received: " + . lc $msg{extra} . " for " . $$self{_mem_action}) if $main::Debug{insteon} >= 3; + $$self{pending_aldb}{data2} = $msg{extra}; + $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); + $$self{_mem_action} = 'aldb_data3'; + $message->extra($$self{_mem_lsb}); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + elsif ($$self{_mem_activity} eq 'update' or $$self{_mem_activity} eq 'add') + { + # poke the new value + $message = new Insteon::InsteonMessage('insteon_send', $$self{device}, 'poke'); + $message->extra($$self{pending_aldb}{data2}); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + } + elsif ($$self{_mem_action} eq 'aldb_data3') + { + if ($$self{_mem_activity} eq 'scan') + { + &::print_log("[Insteon::ALDB_i1] DEBUG3: " . $$self{device}->get_object_name + . " [0x" . $$self{_mem_msb} . $$self{_mem_lsb} . "] received: " + . lc $msg{extra} . " for " . $$self{_mem_action}) if $main::Debug{insteon} >= 3; + $$self{pending_aldb}{data3} = $msg{extra}; + # check the previous record if highwater is set + if ($$self{pending_aldb}{highwater}) + { + if ($$self{pending_aldb}{inuse}) + { + # save pending_aldb and then clear it out + my $aldbkey = lc $$self{pending_aldb}{deviceid} + . $$self{pending_aldb}{group} + . $$self{pending_aldb}{is_controller}; + # append the device "sub-address" (e.g., a non-root button on a keypadlinc) if it exists + my $subaddress = $$self{pending_aldb}{data3}; + if ($subaddress ne '00' and $subaddress ne '01') + { + $aldbkey .= $subaddress; + } + # check for duplicates + if (exists $$self{aldb}{$aldbkey} && $$self{aldb}{$aldbkey}{inuse}) + { + $self->add_duplicate_link_address($$self{pending_aldb}{address}); + } + else + { + %{$$self{aldb}{$aldbkey}} = %{$$self{pending_aldb}}; + } + } + else + { + $self->add_empty_address($$self{pending_aldb}{address}); + } + my $newaddress = sprintf("%04X", hex($$self{pending_aldb}{address}) - 8); + $$self{pending_aldb} = undef; + $self->_peek($newaddress); + } + } + elsif ($$self{_mem_activity} eq 'update' or $$self{_mem_activity} eq 'add') + { + # poke the new value + $message = new Insteon::InsteonMessage('insteon_send', $$self{device}, 'poke'); + $message->extra($$self{pending_aldb}{data3}); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + } + elsif ($$self{_mem_action} eq 'local_onlevel') + { + my $on_level = $self->local_onlevel; + $on_level = &Insteon::DimmableLight::convert_level($on_level); + $message = new Insteon::InsteonMessage('insteon_send', $$self{device}, 'poke'); + $message->extra($on_level); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + elsif ($$self{_mem_action} eq 'local_ramprate') + { + my $ramp_rate = $$self{_ramprate}; + $ramp_rate = '1f' unless $ramp_rate; + $message = new Insteon::InsteonMessage('insteon_send', $$self{device}, 'poke'); + $message->extra($ramp_rate); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } + elsif ($$self{_mem_action} eq 'update_flags') + { + my $flags = $$self{_operating_flags}; + $message = new Insteon::InsteonMessage('insteon_send', $$self{device}, 'poke'); + $message->extra($flags); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); + } +# +# &::print_log("AllLinkDataBase: peek for " . $self->{object_name} +# . " is " . $msg{extra}) if $main::Debug{insteon}; + } +} + + +sub scan_link_table +{ + my ($self,$success_callback,$failure_callback) = @_; + $$self{_mem_activity} = 'scan'; + $$self{_success_callback} = ($success_callback) ? $success_callback : undef; + $$self{_failure_callback} = ($failure_callback) ? $failure_callback : undef; + $self->scandatetime(&main::get_tickcount); + $self->health('corrupt'); # allow acknowledge to set otherwise + $self->_peek('0FF8',0); +} + +sub delete_link +{ + my ($self, $parms_text) = @_; + my %link_parms; + if (@_ > 2) + { + shift @_; + %link_parms = @_; + } + else + { + %link_parms = &main::parse_func_parms($parms_text); + } + $$self{_success_callback} = ($link_parms{callback}) ? $link_parms{callback} : undef; + $$self{_failure_callback} = ($link_parms{failure_callback}) ? $link_parms{failure_callback} : undef; + if ($link_parms{address}) + { + &main::print_log("[Insteon::ALDB_i1] Now deleting link [0x$link_parms{address}]"); + $$self{_mem_activity} = 'delete'; + $$self{pending_aldb}{address} = $link_parms{address}; + $self->_peek($link_parms{address},0); + + } + else + { + my $insteon_object = $link_parms{object}; + my $deviceid = ($insteon_object) ? $insteon_object->device_id : $link_parms{deviceid}; + my $groupid = $link_parms{group}; + $groupid = '01' unless $groupid; + my $is_controller = ($link_parms{is_controller}) ? 1 : 0; + my $subaddress = ($link_parms{data3}) ? $link_parms{data3} : '00'; + # get the address via lookup into the hash + my $key = lc $deviceid . $groupid . $is_controller; + # append the device "sub-address" (e.g., a non-root button on a keypadlinc) if it exists + if ($subaddress ne '00' and $subaddress ne '01') + { + $key .= $subaddress; + } + my $address = $$self{aldb}{$key}{address}; + if ($address) + { + &main::print_log("[Insteon::ALDB_i1] Now deleting link [0x$address] with the following data" + . " deviceid=$deviceid, groupid=$groupid, is_controller=$is_controller"); + # now, alter the flags byte such that the in_use flag is set to 0 + $$self{_mem_activity} = 'delete'; + $$self{pending_aldb}{deviceid} = lc $deviceid; + $$self{pending_aldb}{group} = $groupid; + $$self{pending_aldb}{is_controller} = $is_controller; + $$self{pending_aldb}{address} = $address; + $self->_peek($address,0); + } + else + { + &main::print_log('[Insteon::ALDB_i1] WARN: (' . $$self{device}->get_object_name . ') attempt to delete link that does not exist!' + . " deviceid=$deviceid, groupid=$groupid, is_controller=$is_controller"); + if ($link_parms{callback}) + { + package main; + eval($link_parms{callback}); + &::print_log("[Insteon::ALDB_i1] error encountered during delete_link callback: " . $@) + if $@ and $main::Debug{insteon}; + package Insteon::AllLinkDataBase; + } + } + } +} + +sub delete_orphan_links +{ + my ($self, $audit_mode) = @_; + @{$$self{delete_queue}} = (); # reset the work queue + $$self{delete_queue_processed} = 0; + my $selfname = $$self{device}->get_object_name; + my $num_deleted = 0; + + # first, make sure that the health of ALDB is ok + if ($self->health ne 'good') + { + if ($$self{device}->isa('Insteon::RemoteLinc') or $$self{device}->isa('Insteon::MotionSensor')) + { + &::print_log("[Insteon::ALDB_i1] Delete orphan links: ignoring link from deaf device: $selfname"); + + } + else + { + &::print_log("[Insteon::ALDB_i1] Delete orphan links: skipping $selfname because health: " + . $self->health . ". Please rescan this device!!") + if ($self->health ne 'empty'); + } + $self->_process_delete_queue(); + return; + } + + for my $linkkey (keys %{$$self{aldb}}) + { + if ($linkkey ne 'empty' and $linkkey ne 'duplicates') + { + my $deviceid = lc $$self{aldb}{$linkkey}{deviceid}; + next unless $deviceid; + my $group = $$self{aldb}{$linkkey}{group}; + my $is_controller = $$self{aldb}{$linkkey}{is_controller}; + my $data3 = $$self{aldb}{$linkkey}{data3}; + # $device is the object that is referenced by the ALDB record's deviceid + my $linked_device = ($deviceid eq lc $$self{device}->interface->device_id) ? $$self{device}->interface + : &Insteon::get_object($deviceid,'01'); + if (!($linked_device)) + { + # no device is known by mh with the ADLB record's deviceid + if ($audit_mode) + { + &::print_log("[Insteon::ALDB_i1] (AUDIT) " . $selfname . " now deleting orphaned link w/ details: " + . (($is_controller) ? "controller" : "responder") + . ", deviceid=$deviceid, group=$group"); + } + else + { + my %delete_req = (deviceid => $deviceid, + group => $group, + is_controller => $is_controller, + callback => "$selfname->_aldb->_process_delete_queue()", + data3 => $data3, + cause => "no device could be found"); + push @{$$self{delete_queue}}, \%delete_req; + } + } + elsif ($linked_device->isa("Insteon::BaseInterface") and $is_controller) + { + # ignore since this is just a link back to the PLM + } + elsif ($linked_device->isa("Insteon::BaseInterface")) # and is a RESPONDER!! + { + # does the PLM have a corresponding controlled link to $self? If not, the delete this responder link + if (!($linked_device->has_link($$self{device},$group,1))) + { + if ($audit_mode) + { + my $plm_scene = &Insteon::get_object('000000',$group); + &::print_log("[Insteon::ALDB_i1] (AUDIT) Now deleting orphaned responder link in " + . $$self{device}->get_object_name + . (($data3 eq '00' or $data3 eq '01') ? "" : " [button:" . $data3 . "]") + . " because PLM does not have a corresponding controller record " + . "with group ($group)." . (($plm_scene && ref $plm_scene) ? " Please resync " + . $plm_scene->get_object_name . " before re-running in non-audit mode to restore PLM side" + : "")); + } + else + { + my %delete_req = (deviceid => $deviceid, + group => $group, + is_controller => $is_controller, + callback => "$selfname->_aldb->_process_delete_queue()", + object => $linked_device, + data3 => $data3, + cause => 'PLM does not have a link pointing back to device'); + push @{$$self{delete_queue}}, \%delete_req; + $num_deleted++; + } + } + else + { + # is there an entry in the items.mht that corresponds to this link? + # find the corresponding PLM scene that has this group + my $plm_link = &Insteon::get_object('000000', $group); + if ($plm_link) + { + my $is_invalid = 1; + # now, iterate over the PLM scene members to see if a match exists + foreach my $member_ref (keys %{$$plm_link{members}}) + { + my $member = $$plm_link{members}{$member_ref}{object}; + if ($member->isa('Light_Item')) + { + my @lights = $member->find_members('Insteon::BaseLight'); + if (@lights) + { + $member = @lights[0]; # pick the first + } + } + if ($member->device_id eq $$self{device}->device_id) + { + if ($data3 eq '00' or (lc $data3 eq lc $member->group)) + { + $is_invalid = 0; + last; + } + } + } + if ($is_invalid) + { + if ($audit_mode) + { + my $button_msg = ""; + if ($data3 ne '00' and $data3 ne '01') + { + ## to-do - validate that $data3 is <= 8 for all 8 key devices + $button_msg = " [button:" . $data3 . "]"; + } + &::print_log("[Insteon::ALDB_i1] (AUDIT) Delete orphan responder link from " + . $selfname . $button_msg + . " to PLM because no SCENE_MEMBER entry could be found " + . "in items.mht for INSTEON_ICONTROLLER: " + . $plm_link->get_object_name); + } + else + { + my %delete_req = (deviceid => $deviceid, group => $group, is_controller => $is_controller, + callback => "$selfname->_aldb->_process_delete_queue()", object => $linked_device, + cause => "no link is defined for the plm controlled scene", data3 => $data3); + push @{$$self{delete_queue}}, \%delete_req; + $num_deleted++; + } + } + } + else + { # no corresponding PLM link found + if ($audit_mode) + { + my $button_msg = ""; + if ($data3 ne '00' and $data3 ne '01') + { + ## to-do - validate that $data3 is <= 8 for all 8 key devices + $button_msg = " [button:" . $data3 . "]"; + } + &::print_log("[Insteon::ALDB_i1] (AUDIT) Delete orphan responder link from " + . $selfname . $button_msg . " to PLM because to PLM contoller exists for group:$group"); + } + else + { + # delete the link since it doesn't exist + my %delete_req = (deviceid => $deviceid, group => $group, is_controller => $is_controller, + callback => "$selfname->_aldb->_process_delete_queue()", object => $linked_device, + cause => "no plm link could be found", data3 => $data3); + push @{$$self{delete_queue}}, \%delete_req; + $num_deleted++; + } + } + } + } + else # is a non-PLM device + { + if ($linked_device->isa('Insteon::RemoteLinc') or $linked_device->isa('Insteon::MotionSensor')) + { + &::print_log("[Insteon::ALDB_i1] Delete orphan links: ignoring link from $selfname to 'deaf' device: " . $linked_device->get_object_name); + } + # make sure that the health of the device's ALDB is ok + elsif ($linked_device->_aldb->health ne 'good') + { + &::print_log("[Insteon::ALDB_i1] Delete orphan links: skipping check for reciprocal links from " + . $linked_device->get_object_name . " because health: " + . $linked_device->_aldb->health . ". Please rescan this device!!") + if ($linked_device->_aldb->health ne 'empty'); + } + else + { + # does the device fail to have a reciprocal link? + if (!($linked_device->has_link($self,$group,($is_controller) ? 0:1, $data3))) + { + # this may be a case of an impartial link (not yet bidirectional) + # BUT... if is_controller and $device is not a member of $$self{device} + # if not is_controller and $$self{device} is not a member of $device, + # then the dangling link needs to be deleted + if ($audit_mode) + { + if ($is_controller) + { + # reference_object is the controller that is referenced by this ALDB's deviceid and the group + my $reference_object = &Insteon::get_object($$self{device}->device_id, $group); + # reverse_object is the responder referenced by the ALDB link and it's data3 content + my $reverse_object = &Insteon::get_object($linked_device->device_id, ($data3 eq '00') ? '01' : $data3); + if (ref $reference_object and ref $reverse_object and + $reference_object->isa("Insteon::BaseController") and + $reference_object->has_member($reverse_object)) + { + &::print_log("[Insteon::ALDB_i1] (AUDIT) WARNING: no reciprocal link defined for: " + . $reference_object->get_object_name + . " as controller and " + . $reverse_object->get_object_name + . ". Please sync links with the applicable device; this link will not be deleted." + ); + } + else + { + &::print_log("[Insteon::ALDB_i1] (AUDIT) Deleting link defined for: " + . $$self{device}->get_object_name + . "($group) as controller and " + . $linked_device->get_object_name . "(" . (($data3 eq '00') ? '01' : $data3) . ")" + . " because no reciprocal link exists!" + ); + } + } + else # is a responder + { + # reference_object is the responder that is referenced by this ALDB's deviceid + # and the ALDB link's data3 + my $reference_object = &Insteon::get_object($$self{device}->device_id, + ($data3 eq '00') ? '01' : $data3); + # reverse_object is the controller referenced by the ALDB link and the group + my $reverse_object = &Insteon::get_object($linked_device->device_id, $group ); + if (ref $reference_object and ref $reverse_object and $reverse_object->isa("Insteon::BaseController") and $reverse_object->has_member($reference_object)) + { + &::print_log("[Insteon::ALDB_i1] (AUDIT) WARNING: no reverse link defined for: " + . $reference_object->get_object_name + . " as responder and " + . $reverse_object->get_object_name + . ". Please sync links with the applicable device; this link will not be deleted." + ); + } + else + { + &::print_log("[Insteon::ALDB_i1] (AUDIT) Deleting link defined for: " + . $$self{device}->get_object_name + . "(" . (($data3 eq '00') ? '01' : $data3) . ") as responder and " + . $linked_device->get_object_name . "($group)" + . " because no reverse links exists!" + ); + } + } + } + else # non-audit mode + { + if ($is_controller) + { + my $reference_object = &Insteon::get_object($$self{device}->device_id, $group); + my $reverse_object = &Insteon::get_object($linked_device->device_id, ($data3 eq '00') ? '01' : $data3); + if (ref $reference_object and ref $reverse_object and $reverse_object->isa("Insteon::BaseController") and $reverse_object->has_member($reference_object)) + { + &::print_log("[Insteon::ALDB_i1] WARNING: no reciprocal link defined for: " + . $reference_object->get_object_name + . " as controller and " + . $reverse_object->get_object_name + . ". Please sync links with the applicable device; this link will not be deleted." + ); + } + else + { + &::print_log("[Insteon::ALDB_i1] Deleting link defined for: " + . $$self{device}->get_object_name + . "($group) as controller and " + . $linked_device->get_object_name . "(" . (($data3 eq '00') ? '01' : $data3) . ")" + . " because no reciprocal link exists!" + ); + my %delete_req = (deviceid => $deviceid, + group => $group, + is_controller => $is_controller, + callback => "$selfname->_process_delete_queue()", + object => $linked_device, + cause => "no link to the device could be found", + data3 => $data3); + push @{$$self{delete_queue}}, \%delete_req; + $num_deleted++; + } + } + else # is a responder + { + my $reference_object = &Insteon::get_object($$self{device}->device_id, ($data3 eq '00') ? '01' : $data3); + my $reverse_object = &Insteon::get_object($linked_device->device_id, $group ); + if (ref $reference_object and ref $reverse_object and $reverse_object->isa("Insteon::BaseController") and $reverse_object->has_member($reference_object)) + { + &::print_log("[Insteon::ALDB_i1] WARNING: no reverse link defined for: " + . $reference_object->get_object_name + . " as responder and " + . $reverse_object->get_object_name + . ". Please sync links with the applicable device; this link will not be deleted." + ); + } + else + { + &::print_log("[Insteon::ALDB_i1] Deleting link defined for: " + . $$self{device}->get_object_name + . "(" . (($data3 eq '00') ? '01' : $data3) . ") as responder and " + . $linked_device->get_object_name . "($group)" + . " because no reverse links exists!" + ); + my %delete_req = (deviceid => $deviceid, + group => $group, + is_controller => $is_controller, + callback => "$selfname->_process_delete_queue()", + object => $linked_device, + cause => "no link to the device could be found", + data3 => $data3); + push @{$$self{delete_queue}}, \%delete_req; + $num_deleted++; + } + } + } + } + else # device does have reciprocal link + { + my $is_invalid = 1; + my $link = ($is_controller) ? &Insteon::get_object($$self{device}->device_id,$group) + : &Insteon::get_object($linked_device->device_id,$group); + if ($link) + { + foreach my $member_ref (keys %{$$link{members}}) + { + my $member = $$link{members}{$member_ref}{object}; + if ($member->isa('Light_Item')) + { + my @lights = $member->find_members('Insteon::BaseLight'); + if (@lights) + { + $member = @lights[0]; # pick the first + } + } + if ($member->isa('Insteon::BaseDevice') && !($member->is_root)) + { + $member = $member->get_root; + } + if ($member->isa('Insteon::RemoteLinc') or $member->isa('Insteon::MotionSensor')) + { + &::print_log("[Insteon::ALDB_i1] ignoring link from " . $link->get_object_name . " to " . + $member->get_object_name); + $is_invalid = 0; + } + elsif ($member->isa('Insteon::BaseDevice') && !($is_controller) + && ($member->device_id eq $$self{device}->device_id)) + { + $is_invalid = 0; + last; + } + elsif ($member->isa('Insteon::BaseDevice') && $is_controller + && ($member->device_id eq $linked_device->device_id)) + { + $is_invalid = 0; + last; + } + } # foreach + } + if ($is_invalid) + { + if ($audit_mode) + { + &::print_log("[Insteon::ALDB_i1] (AUDIT) Delete orphan because no reverse link could be found " + . $linked_device->get_object_name . + " details: " + . (($is_controller) ? "controller" : "responder") + . ", deviceid=$deviceid, group=$group, data=$data3"); + } + else + { + my %delete_req = (deviceid => $deviceid, + group => $group, + is_controller => $is_controller, + callback => "$selfname->_aldb->_process_delete_queue()", + object => $linked_device, + cause => "no reverse link could be found", + data3 => $data3); + push @{$$self{delete_queue}}, \%delete_req; + $num_deleted++; + } + } + } + } + } + } + elsif ($linkkey eq 'duplicates') + { + my @duplicate_addresses = (); + push @duplicate_addresses, @{$$self{aldb}{duplicates}}; + my $address = pop @duplicate_addresses; + while ($address) + { + if ($audit_mode) + { + &::print_log("[Insteon::ALDB_i1] (AUDIT) Delete orphan because duplicate found " + . "$selfname, address=$address"); + } + else + { + my %delete_req = (address => $address, + callback => "$selfname->_aldb->_process_delete_queue()", + cause => "duplicate record found"); + push @{$$self{delete_queue}}, \%delete_req; + $num_deleted++; + } + $address = pop @duplicate_addresses; + } + } + } + if (!($audit_mode)) + { + &::print_log("[Insteon::ALDB_i1] ## Begin processing delete queue for: $selfname"); + } + $self->_process_delete_queue(); +} + +sub _process_delete_queue { + my ($self) = @_; + my $num_in_queue = @{$$self{delete_queue}}; + if ($num_in_queue) + { + my $delete_req_ptr = shift(@{$$self{delete_queue}}); + my %delete_req = %$delete_req_ptr; + if ($delete_req{address}) + { + &::print_log("[Insteon::ALDB_i1] (#$num_in_queue) " . $$self{device}->get_object_name . " now deleting duplicate record at address " + . $delete_req{address}); + } + else + { + &::print_log("[Insteon::ALDB_i1] (#$num_in_queue) " . $$self{device}->get_object_name . " now deleting orphaned link w/ details: " + . (($delete_req{is_controller}) ? "controller" : "responder") + . ", " . (($delete_req{object}) ? "device=" . $delete_req{object}->get_object_name + : "deviceid=$delete_req{deviceid}") . ", group=$delete_req{group}, cause=$delete_req{cause}"); + } + $self->delete_link(%delete_req); + $$self{delete_queue_processed}++; + } + else + { + &::print_log("[Insteon::ALDB_i1] Nothing else to do for " . $$self{device}->get_object_name . " after deleting " + . $$self{delete_queue_processed} . " links") if $main::Debug{insteon}; + $$self{device}->interface->_aldb->_process_delete_queue($$self{delete_queue_processed}); + } +} + +sub add_duplicate_link_address +{ + my ($self, $address) = @_; + + unshift @{$$self{aldb}{duplicates}}, $address; + + # now, keep the list sorted! + @{$$self{adlb}{duplicates}} = sort(@{$$self{aldb}{duplicates}}); + +} + +sub delete_duplicate_link_address +{ + my ($self, $address) = @_; + my $num_duplicate_link_addresses = @{$$self{aldb}{duplicates}}; + if ($num_duplicate_link_addresses) + { + my @temp_duplicates = (); + foreach my $temp_address (@{$$self{aldb}{duplicates}}) + { + if ($temp_address ne $address) + { + push @temp_duplicates, $temp_address; + } + } + # keep it sorted + @{$$self{aldb}{duplicates}} = sort(@temp_duplicates); + } +} + +sub add_empty_address +{ + my ($self, $address) = @_; + # before adding it, make sure that it isn't already in the list!! + my $num_addresses = @{$$self{aldb}{empty}}; + my $exists = 0; + if ($num_addresses and $address) + { + foreach my $temp_address (@{$$self{aldb}{empty}}) + { + if ($temp_address eq $address) + { + $exists = 1; + last; + } + } + } + # add it to the list if it doesn't exist + if (!($exists) and $address) + { + unshift @{$$self{aldb}{empty}}, $address; + } + + # now, keep the list sorted! + @{$$self{adlb}{empty}} = sort(@{$$self{aldb}{empty}}); + +} + +sub get_first_empty_address +{ + my ($self) = @_; + + # NOTE: The issue here is that we give up an address from the list + # with the assumption that it will be made non-empty; + # So, if there is a problem during update/add, then will have + # a non-empty, but non-functional entry + my $first_address = pop @{$$self{aldb}{empty}}; + + if (!($first_address)) + { + # then, cycle through all of the existing non-empty addresses + # to find the lowest one and then decrement by 8 + # + # TO-DO: factor in appropriate use of the "highwater" flag + # + my $low_address = 0; + for my $key (keys %{$$self{aldb}}) + { + next if $key eq 'empty' or $key eq 'duplicates'; + my $new_address = hex($$self{aldb}{$key}{address}); + if (!($low_address)) + { + $low_address = $new_address; + next; + } + else + { + $low_address = $new_address if $new_address < $low_address; + } + } + $first_address = sprintf('%04X', $low_address - 8); + } + + return $first_address; +} + +sub add_link +{ + my ($self, $parms_text) = @_; + my %link_parms; + if (@_ > 2) + { + shift @_; + %link_parms = @_; + } + else + { + %link_parms = &main::parse_func_parms($parms_text); + } + my $device_id; + my $insteon_object = $link_parms{object}; + my $group = $link_parms{group}; + if (!(defined($insteon_object))) + { + $device_id = lc $link_parms{deviceid}; + $insteon_object = &Insteon::get_object($device_id, $group); + } + else + { + $device_id = lc $insteon_object->device_id; + } + my $is_controller = ($link_parms{is_controller}) ? 1 : 0; + # check whether the link already exists + my $subaddress = ($link_parms{data3}) ? $link_parms{data3} : '00'; + # get the address via lookup into the hash + my $key = lc $device_id . $group . $is_controller; + # append the device "sub-address" (e.g., a non-root button on a keypadlinc) if it exists + if (!($subaddress eq '00' or $subaddress eq '01')) + { + $key .= $subaddress; + } + if (defined $$self{aldb}{$key}{inuse}) + { + &::print_log("[Insteon::ALDB_i1] WARN: attempt to add link to " . $$self{device}->get_object_name . " that already exists! " + . "object=" . $insteon_object->get_object_name . ", group=$group, is_controller=$is_controller"); + if ($link_parms{callback}) + { + package main; + eval($link_parms{callback}); + &::print_log("[Insteon::ALDB_i1] failure occurred in callback eval for " . $$self{device}->get_object_name . ":" . $@) + if $@ and $main::Debug{insteon}; + package Insteon::ALDB_i1; + } + } + else + { + # strip optional % sign to append on_level + my $on_level = $link_parms{on_level}; + $on_level =~ s/(\d)%?/$1/; + $on_level = '100' unless defined($on_level); # 100% == on is the default + # strip optional s (seconds) to append ramp_rate + my $ramp_rate = $link_parms{ramp_rate}; + $ramp_rate =~ s/(\d)s?/$1/; + $ramp_rate = '0.1' unless $ramp_rate; # 0.1s is the default + # get the first available memory location + my $address = $self->get_first_empty_address(); + $$self{_success_callback} = ($link_parms{callback}) ? $link_parms{callback} : undef; + $$self{_failure_callback} = ($link_parms{failure_callback}) ? $link_parms{failure_callback} : undef; + if ($address) + { + &::print_log("[Insteon::ALDB_i1] DEBUG2: adding link record " . $$self{device}->get_object_name + . " light level controlled by " . $insteon_object->get_object_name + . " and group: $group with on level: $on_level and ramp rate: $ramp_rate") + if $main::Debug{insteon} >= 2; + my $data1 = &Insteon::DimmableLight::convert_level($on_level); + my $data2 = ($$self{device}->isa('Insteon::DimmableLight')) ? &Insteon::DimmableLight::convert_ramp($ramp_rate) : '00'; + my $data3 = ($link_parms{data3}) ? $link_parms{data3} : '00'; + $$self{_mem_activity} = 'add'; + $self->_write_link($address, $device_id, $group, $is_controller, $data1, $data2, $data3); + # TO-DO: ensure that pop'd address is restored back to queue if the transaction fails + } + else + { + &::print_log("[Insteon::ALDB_i1] ERROR: adding link record failed because " + . $$self{device}->get_object_name + . " does not have a record of the first empty ALDB record." + . " Please rescan this device's link table") + if $main::Debug{insteon}; + + if ($$self{_success_callback}) + { + package main; + eval ($$self{_success_callback}); + &::print_log("[Insteon::ALDB_i1] WARN1: Error encountered during ack callback: " . $@) + if $@ and $main::Debug{insteon} >= 1; + package Insteon::AllLinkDatabase; + } + + } + } +} + +sub update_link +{ + my ($self, %link_parms) = @_; + my $insteon_object = $link_parms{object}; + my $group = $link_parms{group}; + my $is_controller = ($link_parms{is_controller}) ? 1 : 0; + # strip optional % sign to append on_level + my $on_level = $link_parms{on_level}; + $on_level =~ s/(\d+)%?/$1/; + # strip optional s (seconds) to append ramp_rate + my $ramp_rate = $link_parms{ramp_rate}; + $ramp_rate =~ s/(\d)s?/$1/; + &::print_log("[Insteon::ALDB_i1] updating " . $$self{device}->get_object_name . " light level controlled by " . $insteon_object->get_object_name + . " and group: $group with on level: $on_level and ramp rate: $ramp_rate") if $main::Debug{insteon}; + my $data1 = sprintf('%02X',$on_level * 2.55); + $data1 = 'ff' if $on_level eq '100'; + $data1 = '00' if $on_level eq '0'; + my $data2 = ($$self{device}->isa('Insteon::DimmableLight')) ? &Insteon::DimmableLight::convert_ramp($ramp_rate) : '00'; + my $data3 = ($link_parms{data3}) ? $link_parms{data3} : '00'; + my $deviceid = $insteon_object->device_id; + my $subaddress = $data3; + # get the address via lookup into the hash + my $key = lc $deviceid . $group . $is_controller; + # append the device "sub-address" (e.g., a non-root button on a keypadlinc) if it exists + if (!($subaddress eq '00' or $subaddress eq '01')) + { + $key .= $subaddress; + } + my $address = $$self{aldb}{$key}{address}; + $$self{_mem_activity} = 'update'; + $$self{_success_callback} = ($link_parms{callback}) ? $link_parms{callback} : undef; + $$self{_failure_callback} = ($link_parms{failure_callback}) ? $link_parms{failure_callback} : undef; + $self->_write_link($address, $deviceid, $group, $is_controller, $data1, $data2, $data3); +} + + +sub log_alllink_table +{ + my ($self) = @_; + my %aldb; + + &::print_log("[Insteon::ALDB_i1] Link table for " + . $$self{device}->get_object_name + . " health: " . $self->health); + + # We want to log links sorted by ALDB address. Since the ALDB + # addresses are scattered throughout the %{$$self{aldb}} hash, + # and it is not easy to obtain them in a linear manner, + # we build a new data structure that will allow us to easily + # traverse the ALDB by address in a sorted manner. The new + # data structure is a bidimensional hash (%aldb) where rows + # are the ALDB addresses and the columns can be "empty" + # (indicates that the ALDB at the corresponding address is + # empty), "duplicate" (indicates that the ALDB at the + # corresponding address is a duplicate), or a hash key (which + # indicates that the ALDB at corresponding address contains + # a link). + foreach my $aldbkey (keys %{$$self{aldb}}) + { + if ($aldbkey eq "empty") + { + foreach my $address (@{$$self{aldb}{empty}}) + { + $aldb{$address}{empty} = undef; # Any value will do + } + } + elsif ($aldbkey eq "duplicates") + { + foreach my $address (@{$$self{aldb}{duplicates}}) + { + $aldb{$address}{duplicate} = undef; # Any value will do + } + } + else + { + $aldb{$$self{aldb}{$aldbkey}{address} }{$aldbkey} = $$self{aldb}{$aldbkey}; + } + } + + # Finally traverse the ALDB, but this time sorted by ALDB address + if ($self->health eq 'good') + { + foreach my $address (sort keys %aldb) + { + my $log_msg = "[Insteon::ALDB_i1] [0x$address] "; + + if (exists $aldb{$address}{empty}) + { + $log_msg .= "is empty"; + } + elsif (exists $aldb{$address}{duplicate}) + { + $log_msg .= "holds a duplicate entry"; + } + else + { + my ($key) = keys %{$aldb{$address} }; # There's only 1 key + my $aldb_entry = $aldb{$address}{$key}; + my $is_controller = $aldb_entry->{is_controller}; + my $device; + + if ($$self{device}->interface()->device_id() + && ($$self{device}->interface()->device_id() + eq $aldb_entry->{deviceid})) + { + $device = $$self{device}->interface; + } + else + { + $device = &Insteon::get_object($aldb_entry->{deviceid},'01'); + } + my $object_name = ($device) ? $device->get_object_name : $aldb_entry->{deviceid}; + + my $on_level = 'unknown'; + if (defined $aldb_entry->{data1}) + { + if ($aldb_entry->{data1}) + { + $on_level = int((hex($aldb_entry->{data1})*100/255) + .5) . "%"; + } + else + { + $on_level = '0%'; + } + } + + my $rspndr_group = $aldb_entry->{data3}; + $rspndr_group = '01' if $rspndr_group eq '00'; + + my $ramp_rate = 'unknown'; + if ($aldb_entry->{data2}) + { + if (!($$self{device}->isa('Insteon::DimmableLight')) + or (!$is_controller and ($rspndr_group != '01'))) + { + $ramp_rate = 'none'; + $on_level = $on_level eq '0%' ? 'off' : 'on'; + } + else + { + $ramp_rate = &Insteon::DimmableLight::get_ramp_from_code($aldb_entry->{data2}) . "s"; + } + } + + $log_msg .= $is_controller ? "contlr($aldb_entry->{group}) " + . "record to $object_name ($rspndr_group), " + . "(d1:$aldb_entry->{data1}, " + . "d2:$aldb_entry->{data2}, " + . "d3:$aldb_entry->{data3})" + : "rspndr($rspndr_group) record to $object_name " + . "($aldb_entry->{group}): onlevel=$on_level " + . "and ramp=$ramp_rate " + . "(d3:$aldb_entry->{data3})"; + } + + &::print_log($log_msg); + } + } + else + { + } +} + +sub update_local_properties +{ + my ($self) = @_; + $$self{_mem_activity} = 'update_local'; + $self->_peek('0032'); # 0032 is the address for the onlevel +} + +sub update_flags +{ + my ($self, $flags) = @_; + return unless defined $flags; + + $$self{_mem_activity} = 'update_flags'; + $$self{_operating_flags} = $flags; + $self->_peek('0023'); +} + +sub get_link_record +{ + my ($self,$link_key) = @_; + my %link_record = (); + %link_record = %{$$self{aldb}{$link_key}} if $$self{aldb}{$link_key}; + return %link_record; +} + + + +sub has_link +{ + my ($self, $insteon_object, $group, $is_controller, $subaddress) = @_; + my $key = ""; + if ($insteon_object->isa('Insteon::BaseObject') || $insteon_object->isa('Insteon::BaseInterface')) + { + $key = lc $insteon_object->device_id . $group . $is_controller; + } + elsif ($insteon_object->isa('Insteon::AllLinkDatabase')) + { + $key = lc $$insteon_object{device}->device_id . $group . $is_controller; + } + $subaddress = '00' unless $subaddress; + # append the device "sub-address" (e.g., a non-root button on a keypadlinc) if it exists + if (!($subaddress eq '00' or $subaddress eq '01')) + { + $key .= $subaddress; + } + return (defined $$self{aldb}{$key}) ? 1 : 0; +} + +sub _write_link +{ + my ($self, $address, $deviceid, $group, $is_controller, $data1, $data2, $data3) = @_; + if ($address) + { + &::print_log("[Insteon::ALDB_i1] " . $$self{device}->get_object_name . " address: $address found for device: $deviceid and group: $group"); + # change address for start of change to be address + offset + if ($$self{_mem_activity} eq 'update') + { + $address = sprintf('%04X',hex($address) + 5); + } + $$self{pending_aldb}{address} = $address; + $$self{pending_aldb}{deviceid} = lc $deviceid; + $$self{pending_aldb}{group} = lc $group; + $$self{pending_aldb}{is_controller} = $is_controller; + $$self{pending_aldb}{data1} = (defined $data1) ? lc $data1 : '00'; + $$self{pending_aldb}{data2} = (defined $data2) ? lc $data2 : '00'; + # Note: if device is a KeypadLinc, then $data3 must be assigned the value of the applicable button (01) + if (($$self{device}->isa('Insteon::KeyPadLincRelay') or $$self{device}->isa('Insteon::KeyPadLinc')) and ($data3 eq '00')) + { + &::print_log("[Insteon::ALDB_i1] setting data3 to " . $$self{device}->group . " for this keypadlinc") + if $main::Debug{insteon}; + $data3 = $$self{device}->group; + } + $$self{pending_aldb}{data3} = (defined $data3) ? lc $data3 : '00'; + $self->_peek($address); + } + else + { + &::print_log("[Insteon::ALDB_i1] WARN: " . $$self{device}->get_object_name + . " write_link failure: no address available for record to device: $deviceid and group: $group" . + " and is_controller: $is_controller");; + if ($$self{_success_callback}) + { + package main; + eval ($$self{_success_callback}); + &::print_log("[Insteon::ALDB_i1] WARN1: Error encountered during ack callback: " . $@) + if $@ and $main::Debug{insteon} >= 1; + package Insteon::AllLinkDatabase; + } + } +} + +sub _peek +{ + my ($self, $address, $extended) = @_; + my $msb = substr($address,0,2); + my $lsb = substr($address,2,2); + if ($extended) + { + my $message = $self->device->derive_message('peek','insteon_ext_send', + $lsb . "0000000000000000000000000000"); + $self->interface->queue_message($message); + + } + else + { + $$self{_mem_lsb} = $lsb; + $$self{_mem_msb} = $msb; + $$self{_mem_action} = 'aldb_peek'; + &::print_log("[Insteon::ALDB_i1] " . $$self{device}->get_object_name . " accessing memory at location: 0x" . $address); + my $message = new Insteon::InsteonMessage('insteon_send', $$self{device}, 'set_address_msb'); + $message->extra($msb); + $message->failure_callback($$self{_failure_callback}); + $self->_send_cmd($message); +# $self->_send_cmd('command' => 'set_address_msb', 'extra' => $msb, 'is_synchronous' => 1); + } +} + + + +package Insteon::ALDB_i2; + +use strict; +use Insteon; +use Insteon::Lighting; + +@Insteon::ALDB_i2::ISA = ('Insteon::AllLinkDatabase'); + +sub new +{ + my ($class,$device) = @_; + + my $self = new Insteon::AllLinkDatabase($device); + bless $self,$class; + return $self; +} + + + + + +package Insteon::ALDB_PLM; + +use strict; +use Insteon; +use Insteon::Lighting; + +@Insteon::ALDB_PLM::ISA = ('Insteon::AllLinkDatabase'); + +sub new +{ + my ($class,$device) = @_; + + my $self = new Insteon::AllLinkDatabase($device); + bless $self,$class; + return $self; +} + +sub restore_string +{ + my ($self) = @_; + my $restore_string = ''; + if ($$self{aldb}) + { + my $link = ''; + foreach my $link_key (keys %{$$self{aldb}}) + { + $link .= '|' if $link; # separate sections + my %link_record = %{$$self{aldb}{$link_key}}; + my $record = ''; + foreach my $record_key (keys %link_record) + { + next unless $link_record{$record_key}; + $record .= ',' if $record; + $record .= $record_key . '=' . $link_record{$record_key}; + } + $link .= $record; + } + $restore_string .= $$self{device}->get_object_name . "->_aldb->restore_linktable(q~$link~) if " . $$self{device}->get_object_name . "->_aldb;\n"; + } + if (defined $self->scandatetime) + { + $restore_string .= $$self{device}->get_object_name . "->_aldb->scandatetime(q~" . $self->scandatetime . "~) if " + . $$self{device}->get_object_name . "->_aldb;\n"; + } + $restore_string .= $$self{device}->get_object_name . "->_aldb->health(q~" . $self->health . "~) if " + . $$self{device}->get_object_name . "->_aldb;\n"; + return $restore_string; +} + +sub restore_linktable +{ + my ($self, $links) = @_; + if ($links) + { + foreach my $link_section (split(/\|/,$links)) + { + my %link_record = (); + my $deviceid = ''; + my $groupid = '01'; + my $is_controller = 0; + foreach my $link_record (split(/,/,$link_section)) + { + my ($key,$value) = split(/=/,$link_record); + $deviceid = $value if ($key eq 'deviceid'); + $groupid = $value if ($key eq 'group'); + $is_controller = $value if ($key eq 'is_controller'); + $link_record{$key} = $value if $key and defined($value); + } + my $linkkey = $deviceid . $groupid . $is_controller; + %{$$self{aldb}{lc $linkkey}} = %link_record; + } +# $self->log_alllink_table(); + } +} + +sub log_alllink_table +{ + my ($self) = @_; + &::print_log("[Insteon::ALDB_PLM] Link table health: " . $self->health); + foreach my $linkkey (sort(keys(%{$$self{aldb}}))) { + my $data3 = $$self{aldb}{$linkkey}{data3}; + my $is_controller = $$self{aldb}{$linkkey}{is_controller}; + my $group = ($is_controller) ? $data3 : $$self{aldb}{$linkkey}{group}; + $group = '01' if $group eq '00'; + my $deviceid = $$self{aldb}{$linkkey}{deviceid}; + my $device = &Insteon::get_object($deviceid,$group); + my $object_name = ''; + if ($device) + { + $object_name = $device->get_object_name; + } + else + { + $object_name = uc substr($deviceid,0,2) . '.' . + uc substr($deviceid,2,2) . '.' . + uc substr($deviceid,4,2); + } + &::print_log("[Insteon::ALDB_PLM] " . + (($is_controller) ? "cntlr($$self{aldb}{$linkkey}{group}) record to " + . $object_name + : "responder record to " . $object_name . "($$self{aldb}{$linkkey}{group})") + . " (d1=$$self{aldb}{$linkkey}{data1}, d2=$$self{aldb}{$linkkey}{data2}, " + . "d3=$data3)"); + } +} + +sub parse_alllink +{ + my ($self, $data) = @_; + if (substr($data,0,6)) + { + my %link = (); + my $flag = substr($data,0,1); + $link{is_controller} = (hex($flag) & 0x04) ? 1 : 0; + $link{flags} = substr($data,0,2); + $link{group} = lc substr($data,2,2); + $link{deviceid} = lc substr($data,4,6); + $link{data1} = substr($data,10,2); + $link{data2} = substr($data,12,2); + $link{data3} = substr($data,14,2); + my $key = $link{deviceid} . $link{group} . $link{is_controller}; + %{$$self{aldb}{lc $key}} = %link; + } +} + +sub get_first_alllink +{ + my ($self) = @_; + $self->scandatetime(&main::get_tickcount); + $self->health('corrupt'); # set as corrupt and allow acknowledge to set otherwise + $$self{device}->queue_message(new Insteon::InsteonMessage('all_link_first_rec', $$self{device})); +} + +sub get_next_alllink +{ + my ($self) = @_; + $$self{device}->queue_message(new Insteon::InsteonMessage('all_link_next_rec', $$self{device})); +} + +sub delete_orphan_links +{ + my ($self, $audit_mode) = @_; + + &::print_log("[Insteon::ALDB_PLM] #### NOW BEGINNING DELETE ORPHAN LINKS ####"); + + @{$$self{delete_queue}} = (); # reset the work queue + my $selfname = $$self{device}->get_object_name; + my $num_deleted = 0; + foreach my $linkkey (keys %{$$self{aldb}}) + { + my $deviceid = lc $$self{aldb}{$linkkey}{deviceid}; + my $group = $$self{aldb}{$linkkey}{group}; + my $is_controller = $$self{aldb}{$linkkey}{is_controller}; + my $data3 = $$self{aldb}{$linkkey}{data3}; + my $device = &Insteon::get_object($deviceid,'01'); + # if a PLM link (regardless of responder or controller) exists to a device that is not known, then delete + if (!($device)) + { + if ($audit_mode) + { + &::print_log("[Insteon::ALDB_PLM] (AUDIT) Delete Orphan Link to non-existant deviceid: " . + $deviceid . "; group:$group; " + . (($is_controller) ? "controller; data:$data3" : "responder")) + if $main::Debug{insteon}; + } + else + { + my %delete_req = (deviceid => $deviceid, group => $group, is_controller => $is_controller, + callback => "$selfname->_aldb->_process_delete_queue(1)", + linkdevice => $self, data3 => $data3); + push @{$$self{delete_queue}}, \%delete_req; + } + } + else + { + my $is_invalid = 1; + my $link = undef; + if ($is_controller) + { + # then, this is a PLM defined link; and, we won't care about responder links as we assume + # they're ok given that they reference known devices + $link = &Insteon::get_object('000000',$group); + if (!($link)) + { + # a reference in the PLM's linktable does not match a scene member target + if ($audit_mode) + { + &::print_log("[Insteon::ALDB_PLM] (AUDIT) Delete Orphan PLM controller link ($group) to: " + . $device->get_object_name() . "($data3)") + if $main::Debug{insteon}; + } + else + { + my %delete_req = (object => $device, group => $group, is_controller => 1, + callback => "$selfname->_aldb->_process_delete_queue(1)", + linkdevice => $self, data3 => $data3); + push @{$$self{delete_queue}}, \%delete_req; + } + } + else + { + # iterate over all of the members of the Insteon_Link item + foreach my $member_ref (keys %{$$link{members}}) + { + my $member = $$link{members}{$member_ref}{object}; + # member will correspond to a scene member item + # and, if it is a light item, then get the real device + if ($member->isa('Light_Item')) + { + my @lights = $member->find_members('Insteon::BaseLight'); + if (@lights) + { + $member = @lights[0]; # pick the first + } + } + if ($member->isa('Insteon::BaseDevice')) + { + if ($member->isa('Insteon::RemoteLinc') or $member->isa('Insteon::MotionSensor')) + { + &::print_log("[Insteon::ALDB_PLM] ignoring link from PLM to " . + $member->get_object_name); + $is_invalid = 0; + } + else + { + my $linkmember = $member; + # make sure that this is a root device + if (!($member->is_root)) + { + $member = $member->get_root; + } + if (lc $member->device_id eq $$self{aldb}{$linkkey}{deviceid}) + { + # at this point, the forward link is ok; but, only if the reverse + # link also exists. So, check: + if ($member->has_link($self, $group, 0, $data3)) + { + $is_invalid = 0; + } + last; + } + } + } + else + { + $is_invalid = 0; + } + } # foreach $$link{members} + if ($is_invalid) + { + # then, there is a good chance that a reciprocal link exists; if so, delet it too + if ($device->has_link($self,$group,0, $data3)) + { + if ($audit_mode) + { + &::print_log("[Insteon::ALDB_PLM] (AUDIT) Delete orphan controller link from PLM to " + . $device->get_object_name() + . " because no SCENE_MEMBER entry could be found " + . "in items.mht for INSTEON_ICONTROLLER: " + . $link->get_object_name()); + + } + else + { + my %delete_req = (object => $self, group => $group, is_controller => 0, + callback => "$selfname->_aldb->_process_delete_queue(1)", + linkdevice => $device, data3 => $data3); + push @{$$self{delete_queue}}, \%delete_req; + } + } + } # if $is_invalid + } # else + } + } + } + + $$self{delete_queue_processed} = 0; # reset the counter + + # iterate over all registered objects and compare whether the link tables match defined scene linkages in known Insteon_Links + for my $obj (&Insteon::find_members('Insteon::BaseDevice')) + { + #Match on real objects only + if (($obj->is_root)) + { + my %delete_req = ('root_object' => $obj, 'audit_mode' => $audit_mode); + push @{$$self{delete_queue}}, \%delete_req; + } + } + + $self->_process_delete_queue(); +} + +sub _process_delete_queue { + my ($self, $p_num_deleted) = @_; + $$self{delete_queue_processed} += $p_num_deleted if $p_num_deleted; + my $num_in_queue = @{$$self{delete_queue}}; + if ($num_in_queue) + { + my $delete_req_ptr = shift(@{$$self{delete_queue}}); + my %delete_req = %$delete_req_ptr; + # distinguish between deleting PLM links and processing delete orphans for a root item + if ($delete_req{'root_object'}) + { + $delete_req{'root_object'}->delete_orphan_links($delete_req{'audit_mode'}); + } + else + { + if ($delete_req{linkdevice} eq $self) + { + &::print_log("[Insteon::ALDB_PLM] now deleting orphaned link w/ details: " + . (($delete_req{is_controller}) ? "controller" : "responder") + . ", " . (($delete_req{object}) ? "object=" . $delete_req{object}->get_object_name + : "deviceid=$delete_req{deviceid}") . ", group=$delete_req{group}") + if $main::Debug{insteon}; + $self->delete_link(%delete_req); + } + elsif ($delete_req{linkdevice}) + { + $delete_req{linkdevice}->delete_link(%delete_req); + } + } + } + else + { + &::print_log("[Insteon::ALDB_PLM] A total of $$self{delete_queue_processed} orphaned link records were deleted."); + &::print_log("[Insteon::ALDB_PLM] #### END DELETE ORPHAN LINKS ####"); + } + +} + +sub delete_link +{ + # linkkey is concat of: deviceid, group, is_controller + my ($self, $parms_text) = @_; + my %link_parms; + if (@_ > 2) + { + shift @_; + %link_parms = @_; + } + else + { + %link_parms = &main::parse_func_parms($parms_text); + } + my $num_deleted = 0; + my $insteon_object = $link_parms{object}; + my $deviceid = ($insteon_object) ? $insteon_object->device_id : $link_parms{deviceid}; + my $group = $link_parms{group}; + my $is_controller = ($link_parms{is_controller}) ? 1 : 0; + my $linkkey = lc $deviceid . $group . (($is_controller) ? '1' : '0'); + if (defined $$self{aldb}{$linkkey}) + { + my $cmd = '80' + . $$self{aldb}{$linkkey}{flags} + . $$self{aldb}{$linkkey}{group} + . $$self{aldb}{$linkkey}{deviceid} + . $$self{aldb}{$linkkey}{data1} + . $$self{aldb}{$linkkey}{data2} + . $$self{aldb}{$linkkey}{data3}; + delete $$self{aldb}{$linkkey}; + $num_deleted = 1; + my $message = new Insteon::InsteonMessage('all_link_manage_rec', $$self{device}); + if ($link_parms{callback}) + { + $$self{_success_callback} = $link_parms{callback}; + $message->callback($link_parms{callback}); + } + $message->interface_data($cmd); + $$self{device}->queue_message($message); + } + else + { + &::print_log("[Insteon::ALDB_PLM] no entry in linktable could be found for linkkey: $linkkey"); + if ($link_parms{callback}) + { + package main; + eval ($link_parms{callback}); + &::print_log("[Insteon_PLM] error in add link callback: " . $@) + if $@ and $main::Debug{insteon}; + package Insteon_PLM; + } + } + return $num_deleted; +} + +sub add_link +{ + my ($self, $parms_text) = @_; + my %link_parms; + if (@_ > 2) + { + shift @_; + %link_parms = @_; + } + else + { + %link_parms = &main::parse_func_parms($parms_text); + } + my $device_id; + my $group = ($link_parms{group}) ? $link_parms{group} : '01'; + my $insteon_object = $link_parms{object}; + if (!(defined($insteon_object))) + { + $device_id = lc $link_parms{deviceid}; + $insteon_object = &Insteon::get_object($device_id, $group); + } + else + { + $device_id = lc $insteon_object->device_id; + } + my $is_controller = ($link_parms{is_controller}) ? 1 : 0; + # first, confirm that the link does not already exist + my $linkkey = lc $device_id . $group . $is_controller; + if (defined $$self{aldb}{$linkkey}) + { + &::print_log("[Insteon::ALDB_PLM] WARN: attempt to add link to PLM that already exists! " + . "deviceid=" . $device_id . ", group=$group, is_controller=$is_controller"); + if ($link_parms{callback}) + { + package main; + eval ($link_parms{callback}); + &::print_log("[Insteon::ALDB_PLM] error in add link callback: " . $@) + if $@ and $main::Debug{insteon}; + package Insteon_PLM; + } + } + else + { + my $control_code = ($is_controller) ? '40' : '41'; + # flags should be 'a2' for responder and 'e2' for controller + my $flags = ($is_controller) ? 'E2' : 'A2'; + my $data1 = (defined $link_parms{data1}) ? $link_parms{data1} : (($is_controller) ? '01' : '00'); + my $data2 = (defined $link_parms{data2}) ? $link_parms{data2} : '00'; + my $data3 = (defined $link_parms{data3}) ? $link_parms{data3} : '00'; + # from looking at manually linked records, data1 and data2 are both 00 for responder records + # and, data1 is 01 and usually data2 is 00 for controller records + + my $cmd = $control_code + . $flags + . $group + . $device_id + . $data1 + . $data2 + . $data3; + $$self{aldb}{$linkkey}{flags} = lc $flags; + $$self{aldb}{$linkkey}{group} = lc $group; + $$self{aldb}{$linkkey}{is_controller} = $is_controller; + $$self{aldb}{$linkkey}{deviceid} = lc $device_id; + $$self{aldb}{$linkkey}{data1} = lc $data1; + $$self{aldb}{$linkkey}{data2} = lc $data2; + $$self{aldb}{$linkkey}{data3} = lc $data3; + my $message = new Insteon::InsteonMessage('all_link_manage_rec', $$self{device}); + $message->interface_data($cmd); + if ($link_parms{callback}) + { + $$self{_success_callback} = $link_parms{callback}; + $message->callback($link_parms{callback}); + } + $message->interface_data($cmd); + $$self{device}->queue_message($message); + } +} + +sub has_link +{ + my ($self, $insteon_object, $group, $is_controller, $subaddress) = @_; + # note, subaddress is IGNORED!! + my $key = lc $insteon_object->device_id . $group . $is_controller; + return (defined $$self{aldb}{$key}) ? 1 : 0; +} + + + + +1; \ No newline at end of file diff --git a/lib/Insteon/BaseInsteon.pm b/lib/Insteon/BaseInsteon.pm new file mode 100755 index 000000000..ae2db4270 --- /dev/null +++ b/lib/Insteon/BaseInsteon.pm @@ -0,0 +1,1857 @@ +=begin comment +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ + +File: + BaseInsteon.pm + +Description: + Generic class implementation of an Insteon Device. + +Author(s): + Gregg Liming / gregg@limings.net + +License: + This free software is licensed under the terms of the GNU public license. + +Usage: + + $ip_patio_light = new Insteon_Device($myPLM,"33.44.55"); + + $ip_patio_light->set("ON"); + +Special Thanks to: + Brian Warren for significant testing and patches + Bruce Winter - MH + +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +=cut + +package Insteon::BaseObject; + +use strict; +use Insteon; +use Insteon::AllLinkDatabase; +use Insteon::Message; + +@Insteon::BaseObject::ISA = ('Generic_Item'); + +our %message_types = ( + on => 0x11, + off => 0x13 +); + +our %nack_messages = ( + fb => 'illegal_value_in_cmd', + fc => 'pre_nak_long_db_search', + fd => 'bad_checksum_or_unknown_cmd', + fe => 'load_sense_detects_no_load', + ff => 'sender_id_not_in_responder_aldb', +); + +sub derive_link_state +{ + my ($p_state) = @_; + + my $link_state = 'on'; + if ($p_state eq 'off') + { + $link_state = 'off'; + } + elsif ($p_state =~ /\d+%?/) + { + my ($dim_state) = $p_state =~ /(\d+)%?/; + $link_state = 'off' if $dim_state == 0; + } + + return $link_state; +} + +sub new +{ + my ($class,$p_deviceid,$p_interface) = @_; + my $self={}; + bless $self,$class; + + $$self{message_types} = \%message_types; + + if (defined $p_deviceid) { + my ($deviceid, $group) = $p_deviceid =~ /(\w\w\.\w\w\.\w\w):?(.+)?/; + # if a group is passed in, then assume it can be a controller + $$self{is_controller} = ($group) ? 1 : 0; + $self->device_id($deviceid); + $group = '01' unless $group; + $group = '0' . $group if length($group) == 1; + $self->group(uc $group); + } + + if ($p_interface) { + $self->interface($p_interface); + } else { + $self->interface(&Insteon::active_interface()); + } + + $self->restore_data('level','default_hop_count'); + + $self->initialize(); + $$self{level} = undef; + $$self{flag} = "0F"; + $$self{ackMode} = "1"; + $$self{awaiting_ack} = 0; + $$self{is_acknowledged} = 0; + $$self{max_queue_time} = $::config_parms{'Insteon_PLM_max_queue_time'}; + $$self{max_queue_time} = 10 unless $$self{max_queue_time}; # 10 seconds is max time allowed in command stack + @{$$self{command_stack}} = (); + $$self{_onlevel} = undef; + $$self{is_responder} = 1; + $$self{default_hop_count} = 1; + + &Insteon::add($self); + return $self; +} + +sub initialize +{ + my ($self) = @_; + $$self{m_write} = 1; + $$self{m_is_locally_set} = 0; + # persist local, simple attribs + + # do we really need to ping the devices anymore for a devcat? + $$self{ping_timer} = new Timer(); + $$self{ping_timerTime} = 300; +# $$self{ping_timer}->set($$self{ping_timerTime} + (rand() * $$self{ping_timerTime}), $self) +# unless $self->group eq '01' and defined $self->devcat; +} + +sub interface +{ + my ($self,$p_interface) = @_; + if (defined $p_interface) { + $$self{interface} = $p_interface; + } + elsif (!($$self{interface})) + { + $$self{interface} = &Insteon::active_interface; + } + return $$self{interface}; +} + +sub device_id +{ + my ($self,$p_device_id) = @_; + + if (defined $p_device_id) + { + $p_device_id =~ /(\w\w)\W?(\w\w)\W?(\w\w)/; + $$self{device_id}=$1 . $2 . $3; + } + return $$self{device_id}; +} + +sub group +{ + my ($self, $p_group) = @_; + $$self{m_group} = $p_group if $p_group; + return $$self{m_group}; +} + +sub default_hop_count +{ + my ($self, $hop_count) = @_; + $$self{default_hop_count} = $hop_count if $hop_count; + return $$self{default_hop_count}; +} + +sub equals +{ + my ($self, $compare_object) = @_; + # make sure that the compare_object is legitimate + return 0 unless $compare_object && ref $compare_object && $compare_object->isa('Insteon::BaseObject'); + return 1 if $compare_object eq $self; + # self and compare_object need to have device_ids and groups to be equal + return 0 unless $self->device_id && $self->group && $compare_object->device_id && $compare_object->group; + return 1 if (($compare_object->device_id eq $self->device_id) + && ($compare_object->group eq $self->group)); + # default to false; + return 0; +} + +sub set +{ + my ($self,$p_state,$p_setby,$p_response) = @_; + return if &main::check_for_tied_filters($self, $p_state); + + # Override any set_with_timer requests + if ($$self{set_timer}) { + &Timer::unset($$self{set_timer}); + delete $$self{set_timer}; + } + + # did the queue timer go off? + if (ref $p_setby and $p_setby eq $$self{ping_timer}) { + if (! (defined($$self{devcat}))) { + $self->ping(); + # set the timer again in case nothing occurs + $$self{ping_timer}->set($$self{ping_timerTime} + (rand() * $$self{ping_timerTime}), $self); + } + } elsif ($self->_is_valid_state($p_state)) { + # always reset the is_locally_set property unless set_by is the device + $$self{m_is_locally_set} = 0 unless ref $p_setby and $p_setby eq $self; + + # handle invalid state for non-dimmable devices + if (($p_state eq 'dim' or $p_state eq 'bright') and !($self->isa('Insteon::DimmableLight'))) { + $p_state = 'on'; + } + elsif ($p_state eq 'toggle') + { + if ($self->state eq 'on') + { + $p_state = 'off'; + } + elsif ($self->state eq 'off') + { + $p_state = 'on'; + } + } + + my $setby_name = $p_setby; + $setby_name = $p_setby->get_object_name() if (ref $p_setby and $p_setby->can('get_object_name')); + if (ref $p_setby and (($p_setby eq $self->interface()) + or (($p_setby->isa('Insteon::BaseObject')) + and (($p_setby eq $self) + or (&main::set_by_to_target($p_setby) eq $self->interface))))) + { + # don't reset the object w/ the same state if set from the interface + return if (lc $p_state eq lc $self->state) and $self->is_acknowledged + and not(($p_setby->isa('Insteon::BaseObject') and ($p_setby eq $self))); + &::print_log("[Insteon::BaseObject] " . $self->get_object_name() + . "::set($p_state, $setby_name)") if $main::Debug{insteon}; + $self->set_receive($p_state,$p_setby,$p_response) if defined $p_state; + } else { + my $message = $self->derive_message($p_state); + $self->_send_cmd($message); + +# $self->_send_cmd(command => $p_state, +# type => (($self->isa('Insteon::Insteon_Link') and !($self->is_root)) ? 'alllink' : 'standard')); + &::print_log("[Insteon::BaseObject] " . $self->get_object_name() . "::set($p_state, $setby_name)") + if $main::Debug{insteon}; + $self->is_acknowledged(0); + $$self{pending_state} = $p_state; + $$self{pending_setby} = $p_setby; + $$self{pending_response} = $p_response; + } + $self->level($p_state) if $self->isa("Insteon::BaseDevice"); # update the level value +# $self->SUPER::set($p_state,$p_setby,$p_response) if defined $p_state; + } else { + &::print_log("[Insteon::BaseObject] failed state validation with state=$p_state"); + } +} + +sub is_acknowledged +{ + my ($self, $p_ack) = @_; + if (defined $p_ack) + { + if ($p_ack) + { + $self->set_receive($$self{pending_state},$$self{pending_setby}, $$self{pending_response}) if defined $$self{pending_state}; + } + else + { + # if we are not acknowledged, then clear the awaiting acknowledgement flag + # we won't do the converse as it is set in _process_command_stack + $$self{awaiting_ack} = 0; + } + $$self{is_acknowledged} = $p_ack; + $$self{pending_state} = undef; + $$self{pending_setby} = undef; + $$self{pending_response} = undef; + } + return $$self{is_acknowledged}; +} + +sub set_receive +{ + my ($self, $p_state, $p_setby, $p_response) = @_; + $self->SUPER::set($p_state, $p_setby, $p_response); +} + +sub set_with_timer { + my ($self, $state, $time, $return_state, $additional_return_states) = @_; + return if &main::check_for_tied_filters($self, $state); + + $self->set($state) unless $state eq ''; + + return unless $time; + + my $state_change = ($state eq 'off') ? 'on' : 'off'; + $state_change = $return_state if defined $return_state; + $state_change = $self->{state} if $return_state and lc $return_state eq 'previous'; + + $state_change .= ';' . $additional_return_states if $additional_return_states; + + $$self{set_timer} = &Timer::new() unless $$self{set_timer}; + my $object_name = $self->{object_name}; + my $action = "$object_name->set('$state_change')"; + $$self{set_timer}->set($time, $action); +} + +sub _send_cmd +{ + my ($self, $message) = @_; +# $msg{type} = 'standard' unless $msg{type}; + +# my $message = $self->derive_message($msg{command},$msg{type},$msg{extra}); + + if ($message->command eq 'peek' + or $message->command eq 'poke' + or $message->command eq 'status_request' + or $message->command eq 'do_read_ee' + or $message->command eq 'set_address_msb' + ) + { + push(@{$$self{command_stack}}, $message); + } + else + { + unshift(@{$$self{command_stack}},$message); + } + $self->_process_command_stack(); +} + +sub derive_message +{ + my ($self, $p_command, $p_extra) = @_; + my @args; + my $level; + + #msg id + my ($command, $subcommand) = split(/:/, $p_command, 2); + $command=lc($command); +# &::print_log("XLATE:$msg:$substate:$p_state:"); + + my $message; + + if ($self->isa("Insteon::BaseController")) + { + # only send out as all-link if the link originates from the plm + if ($self->isa("Insteon::InterfaceController")) + { # return the size of the command stack + $message = new Insteon::InsteonMessage('all_link_send', $self); + } + elsif ($self->is_root) + { # return the size of the command stack + $message = new Insteon::InsteonMessage('insteon_send', $self); + } else { + # silently ignore as this is now permitted if via "surrogate" + } + } elsif ($self->isa("Insteon::BaseObject")) { + $message = new Insteon::InsteonMessage('insteon_send', $self); + } + + if (!(defined $p_extra)) { + if ($command eq 'on') + { + if ($self->isa('Insteon::BaseDevice') && defined $self->local_onlevel) { + $level = 2.55 * $self->local_onlevel; + $command = 'on_fast'; + } else { + $level=255; + } + } elsif ($command eq 'off') + { + $level = 0; + } elsif ($command=~/^([1]?[0-9]?[0-9])/) + { + if ($1 < 1) { + $command='off'; + $level = 0; + } else { + $level = ($self->isa('Insteon::DimmableLight')) ? $1 * 2.55 : 255; + $command='on'; + } + } + } + + # confirm that the resulting $msg is legitimate + if (!(defined($self->message_type_code($command)))) { + &::print_log("[Insteon::BaseInsteon] invalid state=$command") if $main::Debug{insteon}; + return undef; + } + + if ($p_extra) + { $message->extra($p_extra); + + } elsif ($subcommand) { + $message->extra($subcommand); + } else { + if ($command eq 'on') + { + $message->extra(sprintf("%02X",$level)); + } else { + $message->extra('00'); + } + } + + $message->command($command); + return $message; +} + +sub message_type_code +{ + my ($self, $msg) = @_; + my $msg_type_ptr = $$self{message_types}; + my %msg_types = %$msg_type_ptr; + my $code = $msg_types{$msg}; + return $code; +} + +sub message_type +{ + my ($self, $cmd1) = @_; + my $msg_type; + my $msg_type_ptr = $$self{message_types}; + my %msg_types = %$msg_type_ptr; + for my $key (keys %msg_types){ + if (pack("C",$msg_types{$key}) eq pack("H*",$cmd1)) + { +# &::print_log("[Insteon::BaseObject] found: $key"); + $msg_type=$key; + last; + } + } + return $msg_type; +} + +sub _is_info_request +{ + my ($self, $cmd, $ack_setby, %msg) = @_; + my $is_info_request = ($cmd eq 'status_request') ? 1 : 0; +#print "cmd: $cmd; is_info_request: $is_info_request\n"; + if ($is_info_request) { + my $ack_on_level = (hex($msg{extra}) >= 254) ? 100 : sprintf("%d", hex($msg{extra}) * 100 / 255); + &::print_log("[Insteon::BaseObject] received status for " . + $self->{object_name} . " with on-level: $ack_on_level%, " + . "hops left: $msg{hopsleft}") if $main::Debug{insteon}; + $self->level($ack_on_level); # update the level value + if ($ack_on_level == 0) { + $self->SUPER::set('off', $ack_setby); + } elsif ($ack_on_level > 0 and !($self->isa('Insteon::DimmableLight'))) { + $self->SUPER::set('on', $ack_setby); + } else { + $self->SUPER::set($ack_on_level . '%', $ack_setby); + } + # if this were a scene controller, then also propogate the result to all members + } + elsif ( $cmd eq 'get_engine_version' ) { + my $version = $msg{extra}; + $version++; # version retuned in cmd2 is 0 indexed + if ( $version == 3 ) { + $version = 'I2CS'; + } + else { + $version = 'I'. sprintf( "%1d",$version); + } + &::print_log("[Insteon::BaseObject] received engine version for " + . $self->{object_name} . " of $version."); + } + + return $is_info_request; + +} + +sub _process_message +{ + my ($self,$p_setby,%msg) = @_; + my $p_state = undef; + + # the current approach assumes that links from other controllers to some responder + # would be seen by the plm by also direct linking the controller as a responder + # and not putting the plm into monitor mode. This means that updating the state + # of the responder based upon the link controller's request is handled + # by Insteon_Link. + $$self{m_is_locally_set} = 1 if $msg{source} eq lc $self->device_id; + if ($msg{is_ack}) { + my $pending_cmd = ($$self{_prior_msg}) ? $$self{_prior_msg}->command : $msg{command}; + if ($$self{awaiting_ack}) + { + my $ack_setby = (ref $$self{m_status_request_pending}) + ? $$self{m_status_request_pending} : $p_setby; + if ($self->_is_info_request($pending_cmd,$ack_setby,%msg)) + { + $self->is_acknowledged(1); + $$self{m_status_request_pending} = 0; + $self->_process_command_stack(%msg); + } + elsif (($pending_cmd eq 'peek') or ($pending_cmd eq 'set_address_msb')) + { + $self->_aldb->_on_peek(%msg) if $self->_aldb; + $self->_process_command_stack(%msg); + } + elsif (($pending_cmd eq 'poke') or ($pending_cmd eq 'set_address_msb')) + { + $self->_aldb->_on_poke(%msg) if $self->_aldb; + $self->_process_command_stack(%msg); + } + else + { + $self->is_acknowledged(1); + # signal receipt of message to the command stack in case commands are queued + $self->_process_command_stack(%msg); + &::print_log("[Insteon::BaseObject] received command/state (awaiting) acknowledge from " . $self->{object_name} + . ": $pending_cmd and data: $msg{extra}") if $main::Debug{insteon}; + } + } + else + { + # allow non-synchronous messages to also use the _is_info_request hook + $self->_is_info_request($pending_cmd,$p_setby,%msg); + $self->is_acknowledged(1); + # signal receipt of message to the command stack in case commands are queued + $self->_process_command_stack(%msg); + &::print_log("[Insteon::BaseObject] received command/state acknowledge from " . $self->{object_name} + . ": " . (($msg{command}) ? $msg{command} : "(unknown)") + . " and data: $msg{extra}") if $main::Debug{insteon}; + } + } + elsif ($msg{is_nack}) + { +# if ($$self{awaiting_ack}) +# { + # NOTE!!! NACKs are usually a sign of a burnt-out bulb!! +# &::print_log("[Insteon::BaseObject] WARN!! encountered a nack message for " . $self->{object_name} +# . " ... waiting for retry"); +# } +# else +# { + if ($self->isa('Insteon::BaseLight')) { + + &::print_log("[Insteon::BaseObject] WARN!! encountered a nack message (" + . $self->get_nack_msg_for( $msg{extra} ) + .") for " + . $self->{object_name} + . ". It may be unplugged or have a burned out bulb") if $main::Debug{insteon}; + } + else { + &::print_log("[Insteon::BaseObject] WARN!! encountered a nack message (" + . $self->get_nack_msg_for( $msg{extra} ) + .") for " + . $self->{object_name} + . " ... skipping"); + } + $self->is_acknowledged(0); + $self->_process_command_stack(%msg); +# } + } + elsif ($msg{command} eq 'start_manual_change') + { + # do nothing; although, maybe anticipate change? we should always get a stop + } elsif ($msg{command} eq 'stop_manual_change') { + # request status so that the final state can be known + $self->request_status($self); + } elsif ($msg{type} eq 'broadcast') { + $self->devcat($msg{devcat}); + &::print_log("[Insteon::BaseObject] device category: $msg{devcat} received for " . $self->{object_name}); + # stop ping timer now that we have a devcat; possibly may want to change this behavior to allow recurring pings + $$self{ping_timer}->stop(); + } else { + ## TO-DO: make sure that the state passed by command is something that is reasonable to set + $p_state = $msg{command}; + if ($msg{type} eq 'alllink') + { + $$self{_pending_cleanup} = 1; + } + elsif ($msg{type} eq 'cleanup') + { + $self->set($p_state, $self); # unless (lc($self->state) eq lc($p_state)) and + # ($msg{type} eq 'cleanup' and $$self{_pending_cleanup}); + $$self{_pending_cleanup} = 0; + } + } +} + +sub _process_command_stack +{ + my ($self, %ackmsg) = @_; + if (%ackmsg) { # which may also be something that can be interpretted as a "nack" + # determine whether to unset awaiting_ack + # for now, be "dumb" and just unset it + $$self{awaiting_ack} = 0; + } + if (!($$self{awaiting_ack})) { + my $callback = undef; + my $message = pop(@{$$self{command_stack}}); + # convert ptr to cmd hash + if ($message) + { + my $plm_queue_size = $self->interface->queue_message($message); + + # send msg + if ($message->command eq 'peek' + or $message->command eq 'poke' + or $message->command eq 'status_request' + or $message->command eq 'do_read_ee' + or $message->command eq 'set_address_msb' + ) + { + $$self{awaiting_ack} = 1; + } + else + { + $$self{awaiting_ack} = 0; + } + + $$self{_prior_msg} = $message; + # TO-DO: adjust timer based upon (1) type of message and (2) retry_count + my $queue_time = $$self{max_queue_time} + $plm_queue_size; + # if is_synchronous, then no other command can be sent until an insteon ack or nack is received + # for this command + } else { + # and, always clear awaiting_ack and _prior_msg + $$self{awaiting_ack} = 0; + $$self{_prior_msg} = undef; + } + if ($callback) { + package main; + eval ($callback); + &::print_log("[Insteon::BaseObject] error in queue timer callback: " . $@) + if $@ and $main::Debug{insteon}; + package Insteon::BaseObject; + } + } else { +# &::print_log("[Insteon_Device] " . $self->get_object_name . " command queued but not yet sent; awaiting ack from prior command") if $main::Debug{insteon}; + } +} + +sub _is_valid_state +{ + my ($self,$state) = @_; + if (!(defined($state)) or $state eq '') { + return 0; + } + + my ($msg, $substate) = split(/:/, $state, 2); + $msg=lc($msg); + + if ($msg=~/^([1]?[0-9]?[0-9])/) + { + if ($1 < 1) { + $msg='off'; + } else { + $msg='on'; + } + } + elsif ($msg eq 'toggle') + { + if ($self->state eq 'on') + { + $msg = 'off'; + } + elsif ($self->state eq 'off') + { + $msg = 'on'; + } + } + + # confirm that the resulting $msg is legitimate + if (!(defined($$self{message_types}{$msg}))) { + return 0; + } else { + return 1; + } +} + +# Provide human readable nack message. +sub get_nack_msg_for { + my ($self,$msg) = @_; + return $nack_messages{ $msg }; +} + +#################################### +### ##################### +### BaseObject ##################### +### ##################### +#################################### + +package Insteon::BaseDevice; + +use strict; +use Insteon; +use Insteon::AllLinkDatabase; + +@Insteon::BaseDevice::ISA = ('Insteon::BaseObject'); + +our %message_types = ( + %Insteon::BaseObject::message_types, + assign_to_group => 0x01, + delete_from_group => 0x02, + linking_mode => 0x09, + unlinking_mode => 0x0A, + get_engine_version => 0x0D, + ping => 0x10, + on_fast => 0x12, + off_fast => 0x14, + start_manual_change => 0x17, + stop_manual_change => 0x18, + status_request => 0x19, + get_operating_flags => 0x1f, + set_operating_flags => 0x20, + do_read_ee => 0x24, + remote_set_button_tap => 0x25, + set_led_status => 0x27, + set_address_msb => 0x28, + poke => 0x29, + poke_extended => 0x2a, + peek => 0x2b, + peek_internal => 0x2c, + poke_internal => 0x2d +); + + +my %operating_flags = ( + 'program_lock_on' => '00', + 'program_lock_off' => '01', + 'led_on_during_tx' => '02', + 'led_off_during_tx' => '03', + 'resume_dim_on' => '04', + 'beeper_enabled' => '04', + 'resume_dim_off' => '05', + 'beeper_off' => '05', + 'eight_key_kpl' => '06', + 'load_sense_on' => '06', + 'six_key_kpl' => '07', + 'load_sense_off' => '07', + 'led_backlight_off' => '08', + 'led_off' => '08', + 'led_backlight_on' => '09', + 'led_enabled' => '09', + 'key_beep_enabled' => '0a', + 'one_minute_warn_disabled' => '0a', + 'key_beep_off' => '0b', + 'one_minute_warn_enabled' => '0b' +); + + +sub new +{ + my ($class,$p_deviceid,$p_interface) = @_; + my $self= new Insteon::BaseObject($p_deviceid,$p_interface); + bless $self,$class; + + $$self{message_types} = \%message_types; + + if ($self->group eq '01') { + $$self{aldb} = new Insteon::ALDB_i1($self); + } + + $self->restore_data('level'); + + $self->initialize(); + $self->rate(undef); + $$self{level} = undef; + $$self{flag} = "0F"; + $$self{ackMode} = "1"; + $$self{awaiting_ack} = 0; + $$self{is_acknowledged} = 0; + $$self{max_queue_time} = $::config_parms{'Insteon_PLM_max_queue_time'}; + $$self{max_queue_time} = 10 unless $$self{max_queue_time}; # 10 seconds is max time allowed in command stack + @{$$self{command_stack}} = (); + $$self{_onlevel} = undef; + $$self{is_responder} = 1; + + return $self; +} + +sub initialize +{ + my ($self) = @_; + $$self{m_write} = 1; + $$self{m_is_locally_set} = 0; + # persist local, simple attribs + + # do we really need to ping the devices anymore for a devcat? + $$self{ping_timer} = new Timer(); + $$self{ping_timerTime} = 300; +} + +sub rate +{ + my ($self,$p_rate) = @_; + $$self{rate} = $p_rate if defined $p_rate; + return $$self{rate}; +} + +sub set_receive +{ + my ($self, $p_state, $p_setby, $p_response) = @_; + $self->level($p_state) if $self->can('level'); # update the level value + $self->SUPER::set_receive($p_state, $p_setby, $p_response); +} + +sub is_controller +{ + my ($self) = @_; + return $$self{is_controller}; +} + +sub is_responder +{ + my ($self,$is_responder) = @_; + $$self{is_responder} = $is_responder if defined $is_responder; + if ($self->is_root) { + return $$self{is_responder}; + } + else + { + my $root_obj = $self->get_root(); + if (ref $root_obj) + { + return $$root_obj{is_responder}; + } + else + { + return 0; + } + } +} + +sub link_to_interface +{ + my ($self,$p_group, $p_data3) = @_; + my $group = $p_group; + $group = '01' unless $group; + # add a link first to this device back to interface + # and, add a reference to creating a link from interface back to device via hook + my $callback_instance = $self->interface->get_object_name; + my $callback_info = "deviceid=" . lc $self->device_id . " group=$group is_controller=0"; + my %link_info = ( object => $self->interface, group => $group, is_controller => 1, + on_level => '100%', ramp_rate => '0.1s', + callback => "$callback_instance->add_link('$callback_info')"); + $link_info{data3} = $p_data3 if $p_data3; + if ($self->_aldb) { + $self->_aldb->add_link(%link_info); + } + else + { + &main::print_log("[BaseInsteon] This item " . $self->get_object_name . + " does not have an ALDB object. Linking is not permitted."); + } +} + +sub unlink_to_interface +{ + my ($self,$p_group) = @_; + my $group = $p_group; + $group = '01' unless $group; + my $callback_instance = $self->interface->get_object_name; + my $callback_info = "deviceid=" . lc $self->device_id . " group=$group is_controller=0"; + if ($self->_aldb) { + $self->_aldb->delete_link(object => $self->interface, group => $group, is_controller => 1, + callback => "$callback_instance->delete_link('$callback_info')"); + } + else + { + &main::print_log("[BaseInsteon] This item " . $self->get_object_name . + " does not have an ALDB object. Unlinking is not permitted."); + } +} + + +sub _aldb +{ + my ($self) = @_; + my $root_obj = $self->get_root(); + return $$root_obj{aldb}; +} + + +sub set_operating_flag { + my ($self, $flag) = @_; + + if (!(exists($operating_flags{$flag}))) + { + &::print_log("[Insteon::BaseDevice] $flag is not a support operating flag"); + return; + } + + if ($self->is_root and !($self->isa('Insteon::InterfaceController'))) + { + # TO-DO: check devcat to determine if the action is supported by the device + my $message = new Insteon::InsteonMessage('insteon_send', $self, 'set_operating_flags'); + $message->extra($operating_flags{$flag}); + $self->_send_cmd($message); +# $self->_send_cmd('command' => 'set_operating_flags', 'extra' => $operating_flags{$flag}); + } + else + { + &::print_log("[Insteon::BaseDevice] " . $self->get_object_name . " is either not a root device or is a plm controlled scene"); + return; + } +} + +sub get_operating_flag { + my ($self) = @_; + + if ($self->is_root and !($self->isa('Insteon::InterfaceController'))) + { + # TO-DO: check devcat to determine if the action is supported by the device + my $message = new Insteon::InsteonMessage('insteon_send', $self, 'get_operating_flags'); + $self->_send_cmd($message); +# $self->_send_cmd('command' => 'get_operating_flags'); + } + else + { + &::print_log("[Insteon::BaseDevice] " . $self->get_object_name . " is either not a root device or is a plm controlled scene"); + return; + } +} + +sub writable { + my ($self, $p_write) = @_; + if (defined $p_write) + { + if ($p_write =~ /r/i or $p_write =~/^0/) + { + $$self{m_write} = 0; + } + else + { + $$self{m_write} = 1; + } + } + return $$self{m_write}; +} + +sub is_locally_set { + my ($self) = @_; + return $$self{m_is_locally_set}; +} + + +sub is_root { + my ($self) = @_; + return (($self->group eq '01') and !($self->isa('Insteon::InterfaceController'))) ? 1 : 0; +} + +sub get_root { + my ($self) = @_; + if ($self->is_root) + { + return $self; + } + else + { + return &Insteon::get_object($self->device_id, '01'); + } +} + +sub has_link +{ + my ($self, $insteon_object, $group, $is_controller, $subaddress) = @_; + my $aldb = $self->get_root()->_aldb; + if ($aldb) + { + return $aldb->has_link($insteon_object, $group, $is_controller, $subaddress); + } + else + { + return 0; + } + +} + +sub add_link +{ + my ($self, $parms_text) = @_; + my $aldb = $self->get_root()->_aldb; + if ($aldb) + { + my %link_parms; + if (@_ > 2) + { + shift @_; + %link_parms = @_; + } + else + { + %link_parms = &main::parse_func_parms($parms_text); + } + $aldb->add_link(%link_parms); + } + +} + +sub update_link +{ + my ($self, $parms_text) = @_; + my $aldb = $self->get_root()->_aldb; + if ($aldb) + { + my %link_parms; + if (@_ > 2) + { + shift @_; + %link_parms = @_; + } + else + { + %link_parms = &main::parse_func_parms($parms_text); + } + $aldb->update_link(%link_parms); + } +} + +sub delete_link +{ + my ($self, $parms_text) = @_; + my $aldb = $self->get_root()->_aldb; + if ($aldb) + { + my %link_parms; + if (@_ > 2) + { + shift @_; + %link_parms = @_; + } + else + { + %link_parms = &main::parse_func_parms($parms_text); + } + $aldb->delete_link(%link_parms); + } +} + +sub scan_link_table +{ + my ($self, $success_callback, $failure_callback) = @_; + my $aldb = $self->get_root()->_aldb; + if ($aldb) + { + return $aldb->scan_link_table($success_callback, $failure_callback); + } + +} + +### WARN: Testing using the following does not produce results as expected. Use at your own risk. [GL] +sub remote_set_button_tap +{ + my ($self,$p_number_taps) = @_; + my $taps = ($p_number_taps =~ /2/) ? '02' : '01'; + my $message = new Insteon::InsteonMessage('insteon_send', $self, 'remote_set_button_tap'); + $message->extra($taps); + $self->_send_cmd($message); +# $self->_send_cmd('command' => 'remote_set_button_tap', 'extra' => $taps); +} + +sub request_status +{ + my ($self, $requestor) = @_; + $$self{m_status_request_pending} = ($requestor) ? $requestor : 1; + my $message = new Insteon::InsteonMessage('insteon_send', $self, 'status_request'); + $self->_send_cmd($message); +# $self->_send_cmd('command' => 'status_request', 'is_synchronous' => 1); +} + +sub get_engine_version { + my ($self, $requestor) = @_; + + my $message = new Insteon::InsteonMessage('insteon_send', $self, 'get_engine_version'); + $self->_send_cmd($message); +} + +sub ping +{ + my ($self) = @_; + my $message = new Insteon::InsteonMessage('insteon_send', $self, 'ping'); + $self->_send_cmd($message); +# $self->_send_cmd('command' => 'ping'); +} + +sub set_led_status +{ + my ($self, $status_mask) = @_; + my $message = new Insteon::InsteonMessage('insteon_send', $self, 'set_led_status'); + $message->extra($status_mask); + $self->_send_cmd($message); +# $self->_send_cmd('command' => 'set_led_status', 'extra' => $status_mask); +} + +sub restore_string +{ + my ($self) = @_; + my $restore_string = $self->SUPER::restore_string(); + if ($self->_aldb) + { + $restore_string .= $self->_aldb->restore_string(); + } + if ($$self{states}) + { + my $states = ''; + foreach my $state (@{$$self{states}}) + { + $states .= '|' if $states; + $states .= $state; + } + $restore_string .= $self->{object_name} . "->restore_states(q~$states~);\n"; + } + + return $restore_string; +} + +sub restore_states +{ + my ($self, $states) = @_; + if ($states) + { + @{$$self{states}} = split(/\|/,$states); + } +} + +sub restore_aldb +{ + my ($self,$aldb) = @_; + if ($self->_aldb and $aldb) + { + $self->_aldb->restore_aldb($aldb); + } +} + +sub devcat +{ + my ($self, $devcat) = @_; + if ($devcat) + { + $$self{devcat} = $devcat; + if (($$self{devcat} =~ /^01\w\w/) or ($$self{devcat} =~ /^02\w\w/) && !($self->states)) + { + $self->states( 'on,off' ); + } + } + return $$self{devcat}; +} + +sub states +{ + my ($self, $states) = @_; + if ($states) + { + @{$$self{states}} = split(/,/,$states); + } + if ($$self{states}) + { + return @{$$self{states}}; + } else { + return undef; + } + +} + + +sub local_onlevel +{ + my ($self, $p_onlevel) = @_; + if (defined $p_onlevel) + { + my ($onlevel) = $p_onlevel =~ /(\d+)%?/; + $$self{_onlevel} = $onlevel; + } + return $$self{_onlevel}; +} + +sub local_ramprate +{ + my ($self, $p_ramprate) = @_; + if (defined $p_ramprate) { + $$self{_ramprate} = &Insteon::DimmableLight::convert_ramp($p_ramprate); + } + return $$self{_ramprate}; + +} + +sub delete_orphan_links +{ + my ($self, $audit_mode) = @_; + return $self->_aldb->delete_orphan_links($audit_mode) if $self->_aldb; +} + +sub _process_delete_queue { + my ($self) = @_; + $self->_aldb->_process_delete_queue() if $self->_aldb; +} + +sub log_alllink_table +{ + my ($self) = @_; + $self->_aldb->log_alllink_table if $self->_aldb; +} + +sub update_local_properties +{ + my ($self) = @_; + if ($self->isa('Insteon::DimmableLight')) + { + $self->_aldb->update_local_properties() if $self->_aldb; + } + else + { + &::print_log("[Insteon::BaseDevice] update_local_properties may only be applied to dimmable devices!"); + } +} + +sub update_flags +{ + my ($self, $flags) = @_; + if (!($self->isa('Insteon::KeyPadLinc') or $self->isa('Insteon::KeyPadLincRelay'))) + { + &::print_log("[Insteon::BaseDevice] Operating flags may only be revised on keypadlincs!"); + return; + } + return unless defined $flags; + + $self->_aldb->update_flags($flags) if $self->_aldb; +} + + +#################################### +### ################# +### BaseController ################# +### ################# +#################################### + +package Insteon::BaseController; + +use strict; +use Insteon; + +@Insteon::BaseController::ISA = ('Generic_Item'); + +sub new +{ + my ($class,$p_deviceid,$p_interface,$p_devcat) = @_; + + # note that $p_deviceid will be 00.00.00: if the link uses the interface as the controller + my $self = {}; + bless $self,$class; +# don't apply ping timer to this class +# $$self{ping_timer}->stop(); + return $self; +} + +sub add +{ + my ($self, $obj, $on_level, $ramp_rate) = @_; + if (ref $obj and ($obj->isa('Light_Item') or $obj->isa('Insteon::BaseDevice'))) + { + if ($$self{members} && $$self{members}{$obj}) + { + print "[Insteon::BaseController] An object (" . $obj->{object_name} . ") already exists " + . "in this scene. Aborting add request.\n"; + return; + } + if ($on_level =~ /^sur/i) + { + $on_level = '100%'; + $$obj{surrogate} = $self; + } + elsif (lc $on_level eq 'on') + { + $on_level = '100%'; + } + elsif (lc $on_level eq 'off') + { + $on_level = '0%'; + } + $on_level = '100%' unless $on_level; + $$self{members}{$obj}{on_level} = $on_level; + $$self{members}{$obj}{object} = $obj; + $ramp_rate =~ s/s$//i; + $$self{members}{$obj}{ramp_rate} = $ramp_rate if defined $ramp_rate; + } else { + &::print_log("[Insteon::BaseController] WARN: unable to add $obj as items of this type are not supported!"); + } +} + +sub sync_links +{ + my ($self, $audit_mode, $callback, $failure_callback) = @_; + @{$$self{sync_queue}} = (); # reset the work queue + $$self{sync_queue_callback} = ($callback) ? $callback : undef; + my $insteon_object = $self->interface; + if (!($self->isa('Insteon::InterfaceController'))) + { + $insteon_object = &Insteon::get_object($self->device_id,'01'); + if (!(defined($insteon_object))) + { + &main::print_log("[Insteon::BaseController] WARN!! A device w/ insteon address: " . $self->device_id . ":01 could not be found. " + . "Please double check your items.mht file."); + } + } + my $self_link_name = $self->get_object_name; + # abort if $insteon_object doesn't exist + $self->_process_sync_queue() unless $insteon_object; + if ($$self{members}) + { + foreach my $member_ref (keys %{$$self{members}}) + { + my $member = $$self{members}{$member_ref}{object}; + # find real device if member is a Light_Item + if ($member->isa('Light_Item')) + { + my @children = $member->find_members('Insteon::BaseDevice'); + $member = $children[0]; + } + my $linkmember = $member; + # find real device if member's group is not '01'; for example, cross-linked KeypadLincs + if ($member->group ne '01') + { + $member = &Insteon::get_object($member->device_id,'01'); + } + my $tgt_on_level = $$self{members}{$member_ref}{on_level}; + $tgt_on_level = '100%' unless defined $tgt_on_level; + + my $tgt_ramp_rate = $$self{members}{$member_ref}{ramp_rate}; + $tgt_ramp_rate = '0' unless defined $tgt_ramp_rate; + # first, check existance for each link; if found, then perform an update (unless link is to PLM) + # if not, then add the link + if ($member->has_link($insteon_object, $self->group, 0, $linkmember->group)) + { + # TO-DO: only update link if the on_level and ramp_rate are different + my $requires_update = 0; + $tgt_on_level =~ s/(\d+)%?/$1/; + $tgt_ramp_rate =~ s/(\d)s?/$1/; + my $aldbkey = lc $insteon_object->device_id . $self->group . '0'; + if (($member->isa('Insteon::KeyPadLincRelay') or $member->isa('Insteon::KeyPadLinc')) + and $linkmember->group ne '01') { + $aldbkey .= $linkmember->group; + } + if (!($member->isa('Insteon::DimmableLight'))) + { + my $member_aldb = $member->_aldb; + if ($tgt_on_level >= 1 and $$member_aldb{aldb}{$aldbkey}{data1} ne 'ff') + { + $requires_update = 1; + $tgt_on_level = 100; + } + elsif ($tgt_on_level == 0 and $$member_aldb{aldb}{$aldbkey}{data1} ne '00') + { + $requires_update = 1; + } + if ($$member_aldb{aldb}{$aldbkey}{data2} ne '00') + { + $tgt_ramp_rate = 0; + } + } + else + { + my $member_aldb = $member->_aldb; + $tgt_ramp_rate = 0.1 unless $tgt_ramp_rate; + my $link_on_level = hex($$member_aldb{aldb}{$aldbkey}{data1})/2.55; + my $raw_ramp_rate = $$member_aldb{aldb}{$aldbkey}{data2}; + my $raw_tgt_ramp_rate = &Insteon::DimmableLight::convert_ramp($tgt_ramp_rate); + if (($raw_ramp_rate != $raw_tgt_ramp_rate) && ($raw_ramp_rate ne '00' and $raw_tgt_ramp_rate ne '1f')) + { + $requires_update = 1; + &::print_log("[Insteon::BaseController] DEBUG: flagging " . $self->get_object_name + . " for update because existing ramp rate ($raw_ramp_rate) != target ($raw_tgt_ramp_rate)") + if $main::Debug{insteon}; + + } + elsif (($link_on_level > $tgt_on_level + 1) or ($link_on_level < $tgt_on_level -1)) + { + $requires_update = 1; + &::print_log("[Insteon::BaseController] DEBUG: flagging " . $self->get_object_name + . " for update because existing on level ($link_on_level) != target ($tgt_on_level)") + if $main::Debug{insteon}; + } + } + if ($requires_update) + { + if ($audit_mode) + { + &::print_log("[Insteon::BaseController] (AUDIT) - updating responder record to " + . $member->get_object_name . " for " + . $insteon_object->get_object_name . " with group:" . $self->group + . "; on_level:$tgt_on_level; ramp_rate:$tgt_ramp_rate"); + } + else + { + my %link_req = ( member => $member, cmd => 'update', object => $insteon_object, + group => $self->group, is_controller => 0, + on_level => $tgt_on_level, ramp_rate => $tgt_ramp_rate, + callback => "$self_link_name->_process_sync_queue()" ); + # set data3 is device is a KeypadLinc + if ($member->isa('Insteon::KeyPadLincRelay') or $member->isa('Insteon::KeyPadLinc')) + { + $link_req{data3} = $linkmember->group; + } + push @{$$self{sync_queue}}, \%link_req; + } + } + } + else + { + if ($audit_mode) + { + &::print_log("[Insteon::BaseController] (AUDIT) - adding responder record to " + . $member->get_object_name . " for " + . $insteon_object->get_object_name . " with group:" . $self->group + . "; on_level:$tgt_on_level; ramp_rate:$tgt_ramp_rate"); + } + else + { + my %link_req = ( member => $member, cmd => 'add', object => $insteon_object, + group => $self->group, is_controller => 0, + on_level => $tgt_on_level, ramp_rate => $tgt_ramp_rate, + callback => "$self_link_name->_process_sync_queue()" ); + # set data3 is device is a KeypadLinc + if ($member->isa('Insteon::KeyPadLincRelay') or $member->isa('Insteon::KeyPadLinc')) + { + $link_req{data3} = $linkmember->group; + } + push @{$$self{sync_queue}}, \%link_req; + } + } + if (!($insteon_object->has_link($member, $self->group, 1, $linkmember->group))) + { + if ($audit_mode) + { + &::print_log("[Insteon::BaseController] (AUDIT) - adding controller record to " + . $insteon_object->get_object_name . " for " . $member->get_object_name + . " with group:" . $self->group); + } + else + { + my %link_req = ( member => $insteon_object, cmd => 'add', object => $member, + group => $self->group, is_controller => 1, + callback => "$self_link_name->_process_sync_queue()" ); + # set data3 is device is a KeypadLinc + if ($member->isa('Insteon::KeyPadLincRelay') or $member->isa('Insteon::KeyPadLinc')) + { + $link_req{data3} = $linkmember->group; + } + push @{$$self{sync_queue}}, \%link_req; + } + } + } + } + # if not a plm controlled link, then confirm that a link back to the plm exists + if (!($self->isa('Insteon::InterfaceController'))) + { + my $subaddress = ($self->isa('Insteon::KeyPadLincRelay') or $self->isa('Insteon::KeyPadLinc')) ? $self->group : '00'; + if (!($insteon_object->has_link($self->interface,$self->group,1,$subaddress))) + { + if ($audit_mode) + { + &::print_log("[Insteon::BaseController] (AUDIT) - adding controller record to " + . $insteon_object->get_object_name . " for " + . $self->interface->get_object_name . " with group:" . $self->group); + } + else + { + my %link_req = ( member => $insteon_object, cmd => 'add', object => $self->interface, + group => $self->group, is_controller => 1, + callback => "$self_link_name->_process_sync_queue()" ); + $link_req{data3} = $self->group if $insteon_object->isa('Insteon::KeyPadLincRelay') or $insteon_object->isa('Insteon::KeyPadLinc'); + push @{$$self{sync_queue}}, \%link_req; + } + } + if (!($self->interface->has_link($insteon_object,$self->group,0,$subaddress))) + { + if ($audit_mode) + { + &::print_log("[Insteon::BaseController] (AUDIT) - adding responder record to " + . $self->interface->get_object_name . " for " + . $insteon_object->get_object_name . " with group:" . $self->group); + } + else + { + my %link_req = ( member => $self->interface, cmd => 'add', object => $insteon_object, + group => $self->group, is_controller => 0, + callback => "$self_link_name->_process_sync_queue()" ); + push @{$$self{sync_queue}}, \%link_req; + } + } + } + my $num_sync_queue = @{$$self{sync_queue}}; + if (!($num_sync_queue)) + { + &::print_log("[Insteon::BaseController] Nothing to do when syncing links for " . $self->get_object_name) + if $main::Debug{insteon}; + } + $self->_process_sync_queue(); + + # TO-DO: consult links table to determine if any "orphaned links" refer to this device; if so, then delete + # WARN: can't immediately do this as the link tables aren't finalized on the above operations + # until the end of the actual insteon memory poke sequences; therefore, may need to handle separately +} + +sub _process_sync_queue { + my ($self) = @_; + # get next in queue if it exists + my $num_sync_queue = @{$$self{sync_queue}}; + if ($num_sync_queue) { + my $link_req_ptr = shift(@{$$self{sync_queue}}); + my %link_req = %$link_req_ptr; + if ($link_req{cmd} eq 'update') { + my $link_member = $link_req{member}; + $link_member->update_link(%link_req); + } elsif ($link_req{cmd} eq 'add') { + my $link_member = $link_req{member}; + $link_member->add_link(%link_req); + } + } elsif ($$self{sync_queue_callback}) { + package main; + eval ($$self{sync_queue_callback}); + &::print_log("[Insteon::BaseController] error in sync links callback: " . $@) + if $@ and $main::Debug{insteon}; + $$self{sync_queue_callback} = undef; + package Insteon::Insteon_link; + } +} + +sub set +{ + my ($self, $p_state, $p_setby, $p_respond) = @_; + # prevent reciprocal setby loops + return -1 if (ref $p_setby and ($p_setby ne $self) and $p_setby->can('get_set_by') and + $p_setby->{set_by} eq $self); + return -1 if &main::check_for_tied_filters($self, $p_state); + + # prevent setby internal Insteon_Device timers + return -1 if $p_setby eq $$self{ping_timer}; + + my $link_state = &Insteon::BaseObject::derive_link_state($p_state); + + $self->set_linked_devices($link_state); + + return 0; +} + +sub set_linked_devices +{ + my ($self, $link_state) = @_; + # iterate over the members + if ($$self{members}) + { + foreach my $member_ref (keys %{$$self{members}}) + { + my $member = $$self{members}{$member_ref}{object}; + my $on_state = $$self{members}{$member_ref}{on_level}; + $on_state = '100%' unless $on_state; + my $local_state = $on_state; + $local_state = 'on' if $local_state eq '100%' + && $member->isa('Insteon::BaseDevice') && !($member->is_root); + $local_state = 'off' if $local_state eq '0%' or $link_state eq 'off'; + if ($member->isa('Light_Item')) + { + # if they are Light_Items, then set their on_dim attrib to the member on level + # and then "blank" them via the manual method for a tad over the ramp rate + # In addition, locate the Light_Item's Insteon_Device member and do the + # same as if the member were an Insteon_Device + my $ramp_rate = $$self{members}{$member_ref}{ramp_rate}; + $ramp_rate = 0 unless defined $ramp_rate; + $ramp_rate = $ramp_rate + 2; + my @lights = $member->find_members('Insteon::BaseDevice'); + if (@lights) + { + my $light = @lights[0]; + # remember the current state to support resume + $$self{members}{$member_ref}{resume_state} = $light->state; + $member->manual($light, $ramp_rate); + $light->set_receive($local_state,$self); + } + else + { + $member->manual(1, $ramp_rate); + } + $member->set_on_state($local_state) unless $link_state eq 'off'; + } + elsif ($member->isa('Insteon::BaseDevice')) + { + # remember the current state to support resume + $$self{members}{$member_ref}{resume_state} = $member->state; + # if they are Insteon_Device objects, then simply set_receive their state to + # the member on level + if (!($member->isa('Insteon::DimmableLight')) and $member->isa('Insteon::BaseLight')) + { + $local_state = &Insteon::BaseObject::derive_link_state($local_state); + } + $member->set_receive($local_state,$self); + } + } + } + + +} + +sub set_with_timer { + my ($self, $state, $time, $return_state, $additional_return_states) = @_; + return if &main::check_for_tied_filters($self, $state); + + $self->set($state) unless $state eq ''; + + return unless $time; + + my $state_change = ($state eq 'off') ? 'on' : 'off'; + $state_change = $return_state if defined $return_state; + $state_change = $self->{state} if $return_state and lc $return_state eq 'previous'; + + $state_change .= ';' . $additional_return_states if $additional_return_states; + + $$self{set_timer} = &Timer::new() unless $$self{set_timer}; + my $object_name = $self->{object_name}; + my $action = "$object_name->set('$state_change')"; + $$self{set_timer}->set($time, $action); +} + + +sub update_members +{ + my ($self) = @_; + # iterate over the members + if ($$self{members}) { + foreach my $member_ref (keys %{$$self{members}}) { + my ($device); + my $member = $$self{members}{$member_ref}{object}; + my $on_state = $$self{members}{$member_ref}{on_level}; + $on_state = '100%' unless $on_state; + my $ramp_rate = $$self{members}{$member_ref}{ramp_rate}; + $ramp_rate = 0 unless defined $ramp_rate; + if ($member->isa('Light_Item')) { + # if they are Light_Items, then locate the Light_Item's Insteon_Device member + my @lights = $member->find_members('Insteon::BaseDevice'); + if (@lights) { + $device = @lights[0]; + } + } elsif ($member->isa('Insteon::BaseDevice')) { + $device = $member; + } + if ($device) { + my %current_record = $device->get_link_record($self->device_id . $self->group); + if (%current_record) { + &::print_log("[Insteon::BaseController] remote record: $current_record{data1}") + if $::Debug{insteon}; + } + } + } + } +} + + +sub initiate_linking_as_controller +{ + my ($self, $p_group) = @_; + # iterate over the members + if ($$self{members}) { + foreach my $member_ref (keys %{$$self{members}}) { + my $member = $$self{members}{$member_ref}{object}; + if ($member->isa('Light_Item')) { + # if they are Light_Items, then set them to manual to avoid automation + # while manually setting light parameters + $member->manual(1,120,120); # 120 seconds should be enough + } + } + } + $self->interface()->initiate_linking_as_controller($p_group); +} + +sub derive_message +{ + my ($self, $p_state, $p_extra) = @_; + if ($self->is_root) { + return $self->Insteon::BaseObject::derive_message($p_state, $p_extra); + } else { + return $self->Insteon::BaseObject::derive_message($p_state, $p_extra); + } +} + +sub find_members +{ + my ($self,$p_type) = @_; + + my @l_found; + if ($$self{members}) + { + foreach my $member_ref (keys %{$$self{members}}) + { + my $member = $$self{members}{$member_ref}{object}; + if ($member->isa($p_type)) + { + push @l_found, $member; + } + } + } + return @l_found; + +} + +sub has_member +{ + my ($self, $compare_object) = @_; + foreach my $member_ref (keys %{$$self{members}}) + { + my $member = $$self{members}{$member_ref}{object}; + if ($member eq $compare_object) + { + return 1; + } + } + return 0; +} + +#################################### +### ##################### +### DeviceController ############### +### ############### +#################################### + + +package Insteon::DeviceController; + +use strict; +use Insteon; + +@Insteon::DeviceController::ISA = ('Insteon::BaseController'); + +sub new +{ + my ($class,$p_deviceid,$p_interface,$p_devcat) = @_; + + # note that $p_deviceid will be 00.00.00: if the link uses the interface as the controller + my $self = new Insteon::BaseController($p_deviceid,$p_interface); + bless $self,$class; + return $self; +} + +sub set +{ + my ($self, $p_state, $p_setby, $p_respond) = @_; + + my $rslt_code = $self->Insteon::BaseController::set($p_state, $p_setby, $p_respond); + return $rslt_code if $rslt_code; + + my $link_state = &Insteon::BaseObject::derive_link_state($p_state); + + $self->Insteon::BaseObject::set((($self->is_root) ? $p_state : $link_state), $p_setby, $p_respond); + + return 0; +} + + +sub request_status +{ + my ($self,$requestor) = @_; +# if ($self->group ne '01') { + if ($$self{members} and !($self->isa('Insteon::InterfaceController')) + and (!(ref $requestor) or ($requestor eq $self))) { + &::print_log("[Insteon::DeviceController] requesting status for members of " . $$self{object_name}); + foreach my $member (keys %{$$self{members}}) { + next unless $member->isa('Insteon::BaseObject'); + my $member_obj = $$self{members}{$member}{object}; + next if $requestor eq $member_obj; + if ($member_obj->isa('Insteon::BaseDevice')) { + &::print_log("[Insteon::DeviceController] checking status of " . $member_obj->get_object_name() + . " for requestor " . $requestor->get_object_name()); + $member_obj->request_status($self); + } + } + } + # the following has bad assumptions in that we don't always know if a device is a responder + # since it could be a slave + if ($self->is_root && $self->is_responder) { + $self->Insteon::BaseDevice::request_status($requestor); + } +} + +sub link_to_interface +{ + my ($self, $p_group, $p_data3) = @_; + my $group = $p_group; + $group = $self->group unless $group; + # get the surrogate device for this if group is not '01' + if ($self->group ne '01') { + my $surrogate_obj = &Insteon::get_object($self->device_id,'01'); + if ($p_data3) { + $surrogate_obj->link_to_interface($group,$p_data3); + } elsif ($surrogate_obj->isa('Insteon::KeyPadLincRelay') or $surrogate_obj->isa('Insteon::KeyPadLinc')) { + $surrogate_obj->link_to_interface($group,$self->group); + } else { + $surrogate_obj->link_to_interface($group); + } + # next, if the link is a keypadlinc, then create the reverse link to permit + # control over the button's light + if ($surrogate_obj->isa('Insteon::KeyPadLincRelay') or $surrogate_obj->isa('Insteon::KeyPadLinc')) { + + } + } else { + if ($p_data3) { + $self->SUPER::link_to_interface($group, $p_data3); + } else { + $self->SUPER::link_to_interface($group); + } + } +} + +sub unlink_to_interface +{ + my ($self,$p_group) = @_; + my $group = $p_group; + $group = $self->group unless $group; + # get the surrogate device for this if group is not '01' + if ($self->group ne '01') { + my $surrogate_obj = &Insteon::get_object($self->device_id,'01'); + $surrogate_obj->unlink_to_interface($group); + # next, if the link is a keypadlinc, then delete the reverse link to permit + # control over the button's light + if ($surrogate_obj->isa('Insteon::KeyPadLincRelay') or $surrogate_obj->isa('Insteon::KeyPadLinc')) { + + } + } else { + $self->SUPER::unlink_to_interface($group); + } +} + + + +#################################### +### ############ +### InterfaceController ############ +### ############ +#################################### + + +package Insteon::InterfaceController; + +use strict; +use Insteon; + +@Insteon::InterfaceController::ISA = ('Insteon::BaseController','Insteon::BaseObject'); + +sub new +{ + my ($class,$p_deviceid,$p_interface) = @_; + + # note that $p_deviceid will be 00.00.00: if the link uses the interface as the controller + my $self = new Insteon::BaseObject($p_deviceid,$p_interface); + bless $self,$class; + return $self; +} + +sub set +{ + my ($self, $p_state, $p_setby, $p_respond) = @_; + + my $rslt_code = $self->Insteon::BaseController::set($p_state, $p_setby, $p_respond); + return $rslt_code if $rslt_code; + + $self->Insteon::BaseObject::set($p_state, $p_setby, $p_respond); + + return 0; +} + +sub is_root +{ + return 0; +} + +1; diff --git a/lib/Insteon/BaseInterface.pm b/lib/Insteon/BaseInterface.pm new file mode 100755 index 000000000..01b324a6d --- /dev/null +++ b/lib/Insteon/BaseInterface.pm @@ -0,0 +1,515 @@ + +package Insteon::BaseInterface; + +use strict; +use Insteon::Message; +@Insteon::BaseInterface::ISA = ('Class::Singleton'); + +sub check_for_data +{ + my $interface = &Insteon::active_interface(); + $interface->check_for_data(); +} + +sub poll_all +{ + my $scan_at_startup = $main::config_parms{Insteon_PLM_scan_at_startup}; + $scan_at_startup = 1 unless defined $scan_at_startup; + $scan_at_startup = 0 unless $main::Save{mh_exit} eq 'normal'; + my $plm = &Insteon::active_interface(); + if (defined $plm) + { + if (!($plm->device_id) and !($$plm{_id_check})) + { + $$plm{_id_check} = 1; + $plm->queue_message(new Insteon::InsteonMessage('plm_info', $plm)); + } + if ($scan_at_startup) + { + + for my $insteon_device (&Insteon::find_members('Insteon::BaseDevice')) + { + if ($insteon_device and $insteon_device->is_root and $insteon_device->is_responder) + { + # don't request status for objects associated w/ other than the primary group + # as they are psuedo links + $insteon_device->request_status(); + } + if ($insteon_device->devcat) { + # reset devcat so as to trigger any device specific properties + $insteon_device->devcat($insteon_device->devcat); + } + } + } + } +} + +sub new +{ + my ($class) = @_; + + my $self = {}; + @{$$self{command_stack2}} = (); + @{$$self{command_history}} = (); + bless $self, $class; + $self->transmit_in_progress(0); +# $self->debug(0) unless $self->debug; + return $self; +} + +sub equals +{ + my ($self, $compare_object) = @_; + # make sure that the compare_object is legitimate + return 0 unless $compare_object && ref $compare_object && $compare_object->isa('Insteon::BaseInterface'); + return 1 if $compare_object eq $self; + # if they don't both have device_ids then treat them as identical + return 1 unless $compare_object->device_id && $self->device_id; + if ($compare_object->device_id eq $self->device_id) + { + return 1; + } + else + { + return 0; + } +} + +sub _is_duplicate +{ + my ($self, $cmd) = @_; + return 1 if ($self->active_message && $self->active_message->interface_data eq $cmd); + my $duplicate_detected = 0; + # check for duplicates of $cmd already in command_stack and ignore if they exist + foreach my $message (@{$$self{command_stack2}}) + { + if ($message->interface_data eq $cmd) + { + $duplicate_detected = 1; + last; + } + } + return $duplicate_detected; +} + +sub has_link +{ + my ($self, $insteon_object, $group, $is_controller, $subaddress) = @_; + if ($self->_aldb) + { + return $self->_aldb->has_link($insteon_object, $group, $is_controller, $subaddress); + } + return 0; +} + +sub add_link +{ + my ($self, $parms_text) = @_; + if ($self->_aldb) + { + my %link_parms; + if (@_ > 2) + { + shift @_; + %link_parms = @_; + } + else + { + %link_parms = &main::parse_func_parms($parms_text); + } + $self->_aldb->add_link(%link_parms); + } +} + +sub delete_link +{ + my ($self, $parms_text) = @_; + if ($self->_aldb) + { + my %link_parms; + if (@_ > 2) + { + shift @_; + %link_parms = @_; + } + else + { + %link_parms = &main::parse_func_parms($parms_text); + } + $self->_aldb->delete_link(%link_parms); + } +} + +sub active_message +{ + my ($self, $message) = @_; + if (defined $message) + { + $$self{active_message} = $message; + } + return $$self{active_message}; +} + +sub clear_active_message +{ + my ($self) = @_; + $$self{active_message} = undef; + $self->transmit_in_progress(0); +} + +sub retry_active_message +{ + my ($self) = @_; + $self->transmit_in_progress(0); +} + +sub transmit_in_progress +{ + my ($self, $xmit_flag) = @_; + if (defined $xmit_flag) + { + $$self{xmit_in_progress} = $xmit_flag; + } + # also factor in xmit timer since this must be honored to allow + # adequate time to elapse + return $$self{xmit_in_progress} || ($self->_check_timeout('xmit')==0); +} + +sub queue_message +{ + my ($self, $message) = @_; + + my $command_queue_size = @{$$self{command_stack2}}; + return $command_queue_size unless $message; + + #queue any new command + if (defined $message) + { + my $setby = $message->setby; + if ($self->_is_duplicate($message->interface_data) && !($message->isa('Insteon::X10Message'))) + { + &main::print_log("[Insteon::BaseInterface] Attempt to queue command already in queue; skipping ...") if $main::Debug{insteon}; + } + else + { + my $queue_size = @{$$self{command_stack2}}; +# &main::print_log("[Insteon_PLM] Command stack size: $queue_size") if $queue_size > 0 and $main::Debug{insteon}; + if ($setby and ref($setby) and $setby->can('set_retry_timeout') + and $setby->get_object_name) + { + $message->callback($setby->get_object_name . "->set_retry_timeout()"); + } + unshift(@{$$self{command_stack2}}, $message); + } + } + # and, begin processing either this entry or the oldest one in the queue + $self->process_queue(); +} + +sub process_queue +{ + my ($self) = @_; + + my $command_queue_size = @{$$self{command_stack2}}; + + if ($self->transmit_in_progress) + { + return $command_queue_size; + } + else + #we dont transmit on top of another xmit + { # no transmission is progress that has not already been acked or nacked by the PLM + # get pending command record + my $pending_message = $self->active_message; + + if (!($pending_message)) + { # no prior message remains; so, get one from the queue + $pending_message = pop(@{$$self{command_stack2}}); + $self->active_message($pending_message) if $pending_message; + } + + if ($pending_message) + { # a message exists to be sent (whether previously sent or queued) + + if ($self->active_message->send($self) == 0) + { # this only occurs if the retry count has been exceeded + # which also means that there wasn't a message actually sent + &::print_log("[Insteon::BaseInterface] WARN: number of retries (" + . $self->active_message->send_attempts + . ") for " . $self->active_message->to_string() + . " exceeds limit. Now moving on...") if $main::Debug{insteon}; + # !!!!!!!!! TO-DO - handle failure timeout ??? + my $failed_message = $self->active_message; + # make sure to let the sending object know!!! + if (defined($failed_message->setby) and $failed_message->setby->can('is_acknowledged')) + { + $failed_message->setby->is_acknowledged(0); + } + else + { + &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: Now calling callback: " . + $failed_message->failure_callback) if $main::Debug{insteon}; + package main; + eval $failed_message->failure_callback; + &::print_log("[Insteon::BaseInterface] problem w/ retry callback: $@") if $@; + package Insteon::BaseInterface; + } + + $self->process_queue(); + } + } + else # no pending message + { + # clear the timer + $self->_clear_timeout('command'); + return 0; + } + } + my $command_queue_size = @{$$self{command_stack2}}; + return $command_queue_size; +} + +sub device_id { + my ($self, $p_deviceid) = @_; + $$self{deviceid} = $p_deviceid if defined $p_deviceid; + return $$self{deviceid}; +} + +sub restore_string +{ + my ($self) = @_; + my $restore_string = $self->SUPER::restore_string(); + $restore_string .= $self->_aldb->restore_string(); + return $restore_string; +} + +sub restore_linktable +{ + my ($self,$aldb) = @_; + if ($self->_aldb and $aldb) { + $self->_aldb->restore_linktable($aldb); + } +} + + +sub log_alllink_table +{ + my ($self) = @_; + $self->_aldb->log_alllink_table if $self->_aldb; +} + +sub delete_orphan_links +{ + my ($self, $audit_mode) = @_; + return $self->_aldb->delete_orphan_links($audit_mode) if $self->_aldb; +} + + ###################### + ### EVENT HANDLERS ### +###################### + +sub on_interface_info_received +{ + my ($self) = @_; + &::print_log("[Insteon_PLM] PLM id: " . $self->device_id . + " firmware: " . $self->firmware) + if $main::Debug{insteon}; + $self->clear_active_message(); +} + + +sub on_standard_insteon_received +{ + my ($self, $message_data) = @_; + my %msg = &Insteon::InsteonMessage::command_to_hash($message_data); + if (%msg) + { + # get the matching object + my $object = &Insteon::get_object($msg{source}, $msg{group}); + if (defined $object) + { + if ($msg{type} ne 'broadcast') + { + $msg{command} = $object->message_type($msg{cmd_code}); + &::print_log("[Insteon::BaseInterface] command:$msg{command}; type:$msg{type}; group: $msg{group}") + if (!($msg{is_ack} or $msg{is_nack})) and $main::Debug{insteon}; + } + if ($msg{is_ack} or $msg{is_nack}) + { + # need to confirm that this message corresponds to the current active one before clearing it + # TO-DO!!! This is a brute force and poor compare technique; needs to be replaced by full compare + if ($self->active_message && ref $self->active_message->setby) + { + if ($self->active_message->send_attempts == 0) + { + &main::print_log("[Insteon::BaseInterface] WARN: received ACK/NACK message for " + . $object->get_object_name . " but cannot correlate to sent message " + . "(active but send attempts = 0). IGNORING received message!!"); + } + elsif ($msg{type} eq 'direct') + { + if (lc $self->active_message->setby->device_id eq lc $msg{source}) + { + # prevent re-processing transmit queue until after clearing occurs + $self->transmit_in_progress(1); + # ask the object to process the received message and update its state + $object->_process_message($self, %msg); + $self->clear_active_message(); + } + else + { + &main::print_log("[Insteon::BaseInterface] WARN: deviceid of " + . "active message != received message source (" + . $object->get_object_name() . "). IGNORING received message!!"); + } + } + elsif ($msg{type} eq 'cleanup') + { + $object = &Insteon::get_object('000000', $msg{extra}); + if ($object) + { + my %cleanup_msg = ('type' => 'cleanup', + 'group' => $msg{extra}, + 'is_ack' => 1, + 'command' => 'cleanup' + ); + # prevent re-processing transmit queue until after clearing occurs + $self->transmit_in_progress(1); + # ask the object to process the received message and update its state + $object->_process_message($self, %cleanup_msg); + $self->clear_active_message(); + } + else + { + &main::print_log("[Insteon::BaseInterface] ERROR: received cleanup message " + . "that does not correspond to a valid PLM group. Corrupted message is assumed " + . "and will be skipped!"); + } + } + else + { + &main::print_log("[Insteon::BaseInterface] ERROR: received ACK/NACK message from " + . $object->get_object_name . " but unable to process $msg{type} message type." + . " IGNORING received message!!"); + } + } + else + { + if ($msg{type} eq 'direct') + { + &main::print_log("[Insteon::BaseInterface] WARN: received insteon ACK/NACK message from " + . $object->get_object_name . " but cannot correlate to sent message! IGNORING received message!!"); + } + elsif ($msg{type} eq 'cleanup') + { + # this is just going to be ignored since there is a virtual processing done + # in the Insteon_PLM handler for cleanup messages. + # however, if the virtual handler was not invoked due to receipt of the broadcast message + # then, the above cleanup handler would be run + &main::print_log("[Insteon::BaseInterface] DEBUG3: received cleanup message responding to " + . "PLM controller group: $msg{extra}. Ignoring as this has already been processed") + if $main::Debug{insteon} >= 3; + } + else + { + # ask the object to process the received message and update its state + $object->_process_message($self, %msg); + } + } + } + else + { + # ask the object to process the received message and update its state + $object->_process_message($self, %msg); + } + } + else + { + &::print_log("[Insteon::BaseInterface] Warn! Unable to locate object for source: $msg{source} and group: $msg{group}"); + } + # treat the message as legitimate even if an object match did not occur + } +} + +sub on_extended_insteon_received +{ + my ($self, $message_data) = @_; + my %msg = &Insteon::InsteonMessage::command_to_hash($message_data); + if (%msg) + { + # get the matching object + my $object = &Insteon::get_object($msg{source}, $msg{group}); + if (defined $object) + { + if ($msg{type} ne 'broadcast') + { + $msg{command} = $object->message_type($msg{cmd_code}); + &::print_log("[Insteon::BaseInterface] command:$msg{command}; type:$msg{type}; group: $msg{group}") + if (!($msg{is_ack} or $msg{is_nack})) and $main::Debug{insteon}; + } + &::print_log("[Insteon::BaseInterface] Processing message for " . $object->get_object_name) if $main::Debug{insteon}; + $object->_process_message($self, %msg); + if ($msg{is_ack} or $msg{is_nack}) + { + $self->clear_active_message(); + } + } + else + { + &::print_log("[Insteon::BaseInterface] Warn! Unable to locate object for source: $msg{source} and group: $msg{group}"); + } + # treat the message as legitimate even if an object match did not occur + } + +} + + ################################# + ### INTERNAL METHODS/FUNCTION ### +################################# + +sub _set_timeout +{ + my ($self, $timeout_name, $timeout_in_millis) = @_; + my $tickcount = &main::get_tickcount + $timeout_in_millis; + $tickcount += 2**32 if $tickcount < 0; # force a wrap; to be handleded by check timeout + $$self{"_timeout_$timeout_name"} = $tickcount; +} + +# +# return -1 if timeout_name does not match an existing timer +# return 0 if timer has not expired +# return 1 if timer has expired +# +sub _check_timeout +{ + my ($self, $timeout_name) = @_; + return 0 unless $timeout_name; + return -1 unless defined $$self{"_timeout_$timeout_name"}; + my $current_tickcount = &main::get_tickcount; + return 0 if (($current_tickcount >= 2**16) and ($$self{"_timeout_$timeout_name"} < 2**16)); + return ($current_tickcount > $$self{"_timeout_$timeout_name"}) ? 1 : 0; +} + +sub _clear_timeout +{ + my ($self, $timeout_name) = @_; + $$self{"_timeout_$timeout_name"} = undef; +} + +sub _aldb +{ + my ($self) = @_; + return $$self{aldb}; +} + + +1 \ No newline at end of file diff --git a/lib/Insteon/Controller.pm b/lib/Insteon/Controller.pm new file mode 100755 index 000000000..45b77b9ad --- /dev/null +++ b/lib/Insteon/Controller.pm @@ -0,0 +1,57 @@ + +package Insteon::RemoteLinc; + +use strict; +use Insteon::BaseInsteon; + +@Insteon::RemoteLinc::ISA = ('Insteon::BaseDevice','Insteon::DeviceController'); + +my %message_types = ( + %Insteon::BaseDevice::message_types, + bright => 0x15, + dim => 0x16 +); + +sub new +{ + my ($class,$p_deviceid,$p_interface) = @_; + + my $self = new Insteon::BaseDevice($p_deviceid,$p_interface); + $$self{message_types} = \%message_types; + bless $self,$class; + return $self; +} + +sub set +{ + my ($self,$p_state,$p_setby,$p_response) = @_; + return if &main::check_for_tied_filters($self, $p_state); + + # Override any set_with_timer requests + if ($$self{set_timer}) { + &Timer::unset($$self{set_timer}); + delete $$self{set_timer}; + } + + # if it can't be controlled (i.e., a responder), then don't send out any signals + # motion sensors seem to get multiple fast reports; don't trigger on both + my $setby_name = $p_setby; + $setby_name = $p_setby->get_object_name() if (ref $p_setby and $p_setby->can('get_object_name')); + if (not defined($self->get_idle_time) or $self->get_idle_time > 1 or $self->state ne $p_state) { + &::print_log("[Insteon::RemoteLinc] " . $self->get_object_name() + . "::set_receive($p_state, $setby_name)") if $main::Debug{insteon}; + $self->set_receive($p_state,$p_setby); + } else { + &::print_log("[Insteon::RemoteLinc] " . $self->get_object_name() + . "::set_receive($p_state, $setby_name) deferred due to repeat within 1 second") + if $main::Debug{insteon}; + } + return; +} + +sub is_responder +{ + return 0; +} + +1 \ No newline at end of file diff --git a/lib/Insteon/Lighting.pm b/lib/Insteon/Lighting.pm new file mode 100755 index 000000000..931530349 --- /dev/null +++ b/lib/Insteon/Lighting.pm @@ -0,0 +1,356 @@ +package Insteon::BaseLight; + +use strict; +use Insteon::BaseInsteon; + +@Insteon::BaseLight::ISA = ('Insteon::BaseDevice'); + +sub new +{ + my ($class,$p_deviceid,$p_interface) = @_; + + my $self = new Insteon::BaseDevice($p_deviceid,$p_interface); + bless $self,$class; + # include very basic states + @{$$self{states}} = ('on','off'); + + return $self; +} + +sub level +{ + my ($self, $p_level) = @_; + if (defined $p_level) { + my $level = 100; + if ($p_level eq 'off') + { + $level = 0; + } + $$self{level} = $level; + } + return $$self{level}; + +} + +package Insteon::DimmableLight; + +use strict; +use Insteon::BaseInsteon; + +@Insteon::DimmableLight::ISA = ('Insteon::BaseLight'); + +my %message_types = ( + %SUPER::message_types, + bright => 0x15, + dim => 0x16 +); + +my %ramp_h2n = ( + '00' => 540, + '01' => 480, + '02' => 420, + '03' => 360, + '04' => 300, + '05' => 270, + '06' => 240, + '07' => 210, + '08' => 180, + '09' => 150, + '0a' => 120, + '0b' => 90, + '0c' => 60, + '0d' => 47, + '0e' => 43, + '0f' => 39, + '10' => 34, + '11' => 32, + '12' => 30, + '13' => 28, + '14' => 26, + '15' => 23.5, + '16' => 21.5, + '17' => 19, + '18' => 8.5, + '19' => 6.5, + '1a' => 4.5, + '1b' => 2, + '1c' => .5, + '1d' => .3, + '1e' => .2, + '1f' => .1 +); + +sub convert_ramp +{ + my ($ramp_in_seconds) = @_; + if ($ramp_in_seconds) { + foreach my $rampkey (sort keys %ramp_h2n) { + return $rampkey if $ramp_in_seconds >= $ramp_h2n{$rampkey}; + } + } else { + return '1f'; + } +} + +sub get_ramp_from_code +{ + my ($ramp_code) = @_; + if ($ramp_code) { + return $ramp_h2n{$ramp_code}; + } else { + return 0; + } +} + +sub convert_level +{ + my ($on_level) = @_; + my $level = 'ff'; + if (defined ($on_level)) { + if ($on_level eq '100') { + $level = 'ff'; + } elsif ($on_level eq '0') { + $level = '00'; + } else { + $level = sprintf('%02X',$on_level * 2.55); + } + } + return $level; +} + +sub new +{ + my ($class,$p_deviceid,$p_interface) = @_; + + my $self = new Insteon::BaseLight($p_deviceid,$p_interface); + bless $self,$class; + return $self; +} + +sub level +{ + my ($self, $p_level) = @_; + if (defined $p_level) { + my $level = undef; + if ($p_level eq 'on') + { + # set the level based on any locally defined on level + $level = $self->local_onlevel if $self->can('local_onlevel'); + # set to 100 if a local on level is not defined + $level=100 unless defined($level); + } elsif ($p_level eq 'off') + { + $level = 0; + } elsif ($p_level =~ /^([1]?[0-9]?[0-9])%?$/) + { + if ($1 < 1) { + $level = 0; + } else { + $level = $1; + } + } + $$self{level} = $level if defined $level; + } + return $$self{level}; + +} + + +package Insteon::ApplianceLinc; + +use strict; +use Insteon::BaseInsteon; + +@Insteon::ApplianceLinc::ISA = ('Insteon::BaseLight'); + +sub new +{ + my ($class,$p_deviceid,$p_interface) = @_; + + my $self = new Insteon::BaseLight($p_deviceid,$p_interface); + bless $self,$class; + return $self; +} + +sub set +{ + my ($self, $p_state, $p_setby, $p_respond) = @_; + + my $link_state = &Insteon::BaseObject::derive_link_state($p_state); + + return $self->Insteon::BaseDevice::set($link_state, $p_setby, $p_respond); +} + + +package Insteon::LampLinc; + +use strict; +use Insteon::BaseInsteon; + +@Insteon::LampLinc::ISA = ('Insteon::DimmableLight'); + + +sub new +{ + my ($class,$p_deviceid,$p_interface) = @_; + + my $self = new Insteon::DimmableLight($p_deviceid,$p_interface); + bless $self,$class; + return $self; +} + +package Insteon::SwitchLincRelay; + +use strict; +use Insteon::BaseInsteon; + +@Insteon::SwitchLincRelay::ISA = ('Insteon::BaseLight','Insteon::DeviceController'); + + +sub new +{ + my ($class,$p_deviceid,$p_interface) = @_; + + my $self = new Insteon::BaseLight($p_deviceid,$p_interface); + bless $self,$class; + return $self; +} + +sub set +{ + my ($self, $p_state, $p_setby, $p_respond) = @_; + + my $link_state = &Insteon::BaseObject::derive_link_state($p_state); + + return $self->Insteon::DeviceController::set($link_state, $p_setby, $p_respond); +} + +package Insteon::SwitchLinc; + +use strict; +use Insteon::BaseInsteon; + +@Insteon::SwitchLinc::ISA = ('Insteon::DimmableLight','Insteon::DeviceController'); + +sub new +{ + my ($class,$p_deviceid,$p_interface) = @_; + + my $self = new Insteon::DimmableLight($p_deviceid,$p_interface); + bless $self,$class; + return $self; +} + +sub set +{ + my ($self, $p_state, $p_setby, $p_respond) = @_; + + return $self->Insteon::DeviceController::set($p_state, $p_setby, $p_respond); +} + +package Insteon::KeyPadLincRelay; + +use strict; +use Insteon::BaseInsteon; + +@Insteon::KeyPadLincRelay::ISA = ('Insteon::BaseLight','Insteon::DeviceController'); + + +sub new +{ + my ($class,$p_deviceid,$p_interface) = @_; + + my $self = new Insteon::BaseLight($p_deviceid,$p_interface); + bless $self,$class; + return $self; +} + +sub set +{ + my ($self, $p_state, $p_setby, $p_respond) = @_; + + my $link_state = &Insteon::BaseObject::derive_link_state($p_state); + + if (!($self->is_root)) + { + my $rslt_code = $self->Insteon::BaseController::set($p_state, $p_setby, $p_respond); + return $rslt_code if $rslt_code; + + if (ref $p_setby and $p_setby->isa('Insteon::BaseDevice')) + { + $self->Insteon::BaseObject::set($p_state, $p_setby, $p_respond); + } + elsif (ref $$self{surrogate} && ($$self{surrogate}->isa('Insteon::InterfaceController'))) + { + $$self{surrogate}->set($link_state, $p_setby, $p_respond) + unless ref $p_setby and $p_setby eq $self; + } + else + { + &::print_log("[Insteon::KeyPadLinc] You may not directly attempt to set a keypadlinc's button " + . "unless you have defined a reverse link with the \"surrogate\" keyword"); + } + } + else + { + return $self->Insteon::DeviceController::set($link_state, $p_setby, $p_respond); + } + + return 0; + +} + + +package Insteon::KeyPadLinc; + +use strict; +use Insteon::BaseInsteon; + +@Insteon::KeyPadLinc::ISA = ('Insteon::DimmableLight','Insteon::DeviceController'); + + +sub new +{ + my ($class,$p_deviceid,$p_interface) = @_; + + my $self = new Insteon::DimmableLight($p_deviceid,$p_interface); + bless $self,$class; + return $self; +} + +sub set +{ + my ($self, $p_state, $p_setby, $p_respond) = @_; + + if (!($self->is_root)) + { + my $rslt_code = $self->Insteon::BaseController::set($p_state, $p_setby, $p_respond); + return $rslt_code if $rslt_code; + + my $link_state = &Insteon::BaseObject::derive_link_state($p_state); + + if (ref $p_setby and $p_setby->isa('Insteon::BaseDevice')) + { + $self->Insteon::BaseObject::set($p_state, $p_setby, $p_respond); + } + elsif (ref $$self{surrogate} && ($$self{surrogate}->isa('Insteon::InterfaceController'))) + { + $$self{surrogate}->set($link_state, $p_setby, $p_respond) + unless ref $p_setby and $p_setby eq $self; + } + else + { + &::print_log("[Insteon::KeyPadLinc] You may not directly attempt to set a keypadlinc's button " + . "unless you have defined a reverse link with the \"surrogate\" keyword"); + } + } + else + { + return $self->Insteon::DeviceController::set($p_state, $p_setby, $p_respond); + } + + return 0; + +} + +1 \ No newline at end of file diff --git a/lib/Insteon/Message.pm b/lib/Insteon/Message.pm new file mode 100755 index 000000000..3dedaa8df --- /dev/null +++ b/lib/Insteon/Message.pm @@ -0,0 +1,690 @@ + +package Insteon::BaseMessage; + +use strict; +use Insteon; + +sub new +{ + my ($class) = @_; + my $self={}; + bless $self,$class; + + $$self{queue_time} = &main::get_tickcount; + $$self{send_attempts} = 0; + + return $self; +} + +sub interface_data +{ + my ($self, $interface_data) = @_; + if ($interface_data) + { + $$self{interface_data} = $interface_data; + } + return $$self{interface_data}; +} + +sub queue_time +{ + my ($self, $queue_time) = @_; + if ($queue_time) + { + $$self{queue_time} = $queue_time; + } + return $$self{queue_time}; +} + +sub callback +{ + my ($self, $callback) = @_; + if ($callback) + { + $$self{callback} = $callback; + } + return $$self{callback}; +} + +sub failure_callback +{ + my ($self, $callback) = @_; + if ($callback) + { + $$self{failure_callback} = $callback; + } + return $$self{failure_callback}; +} + +sub send_attempts +{ + my ($self, $send_attempts) = @_; + if ($send_attempts) + { + $$self{send_attempts} = $send_attempts; + } + return $$self{send_attempts}; +} + +sub setby +{ + my ($self, $setby) = @_; + if ($setby) + { + $$self{setby} = $setby; + } + return $$self{setby}; +} + +sub respond +{ + my ($self, $respond) = @_; + if ($respond) + { + $$self{respond} = $respond; + } + return $$self{respond}; +} + +sub send +{ + my ($self, $interface) = @_; + if ($self->send_attempts < ($::config_parms{'Insteon_retry_count'} || 5)) + { + + if ($self->send_attempts > 0) + { + &::print_log("[Insteon::BaseMessage] WARN: now resending " + . $self->to_string() . " after " . $self->send_attempts + . " attempts.") if $main::Debug{insteon}; + # revise default hop count to reflect retries + if (ref $self->setby && $self->setby->isa('Insteon::BaseObject')) + { + if (($self->send_attempts > $self->setby->default_hop_count) + and ($self->send_attempts <= 3)) + { + &main::print_log("[Insteon::Message] Now setting default hop count for " + . $self->setby->get_object_name . " to " + . $self->send_attempts); + $self->setby->default_hop_count($self->send_attempts); + } + } + } + + # need to set timeout as a function of retries; also need to alter hop count + $self->send_attempts($self->send_attempts + 1); + $interface->_send_cmd($self, $self->send_timeout); + if ($self->callback) + { + package main; + eval $self->callback; + &::print_log("[Insteon::BaseMessage] problem w/ retry callback: $@") if $@; + package Insteon::Message; + } + return 1; + } + else + { + return 0; + } + +} + +sub seconds_delayed +{ + my ($self) = @_; + my $current_tickcount = &main::get_tickcount; + my $delay_time = $current_tickcount - $self->queue_time; + if ($self->queue_time > $current_tickcount) + { + return 'unknown'; + } + + $delay_time = $delay_time / 1000; + return $delay_time; +} + +sub send_timeout +{ + my ($self, $timeout) = @_; + $$self{send_timeout} = $timeout if defined $timeout; + return $$self{send_timeout}; +} + +sub to_string +{ + my ($self) = @_; + return $self->interface_data; +} + +package Insteon::InsteonMessage; +use strict; +use Insteon; + +@Insteon::InsteonMessage::ISA = ('Insteon::BaseMessage'); + +sub new +{ + my ($class, $command_type, $setby, $command, $extra) = @_; + my $self= new Insteon::BaseMessage(); + bless $self,$class; + + $self->command_type($command_type); + $self->setby($setby); + $self->command($command); + $self->extra($extra); + $self->send_timeout(2000); + + return $self; +} + +sub command_to_hash +{ + my ($p_state) = @_; + my %msg = (); + my $hopflag = hex(uc substr($p_state,13,1)); + $msg{hopsleft} = $hopflag >> 2; + my $msgflag = hex(uc substr($p_state,12,1)); + $msg{is_extended} = (0x01 & $msgflag) ? 1 : 0; + if ($msg{is_extended}) + { + $msg{source} = substr($p_state,0,6); + $msg{destination} = substr($p_state,6,6); + $msg{extra} = substr($p_state,16,16); + } + else + { + $msg{source} = substr($p_state,0,6); + $msgflag = $msgflag >> 1; + if ($msgflag == 4) + { + $msg{type} = 'broadcast'; + $msg{devcat} = substr($p_state,6,4); + $msg{firmware} = substr($p_state,10,2); + $msg{is_master} = substr($p_state,16,2); + $msg{dev_attribs} = substr($p_state,18,2); + } + elsif ($msgflag ==6) + { + $msg{type} = 'alllink'; + $msg{group} = substr($p_state,10,2); + } + else + { + $msg{destination} = substr($p_state,6,6); + if ($msgflag == 2) + { + $msg{type} = 'cleanup'; + $msg{group} = substr($p_state,16,2); + } + elsif ($msgflag == 3) + { + $msg{type} = 'cleanup'; + $msg{is_ack} = 1; + # the "extra" value will contain the controller's group ID + $msg{extra} = substr($p_state,16,2); + } + elsif ($msgflag == 7) + { + $msg{type} = 'cleanup'; + $msg{is_nack} = 1; + $msg{extra} = substr($p_state,16,2); + } + elsif ($msgflag == 0) + { + $msg{type} = 'direct'; + $msg{extra} = substr($p_state,16,2); + } + elsif ($msgflag == 1) + { + $msg{type} = 'direct'; + $msg{is_ack} = 1; + $msg{extra} = substr($p_state,16,2); + } + elsif ($msgflag == 5) + { + $msg{type} = 'direct'; + $msg{is_nack} = 1; + $msg{extra} = substr($p_state,16,2); + } + } + } + $msg{cmd_code} = substr($p_state,14,2); + + return %msg; +} + + +sub command +{ + my ($self, $command) = @_; + $$self{command} = $command if $command; + return $$self{command}; +} + +sub command_type +{ + my ($self, $command_type) = @_; + $$self{command_type} = $command_type if $command_type; + return $$self{command_type}; +} + +sub extra +{ + my ($self, $extra) = @_; + $$self{extra} = $extra if $extra; + return $$self{extra}; +} + +sub send_timeout +{ +# hop timing in seconds; this method returns timeout in millisconds +# hops standard extended +# ---- -------- -------- +# 0 1.40 2.22 +# 1 1.70 2.69 +# 2 1.90 3.01 +# 3 2.00 3.17 + + my ($self, $ignore) = @_; + my $hop_count = (ref $self->setby and $self->setby->isa('Insteon::BaseObject')) ? + $self->send_attempts + $self->setby->default_hop_count - 1 + : $self->send_attempts; + if ($self->command_type eq 'all_link_send') + { + # note, the following was set to 2000 and that was insufficient + return 3000; + } + elsif ($self->command_type eq 'insteon_ext_send') + { + if ($hop_count == 1) + { + return 2220; + } + elsif ($hop_count == 2) + { + return 2690; + } + elsif ($hop_count == 3) + { + return 3000; + } + elsif ($hop_count >= 4) + { + return 3170; + } + } + else + { + if ($hop_count == 1) + { + return 1400; + } + elsif ($hop_count == 2) + { + return 1700; + } + elsif ($hop_count == 3) + { + return 1900; + } + elsif ($hop_count >= 4) + { + return 2000; + } + } +} + +sub to_string +{ + my ($self) = @_; + my $result = ''; + if ($self->setby) + { + $result .= 'obj=' . $self->setby->get_object_name; + } + if ($result) + { + $result .= '; '; + } + if ($self->command) + { + $result .= 'command=' . $self->command; + } + else + { + $result .= 'interface_data=' . $self->interface_data; + } + if ($self->extra) + { + $result .= '; extra=' . $self->extra; + } + + return $result; +} + +sub interface_data +{ + my ($self, $interface_data) = @_; + my $result = $self->SUPER::interface_data($interface_data); + if (!($result) && + (($self->command_type eq 'insteon_send') + or ($self->command_type eq 'insteon_ext_send') + or ($self->command_type eq 'all_link_send'))) + { + return $self->_derive_interface_data(); + } + else + { + return $result; + } +} + +sub _derive_interface_data +{ + + my ($self) = @_; + my $cmd = ''; + my $level; + if ($self->command_type =~ /all_link_send/i) + { + $cmd.=$self->setby->group; + } + else + { + my $hop_count = $self->send_attempts + $self->setby->default_hop_count - 1; + $cmd.=$self->setby->device_id(); + if ($self->command_type =~ /insteon_ext_send/i) + { + if ($hop_count == 1) + { + $cmd.='15'; + } + elsif ($hop_count == 2) + { + $cmd.='1A'; + } + elsif ($hop_count >= 3) + { + $cmd.='1F'; + } + } + else + { + if ($hop_count == 1) + { + $cmd.='05'; + } + elsif ($hop_count == 2) + { + $cmd.='0A'; + } + elsif ($hop_count >= 3) + { + $cmd.='0F'; + } + } + } + $cmd.= unpack("H*",pack("C",$self->setby->message_type_code($self->command))); + if ($self->extra) + { + $cmd.= $self->extra; + } + elsif ($self->command_type eq 'insteon_send') + { # auto append '00' if no extra defined for a standard insteon send + $cmd .= '00'; + } + + return $cmd; + +} + +package Insteon::X10Message; +use strict; +use Insteon; + +@Insteon::X10Message::ISA = ('Insteon::BaseMessage'); + +my %x10_house_codes = ( + a => 0x6, + b => 0xE, + c => 0x2, + d => 0xA, + e => 0x1, + f => 0x9, + g => 0x5, + h => 0xD, + i => 0x7, + j => 0xF, + k => 0x3, + l => 0xB, + m => 0x0, + n => 0x8, + o => 0x4, + p => 0xC +); + +my %mh_house_codes = ( + '6' => 'a', + 'e' => 'b', + '2' => 'c', + 'a' => 'd', + '1' => 'e', + '9' => 'f', + '5' => 'g', + 'd' => 'h', + '7' => 'i', + 'f' => 'j', + '3' => 'k', + 'b' => 'l', + '0' => 'm', + '8' => 'n', + '4' => 'o', + 'c' => 'p' +); + +my %x10_unit_codes = ( + 1 => 0x6, + 2 => 0xE, + 3 => 0x2, + 4 => 0xA, + 5 => 0x1, + 6 => 0x9, + 7 => 0x5, + 8 => 0xD, + 9 => 0x7, + 10 => 0xF, + a => 0xF, + 11 => 0x3, + b => 0x3, + 12 => 0xB, + c => 0xB, + 13 => 0x0, + d => 0x0, + 14 => 0x8, + e => 0x8, + 15 => 0x4, + f => 0x4, + 16 => 0xC, + g => 0xC + +); + +my %mh_unit_codes = ( + '6' => '1', + 'e' => '2', + '2' => '3', + 'a' => '4', + '1' => '5', + '9' => '6', + '5' => '7', + 'd' => '8', + '7' => '9', + 'f' => 'a', + '3' => 'b', + 'b' => 'c', + '0' => 'd', + '8' => 'e', + '4' => 'f', + 'c' => 'g' +); + +my %x10_commands = ( + on => 0x2, + j => 0x2, + off => 0x3, + k => 0x3, + bright => 0x5, + l => 0x5, + dim => 0x4, + m => 0x4, + preset_dim1 => 0xA, + preset_dim2 => 0xB, + all_off => 0x0, + p => 0x0, + all_lights_on => 0x1, + o => 0x1, + all_lights_off => 0x6, + status => 0xF, + status_on => 0xD, + status_off => 0xE, + hail_ack => 0x9, + ext_code => 0x7, + ext_data => 0xC, + hail_request => 0x8 +); + +my %mh_commands = ( + '2' => 'J', + '3' => 'K', + '5' => 'L', + '4' => 'M', + 'a' => 'preset_dim1', + 'b' => 'preset_dim2', +# '0' => 'all_off', + '0' => 'P', +# '1' => 'all_lights_on', + '1' => 'O', + '6' => 'all_lights_off', + 'f' => 'status', + 'd' => 'status_on', + 'e' => 'status_off', + '9' => 'hail_ack', + '7' => 'ext_code', + 'c' => 'ext_data', + '8' => 'hail_request' +); + +sub new +{ + my ($class, $interface_data) = @_; + my $self= new Insteon::BaseMessage(); + bless $self,$class; + + $self->interface_data($interface_data); + $self->send_timeout(2000); + + return $self; +} + +sub get_formatted_data +{ + my ($self) = @_; + + my $data = $self->interface_data; + + my $msg=undef; + if (uc(substr($data,length($data)-2,2)) eq '00') + { + $msg = "X"; + $msg.= uc($mh_house_codes{substr($data,4,1)}); + $msg.= uc($mh_unit_codes{substr($data,5,1)}); + for (my $index =6; $index{id_by_state}{$cmd}); + + my $hc = lc(substr($p_setby->{x10_id},1,1)); + my $uc = lc(substr($p_setby->{x10_id},2,1)); + + if ($hc eq undef) { + &main::print_log("[Insteon::Message] Object:$p_setby Doesnt have an x10 id (yet)"); + return undef; + } + + if ($uc eq undef) { + &main::print_log("[Insteon::Message] Message is for entire HC") if $main::Debug{insteon}; + } + else { + + #Every X10 message starts with the House and unit code + $msg = substr(unpack("H*",pack("C",$x10_house_codes{substr($id,1,1)})),1,1); + $msg.= substr(unpack("H*",pack("C",$x10_unit_codes{substr($id,2,1)})),1,1); + $msg.= "00"; + &main::print_log("[Insteon_PLM] x10 sending code: " . uc($hc . $uc) . " as insteon msg: " + . $msg) if $main::Debug{insteon}; + + push @data, $msg; + } + + my $ecmd; + #Iterate through the rest of the pairs of nibbles + my $spos = 3; + if ($uc eq undef) {$spos=1;} +# &::print_log("PLM:PAIR:$id:$spos:$ecmd:"); + for (my $pos = $spos; $posget_object_name() if (ref $p_setby and $p_setby->can('get_object_name')); + if (not defined($self->get_idle_time) or $self->get_idle_time > 1 or $self->state ne $p_state) { + &::print_log("[Insteon::MotionSensor] " . $self->get_object_name() + . "::set_receive($p_state, $setby_name)") if $main::Debug{insteon}; + $self->set_receive($p_state,$p_setby); + } else { + &::print_log("[Insteon::MotionSensor] " . $self->get_object_name() + . "::set_receive($p_state, $setby_name) deferred due to repeat within 1 second") + if $main::Debug{insteon}; + } + return; +} + +sub is_responder +{ + return 0; +} + +1 \ No newline at end of file diff --git a/lib/Insteon/convert_insteon_config b/lib/Insteon/convert_insteon_config new file mode 100755 index 000000000..f551f6545 --- /dev/null +++ b/lib/Insteon/convert_insteon_config @@ -0,0 +1,54 @@ +#!/usr/bin/perl -w + +use strict; + +# Simple insteon.mht syntax converter by Marc MERLIN +# This is not even close to being foolproof but it may just work for you, or +# you can tweak the regexes a bit to make it work for you. +# If it breaks, you get to keep both pieces :) + +# Run: +# convert_insteon_config < old_items.mht > new_items.mht +# If you are upgrading from the old insteon code, you will also need +# to delete data/mh_temp.saved_states and mh_temp.saved_states.unused + +while (<>) +{ + # these work for all, but don't know what insteon device to set + s#IPLL,\s*PLM:(\d+),\s*#INSTEON_ICONTROLLER, $1, #i; + s#IPLL,#INSTEON_SWITCHLINC|SWITCHLINCRELAY|KEYPADLINC|REMOTELINC,#i; + s#IPLD,#INSTEON_LAMPLINC|APPLIANCELINC|MOTIONSENSOR,#i; + + # the regexes below do some magic based on my insteon.mht file which + # has comments stating what each device actually is, so I use this to + # turn refine the check above to state which of the 3 or 4 devices we + # actually got: +#IPLL, 11.E1.9D:01, mbr_kpl, All_Lights, PLM, # v1.8 keypadlinc dimmer +#IPLL, 0E.07.49:02, fmr_kpl_kitchen_kpl, fmr_kplB|buttons, PLM, +#IPLL, 0F.B7.05:01, mbr_lamp2, All_Lights|mbr_both, PLM, # v4.2 switchlink dimmer +#IPLD, 0F.6E.C2, mbr_lamp3, All_Lights, PLM, # v4.3 lamplinc +#IPLD, 11.8E.1C, gar_mos1, Sensors, PLM,1001 # v1.1 +#IPLL, 15.E7.62:01, iolinc_garside, iolincs, PLM,0007 # v1.4 iolinc + + # those are local hacks to do the right replaces with my config file + s#INSTEON_SWITCHLINC\|SWITCHLINCRELAY\|KEYPADLINC\|REMOTELINC(.*switchlin. dimmer)#INSTEON_SWITCHLINC$1#i; + s#INSTEON_SWITCHLINC\|SWITCHLINCRELAY\|KEYPADLINC\|REMOTELINC(.*switchlin. relay)#INSTEON_SWITCHLINCRELAY$1#i; + s#INSTEON_SWITCHLINC\|SWITCHLINCRELAY\|KEYPADLINC\|REMOTELINC(.*_kpl)#INSTEON_KEYPADLINC$1#i; + s#INSTEON_SWITCHLINC\|SWITCHLINCRELAY\|KEYPADLINC\|REMOTELINC(.*rlink)#INSTEON_REMOTELINC$1#i; + # IOLINC isn't supported yet, but it does look like a switchlinc relay. + s#INSTEON_SWITCHLINC\|SWITCHLINCRELAY\|KEYPADLINC\|REMOTELINC(.*iolin)#INSTEON_SWITCHLINCRELAY$1#i; + s#INSTEON_SWITCHLINC\|SWITCHLINCRELAY\|KEYPADLINC\|REMOTELINC(.*PLM)#INSTEON_PLM$1#i; + + s#INSTEON_LAMPLINC\|APPLIANCELINC\|MOTIONSENSOR(.*lamplin)#INSTEON_LAMPLINC$1#i; + s#INSTEON_LAMPLINC\|APPLIANCELINC\|MOTIONSENSOR(.*appliance lin)#INSTEON_APPLIANCELINC$1#i; + s#INSTEON_LAMPLINC\|APPLIANCELINC\|MOTIONSENSOR(.*_mos\d+)#INSTEON_MOTIONSENSOR$1#i; + + # obviously, the idea is that if you have any of those INSTEON_A|B|C left over + # after the regexes above, you need to fix them yourself or add more regexes. + + s#,\s*plm,?(?:\d+)?##i; + # restore 'plm' on the one line we need it on. + s/INSTEON_PLM/INSTEON_PLM, PLM/; + + print; +} diff --git a/lib/Insteon_Device.pm b/lib/Insteon_Device.pm deleted file mode 100644 index 048f6eaa2..000000000 --- a/lib/Insteon_Device.pm +++ /dev/null @@ -1,1903 +0,0 @@ -=begin comment -@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - -File: - Insteon_Device.pm - -Description: - Generic class implementation of an Insteon Device. - -Author(s): - Jason Sharpee / jason@sharpee.com - Gregg Liming / gregg@limings.net - -License: - This free software is licensed under the terms of the GNU public license. - -Usage: - - $ip_patio_light = new Insteon_Device($myPLM,"33.44.55"); - - $ip_patio_light->set("ON"); - -Special Thanks to: - Brian Warren for significant testing and patches - Bruce Winter - MH - -@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -=cut - -use strict; - -package Insteon_Device; - -@Insteon_Device::ISA = ('Generic_Item'); - -my %message_types = ( - assign_to_group => 0x01, - delete_from_group => 0x02, - linking_mode => 0x09, - unlinking_mode => 0x0A, - ping => 0x10, - on => 0x11, - on_fast => 0x12, - off => 0x13, - off_fast => 0x14, - bright => 0x15, - dim => 0x16, - start_manual_change => 0x17, - stop_manual_change => 0x18, - status_request => 0x19, - get_operating_flags => 0x1f, - set_operating_flags => 0x20, - do_read_ee => 0x24, - remote_set_button_tap => 0x25, - set_led_status => 0x27, - set_address_msb => 0x28, - poke => 0x29, - poke_extended => 0x2a, - peek => 0x2b, - peek_internal => 0x2c, - poke_internal => 0x2d, - on_at_ramp_rate => 0x2e, - off_at_ramp_rate => 0x2f, - sprinkler_valve_on => 0x40, - sprinkler_valve_off => 0x41, - sprinkler_program_on => 0x42, - sprinkler_program_off => 0x43, - sprinkler_control => 0x44, - sprinkler_timers_request => 0x45, - thermostat_temp_up => 0x68, - thermostat_temp_down => 0x69, - thermostat_get_zone_temp => 0x6a, - thermostat_get_zone_setpoint => 0x6a, - thermostat_get_zone_humidity => 0x6a, - thermostat_control => 0x6b, - thermostat_get_mode => 0x6b, - thermostat_get_temp => 0x6b, - thermostat_setpoint_cool => 0x6c, - thermostat_setpoint_heat => 0x6d -); - -my %operating_flags = ( - 'program_lock_on' => '00', - 'program_lock_off' => '01', - 'led_on_during_tx' => '02', - 'led_off_during_tx' => '03', - 'resume_dim_on' => '04', - 'beeper_enabled' => '04', - 'resume_dim_off' => '05', - 'beeper_off' => '05', - 'eight_key_kpl' => '06', - 'load_sense_on' => '06', - 'six_key_kpl' => '07', - 'load_sense_off' => '07', - 'led_backlight_off' => '08', - 'led_off' => '08', - 'led_backlight_on' => '09', - 'led_enabled' => '09', - 'key_beep_enabled' => '0a', - 'one_minute_warn_disabled' => '0a', - 'key_beep_off' => '0b', - 'one_minute_warn_enabled' => '0b' -); - -my %ramp_h2n = ( - '00' => 540, - '01' => 480, - '02' => 420, - '03' => 360, - '04' => 300, - '05' => 270, - '06' => 240, - '07' => 210, - '08' => 180, - '09' => 150, - '0a' => 120, - '0b' => 90, - '0c' => 60, - '0d' => 47, - '0e' => 43, - '0f' => 39, - '10' => 34, - '11' => 32, - '12' => 30, - '13' => 28, - '14' => 26, - '15' => 23.5, - '16' => 21.5, - '17' => 19, - '18' => 8.5, - '19' => 6.5, - '1a' => 4.5, - '1b' => 2, - '1c' => .5, - '1d' => .3, - '1e' => .2, - '1f' => .1 -); - -sub convert_ramp -{ - my ($ramp_in_seconds) = @_; - if ($ramp_in_seconds) { - foreach my $rampkey (sort keys %ramp_h2n) { - return $rampkey if $ramp_in_seconds >= $ramp_h2n{$rampkey}; - } - } else { - return '1f'; - } -} - -sub get_ramp_from_code -{ - my ($ramp_code) = @_; - if ($ramp_code) { - return $ramp_h2n{$ramp_code}; - } else { - return 0; - } -} - -sub convert_level -{ - my ($on_level) = @_; - my $level = 'ff'; - if (defined ($on_level)) { - if ($on_level eq '100') { - $level = 'ff'; - } elsif ($on_level eq '0') { - $level = '00'; - } else { - $level = sprintf('%02X',$on_level * 2.55); - } - } - return $level; -} - -sub new -{ - my ($class,$p_interface,$p_deviceid,$p_devcat) = @_; - my $self={}; - bless $self,$class; - - if (defined $p_deviceid) { - my ($deviceid, $group) = $p_deviceid =~ /(\w\w\.\w\w\.\w\w):?(.+)?/; - # if a group is passed in, then assume it can be a controller - $$self{is_controller} = ($group) ? 1 : 0; - $self->device_id($deviceid); - $group = '01' unless $group; - $group = '0' . $group if length($group) == 1; - $self->group(uc $group); - } - if ($p_devcat) { - $self->devcat($p_devcat); - $self->restore_data('level','send_synchronously'); - } else { - $self->restore_data('devcat','level','send_synchronously'); - } - $self->initialize(); - $self->rate(undef); - $$self{level} = undef; - $$self{flag} = "0F"; - $$self{ackMode} = "1"; - $$self{awaiting_ack} = 0; - $$self{is_acknowledged} = 0; - $$self{queue_timer} = new Timer(); - $$self{max_queue_time} = $::config_parms{'Insteon_PLM_max_queue_time'}; - $$self{max_queue_time} = 10 unless $$self{max_queue_time}; # 10 seconds is max time allowed in command stack - @{$$self{command_stack}} = (); - $$self{_retry_count} = 0; # num times that a command has been resent - $$self{_onlevel} = undef; - if ($p_devcat and (($p_devcat eq '0005') or ($p_devcat eq '1001'))) { - $$self{is_responder} = 0; - } else { - $$self{is_responder} = 1; - } - $self->interface($p_interface) if defined $p_interface; - return $self; -} - -sub initialize -{ - my ($self) = @_; - $$self{send_synchronously} = undef; - $$self{m_write} = 1; - $$self{m_is_locally_set} = 0; - # persist local, simple attribs - $$self{ping_timer} = new Timer(); - $$self{ping_timerTime} = 300; - $$self{ping_timer}->set($$self{ping_timerTime} + (rand() * $$self{ping_timerTime}), $self) - unless $self->group eq '01' and defined $self->devcat; -} - -sub interface -{ - my ($self,$p_interface) = @_; - if (defined $p_interface) { - $$self{interface} = $p_interface; - # be sure to add the object to the interface - $$self{interface}->add_item_if_not_present($self); - } - return $$self{interface}; -} - -sub device_id -{ - my ($self,$p_device_id) = @_; - - if (defined $p_device_id) - { - $p_device_id =~ /(\w\w)\W?(\w\w)\W?(\w\w)/; - $$self{device_id}=$1 . $2 . $3; - } - return $$self{device_id}; -} - -sub rate -{ - my ($self,$p_rate) = @_; - $$self{rate} = $p_rate if defined $p_rate; - return $$self{rate}; -} - -sub send_synchronously -{ - my ($self, $p_send_sync) = @_; - $$self{send_synchronously} = $p_send_sync if defined $p_send_sync; - if (defined $$self{send_synchronously}) { - return $$self{send_synchronously}; - } elsif ($main::config_parms{Insteon_send_synchronously}) { - return 1; - } else { - return 0; - } -} - - -sub is_acknowledged -{ - my ($self, $p_ack) = @_; - $$self{is_acknowledged} = $p_ack if defined $p_ack; - if ($p_ack) { - $self->SUPER::set($$self{pending_state},$$self{pending_setby}, $$self{pending_response}) if defined $$self{pending_state}; - $$self{pending_state} = undef; - $$self{pending_setby} = undef; - $$self{pending_response} = undef; - } - return $$self{is_acknowledged}; -} - -sub is_controller -{ - my ($self) = @_; - return $$self{is_controller}; -} - -sub is_responder -{ - my ($self,$is_responder) = @_; - $$self{is_responder} = $is_responder if defined $is_responder; - if ($self->is_root) { - return $$self{is_responder}; - } else { - my $root_obj = $self->get_root(); - return (ref $root_obj) ? $$root_obj{is_responder} : 0; - } -} - -sub is_keypadlinc -{ - my ($self) = @_; - my $obj = $self->get_root; - if (($$obj{devcat} eq '0109') or ($$obj{devcat} =~ /010c/i) or ($$obj{devcat} =~ /020f/i) or ($$obj{devcat} eq '011b')) { - return 1; - } else { - return 0; - } -} - -sub is_remotelinc -{ - my ($self) = @_; - my $obj = $self->get_root; - if ($$obj{devcat} eq '0005') { - return 1; - } else { - return 0; - } -} - -sub level -{ - my ($self, $p_level) = @_; - if (defined $p_level) { - my $level = undef; - if ($p_level eq 'on') - { - # set the level based on any locally defined on level - $level = &Insteon_Device::local_onlevel; - # set to 100 if a local on level is not defined - $level=100 unless defined($level); - } elsif ($p_level eq 'off') - { - $level = 0; - } elsif ($p_level =~ /^([1]?[0-9]?[0-9])%?$/) - { - if ($1 < 1) { - $level = 0; - } else { - $level = ($self->is_dimmable) ? $1 : 100; - } - } - $$self{level} = $level if defined $level; - } - return $$self{level}; - -} - -sub set -{ - my ($self,$p_state,$p_setby,$p_response) = @_; - return if &main::check_for_tied_filters($self, $p_state); - - # Override any set_with_timer requests - if ($$self{set_timer}) { - &Timer::unset($$self{set_timer}); - delete $$self{set_timer}; - } - - if (!($self->is_plm_controlled) && !($self->is_responder)) { - # if it can't be controlled (i.e., a responder), then don't send out any signals - # motion sensors seem to get multiple fast reports; don't trigger on both - if (not defined($self->get_idle_time) or $self->get_idle_time > 1) { - &::print_log("[Insteon_Device] " . $self->get_object_name() - . "::set_receive($p_state, $p_setby)") if $main::Debug{insteon}; - $self->set_receive($p_state,$p_setby); - } else { - &::print_log("[Insteon_Device] " . $self->get_object_name() - . "::set_receive($p_state, $p_setby) deferred due to repeat within 1 second") - if $main::Debug{insteon}; - } - return; - } - - # did the queue timer go off? - if (ref $p_setby and $p_setby eq $$self{queue_timer}) { - $self->_process_command_stack(); - } elsif (ref $p_setby and $p_setby eq $$self{ping_timer}) { - if (! (defined($$self{devcat}))) { - $self->ping(); - # set the timer again in case nothing occurs - $$self{ping_timer}->set($$self{ping_timerTime} + (rand() * $$self{ping_timerTime}), $self); - } - } elsif ($self->_is_valid_state($p_state)) { - # always reset the is_locally_set property unless set_by is the device - $$self{m_is_locally_set} = 0 unless ref $p_setby and $p_setby eq $self; - - # handle invalid state for non-dimmable devices - if (($p_state eq 'dim' or $p_state eq 'bright') and !($self->is_dimmable)) { - $p_state = 'on'; - } - - if (ref $p_setby and (($p_setby eq $self->interface()) - or ($p_setby->isa('Insteon_Device') and (($p_setby eq $self) - or (&main::set_by_to_target($p_setby) eq $self->interface))))) - { - # don't reset the object w/ the same state if set from the interface - return if (lc $p_state eq lc $self->state) and $self->is_acknowledged - and not (($p_setby->isa('Insteon_Device') and (($p_setby eq $self)))); - &::print_log("[Insteon_Device] " . $self->get_object_name() - . "::set($p_state, $p_setby)") if $main::Debug{insteon}; - $self->SUPER::set($p_state,$p_setby,$p_response) if defined $p_state; - } else { - $self->_send_cmd(command => $p_state, - type => (($self->isa('Insteon_Link') and !($self->is_root)) ? 'alllink' : 'standard'), - 'is_synchronous' => $self->send_synchronously); - &::print_log("[Insteon_Device] " . $self->get_object_name() . "::set($p_state, $p_setby)") - if $main::Debug{insteon}; - $self->is_acknowledged(0); - $$self{pending_state} = $p_state; - $$self{pending_setby} = $p_setby; - $$self{pending_response} = $p_response; - } - $self->level($p_state); # update the level value -# $self->SUPER::set($p_state,$p_setby,$p_response) if defined $p_state; - } else { - &::print_log("[Insteon_Device] failed state validation with state=$p_state"); - } -} - -sub set_with_timer { - my ($self, $state, $time, $return_state, $additional_return_states) = @_; - return if &main::check_for_tied_filters($self, $state); - - $self->set($state) unless $state eq ''; - - return unless $time; - - my $state_change = ($state eq 'off') ? 'on' : 'off'; - $state_change = $return_state if defined $return_state; - $state_change = $self->{state} if $return_state and lc $return_state eq 'previous'; - - $state_change .= ';' . $additional_return_states if $additional_return_states; - - $$self{set_timer} = &Timer::new() unless $$self{set_timer}; - my $object_name = $self->{object_name}; - my $action = "$object_name->set('$state_change')"; - $$self{set_timer}->set($time, $action); -} - -sub link_to_interface -{ - my ($self,$p_group, $p_data3) = @_; - my $group = $p_group; - $group = '01' unless $group; - # add a link first to this device back to interface - # and, add a reference to creating a link from interface back to device via hook - my $callback_instance = $self->interface->get_object_name; - my $callback_info = "deviceid=" . lc $self->device_id . " group=$group is_controller=0"; - my %link_info = ( object => $self->interface, group => $group, is_controller => 1, - on_level => '100%', ramp_rate => '0.1s', - callback => "$callback_instance->add_link('$callback_info')"); - $link_info{data3} = $p_data3 if $p_data3; - $self->add_link(%link_info); -} - -sub unlink_to_interface -{ - my ($self,$p_group) = @_; - my $group = $p_group; - $group = '01' unless $group; - my $callback_instance = $self->interface->get_object_name; - my $callback_info = "deviceid=" . lc $self->device_id . " group=$group is_controller=0"; - $self->delete_link(object => $self->interface, group => $group, is_controller => 1, - callback => "$callback_instance->delete_link('$callback_info')"); -} - -sub queue_timer_callback -{ - my ($self, $callback) = @_; - $$self{queue_timer_callback} = $callback if defined $callback; - return $$self{queue_timer_callback}; -} - -sub _send_cmd -{ - my ($self, %msg) = @_; - $msg{type} = 'standard' unless $msg{type}; - if ($msg{is_synchronous}) { - push(@{$$self{command_stack}}, \%msg); - } else { - unshift(@{$$self{command_stack}}, \%msg); - } - $self->_process_command_stack(); -} - -sub _process_command_stack -{ - my ($self, %ackmsg) = @_; - if (%ackmsg) { # which may also be something that can be interpretted as a "nack" - # determine whether to unset awaiting_ack - # for now, be "dumb" and just unset it - $$self{awaiting_ack} = 0; - # is there an "on_ack" command to now be performed? if so, queue it - if ($ackmsg{on_ack}) { - # process the on_ack command - # any new command needs to be pushed on to the queue in front of other pending cmds - } - } - if ($$self{queue_timer}->expired or !($$self{awaiting_ack})) { - my $callback = undef; - if ($$self{queue_timer}->expired) { - if ($$self{_prior_msg} and $$self{_retry_count} < 2) { - # first check to see if type is an alllink; if so, then don't keep retrying until - # proper handling of alllink cleanup status is implemented in Insteon_PLM - if ($$self{_prior_msg}{type} eq 'alllink' and (!($self->is_plm_controlled))) { - # do nothing - } else { - push(@{$$self{command_stack}}, \%{$$self{_prior_msg}}); - &::print_log("[Insteon_Device] WARN: queue timer on " . $self->get_object_name . - " expired. Attempting resend: $$self{_prior_msg}{command}"); - } - } else { - &::print_log("[Insteon_Device] WARN: queue timer on " . $self->get_object_name . - " expired. Trying next command if queued."); - $$self{m_status_request_pending} = 0; # hack--need a better way - if ($self->queue_timer_callback) { - if ($$self{_prior_msg} and ($$self{_prior_msg}{is_synchronous})) { - # get rid of any pending next command as we need to abort - pop(@{$$self{command_stack}}); - } - $callback = $self->queue_timer_callback; - $self->queue_timer_callback(''); # reset to prevent repeat callbacks - } - } - } - my $cmdptr = pop(@{$$self{command_stack}}); - # convert ptr to cmd hash - if ($cmdptr) { - my %cmd = %$cmdptr; - # convert cmd to insteon message - my $insteonmsg = $self->_xlate_mh_insteon($cmd{command},$cmd{type},$cmd{extra}); - if (!(defined($insteonmsg))) { - return; - } - my $plm_queue_size = $self->interface()->set($insteonmsg, $self); - # send msg - if ($cmd{is_synchronous}) { - $$self{awaiting_ack} = 1; - } else { - $$self{awaiting_ack} = 0; - } - # check to see if we are resending the same command; if so, then assume it is a retry and bump the counter - if ($$self{_prior_msg} and $$self{_prior_msg}{command} eq $cmd{command}) { - $$self{_retry_count} = ($$self{_retry_count}) ? $$self{_retry_count} + 1 : 1; - # unless there is a difference in the "extra" field which would be useful for something like repeat peeks - if (exists($$self{_prior_msg}{extra}) and exists($cmd{extra}) and ($$self{_prior_msg}{extra} ne $cmd{extra})) { - $$self{_retry_count} = 0; - } - } else { - $$self{_retry_count} = 0; - } - %{$$self{_prior_msg}} = %cmd; - # TO-DO: adjust timer based upon (1) type of message and (2) retry_count - my $queue_time = $$self{max_queue_time} + $plm_queue_size; - unless ($self->get_object_name) { - # needed because the initial startup scan occurs before names are assigned - $self->set_retry_timeout($queue_time); - } -# $$self{queue_timer}->set($queue_time,$self); - # if is_synchronous, then no other command can be sent until an insteon ack or nack is received - # for this command - } else { - # always unset the timer if no more commands - $$self{queue_timer}->unset(); - # and, always clear awaiting_ack and _prior_msg - $$self{awaiting_ack} = 0; - $$self{_prior_msg} = undef; - } - if ($callback) { - package main; - eval ($callback); - &::print_log("[Insteon_Device] error in queue timer callback: " . $@) - if $@ and $main::Debug{insteon}; - package Insteon_Device; - } - } else { - &::print_log("[Insteon_Device] " . $self->get_object_name . " command queued but not yet sent; awaiting ack from prior command") if $main::Debug{insteon}; - } -} - -sub set_operating_flag { - my ($self, $flag) = @_; - - if (!(exists($operating_flags{$flag}))) { - &::print_log("[Insteon_Device] $flag is not a support operating flag"); - return; - } - - if ($self->is_root and !($self->is_plm_controlled)) { - # TO-DO: check devcat to determine if the action is supported by the device - $self->_send_cmd('command' => 'set_operating_flags', 'extra' => $operating_flags{$flag}); - } else { - &::print_log("[Insteon_Device] " . $self->get_object_name . " is either not a root device or is a plm controlled scene"); - return; - } -} - -sub get_operating_flag { - my ($self) = @_; - - if ($self->is_root and !($self->is_plm_controlled)) { - # TO-DO: check devcat to determine if the action is supported by the device - $self->_send_cmd('command' => 'get_operating_flags'); - } else { - &::print_log("[Insteon_Device] " . $self->get_object_name . " is either not a root device or is a plm controlled scene"); - return; - } -} - - -sub set_retry_timeout { - my ($self, $timeout) = @_; -#print "########## now setting " . $self->get_object_name . " retry timeout to $$self{max_queue_time} seconds\n"; - my $timer_value = $timeout; - $timer_value = $$self{max_queue_time} unless $timer_value; - $$self{queue_timer}->set($timer_value,$self); -} - -sub writable { - my ($self, $p_write) = @_; - if (defined $p_write) { - if ($p_write =~ /r/i or $p_write =~/^0/) { - $$self{m_write} = 0; - } else { - $$self{m_write} = 1; - } - } - return $$self{m_write}; -} - -sub is_locally_set { - my ($self) = @_; - return $$self{m_is_locally_set}; -} - -sub is_plm_controlled { - my ($self) = @_; - return ($self->device_id eq '000000') ? 1 : 0; -} - -sub is_root { - my ($self) = @_; - return (($self->group eq '01') and !($self->is_plm_controlled)) ? 1 : 0; -} - -sub get_root { - my ($self) = @_; - if ($self->is_root) { - return $self; - } else { - return $self->interface->get_object($self->device_id, '01'); - } -} - -sub group -{ - my ($self, $p_group) = @_; - $$self{m_group} = $p_group if $p_group; - return $$self{m_group}; -} - -### WARN: Testing using the following does not produce results as expected. Use at your own risk. [GL] -sub remote_set_button_tap -{ - my ($self,$p_number_taps) = @_; - my $taps = ($p_number_taps =~ /2/) ? '02' : '01'; - $self->_send_cmd('command' => 'remote_set_button_tap', 'extra' => $taps); -} - -sub request_status -{ - my ($self, $requestor) = @_; - $$self{m_status_request_pending} = ($requestor) ? $requestor : 1; - $self->_send_cmd('command' => 'status_request', 'is_synchronous' => 1); -} - -sub ping -{ - my ($self) = @_; - $self->_send_cmd('command' => 'ping'); -} - -sub set_led_status -{ - my ($self, $status_mask) = @_; - $self->_send_cmd('command' => 'set_led_status', 'extra' => $status_mask); -} - -sub _is_valid_state -{ - my ($self,$state) = @_; - if (!(defined($state)) or $state eq '') { - return 0; - } - - my ($msg, $substate) = split(/:/, $state, 2); - $msg=lc($msg); - - if ($msg=~/^([1]?[0-9]?[0-9])/) - { - if ($1 < 1) { - $msg='off'; - } else { - $msg='on'; - } - } - - # confirm that the resulting $msg is legitimate - if (!(defined($message_types{$msg}))) { - return 0; - } else { - return 1; - } -} - -sub _is_info_request -{ - my ($self, $cmd, $ack_setby, %msg) = @_; - my $is_info_request = ($cmd eq 'status_request') ? 1 : 0; -#print "cmd: $cmd; is_info_request: $is_info_request\n"; - if ($is_info_request) { - my $ack_on_level = (hex($msg{extra}) >= 254) ? 100 : sprintf("%d", hex($msg{extra}) * 100 / 255); - &::print_log("[Insteon_Device] received status request report for " . - $self->{object_name} . " with on-level: $ack_on_level%, " - . "hops left: $msg{hopsleft}") if $main::Debug{insteon}; - $self->level($ack_on_level); # update the level value - if ($ack_on_level == 0) { - $self->SUPER::set('off', $ack_setby); - } elsif ($ack_on_level > 0 and !($self->is_dimmable)) { - $self->SUPER::set('on', $ack_setby); - } else { - $self->SUPER::set($ack_on_level . '%', $ack_setby); - } - } - return $is_info_request; - -} - -sub _process_message -{ - my ($self,$p_setby,%msg) = @_; - my $p_state = undef; - - # the current approach assumes that links from other controllers to some responder - # would be seen by the plm by also direct linking the controller as a responder - # and not putting the plm into monitor mode. This means that updating the state - # of the responder based upon the link controller's request is handled - # by Insteon_Link. - $$self{m_is_locally_set} = 1 if $msg{source} eq lc $self->device_id; - if ($msg{is_ack}) { - my $pending_cmd = ($$self{_prior_msg}) ? $$self{_prior_msg}{command} : $msg{command}; - if ($$self{awaiting_ack}) { - my $ack_setby = (ref $$self{m_status_request_pending}) - ? $$self{m_status_request_pending} : $p_setby; - if ($self->_is_info_request($pending_cmd,$ack_setby,%msg)) { - $self->is_acknowledged(1); - $$self{m_status_request_pending} = 0; - $self->_process_command_stack(%msg); - } elsif (($pending_cmd eq 'peek') or ($pending_cmd eq 'set_address_msb')) { - $self->_on_peek(%msg); - $self->_process_command_stack(%msg); - } elsif (($pending_cmd eq 'poke') or ($pending_cmd eq 'set_address_msb')) { - $self->_on_poke(%msg); - $self->_process_command_stack(%msg); - } else { - $self->is_acknowledged(1); - # signal receipt of message to the command stack in case commands are queued - $self->_process_command_stack(%msg); - &::print_log("[Insteon_Device] received command/state (awaiting) acknowledge from " . $self->{object_name} - . ": $pending_cmd and data: $msg{extra}") if $main::Debug{insteon}; - } - } else { - # allow non-synchronous messages to also use the _is_info_request hook - $self->_is_info_request($pending_cmd,$p_setby,%msg); - $self->is_acknowledged(1); - # signal receipt of message to the command stack in case commands are queued - $self->_process_command_stack(%msg); - &::print_log("[Insteon_Device] received command/state acknowledge from " . $self->{object_name} - . ": " . (($msg{command}) ? $msg{command} : "(unknown)") - . " and data: $msg{extra}") if $main::Debug{insteon}; - } - } elsif ($msg{is_nack}) { - if ($$self{awaiting_ack}) { - &::print_log("[Insteon_Device] WARN!! encountered a nack message for " . $self->{object_name} - . " ... waiting for retry"); - } else { - &::print_log("[Insteon_Device] WARN!! encountered a nack message for " . $self->{object_name} - . " ... skipping"); - $self->is_acknowledged(0); - $self->_process_command_stack(%msg); - } - } elsif ($msg{command} eq 'start_manual_change') { - # do nothing; although, maybe anticipate change? we should always get a stop - } elsif ($msg{command} eq 'stop_manual_change') { - $self->request_status($self); - } elsif ($msg{type} eq 'broadcast') { - $self->devcat($msg{devcat}); - &::print_log("[Insteon_Device] device category: $msg{devcat} received for " . $self->{object_name}); - # stop ping timer now that we have a devcat; possibly may want to change this behavior to allow recurring pings - $$self{ping_timer}->stop(); - } else { - ## TO-DO: make sure that the state passed by command is something that is reasonable to set - $p_state = $msg{command}; - $$self{_pending_cleanup} = 1 if $msg{type} eq 'alllink'; -# $self->set($p_state, $p_setby) unless (lc($self->state) eq lc($p_state)) and - $self->set($p_state, $self) unless (lc($self->state) eq lc($p_state)) and - ($msg{type} eq 'cleanup' and $$self{_pending_cleanup}); - $$self{_pending_cleanup} = 0 if $msg{type} eq 'cleanup'; - } -} - -sub _xlate_insteon_mh -{ - my ($p_state) = @_; - my %msg = (); - my $hopflag = hex(uc substr($p_state,13,1)); - $msg{hopsleft} = $hopflag >> 2; - my $msgflag = hex(uc substr($p_state,12,1)); - $msg{is_extended} = (0x01 & $msgflag) ? 1 : 0; - if ($msg{is_extended}) { - $msg{source} = substr($p_state,0,6); - $msg{destination} = substr($p_state,6,6); - $msg{extra} = substr($p_state,16,16); - } else { - $msg{source} = substr($p_state,0,6); - $msgflag = $msgflag >> 1; - if ($msgflag == 4) { - $msg{type} = 'broadcast'; - $msg{devcat} = substr($p_state,6,4); - $msg{firmware} = substr($p_state,10,2); - $msg{is_master} = substr($p_state,16,2); - $msg{dev_attribs} = substr($p_state,18,2); - } elsif ($msgflag ==6) { - $msg{type} = 'alllink'; - $msg{group} = substr($p_state,10,2); - } else { - $msg{destination} = substr($p_state,6,6); - if ($msgflag == 2) { - $msg{type} = 'cleanup'; - $msg{group} = substr($p_state,16,2); - } elsif ($msgflag == 3) { - $msg{type} = 'cleanup'; - $msg{is_ack} = 1; - } elsif ($msgflag == 7) { - $msg{type} = 'cleanup'; - $msg{is_nack} = 1; - } elsif ($msgflag == 0) { - $msg{type} = 'direct'; - $msg{extra} = substr($p_state,16,2); - } elsif ($msgflag == 1) { - $msg{type} = 'direct'; - $msg{is_ack} = 1; - $msg{extra} = substr($p_state,16,2); - } elsif ($msgflag == 5) { - $msg{type} = 'direct'; - $msg{is_nack} = 1; - } - } - } - my $cmd1 = substr($p_state,14,2); - - if ($msg{type} ne 'broadcast') { - &::print_log("[Insteon_Device] command:$cmd1; type:$msg{type}; group: $msg{group}") if (!($msg{is_ack} or $msg{is_nack})) - and $main::Debug{insteon}; - for my $key (keys %message_types){ - if (pack("C",$message_types{$key}) eq pack("H*",$cmd1)) - { - &::print_log("[Insteon_Device] found: $key") - if (!($msg{is_ack} or $msg{is_nack})) and $main::Debug{insteon}; - $msg{command}=$key; - last; - } - } - } - return %msg; -} - -sub _xlate_mh_insteon -{ - my ($self,$p_state,$p_type, $p_extra) = @_; - my $cmd; - my @args; - my $level; - - #msg id - my ($msg, $substate) = split(/:/, $p_state, 2); - $msg=lc($msg); -# &::print_log("XLATE:$msg:$substate:$p_state:"); - - if (!(defined $p_extra)) { - if ($msg eq 'on') - { - if (defined $self->local_onlevel) { - $level = 2.55 * $self->local_onlevel; - $msg = 'on_fast'; - } else { - $level=255; - } - } elsif ($msg eq 'off') - { - $level = 0; - } elsif ($msg=~/^([1]?[0-9]?[0-9])/) - { - if ($1 < 1) { - $msg='off'; - $level = 0; - } else { - $level = ($self->is_dimmable) ? $1 * 2.55 : 255; - $msg='on'; - } - } - } - - # confirm that the resulting $msg is legitimate - if (!(defined($message_types{$msg}))) { - &::print_log("[Insteon_Device] invalid state=$msg") if $main::Debug{insteon}; - return undef; - } - - $cmd=''; - if ($p_type =~ /broadcast/i) { - $cmd.=$self->group; - } else { - $cmd.=$self->device_id(); - if ($p_type =~ /extended/i) { - $cmd.='1F'; - } else { - $cmd.='0F'; - } - } - $cmd.= unpack("H*",pack("C",$message_types{$msg})); - if ($p_extra) - { - $cmd.= $p_extra; - } elsif ($substate) { - $cmd.= $substate; - } else { - if ($msg eq 'on') - { - $cmd.= sprintf("%02X",$level); - } else { - $cmd.='00'; - } - } - return $cmd; -} - -sub _on_poke -{ - my ($self,%msg) = @_; - if (($$self{_mem_activity} eq 'update') or ($$self{_mem_activity} eq 'add')) { - if ($$self{_mem_action} eq 'adlb_flag') { - $$self{_mem_action} = 'adlb_group'; - $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); - $self->_send_cmd('command' => 'peek', 'extra' => $$self{_mem_lsb}, 'is_synchronous' => 1); - } elsif ($$self{_mem_action} eq 'adlb_group') { - $$self{_mem_action} = 'adlb_devhi'; - $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); - $self->_send_cmd('command' => 'peek', 'extra' => $$self{_mem_lsb}, 'is_synchronous' => 1); - } elsif ($$self{_mem_action} eq 'adlb_devhi') { - $$self{_mem_action} = 'adlb_devmid'; - $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); - $self->_send_cmd('command' => 'peek', 'extra' => $$self{_mem_lsb}, 'is_synchronous' => 1); - } elsif ($$self{_mem_action} eq 'adlb_devmid') { - $$self{_mem_action} = 'adlb_devlo'; - $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); - $self->_send_cmd('command' => 'peek', 'extra' => $$self{_mem_lsb}, 'is_synchronous' => 1); - } elsif ($$self{_mem_action} eq 'adlb_devlo') { - $$self{_mem_action} = 'adlb_data1'; - $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); - $self->_send_cmd('command' => 'peek', 'extra' => $$self{_mem_lsb}, 'is_synchronous' => 1); - } elsif ($$self{_mem_action} eq 'adlb_data1') { - $$self{_mem_action} = 'adlb_data2'; - $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); - $self->_send_cmd('command' => 'peek', 'extra' => $$self{_mem_lsb}, 'is_synchronous' => 1); - } elsif ($$self{_mem_action} eq 'adlb_data2') { - $$self{_mem_action} = 'adlb_data3'; - $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); - $self->_send_cmd('command' => 'peek', 'extra' => $$self{_mem_lsb}, 'is_synchronous' => 1); - } elsif ($$self{_mem_action} eq 'adlb_data3') { - ## update the adlb records w/ the changes that were made - my $adlbkey = $$self{pending_adlb}{deviceid} . $$self{pending_adlb}{group} . $$self{pending_adlb}{is_controller}; - # append the device "sub-address" (e.g., a non-root button on a keypadlinc) if it exists - my $subaddress = $$self{pending_adlb}{data3}; - if (($subaddress ne '00') and ($subaddress ne '01')) { - $adlbkey .= $subaddress; - } - $$self{adlb}{$adlbkey}{data1} = $$self{pending_adlb}{data1}; - $$self{adlb}{$adlbkey}{data2} = $$self{pending_adlb}{data2}; - $$self{adlb}{$adlbkey}{data3} = $$self{pending_adlb}{data3}; - $$self{adlb}{$adlbkey}{inuse} = 1; # needed so that restore string will preserve record - if ($$self{_mem_activity} eq 'add') { - $$self{adlb}{$adlbkey}{is_controller} = $$self{pending_adlb}{is_controller}; - $$self{adlb}{$adlbkey}{deviceid} = lc $$self{pending_adlb}{deviceid}; - $$self{adlb}{$adlbkey}{group} = lc $$self{pending_adlb}{group}; - $$self{adlb}{$adlbkey}{address} = $$self{pending_adlb}{address}; - # on completion, check to see if the empty links list is now empty; if so, - # then decrement the current address and add it to the list - my $num_empty = @{$$self{adlb}{empty}}; - if (!($num_empty)) { - my $low_address = 0; - for my $key (keys %{$$self{adlb}}) { - next if $key eq 'empty' or $key eq 'duplicates'; - my $new_address = hex($$self{adlb}{$key}{address}); - if (!($low_address)) { - $low_address = $new_address; - next; - } else { - $low_address = $new_address if $new_address < $low_address; - } - } - $low_address = sprintf('%04X', $low_address - 8); - unshift @{$$self{adlb}{empty}}, $low_address; - } - } - # clear out mem_activity flag - $$self{_mem_activity} = undef; - if (defined $$self{_mem_callback}) { - my $callback = $$self{_mem_callback}; - # clear it out *before* the eval - $$self{_mem_callback} = undef; - package main; - eval ($callback); - package Insteon_Device; - &::print_log("[Insteon_Device] error in link callback: " . $@) - if $@ and $main::Debug{insteon}; - } - } - } elsif ($$self{_mem_activity} eq 'update_local') { - if ($$self{_mem_action} eq 'local_onlevel') { - $$self{_mem_lsb} = '21'; - $$self{_mem_action} = 'local_ramprate'; - $self->_send_cmd('command' => 'peek', 'extra' => $$self{_mem_lsb}, 'is_synchronous' => 1); - } elsif ($$self{_mem_action} eq 'local_ramprate') { - if ($self->is_keypadlinc) { - # update from eeprom--only a kpl issue - $self->_send_cmd('command' => 'do_read_ee','is_synchronous' => 1); - } - } - } elsif ($$self{_mem_activity} eq 'update_flags') { - # update from eeprom--only a kpl issue - $self->_send_cmd('command' => 'do_read_ee','is_synchronous' => 1); - } elsif ($$self{_mem_activity} eq 'delete') { - # clear out mem_activity flag - $$self{_mem_activity} = undef; - # add the address of the deleted link to the empty list - push @{$$self{adlb}{empty}}, $$self{pending_adlb}{address}; - if (exists $$self{pending_adlb}{deviceid}) { - my $key = lc $$self{pending_adlb}{deviceid} . $$self{pending_adlb}{group} . $$self{pending_adlb}{is_controller}; - # append the device "sub-address" (e.g., a non-root button on a keypadlinc) if it exists - my $subaddress = $$self{pending_adlb}{data3}; - if ($subaddress ne '00' and $subaddress ne '01') { - $key .= $subaddress; - } - delete $$self{adlb}{$key}; - } - - if (defined $$self{_mem_callback}) { - my $callback = $$self{_mem_callback}; - # clear it out *before* the eval - $$self{_mem_callback} = undef; - package main; - eval ($callback); - &::print_log("[Insteon_Device] error in link callback: " . $@) - if $@ and $main::Debug{insteon}; - package Insteon_Device; - $$self{_mem_callback} = undef; - } - } -# -} - -sub _on_peek -{ - my ($self,%msg) = @_; - if ($msg{is_extended}) { - &::print_log("Insteon_Device: extended peek for " . $self->{object_name} - . " is " . $msg{extra}) if $main::Debug{insteon}; - } else { - if ($$self{_mem_action} eq 'adlb_peek') { - if ($$self{_mem_activity} eq 'scan') { - $$self{_mem_action} = 'adlb_flag'; - # if the device is responding to the peek, then init the link table - # if at the very start of a scan - if (lc $$self{_mem_msb} eq '0f' and lc $$self{_mem_lsb} eq 'f8') { - # reinit the adlb hash as there will be a new one - $$self{adlb} = undef; - # reinit the empty address list - @{$$self{adlb}{empty}} = (); - # and, also the duplicates list - @{$$self{adlb}{duplicates}} = (); - } - } elsif ($$self{_mem_activity} eq 'update') { - $$self{_mem_action} = 'adlb_data1'; - } elsif ($$self{_mem_activity} eq 'update_local') { - $$self{_mem_action} = 'local_onlevel'; - } elsif ($$self{_mem_activity} eq 'update_flags') { - $$self{_mem_action} = 'update_flags'; - } elsif ($$self{_mem_activity} eq 'delete') { - $$self{_mem_action} = 'adlb_flag'; - } elsif ($$self{_mem_activity} eq 'add') { - $$self{_mem_action} = 'adlb_flag'; - } - $self->_send_cmd('command' => 'peek', 'extra' => $$self{_mem_lsb}, 'is_synchronous' => 1); - } elsif ($$self{_mem_action} eq 'adlb_flag') { - if ($$self{_mem_activity} eq 'scan') { - my $flag = hex($msg{extra}); - $$self{pending_adlb}{inuse} = ($flag & 0x80) ? 1 : 0; - $$self{pending_adlb}{is_controller} = ($flag & 0x40) ? 1 : 0; - $$self{pending_adlb}{highwater} = ($flag & 0x02) ? 1 : 0; - if (!($$self{pending_adlb}{highwater})) { - # since this is the last unused memory location, then add it to the empty list - unshift @{$$self{adlb}{empty}}, $$self{_mem_msb} . $$self{_mem_lsb}; - $$self{_mem_action} = undef; - # clear out mem_activity flag - $$self{_mem_activity} = undef; - &::print_log("[Insteon_Device] " . $self->get_object_name . " completed link memory scan") - if $main::Debug{insteon}; - if (defined $$self{_mem_callback}) { - package main; - eval ($$self{_mem_callback}); - &::print_log("[Insteon_Device] " . $self->get_object_name . ": error during scan callback $@") - if $@ and $main::Debug{insteon}; - package Insteon_Device; - $$self{_mem_callback} = undef; - } - # ping the device as part of the scan if we don't already have a devcat - if (!($self->{devcat})) { - $self->ping(); - } - } else { - $$self{pending_adlb}{flag} = $msg{extra}; - ## confirm that we have a high-water mark; otherwise stop - $$self{pending_adlb}{address} = $$self{_mem_msb} . $$self{_mem_lsb}; - $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); - $$self{_mem_action} = 'adlb_group'; - $self->_send_cmd('command' => 'peek', 'extra' => $$self{_mem_lsb}, 'is_synchronous' => 1); - } - } elsif ($$self{_mem_activity} eq 'add') { - my $flag = ($$self{pending_adlb}{is_controller}) ? 'E2' : 'A2'; - $$self{pending_adlb}{flag} = $flag; - $self->_send_cmd('command' => 'poke', 'extra' => $flag, 'is_synchronous' => 1); - } elsif ($$self{_mem_activity} eq 'delete') { - $self->_send_cmd('command' => 'poke', 'extra' => '02', 'is_synchronous' => 1); - } - } elsif ($$self{_mem_action} eq 'adlb_group') { - if ($$self{_mem_activity} eq 'scan') { - $$self{pending_adlb}{group} = lc $msg{extra}; - $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); - $$self{_mem_action} = 'adlb_devhi'; - $self->_send_cmd('command' => 'peek', 'extra' => $$self{_mem_lsb}, - 'is_synchronous' => 1); - } else { - $self->_send_cmd('command' => 'poke', 'extra' => $$self{pending_adlb}{group}, - 'is_synchronous' => 1); - } - } elsif ($$self{_mem_action} eq 'adlb_devhi') { - if ($$self{_mem_activity} eq 'scan') { - $$self{pending_adlb}{deviceid} = lc $msg{extra}; - $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); - $$self{_mem_action} = 'adlb_devmid'; - $self->_send_cmd('command' => 'peek', 'extra' => $$self{_mem_lsb}, 'is_synchronous' => 1); - } elsif ($$self{_mem_activity} eq 'add') { - my $devid = substr($$self{pending_adlb}{deviceid},0,2); - $self->_send_cmd('command' => 'poke', 'extra' => $devid, 'is_synchronous' => 1); - } - } elsif ($$self{_mem_action} eq 'adlb_devmid') { - if ($$self{_mem_activity} eq 'scan') { - $$self{pending_adlb}{deviceid} .= lc $msg{extra}; - $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); - $$self{_mem_action} = 'adlb_devlo'; - $self->_send_cmd('command' => 'peek', 'extra' => $$self{_mem_lsb}, 'is_synchronous' => 1); - } elsif ($$self{_mem_activity} eq 'add') { - my $devid = substr($$self{pending_adlb}{deviceid},2,2); - $self->_send_cmd('command' => 'poke', 'extra' => $devid, 'is_synchronous' => 1); - } - } elsif ($$self{_mem_action} eq 'adlb_devlo') { - if ($$self{_mem_activity} eq 'scan') { - $$self{pending_adlb}{deviceid} .= lc $msg{extra}; - $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); - $$self{_mem_action} = 'adlb_data1'; - $self->_send_cmd('command' => 'peek', 'extra' => $$self{_mem_lsb}, 'is_synchronous' => 1); - } elsif ($$self{_mem_activity} eq 'add') { - my $devid = substr($$self{pending_adlb}{deviceid},4,2); - $self->_send_cmd('command' => 'poke', 'extra' => $devid, 'is_synchronous' => 1); - } - } elsif ($$self{_mem_action} eq 'adlb_data1') { - if ($$self{_mem_activity} eq 'scan') { - $$self{_mem_action} = 'adlb_data2'; - $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); - $$self{pending_adlb}{data1} = $msg{extra}; - $self->_send_cmd('command' => 'peek', 'extra' => $$self{_mem_lsb}, 'is_synchronous' => 1); - } elsif ($$self{_mem_activity} eq 'update' or $$self{_mem_activity} eq 'add') { - # poke the new value - $self->_send_cmd('command' => 'poke', 'extra' => $$self{pending_adlb}{data1}, 'is_synchronous' => 1); - } - } elsif ($$self{_mem_action} eq 'adlb_data2') { - if ($$self{_mem_activity} eq 'scan') { - $$self{pending_adlb}{data2} = $msg{extra}; - $$self{_mem_lsb} = sprintf("%02X", hex($$self{_mem_lsb}) + 1); - $$self{_mem_action} = 'adlb_data3'; - $self->_send_cmd('command' => 'peek', 'extra' => $$self{_mem_lsb}, 'is_synchronous' => 1); - } elsif ($$self{_mem_activity} eq 'update' or $$self{_mem_activity} eq 'add') { - # poke the new value - $self->_send_cmd('command' => 'poke', 'extra' => $$self{pending_adlb}{data2}, 'is_synchronous' => 1); - } - } elsif ($$self{_mem_action} eq 'adlb_data3') { - if ($$self{_mem_activity} eq 'scan') { - $$self{pending_adlb}{data3} = $msg{extra}; - # check the previous record if highwater is set - if ($$self{pending_adlb}{highwater}) { - if ($$self{pending_adlb}{inuse}) { - # save pending_adlb and then clear it out - my $adlbkey = lc $$self{pending_adlb}{deviceid} - . $$self{pending_adlb}{group} - . $$self{pending_adlb}{is_controller}; - # append the device "sub-address" (e.g., a non-root button on a keypadlinc) if it exists - my $subaddress = $$self{pending_adlb}{data3}; - if ($subaddress ne '00' and $subaddress ne '01') { - $adlbkey .= $subaddress; - } - # check for duplicates - if (exists $$self{adlb}{$adlbkey} && $$self{adlb}{$adlbkey}{inuse}) { - unshift @{$$self{adlb}{duplicates}}, $$self{pending_adlb}{address}; - } else { - %{$$self{adlb}{$adlbkey}} = %{$$self{pending_adlb}}; - } - } else { - # TO-DO: record the locations of deleted ADLB records for subsequent reuse - unshift @{$$self{adlb}{empty}}, $$self{pending_adlb}{address}; - } - my $newaddress = sprintf("%04X", hex($$self{pending_adlb}{address}) - 8); - $$self{pending_adlb} = undef; - $self->_peek($newaddress); - } - } elsif ($$self{_mem_activity} eq 'update' or $$self{_mem_activity} eq 'add') { - # poke the new value - $self->_send_cmd('command' => 'poke', 'extra' => $$self{pending_adlb}{data3}, 'is_synchronous' => 1); - } - } elsif ($$self{_mem_action} eq 'local_onlevel') { - my $on_level = $self->local_onlevel; - $on_level = &Insteon_Device::convert_level($on_level); - $self->_send_cmd('command' => 'poke', 'extra' => $on_level, 'is_synchronous' => 1); - } elsif ($$self{_mem_action} eq 'local_ramprate') { - my $ramp_rate = $$self{_ramprate}; - $ramp_rate = '1f' unless $ramp_rate; - $self->_send_cmd('command' => 'poke', 'extra' => $ramp_rate, 'is_synchronous' => 1); - } elsif ($$self{_mem_action} eq 'update_flags') { - my $flags = $$self{_operating_flags}; - $self->_send_cmd('command' => 'poke', 'extra' => $flags, 'is_synchronous' => 1); - } -# -# &::print_log("Insteon_Device: peek for " . $self->{object_name} -# . " is " . $msg{extra}) if $main::Debug{insteon}; - } -} - -sub restore_string -{ - my ($self) = @_; - my $restore_string = $self->SUPER::restore_string(); - if ($$self{adlb}) { - my $adlb = ''; - foreach my $adlb_key (keys %{$$self{adlb}}) { - next unless $adlb_key eq 'empty' || $adlb_key eq 'duplicates' || $$self{adlb}{$adlb_key}{inuse}; - $adlb .= '|' if $adlb; # separate sections - my $record = ''; - if ($adlb_key eq 'empty') { - foreach my $address (@{$$self{adlb}{empty}}) { - $record .= ';' if $record; - $record .= $address; - } - $record = 'empty=' . $record; - } elsif ($adlb_key eq 'duplicates') { - my $duplicate_record = ''; - foreach my $address (@{$$self{adlb}{duplicates}}) { - $duplicate_record .= ';' if $duplicate_record; - $duplicate_record .= $address; - } - $record = 'duplicates=' . $duplicate_record; - } else { - my %adlb_record = %{$$self{adlb}{$adlb_key}}; - foreach my $record_key (keys %adlb_record) { - next unless $adlb_record{$record_key}; - $record .= ',' if $record; - $record .= $record_key . '=' . $adlb_record{$record_key}; - } - } - $adlb .= $record; - } -# &::print_log("[Insteon_Device] ADLB restore string: $adlb") if $main::Debug{insteon}; - $restore_string .= $self->{object_name} . "->restore_adlb(q~$adlb~);\n"; - } - if ($$self{states}) { - my $states = ''; - foreach my $state (@{$$self{states}}) { - $states .= '|' if $states; - $states .= $state; - } - $restore_string .= $self->{object_name} . "->restore_states(q~$states~);\n"; - } - return $restore_string; -} - -sub restore_states -{ - my ($self, $states) = @_; - if ($states) { - @{$$self{states}} = split(/\|/,$states); - } -} - -sub restore_adlb -{ - my ($self,$adlb) = @_; - if ($adlb) { - foreach my $adlb_section (split(/\|/,$adlb)) { - my %adlb_record = (); - my @adlb_empty = (); - my @adlb_duplicates = (); - my $deviceid = ''; - my $groupid = '01'; - my $is_controller = 0; - my $subaddress = '00'; - foreach my $adlb_entry (split(/,/,$adlb_section)) { - my ($key,$value) = split(/=/,$adlb_entry); - next unless $key and defined($value) and $value ne ''; - if ($key eq 'empty') { - @adlb_empty = split(/;/,$value); - } elsif ($key eq 'duplicates') { - @adlb_duplicates = split(/;/,$value); - } else { - $deviceid = lc $value if ($key eq 'deviceid'); - $groupid = lc $value if ($key eq 'group'); - $is_controller = $value if ($key eq 'is_controller'); - $subaddress = $value if ($key eq 'data3'); - $adlb_record{$key} = $value if $key and defined($value); - } - } - if (@adlb_empty) { - @{$$self{adlb}{empty}} = @adlb_empty; - } elsif (@adlb_duplicates) { - @{$$self{adlb}{duplicates}} = @adlb_duplicates; - } elsif (scalar %adlb_record) { - next unless $deviceid; - my $adlbkey = $deviceid . $groupid . $is_controller; - # append the device "sub-address" (e.g., a non-root button on a keypadlinc) if it exists - if ($subaddress ne '00' and $subaddress ne '01') { - $adlbkey .= $subaddress; - } - %{$$self{adlb}{$adlbkey}} = %adlb_record; - } - } -# $self->log_alllink_table(); - } -} - -sub devcat -{ - my ($self, $devcat) = @_; - if ($devcat) { - $$self{devcat} = $devcat; - if (($$self{devcat} =~ /^01\w\w/) or ($$self{devcat} =~ /^02\w\w/) && !($self->states)) { - $self->states( 'on,off' ); - } - } - return $$self{devcat}; -} - -sub states -{ - my ($self, $states) = @_; - if ($states) { - @{$$self{states}} = split(/,/,$states); - } - if ($$self{states}) { - return @{$$self{states}}; - } else { - return undef; - } - -} - -sub is_dimmable -{ - my ($self) = @_; - if (!($self->is_root)) { - return 0; - } else { - if ($$self{devcat}) { - if ($$self{devcat} =~ /^01\w\w/) { - return 1; - } else { - return 0; - } - } else { - &::print_log("[Insteon_Device] WARN: making assumption that " . $self->get_object_name . " is dimmable because devcat is not yet known") - if $main::Debug{insteon}; - return 1; - } - } -} - -sub local_onlevel -{ - my ($self, $p_onlevel) = @_; - if (defined $p_onlevel) { - my ($onlevel) = $p_onlevel =~ /(\d+)%?/; - $$self{_onlevel} = $onlevel; - } - return $$self{_onlevel}; -} - -sub local_ramprate -{ - my ($self, $p_ramprate) = @_; - if (defined $p_ramprate) { - $$self{_ramprate} = &Insteon_Device::convert_ramp($p_ramprate); - } - return $$self{_ramprate}; - -} - -sub set_receive -{ - my ($self, $p_state, $p_setby, $p_response) = @_; - $self->level($p_state); # update the level value - $self->SUPER::set($p_state, $p_setby, $p_response); -} - -sub scan_link_table -{ - my ($self,$callback) = @_; - $$self{_mem_activity} = 'scan'; - $$self{_mem_callback} = ($callback) ? $callback : undef; - $self->_peek('0FF8',0); -} - -sub delete_link -{ - my ($self, $parms_text) = @_; - my %link_parms; - if (@_ > 2) { - shift @_; - %link_parms = @_; - } else { - %link_parms = &main::parse_func_parms($parms_text); - } - if ($link_parms{address}) { - $$self{_mem_callback} = ($link_parms{callback}) ? $link_parms{callback} : undef; - $$self{_mem_activity} = 'delete'; - $$self{pending_adlb}{address} = $link_parms{address}; - $self->_peek($link_parms{address},0); - - } else { - my $insteon_object = $link_parms{object}; - my $deviceid = ($insteon_object) ? $insteon_object->device_id : $link_parms{deviceid}; - my $groupid = $link_parms{group}; - $groupid = '01' unless $groupid; - my $is_controller = ($link_parms{is_controller}) ? 1 : 0; - my $subaddress = ($link_parms{data3}) ? $link_parms{data3} : '00'; - # get the address via lookup into the hash - my $key = lc $deviceid . $groupid . $is_controller; - # append the device "sub-address" (e.g., a non-root button on a keypadlinc) if it exists - if ($subaddress ne '00' and $subaddress ne '01') { - $key .= $subaddress; - } - my $address = $$self{adlb}{$key}{address}; - if ($address) { - &main::print_log("[Insteon_Device] Now deleting link [0x$address] with the following data" - . " deviceid=$deviceid, groupid=$groupid, is_controller=$is_controller"); - # now, alter the flags byte such that the in_use flag is set to 0 - $$self{_mem_callback} = ($link_parms{callback}) ? $link_parms{callback} : undef; - $$self{_mem_activity} = 'delete'; - $$self{pending_adlb}{deviceid} = lc $deviceid; - $$self{pending_adlb}{group} = $groupid; - $$self{pending_adlb}{is_controller} = $is_controller; - $$self{pending_adlb}{address} = $address; - $self->_peek($address,0); - } else { - &main::print_log('[Insteon_Device] WARN: (' . $self->get_object_name . ') attempt to delete link that does not exist!' - . " deviceid=$deviceid, groupid=$groupid, is_controller=$is_controller"); - if ($link_parms{callback}) { - package main; - eval($link_parms{callback}); - &::print_log("[Insteon_Device] error encountered during delete_link callback: " . $@) - if $@ and $main::Debug{insteon}; - package Insteon_Device; - } - } - } -} - -sub delete_orphan_links -{ - my ($self) = @_; - @{$$self{delete_queue}} = (); # reset the work queue - my $selfname = $self->get_object_name; - my $num_deleted = 0; - for my $linkkey (keys %{$$self{adlb}}) { - if ($linkkey ne 'empty' and $linkkey ne 'duplicates') { - my $deviceid = lc $$self{adlb}{$linkkey}{deviceid}; - next unless $deviceid; - my $group = $$self{adlb}{$linkkey}{group}; - my $is_controller = $$self{adlb}{$linkkey}{is_controller}; - my $data3 = $$self{adlb}{$linkkey}{data3}; - my $device = ($deviceid eq lc $self->interface->device_id) ? $self->interface - : $self->interface->get_object($deviceid,'01'); - if (!($device)) { -# &::print_log("[Insteon_Device] " . $self->get_object_name . " now deleting orphaned link w/ details: " -# . (($is_controller) ? "controller" : "responder") -# . ", deviceid=$deviceid, group=$group"); - my %delete_req = (deviceid => $deviceid, group => $group, is_controller => $is_controller, - callback => "$selfname->_process_delete_queue()", cause => "no device could be found"); - push @{$$self{delete_queue}}, \%delete_req; - } elsif ($device->isa("Insteon_PLM") and $is_controller) { - # ignore since this is just a link back to the PLM - } elsif ($device->isa("Insteon_PLM")) { - # does the PLM have a link point back? If not, the delete this one - if (!($device->has_link($self,$group,1))) { - my %delete_req = (deviceid => $deviceid, group => $group, is_controller => $is_controller, - callback => "$selfname->_process_delete_queue()", object => $device, data3 => $data3); - push @{$$self{delete_queue}}, \%delete_req; - $num_deleted++; - } - # is there an entry in the items.mht that corresponds to this link? - if ($is_controller) { - # TO-DO: handle this case - } else { - my $plm_link = $device->get_device('000000',$group); - if ($plm_link) { - my $is_invalid = 1; - foreach my $member_ref (keys %{$$plm_link{members}}) { - my $member = $$plm_link{members}{$member_ref}{object}; - if ($member->isa('Light_Item')) { - my @lights = $member->find_members('Insteon_Device'); - if (@lights) { - $member = @lights[0]; # pick the first - } - } - if ($member->device_id eq $self->device_id) { - if ($data3 eq '00' or (lc $data3 eq lc $member->group)) { - $is_invalid = 0; - last; - } - } - } - if ($is_invalid) { - my %delete_req = (deviceid => $deviceid, group => $group, is_controller => $is_controller, - callback => "$selfname->_process_delete_queue()", object => $device, - cause => "no link is defined for the plm controlled scene", data3 => $data3); - push @{$$self{delete_queue}}, \%delete_req; - $num_deleted++; - } - } else { - # delete the link since it doesn't exist - my %delete_req = (deviceid => $deviceid, group => $group, is_controller => $is_controller, - callback => "$selfname->_process_delete_queue()", object => $device, - cause => "no plm link could be found", data3 => $data3); - push @{$$self{delete_queue}}, \%delete_req; - $num_deleted++; - } - } - } else { - if (!($device->has_link($self,$group,($is_controller) ? 0:1, $data3))) { - my %delete_req = (deviceid => $deviceid, group => $group, is_controller => $is_controller, - callback => "$selfname->_process_delete_queue()", object => $device, - cause => "no link to the device could be found", data3 => $data3); - push @{$$self{delete_queue}}, \%delete_req; - $num_deleted++; - } else { - my $is_invalid = 1; - my $link = ($is_controller) ? $self->interface->get_object($self->device_id,$group) - : $self->interface->get_object($device->device_id,$group); - if ($link) { - foreach my $member_ref (keys %{$$link{members}}) { - my $member = $$link{members}{$member_ref}{object}; - if ($member->isa('Light_Item')) { - my @lights = $member->find_members('Insteon_Device'); - if (@lights) { - $member = @lights[0]; # pick the first - } - } - if ($member->isa('Insteon_Device') and !($member->is_root)) { - $member = $member->get_root; - } - if ($member->isa('Insteon_Device') and !($is_controller) and ($member->device_id eq $self->device_id)) { - $is_invalid = 0; - last; - } elsif ($member->isa('Insteon_Device') and $is_controller and ($member->device_id eq $device->device_id)) { - $is_invalid = 0; - last; - } - - } - } - if ($is_invalid) { - my %delete_req = (deviceid => $deviceid, group => $group, is_controller => $is_controller, - callback => "$selfname->_process_delete_queue()", object => $device, - cause => "no reverse link could be found", data3 => $data3); - push @{$$self{delete_queue}}, \%delete_req; - $num_deleted++; - } - } - } - } elsif ($linkkey eq 'duplicates') { - my $address = pop @{$$self{adlb}{duplicates}}; - while ($address) { - my %delete_req = (address => $address, - callback => "$selfname->_process_delete_queue()", - cause => "duplicate record found"); - push @{$$self{delete_queue}}, \%delete_req; - $num_deleted++; - $address = pop @{$$self{adlb}{duplicates}}; - } - } - } - $$self{delete_queue_processed} = 0; - $self->_process_delete_queue(); - return $num_deleted; -} - -sub _process_delete_queue { - my ($self) = @_; - my $num_in_queue = @{$$self{delete_queue}}; - if ($num_in_queue) { - my $delete_req_ptr = shift(@{$$self{delete_queue}}); - my %delete_req = %$delete_req_ptr; - if ($delete_req{address}) { - &::print_log("[Insteon_Device] " . $self->get_object_name . " now deleting duplicate record at address " - . $delete_req{address}); - } else { - &::print_log("[Insteon_Device] " . $self->get_object_name . " now deleting orphaned link w/ details: " - . (($delete_req{is_controller}) ? "controller" : "responder") - . ", " . (($delete_req{object}) ? "device=" . $delete_req{object}->get_object_name - : "deviceid=$delete_req{deviceid}") . ", group=$delete_req{group}, cause=$delete_req{cause}"); - } - $self->delete_link(%delete_req); - $$self{delete_queue_processed}++; - } else { - $self->interface->_process_delete_queue($$self{delete_queue_processed}); - } -} - -sub add_link -{ - my ($self, $parms_text) = @_; - my %link_parms; - if (@_ > 2) { - shift @_; - %link_parms = @_; - } else { - %link_parms = &main::parse_func_parms($parms_text); - } - my $device_id; - my $insteon_object = $link_parms{object}; - my $group = $link_parms{group}; - if (!(defined($insteon_object))) { - $device_id = lc $link_parms{deviceid}; - $insteon_object = $self->interface->get_object($device_id, $group); - } else { - $device_id = lc $insteon_object->device_id; - } - my $is_controller = ($link_parms{is_controller}) ? 1 : 0; - # check whether the link already exists - my $subaddress = ($link_parms{data3}) ? $link_parms{data3} : '00'; - # get the address via lookup into the hash - my $key = lc $device_id . $group . $is_controller; - # append the device "sub-address" (e.g., a non-root button on a keypadlinc) if it exists - if ($subaddress ne '00' and $subaddress ne '01') { - $key .= $subaddress; - } - if (defined $$self{adlb}{$key}{inuse}) { - &::print_log("[Insteon_Device] WARN: attempt to add link to " . $self->get_object_name . " that already exists! " - . "object=" . $insteon_object->get_object_name . ", group=$group, is_controller=$is_controller"); - if ($link_parms{callback}) { - package main; - eval($link_parms{callback}); - &::print_log("[Insteon_Device] failure occurred in callback eval for " . $self->get_object_name . ":" . $@) - if $@ and $main::Debug{insteon}; - package Insteon_Device; - } - } else { - # strip optional % sign to append on_level - my $on_level = $link_parms{on_level}; - $on_level =~ s/(\d)%?/$1/; - $on_level = '100' unless defined($on_level); # 100% == on is the default - # strip optional s (seconds) to append ramp_rate - my $ramp_rate = $link_parms{ramp_rate}; - $ramp_rate =~ s/(\d)s?/$1/; - $ramp_rate = '0.1' unless $ramp_rate; # 0.1s is the default - &::print_log("[Insteon_Device] adding link record " . $self->get_object_name - . " light level controlled by " . $insteon_object->get_object_name - . " and group: $group with on level: $on_level and ramp rate: $ramp_rate") if $main::Debug{insteon}; - my $data1 = &Insteon_Device::convert_level($on_level); - my $data2 = ($self->is_dimmable) ? &Insteon_Device::convert_ramp($ramp_rate) : '00'; - my $data3 = ($link_parms{data3}) ? $link_parms{data3} : '00'; - # get the first available memory location - my $address = pop @{$$self{adlb}{empty}}; - # TO-DO: ensure that pop'd address is restored back to queue if the transaction fails - $$self{_mem_activity} = 'add'; - $$self{_mem_callback} = ($link_parms{callback}) ? $link_parms{callback} : undef; - $self->_write_link($address, $device_id, $group, $is_controller, $data1, $data2, $data3); - } -} - -sub update_link -{ - my ($self, %link_parms) = @_; - my $insteon_object = $link_parms{object}; - my $group = $link_parms{group}; - my $is_controller = ($link_parms{is_controller}) ? 1 : 0; - # strip optional % sign to append on_level - my $on_level = $link_parms{on_level}; - $on_level =~ s/(\d+)%?/$1/; - # strip optional s (seconds) to append ramp_rate - my $ramp_rate = $link_parms{ramp_rate}; - $ramp_rate =~ s/(\d)s?/$1/; - &::print_log("[Insteon_Device] updating " . $self->get_object_name . " light level controlled by " . $insteon_object->get_object_name - . " and group: $group with on level: $on_level and ramp rate: $ramp_rate") if $main::Debug{insteon}; - my $data1 = sprintf('%02X',$on_level * 2.55); - $data1 = 'ff' if $on_level eq '100'; - $data1 = '00' if $on_level eq '0'; - my $data2 = ($self->is_dimmable) ? &Insteon_Device::convert_ramp($ramp_rate) : '00'; - my $data3 = ($link_parms{data3}) ? $link_parms{data3} : '00'; - my $deviceid = $insteon_object->device_id; - my $subaddress = $data3; - # get the address via lookup into the hash - my $key = lc $deviceid . $group . $is_controller; - # append the device "sub-address" (e.g., a non-root button on a keypadlinc) if it exists - if ($subaddress ne '00' and $subaddress ne '01') { - $key .= $subaddress; - } - my $address = $$self{adlb}{$key}{address}; - $$self{_mem_activity} = 'update'; - $$self{_mem_callback} = ($link_parms{callback}) ? $link_parms{callback} : undef; - $self->_write_link($address, $deviceid, $group, $is_controller, $data1, $data2, $data3); -} - - -sub log_alllink_table -{ - my ($self) = @_; - &::print_log("[Insteon_Device] link table for " . $self->get_object_name . " (devcat: $$self{devcat}):"); - foreach my $adlbkey (sort(keys(%{$$self{adlb}}))) { - next if $adlbkey eq 'empty' or $adlbkey eq 'duplicates'; - my ($device); - my $is_controller = $$self{adlb}{$adlbkey}{is_controller}; - if ($self->interface()->device_id() and ($self->interface()->device_id() eq $$self{adlb}{$adlbkey}{deviceid})) { - $device = $self->interface; - } else { - $device = $self->interface()->get_object($$self{adlb}{$adlbkey}{deviceid},'01'); - } - my $object_name = ($device) ? $device->get_object_name : $$self{adlb}{$adlbkey}{deviceid}; - - my $on_level = 'unknown'; - if (defined $$self{adlb}{$adlbkey}{data1}) { - if ($$self{adlb}{$adlbkey}{data1}) { - $on_level = int((hex($$self{adlb}{$adlbkey}{data1})*100/255) + .5) . "%"; - } else { - $on_level = '0%'; - } - } - - my $rspndr_group = $$self{adlb}{$adlbkey}{data3}; - $rspndr_group = '01' if $rspndr_group eq '00'; - - my $ramp_rate = 'unknown'; - if ($$self{adlb}{$adlbkey}{data2}) { - if (!($self->is_dimmable) or (!($is_controller) and ($rspndr_group != '01'))) { - $ramp_rate = 'none'; - if ($on_level eq '0%') { - $on_level = 'off'; - } else { - $on_level = 'on'; - } - } else { - $ramp_rate = $ramp_h2n{$$self{adlb}{$adlbkey}{data2}} . "s"; - } - } - - &::print_log("[Insteon_Device] aldb $adlbkey [0x" . $$self{adlb}{$adlbkey}{address} . "] " . - (($$self{adlb}{$adlbkey}{is_controller}) ? "contlr($$self{adlb}{$adlbkey}{group}) record to " - . $object_name . "($rspndr_group), (d1:$$self{adlb}{$adlbkey}{data1}, d2:$$self{adlb}{$adlbkey}{data2}, d3:$$self{adlb}{$adlbkey}{data3})" - : "rspndr($rspndr_group) record to " . $object_name . "($$self{adlb}{$adlbkey}{group})" - . ": onlevel=$on_level and ramp=$ramp_rate (d3:$$self{adlb}{$adlbkey}{data3})")) if $main::Debug{insteon}; - } - foreach my $address (@{$$self{adlb}{empty}}) { - &::print_log("[Insteon_Device] adlb [0x$address] is empty"); - } - - foreach my $address (@{$$self{adlb}{duplicates}}) { - &::print_log("[Insteon_Device] adlb [0x$address] holds a duplicate entry"); - } - -} - -sub get_link_record -{ - my ($self,$link_key) = @_; - my %link_record = (); - %link_record = %{$$self{adlb}{$link_key}} if $$self{adlb}{$link_key}; - return %link_record; -} - -sub update_local_properties -{ - my ($self) = @_; - if ($self->is_dimmable) { - $$self{_mem_activity} = 'update_local'; - $self->_peek('0032'); # 0032 is the address for the onlevel - } else { - &::print_log("[Insteon_Device] update_local_properties may only be applied to dimmable devices!"); - } -} - -sub update_flags -{ - my ($self, $flags) = @_; - if (!($self->is_keypadlinc)) { - &::print_log("[Insteon_Device] Operating flags may only be revised on keypadlincs!"); - return; - } - return unless defined $flags; - - $$self{_mem_activity} = 'update_flags'; - $$self{_operating_flags} = $flags; - $self->_peek('0023'); -} - - -sub has_link -{ - my ($self, $insteon_object, $group, $is_controller, $subaddress) = @_; - my $key = lc $insteon_object->device_id . $group . $is_controller; - $subaddress = '00' unless $subaddress; - # append the device "sub-address" (e.g., a non-root button on a keypadlinc) if it exists - if ($subaddress ne '00' and $subaddress ne '01') { - $key .= $subaddress; - } - return (defined $$self{adlb}{$key}) ? 1 : 0; -} - -sub _write_link -{ - my ($self, $address, $deviceid, $group, $is_controller, $data1, $data2, $data3) = @_; - if ($address) { - &::print_log("[Insteon_Device] " . $self->get_object_name . " address: $address found for device: $deviceid and group: $group"); - # change address for start of change to be address + offset - if ($$self{_mem_activity} eq 'update') { - $address = sprintf('%04X',hex($address) + 5); - } - $$self{pending_adlb}{address} = $address; - $$self{pending_adlb}{deviceid} = lc $deviceid; - $$self{pending_adlb}{group} = lc $group; - $$self{pending_adlb}{is_controller} = $is_controller; - $$self{pending_adlb}{data1} = (defined $data1) ? lc $data1 : '00'; - $$self{pending_adlb}{data2} = (defined $data2) ? lc $data2 : '00'; - # Note: if device is a KeypadLinc, then $data3 must be assigned the value of the applicable button (01) - if (($self->is_keypadlinc) and ($data3 eq '00')) { - &::print_log("[Insteon_Device] setting data3 to " . $self->group . " for this keypadlinc") - if $main::Debug{insteon}; - $data3 = $self->group; - } - $$self{pending_adlb}{data3} = (defined $data3) ? lc $data3 : '00'; - $self->_peek($address); - } else { - &::print_log("[Insteon_Device] WARN: " . $self->get_object_name - . " write_link failure: no address available for record to device: $deviceid and group: $group" . - " and is_controller: $is_controller");; - } -} - -sub _peek -{ - my ($self, $address, $extended) = @_; - my $msb = substr($address,0,2); - my $lsb = substr($address,2,2); - if ($extended) { - $$self{interface}->set($self->_xlate_mh_insteon('peek','extended', - $lsb . "0000000000000000000000000000"),$self); - } else { - $$self{_mem_lsb} = $lsb; - $$self{_mem_msb} = $msb; - $$self{_mem_action} = 'adlb_peek'; - &::print_log("[Insteon_Device] " . $self->get_object_name . " accessing memory at location: 0x" . $address); - $self->_send_cmd('command' => 'set_address_msb', 'extra' => $msb, 'is_synchronous' => 1); - } -} - - -1; diff --git a/lib/Insteon_Irrigation.pm b/lib/Insteon_Irrigation.pm index 7a51da619..eed06845c 100644 --- a/lib/Insteon_Irrigation.pm +++ b/lib/Insteon_Irrigation.pm @@ -183,4 +183,4 @@ sub _is_info_request { # Overload methods we don't use, but would otherwise cause Insteon traffic. sub request_status { return 0 } - 1; \ No newline at end of file +1; \ No newline at end of file diff --git a/lib/Insteon_Link.pm b/lib/Insteon_Link.pm deleted file mode 100644 index beb4160ae..000000000 --- a/lib/Insteon_Link.pm +++ /dev/null @@ -1,429 +0,0 @@ -=begin comment -@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - -File: - Insteon_Link.pm - -Description: - Generic class implementation of a Insteon Device. - -Author(s): - Gregg Liming / gregg@limings.net - Jason Sharpee / jason@sharpee.com - -License: - This free software is licensed under the terms of the GNU public license. - -Usage: - - $insteon_family_movie = new Insteon_Device($myPIM,30,1); - - $insteon_familty_movie->set("on"); - -Special Thanks to: - Brian Warren for signficant testing and patches - Bruce Winter - MH - -@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -=cut - -use Insteon_Device; - -use strict; -package Insteon_Link; - -@Insteon_Link::ISA = ('Insteon_Device'); - -my %message_types = ( - %SUPER::message_types -); - -sub new -{ - my ($class,$p_interface,$p_deviceid,$p_devcat) = @_; - - # note that $p_deviceid will be 00.00.00: if the link uses the interface as the controller - my $self = $class->SUPER::new($p_interface,$p_deviceid,$p_devcat); - bless $self,$class; -# don't apply ping timer to this class - $$self{ping_timer}->stop(); - return $self; -} - -sub add -{ - my ($self, $obj, $on_level, $ramp_rate) = @_; - if (ref $obj and (($obj->isa('Insteon_Device') and !($obj->is_plm_controlled)) or $obj->isa('Light_Item'))) { - if ($$self{members} && $$self{members}{$obj}) { - print "[Insteon_Link] An object (" . $obj->{object_name} . ") already exists " - . "in this scene. Aborting add request.\n"; - return; - } - if ($on_level =~ /^sur/i) { - $on_level = '100%'; - $$obj{surrogate} = $self; - } elsif (lc $on_level eq 'on') { - $on_level = '100%'; - } elsif (lc $on_level eq 'off') { - $on_level = '0%'; - } - $on_level = '100%' unless $on_level; - $$self{members}{$obj}{on_level} = $on_level; - $$self{members}{$obj}{object} = $obj; - $ramp_rate =~ s/s$//i; - $$self{members}{$obj}{ramp_rate} = $ramp_rate if defined $ramp_rate; - } else { - &::print_log("[Insteon_Link] WARN: unable to add $obj as items of this type are not supported!"); - } -} - -sub sync_links -{ - my ($self, $callback) = @_; - @{$$self{sync_queue}} = (); # reset the work queue - $$self{sync_queue_callback} = ($callback) ? $callback : undef; - my $insteon_object = $self->interface; - if (!($self->is_plm_controlled)) { - $insteon_object = $self->interface->get_object($self->device_id,'01'); - if (!(defined($insteon_object))) { - &main::print_log("[Insteon_Link] WARN!! A device w/ insteon address: " . $self->device_id . ":01 could not be found. " - . "Please double check your items.mht file."); - } - } - my $self_link_name = $self->get_object_name; - # abort if $insteon_object doesn't exist - $self->_process_sync_queue() unless $insteon_object; - if ($$self{members}) { - foreach my $member_ref (keys %{$$self{members}}) { - my $member = $$self{members}{$member_ref}{object}; - # find real device if member is a Light_Item - if ($member->isa('Light_Item')) { - my @children = $member->find_members('Insteon_Device'); - $member = $children[0]; - } - my $linkmember = $member; - # find real device if member's group is not '01'; for example, cross-linked KeypadLincs - if ($member->group ne '01') { - $member = $self->interface->get_object($member->device_id,'01'); - } - my $tgt_on_level = $$self{members}{$member_ref}{on_level}; - $tgt_on_level = '100%' unless defined $tgt_on_level; - - my $tgt_ramp_rate = $$self{members}{$member_ref}{ramp_rate}; - $tgt_ramp_rate = '0' unless defined $tgt_ramp_rate; - # first, check existance for each link; if found, then perform an update (unless link is to PLM) - # if not, then add the link - if ($member->has_link($insteon_object, $self->group, 0, $linkmember->group)) { - # TO-DO: only update link if the on_level and ramp_rate are different - my $requires_update = 0; - $tgt_on_level =~ s/(\d+)%?/$1/; - $tgt_ramp_rate =~ s/(\d)s?/$1/; - my $adlbkey = lc $insteon_object->device_id . $self->group . '0'; - if ($member->is_keypadlinc and $linkmember->group ne '01') { - $adlbkey .= $linkmember->group; - } - if (!($member->is_dimmable)) { - if ($tgt_on_level >= 1 and $$member{adlb}{$adlbkey}{data1} ne 'ff') { - $requires_update = 1; - $tgt_on_level = 100; - } elsif ($tgt_on_level == 0 and $$member{adlb}{$adlbkey}{data1} ne '00') { - $requires_update = 1; - } - if ($$member{adlb}{$adlbkey}{data2} ne '00') { - $tgt_ramp_rate = 0; - } - } else { - $tgt_ramp_rate = 0.1 unless $tgt_ramp_rate; - my $link_on_level = hex($$member{adlb}{$adlbkey}{data1})/2.55; - my $raw_ramp_rate = $$member{adlb}{$adlbkey}{data2}; - my $link_ramp_rate = &Insteon_Device::get_ramp_from_code($raw_ramp_rate); - if ($link_ramp_rate != $tgt_ramp_rate) { - $requires_update = 1; - } elsif (($link_on_level > $tgt_on_level + 1) or ($link_on_level < $tgt_on_level -1)) { - $requires_update = 1; - } - } - if ($requires_update) { - my %link_req = ( member => $member, cmd => 'update', object => $insteon_object, - group => $self->group, is_controller => 0, - on_level => $tgt_on_level, ramp_rate => $tgt_ramp_rate, - callback => "$self_link_name->_process_sync_queue()" ); - # set data3 is device is a KeypadLinc - if ($member->is_keypadlinc) { - $link_req{data3} = $linkmember->group; - } - push @{$$self{sync_queue}}, \%link_req; - } - } else { - my %link_req = ( member => $member, cmd => 'add', object => $insteon_object, - group => $self->group, is_controller => 0, - on_level => $tgt_on_level, ramp_rate => $tgt_ramp_rate, - callback => "$self_link_name->_process_sync_queue()" ); - # set data3 is device is a KeypadLinc - if ($member->is_keypadlinc) { - $link_req{data3} = $linkmember->group; - } - push @{$$self{sync_queue}}, \%link_req; - } - if (!($insteon_object->has_link($member, $self->group, 1, $linkmember->group))) { - my %link_req = ( member => $insteon_object, cmd => 'add', object => $member, - group => $self->group, is_controller => 1, - callback => "$self_link_name->_process_sync_queue()" ); - # set data3 is device is a KeypadLinc - if ($member->is_keypadlinc) { - $link_req{data3} = $linkmember->group; - } - push @{$$self{sync_queue}}, \%link_req; - } - } - } - # if not a plm controlled link, then confirm that a link back to the plm exists - if (!($self->is_plm_controlled)) { - my $subaddress = ($self->is_keypadlinc) ? $self->group : '00'; - if (!($insteon_object->has_link($self->interface,$self->group,1,$subaddress))) { - my %link_req = ( member => $insteon_object, cmd => 'add', object => $self->interface, - group => $self->group, is_controller => 1, - callback => "$self_link_name->_process_sync_queue()" ); - $link_req{data3} = $self->group if $insteon_object->is_keypadlinc; - push @{$$self{sync_queue}}, \%link_req; - } - if (!($self->interface->has_link($insteon_object,$self->group,0,$subaddress))) { - my %link_req = ( member => $self->interface, cmd => 'add', object => $insteon_object, - group => $self->group, is_controller => 0, - callback => "$self_link_name->_process_sync_queue()" ); - push @{$$self{sync_queue}}, \%link_req; - } - } - my $num_sync_queue = @{$$self{sync_queue}}; - if (!($num_sync_queue)) { - &::print_log("[Insteon_Link] Nothing to do when syncing links for " . $self->get_object_name) - if $main::Debug{insteon}; - } - $self->_process_sync_queue(); - - # TO-DO: consult links table to determine if any "orphaned links" refer to this device; if so, then delete - # WARN: can't immediately do this as the link tables aren't finalized on the above operations - # until the end of the actual insteon memory poke sequences; therefore, may need to handle separately -} - -sub _process_sync_queue { - my ($self) = @_; - # get next in queue if it exists - my $num_sync_queue = @{$$self{sync_queue}}; - if ($num_sync_queue) { - my $link_req_ptr = shift(@{$$self{sync_queue}}); - my %link_req = %$link_req_ptr; - if ($link_req{cmd} eq 'update') { - my $link_member = $link_req{member}; - $link_member->update_link(%link_req); - } elsif ($link_req{cmd} eq 'add') { - my $link_member = $link_req{member}; - $link_member->add_link(%link_req); - } - } elsif ($$self{sync_queue_callback}) { - package main; - eval ($$self{sync_queue_callback}); - &::print_log("[Insteon_Link] error in sync links callback: " . $@) - if $@ and $main::Debug{insteon}; - $$self{sync_queue_callback} = undef; - package Insteon_link; - } -} - -sub set -{ - my ($self, $p_state, $p_setby, $p_respond) = @_; - return if &main::check_for_tied_filters($self, $p_state); - - # prevent setby internal Insteon_Device timers - return if $p_setby eq $$self{ping_timer}; - if (ref $p_setby and $p_setby eq $$self{queue_timer}) { - $self->_process_command_stack(); - return; - } - - my $link_state = 'on'; - if ($p_state eq 'off') { - $link_state = 'off'; - } elsif ($p_state =~ /\d+%?/) { - my ($dim_state) = $p_state =~ /(\d+)%?/; - $link_state = 'off' if $dim_state == 0; - } - if ($self->is_plm_controlled or !($self->is_root)) { - # iterate over the members - if ($$self{members}) { - foreach my $member_ref (keys %{$$self{members}}) { - my $member = $$self{members}{$member_ref}{object}; - my $on_state = $$self{members}{$member_ref}{on_level}; - $on_state = '100%' unless $on_state; - my $local_state = $on_state; - $local_state = 'on' if $local_state eq '100%' - && $member->isa('Insteon_Device') && !($member->is_root); - $local_state = 'off' if $local_state eq '0%' or $link_state eq 'off'; - if ($member->isa('Light_Item')) { - # if they are Light_Items, then set their on_dim attrib to the member on level - # and then "blank" them via the manual method for a tad over the ramp rate - # In addition, locate the Light_Item's Insteon_Device member and do the - # same as if the member were an Insteon_Device - my $ramp_rate = $$self{members}{$member_ref}{ramp_rate}; - $ramp_rate = 0 unless defined $ramp_rate; - $ramp_rate = $ramp_rate + 2; - my @lights = $member->find_members('Insteon_Device'); - if (@lights) { - my $light = @lights[0]; - # remember the current state to support resume - $$self{members}{$member_ref}{resume_state} = $light->state; - $member->manual($light, $ramp_rate); - $light->set_receive($local_state,$self); - } else { - $member->manual(1, $ramp_rate); - } - $member->set_on_state($local_state) unless $link_state eq 'off'; - } elsif ($member->isa('Insteon_Device')) { - # remember the current state to support resume - $$self{members}{$member_ref}{resume_state} = $member->state; - # if they are Insteon_Device objects, then simply set_receive their state to - # the member on level - $member->set_receive($local_state,$self); - } - } - } - } - if ($self->is_keypadlinc and !($self->is_root)) { - if (ref $p_setby and $p_setby->isa('Insteon_Device')) { - $self->SUPER::set($p_state, $p_setby, $p_respond); - } elsif (ref $$self{surrogate} && $$self{surrogate}->isa('Insteon_Link')) { - $$self{surrogate}->set($link_state, $p_setby, $p_respond) - unless ref $p_setby and $p_setby eq $self; - } else { - &::print_log("[Insteon_Link] You may not directly attempt to set a keypadlinc's button " - . " unless you have defined a reverse link with the \"surrogate\" keyword"); - } - } else { - $self->SUPER::set((($self->is_root) ? $p_state : $link_state), $p_setby, $p_respond); - } -} - -sub update_members -{ - my ($self) = @_; - # iterate over the members - if ($$self{members}) { - foreach my $member_ref (keys %{$$self{members}}) { - my ($device); - my $member = $$self{members}{$member_ref}{object}; - my $on_state = $$self{members}{$member_ref}{on_level}; - $on_state = '100%' unless $on_state; - my $ramp_rate = $$self{members}{$member_ref}{ramp_rate}; - $ramp_rate = 0 unless defined $ramp_rate; - if ($member->isa('Light_Item')) { - # if they are Light_Items, then locate the Light_Item's Insteon_Device member - my @lights = $member->find_members('Insteon_Device'); - if (@lights) { - $device = @lights[0]; - } - } elsif ($member->isa('Insteon_Device')) { - $device = $member; - } - if ($device) { - my %current_record = $device->get_link_record($self->device_id . $self->group); - if (%current_record) { - &::print_log("[Insteon_Link] remote record: $current_record{data1}") - if $::Debug{insteon}; - } - } - } - } -} - -sub link_to_interface -{ - my ($self, $p_group, $p_data3) = @_; - my $group = $p_group; - $group = $self->group unless $group; - return if $self->device_id eq '000000'; # don't allow this to be used for PLM links - # get the surrogate device for this if group is not '01' - if ($self->group ne '01') { - my $surrogate_obj = $self->interface->get_object($self->device_id,'01'); - if ($p_data3) { - $surrogate_obj->link_to_interface($group,$p_data3); - } elsif ($surrogate_obj->is_keypadlinc) { - $surrogate_obj->link_to_interface($group,$self->group); - } else { - $surrogate_obj->link_to_interface($group); - } - # next, if the link is a keypadlinc, then create the reverse link to permit - # control over the button's light - if ($surrogate_obj->is_keypadlinc) { - - } - } else { - if ($p_data3) { - $self->SUPER::link_to_interface($group, $p_data3); - } else { - $self->SUPER::link_to_interface($group); - } - } -} - -sub unlink_to_interface -{ - my ($self,$p_group) = @_; - my $group = $p_group; - $group = $self->group unless $group; - return if $self->device_id eq '000000'; # don't allow this to be used for PLM links - # get the surrogate device for this if group is not '01' - if ($self->group ne '01') { - my $surrogate_obj = $self->interface->get_object($self->device_id,'01'); - $surrogate_obj->unlink_to_interface($group); - # next, if the link is a keypadlinc, then delete the reverse link to permit - # control over the button's light - if ($surrogate_obj->is_keypadlinc) { - - } - } else { - $self->SUPER::unlink_to_interface($group); - } -} - -sub initiate_linking_as_controller -{ - my ($self, $p_group) = @_; - # iterate over the members - if ($$self{members}) { - foreach my $member_ref (keys %{$$self{members}}) { - my $member = $$self{members}{$member_ref}{object}; - if ($member->isa('Light_Item')) { - # if they are Light_Items, then set them to manual to avoid automation - # while manually setting light parameters - $member->manual(1,120,120); # 120 seconds should be enough - } - } - } - $self->interface()->initiate_linking_as_controller($p_group); -} - -sub _xlate_mh_insteon -{ - my ($self, $p_state, $p_type, $p_extra) = @_; - if ($self->is_root) { - return $self->SUPER::_xlate_mh_insteon($p_state, $p_type, $p_extra); - } else { - return $self->SUPER::_xlate_mh_insteon($p_state, 'broadcast', $p_extra); - } -} - -sub request_status -{ - my ($self,$requestor) = @_; - if (!($self->is_root) and (!(ref $requestor) or ($requestor eq $self))) { - &::print_log("[Insteon_Link] requesting status for members of " . $$self{object_name}); - foreach my $member (keys %{$$self{members}}) { - $$self{members}{$member}{object}->request_status($self); - } - } else { - $self->SUPER::request_status($requestor); - } -} - -1; \ No newline at end of file diff --git a/lib/Insteon_PLM.pm b/lib/Insteon_PLM.pm index 6cca4cda5..52c2e097b 100644 --- a/lib/Insteon_PLM.pm +++ b/lib/Insteon_PLM.pm @@ -1,1469 +1,707 @@ -=begin comment -@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - -File: - Insteon_PLM.pm - -Description: - - This is the base interface class for Insteon Power Line Modem (PLM) - - For more information regarding the technical details of the PLM: - http://www.smarthome.com/manuals/2412sdevguide.pdf - -Author(s): - Jason Sharpee / jason@sharpee.com - Gregg Liming / gregg@limings.net - -License: - This free software is licensed under the terms of the GNU public license. GPLv2 - -Usage: - Use these mh.ini parameters to enable this code: - - Insteon_PLM_serial_port=/dev/ttyS4 - - Example initialization: - - $myPLM = new Insteon_PLM("Insteon_PLM"); - - #Turn Light Module ID L5 On - $myPLM->send_plm_cmd(0x0263b900); - $myPLM->send_plm_cmd(0x0263b280); - -Notes: - -Special Thanks to: - Brian Warren for significant testing and patches - Bruce Winter - MH - -@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - - -=cut - -use strict; - -package Insteon_PLM; - -@Insteon_PLM::ISA = ('Serial_Item'); - -my %Insteon_PLM_Data; - -my %plm_commands = ( -#PLM Serial Commands - plm_info => 0x60, - plm_reset => 0x67, - user_user_reset => 0x55, - plm_get_config => 0x73, - plm_set_config => 0x6B, - plm_led_on => 0x6D, - plm_led_off => 0x6E, - plm_button_event => 0x54, - insteon_send => 0x62, - insteon_received => 0x50, - insteon_ext_received => 0x51, - insteon_nak => 0x70, - insteon_ack => 0x71, - x10_send => 0x63, - x10_received => 0x52, - all_link_complete => 0x53, - all_link_clean_failed => 0x56, - all_link_record => 0x57, - all_link_clean_status => 0x58, - all_link_send => 0x61, - all_link_start => 0x64, - rf_sleep => 0x72 -); - -my %x10_house_codes = ( - a => 0x6, - b => 0xE, - c => 0x2, - d => 0xA, - e => 0x1, - f => 0x9, - g => 0x5, - h => 0xD, - i => 0x7, - j => 0xF, - k => 0x3, - l => 0xB, - m => 0x0, - n => 0x8, - o => 0x4, - p => 0xC -); - -my %mh_house_codes = ( - '6' => 'a', - 'e' => 'b', - '2' => 'c', - 'a' => 'd', - '1' => 'e', - '9' => 'f', - '5' => 'g', - 'd' => 'h', - '7' => 'i', - 'f' => 'j', - '3' => 'k', - 'b' => 'l', - '0' => 'm', - '8' => 'n', - '4' => 'o', - 'c' => 'p' -); - -my %x10_unit_codes = ( - 1 => 0x6, - 2 => 0xE, - 3 => 0x2, - 4 => 0xA, - 5 => 0x1, - 6 => 0x9, - 7 => 0x5, - 8 => 0xD, - 9 => 0x7, - 10 => 0xF, - a => 0xF, - 11 => 0x3, - b => 0x3, - 12 => 0xB, - c => 0xB, - 13 => 0x0, - d => 0x0, - 14 => 0x8, - e => 0x8, - 15 => 0x4, - f => 0x4, - 16 => 0xC, - g => 0xC - -); - -my %mh_unit_codes = ( - '6' => '1', - 'e' => '2', - '2' => '3', - 'a' => '4', - '1' => '5', - '9' => '6', - '5' => '7', - 'd' => '8', - '7' => '9', - 'f' => 'a', - '3' => 'b', - 'b' => 'c', - '0' => 'd', - '8' => 'e', - '4' => 'f', - 'c' => 'g' -); - -my %x10_commands = ( - on => 0x2, - j => 0x2, - off => 0x3, - k => 0x3, - bright => 0x5, - l => 0x5, - dim => 0x4, - m => 0x4, - preset_dim1 => 0xA, - preset_dim2 => 0xB, - all_off => 0x0, - p => 0x0, - all_lights_on => 0x1, - o => 0x1, - all_lights_off => 0x6, - status => 0xF, - status_on => 0xD, - status_off => 0xE, - hail_ack => 0x9, - ext_code => 0x7, - ext_data => 0xC, - hail_request => 0x8 -); - -my %mh_commands = ( - '2' => 'J', - '3' => 'K', - '5' => 'L', - '4' => 'M', - 'a' => 'preset_dim1', - 'b' => 'preset_dim2', -# '0' => 'all_off', - '0' => 'P', -# '1' => 'all_lights_on', - '1' => 'O', - '6' => 'all_lights_off', - 'f' => 'status', - 'd' => 'status_on', - 'e' => 'status_off', - '9' => 'hail_ack', - '7' => 'ext_code', - 'c' => 'ext_data', - '8' => 'hail_request' -); - -sub serial_startup { - my ($instance) = @_; - - my $port = $::config_parms{$instance . "_serial_port"}; -# my $speed = $::config_parms{$instance . "_baudrate"}; - my $speed = 19200; - - $Insteon_PLM_Data{$instance}{'serial_port'} = $port; - &::print_log("[Insteon_PLM] serial:$port:$speed"); - &::serial_port_create($instance, $port, $speed,'none','raw'); - - if (1==scalar(keys %Insteon_PLM_Data)) { # Add hooks on first call only - &::MainLoop_pre_add_hook(\&Insteon_PLM::check_for_data, 1); - &::Reload_post_add_hook(\&Insteon_PLM::poll_all, 1); - } -} - - -sub poll_all { - my $scan_at_startup = $::config_parms{Insteon_PLM_scan_at_startup}; - $scan_at_startup = 1 unless defined $scan_at_startup; - $scan_at_startup = 0 unless $main::Save{mh_exit} eq 'normal'; - if ($scan_at_startup) { - for my $port_name (keys %Insteon_PLM_Data) { - my $plm = $Insteon_PLM_Data{$port_name}{'obj'}; - if (defined $plm) { - for my $insteon_device ($plm->find_members('Insteon_Device')) { - if ($insteon_device and $insteon_device->is_root and $insteon_device->is_responder) - { - # don't request status for objects associated w/ other than the primary group - # as they are psuedo links - $insteon_device->request_status() if $insteon_device->group eq '01'; - } - if ($insteon_device->devcat) { - # reset devcat so as to trigger any device specific properties - $insteon_device->devcat($insteon_device->devcat); - } - } - } - } - } -} - - -sub check_for_data { - - for my $port_name (keys %Insteon_PLM_Data) { - my $plm = $Insteon_PLM_Data{$port_name}{'obj'}; - &::check_for_generic_serial_data($port_name) if $::Serial_Ports{$port_name}{object}; - my $data = $::Serial_Ports{$port_name}{data}; - # always check for data first; if it exists, then process; otherwise check if pending commands exist - if ($data) { - #lets turn this into Hex. I hate perl binary funcs - my $data = unpack "H*", $data; - -# $::Serial_Ports{$port_name}{data} = undef; -# main::print_log("PLM $port_name got:$data: [$::Serial_Ports{$port_name}{data}]"); - my $processedNibs; - $processedNibs = $plm->_parse_data($data); - $processedNibs = 0 unless $processedNibs; -# &::print_log("PLM Proc:$processedNibs:" . length($data)); - if (length($data) > $processedNibs) { - $main::Serial_Ports{$port_name}{data}=pack("H*",substr($data,$processedNibs,length($data)-$processedNibs)); - } else { - $main::Serial_Ports{$port_name}{data} = ''; - } - - # if no data being received, then check if any timeouts have expired - } elsif (defined $plm) { - if ($plm->_check_timeout('command') == 1) { - $plm->_clear_timeout('command'); - if ($$plm{xmit_in_progress}) { - &::print_log("[Insteon_PLM] WARN: No acknowledgement from PLM to last command requires forced abort of current command." - . " This may reflect a problem with your environment."); - $$plm{xmit_in_progress} = 0; - pop(@{$$plm{command_stack2}}); # pop the active command off the queue - $plm->send_plm_cmd(); - } else { - &::print_log("[Insteon_PLM] PLM xmit timer expired but no transmission in place. Moving on...") if $main::Debug{insteon}; - } - } elsif ($plm->_check_timeout('xmit') == 1) { - $plm->_clear_timeout('xmit'); - $plm->send_plm_cmd(); - } - } - } -} - -sub new { - my ($class, $port_name, $p_deviceid) = @_; - $port_name = 'Insteon_PLM' if !$port_name; - - my $self = {}; - $$self{state} = ''; - $$self{said} = ''; - $$self{state_now} = ''; - $$self{port_name} = $port_name; - $$self{last_command} = ''; - $$self{xmit_in_progress} = 0; - @{$$self{command_stack2}} = (); - @{$$self{command_history}} = (); - $$self{_prior_data_fragment} = ''; - $$self{retry_count} = 0; - bless $self, $class; - $Insteon_PLM_Data{$port_name}{'obj'} = $self; - $self->device_id($p_deviceid) if defined $p_deviceid; - - $$self{xmit_delay} = $::config_parms{Insteon_PLM_xmit_delay}; - $$self{xmit_delay} = 0.25 unless defined $$self{xmit_delay}; # and $$self{xmit_delay} > 0.125; - &::print_log("[Insteon_PLM] setting default xmit delay to: $$self{xmit_delay}"); - $$self{xmit_x10_delay} = $::config_parms{Insteon_PLM_xmit_x10_delay}; - $$self{xmit_x10_delay} = 0.5 unless defined $$self{xmit_x10_delay} and $$self{xmit_x10_delay} > 0.5; - &::print_log("[Insteon_PLM] setting x10 xmit delay to: $$self{xmit_x10_delay}"); - $self->_clear_timeout('xmit'); - $self->_clear_timeout('command'); - -# $Insteon_PLM_Data{$port_name}{'send_count'} = 0; -# push(@{$$self{states}}, 'on', 'off'); - - return $self; -} - -sub set -{ - my ($self,$p_state,$p_setby,$p_response) = @_; - - my ($package, $filename, $line) = caller; -# &::print_log("PLM xmit:" , $p_setby->{object_name} . ":$p_state:$p_setby"); - - #identify the type of device that sent the request - if ( - $p_setby->isa("X10_Item") or - $p_setby->isa("X10_Switchlinc") or - $p_setby->isa("X10_Appliance") - ) - { - $self->_xlate_mh_x10($p_state,$p_setby); - } elsif ($p_setby->isa("Insteon_Link")) { - # only send out as all-link if the link originates from the plm - if ($p_setby->is_plm_controlled) { - # return the size of the command stack - return $self->send_plm_cmd('0261' . $p_state, $p_setby); - } elsif ($p_setby->is_root) { - # return the size of the command stack - return $self->send_plm_cmd('0262' . $p_state, $p_setby); - } else { - # silently ignore as this is now permitted if via "surrogate" -# &::print_log("[Insteon_PLM] WARN: you may not attempt to set an Insteon_Link unless " -# . "it is a root device (group = 01) or controlled by the PLM. Set request now being ignored"); - } - } elsif ($p_setby->isa("Insteon_Device")) { - return $self->send_plm_cmd('0262' . $p_state, $p_setby); - } else { - $self->_xlate_mh_x10($p_state,$p_setby); - } -} - -# the following is only intended for diagnostic purposes; use at your own risk -sub reset_serial_object { - - my ($self) = @_; - - for my $port_name (keys %Insteon_PLM_Data) { - my $plm_obj = $Insteon_PLM_Data{$port_name}{'obj'}; - next unless $plm_obj eq $self; - my $port = $Insteon_PLM_Data{$port_name}{'serial_port'}; - # delete out the current serial port - my $port_key = $::Serial_Ports{$port_name}{port}; - if ($port_key) { - &::print_log("[Insteon_PLM] clearing serial port: $port_key"); - $::Serial_Ports{object_by_port}{$port_key} = undef; - } - &::print_log("[Insteon_PLM] creating new serial port for $port_name"); - &::serial_port_create($port_name, $port, 19200, 'none', 'raw'); - } - return; -} - - -sub has_link -{ - my ($self, $insteon_object, $group, $is_controller, $subaddress) = @_; - my $key = lc $insteon_object->device_id . $group . $is_controller; - return (defined $$self{links}{$key}) ? 1 : 0; -} - -sub complete_linking_as_responder -{ - my ($self, $group) = @_; - - # it is not clear that group should be anything as the group will be taken from the controller - $group = '01' unless $group; - # set up the PLM as the responder - my $cmd = '0264'; # start all linking - $cmd .= '00'; # responder code - $cmd .= $group; # WARN - must be 2 digits and in hex!! - $self->send_plm_cmd($cmd) -} - -sub scan_link_table -{ - my ($self,$callback) = @_; - $$self{links} = undef; # clear out the old - $$self{_mem_activity} = 'scan'; - $$self{_mem_callback} = ($callback) ? $callback : undef; - $self->get_first_alllink(); -} - -sub initiate_linking_as_controller -{ - my ($self, $group) = @_; - - $group = 'FF' unless $group; - # set up the PLM as the responder - my $cmd = '0264'; # start all linking - $cmd .= '01'; # controller code - $cmd .= $group; # WARN - must be 2 digits and in hex!! - $self->send_plm_cmd($cmd); -} - -sub initiate_unlinking_as_controller -{ - my ($self, $group) = @_; - - $group = 'FF' unless $group; - # set up the PLM as the responder - my $cmd = '0264'; # start all linking - $cmd .= 'FF'; # controller code - $cmd .= $group; # WARN - must be 2 digits and in hex!! - $self->send_plm_cmd($cmd); -} - -sub get_first_alllink -{ - my ($self) = @_; - $self->send_plm_cmd('0269'); -} - -sub get_next_alllink -{ - my ($self) = @_; - $self->send_plm_cmd('026A'); -} - -sub cancel_linking -{ - my ($self) = @_; - $self->send_plm_cmd('0265'); -} - -sub _is_duplicate -{ - my ($self, $cmd) = @_; - my $duplicate_detected = 0; - # check for duplicates of $cmd already in command_stack and ignore if they exist - foreach my $cmdrec (@{$$self{command_stack2}}) { - if (($cmdrec->{cmd} eq $cmd) and ($cmd !~ /^0263/)) { - $duplicate_detected = 1; - last; - } - } - return $duplicate_detected; -} - -sub send_plm_cmd -{ - my ($self, $cmd, $p_setby) = @_; - - my $command_queue_size = @{$$self{command_stack2}}; - return $command_queue_size unless $cmd or !($$self{xmit_in_progress}); - - # get pending command record - my $cmdptr = pop(@{$$self{command_stack2}}); - my %cmd_record = (); - my $pending_cmd = ''; - my $pending_callback = ''; - if ($cmdptr) { - %cmd_record = %$cmdptr; - $pending_cmd = $cmd_record{cmd}; - $pending_callback = $cmd_record{callback}; - #put the command back into the stack.. Its not our job to tamper with this array - push(@{$$self{command_stack2}},\%cmd_record) if %cmd_record; - } - - #queue any new command ($cmd) - if (defined $cmd and $cmd ne '') - { - if ($self->_is_duplicate($cmd)) { - &main::print_log("[Insteon_PLM] Attempt to queue command already in queue; skipping ...") if $main::Debug{insteon}; - } else { - my $queue_size = @{$$self{command_stack2}}; - &main::print_log("[Insteon_PLM] Command stack size: $queue_size") if $queue_size > 0 and $main::Debug{insteon}; - # &::print_log("PLM Add Command:" . $cmd . ":XmitInProgress:" . $$self{xmit_in_progress} . ":" ); - my %cmd_record = (); - $cmd_record{cmd} = $cmd; - $cmd_record{queue_time} = $::Time; - if ($p_setby and ref($p_setby) and $p_setby->can('set_retry_timeout') - and $p_setby->get_object_name) { - $cmd_record{callback} = $p_setby->get_object_name . "->set_retry_timeout()"; -#print "setting callback to $cmd_record{callback}\n"; - } - # pending command becomes the newest queued command if stack is empty - unless ($pending_cmd) { - $pending_cmd = $cmd; - $pending_callback = $cmd_record{callback}; - } - unshift(@{$$self{command_stack2}},\%cmd_record); - } - } - #we dont transmit on top of another xmit - if (!($$self{xmit_in_progress})) { - #always send the oldest command first - if (defined $pending_cmd and $pending_cmd ne '') - { - my $prior_cmd_time = pop(@{$$self{command_history}}); - while ($prior_cmd_time) { - if ($::Time - $prior_cmd_time > 1) { - $prior_cmd_time = pop(@{$$self{command_history}}); - } else { - # put it back on the queue; we're done - push(@{$$self{command_history}}, $prior_cmd_time); - $prior_cmd_time = 0; - } - } - my $past_cmds_in_history = @{$$self{command_history}}; - # need logic to change based upon whether the command is x10 or not -# &::print_log("[Insteon_PLM] num commands in past 1 seconds: $past_cmds_in_history") if $main::Debug{insteon}; - if ($past_cmds_in_history > 3 and !($::config_parms{Insteon_PLM_disable_throttling})) { - &::print_log("[Insteon_PLM] num commands in 1 second exceeded threshold. Now delaying additional transmission for 1 second") if $main::Debug{insteon}; - $self->_set_timeout('xmit',1000); - my $command_queue_size = @{$$self{command_stack2}}; - return $command_queue_size; - } - if (!($self->_check_timeout('xmit')==0)) { - $self->_send_cmd($pending_cmd); - if ($pending_callback) { - package main; - eval $pending_callback; - &::print_log("[Insteon_PLM] problem w/ retry callback: $@") if $@; - package Insteon_PLM; - } - } - my $command_queue_size = @{$$self{command_stack2}}; - return $command_queue_size; - } - } else { -# &::print_log("[Insteon_PLM] active transmission; moving on...") if $main::Debug{insteon}; - my $command_queue_size = @{$$self{command_stack2}}; - return $command_queue_size; - } - my $command_queue_size = @{$$self{command_stack2}}; - return $command_queue_size; -} - -sub _send_cmd { - my ($self, $cmd) = @_; - unshift(@{$$self{command_history}},$::Time); - $$self{xmit_in_progress} = 1; - $self->_set_timeout('command',3000); # a commmand needs to be PLM ack'd w/i 3 seconds or it gets dropped - my $instance = $$self{port_name}; - -# &::print_log("PLM: Executing command:$cmd:") unless $main::config_parms{no_log} =~/Insteon_PLM/; - my $data = pack("H*",$cmd); - $main::Serial_Ports{$instance}{object}->write($data); -### Dont overrun the controller.. Its easy, so lets wait a bit -# select(undef,undef,undef,0.15); - #X10 is sloooooow - # however, the ack/nack processing seems to allow some comms (notably insteon) to proceed - # much faster--hence the ability to overide the slow default of 0.5 seconds - my $delay = $$self{xmit_delay}; - if (substr($cmd,0,4) eq '0263') { # is x10; so, be slow - $delay = $$self{xmit_x10_delay}; - } - if ($delay) { - $self->_set_timeout('xmit',$delay * 1000); -# select(undef,undef,undef,$delay); - } - $$self{'last_change'} = $main::Time; -} - - -sub _parse_data { - my ($self, $data) = @_; - my ($name, $val); - - my $processedNibs=0; - - # it is possible that a fragment exists from a previous attempt; so, if it exists, prepend it - if ($$self{_data_fragment}) { - &::print_log("[Insteon_PLM] Prepending prior data fragment: $$self{_data_fragment}") if $main::Debug{insteon}; - $$self{_prior_data_fragment} = $$self{_data_fragment}; - $data = $$self{_data_fragment} . $data; - $$self{_data_fragment} = ''; - } - &::print_log( "[Insteon_PLM] Parsing serial data: $data") if $main::Debug{insteon}; - - # begin by pulling out any PLM ack/nacks - my $prev_cmd = ''; - my $cmdptr = pop(@{$$self{command_stack2}}); - my %cmd_record = (); - if ($cmdptr) { - %cmd_record = %$cmdptr; - $prev_cmd = lc $cmd_record{cmd}; - } - my $residue_data = ''; - my $process_next_command = 0; - my $nack_count = 0; - if (defined $prev_cmd and $prev_cmd ne '') - { -# &::print_log("PLM: Defined:$prev_cmd"); - my $ackcmd = $prev_cmd . '06'; - my $nackcmd = $prev_cmd . '15'; - my $badcmd = $prev_cmd . '0f'; - my $entered_ack_loop = 0; - foreach my $data_1 (split(/($ackcmd)|($nackcmd)|(0260\w{12}06)|(0260\w{12}15)|($badcmd)/,$data)) - { - #ignore blanks.. the split does odd things - next if $data_1 eq ''; - - $entered_ack_loop = 1; - - if ($data_1 =~ /^($ackcmd)|($nackcmd)|(0260\w{12}06)|(0260\w{12}15)|($badcmd)$/) { - $processedNibs+=length($data_1); - my $ret_code = substr($data_1,length($data_1)-2,2); -# &::print_log("PLM: Return code $ret_code"); - if ($ret_code eq '06') { - my $record_type = substr($data_1,0,4); - if ($record_type eq '0260') { - $self->device_id(substr($data_1,4,6)); - $self->firmware(substr($data_1,14,2)); - &::print_log("[Insteon_PLM] PLM id: " . $self->device_id . - " firmware: " . $self->firmware) - if $main::Debug{insteon}; - } elsif ($record_type eq '0269' or $record_type eq '026a') { - $$self{_next_link_ok} = 1; - } - $$self{xmit_in_progress} = 0; - # check to see if it is an all-link and if so, then remember for "cleanup" - if ($data_1 =~ /0261\w{6}06/) { - $$self{pending_alllink} = $prev_cmd; - } - $self->_clear_timeout('command'); - $process_next_command = 1; - $$self{retry_count} = 0; - if (($record_type eq '026f') and $$self{_mem_callback}) { - my $callback = $$self{_mem_callback}; - $$self{_mem_callback} = undef; - package main; - eval ($callback); - &::print_log("[Insteon_PLM] error encountered during ack callback: " . $@) - if $@ and $main::Debug{insteon}; - package Insteon_PLM; - } - } elsif ($ret_code eq '15' or $ret_code eq '0f') { #NAK or "bad" command received - my $record_type = substr($data_1,0,4); - $$self{xmit_in_progress} = 0; - $self->_clear_timeout('command'); - $process_next_command = 1; - if ($record_type eq '0269' or $record_type eq '026a') { - $$self{_next_link_ok} = 0; - $$self{_mem_activity} = undef; - } else { - &::print_log("[Insteon_PLM] Prior cmd failed"); - } - if ($$self{_mem_callback}) { - my $callback = $$self{_mem_callback}; - $$self{_mem_callback} = undef; - package main; - eval ($callback); - &::print_log("[Insteon_PLM] error encountered during nack callback: " . $@) - if $@ and $main::Debug{insteon}; - package Insteon_PLM; - } - } else { - # We have a problem (Usually we stepped on another X10 command) - &::print_log("[Insteon_PLM] Command error: $data_1."); - $$self{xmit_in_progress} = 0; - $self->_clear_timeout('command'); - #move it off the top of the stack and re-transmit later! - #TODO: We should keep track of an errored command and kill it if it fails twice. prevent an infinite loop here - $process_next_command = 1; - } - } else { - $residue_data .= $data_1; - } - } - if (!($process_next_command)) { - # then, didn't get a match and need to push the command back on the stack - unless ($self->_is_duplicate($cmd_record{cmd})) { - push(@{$$self{command_stack2}}, \%cmd_record); - } - } - $residue_data = $data unless $entered_ack_loop; - } else { - $residue_data = $data; - } - - my $entered_rcv_loop = 0; - - foreach my $data_1 (split(/(0252\w{4})|(0250\w{18})|(0251\w{46})|(0253\w{16})|(0256\w{8})|(0257\w{16})|(0258\w{2})|(0254\w{2})/,$residue_data)) - { - #ignore blanks.. the split does odd things - next if $data_1 eq ''; - - $entered_rcv_loop = 1; - - #we found a matching command in stream, add to processed bytes - $processedNibs+=length($data_1); - - if (substr($data_1,0,4) eq '0250') { #Insteon Standard Received - if (length($data_1) != 22) { - $$self{_data_fragment} = $data_1; - } else { - $$self{_data_fragment} .= $data_1 unless $self->delegate($data_1); - } - } elsif (substr($data_1,0,4) eq '0251') { #Insteon Extended Received - if (length($data_1) != 50) { - $$self{_data_fragment} = $data_1; - } else { - $$self{_data_fragment} .= $data_1 unless $self->delegate($data_1); - } - } elsif (substr($data_1,0,4) eq '0252') { #X10 Received - if (length($data_1) != 8) { - $$self{_data_fragment} = $data_1; - } else { - my $x10_data = $self->_xlate_x10_mh($data_1); - &::print_log("[Insteon_PLM] received x10 data: $x10_data") if $main::Debug{insteon} - &::process_serial_data($x10_data,undef,$self); - } - } elsif (substr($data_1,0,4) eq '0253') { #ALL-Linking Completed - if (length($data_1) != 20) { - $$self{_data_fragment} = $data_1; - } else { - my $link_address = substr($data_1,8,6); - &::print_log("[Insteon_PLM] ALL-Linking Completed with $link_address ($data_1)") if $main::Debug{insteon}; - } - } elsif (substr($data_1,0,4) eq '0256') { #ALL-Link Cleanup Failure Report - if (length($data_1) != 12) { - $$self{_data_fragment} = $data_1; - } else { - &::print_log("[Insteon_PLM] ALL-Link Cleanup Failure Report:$data_1") if $main::Debug{insteon}; - } - } elsif (substr($data_1,0,4) eq '0257') { #ALL-Link Record Response - if (length($data_1) != 20) { - $$self{_data_fragment} = $data_1; - } else { - &::print_log("[Insteon_PLM] ALL-Link Record Response:$data_1") if $main::Debug{insteon}; - $self->parse_alllink($data_1); - } - } elsif (substr($data_1,0,4) eq '0258') { #ALL-Link Cleanup Status Report - if (length($data_1) != 6) { - $$self{_data_fragment} = $data_1; - } else { - my $cleanup_ack = substr($data_1,4,2); - if ($cleanup_ack eq '15') { - $$self{retry_count} += 1; - if ($$self{retry_count} < 3) { - &::print_log("[Insteon_PLM] All-Link Cleanup reports failure. Attempting resend") - if $main::Debug{insteon}; - - $self->send_plm_cmd($$self{pending_alllink}) if $$self{pending_alllink}; - } else { - # move on - $$self{retry_count} = 0; - $$self{pending_alllink} = undef; - } - } else { - &::print_log("[Insteon_PLM] ALL-Link Cleanup reports success") if $main::Debug{insteon}; - # attempt to process the message by the link object; this acknowledgement will reset - # the auto-retry timer - if ($$self{pending_alllink}) { - my $group = substr($$self{pending_alllink},4,2); - my $link = $self->get_object('000000',$group); - if ($link) { - my %msg = ('type' => 'cleanup', - 'group' => $group, - 'is_ack' => 1, - 'command' => 'cleanup' - ); - $link->_process_message($self, %msg); - $$self{pending_alllink} = undef; # clear it - } - } - } - } - } elsif (substr($data_1,0,4) eq '0254') { # Button Event Report - # ignore; do nothing - } elsif (substr($data_1,0,2) eq '15') { #NAK Received - if (!($nack_count)) { - my $nack_delay = ($::config_parms{Insteon_PLM_disable_throttling}) ? 0.3 : 1.0; - &::print_log("[Insteon_PLM] Interface extremely busy. Resending command" - . " after delaying for $nack_delay second") if $main::Debug{insteon}; - $self->_set_timeout('xmit',$nack_delay * 1000); - $$self{retry_count} += 1; - if ($$self{retry_count} < 3) { - unless ($self->_is_duplicate($cmd_record{cmd})) { - push(@{$$self{command_stack2}}, \%cmd_record); - } - } - $$self{xmit_in_progress} = 0; - $self->_clear_timeout('command'); - $process_next_command = 0; - $nack_count++; - } - } else { - # it's probably a fragment; so, handle it - $$self{_data_fragment} .= $data_1 unless $data_1 eq $$self{_prior_data_fragment}; - } - } - - $$self{_data_fragment} = $residue_data unless $entered_rcv_loop or $$self{_data_fragment}; - - if ($process_next_command) { - $self->process_command_stack(); - } - - return $processedNibs; -} - -sub process_command_stack -{ - my ($self) = @_; - ## send any remaining commands in stack - my $stack_count = @{$$self{command_stack2}}; - if ($stack_count> 0 ) - { - #send any remaining commands. - $self->send_plm_cmd(); - } -} - -sub _xlate_mh_x10 -{ - my ($self,$p_state,$p_setby) = @_; - - my $msg; - my $cmd=$p_state; - $cmd=~ s/\:.*$//; - $cmd=lc($cmd); - - my $id=lc($p_setby->{id_by_state}{$cmd}); - - my $hc = lc(substr($p_setby->{x10_id},1,1)); - my $uc = lc(substr($p_setby->{x10_id},2,1)); - - if ($hc eq undef) { - &main::print_log("[Insteon_PLM] Object:$p_setby Doesnt have an x10 id (yet)"); - return undef; - } - - if ($uc eq undef) { - &main::print_log("[Insteon_PLM] Message is for entire HC") if $main::Debug{insteon}; - } - else { - - #Every X10 message starts with the House and unit code - $msg = "02"; - $msg.= unpack("H*",pack("C",$plm_commands{x10_send})); - $msg.= substr(unpack("H*",pack("C",$x10_house_codes{substr($id,1,1)})),1,1); - $msg.= substr(unpack("H*",pack("C",$x10_unit_codes{substr($id,2,1)})),1,1); - $msg.= "00"; - &main::print_log("[Insteon_PLM] x10 sending code: " . uc($hc . $uc) . " as insteon msg: " - . $msg) if $main::Debug{insteon}; - $self->send_plm_cmd($msg); - } - - my $ecmd; - #Iterate through the rest of the pairs of nibbles - my $spos = 3; - if ($uc eq undef) {$spos=1;} -# &::print_log("PLM:PAIR:$id:$spos:$ecmd:"); - for (my $pos = $spos; $possend_plm_cmd($msg); - } -} - -sub _xlate_x10_mh -{ - my ($self,$data) = @_; - - my $msg=undef; - if (uc(substr($data,length($data)-2,2)) eq '00') - { - $msg = "X"; - $msg.= uc($mh_house_codes{substr($data,4,1)}); - $msg.= uc($mh_unit_codes{substr($data,5,1)}); - for (my $index =6; $indexget_object($msg{source}, $msg{group}); - &::print_log("[Insteon_PLM] Warn! Unable to locate object for source: $msg{source} and group; $msg{group}") - if (!(defined $object)); - if (defined $object) { - &::print_log("[Insteon_PLM] Processing message for " . $object->get_object_name) if $main::Debug{insteon}; - $object->_process_message($self, %msg); - } - return 1; # treat the message as legitimate even if an object match did not occur - } else { - return 0; - } -} - -sub parse_alllink -{ - my ($self, $data) = @_; - if (substr($data,8,6)) { - my %link = (); - my $flag = substr($data,4,1); - $link{is_controller} = (hex($flag) & 0x04) ? 1 : 0; - $link{flags} = substr($data,4,2); - $link{group} = lc substr($data,6,2); - $link{deviceid} = lc substr($data,8,6); - $link{data1} = substr($data,14,2); - $link{data2} = substr($data,16,2); - $link{data3} = substr($data,18,2); - my $key = $link{deviceid} . $link{group} . $link{is_controller}; - %{$$self{links}{lc $key}} = %link; - } - $self->get_next_alllink(); -} - -sub restore_string -{ - my ($self) = @_; - my $restore_string = $self->SUPER::restore_string(); - if ($$self{links}) { - my $link = ''; - foreach my $link_key (keys %{$$self{links}}) { - $link .= '|' if $link; # separate sections - my %link_record = %{$$self{links}{$link_key}}; - my $record = ''; - foreach my $record_key (keys %link_record) { - next unless $link_record{$record_key}; - $record .= ',' if $record; - $record .= $record_key . '=' . $link_record{$record_key}; - } - $link .= $record; - } -# &::print_log("[Insteon_PLM] AllLink restore string: $link") if $main::Debug{insteon}; - $restore_string .= $self->{object_name} . "->restore_linktable(q~$link~);\n"; - } - return $restore_string; -} - -sub restore_linktable -{ - my ($self, $links) = @_; - if ($links) { - foreach my $link_section (split(/\|/,$links)) { - my %link_record = (); - my $deviceid = ''; - my $groupid = '01'; - my $is_controller = 0; - foreach my $link_record (split(/,/,$link_section)) { - my ($key,$value) = split(/=/,$link_record); - $deviceid = $value if ($key eq 'deviceid'); - $groupid = $value if ($key eq 'group'); - $is_controller = $value if ($key eq 'is_controller'); - $link_record{$key} = $value if $key and defined($value); - } - my $linkkey = $deviceid . $groupid . $is_controller; - %{$$self{links}{lc $linkkey}} = %link_record; - } -# $self->log_alllink_table(); - } -} - -sub log_alllink_table -{ - my ($self) = @_; - foreach my $linkkey (sort(keys(%{$$self{links}}))) { - my $data3 = $$self{links}{$linkkey}{data3}; - my $is_controller = $$self{links}{$linkkey}{is_controller}; - my $group = ($is_controller) ? $data3 : $$self{links}{$linkkey}{group}; - $group = '01' if $group == '00'; - my $device = $self->get_object($$self{links}{$linkkey}{deviceid},$group); - my $object_name = ($device) ? $device->get_object_name : $$self{links}{$linkkey}{deviceid}; - &::print_log("[Insteon_PLM] " . - (($is_controller) ? "cntlr($$self{links}{$linkkey}{group}) record to " - . $object_name - : "responder record to " . $object_name . "($$self{links}{$linkkey}{group})") - . " (d1=$$self{links}{$linkkey}{data1}, d2=$$self{links}{$linkkey}{data2}, " - . "d3=$data3)") - if $main::Debug{insteon}; - } -} - -sub delete_orphan_links -{ - my ($self) = @_; - @{$$self{delete_queue}} = (); # reset the work queue - my $selfname = $self->get_object_name; - my $num_deleted = 0; - foreach my $linkkey (keys %{$$self{links}}) { - my $deviceid = lc $$self{links}{$linkkey}{deviceid}; - my $group = $$self{links}{$linkkey}{group}; - my $is_controller = $$self{links}{$linkkey}{is_controller}; - my $data3 = $$self{links}{$linkkey}{data3}; - my $device = $self->get_object($deviceid,'01'); - # if a PLM link (regardless of responder or controller) exists to a device that is not known, then delete - if (!($device)) { - my %delete_req = (deviceid => $deviceid, group => $group, is_controller => $is_controller, - callback => "$selfname->_process_delete_queue(1)", - linkdevice => $self, data3 => $data3); - push @{$$self{delete_queue}}, \%delete_req; - } else { - my $is_invalid = 1; - my $link = undef; - if ($is_controller) { - # then, this is a PLM defined link; and, we won't care about responder links as we assume - # they're ok given that they reference known devices - $link = $self->get_object('000000',$group); - if (!($link)) { - # a reference in the PLM's linktable does not match a scene member target - $is_invalid = 1; - } else { - # iterate over all of the members of the Insteon_Link item - foreach my $member_ref (keys %{$$link{members}}) { - my $member = $$link{members}{$member_ref}{object}; - # member will correspond to a scene member item - # and, if it is a light item, then get the real device - if ($member->isa('Light_Item')) { - my @lights = $member->find_members('Insteon_Device'); - if (@lights) { - $member = @lights[0]; # pick the first - } - } - if ($member->isa('Insteon_Device')) { - my $linkmember = $member; - # make sure that this is a root device - if (!($member->is_root)) { - $member = $member->get_root; - } - if (lc $member->device_id eq $$self{links}{$linkkey}{deviceid}) { - # at this point, the forward link is ok; but, only if the reverse - # link also exists. So, check: - if ($member->has_link($self, $group, 0, $data3)) { - $is_invalid = 0; - } - last; - } - } else { - $is_invalid = 0; - } - } - if ($is_invalid) { - # then, there is a good chance that a reciprocal link exists; if so, delet it too - if ($device->has_link($self,$group,0, $data3)) { - my %delete_req = (object => $self, group => $group, is_controller => 0, - callback => "$selfname->_process_delete_queue(1)", - linkdevice => $device, data3 => $data3); - push @{$$self{delete_queue}}, \%delete_req; - } - } - } - if ($is_invalid) { - my %delete_req = (object => $device, group => $group, is_controller => 1, - callback => "$selfname->_process_delete_queue(1)", - linkdevice => $self, data3 => $data3); - push @{$$self{delete_queue}}, \%delete_req; - } - } - } - } - - $$self{delete_queue_processed} = 0; # reset the counter - - # iterate over all registered objects and compare whether the link tables match defined scene linkages in known Insteon_Links - for my $obj ($self->find_members('Insteon_Device')) - { - #Match on real objects only - if (($obj->is_root)) - { - $num_deleted += $obj->delete_orphan_links(); - my %delete_req = ('root_object' => $obj, callback => "$selfname->_process_delete_queue()"); - push @{$$self{delete_queue}}, \%delete_req; - } - } - $self->_process_delete_queue(); -} - -sub _process_delete_queue { - my ($self, $p_num_deleted) = @_; - $$self{delete_queue_processed} += $p_num_deleted if $p_num_deleted; - my $num_in_queue = @{$$self{delete_queue}}; - if ($num_in_queue) { - my $delete_req_ptr = shift(@{$$self{delete_queue}}); - my %delete_req = %$delete_req_ptr; - # distinguish between deleting PLM links and processing delete orphans for a root item - if ($delete_req{'root_object'}) { - $delete_req{'root_object'}->delete_orphan_links(); - } else { - if ($delete_req{linkdevice} eq $self) { - &::print_log("[Insteon_PLM] now deleting orphaned link w/ details: " - . (($delete_req{is_controller}) ? "controller" : "responder") - . ", " . (($delete_req{object}) ? "object=" . $delete_req{object}->get_object_name - : "deviceid=$delete_req{deviceid}") . ", group=$delete_req{group}") - if $main::Debug{insteon}; - $self->delete_link(%delete_req); - } elsif ($delete_req{linkdevice}) { - $delete_req{linkdevice}->delete_link(%delete_req); - } - } - } else { - &::print_log("[Insteon_PLM] A total of $$self{delete_queue_processed} orphaned link records were deleted."); - } - -} - -sub delete_link -{ - # linkkey is concat of: deviceid, group, is_controller - my ($self, $parms_text) = @_; - my %link_parms; - if (@_ > 2) { - shift @_; - %link_parms = @_; - } else { - %link_parms = &main::parse_func_parms($parms_text); - } - my $num_deleted = 0; - my $insteon_object = $link_parms{object}; - my $deviceid = ($insteon_object) ? $insteon_object->device_id : $link_parms{deviceid}; - my $group = $link_parms{group}; - my $is_controller = ($link_parms{is_controller}) ? 1 : 0; - my $linkkey = lc $deviceid . $group . (($is_controller) ? '1' : '0'); - if (defined $$self{links}{$linkkey}) { - my $cmd = '026F' . '80' - . $$self{links}{$linkkey}{flags} - . $$self{links}{$linkkey}{group} - . $$self{links}{$linkkey}{deviceid} - . $$self{links}{$linkkey}{data1} - . $$self{links}{$linkkey}{data2} - . $$self{links}{$linkkey}{data3}; - $$self{_mem_callback} = $link_parms{callback} if $link_parms{callback}; - delete $$self{links}{$linkkey}; - $num_deleted = 1; - $self->send_plm_cmd($cmd); - } else { - &::print_log("[Insteon_PLM] no entry in linktable could be found for linkkey: $linkkey"); - if ($link_parms{callback}) { - package main; - eval ($link_parms{callback}); - &::print_log("[Insteon_PLM] error in add link callback: " . $@) - if $@ and $main::Debug{insteon}; - package Insteon_PLM; - } - } - return $num_deleted; -} - -sub add_link -{ - my ($self, $parms_text) = @_; - my %link_parms; - if (@_ > 2) { - shift @_; - %link_parms = @_; - } else { - %link_parms = &main::parse_func_parms($parms_text); - } - my $device_id; - my $group = ($link_parms{group}) ? $link_parms{group} : '01'; - my $insteon_object = $link_parms{object}; - if (!(defined($insteon_object))) { - $device_id = lc $link_parms{deviceid}; - $insteon_object = $self->get_object($device_id, $group); - } else { - $device_id = lc $insteon_object->device_id; - } - my $is_controller = ($link_parms{is_controller}) ? 1 : 0; - # first, confirm that the link does not already exist - my $linkkey = lc $device_id . $group . $is_controller; - if (defined $$self{links}{$linkkey}) { - &::print_log("[Insteon_PLM] WARN: attempt to add link to PLM that already exists! " - . "object=" . $insteon_object->get_object_name . ", group=$group, is_controller=$is_controller"); - if ($link_parms{callback}) { - package main; - eval ($link_parms{callback}); - &::print_log("[Insteon_PLM] error in add link callback: " . $@) - if $@ and $main::Debug{insteon}; - package Insteon_PLM; - } - } else { - my $control_code = ($is_controller) ? '40' : '41'; - # flags should be 'a2' for responder and 'e2' for controller - my $flags = ($is_controller) ? 'E2' : 'A2'; - my $data1 = (defined $link_parms{data1}) ? $link_parms{data1} : (($is_controller) ? '01' : '00'); - my $data2 = (defined $link_parms{data2}) ? $link_parms{data2} : '00'; - my $data3 = (defined $link_parms{data3}) ? $link_parms{data3} : '00'; - # from looking at manually linked records, data1 and data2 are both 00 for responder records - # and, data1 is 01 and usually data2 is 00 for controller records - - my $cmd = '026F' - . $control_code - . $flags - . $group - . $device_id - . $data1 - . $data2 - . $data3; - $$self{_mem_callback} = $link_parms{callback} if $link_parms{callback}; - $$self{links}{$linkkey}{flags} = lc $flags; - $$self{links}{$linkkey}{group} = lc $group; - $$self{links}{$linkkey}{is_controller} = $is_controller; - $$self{links}{$linkkey}{deviceid} = lc $device_id; - $$self{links}{$linkkey}{data1} = lc $data1; - $$self{links}{$linkkey}{data2} = lc $data2; - $$self{links}{$linkkey}{data3} = lc $data3; - $self->send_plm_cmd($cmd); - } -} - -sub get_object -{ - my ($self, $p_deviceid, $p_group) = @_; - - my $retObj = undef; - - for my $obj (@{$$self{objects}}) - { - #Match on Insteon objects only - if ($obj->isa("Insteon_Device")) - { - if (lc $obj->device_id() eq lc $p_deviceid) - { - if ($p_group) - { - if (lc $p_group eq lc $obj->group) - { - $retObj = $obj; - last; - } - } else { - $retObj = $obj; - last; - } - } - } - } - - return $retObj; -} - - -sub add_id_state -{ - my ($self,$id,$state) = @_; -# &::print_log("PLM: AddIDSTATE:$id:$state"); -} - -sub add -{ - my ($self,@p_objects) = @_; - - my @l_objects; - - for my $l_object (@p_objects) { - if ($l_object->isa('Group_Item') ) { - @l_objects = $$l_object{members}; - for my $obj (@l_objects) { - $self->add($obj); - } - } else { - $self->add_item($l_object); - } - } -} - -sub add_item -{ - my ($self,$p_object) = @_; - - push @{$$self{objects}}, $p_object; - - if (!($self->device_id) and !($$self{_id_check})) { - $$self{_id_check} = 1; - $self->send_plm_cmd('0260'); - } - -# if ($p_object->isa('Insteon_Device') and $p_object->is_root and $p_object->devcat ne '0005') -# { - # don't request status for objects associated w/ other than the primary group - # as they are psuedo links -# my $scan_at_startup = $::config_parms{Insteon_PLM_scan_at_startup}; -# $scan_at_startup = 1 unless defined $scan_at_startup; -# $scan_at_startup = 0 unless $main::Save{mh_exit} eq 'normal'; -# $p_object->request_status() if $p_object->group eq '01' and $scan_at_startup; -# } - return $p_object; -} - -sub remove_all_items { - my ($self) = @_; - - if (ref $$self{objects}) { - foreach (@{$$self{objects}}) { - # $_->untie_items($self); - } - } - delete $self->{objects}; -} - -sub add_item_if_not_present { - my ($self, $p_object) = @_; - - if (ref $$self{objects}) { - foreach (@{$$self{objects}}) { - if ($_ eq $p_object) { - return 0; - } - } - } - $self->add_item($p_object); - return 1; -} - -sub remove_item { - my ($self, $p_object) = @_; - - if (ref $$self{objects}) { - for (my $i = 0; $i < scalar(@{$$self{objects}}); $i++) { - if ($$self{objects}->[$i] eq $p_object) { - splice @{$$self{objects}}, $i, 1; - # $p_object->untie_items($self); - return 1; - } - } - } - return 0; -} - - -sub is_member { - my ($self, $p_object) = @_; - - my @l_objects = @{$$self{objects}}; - for my $l_object (@l_objects) { - if ($l_object eq $p_object) { - return 1; - } - } - return 0; -} - -sub find_members { - my ($self,$p_type) = @_; - - my @l_found; - my @l_objects = @{$$self{objects}}; - for my $l_object (@l_objects) { - if ($l_object->isa($p_type)) { - push @l_found, $l_object; - } - } - return @l_found; -} - -sub device_id { - my ($self, $p_deviceid) = @_; - $$self{deviceid} = $p_deviceid if defined $p_deviceid; - return $$self{deviceid}; -} - -sub get_device -{ - my ($self, $p_deviceid, $p_group) = @_; - foreach my $device ($self->find_members('Insteon_Device')) { - if (lc $device->device_id eq lc $p_deviceid and lc $device->group eq lc $p_group) { - return $device; - } - } -} - -sub _set_timeout -{ - my ($self, $timeout_name, $timeout_in_millis) = @_; - my $tickcount = &main::get_tickcount + $timeout_in_millis; - $tickcount += 2**32 if $tickcount < 0; # force a wrap; to be handleded by check timeout - $$self{"_timeout_$timeout_name"} = $tickcount; -} - -sub _check_timeout -{ - my ($self, $timeout_name) = @_; - return 0 unless $timeout_name; - return -1 unless defined $$self{"_timeout_$timeout_name"}; - my $current_tickcount = &main::get_tickcount; - return 0 if (($current_tickcount >= 2**16) and ($$self{"_timeout_$timeout_name"} < 2**16)); - return ($current_tickcount > $$self{"_timeout_$timeout_name"}) ? 1 : 0; -} - -sub _clear_timeout -{ - my ($self, $timeout_name) = @_; - $$self{"_timeout_$timeout_name"} = undef; -} - -sub firmware { - my ($self, $p_firmware) = @_; - $$self{firmware} = $p_firmware if defined $p_firmware; - return $$self{firmware}; -} - -=begin -sub default_getstate -{ - my ($self,$p_state) = @_; - return $$self{m_obj}->state(); -} -=cut -1; - +=begin comment +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ + +File: + Insteon_PLM.pm + +Description: + + This is the base interface class for Insteon Power Line Modem (PLM) + + For more information regarding the technical details of the PLM: + http://www.smarthome.com/manuals/2412sdevguide.pdf + +Author(s): + Jason Sharpee / jason@sharpee.com + Gregg Liming / gregg@limings.net + +License: + This free software is licensed under the terms of the GNU public license. GPLv2 + +Usage: + Use these mh.ini parameters to enable this code: + + Insteon_PLM_serial_port=/dev/ttyS4 + + Example initialization: + + +Notes: + +Special Thanks to: + Brian Warren for significant testing and patches + Bruce Winter - MH + +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ + + +=cut + + +package Insteon_PLM; + +use strict; +use Insteon::BaseInterface; +use Insteon::BaseInsteon; +use Insteon::AllLinkDatabase; + +@Insteon_PLM::ISA = ('Serial_Item','Insteon::BaseInterface'); + + +my %prefix = ( +#PLM Serial Commands + insteon_received => '0250', + insteon_ext_received => '0251', + x10_received => '0252', + all_link_complete => '0253', + plm_button_event => '0254', + user_user_reset => '0255', + all_link_clean_failed => '0256', + all_link_record => '0257', + all_link_clean_status => '0258', + plm_info => '0260', + all_link_send => '0261', + insteon_send => '0262', + insteon_ext_send => '0262', + x10_send => '0263', + all_link_start => '0264', + all_link_cancel => '0265', + plm_reset => '0267', + all_link_first_rec => '0269', + all_link_next_rec => '026a', + plm_set_config => '026b', + plm_led_on => '026d', + plm_led_off => '026e', + all_link_manage_rec => '026f', + insteon_nak => '0270', + insteon_ack => '0271', + rf_sleep => '0272', + plm_get_config => '0273' +); + + +sub serial_startup { + my ($instance) = @_; + my $port = $::config_parms{$instance . "_serial_port"}; + my $speed = 19200; + + &::print_log("[Insteon_PLM] serial:$port:$speed"); + &::serial_port_create($instance, $port, $speed,'none','raw'); + +} + +sub new { + my ($class, $port_name, $p_deviceid) = @_; + $port_name = 'Insteon_PLM' if !$port_name; + my $port = $::config_parms{$port_name . "_serial_port"}; + + my $self = new Insteon::BaseInterface(); + $$self{state} = ''; + $$self{said} = ''; + $$self{state_now} = ''; + $$self{port_name} = $port_name; + $$self{port} = $port; + $$self{last_command} = ''; + $$self{_prior_data_fragment} = ''; + bless $self, $class; + $self->restore_data('debug'); + $$self{aldb} = new Insteon::ALDB_PLM($self); + + &Insteon::add($self); + + $self->device_id($p_deviceid) if defined $p_deviceid; + + $$self{xmit_delay} = $::config_parms{Insteon_PLM_xmit_delay}; + $$self{xmit_delay} = 0.25 unless defined $$self{xmit_delay}; # and $$self{xmit_delay} > 0.125; + &::print_log("[Insteon_PLM] setting default xmit delay to: $$self{xmit_delay}"); + $$self{xmit_x10_delay} = $::config_parms{Insteon_PLM_xmit_x10_delay}; + $$self{xmit_x10_delay} = 0.5 unless defined $$self{xmit_x10_delay} and $$self{xmit_x10_delay} > 0.5; + &::print_log("[Insteon_PLM] setting x10 xmit delay to: $$self{xmit_x10_delay}"); + $self->_clear_timeout('xmit'); + $self->_clear_timeout('command'); + + return $self; +} + + +sub restore_string +{ + my ($self) = @_; + my $restore_string = $self->SUPER::restore_string(); + if ($self->_aldb) { + $restore_string .= $self->_aldb->restore_string(); + } + return $restore_string; +} + +sub check_for_data { + + my ($self) = @_; + my $port_name = $$self{port_name}; + &::check_for_generic_serial_data($port_name) if $::Serial_Ports{$port_name}{object}; + my $data = $::Serial_Ports{$port_name}{data}; + # always check for data first; if it exists, then process; otherwise check if pending commands exist + if ($data) + { + # now, clear the serial port data so that any subsequent command processing doesn't result in an immediate filling/overwriting + if (length($$self{_data_fragment})) + { +# $main::Serial_Ports{$port_name}{data}=pack("H*",$$self{_data_fragment}); + # always clear the buffer since we're maintaining the fragment separately + $main::Serial_Ports{$port_name}{data} = ''; + } + else + { + $main::Serial_Ports{$port_name}{data} = ''; + } + + #lets turn this into Hex. I hate perl binary funcs + my $data = unpack "H*", $data; + + $self->_parse_data($data); + } + elsif (defined $self) + { + # if no data being received, then check if any timeouts have expired + if ($self->_check_timeout('command') == 1) + { + $self->_clear_timeout('command'); + if ($self->transmit_in_progress) { +# &::print_log("[Insteon_PLM] WARN: No acknowledgement from PLM to last command requires forced abort of current command." +# . " This may reflect a problem with your environment."); +# pop(@{$$self{command_stack2}}); # pop the active command off the queue + $self->retry_active_message(); + $self->process_queue(); + } + else + { + &::print_log("[Insteon_PLM] DEBUG2: PLM command timer expired but no transmission in place. Moving on...") if $main::Debug{insteon} >= 2; + $self->clear_active_message(); + $self->process_queue(); + } + } + elsif ($self->_check_timeout('xmit') == 1) + { + $self->_clear_timeout('xmit'); + if (!($self->transmit_in_progress)) + { + $self->process_queue(); + } + } + } +} + + +sub set +{ + my ($self,$p_state,$p_setby,$p_response) = @_; + + my @x10_commands = &Insteon::X10Message::generate_commands($p_state, $p_setby); + foreach my $command (@x10_commands) + { + $self->queue_message(new Insteon::X10Message($command)); + } +} + +sub complete_linking_as_responder +{ + my ($self, $group) = @_; + + # it is not clear that group should be anything as the group will be taken from the controller + $group = '01' unless $group; + # set up the PLM as the responder + my $cmd = '00'; # responder code + $cmd .= $group; # WARN - must be 2 digits and in hex!! + my $message = new Insteon::InsteonMessage('all_link_start', $self); + $message->interface_data($cmd); + $self->queue_message($message) +} + +sub log_alllink_table +{ + my ($self) = @_; + $self->_aldb->log_alllink_table if $self->_aldb; +} + +sub scan_link_table +{ + my ($self,$callback) = @_; + #$$self{links} = undef; # clear out the old + $$self{aldb} = new Insteon::ALDB_PLM($self); + $$self{_mem_activity} = 'scan'; + $$self{_mem_callback} = ($callback) ? $callback : undef; + $self->_aldb->get_first_alllink(); +} + +sub initiate_linking_as_controller +{ + my ($self, $group) = @_; + + $group = 'FF' unless $group; + # set up the PLM as the responder + my $cmd = '01'; # controller code + $cmd .= $group; # WARN - must be 2 digits and in hex!! + my $message = new Insteon::InsteonMessage('all_link_start', $self); + $message->interface_data($cmd); + $self->queue_message($message); +} + +sub initiate_unlinking_as_controller +{ + my ($self, $group) = @_; + + $group = 'FF' unless $group; + # set up the PLM as the responder + my $cmd = 'FF'; # controller code + $cmd .= $group; # WARN - must be 2 digits and in hex!! + my $message = new Insteon::InsteonMessage('all_link_start', $self); + $message->interface_data($cmd); + $self->queue_message($message); +} + + +sub cancel_linking +{ + my ($self) = @_; + $self->queue_message(new Insteon::InsteonMessage('all_link_cancel', $self)); +} + +sub _aldb +{ + my ($self) = @_; + return $$self{aldb}; +} + + + +sub _send_cmd { + my ($self, $message, $cmd_timeout) = @_; + my $instance = $$self{port_name}; + if (!(ref $main::Serial_Ports{$instance}{object})) { + print "WARN: Insteon_PLM serial port not initialized!\n"; + return; + } + unshift(@{$$self{command_history}},$::Time); + $self->transmit_in_progress(1); + + my $command = $message->interface_data; + my $delay = $$self{xmit_delay}; + + # determine the delay from the point that the message was created to + # the point that it is queued + my $incurred_delay_time = $message->seconds_delayed; + &main::print_log("[Insteon_PLM] DEBUG2: Sending " . $message->to_string . " incurred delay of " + . sprintf('%.2f',$incurred_delay_time) . " seconds; starting hop-count: " + . ((ref $message->setby && $message->setby->isa('Insteon::BaseObject')) ? $message->setby->default_hop_count : "?")) if $main::Debug{insteon} >= 2; + + if ($message->isa('Insteon::X10Message')) { # is x10; so, be slow + $command = $prefix{x10_send} . $command; + $delay = $$self{xmit_x10_delay}; + # clear command timeout so that we don't wait for an insteon ack before sending the next command + } else { + my $command_type = $message->command_type; + $command = $prefix{$command_type} . $command; + if ($command_type eq 'all_link_send' or $command_type eq 'insteon_send' or $command_type eq 'insteon_ext_send') + { + $self->_set_timeout('command', $cmd_timeout); # a commmand needs to be PLM ack'd w/i 3 seconds or it gets dropped + } + } + + my $data = pack("H*",$command); +# &::print_log("PLM: Executing command:$command:") unless $main::config_parms{no_log} =~/Insteon_PLM/; + $main::Serial_Ports{$instance}{object}->write($data) if $main::Serial_Ports{$instance}; + + + if ($delay) { + $self->_set_timeout('xmit',$delay * 1000); + } + $$self{'last_change'} = $main::Time; +} + + +sub _parse_data { + my ($self, $data) = @_; + my ($name, $val); + + # it is possible that a fragment exists from a previous attempt; so, if it exists, prepend it + if ($$self{_data_fragment}) + { + &::print_log("[Insteon_PLM] DEBUG3: Prepending prior data fragment: $$self{_data_fragment}") if $main::Debug{insteon} >= 3; + # maintain a copy of the parsed data fragment + $$self{_prior_data_fragment} = $$self{_data_fragment}; + # append if not a repeat + $data = $$self{_data_fragment} . $data unless $$self{_data_fragment} eq $data; + # and, clear it out + $$self{_data_fragment} = ''; + } + else + { + # clear the memory of any prior data fragment + $$self{_prior_data_fragment} = ''; + } + + &::print_log( "[Insteon_PLM] DEBUG3: Received raw PLM data: $data") if $main::Debug{insteon} >= 3; + + # begin by pulling out any PLM ack/nacks + my $prev_cmd = ''; + my $pending_message = $self->active_message; + if ($pending_message) { + $prev_cmd = lc $pending_message->interface_data; + if ($pending_message->isa('Insteon::X10Message')) + { + $prev_cmd = $prefix{x10_send} . $prev_cmd; + } else { + my $command_type = $pending_message->command_type; + $prev_cmd = $prefix{$command_type} . $prev_cmd; + } + } + + my $residue_data = ''; + my $process_next_command = 1; + my $nack_count = 0; + my $entered_ack_loop; + my $previous_parsed_data; + if (defined $prev_cmd and $prev_cmd ne '') + { + my $ackcmd = $prev_cmd . '06'; + my $nackcmd = $prev_cmd . '15'; + my $badcmd = $prev_cmd . '0f'; + $previous_parsed_data = ''; + foreach my $parsed_data (split(/($ackcmd)|($nackcmd)|($prefix{plm_info}\w{12}06)|($prefix{plm_info}\w{12}15)|($badcmd)/,$data)) + { + #ignore blanks.. the split does odd things + next if $parsed_data eq ''; + next if $previous_parsed_data eq $parsed_data; # guard against repeats + $previous_parsed_data = $parsed_data; # and, now reinitialize + $entered_ack_loop = 1; + if ($parsed_data =~ /^($ackcmd)|($nackcmd)|($prefix{plm_info}\w{12}06)|($prefix{plm_info}\w{12}15)|($prefix{all_link_first_rec}15)|($prefix{all_link_next_rec}15)|($badcmd)$/) + { + my $ret_code = substr($parsed_data,length($parsed_data)-2,2); + my $record_type = substr($parsed_data,0,4); + my $message_data = substr($parsed_data,4,length($parsed_data)-4); + if ($ret_code eq '06') + { + if ($record_type eq $prefix{plm_info}) + { + $self->device_id(substr($message_data,0,6)); + $self->firmware(substr($message_data,10,2)); + $self->on_interface_info_received(); + } + elsif ($record_type eq $prefix{all_link_first_rec} + or $record_type eq $prefix{all_link_next_rec}) + { + $$self{_next_link_ok} = 1; + } + elsif ($record_type eq $prefix{all_link_start}) + { + # clear the active message because we're done + $self->clear_active_message(); + } + else + { + &::print_log("[Insteon_PLM] DEBUG3: Received PLM acknowledge: " + . $pending_message->to_string) if $main::Debug{insteon} >= 3; + } + + # X10 messages don't ACK back on the powerline, so clear them if the PLM acknowledges + # AND if the current, pending message is the X10 message + if (($parsed_data =~ /$prefix{x10_send}\w{4}06/) && ($pending_message->isa('Insteon::X10Message'))) + { + $self->clear_active_message(); + } + + if ($record_type eq $prefix{all_link_manage_rec}) + { + # clear the active message because we're done + $self->clear_active_message(); + my $callback = $pending_message->callback(); #$$self{_mem_callback}; + $$self{_mem_callback} = undef; + if ($callback) + { + package main; + eval ($callback); + &::print_log("[Insteon_PLM] WARN1: Error encountered during ack callback: " . $@) + if $@ and $main::Debug{insteon} >= 1; + package Insteon_PLM; + } + } + } + elsif ($ret_code eq '15' or $ret_code eq '0f') + { #NAK or "bad" command received + $self->clear_active_message(); # regardless, we're not retrying as we'll just get the same + + if ($record_type eq $prefix{all_link_first_rec} + or $record_type eq $prefix{all_link_next_rec}) + { + # both of these conditions are ok as it just means + # we've reached the end of the memory + $$self{_next_link_ok} = 0; + $$self{_mem_activity} = undef; + if ($record_type eq $prefix{all_link_first_rec}) + { + $self->_aldb->health("empty"); + } + else + { + $self->_aldb->health("good"); + } + if ($$self{_mem_callback}) + { + my $callback = $$self{_mem_callback}; + $$self{_mem_callback} = undef; + package main; + eval ($callback); + &::print_log("[Insteon_PLM] WARN1: Error encountered during nack callback: " . $@) + if $@ and $main::Debug{insteon} >= 1; + package Insteon_PLM; + } + } + elsif ($record_type eq $prefix{all_link_send}) + { + &::print_log("[Insteon_PLM] WARN: PLM memory does not contain link for: " + . $pending_message->to_string . $@) + } + elsif ($record_type eq $prefix{all_link_start}) + { + &::print_log("[Insteon_PLM] WARN: PLM unable to complete requested operation: " + . $pending_message->to_string . $@); + } + elsif ($record_type eq $prefix{all_link_manage_rec}) + { + # parse out the data + my $failed_cmd_code = substr($pending_message->interface_data(),0,2); + my $failed_cmd = 'unknown'; + if ($failed_cmd_code eq '40') + { + $failed_cmd = 'update/add controller record'; + } + elsif ($failed_cmd_code eq '41') + { + $failed_cmd = 'update/add responder record'; + } + elsif ($failed_cmd_code eq '80') + { + $failed_cmd = 'delete record'; + } + my $failed_group = substr($pending_message->interface_data(),4,2); + my $failed_deviceid = substr($pending_message->interface_data(),6,6); + &::print_log("[Insteon_PLM] WARN: PLM unable to complete requested " + . "PLM link table update ($failed_cmd) for " + . "group: $failed_group and deviceid: $failed_deviceid" ); + if ($$self{_mem_callback}) + { + my $callback = $$self{_mem_callback}; + $$self{_mem_callback} = undef; + package main; + eval ($callback); + &::print_log("[Insteon_PLM] WARN1: Error encountered during ack callback: " . $@) + if $@ and $main::Debug{insteon} >= 1; + package Insteon_PLM; + } + # clear the active message because we're done + # $self->clear_active_message(); + } + else + { + &::print_log("[Insteon_PLM] WARN: received NACK for " + . $pending_message->to_string() + . ". If this is a light fixture, check bulb"); + } + } + else + { + # We have a problem (Usually we stepped on another X10 command) + &::print_log("[Insteon_PLM] ERROR: encountered $parsed_data. " + . $pending_message->to_string()); + $self->retry_active_message(); + #move it off the top of the stack and re-transmit later! + #TODO: We should keep track of an errored command and kill it if it fails twice. prevent an infinite loop here + } + } + else # no match occurred--which is the "leftovers" + { + # is $parsed_data an accidental anomoly? (there are other cases; but, this is a good start) + if ($parsed_data =~ /^($prefix{insteon_send}\w{12}06)|($prefix{insteon_send}\w{12}15)$/) + { + # first, parse the content to confirm that it could be a legitimate ACK + my $unknown_deviceid = substr($parsed_data,4,6); + my $unknown_msg_flags = substr($parsed_data,10,2); + my $unknown_command = substr($parsed_data,12,2); + my $unknown_data = substr($parsed_data,14,2); + my $unknown_obj = &Insteon::get_object($unknown_deviceid, '01'); + if ($unknown_obj) + { + &::print_log("[Insteon_PLM] WARN: encountered '$parsed_data' " + . "from " . $unknown_obj->get_object_name() + . " with command: $unknown_command, but expected '$ackcmd'."); + $residue_data .= $parsed_data; + } + else + { + &::print_log("[Insteon_PLM] ERROR: encountered '$parsed_data' " + . "that does not match any known device ID (expected '$ackcmd')." + . " Discarding received data."); + #$residue_data .= $parsed_data; + } + } + else + { + $residue_data .= $parsed_data; + } + } + } #foreach - split across the incoming data + + $residue_data = $data unless $entered_ack_loop or $residue_data; + } + else + { + $residue_data = $data unless $residue_data; + } + + my $entered_rcv_loop = 0; + + $previous_parsed_data = ''; + + foreach my $parsed_data (split(/($prefix{x10_received}\w{4})|($prefix{insteon_received}\w{18})|($prefix{insteon_ext_received}\w{46})|($prefix{all_link_complete}\w{16})|($prefix{all_link_clean_failed}\w{8})|($prefix{all_link_record}\w{16})|($prefix{all_link_clean_status}\w{2})|($prefix{plm_button_event}\w{2})/,$residue_data)) + { + #ignore blanks.. the split does odd things + next if $parsed_data eq ''; + next if $previous_parsed_data eq $parsed_data; # guard against repeats + $previous_parsed_data = $parsed_data; # and, now reinitialize + + $entered_rcv_loop = 1; + + my $parsed_prefix = substr($parsed_data,0,4); + my $message_length = length($parsed_data); + + my $message_data = substr($parsed_data,4,length($parsed_data)-4); + + if ($parsed_prefix eq $prefix{insteon_received} and ($message_length == 22)) + { #Insteon Standard Received + $self->on_standard_insteon_received($message_data); + } + elsif ($parsed_prefix eq $prefix{insteon_ext_received} and ($message_length == 50)) + { #Insteon Extended Received + $self->on_extended_insteon_received($message_data); + } + elsif($parsed_prefix eq $prefix{x10_received} and ($message_length == 8)) + { #X10 Received + my $x10_message = new Insteon::X10Message($message_data); + my $x10_data = $x10_message->get_formatted_data(); + &::print_log("[Insteon_PLM] DEBUG3: received x10 data: $x10_data") if $main::Debug{insteon} >= 3 + &::process_serial_data($x10_data,undef,$self); + } + elsif ($parsed_prefix eq $prefix{all_link_complete} and ($message_length == 20)) + { #ALL-Linking Completed + my $link_address = substr($message_data,4,6); + &::print_log("[Insteon_PLM] DEBUG2: ALL-Linking Completed with $link_address ($message_data)") if $main::Debug{insteon} >= 2; + $self->clear_active_message(); + } + elsif ($parsed_prefix eq $prefix{all_link_clean_failed} and ($message_length == 14)) + { #ALL-Link Cleanup Failure Report + $self->retry_active_message(); + # extract out the pertinent parts of the message for display purposes + # bytes 0-1 - ignore; 2-3 - group; 4-9 device address + my $failure_group = substr($message_data,2,2); + my $failure_device = substr($message_data,4,6); + + &::print_log("[Insteon_PLM] DEBUG2: Received all-link cleanup failure from device: " + . "$failure_device and group: failure_group") if $main::Debug{insteon} >= 2; + } + elsif ($parsed_prefix eq $prefix{all_link_record} and ($message_length == 20)) + { #ALL-Link Record Response + &::print_log("[Insteon_PLM] DEBUG2: ALL-Link Record Response:$message_data") if $main::Debug{insteon} >= 2; + $self->_aldb->parse_alllink($message_data); + # before doing the next, make sure that the pending command + # (if it sitll exists) is pulled from the queue + $self->clear_active_message(); + + $self->_aldb->get_next_alllink(); + } + elsif ($parsed_prefix eq $prefix{all_link_clean_status} and ($message_length == 6)) + { #ALL-Link Cleanup Status Report + my $cleanup_ack = substr($message_data,0,2); + if ($cleanup_ack eq '15') + { + my $delay_in_seconds = 1.0; # this may need to be tweaked + &::print_log("[Insteon_PLM] WARN1: Received all-link cleanup failure for current message." + . " Attempting resend in " . $delay_in_seconds . " seconds.") + if $main::Debug{insteon} >= 1; + $self->retry_active_message(); + # except that we should cause a bit of a delay to let things settle out + $self->_set_timeout('xmit',$delay_in_seconds * 1000); + $process_next_command = 0; + } + else + { + my $message_to_string = ($self->active_message) ? $self->active_message->to_string() : ""; + &::print_log("[Insteon_PLM] DEBUG2: Received all-link cleanup success: $message_to_string") + if $main::Debug{insteon} >= 2; + + # attempt to process the message by the link object; this acknowledgement will reset + # the auto-retry timer + if ($self->active_message && $self->active_message->isa('Insteon::InsteonMessage') + &&($self->active_message->command_type == 'all_link_send')) + { + my $group = substr($self->active_message->interface_data,0,2); + my $link = &Insteon::get_object('000000',$group); + if ($link) + { + my %msg = ('type' => 'cleanup', + 'group' => $group, + 'is_ack' => 1, + 'command' => 'cleanup' + ); + $link->_process_message($self, %msg); + } + # only clear the active message if this all_link_clean_status corresponds to a all_link_send message + $self->clear_active_message(); + } + } + } + elsif (substr($parsed_data,0,2) eq '15') + { # Indicates that the PLM can't receive more commands at the moment + # so, slow things down + if (!($nack_count)) + { + my $nack_delay = ($::config_parms{Insteon_PLM_disable_throttling}) ? 0.3 : 1.0; + &::print_log("[Insteon_PLM] DEBUG3: Interface extremely busy. Resending command" + . " after delaying for $nack_delay second") if $main::Debug{insteon} >= 3; + $self->_set_timeout('xmit',$nack_delay * 1000); + $self->retry_active_message(); + $process_next_command = 0; + $nack_count++; + } + } + else + { + # it's probably a fragment; so, handle it + # it it's the same as last time, then drop it as we can't recover + $$self{_data_fragment} .= $parsed_data + unless (($parsed_data eq $$self{_prior_data_fragment}) or ($parsed_data eq $$self{_data_fragment})); + } + } + + $$self{_data_fragment} = $residue_data unless $entered_rcv_loop or $$self{_data_fragment}; + + if ($process_next_command) { + $self->process_queue(); + } + + return; +} + +# dummy sub required to support the X10 integrtion + +sub add_id_state { + # do nothing +} + +sub firmware { + my ($self, $p_firmware) = @_; + $$self{firmware} = $p_firmware if defined $p_firmware; + return $$self{firmware}; +} + + +1; \ No newline at end of file diff --git a/lib/Light_Switch_Item.pm b/lib/Light_Switch_Item.pm index 9b2e291c7..4c9daef41 100644 --- a/lib/Light_Switch_Item.pm +++ b/lib/Light_Switch_Item.pm @@ -164,7 +164,7 @@ sub set { last; } } - } + } } 1; diff --git a/lib/Omnistat.pm b/lib/Omnistat.pm index b732cd44d..0ffc4ba6a 100644 --- a/lib/Omnistat.pm +++ b/lib/Omnistat.pm @@ -67,23 +67,19 @@ TODO: The sleep situation has been much improved, but if someone smart could rep Changelog ================================================================================ -2010/07/26 - Marc MERLIN +2011/11/24 - Marc MERLIN ======================== -Minor fixes, but the biggest was modifying bin/mh to support code that occasionally dies -(mh would disable that code after it died 9 times, which is not so good since it killed -all temp and stat logging if you were using that). -It is just hard to never trigger die code, in my case I sometimes have: -Omnistat[1]->send_cmd did not get expected first byte (0x81) in ack reply to command 01 20 48 - 01 6a (got 0x82 in 0x82 0x22 0x48 0x00 0xec 0x81 0x22 0x48 0x00 0xeb ) at ../lib/Omnistat.pm line 544. -this shows that I got a reply from stat #2 when I was expecting a reply from stat #1. -It happens rarely, and it's likely mostly serial port issues that I can't easily fix nor really -care to since they're rare and the code just deals with them. - -As a result, you should put this in mh,private.ini: -omnistat_allowed_errors = 999999999999 -hvac_allowed_errors = 999999999999 -replacing the first word (hvac/omnistat) by your code/module.pl names that use this library. -This will stop mh from disabling your code if the libraries dies every so often. +This has major improvements on serial port data handing to avoid the occasional dies due to poor timing. +Details: +- stop messing around, and just require Time::Hires (old code could limp around with just 'sleep', but as + a result it did a poor job of reliably getting data replies on some occasions). +- instead of blindly sleeping for a pre-guessed time before reading a response, read data characters +- sleeps are now reduced to the bare minimum required (0.37s for typical reads to 0.80s for full register dumps). +- No data gets dropped anymore without suitable logging and serial port + data is cleared before sending a command and waiting for an answer. +- No more priming hack needed. +- die resets cache data so that we don't end up with possible garbage data +- state_now logic was improved somewhat. 2011/01/09 - Mickey Argo/Karl Suchy/Marc MERLIN @@ -404,21 +400,11 @@ package Omnistat; sub omnistat_debug { my ($mesg) = @_; - print "$::Time_Date: $mesg\n" if $::Debug{omnistat}; + &::print_log("$mesg") if $::Debug{omnistat}; + #print "$::Time_Date: $mesg\n" if $::Debug{omnistat}; } -# Load Time::HiRes if it's available -use vars qw($USLEEP); -eval { require Time::HiRes }; -if (not $@) { - Time::HiRes->import( qw(usleep) ); - omnistat_debug("Omnistat found Time::Hires, will use usleep in omni_sleep"); - $USLEEP=1; -} else { - omnistat_debug("Omnistat did NOT find Time::Hires, will NOT use usleep in omni_sleep"); - warn("Omnistat works much better with Time::HiRes, install it if you can"); - $USLEEP=0; -} +use Time::HiRes; # -------------------------------------------------------------- # -------------------- START OF SUBROUTINES -------------------- @@ -426,11 +412,6 @@ if (not $@) { @Omnistat::ISA = ('Serial_Item'); -sub omni_sleep() { - $USLEEP ? usleep($_[0]) : sleep(int($_[0] + 0.99999)); -} - - # My guess is that most people would want to have temperature logging, but you can turn it off with # Omnistat_stat_log=0 in mh.private.ini -- merlin sub omnistat_log { @@ -480,7 +461,7 @@ sub new { foreach my $reg (0x15..0x38, 0x0f, 0x49) { $$self{cache_agelimit}{$reg} = 3600 * 24; # CACHE_TIMEOUT_DAILY } - # setpoints and modes are cached 53 secs so that they are pretty much + # setpoints and modes are cached 54 secs so that they are pretty much # guaranteed to be updated once a minute even with the random +10% offset foreach my $reg (0x3b .. 0x3f) { $$self{cache_agelimit}{$reg} = 54; # CACHE_TIMEOUT_SHORT @@ -497,16 +478,26 @@ sub new { omnistat_debug("Omnistat[$$self{address}] object created"); bless $self,$class; - # This is to work around a timing bug where the first query doesn't get a proper ack - # we just "prime" the device and connection by making one query to it where we ignore the answer - # no idea why this is needed, but it works for me and things are stable afterwards -- merlin - $self->{'PRIME'}=1; - $self->send_cmd("0x01 0x20 0x40 0x01 0x62", 1); - $self->{'PRIME'}=0; + # Clean up left over data on the serial port. + &main::check_for_generic_serial_data('Omnistat'); + $main::Serial_Ports{Omnistat}{data} = ''; + + &::print_log("HAI Thermostat $address initialized"); return $self; } +sub die_reset { + my ($self, $mesg) = @_; + + $self->{cache} = {}; + $self->{cache_updatetime} = {}; + + warn("Resetting cache for ".$self->{address}. " before die\n"); + &::print_log($mesg); + die "$mesg"; +} + # ************************************* # * Add the checksum to the cmd array. # ************************************* @@ -524,6 +515,30 @@ sub add_checksum { return @array; } +sub read_omnistat_serial_data { + my $serial_data; + + &main::check_for_generic_serial_data('Omnistat'); + $serial_data .= $main::Serial_Ports{Omnistat}{data}; + $main::Serial_Ports{Omnistat}{data} = ''; + + return $serial_data; +} + +sub convert_omnistat_serial_data { + my ($serial_data) = @_; + my $len = length($serial_data); + + $serial_data = unpack( "H*", $serial_data ); + + my $rcvd = ''; + for (my $i = 0 ; $i < $len ; $i++ ) { + $rcvd = $rcvd . sprintf( "0x%s ", substr( $serial_data, $i * 2, 2 ) ); + } + + return $rcvd; +} + # ************************************** # * Send the command to the thermostat. # ************************************** @@ -533,77 +548,88 @@ sub add_checksum { # of 1.25s, that said it seems to work ok with the current timings and should work without resends unless your # serial cable wires are crap (use CAT-5) and/or very long -- merlin # -# FIXME, 2-3 times, I had this bug right after starting mh: -# 25/07/2009 10:15:30 : Omnistat[2]->read_cached_reg: reg=0x3b not cached, fetching -# 25/07/2009 10:15:30 : Omnistat->send_cmd string=0x02 0x20 0x3b 0x0e 0x6b (with 833325,us reply delay (14 char(s) to read back)) -# 25/07/2009 10:15:30 : Omnistat->send_cmd got reply "0xff 0x82 0xf2 0x3b 0x8b 0x64 0x03 0x00 0x00 0x78 0x1e 0x0f 0x0a 0x60 0x00 0x00 0x02 0x00 0xb2 " -# The 0xff in the reply didn't belong. No idea where it came from, especially because it was the first command and reply. -# for now it makes the code die, the command fail and then things restart and continue -- merlin sub send_cmd { # if you want to default to a full 2sec wait, pass '-1' as reply_count my ($self, $reply_count, @string) = @_; my $addr = $$self{address}; my $cmd = ''; - # We try to calculate how long we wait for the reply, or default to 2 sec (2M usec) - my $reply_wait = 2000000; + # We try to calculate how long we wait for the reply, but 2sec max (time can be fractional seconds). + my $max_reply_wait = 2; # some experimentation shows on my system that we need to wait 0.3sec + 0.1sec for each 3 registers returned --merlin # 300bps is 30cps, which does equate to 0.0333333s per character. From experimentation, one needs to wait an extra # 11 characters in addition to the payload you're expecting back to get reliable replies (10 almost works but causes # occasional corruption due to timings). -- merlin - # (12+ chars wait instead of 11 might be needed for you. Please increase & let me know if this is too short for you). - my $REPLY_BASE_DELAY = 11; - # While we don't get as many bytes as we sent if we were to set several registers in a row (which is not currently - # supported in this code), the spec says to wait 30ms per register set, so the wait time ends up being able the same - # when setting data than when polling it. - $reply_wait = (33333*($reply_count + $REPLY_BASE_DELAY)) if ($reply_count > -1); + # Waiting a pre-calculated time turned out to still be a bit unrealiable. It's much better to know how many characters + # you're expecting back (4 chars of header/footer + reply payload). + # If no reply count was given, we'll pretend to wait for 20 chars of payload, which will cause the 2sec watchdog + # to kick in. Max reply length is 14 chars AFAIK. + $reply_count = 16 if ($reply_count == -1); + # Omnistat sends 4 bytes of header/footer + payload for a query, or only 3 for a write. + if ($reply_count == 0) + { + $reply_count += 3; + } + else + { + $reply_count += 4; + } + + # Delete any data that might be waiting on the serial port before we send our command. + $_ = convert_omnistat_serial_data( read_omnistat_serial_data() ); + #omnistat_debug("Omnistat[$$self{address}]->send_cmd: Left over serial data before send_cmd (if any): $_"); + if ($_) + { + &::print_log("Omnistat[$$self{address}]->send_cmd: Left over serial data before send_cmd (likely bug/dropped data): $_"); + # I occasionally see this on restart, that's totally fine, it just cleans up leftover data on the port: + # Omnistat[2]->send_cmd: Left over serial data before send_cmd (likely bug/dropped data): 0xfe + } - omnistat_debug("Omnistat[$$self{address}]->send_cmd string=@string (with $reply_wait,us reply delay ($reply_count char(s) to read back))"); + omnistat_debug("Omnistat[$$self{address}]->send_cmd string=@string ($reply_count char(s) to read back)"); foreach my $byte (@string) { $byte =~ s/0x//; # strip off the 0x $cmd = $cmd . pack "H2", $byte; # pack it into 8 bits } - # send it to thermostat + # Send it to thermostat #omnistat_debug("Omnistat->send_cmd will write $cmd"); $main::Serial_Ports{Omnistat}{object}->write($cmd); - # need to wait a bit for the reply - # FIXME: sleep is bad, especially if you're not using usleep from Time::Hires, the only proper way to do this would be to - # have a request queue where one command gets processed every 1-2 seconds, but that would be a big rewrite -- merlin - &Omnistat::omni_sleep($reply_wait); + # Read response. + my $serial_data = ""; + my $rcvd; + my $len; + my $before_time = Time::HiRes::time(); + my $diff_time; - # read response - &main::check_for_generic_serial_data('Omnistat'); - my $temp = $main::Serial_Ports{Omnistat}{data}; - $main::Serial_Ports{Omnistat}{data} = ''; - my $len = length($temp); - $temp = unpack( "H*", $temp ); - my ($i); - my $rcvd = ''; - my $ack_byte = 0x80 + $addr; - for ( $i = 0 ; $i < $len ; $i++ ) { - $rcvd = $rcvd . sprintf( "0x%s ", substr( $temp, $i * 2, 2 ) ); + do + { + # Wait 33ms (to get at least one character). + Time::HiRes::usleep(33333); + $serial_data .= read_omnistat_serial_data(); + $len = length($serial_data); + $diff_time = Time::HiRes::time() - $before_time; + omnistat_debug("Omnistat[$$self{address}]->send_cmd received $len chars back (waiting for $reply_count). $diff_time elapsed out of max $max_reply_wait secs"); } - my $rcvd_ack = hex(substr($rcvd, 0 , 4)); + until ($len == $reply_count or $diff_time > $max_reply_wait); - if ($self->{'PRIME'}) + $rcvd = convert_omnistat_serial_data($serial_data); + if ($diff_time > $max_reply_wait) { - omnistat_debug("Omnistat[$$self{address}]->send_cmd skipping error check and return value during prime"); - return; + &::print_log("WARNING: Omnistat[$$self{address}]->send_cmd packet receive $diff_time exceeded ${max_reply_wait}sec, either a bug or misterhouse hung (Got $len out of $reply_count for command @string)"); + # A long hang can happen if misterhouse hung due to the OS while it was processing the tight loop above. At least the code deal + # with it by reading multiple characters at the same time. + # 26/11/2011 05:04:37 Omnistat[2]->send_cmd received 5 chars back (waiting for 18). 0.368366956710815 elapsed out of max 2 secs + # 26/11/2011 05:04:37 Omnistat[2]->send_cmd received 18 chars back (waiting for 18). 4.18395900726318 elapsed out of max 2 secs + # 26/11/2011 05:04:37 Paused for 4 seconds } - # FIXME? Those two dies aren't ideal, but it happens that you get corruption or bad data on a reply. - # Expected for 01 20 3b 0e 6a is something like - # 0x81 0xf2 0x3b 0x7c 0x71 0x03 0x00 0x00 0x7d 0x07 0x1e 0x0f 0x00 0x00 0x00 0x02 0x0c 0x5d - # but I have seen replies like - # 0x03 0xf2 0x3b 0x7c 0x71 0x03 0x00 0x00 0x7d 0x00 0x1c 0x0f 0x00 0x00 0x00 0x02 0x0c 0x54 (0x81 ack byte is wrong) - # or sync issues like - # 0x64 0x82 0xf2 0x3b 0x8e 0x64 0x00 0x00 0x00 0x7d 0x20 0x29 0x0f 0x60 0x00 0x00 0x00 0x00 0xd6 (0x64 shouldn't be here) - # On my system, this error only seems to happen soon after startup and doesn't seem to happen later -- merlin - die "$::Time_Date: Omnistat[$$self{address}]->send_cmd did not get ack reply to command @string ($rcvd)" unless (length($rcvd) > 3); - die "$::Time_Date: Omnistat[$$self{address}]->send_cmd did not get expected first byte (".sprintf("0x%02x",$ack_byte).") in ack reply to command @string (got ".sprintf("0x%02x", $rcvd_ack)." in $rcvd)" unless ($rcvd_ack eq $ack_byte); + my $ack_byte = 0x80 + $addr; + my $rcvd_ack = hex(substr($rcvd, 0 , 4)); + + $self->die_reset("$::Time_Date: Omnistat[$$self{address}]->send_cmd did not get ack reply to command @string (received: $rcvd). We were expecting $reply_count bytes back.") unless (length($rcvd) > 3); + $self->die_reset("$::Time_Date: Omnistat[$$self{address}]->send_cmd did not get expected first byte (".sprintf("0x%02x",$ack_byte).") in ack reply to command @string (got ".sprintf("0x%02x", $rcvd_ack)." in $rcvd)") unless ($rcvd_ack eq $ack_byte); omnistat_debug("Omnistat[$$self{address}]->send_cmd got reply \"$rcvd\""); return $rcvd; @@ -726,7 +752,7 @@ sub translate_temp { # this is a good place to catch a 14 reg read that happens in read_group1 extended, being off by one character, or returning # bogus 0's. - die "$::Time_Date: Omnistat->translate_temp got an input temperature of 0 = -40F/C, this typically means serial port corruption, bad... You may want to increase REPLY_BASE_DELAY" if (not $settemp or $settemp eq "0x00"); + die "$::Time_Date: Omnistat->translate_temp got an input temperature of 0 = -40F/C, this typically means serial port corruption, bad..." if (not $settemp or $settemp eq "0x00"); # Calculate conversion mathematically rather than using a table so all temps will work (needed for outside temperature) if ( substr( $settemp, 0, 2 ) eq '0x' ) @@ -843,12 +869,14 @@ sub translate_time { sub translate_stat_output { my ( $self, $reg48 ) = @_; - die "Omnistat::translate_stat_output got non hex value in '$reg48'" unless (is_hex($reg48)); - # see reg 0x48 / output register at the top of this file + $self->die_reset("Omnistat::translate_stat_output got non hex value in '$reg48'") unless (is_hex($reg48)); + + # see reg 0x48 / output register in the comments at the top of this file + # "0x0d" is turned into "fan/heat" my $output = "off"; $output = "fan" if (hex($reg48) & 8); - # if stage 1 and stage 2 heat/cool are off, return here + # if stage 1 (heat/coot) and stage 2 are off, return here #&::print_log("pass1: reg48: $reg48, $output"); return $output if (not hex($reg48) & (4+16)); @@ -1431,7 +1459,7 @@ sub get_program_mode { sub get_filter_reminder { my ( $self ) = @_; my $days = $self->read_cached_reg("0x0f",1); - return hex($days); + return (hex($days)); } sub set_filter_reminder { @@ -1476,28 +1504,77 @@ sub get_run_time_this_week { # * Get the run time for last week (in hours) # ************************************** sub get_run_time_last_week { - my ( $self) = @_; + my ( $self ) = @_; my $hours = $self->read_cached_reg("0x11",1); return hex($hours); } +# *************************************************************************** +# * Update the object's state (query with omnistat->state_now to see changes) +# *************************************************************************** + +# Good news is that state changes stack up , i.e. the last change does not overwrite the previous one. +# omnistat->state_now will just unroll changes as a FIFO for situations like these: +# 25/11/2011 23:30:37 Omnistat[2]->read_reg: set state->now to cool_sp_change +# 25/11/2011 23:30:37 Omnistat[2]->read_reg: set state->now to heat_sp_change +# 25/11/2011 23:30:37 Omnistat[2]->read_reg: set state->now to temp_change +sub set_state_change_if_any { + # register MUST be an hex STRING (i.e. "0x21", not 0x21) + my ( $self, $register ) = @_; + + if ($register eq "0x40") { + $self->set_receive('temp_change'); + omnistat_log("Omnistat[$$self{address}]->state_now set to temp_change"); + } elsif ($register eq "0x3b") { + $self->set_receive('cool_sp_change'); + omnistat_log("Omnistat[$$self{address}]->state_now set to cool_sp_change"); + } elsif ($register eq "0x3c") { + $self->set_receive('heat_sp_change'); + omnistat_log("Omnistat[$$self{address}]->state_now set to heat_sp_change"); + } elsif ($register eq "0x3d") { + $self->set_receive('mode_change'); + omnistat_log("Omnistat[$$self{address}]->state_now set to mode_change"); + } elsif ($register eq "0x3f") { + $self->set_receive('hold_change'); + omnistat_log("Omnistat[$$self{address}]->state_now set to hold_change"); + } elsif ($register eq "0x3e") { + $self->set_receive('fan_mode_change'); + omnistat_log("Omnistat[$$self{address}]->state_now set to fan_mode_change"); + } elsif ($register eq "0x0f") { + if ($self->get_filter_reminder eq 0) { + $self->set_receive('filter_reminder_now'); + omnistat_log("Omnistat[$$self{address}]->state_now set to filter_reminder_now"); + } else { + $self->set_receive('filter_reminder_change'); + omnistat_log("Omnistat[$$self{address}]->state_now set to filter_reminder_change"); + + } + # We test this one last so that if multiple changes happen at once, ->state shows this as + # the last relevant state, which is typically more important than the other ones. + } elsif ($register eq "0x48") { # this one is read only + $self->set_receive('current_output_change'); + omnistat_log("Omnistat[$$self{address}]->state_now set to current_output_change"); + } +} + # ********************************************* # * Read specified register(s) from Omnistat. # ********************************************* sub read_reg { - # register MUST be an hex STRING (i.e. "0x21", not 0x21) # I added a $whitelisted param to strongly hint that people use the caching call instead # but you can force a non caching call by just adding the whitelisted flag in the caller # yes, $count isn't optional anymore, sorry (but it is optional in read_cached_reg) -- merlin + + # register MUST be an hex STRING (i.e. "0x21", not 0x21) my ( $self, $register, $count, $whitelisted ) = @_; my $addr = $$self{address}; my ( @cmd, $regraw, $reg, $byte, $cnt ); my $i; my @value; - die "Omnistat::read_reg got non hex value in $register" unless (is_hex($register)); + $self->die_reset("Omnistat::read_reg got non hex value in $register") unless (is_hex($register)); warn "You should call read_cached_reg instead of read_reg to avoid hang delays. Adjust CACHE_TIMEOUT_ values in new(), and/or set debug=omnistat in mh.private.ini to adjust caching" if (not $whitelisted); - die "You can only read 14 registers at a time, you asked for $count" if ($count >14); + $self->die_reset("You can only read 14 registers at a time, you asked for $count") if ($count >14); $count = 1 if (not $count); @@ -1508,14 +1585,14 @@ sub read_reg { @cmd = add_checksum(@cmd); $regraw = $self->send_cmd($count, @cmd); $reg = substr( $regraw, 15, $count * 5 ); - die "Omnistat[$$self{address}]->read_reg: got empty response to @cmd (read $count regs from register offset $register), serial port send/read probably failed, check your configuration or you may have a timing issue and may need to increase REPLY_BASE_DELAY" if (not $reg); + $self->die_reset("Omnistat[$$self{address}]->read_reg: got incomplete response to @cmd: $regraw (read $count regs from register offset $register), serial port send/read probably failed, check your configuration or you may have a timing issue") if (not $reg); omnistat_debug("Omnistat[$$self{address}]->read_reg: reg[$register]=$reg"); # Cache the value(s) @value = split ' ', $reg; for ( $i = 0 ; $i < $count ; $i++ ) { - die "Omnistat[$$self{address}]->read_reg: got partial response to @cmd (read $count from $register), response truncated at byte $i. You may have a timing issue and may need to increase REPLY_BASE_DELAY" if (not $value[$i]); + $self->die_reset("Omnistat[$$self{address}]->read_reg: got partial response to @cmd (read $count from $register), response truncated at byte $i. You may have a timing issue.") if (not $value[$i]); my $regoffset = sprintf( "0x%02x", hex($register) + $i); @@ -1528,27 +1605,8 @@ sub read_reg { omnistat_debug("Omnistat[$$self{address}]->read_reg: reg[$regoffset]=$value[$i] updated in cache"); # Update the cache $$self{cache}{hex($regoffset)} = $value[$i]; - - # see if it's a register we care about and register state change if so - if ($regoffset eq "0x40") { - $self->set_receive('temp_change'); - } elsif ($regoffset eq "0x3b") { - $self->set_receive('cool_sp_change'); - } elsif ($regoffset eq "0x3c") { - $self->set_receive('heat_sp_change'); - } elsif ($regoffset eq "0x3d") { - $self->set_receive('mode_change'); - } elsif ($regoffset eq "0x3f") { - $self->set_receive('hold_change'); - } elsif ($regoffset eq "0x3e") { - $self->set_receive('fan_mode_change'); - } elsif ($regoffset eq "0x48") { # this one is read only - $self->set_receive('current_output_change'); - } elsif ($regoffset eq "0x0f") { - if ($value[$i] eq "0x00") { - $self->set_receive('filter_reminder'); - } - } + # Update state_now fifo. + $self->set_state_change_if_any($regoffset); } else { omnistat_debug("Omnistat[$$self{address}]->read_reg: reg[$regoffset]=$value[$i] current in cache"); } @@ -1569,14 +1627,14 @@ sub read_reg { # ********************************************* # * Write specified register to Omnistat. # ********************************************* -#TODO: add ability to set multiple registers at once +#TODO: add ability to set multiple registers at once (if ever needed, I don't have that need) sub set_reg { # register MUST be an hex STRING (i.e. "0x21", not 0x21) my ( $self, $register, $value ) = @_; my $addr = $$self{address}; my (@cmd); - die "Omnistat::set_reg got non hex value in $register <- $value" unless (is_hex($register) and is_hex($value)); + $self->die_reset("Omnistat::set_reg got non hex value in $register <- $value") unless (is_hex($register) and is_hex($value)); $cmd[0] = sprintf( "0x%02x", $addr ); $cmd[1] = "0x21"; $cmd[2] = $register; @@ -1589,25 +1647,8 @@ sub set_reg { { if ($$self{cache}{ hex($register) } ne $value) { - # TODO, merge with above, prevent duplication # register changed, check for state change - if ($register eq "0x40") { - $self->set_receive('temp_change'); - } elsif ($register eq "0x3b") { - $self->set_receive('cool_sp_change'); - } elsif ($register eq "0x3c") { - $self->set_receive('heat_sp_change'); - } elsif ($register eq "0x3d") { - $self->set_receive('mode_change'); - } elsif ($register eq "0x3f") { - $self->set_receive('hold_change'); - } elsif ($register eq "0x3e") { - $self->set_receive('fan_mode_change'); - } elsif ($register eq "0x0f") { - if ($value eq "0x00") { - $self->set_receive('filter_reminder'); - } - } + $self->set_state_change_if_any($register); } } @@ -1631,7 +1672,7 @@ sub read_cached_reg { my $value; my $regval; - die "Omnistat::read_cached_reg got non hex value in $register" unless (is_hex($register)); + $self->die_reset("Omnistat::read_cached_reg got non hex value in $register") unless (is_hex($register)); $count = 1 if (not $count); # First see if we can read from the cache @@ -1709,6 +1750,9 @@ sub read_group1 { # $group1raw = $self->send_cmd(6, @cmd); + # plus_output: Do we fetch enough registers to receive output register too? + # This forces us to fetch more data than needed, but it's not slower than + # querying group1 and then ouput separately. Too bad output isn't part of group1. if ($plus_output) { $group1 = $self->read_cached_reg("0x3b", 14, $maxcachetime); ( $cool_set, $heat_set, $mode, $fan, $hold, $cur, $_, $_, $_, $_, $_, $_, $_, $output ) = split(' ', $group1); @@ -1743,3 +1787,4 @@ sub read_cached_group1 { 1; +# vim:sts=2:sw=2 diff --git a/lib/X10_CMxx_mochad-0.1.7.diff b/lib/X10_CMxx_mochad-0.1.7.diff new file mode 100644 index 000000000..87f955177 --- /dev/null +++ b/lib/X10_CMxx_mochad-0.1.7.diff @@ -0,0 +1,127 @@ +diff -urN mochad-0.1.7.orig/apps/mochad.scr mochad-0.1.7/apps/mochad.scr +--- mochad-0.1.7.orig/apps/mochad.scr 1969-12-31 16:00:00.000000000 -0800 ++++ mochad-0.1.7/apps/mochad.scr 2011-07-02 12:51:46.502164447 -0700 +@@ -0,0 +1,29 @@ ++#!/bin/bash ++ ++# By marc_soft@merlins.org. ++ ++# This script is designed to get mochad raw data to a fifo. ++# This is used as an input source for misterhouse, ++# See misterhouse/lib/X10_CMxx.pm for more details. ++ ++# For this script to be useful linux with udev, you'll want ++# to edit /etc/udev/rules.d/91-usb-x10-controllers.rules ++# and make sure this script is run instead of the mochad binary. ++ ++FIFO=/var/run/CM19a ++ ++# Kill left over daemon just in case. ++killall mochad 2>/dev/null ++ ++/bin/rm $FIFO 2>/dev/null ++mkfifo $FIFO ++ ++# mochad forks off. ++/usr/local/bin/mochad --raw-data ++ ++( while : ++do ++ nc localhost 1099 > $FIFO ++ # This will restart nc as long as the mochad daemon is running. ++ pgrep -f '/usr/local/bin/mochad --raw-data' > /dev/null || break ++done ) & +diff -urN mochad-0.1.7.orig/decode.c mochad-0.1.7/decode.c +--- mochad-0.1.7.orig/decode.c 2011-03-27 16:20:49.000000000 -0700 ++++ mochad-0.1.7/decode.c 2011-07-01 10:46:01.419570619 -0700 +@@ -875,8 +875,10 @@ + *p = 0x5d; + memcpy(p+1, buf, len); + len++; +- cm15a_decode_rf(fd, p, len); +- return; ++ } ++ ++ if (raw_data) { ++ mh_sockhexdump(fd, p, len); + } + + switch (*p) +diff -urN mochad-0.1.7.orig/decode.h mochad-0.1.7/decode.h +--- mochad-0.1.7.orig/decode.h 2011-03-20 22:58:48.000000000 -0700 ++++ mochad-0.1.7/decode.h 2011-07-01 10:46:44.801939582 -0700 +@@ -17,6 +17,8 @@ + * along with mochad. If not, see . + */ + ++extern int raw_data; ++ + const char *findSecEventName(unsigned char secev); + + const char *findSecRemoteKeyName(unsigned char secev); +diff -urN mochad-0.1.7.orig/mochad.c mochad-0.1.7/mochad.c +--- mochad-0.1.7.orig/mochad.c 2011-03-21 03:19:43.000000000 -0700 ++++ mochad-0.1.7/mochad.c 2011-07-01 10:46:58.343742575 -0700 +@@ -164,6 +164,16 @@ + sockprintf(fd, "%s\n", buf); + } + ++// Output Raw data with header for parsing by misterhouse ++void mh_sockhexdump(int fd, void *p, size_t len) ++{ ++ char buf[(3*100)+1]; ++ ++ _hexdump(p, len, buf, sizeof(buf)); ++ sockprintf(fd, "Raw data received: %s\n", buf); ++} ++ ++ + static int Do_exit = 0; + static int Reattach = 0; + +@@ -685,6 +695,9 @@ + fflush(NULL); + } + ++// This affects whether decode.c will show raw frame data for debugging RF connectivity ++// as well as providing raw data for parsing by users like misterhouse's X10_CMxx module. ++int raw_data = 0; + int main(int argc, char *argv[]) + { + int rc, i; +@@ -698,6 +711,8 @@ + for (i = 1; i < argc; i++) { + if (strcmp(argv[i], "-d") == 0) + foreground = 1; ++ if (strcmp(argv[i], "--raw-data") == 0) ++ raw_data = 1; + else if (strcmp(argv[i], "--version") == 0) { + printf("%s\n", PACKAGE_STRING); + printcopy(); +diff -urN mochad-0.1.7.orig/README mochad-0.1.7/README +--- mochad-0.1.7.orig/README 2010-12-21 17:45:11.000000000 -0800 ++++ mochad-0.1.7/README 2011-07-01 23:35:09.255139648 -0700 +@@ -85,6 +85,23 @@ + Please see http://sourceforge.net/apps/mediawiki/mochad/index.php?title=Main_Page + for more details on command and event messages. + ++ ++If you want to debug X10 RF, or gateway raw frames to another program, you can ++use the --raw-data argument. ++See apps/mochad.scr for an example on how to gateway frames with misterhouse. ++ ++Another use is to simply be able to get all the raw RF frames to see if the ++multiple copies received are identical (good), off by a few bits (RF marginal), ++or nonsensical (bad). ++ ++ 07/01 23:34:42 Rx RF HouseUnit: A1 Func: Off ++ 07/01 23:34:42 Raw data received: 5D 20 60 9F 20 DF ++ 07/01 23:34:42 Raw data received: 5D 20 60 9F 20 DF ++ 07/01 23:34:43 Raw data received: 5D 20 60 9F 20 DF ++ 07/01 23:34:43 Raw data received: 5D 20 60 9F 20 DF ++ 07/01 23:34:43 Raw data received: 5D 20 60 9F 20 DF ++ ++ + == Multiple controllers + + The Perl program mochamon.pl shows how to monitor more than one instance of diff --git a/lib/read_table_A.pl b/lib/read_table_A.pl index 40b46d9e7..f86834765 100644 --- a/lib/read_table_A.pl +++ b/lib/read_table_A.pl @@ -14,7 +14,7 @@ #print_log "Using read_table_A.pl"; -my (%groups, %objects, %packages); +my (%groups, %objects, %packages, %addresses); sub read_table_init_A { # reset known groups @@ -22,6 +22,7 @@ sub read_table_init_A { %groups=(); %objects=(); %packages=(); + %addresses=(); } sub read_table_A { @@ -32,7 +33,7 @@ sub read_table_A { } $record =~ s/\s*#.*$//; - my ($code, $address, $name, $object, $grouplist, $comparison, $limit, @other, $other, $vcommand, $occupancy,$network,$password); + my ($code, $address, $name, $object, $grouplist, $comparison, $limit, @other, $other, $vcommand, $occupancy,$network,$password, $interface); my(@item_info) = split(',\s*', $record); my $type = uc shift @item_info; @@ -84,29 +85,71 @@ sub read_table_A { } # ---------------------------------------------------------------------- elsif($type eq "INSTEON_PLM") { - require 'Insteon_PLM.pm'; + require Insteon_PLM; ($name, $grouplist, @other) = @item_info; $other = join ', ', (map {"'$_'"} @other); # Quote data - $object = "Insteon_PLM('Insteon_PLM')"; + $object = "Insteon_PLM('Insteon_PLM',$other)"; } - elsif($type eq "IPLD") { - require 'Insteon_Device.pm'; - ($address, $name, $grouplist, $object, @other) = @item_info; + elsif($type eq "INSTEON_LAMPLINC") { + require Insteon::Lighting; + ($address, $name, $grouplist, @other) = @item_info; $other = join ', ', (map {"'$_'"} @other); # Quote data - $object = "Insteon_Device(\$$object, \'$address\', $other)"; + $object = "Insteon::LampLinc(\'$address\',$other)"; } - elsif($type eq "IPLL") { - require 'Insteon_Link.pm'; - ($address, $name, $grouplist, $object, @other) = @item_info; + elsif($type eq "INSTEON_APPLIANCELINC") { + require Insteon::Lighting; + ($address, $name, $grouplist, @other) = @item_info; + $other = join ', ', (map {"'$_'"} @other); # Quote data + $object = "Insteon::ApplianceLinc(\'$address\',$other)"; + } + elsif($type eq "INSTEON_SWITCHLINC") { + require Insteon::Lighting; + ($address, $name, $grouplist, @other) = @item_info; + $other = join ', ', (map {"'$_'"} @other); # Quote data + $object = "Insteon::SwitchLinc(\'$address\',$other)"; + } + elsif($type eq "INSTEON_SWITCHLINCRELAY") { + require Insteon::Lighting; + ($address, $name, $grouplist, @other) = @item_info; + $other = join ', ', (map {"'$_'"} @other); # Quote data + $object = "Insteon::SwitchLincRelay(\'$address\',$other)"; + } + elsif($type eq "INSTEON_KEYPADLINC") { + require Insteon::Lighting; + ($address, $name, $grouplist, @other) = @item_info; + $other = join ', ', (map {"'$_'"} @other); # Quote data + $object = "Insteon::KeyPadLinc(\'$address\', $other)"; + } + elsif($type eq "INSTEON_KEYPADLINCRELAY") { + require Insteon::Lighting; + ($address, $name, $grouplist, @other) = @item_info; + $other = join ', ', (map {"'$_'"} @other); # Quote data + $object = "Insteon::KeyPadLincRelay(\'$address\', $other)"; + } + elsif($type eq "INSTEON_REMOTELINC") { + require Insteon::Controller; + ($address, $name, $grouplist, @other) = @item_info; + $other = join ', ', (map {"'$_'"} @other); # Quote data + $object = "Insteon::RemoteLinc(\'$address\', $other)"; + } + elsif($type eq "INSTEON_MOTIONSENSOR") { + require Insteon::Security; + ($address, $name, $grouplist, @other) = @item_info; + $other = join ', ', (map {"'$_'"} @other); # Quote data + $object = "Insteon::MotionSensor(\'$address\', $other)"; + } + elsif($type eq "INSTEON_ICONTROLLER") { + require Insteon::BaseInsteon; + ($address, $name, $grouplist, @other) = @item_info; $other = join ', ', (map {"'$_'"} @other); # Quote data my ($deviceid,$groupid) = $address =~ /(\S+):(\S+)/; - if ($deviceid =~ /$object/i) { - $object = "Insteon_Link(\$$object, \'00.00.00:$groupid\', $other)"; + if ($groupid) { + $object = "Insteon::InterfaceController(\'00.00.00:$groupid\', $other)"; } else { - $object = "Insteon_Link(\$$object, \'$address\', $other)"; + $object = "Insteon::InterfaceController(\'00.00.00:$address\', $other)"; } } - elsif($type eq 'IPLT') { + elsif($type eq 'IPLT' or $type eq 'INSTEON_THERMOSTAT') { require 'Insteon_Thermostat.pm'; ($address, $name, $grouplist, $object, @other) = @item_info; $other = join ', ', (map {"'$_'"} @other); # Quote data @@ -800,7 +843,7 @@ sub read_table_A { if( ! $packages{xPL_Plugwise}++ ) { # first time for this object type? $code .= "use xPL_Plugwise;\n"; } - } + } elsif($type eq "XPL_SQUEEZEBOX") { ($address, $name, $grouplist, @other) = @item_info; $other = join ', ', (map {"'$_'"} @other); # Quote data @@ -919,7 +962,8 @@ sub read_table_A { $code .= sprintf "\$%-35s -> add(\$%s);\n", $scene_name, $name; } } else { - print "\nThere is no object called $scene_name defined. Ignoring SCENE_MEMBER entry.\n"; + print "\nThere is no object called $scene_name defined. Ignoring SCENE_MEMBER entry.\n" unless $objects{$scene_name}; + print "\nThere is no object called $name defined. Ignoring SCENE_MEMBER entry.\n" unless $objects{$name}; } $object = ''; } else { diff --git a/lib/site/DateTime/TimeZone.pm b/lib/site/DateTime/TimeZone.pm index 39b5dca73..f26a9b459 100644 --- a/lib/site/DateTime/TimeZone.pm +++ b/lib/site/DateTime/TimeZone.pm @@ -1,11 +1,13 @@ package DateTime::TimeZone; +use 5.006; + use strict; +use warnings; -use vars qw( $VERSION ); -$VERSION = '0.6603'; +our $VERSION = '0.84'; -use DateTime::TimeZoneCatalog; +use DateTime::TimeZone::Catalog; use DateTime::TimeZone::Floating; use DateTime::TimeZone::Local; use DateTime::TimeZone::OffsetOnly; @@ -24,7 +26,7 @@ use constant OFFSET => 4; use constant IS_DST => 5; use constant SHORT_NAME => 6; -my %SpecialName = map { $_ => 1 } qw( EST MST HST EST5EDT CST6CDT MST7MDT PST8PDT ); +my %SpecialName = map { $_ => 1 } qw( EST MST HST CET EET MET WET EST5EDT CST6CDT MST7MDT PST8PDT ); sub new { @@ -33,13 +35,13 @@ sub new { name => { type => SCALAR } }, ); - if ( exists $DateTime::TimeZone::LINKS{ $p{name} } ) + if ( exists $DateTime::TimeZone::Catalog::LINKS{ $p{name} } ) { - $p{name} = $DateTime::TimeZone::LINKS{ $p{name} }; + $p{name} = $DateTime::TimeZone::Catalog::LINKS{ $p{name} }; } - elsif ( exists $DateTime::TimeZone::LINKS{ uc $p{name} } ) + elsif ( exists $DateTime::TimeZone::Catalog::LINKS{ uc $p{name} } ) { - $p{name} = $DateTime::TimeZone::LINKS{ uc $p{name} }; + $p{name} = $DateTime::TimeZone::Catalog::LINKS{ uc $p{name} }; } unless ( $p{name} =~ m,/, @@ -100,7 +102,7 @@ sub new $zone->can('olson_version') ? $zone->olson_version() : 'unknown'; - my $catalog_version = __PACKAGE__->catalog_olson_version(); + my $catalog_version = DateTime::TimeZone::Catalog->OlsonVersion(); if ( $object_version ne $catalog_version ) { @@ -404,9 +406,13 @@ sub category { (split /\//, $_[0]->{name}, 2)[0] } sub is_valid_name { - my $tz = eval { $_[0]->new( name => $_[1] ) }; + my $tz; + { + local $@; + $tz = eval { $_[0]->new( name => $_[1] ) }; + } - return $tz && UNIVERSAL::isa( $tz, 'DateTime::TimeZone') ? 1 : 0 + return $tz && $tz->isa('DateTime::TimeZone') ? 1 : 0 } sub STORABLE_freeze @@ -444,7 +450,11 @@ sub STORABLE_thaw # sub offset_as_seconds { - shift if eval { $_[0]->isa('DateTime::TimeZone') }; + { + local $@; + shift if eval { $_[0]->isa('DateTime::TimeZone') }; + } + my $offset = shift; return undef unless defined $offset; @@ -479,7 +489,11 @@ sub offset_as_seconds sub offset_as_string { - shift if eval { $_[0]->isa('DateTime::TimeZone') }; + { + local $@; + shift if eval { $_[0]->isa('DateTime::TimeZone') }; + } + my $offset = shift; return undef unless defined $offset; @@ -501,54 +515,54 @@ sub offset_as_string ); } -# These methods all operate on data contained in the DateTime/TimeZoneCatalog.pm file. +# These methods all operate on data contained in the DateTime/TimeZone/Catalog.pm file. sub all_names { - return wantarray ? @DateTime::TimeZone::ALL : [@DateTime::TimeZone::ALL]; + return wantarray ? @DateTime::TimeZone::Catalog::ALL : [@DateTime::TimeZone::Catalog::ALL]; } sub categories { return wantarray - ? @DateTime::TimeZone::CATEGORY_NAMES - : [@DateTime::TimeZone::CATEGORY_NAMES]; + ? @DateTime::TimeZone::Catalog::CATEGORY_NAMES + : [@DateTime::TimeZone::Catalog::CATEGORY_NAMES]; } sub links { return - wantarray ? %DateTime::TimeZone::LINKS : {%DateTime::TimeZone::LINKS}; + wantarray ? %DateTime::TimeZone::Catalog::LINKS : {%DateTime::TimeZone::Catalog::LINKS}; } sub names_in_category { shift if $_[0]->isa('DateTime::TimeZone'); - return unless exists $DateTime::TimeZone::CATEGORIES{ $_[0] }; + return unless exists $DateTime::TimeZone::Catalog::CATEGORIES{ $_[0] }; return wantarray - ? @{ $DateTime::TimeZone::CATEGORIES{ $_[0] } } - : [ $DateTime::TimeZone::CATEGORIES{ $_[0] } ]; + ? @{ $DateTime::TimeZone::Catalog::CATEGORIES{ $_[0] } } + : [ $DateTime::TimeZone::Catalog::CATEGORIES{ $_[0] } ]; } sub countries { wantarray - ? ( sort keys %DateTime::TimeZone::ZONES_BY_COUNTRY ) - : [ sort keys %DateTime::TimeZone::ZONES_BY_COUNTRY ]; + ? ( sort keys %DateTime::TimeZone::Catalog::ZONES_BY_COUNTRY ) + : [ sort keys %DateTime::TimeZone::Catalog::ZONES_BY_COUNTRY ]; } sub names_in_country { shift if $_[0]->isa('DateTime::TimeZone'); - return unless exists $DateTime::TimeZone::ZONES_BY_COUNTRY{ lc $_[0] }; + return unless exists $DateTime::TimeZone::Catalog::ZONES_BY_COUNTRY{ lc $_[0] }; return wantarray - ? @{ $DateTime::TimeZone::ZONES_BY_COUNTRY{ lc $_[0] } } - : $DateTime::TimeZone::ZONES_BY_COUNTRY{ lc $_[0] }; + ? @{ $DateTime::TimeZone::Catalog::ZONES_BY_COUNTRY{ lc $_[0] } } + : $DateTime::TimeZone::Catalog::ZONES_BY_COUNTRY{ lc $_[0] }; } @@ -623,34 +637,21 @@ C object is returned. If the "name" parameter is "local", then the module attempts to determine the local time zone for the system. -First it checks C<$ENV> for keys named "TZ", "SYS$TIMEZONE_RULE", -"SYS$TIMEZONE_NAME", "UCX$TZ", or "TCPIP$TZC" (the last 4 are for -VMS). If this is defined, and it is not the string "local", then it -is treated as any other valid name (including "floating"), and the -constructor tries to create a time zone based on that name. +The method for finding the local zone varies by operating system. See +the appropriate module for details of how we check for the local time +zone. + +=over 4 -Next, it checks for the existence of a symlink at F. -It follows this link to the real file and figures out what the file's -name is. It then tries to turn this name into a valid time zone. For -example, if this file is linked to F, -it will end up trying "US/Central", which will then be converted to -"America/Chicago" internally. +=item * L -Some systems just copy the relevant file to F instead -of making a symlink. In this case, we look in F -for a file that has the same size and content as F to -determine the local time zone. +=item * L -Then it checks for a file called F or F. -If one of these exists, it is read and it tries to create a time zone -with the name contained in the file. +=item * L -Finally, it checks for a file called F. If this -file exists, it looks for a line inside the file matching -C. If this line exists, it tries the -value as a time zone name. +=back -If none of these methods work, it gives up and dies. +If a local time zone is not found, then an exception will be thrown. =head2 $tz->offset_for_datetime( $dt ) @@ -756,7 +757,7 @@ use C to do so. =head2 DateTime::TimeZone->names_in_country( $country_code ) -Given a two-letter ISO3066 country code, this method returns a list of +Given a two-letter ISO3166 country code, this method returns a list of time zones used in that country. The country code may be of any case. In scalar context, it returns an array reference, while in list context it returns an array. @@ -793,12 +794,33 @@ your module with Storable. =head1 SUPPORT Support for this module is provided via the datetime@perl.org email -list. See http://lists.perl.org/ for more details. +list. See http://datetime.perl.org/?MailingList for details. Please submit bugs to the CPAN RT system at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=datetime%3A%3Atimezone or via email at bug-datetime-timezone@rt.cpan.org. +=head1 DONATIONS + +If you'd like to thank me for the work I've done on this module, +please consider making a "donation" to me via PayPal. I spend a lot of +free time creating free software, and would appreciate any support +you'd care to offer. + +Please note that B in order +for me to continue working on this particular software. I will +continue to do so, inasmuch as I have in the past, for as long as it +interests me. + +Similarly, a donation made in this way will probably not make me work +on this software much more, unless I get so many donations that I can +consider working on free software full time, which seems unlikely at +best. + +To donate, log into PayPal and send money to autarch@urth.org or use +the button on this page: +L + =head1 AUTHOR Dave Rolsky @@ -811,7 +833,7 @@ datetime@perl.org list. =head1 COPYRIGHT -Copyright (c) 2003-2007 David Rolsky. All rights reserved. This +Copyright (c) 2003-2008 David Rolsky. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/lib/site/HTTP/Date.pm b/lib/site/HTTP/Date.pm index a2e08b533..95e568e1c 100644 --- a/lib/site/HTTP/Date.pm +++ b/lib/site/HTTP/Date.pm @@ -1,6 +1,5 @@ package HTTP::Date; # $Date$ -$VERSION = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/); require 5.004; require Exporter; diff --git a/lib/site/HTTP/Headers.pm b/lib/site/HTTP/Headers.pm index febee2eb3..755b95d4f 100644 --- a/lib/site/HTTP/Headers.pm +++ b/lib/site/HTTP/Headers.pm @@ -6,7 +6,6 @@ use strict; use Carp (); use vars qw($VERSION $TRANSLATE_UNDERSCORE); -$VERSION = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/); # The $TRANSLATE_UNDERSCORE variable controls whether '_' can be used # as a replacement for '-' in header field names. diff --git a/lib/site/HTTP/Message.pm b/lib/site/HTTP/Message.pm index 36a26163f..295d563f4 100644 --- a/lib/site/HTTP/Message.pm +++ b/lib/site/HTTP/Message.pm @@ -4,7 +4,7 @@ package HTTP::Message; use strict; use vars qw($VERSION $AUTOLOAD); -$VERSION = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/); +$VERSION = '1.23'; require HTTP::Headers; require Carp; diff --git a/lib/site/HTTP/Request.pm b/lib/site/HTTP/Request.pm index 4902fa624..54a6030ad 100644 --- a/lib/site/HTTP/Request.pm +++ b/lib/site/HTTP/Request.pm @@ -4,7 +4,6 @@ package HTTP::Request; require HTTP::Message; @ISA = qw(HTTP::Message); -$VERSION = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/); use strict; diff --git a/lib/site/HTTP/Response.pm b/lib/site/HTTP/Response.pm index fb56ed38a..e7d8999bf 100644 --- a/lib/site/HTTP/Response.pm +++ b/lib/site/HTTP/Response.pm @@ -4,7 +4,6 @@ package HTTP::Response; require HTTP::Message; @ISA = qw(HTTP::Message); -$VERSION = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/); use strict; use HTTP::Status (); diff --git a/lib/site/HTTP/Status.pm b/lib/site/HTTP/Status.pm index ebb02c4c6..31a77fd53 100644 --- a/lib/site/HTTP/Status.pm +++ b/lib/site/HTTP/Status.pm @@ -11,7 +11,7 @@ require Exporter; @ISA = qw(Exporter); @EXPORT = qw(is_info is_success is_redirect is_error status_message); @EXPORT_OK = qw(is_client_error is_server_error); -$VERSION = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/); +$VERSION = '1.23'; # Note also addition of mnemonics to @EXPORT below diff --git a/lib/site/OW.pm b/lib/site/OW.pm index 892f7b646..9af3c068d 100755 --- a/lib/site/OW.pm +++ b/lib/site/OW.pm @@ -1,16 +1,16 @@ # This file was automatically generated by SWIG (http://www.swig.org). -# Version 1.3.33 +# Version 1.3.40 # -# Don't modify this file, modify the SWIG interface instead. +# Do not make changes to this file unless you know what you are doing--modify +# the SWIG interface file instead. package OW; -require Exporter; -require DynaLoader; -@ISA = qw(Exporter DynaLoader); +use base qw(Exporter); +use base qw(DynaLoader); package OWc; bootstrap OW; package OW; -@EXPORT = qw( ); +@EXPORT = qw(); # ---------- BASE METHODS ------------- @@ -58,6 +58,7 @@ package OW; *get_error_print = *OWc::get_error_print; *set_error_level = *OWc::set_error_level; *get_error_level = *OWc::get_error_level; +*opt = *OWc::opt; # ------- VARIABLE STUBS -------- diff --git a/web/bin/button_action.pl b/web/bin/button_action.pl index 2717f8e6e..4c6fddf78 100644 --- a/web/bin/button_action.pl +++ b/web/bin/button_action.pl @@ -11,7 +11,7 @@ #print "db ln=$list_name, i=$item, s=$state_xy xy=$x,$y\n"; # Do not dim the dishwasher :) -unless (eval qq|$item->isa('X10_Appliance') or $item->isa('Fan_Motor')|) { +unless (eval qq|$item->isa('X10_Appliance') or $item->isa('Fan_Motor') or $item->isa('Insteon_Device')|) { $state = 'dim' if $x < 40; # Left side of image $state = 'brighten' if $x > 110; # Right side of image } @@ -22,6 +22,9 @@ $state = 'up' if $x > 110; # Right side of image } +#if (eval qq|$item->isa('Insteon_Device'|) { +# $state = "toggle"; +#} eval qq|$item->set("$state", 'web')|; print "button_action.pl eval error: $@\n" if $@; diff --git a/web/bin/items.pl b/web/bin/items.pl index 37f17afd8..8fbf3c409 100644 --- a/web/bin/items.pl +++ b/web/bin/items.pl @@ -52,8 +52,8 @@ sub web_items_list { my $default = File::Spec->catfile(@Code_Dirs[0], "items.mht"); push @file_paths, $default unless @file_paths[0]; # Create new items file if none - $web_item_file_name = @file_paths[0] unless $web_item_file_name; # Default to first mht file found - $web_item_file_name = $1 if $ARGV[0] =~ /^file=(.+)$/; # User selected another mht file + $web_item_file_name = @file_paths[0] unless $web_item_file_name; # Default to first mht file found + $web_item_file_name = $1 if $ARGV[0] =~ /^file=(.+)$/; # User selected another mht file # Create a form to pick which file $html .= "
Which .mht file to edit?\n"; @@ -62,18 +62,20 @@ sub web_items_list { # Create form to add an item my $form_type = &html_form_select('type', 0, 'X10 Light (X10I)', - 'Analog Sensor (ANALOG_SENSOR)', 'AUDIOTRON', 'COMPOOL', - 'EIB Switch (EIB1)', 'EIB Switch Group (EIB1G)', 'EIB Dimmer (EIB2)', + 'Analog Sensor (ANALOG_SENSOR)', 'AUDIOTRON', 'COMPOOL', + 'EIB Switch (EIB1)', 'EIB Switch Group (EIB1G)', 'EIB Dimmer (EIB2)', 'EIB Value (EIB5)', 'EIB Drive (EIB7)', - 'GENERIC', 'GROUP', 'IBUTTON', 'INSTEON_PLM','Insteon Device (IPLD)','Insteon Link (IPLL)', - 'MP3PLAYER', 'One-Wire xAP Connector (OWX)', 'RF', 'SERIAL', - 'SG485LCD', 'SG485RCSTHRM', 'STARGATEDIN', 'STARGATEVAR', - 'STARGATEFLAG', 'STARGATERELAY', 'STARGATETHERM', 'STARGATEPHONE', - 'VOICE', 'WEATHER', + 'GENERIC', 'GROUP', 'IBUTTON', 'INSTEON_PLM','INSTEON_LAMPLINC','INSTEON_APPLIANCELINC', + 'INSTEON_SWITCHLINC','INSTEON_SWITCHLINCRELAY','INSTEON_KEYPADLINC','INSTEON_KEYPADLINCRELAY', + 'INSTEON_REMOTELINC','INSTEON_MOTIONSENSOR','INSTEON_ICONTROLLER', + 'MP3PLAYER', 'One-Wire xAP Connector (OWX)', 'RF', 'SERIAL', + 'SG485LCD', 'SG485RCSTHRM', 'STARGATEDIN', 'STARGATEVAR', + 'STARGATEFLAG', 'STARGATERELAY', 'STARGATETHERM', 'STARGATEPHONE', + 'VOICE', 'WEATHER', 'X10 Appliance (X10A)', 'X10 Light (X10I)', 'X10 Ote (X10O)', 'X10 SwitchLinc (X10SL)', 'X10 Garage Door (X10G)', 'X10 Irrigation (X10S)', 'X10 RCS (X10T)', 'X10 Motion Sensor (X10MS)', 'X10 6 Button Remote (X106BUTTON)', - 'XANTECH', + 'XANTECH', ); #form action='/bin/items.pl?add' method=post> @@ -117,7 +119,7 @@ sub web_items_list { $html .= "
\n"; # Define fields by type - my %headers = ( + my %headers = ( ANALOG_SENSOR => ['Identifier', 'Name', 'Conduit', 'Groups', 'Type', 'Tokens'], EIB1 => ['Address', 'Name', 'Groups', 'Mode'], EIB1G => ['Address', 'Name', 'Groups', 'Addresses'], @@ -134,12 +136,19 @@ sub web_items_list { X10SL => [qw(Address Name Groups Interface Options)], X10MS => [qw(Address Name Groups Type)], X106BUTTON => [qw(Address Name)], - UPBPIM => [qw(Name NetworkID Password Address)], - UPBD => [qw(Name Interface NetworkID Address Groups)], - UPBL => [qw(Name Interface NetworkID Address Groups)], - INSTEON_PLM => [qw(Name)], - IPLD => [qw(Address Name Groups Interface Options)], - IPLL => [qw(Address Name Groups Interface Options)], + UPBPIM => [qw(Name NetworkID Password Address)], + UPBD => [qw(Name Interface NetworkID Address Groups)], + UPBL => [qw(Name Interface NetworkID Address Groups)], + INSTEON_PLM => [qw(Name)], + INSTEON_LAMPLINC => [qw(Address Name Groups)], + INSTEON_APPLIANCELINC => [qw(Address Name Groups)], + INSTEON_SWITCHLINC => [qw(Address Name Groups)], + INSTEON_SWITCHLINCRELAY => [qw(Address Name Groups)], + INSTEON_KEYPADLINC => [qw(Address Name Groups)], + INSTEON_KEYPADLINCRELAY => [qw(Address Name Groups)], + INSTEON_REMOTELINC => [qw(Address Name Groups)], + INSTEON_MOTIONSENSOR => [qw(Address Name Groups)], + INSTEON_ICONTROLLER => [qw(Address Name Groups)], SCENE_MEMBER => [qw(MemberName LinkName OnLevel RampRate)], default => [qw(Address Name Groups Other)] ); @@ -199,10 +208,14 @@ sub web_item_set_field { $data =~ s/[^a-z0-9_]//ig; } - # Replace the updated field + # Get current item record and split into fields + my $record = @file_data[$pos]; + my @item_info = split(',\s*', $record); + + # Replace the updated field $item_info[$field] = $data; - # Rebuild the record with updated field + # Rebuild the record with updated field $record = ''; while (@item_info) { my $item = shift @item_info; @@ -211,7 +224,7 @@ sub web_item_set_field { } $record =~ s/ *$//; - # Replace the updated record and write out mht file + # Replace the updated record and write out mht file $file_data[$pos] = $record; # print "db2 p=$pos f=$field d=$data r=$record\n"; @@ -264,8 +277,8 @@ sub web_item_add { } $other2 =~ s/,$//; - # write out new record to mht file - $file_data[@file_data] = sprintf("%-20s%-20s%-20s%-20s%-20s%s", + # write out new record to mht file + $file_data[@file_data] = sprintf("%-20s%-20s%-20s%-20s%-20s%s", $type, $address, $name, $group, $other1, $other2); &mht_item_file_write($web_item_file_name, \@file_data); diff --git a/web/hai b/web/hai new file mode 120000 index 000000000..fa175d172 --- /dev/null +++ b/web/hai @@ -0,0 +1 @@ +../code/support/hai-omnistat/hai_web \ No newline at end of file diff --git a/web/lib/default.xsl b/web/lib/default.xsl index ea30c04e6..dca03344e 100755 --- a/web/lib/default.xsl +++ b/web/lib/default.xsl @@ -1,13 +1,13 @@ - - + + - + - + @@ -28,10 +28,10 @@ - + - +
    @@ -63,7 +63,7 @@
- +
  • @@ -80,7 +80,7 @@ - + @@ -111,7 +111,7 @@ - + @@ -131,5 +131,5 @@ - - + +