From 1973c129e9beb819eae8900f6883582042e8a3fe Mon Sep 17 00:00:00 2001 From: Lieven Hollevoet Date: Sun, 18 Aug 2013 22:15:55 +0200 Subject: [PATCH 001/180] Remove hard-coded Perl path that causes email fetching to fail. When a user installs a local Perl version to run MisterHouse under instead of using the system-provided Perl, then the hardcoded Perl path at the shebang in get_email causes the module search path to be incorrect. /usr/bin/env perl properly solves this issue. --- bin/get_email | 4 +++- lib/imap_utils.pl | 3 ++- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/bin/get_email b/bin/get_email index 9eee005b9..172ca9067 100755 --- a/bin/get_email +++ b/bin/get_email @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!/usr/bin/env perl # -*- Perl -*- #--------------------------------------------------------------------------- # File: @@ -11,6 +11,8 @@ # http://misterhouse.net/mh/bin/get_email # Change log: # 03/26/99 Created. +# Notes: +# check required modules in lib/imap_utils.pl # # This software is licensed under the terms of the GNU public license. # Copyright 1999 Bruce Winter diff --git a/lib/imap_utils.pl b/lib/imap_utils.pl index 8e30823c0..483e0bacb 100644 --- a/lib/imap_utils.pl +++ b/lib/imap_utils.pl @@ -16,7 +16,8 @@ =head2 DESCRIPTION Time::Zone if the IMAP scan hangs before authenticating against the gmail account, reinstall the -IO::Socket::SSL +IO::Socket::SSL. On OS X you need to install openssl before attempting to install the +SSL-related Perl modules. The easiest way to do this is through homebrew (brew install openssl) Todo: parse unread messages From 3de7c844ce561788a62d0f963fd4f69b7b00be29 Mon Sep 17 00:00:00 2001 From: hplato Date: Thu, 2 Jan 2014 22:02:33 -0700 Subject: [PATCH 002/180] Cherry Pick Initial AD2USB.pm File from HPlato Repo new file: AD2USB.pm --- lib/AD2USB.pm | 1305 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1305 insertions(+) create mode 100755 lib/AD2USB.pm diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm new file mode 100755 index 000000000..8b6ac8520 --- /dev/null +++ b/lib/AD2USB.pm @@ -0,0 +1,1305 @@ +# ########################################################################### +# Name: AD2USB Monitoring Module +# +# Description: +# Module that monitors a serial device for the AD2USB for known events and +# maintains the state of the Ademco system in memory. Module also sends +# instructions to the panel as requested. +# +# Author: Kirk Friedenberger (kfriedenberger@gmail.com) +# $Revision: $ +# $Date: $ +# +# Change log: +# - Added relay support (Wayne Gatlin, wayne@razorcla.ws) +# - Added 2-way zone expander support (Wayne Gatlin, wayne@razorcla.ws) +# - Completed Wireless support (Wayne Gatlin, wayne@razorcla.ws) +# - Added ser2sock support (Wayne Gatlin, wayne@razorcla.ws) +# - Added in child MH-Style objects (Door & Motion items) (H Plato, hplato@gmail.com) +############################################################################## +# Copyright Kirk Friedenberger (kfriedenberger@gmail.com), 2013, All rights reserved +############################################################################## +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +# THE SOFTWARE. +############################################################################### + +use Switch; + +package AD2USB; + +@AD2USB::ISA = ('Generic_Item'); + +my %CmdMsg; +my %CmdMsgRev; +my $Self; +my %ErrorCode; +my $IncompleteCmd; +my $connecttype; + +# Starting a new object {{{ +sub new { + my ($class) = @_; + my $self = {}; + $$self{panel_status} = 'Unknown'; + $$self{Log} = []; + $$self{ac_power} = 0; + $$self{battery_low} = 1; + $$self{chime} = 0; + + bless $self, $class; + + # load command hash + DefineCmdMsg(); + + + my @LogType = qw(AD2USB_part_log AD2USB_zone_log AD2USB_debug_log); + foreach (@LogType) { + if ( !exists $::config_parms{$_} ) { + $main::config_parms{$_} = 1; + &::print_log("Parameter $_ not defined in mh.private.ini, enabling by default"); + } + } + + if ( !exists $::config_parms{'AD2USB_ser2sock_recon'} ) { + $::config_parms{'AD2USB_ser2sock_recon'} = 10; + &::print_log("Parameter AD2USB_ser2sock_recon not defined in mh.private.ini, enabling by default"); + } + + &main::print_log("Starting ADEMCO panel interface module"); + $Self = $self; + + #Set all zones to ready + ChangeZones( 1, 100, "ready", "ready", 0); + ChangePartitions( 1, 1, "ready", 0); + $self->{keys_sent} = 0; + + return $self; +} + +#}}} +# serial port configuration {{{ +sub init { + + my ($serial_port) = @_; + $serial_port->error_msg(1); + $serial_port->databits(8); + $serial_port->parity("none"); + $serial_port->stopbits(1); + $serial_port->handshake('none'); + $serial_port->datatype('raw'); + $serial_port->dtr_active(1); + $serial_port->rts_active(0); + + select( undef, undef, undef, .100 ); # Sleep a bit + +} + +#}}} +# module startup / enabling serial port {{{ +sub serial_startup { + my $self = $Self; + my $port; my $BaudRate; my $ip; + if ($::config_parms{'AD2USB_serial_port'} and $::config_parms{'AD2USB_serial_port'} ne '/dev/none') { + $port = $::config_parms{'AD2USB_serial_port'}; + $BaudRate = ( defined $::config_parms{AD2USB_baudrate} ) ? $main::config_parms{AD2USB_baudrate} : 115200; + if ( &main::serial_port_create( 'AD2USB', $port, $BaudRate, 'none', 'raw' ) ) { + init( $::Serial_Ports{AD2USB}{object}, $port ); + &main::print_log(" AD2USB.pm initializing port $port at $BaudRate baud") if $main::config_parms{debug} eq 'AD2USB'; + &::MainLoop_pre_add_hook( \&AD2USB::check_for_data, 1 ) if $main::Serial_Ports{AD2USB}{object}; + $::Year_Month_Now = &::time_date_stamp( 10, time ); # Not yet set when we init. + LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", " ========= AD2USB.pm Serial Initialized =========" ); + $connecttype = 'serial'; + } + } elsif ($::config_parms{'AD2USB_ser2sock_ip'}) { + $recon_timer = new Timer; + $ip = $::config_parms{'AD2USB_ser2sock_ip'}; + $port = $::config_parms{'AD2USB_ser2sock_port'}; + &main::print_log(" AD2USB.pm initializing TCP session with $ip on port $port") if $main::config_parms{debug} eq 'AD2USB'; + $AD2USB_ser2sock = new Socket_Item(undef, undef, "$ip:$port", 'AD2USB', 'tcp', 'raw'); + $AD2USB_ser2sock_sender = new Socket_Item(undef, undef, "$ip:$port", 'AD2USB_SENDER', 'tcp', 'rawout'); + start $AD2USB_ser2sock; + start $AD2USB_ser2sock_sender; + &::MainLoop_pre_add_hook( \&AD2USB::check_for_data, 1 ); + $::Year_Month_Now = &::time_date_stamp( 10, time ); # Not yet set when we init. + LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", " ========= AD2USB.pm Socket Initialized =========" ); + $connecttype = 'tcp'; + } else { + warn "AD2USB.pm->startup AD2USB_serial_port or AD2USB_ser2sock_ip not defined in mh.ini file"; + } + } + +#}}} +# module startup; hack because of the startup error +sub startup { +} + + + +#}}} +# check for incoming data on serial port {{{ +sub check_for_data { + my $NewCmd; + + if ($connecttype eq 'serial') { + &main::check_for_generic_serial_data('AD2USB'); + $NewCmd = $main::Serial_Ports{'AD2USB'}{data}; + $main::Serial_Ports{'AD2USB'}{data} = ''; + } + + if ($connecttype eq 'tcp') { + if (active $AD2USB_ser2sock) { + $NewCmd = said $AD2USB_ser2sock; + } else { + # restart the TCP connection if its lost. + if (inactive $recon_timer) { + &main::print_log("Connection to AD2USB was lost, I will try to reconnect in $::config_parms{'AD2USB_ser2sock_recon'} seconds"); + # LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "AD2USB.pm ser2sock connection lost! Trying to reconnect." ); + set $recon_timer $::config_parms{'AD2USB_ser2sock_recon'}, sub { + start $AD2USB_ser2sock; + start $AD2USB_ser2sock_sender; + } + } + } + } + + $self=$Self; + # we need to buffer the information receive, because many command could be include in a single pass + $NewCmd = $IncompleteCmd . $NewCmd if $IncompleteCmd; + return if !$NewCmd; + $NewCmd =~ s/\r\n/#/g; # Replace newlines with # (use # as command delimiter) + #LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "TCP DATA - - $NewCmd" ); + my $Cmd = ''; # Build up a command string by iterating each character + foreach my $c ( split( //, $NewCmd ) ) { + if ( $c eq '#' ) { + if ($Cmd) { + &main::print_log($Cmd); + # This is a full command that was terminated by \r\n + my $status_type = GetStatusType($Cmd); + if ($status_type >= 10) { + # This is a panel message + if (($Cmd ne $self->{panel_status}) || ($status_type == 11)) { + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "NEW: $Cmd") if $main::config_parms{AD2USB_debug_log}; + CheckCmd($Cmd); + ResetAdemcoState(); + $self->{panel_status} = $Cmd; + } + else { + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "DUPE: $Cmd") if $main::config_parms{AD2USB_debug_log}; + } + } + else { + # This is a relay or RF or zone expander message + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "NONPANEL: $Cmd") if $main::config_parms{AD2USB_debug_log}; + CheckCmd($Cmd); + ResetAdemcoState(); + #$self->{panel_status} = $Cmd; + } + $Cmd = ''; + } + } + else { + # Append this character to the current command + $Cmd .= $c; + } + + } + # Save partial command for next serial read + $IncompleteCmd = $Cmd; +} + +#}}} +# Validate the command and perform action {{{ + +sub CheckCmd { + my $CmdStr = shift; + my $status_type = GetStatusType($CmdStr); + my $self = $Self; + + switch ( $status_type ) { + + case -1 { # UNRECOGNIZED STATUS + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "UNKNOWN STATUS: $CmdStr" ) if $main::config_parms{AD2USB_debug_log}; + } + + case 0 { # Key send confirmation + if ($self->{keys_sent} == 0) { + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key sent from ANOTHER panel." ) if $main::config_parms{AD2USB_debug_log}; + } + else { + $self->{keys_sent}--; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key received ($self->{keys_sent} left)" ) if $main::config_parms{AD2USB_debug_log}; + } + + } + + case 10 { # FAULTS AVAILABLE +# &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Faults exist and are available to parse" ) if $main::config_parms{AD2USB_debug_log}; + cmd( $self, "ShowFaults" ); + } + + case 11 { # IN FAULT LOOP + my $status_codes = substr( $CmdStr, 1, 12 ); + my $fault = substr( $CmdStr, 23, 3 ); + $fault = substr($CmdStr, 67, 2); + $fault = "0$fault"; + my $panel_message = substr( $CmdStr, 61, 32); + + my $ZoneName = my $ZoneNum = $fault; + my $PartNum = "1"; + $ZoneName = $main::config_parms{"AD2USB_zone_${ZoneNum}"} if exists $main::config_parms{"AD2USB_zone_${ZoneNum}"}; + $ZoneNum =~ s/^0*//; + $fault = $ZoneNum; + + if (&MappedZones("00$ZoneNum")) { + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Zone $ZoneNum is mapped to a Relay or RF ID, skipping normal monitoring!") } + else { + + #Check if this is the new lowest fault number and reset the zones before it + if (int($fault) <= int($self->{zone_lowest_fault})) { + $self->{zone_lowest_fault} = $fault; + #Reset zones to ready before the lowest + $start = 1; + $end = $self->{zone_lowest_fault} - 1; + ChangeZones( $start, $end, "ready", "bypass", 1); + } + + #Check if this is a new highest fault number and reset zones after it + if (int($fault) > int($self->{zone_highest_fault})) { + $self->{zone_highest_fault} = $fault; + #Reset zones to ready after the highest + $start = $self->{zone_highest_fault} + 1;; + $end = 11; + ChangeZones( $start, $end, "ready", "bypass", 1); + } + + # Check if this zone was already faulted + if ($self->{zone_status}{"$fault"} eq "fault") { + + #Check if this fault is less than the last fault (and must now be the new lowest zone) + if (int($fault) <= int($self->{zone_last_num})) { + #This is the new lowest zone + $self->{zone_lowest_fault} = $fault; + #Reset zones to ready before the lowest + $start = 1; + $end = $self->{zone_lowest_fault} - 1; + ChangeZones( $start, $end, "ready", "bypass", 1); + } + + #Check if this fault is equal to the last fault (and must now be the only zone) + if (int($fault) == int($self->{zone_last_num})) { + #Reset zones to ready after the only one + $start = int($fault) + 1; + $end = 11; + ChangeZones( $start, $end, "ready", "bypass", 1); + } + + #Check if this fault is greater than the last fault and reset the zones between it and the prior one + if (int($fault) > int($self->{zone_last_num})) { + $start = (($self->{zone_last_num} == $fault) ? 1 : int($self->{zone_last_num}) + 1); + $end = $fault - 1; + ChangeZones( $start, $end, "ready", "bypass", 1); + } + } + + + $self->{zone_now_msg} = "$panel_message"; + $self->{zone_now_status} = "fault"; + $self->{zone_now_name} = "$ZoneName"; + $self->{zone_now_num} = "$ZoneNum"; + ChangeZones( int($ZoneNum), int($ZoneNum), "fault", "", 1); + } + $self->{partition_now_msg} = "$panel_message"; + $self->{partition_now_status} = "not ready"; + $self->{partition_now_num} = "$PartNum"; + ChangePartitions( int($PartNum), int($PartNum), "not ready", 1); + } + + case 12 { # IN BYPASS FLASH LOOP + my $status_codes = substr( $CmdStr, 1, 12 ); + my $fault = substr( $CmdStr, 23, 3 ); +$fault = substr($CmdStr, 67, 2); +$fault = "0$fault"; + my $panel_message = substr( $CmdStr, 61, 32); + + my $ZoneName = my $ZoneNum = $fault; + my $PartNum = "1"; + $ZoneName = $main::config_parms{"AD2USB_zone_${ZoneNum}"} if exists $main::config_parms{"AD2USB_zone_${ZoneNum}"}; + $ZoneNum =~ s/^0*//; + $fault = $ZoneNum; + + $self->{zone_now_msg} = "$panel_message"; + $self->{zone_now_status} = "bypass"; + $self->{zone_now_name} = "$ZoneName"; + $self->{zone_now_num} = "$ZoneNum"; + ChangeZones( int($ZoneNum), int($ZoneNum), "bypass", "", 1); + $self->{partition_now_msg} = "$panel_message"; + $self->{partition_now_status} = "not ready"; + $self->{partition_now_num} = "$PartNum"; + ChangePartitions( int($PartNum), int($PartNum), "not ready", 1); + + } + + case 13 { # NORMAL STATUS + + # Get three sections of the Ademco status message + my $status_codes = substr( $CmdStr, 1, 12 ); + my $fault = substr( $CmdStr, 23, 3 ); + my $panel_message = substr( $CmdStr, 61, 32); + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key received ($self->{keys_sent} left)" ) if $main::config_parms{AD2USB_debug_log}; + + # READY + $data = 0; + if ( substr($status_codes,$data,1) == "1" ) { + my $start = 1; + my $end = 11; + if ( substr($status_codes,6,1) ne "1" ) { + # Reset all zones to ready if partition is ready and not bypassed + ChangeZones( $start, $end, "ready", "", 1); + } + else { + # If zones are bypassed, reset unbypassed zones to ready + for ($i = $start; $i <= $end; $i++) { + my $current_status = $self->{zone_status}{"$i"}; + if ($current_status eq "fault") { + ChangeZones($i, $i, "ready", "bypass", 1); + } + } + } + + my $PartName = my $PartNum = "1"; + + $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} if exists $main::config_parms{"AD2USB_part_${PartNum}"}; + $self->{partition_now_msg} = "$panel_message"; + $self->{partition_now_num} = "$PartNum"; + $self->{partition_now_status} = "ready"; + ChangePartitions( int($PartNum), int($PartNum), "ready", 1); + $self->{zone_lowest_fault} = 999; + $self->{zone_highest_fault} = -1; + + # Reset state for fault checks + $self->{zone_last_status} = ""; + $self->{zone_last_num} = ""; + $self->{zone_last_name} = ""; + } + + # ARMED AWAY + $data = 1; + if ( substr($status_codes,$data,1) == "1" ) { + my $PartNum = my $PartName = "1"; + $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} if exists $main::config_parms{"AD2USB_part_${PartNum}"}; + + my $mode = "ERROR"; + if (index($panel_message, "ALL SECURE")) { + $mode = "armed away"; + } + elsif (index($panel_message, "You may exit now")) { + $mode = "exit delay"; + } + elsif (index($panel_message, "or alarm occurs")) { + $mode = "entry delay"; + } + elsif (index($panel_message, "ZONE BYPASSED")) { + $mode = "armed away"; + } + + set $self "$mode"; + $self->{partition_now_msg} = "$panel_message"; + $self->{partition_now_status} = "$mode"; + $self->{partition_now_num} = "$PartNum"; + ChangePartitions( int($PartNum), int($PartNum), "$mode", 1); + + # Reset state for fault checks + $self->{zone_last_status} = ""; + $self->{zone_last_num} = ""; + $self->{zone_last_name} = ""; + } + + # ARMED HOME + $data = 2; + if ( substr($status_codes,$data,1) eq "1" ) { + my $PartNum = my $PartName = "1"; + + my $mode = "armed stay"; + $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} if exists $main::config_parms{"AD2USB_part_${PartNum}"}; + $self->{partition_now_msg} = "$panel_message"; + $self->{partition_now_status} = "$mode"; + $self->{partition_now_num} = "$PartNum"; + ChangePartitions( int($PartNum), int($PartNum), "$mode", 1); + + # Reset state for fault checks + $self->{zone_last_status} = ""; + $self->{zone_last_num} = ""; + $self->{zone_last_name} = ""; + } + + # SKIP BACKLIGHT + $data = 3; + + # PROGRAMMING MODE + $data = 4; + if ( substr($status_codes,$data,1) eq "1" ) { + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel is in programming mode" ) if $main::config_parms{AD2USB_debug_log}; + + # Reset state for fault checks + $self->{zone_last_status} = ""; + $self->{zone_last_num} = ""; + $self->{zone_last_name} = ""; + } + + # SKIP BEEPS + $data = 5; + + # A ZONE OR ZONES ARE BYPASSED + $data = 6; + if ( substr($status_codes,$data,1) == "1" ) { + + # Reset zones to ready that haven't appeared in the bypass loop +# if ($self->{zone_last_status} eq "bypass") { +# if (int($fault) < int($self->{zone_now_num})) { +# $start = int($self->{zone_now_num}) + 1; +# $end = 12; +# } +# ChangeZones( $start, $end - 1, "ready", "", 1); +# $self->{zone_now_status} = ""; +# $self->{zone_now_num} = "0"; +# } + + # Reset state for fault checks + $self->{zone_last_status} = ""; + $self->{zone_last_num} = ""; + $self->{zone_last_name} = ""; + } + + # SKIP AC POWER + $data = 7; + + # SKIP CHIME MODE + $data = 8; + + # ALARM WAS TRIGGERED (Sticky until disarm) + $data = 9; + if ( substr($status_codes,$data,1) == "1" ) { + $EventName = "ALARM WAS TRIGGERED"; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName" ) if $main::config_parms{AD2USB_part_log}; + } + + # ALARM IS SOUNDING + $data = 10; + if ( substr($status_codes,$data,1) == "1" ) { + $EventName = "ALARM IS SOUNDING"; + + #TODO: figure out how to get a partition number + my $PartName = my $PartNum = "1"; + my $ZoneNum = $fault; + $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; + $PartName = $main::config_parms{"AD2USB_part_$PartName"} if exists $main::config_parms{"AD2USB_part_$PartName"}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName - Zone $ZoneNum ($ZoneName)" ) if $main::config_parms{AD2USB_part_log}; + $ZoneNum =~ s/^0*//; + ChangeZones( int($ZoneNum), int($ZoneNum), "alarm", "", 1); + $self->{zone_now_msg} = "$panel_message"; + $self->{zone_now_status} = "alarm"; + $self->{zone_now_num} = "$ZoneNum"; + $self->{partition_now_msg} = "$panel_message"; + $self->{partition_now_status} = "alarm"; + $self->{partition_now_num} = "$PartNum"; + ChangePartitions( int($PartNum), int($PartNum), "alarm", 1); + } + + # SKIP BATTERY LOW + $data = 11; + } + + case 2 { # WIRELESS STATUS + my $ZoneLoop = ""; + my $MZoneLoop = ""; + # Parse raw status strings + my $rf_id = substr( $CmdStr, 5, 7 ); + my $rf_status = substr( $CmdStr, 13, 2 ); + my $lc = 0; + my $wnum = 0; + + # UNKNOWN + my $unknown_1 = 0; + $unknown_1 = 1 if (hex(substr($rf_status, 1, 1)) & 1) == 1; + # Parse for low battery signal + my $low_batt = 0; + $low_batt = 1 if (hex(substr($rf_status, 1, 1)) & 2) == 2; + # Parse for supervision flag + my $supervised = 0; + $supervised = 1 if (hex(substr($rf_status, 1, 1)) & 4) == 4; + # UNKNOWN + my $unknown_8 = 0; + $unknown_8 = 1 if (hex(substr($rf_status, 1, 1)) & 8) == 8; + + # Parse loop faults + my $loop_fault_1 = 0; + $loop_fault_1 = 1 if (hex(substr($rf_status, 0, 1)) & 8) == 8; + my $loop_fault_2 = 0; + $loop_fault_2 = 1 if (hex(substr($rf_status, 0, 1)) & 2) == 2; + my $loop_fault_3 = 0; + $loop_fault_3 = 1 if (hex(substr($rf_status, 0, 1)) & 1) == 1; + my $loop_fault_4 = 0; + $loop_fault_4 = 1 if (hex(substr($rf_status, 0, 1)) & 4) == 4; + + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "WIRELESS: rf_id($rf_id) status($rf_status) loop1($loop_fault_1) loop2($loop_fault_2) loop3($loop_fault_3) loop4($loop_fault_4)" ) if $main::config_parms{AD2USB_debug_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "WIRELESS: rf_id($rf_id) status($rf_status) low_batt($low_batt) supervised($supervised)" ) if $main::config_parms{AD2USB_debug_log}; + + my $ZoneStatus = "ready"; + my $PartStatus = ""; + my @parsest; + my $sensortype; + + if (exists $main::config_parms{"AD2USB_wireless_$rf_id"}) { + # Assign zone + my @ParseNum = split(",", $main::config_parms{"AD2USB_wireless_$rf_id"}); + + # Assign status (zone and partition) + if ($low_batt == "1") { + $ZoneStatus = "low battery"; + } + + foreach $wnum(@ParseNum) { + if ($lc eq 0 or $lc eq 2 or $lc eq 4 or $lc eq 6) { + $ZoneNum = $wnum; + } + + if ($lc eq 1 or $lc eq 3 or $lc eq 5 or $lc eq 7) { + @parsest = split("", $wnum); + $sensortype = $parsest[0]; + $ZoneLoop = $parsest[1]; + $ZoneName = "Unknown"; + $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; + + if ($ZoneLoop eq "1") {$MZoneLoop = $loop_fault_1} + if ($ZoneLoop eq "2") {$MZoneLoop = $loop_fault_2} + if ($ZoneLoop eq "3") {$MZoneLoop = $loop_fault_3} + if ($ZoneLoop eq "4") {$MZoneLoop = $loop_fault_4} + + if ("$MZoneLoop" eq "1") { + $ZoneStatus = "fault"; + } elsif ("$MZoneLoop" eq 0) { + $ZoneStatus = "ready"; + } + + $self->{zone_now_msg} = "$CmdStr"; + $self->{zone_now_status} = "$ZoneStatus"; + $self->{zone_now_name} = "$ZoneName"; + $self->{zone_now_num} = "$ZoneNum"; + ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); + if ($sensortype eq "k") { + $ZoneStatus = "ready"; + $self->{zone_now_msg} = "$CmdStr"; + $self->{zone_now_status} = "$ZoneStatus"; + $self->{zone_now_name} = "$ZoneName"; + $self->{zone_now_num} = "$ZoneNum"; + ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); + } + } + $lc++ + } + } + + } + + case 3 { # EXPANDER STATUS + my $exp_id = substr( $CmdStr, 5, 2 ); + my $input_id = substr( $CmdStr, 8, 2 ); + my $status = substr( $CmdStr, 11, 2 ); + my $ZoneStatus; + my $PartStatus; + + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "EXPANDER: exp_id($exp_id) input($input_id) status($status)" ) if $main::config_parms{AD2USB_debug_log}; + + if (exists $main::config_parms{"AD2USB_expander_$exp_id$input_id"}) { + # Assign zone + $ZoneNum = $main::config_parms{"AD2USB_expander_$exp_id$input_id"}; + $ZoneName = "Unknown"; + $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; + # Assign status (zone and partition) + + + if ($status == 01) { + $ZoneStatus = "fault"; + $PartStatus = "not ready"; + } elsif ($status == 00) { + $ZoneStatus = "ready"; + $PartStatus = ""; + } + + $self->{zone_now_msg} = "$CmdStr"; + $self->{zone_now_status} = "$ZoneStatus"; + $self->{zone_now_name} = "$ZoneName"; + $self->{zone_now_num} = "$ZoneNum"; + ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); + # if (($self->{partition_status}{int($PartNum)}) eq "ready") { #only change the partition status if the current status is "ready". We dont change if the system is armed. + # if ($PartStatus ne "") { + # $self->{partition_now_msg} = "$CmdStr"; + # $self->{partition_now_status} = "$PartStatus"; + # $self->{partition_now_num} = "$PartNum"; + # ChangePartitions( int($PartNum), int($PartNum), "$PartStatus", 1); + # } + # } + } + } + + + case 4 { # RELAY STATUS + my $rel_id = substr( $CmdStr, 5, 2 ); + my $rel_input_id = substr( $CmdStr, 8, 2 ); + my $rel_status = substr( $CmdStr, 11, 2 ); + my $PartName = my $PartNum = "1"; + my $ZoneStatus; + my $PartStatus; + + + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "RELAY: rel_id($rel_id) input($rel_input_id) status($rel_status)" ) if $main::config_parms{AD2USB_debug_log}; + + if (exists $main::config_parms{"AD2USB_relay_$rel_id$rel_input_id"}) { + # Assign zone + $ZoneNum = $main::config_parms{"AD2USB_relay_$rel_id$rel_input_id"}; + $ZoneName = "Unknown"; + $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; + # Assign status (zone and partition) + + + if ($rel_status == 01) { + $ZoneStatus = "fault"; + $PartStatus = "not ready"; + } elsif ($rel_status == 00) { + $ZoneStatus = "ready"; + $PartStatus = ""; + } + + $self->{zone_now_msg} = "$CmdStr"; + $self->{zone_now_status} = "$ZoneStatus"; + $self->{zone_now_name} = "$ZoneName"; + $self->{zone_now_num} = "$ZoneNum"; + ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); + # if (($self->{partition_status}{int($PartNum)}) eq "ready") { #only change the partition status if the current status is "ready". We dont change if the system is armed. + # if ($PartStatus ne "") { + # $self->{partition_now_msg} = "$CmdStr"; + # $self->{partition_now_status} = "$PartStatus"; + # $self->{partition_now_num} = "$PartNum"; + # ChangePartitions( int($PartNum), int($PartNum), "$PartStatus", 1); + # } + # } + } + } + + else { + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "SOMETHING SERIOUSLY WRONG - UNKNOWN COMMAND" ) if $main::config_parms{AD2USB_debug_log}; + } + } + + # NORMAL STATUS TYPE + # ALWAYS CHECK CHIME / AC POWER / BATTERY STATUS / BACKLIGHT / BEEPS + if ($status_type >= 10) { + + # PARSE codes + my $status_codes = substr( $CmdStr, 1, 12 ); + my $fault = substr( $CmdStr, 23, 3 ); + my $panel_message = substr( $CmdStr, 61, 32); + + # BACKLIGHT + $data = 3; + if ( substr($status_codes,$data,1) == "1" ) { + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel backlight is on" ) if $main::config_parms{AD2USB_debug_log}; + } + + # BEEPS + $data = 5; + if ( substr($status_codes,$data,1) != "0" ) { + $NumBeeps = substr($status_codes,$data,1); + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel beeped $NumBeeps times" ) if $main::config_parms{AD2USB_debug_log}; + } + + # AC POWER + $data = 7; + if ( substr($status_codes,$data,1) == "0" ) { + $$self{ac_power} = 0; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "AC Power has been lost" ); + } + else { + $$self{ac_power} = 1; + } + + # CHIME MODE + $data = 8; + if ( substr($status_codes,$data,1) == "0" ) { + $self->{chime} = 0; +# &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Chime is off" ) if $main::config_parms{AD2USB_debug_log}; + } + else { + $self->{chime} = 1; +# &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Chime is on" ) if $main::config_parms{AD2USB_debug_log}; + } + + # BATTERY LOW + $data = 11; + if ( substr($status_codes,$data,1) == "1" ) { + $self->{battery_low} = 1; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel is low on battery" ); + } + else { + $self->{battery_low} = 0; + } + + } + + return; + +} + +#}}} +# local logit call {{{ +sub LocalLogit { + my $file = shift; + my $str = shift; + &::logit( "$file", "$str" ); + my $Timestamp = &::time_date_stamp(16); + $str =~ s/ +/ /; + unshift @{ $Self->{Log} }, "$Timestamp: $str" if $str !~ /Temperature/; + pop @{ $Self->{Log} } if scalar( @{ $Self->{Log} } ) > 60; + +} + +#}}} +# Determine if the status string requires parsing {{{ +sub GetStatusType { + my $AdemcoStr = shift; + my $ll = length($AdemcoStr); + + if ($ll eq 94) { + my $substatus = substr($AdemcoStr, 61, 5); + if ( $substatus eq "FAULT" ) { + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Fault zones available: $AdemcoStr") if $main::config_parms{AD2USB_debug_log}; + return 11; + } + elsif ( $substatus eq "BYPAS" ) { + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Bypass zones available: $AdemcoStr") if $main::config_parms{AD2USB_debug_log}; + return 12; + } + elsif (index($AdemcoStr, "Hit *") >= 0) { + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Faults available: $AdemcoStr") if $main::config_parms{AD2USB_debug_log}; + return 10; + } + else { +# &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Standard status received: $AdemcoStr"); + return 13; + } + } + elsif (substr($AdemcoStr,0,5) eq "!RFX:") { + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Wireless status received.") if $main::config_parms{AD2USB_debug_log}; + return 2; + } + elsif (substr($AdemcoStr,0,5) eq "!EXP:") { + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Expander status received.") if $main::config_parms{AD2USB_debug_log}; + return 3; + } + elsif (substr($AdemcoStr,0,5) eq "!REL:") { + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Relay status received.") if $main::config_parms{AD2USB_debug_log}; + return 4; + } + elsif ($AdemcoStr eq "!Sending...done") { + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Command sent successfully.") if $main::config_parms{AD2USB_debug_log};; + return 0; + } + return -1; +} + +#}}} +# Change zone statuses for zone indices from start to end +sub ChangeZones { + my $start = @_[0]; + my $end = @_[1]; + my $new_status = @_[2]; + my $neq_status = @_[3]; + my $log = @_[4]; + + my $self = $Self; + for ($i = $start; $i <= $end; $i++) { + $current_status = $self->{zone_status}{"$i"}; + if (($current_status ne $new_status) && ($current_status ne $neq_status)) { + if (($main::config_parms{AD2USB_zone_log}) && ($log == 1)) { + my $ZoneNumPadded = $i; + $ZoneNumPadded = sprintf("%3d", $ZoneNumPadded); + $ZoneNumPadded =~ tr/ /0/; + $ZoneName = "Unknown"; + $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNumPadded"} if exists $main::config_parms{"AD2USB_zone_$ZoneNumPadded"}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Zone $i ($ZoneName) changed from '$current_status' to '$new_status'" ) if $main::config_parms{AD2USB_zone_log}; + } + $self->{zone_status}{"$i"} = $new_status; + # Set child object status if it is registered to the zone + $$self{zone_object}{"$i"}->set($new_status) if defined $$self{zone_object}{"$i"}; + } + } +} + +#}}} +# Change partition statuses for partition indices from start to end +sub ChangePartitions { + my $start = @_[0]; + my $end = @_[1]; + my $new_status = @_[2]; + my $log = @_[3]; + + my $self = $Self; + for ($i = $start; $i <= $end; $i++) { + $current_status = $self->{partition_status}{"$i"}; + if ($current_status ne $new_status) { + if (($main::config_parms{AD2USB_part_log}) && ($log == 1)) { + $PartName = $main::config_parms{"AD2USB_part_$i"} if exists $main::config_parms{"AD2USB_part_$i"}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Partition $i ($PartName) changed from '$current_status' to '$new_status'" ) if $main::config_parms{AD2USB_part_log}; + } + $self->{partition_status}{"$i"} = $new_status; + } + } +} + + +# Reset Ademco state to simulate a "now" on some value ie: zone, temp etc. {{{ +sub ResetAdemcoState { + + my $self = $Self; + # store faults (fault and bypass) for next message parsing + if (($self->{zone_now_status} eq "fault") || ($self->{zone_now_status} eq "bypass")) { + $self->{zone_last_status} = $self->{zone_now_status}; + $self->{zone_last_num} = $self->{zone_now_num}; + $self->{zone_last_name} = $self->{zone_now_name}; + } + + # reset zone + if ( defined $self->{zone_now_num} ) { + my $ZoneNum = $self->{zone_now_num}; + $self->{zone_num}{$ZoneNum} = $self->{zone_now_num}; + $self->{zone_msg}{$ZoneNum} = $self->{zone_now_msg}; + $self->{zone_status}{$ZoneNum} = $self->{zone_now_status}; + $self->{zone_time}{$ZoneNum} = &::time_date_stamp( 17, time ); + undef $self->{zone_now_num}; + undef $self->{zone_now_name}; + undef $self->{zone_now_status}; + undef $self->{zone_now_msg}; + } + + # reset partition + if ( defined $self->{partition_now_num} ) { + my $PartNum = $self->{partition_now_num}; + $self->{partition}{$PartNum} = $self->{partition_now_num}; + $self->{partition_msg}{$PartNum} = $self->{partition_now_msg}; + $self->{partition_status}{$PartNum} = $self->{partition_now_status}; + $self->{partition_time}{$PartNum} = &::time_date_stamp( 17, time ); + undef $self->{partition_now_num}; + undef $self->{partition_now_msg}; + undef $self->{partition_now_status}; + } + + return; +} + +#}}} +# Define hash with Ademco commands {{{ +sub DefineCmdMsg { + my %OutputListco; + foreach my $key (keys(%::config_parms)) { + next if $key =~ /_MHINTERNAL_/; + next if $key !~ /^AD2USB_output_(\D+)_(\d+)$/; + if ($1 eq 'co') { + $OutputListco{"$::config_parms{$key}c"} = "$::config_parms{AD2USB_user_master_code}#70$2"; + $OutputListco{"$::config_parms{$key}o"} = "$::config_parms{AD2USB_user_master_code}#80$2"; + } + if ($1 eq 'oc') { + $OutputListco{"$::config_parms{$key}o"} = "$::config_parms{AD2USB_user_master_code}#80$2"; + $OutputListco{"$::config_parms{$key}c"} = "$::config_parms{AD2USB_user_master_code}#70$2"; + } + if ($1 eq 'o') { + $OutputListco{"$::config_parms{$key}o"} = "$::config_parms{AD2USB_user_master_code}#80$2"; + } + if ($1 eq 'c') { + $OutputListco{"$::config_parms{$key}c"} = "$::config_parms{AD2USB_user_master_code}#70$2"; + } + } + + my %ExpListc; + my $srpzonenum; + foreach my $key (keys(%::config_parms)) { + next if $key =~ /_MHINTERNAL_/; + next if $key !~ /^AD2USB_expander_(\d+)$/; + $srpzonenum = substr($::config_parms{$key}, 1); + $ExpListc{"exp$::config_parms{$key}c"} = "L$srpzonenum"."0"; + $ExpListc{"exp$::config_parms{$key}f"} = "L$srpzonenum"."1"; + $ExpListc{"exp$::config_parms{$key}p"} = "L$srpzonenum"."2"; + } + + %CmdMsg = ( + "Disarm" => "$::config_parms{AD2USB_user_master_code}1", + "ArmAway" => "$::config_parms{AD2USB_user_master_code}2", + "ArmStay" => "$::config_parms{AD2USB_user_master_code}3", + "ArmAwayMax" => "$::config_parms{AD2USB_user_master_code}4", + "Test" => "$::config_parms{AD2USB_user_master_code}5", + "Bypass" => "$::config_parms{AD2USB_user_master_code}6#", + "ArmStayInstant" => "$::config_parms{AD2USB_user_master_code}7", + "Code" => "$::config_parms{AD2USB_user_master_code}8", + "Chime" => "$::config_parms{AD2USB_user_master_code}9", + "ToggleVoice" => '#024', + "ShowFaults" => "*", + "AD2USBReboot" => "=", + "AD2USBConfigure" => "!" + ); + + my %newHash = (%OutputListco, %CmdMsg); + %CmdMsg = %newHash; + %newHash = (%ExpListc, %CmdMsg); + %CmdMsg = %newHash; + %CmdMsgRev = reverse %CmdMsg; + return; +} + +#}}} +# Define hash with all zone numbers and names {{{ +sub ZoneName { + #my $self = $Self; + my @Name = ["none"]; + + foreach my $key (keys(%::config_parms)) { + next if $key =~ /_MHINTERNAL_/; + next if $key !~ /^AD2USB_zone_(\d+)$/; + $Name[int($1)]=$::config_parms{$key}; + } + return @Name; +} + + +sub MappedZones { + foreach my $mkey (keys(%::config_parms)) { + next if $mkey =~ /_MHINTERNAL_/; + next if $mkey !~ /^AD2USB_(relay|wireless|expander)_(\d+)$/; + if ("@_" eq $::config_parms{$mkey}) { return 1 } + } + return 0; +} + +#}}} +# Sending command to ADEMCO panel {{{ +sub cmd { + + my ( $class, $cmd, $password ) = @_; + $cmd = $CmdMsg{$cmd}; + + $CmdName = ( exists $CmdMsgRev{$cmd} ) ? $CmdMsgRev{$cmd} : "unknown"; + $CmdStr = $cmd; + + # Exit if unknown command + if ( $CmdName =~ /^unknown/ ) { + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Invalid ADEMCO panel command : $CmdName ($cmd)"); + return; + } + + # Exit if password is wrong + if ( ($password ne $::config_parms{AD2USB_user_master_code}) && ($CmdName ne "ShowFaults" ) ) { + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Invalid password for command $CmdName ($password)"); + return; + } + + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", ">>> Sending to ADEMCO panel $CmdName ($cmd)" ) if $main::config_parms{AD2USB_debug_log}; + $class->{keys_sent} = $class->{keys_sent} + length($CmdStr); + if ($connecttype eq 'serial') { + $main::Serial_Ports{AD2USB}{object}->write("$CmdStr"); + } else { + set $AD2USB_ser2sock_sender "$CmdStr"; + } + return "Sending to ADEMCO panel: $CmdName ($cmd)"; + +} + +#}}} +# user call from MH {{{ + +sub zone_now { + return $_[0]->{zone_now_name} if defined $_[0]->{zone_now_name}; +} + +sub zone_msg { + return $_[0]->{zone_now_msg} if defined $_[0]->{zone_now_msg}; +} + +sub zone_now_restore { + return $_[0]->{zone_now_restore} if defined $_[0]->{zone_now_restore}; +} + +sub zone_now_tamper { + return $_[0]->{zone_now_tamper} if defined $_[0]->{zone_now_tamper}; +} + +sub zone_now_tamper_restore { + return $_[0]->{zone_now_tamper_restore} if defined $_[0]->{zone_now_tamper_restore}; +} + +sub zone_now_alarm { + return $_[0]->{zone_now_alarm} if defined $_[0]->{zone_now_alarm}; +} + +sub zone_now_alarm_restore { + return $_[0]->{zone_now_alarm_restore} if defined $_[0]->{zone_now_alarm_restore}; +} + +sub zone_now_fault { + return $_[0]->{zone_now_num} if defined $_[0]->{zone_now_num}; +} + +sub status_zone { + my ( $class, $zone ) = @_; + return $_[0]->{zone_status}{$zone} if defined $_[0]->{zone_status}{$zone}; +} + +sub zone_name { + my ( $class, $zone_num ) = @_; + $zone_num = sprintf "%03s", $zone_num; + my $ZoneName = $main::config_parms{"AD2USB_zone_$zone_num"} if exists $main::config_parms{"AD2USB_zone_$zone_num"}; + return $ZoneName if $ZoneName; + return $zone_num; +} + +sub partition_now { + my ( $class, $part ) = @_; + return $_[0]->{partition_now_num} if defined $_[0]->{partition_now_num}; +} + +sub partition_now_msg { + my ( $class, $part ) = @_; + return $_[0]->{partition_now_msg} if defined $_[0]->{partition_now_msg}; +} + +sub partition_name { + my ( $class, $part_num ) = @_; + my $PartName = $main::config_parms{"AD2USB_part_$part_num"} if exists $main::config_parms{"AD2USB_part_$part_num"}; + return $PartName if $PartName; + return $part_num; +} + +sub cmd_list { + foreach my $k ( sort keys %CmdMsg ) { + &::print_log("$k"); + } +} + +##Used to register a child object to the zone. Allows for MH-style Door & Motion sensors +sub register { + my ($class, $object, $zone_num ) = @_; + &::print_log("Registering Child Object $object->{zone_number} on zone $zone_num"); + $_[0]->{zone_object}{$zone_num} = $object; + } + + + +# MH-Style child objects +# These allow zones to behave like Door_Items and Motion Sensors +# to use, just create the item with the Master AD2USB object and the appropriate zone +# +# ie. +# $AD2USB = new AD2USB; +# $Front_door = new AD2USB_Door_Item($AD2USB,1); +# $Front_motion = new AD2USB_Motion_Item($AD2USB,2); + +package AD2USB_Door_Item; + +@AD2USB_Door_Item::ISA = ('Generic_Item'); + +sub new +{ + my ($class,$object,$zone) = @_; + + my $self={}; + bless $self,$class; + + $$self{m_write} = 0; + $$self{m_timerCheck} = new Timer() unless $$self{m_timerCheck}; + $$self{m_timerAlarm} = new Timer() unless $$self{m_timerAlarm}; + $$self{'alarm_action'} = ''; + $$self{last_open} = 0; + $$self{last_closed} = 0; + @{$$self{states}} = ('open','closed','check'); + $$self{zone_number} = $zone; + $$self{master_object} = $object; + $$self{item_type} = 'door'; + $object->register($self,$zone); + + return $self; + +} + +sub set +{ + my ($self,$p_state,$p_setby) = @_; + + if (ref $p_setby and $p_setby->can('get_set_by')) { + &::print_log("AD2USB_Door_Item($$self{object_name})::set($p_state, $p_setby): $$p_setby{object_name} was set by " . $p_setby->get_set_by) if $main::Debug{AD2USB}; + } else { + &::print_log("AD2USB_Door_Item($$self{object_name})::set($p_state, $p_setby)") if $main::Debug{AD2USB}; + } + + if ($p_state =~ /^fault/) { + $p_state = 'open'; + $$self{last_open} = $::Time; + + } elsif ($p_state =~ /^ready/) { + $p_state = 'closed'; + $$self{last_closed} = $::Time; + + # Other door sensors? + } elsif ($p_state eq 'on') { + $p_state = 'open'; + $$self{last_open} = $::Time; + + } elsif ($p_state eq 'off') { + $p_state = 'closed'; + $$self{last_closed} = $::Time; + + } else { + $p_state = 'check'; + } + + $self->SUPER::set($p_state,$p_setby); +} + +sub get_last_close_time { + my ($self) = @_; + return $$self{last_closed}; +} + +sub get_last_open_time { + my ($self) = @_; + return $$self{last_open}; +} + +sub get_child_item_type { + my ($self) = @_; + return $$self{item_type}; +} + +#Left in these methods to maintain compatibility. Since we're not tracking inactivity, these won't return proper results. + +sub set_alarm($$$) { + my ($self, $time, $action, $repeat_time) = @_; + $$self{'alarm_action'} = $action; + $$self{'alarm_time'} = $time; + $$self{'alarm_repeat_time'} = $repeat_time if defined $repeat_time; + &::print_log ("AD2USB_Door_Item:: set_alarm not supported"); + +} + +sub set_inactivity_alarm($$$) { + my ($self, $time, $action) = @_; + $$self{'inactivity_action'} = $action; + $$self{'inactivity_time'} = $time*3600; + &::print_log("AD2USB_Door_Item:: set_inactivity_alarm not supported"); + +} + + +package AD2USB_Motion_Item; +@AD2USB_Motion_Item::ISA = ('Generic_Item'); + +sub new +{ + my ($class,$object,$zone) = @_; + + my $self={}; + bless $self,$class; + + $$self{m_write} = 0; + $$self{m_timerCheck} = new Timer() unless $$self{m_timerCheck}; + $$self{m_timerAlarm} = new Timer() unless $$self{m_timerAlarm}; + $$self{'alarm_action'} = ''; + $$self{last_still} = 0; + $$self{last_motion} = 0; + @{$$self{states}} = ('motion','still','check'); + $$self{zone_number} = $zone; + $$self{master_object} = $object; + $$self{item_type} = 'motion'; + + $object->register($self,$zone); + + return $self; + +} + +sub set +{ + my ($self,$p_state,$p_setby) = @_; + + + if (ref $p_setby and $p_setby->can('get_set_by')) { + &::print_log("AD2USB_Motion_Item($$self{object_name})::set($p_state, $p_setby): $$p_setby{object_name} was set by " . $p_setby->get_set_by) if $main::Debug{AD2USB}; + } else { + &::print_log("AD2USB_Motion_Item($$self{object_name})::set($p_state, $p_setby)") if $main::Debug{AD2USB}; + } + + if ($p_state =~ /^fault/i) { + $p_state = 'motion'; + $$self{last_motion} = $::Time; + + } elsif ($p_state =~ /^ready/i) { + $p_state = 'still'; + $$self{last_still} = $::Time; + + } else { + $p_state = 'check'; + } + + $self->SUPER::set($p_state, $p_setby); +} + +sub get_last_still_time { + my ($self) = @_; + return $$self{last_still}; +} + +sub get_last_motion_time { + my ($self) = @_; + return $$self{last_motion}; +} + +sub get_child_item_type { + my ($self) = @_; + return $$self{item_type}; +} + +#Left in these methods to maintain compatibility. Since we're not tracking inactivity, these won't return proper results. +sub delay_off() +{ + my ($self,$p_time) = @_; + $$self{m_delay_off} = $p_time if defined $p_time; + &::print_log("AD2USB_Motion_Item:: delay_off not supported"); + return $$self{m_delay_off}; +} + +sub set_inactivity_alarm($$$) { + my ($self, $time, $action) = @_; + $$self{'inactivity_action'} = $action; + $$self{'inactivity_time'} = $time*3600; + $$self{m_timerCheck}->set($time*3600, $self); + &::print_log("AD2USB_Motion_Item:: set_inactivity_alarm not supported"); +} + +1; + +#}}} +#$Log:$ + +__END__ + From 7eba0251ac383840ebf1c27d6685e909fa03cde5 Mon Sep 17 00:00:00 2001 From: hplato Date: Fri, 3 Jan 2014 17:12:19 -0700 Subject: [PATCH 003/180] Cherry Pick HPlato Modifications to AD2USB.pm modified: AD2USB.pm --- lib/AD2USB.pm | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 8b6ac8520..76577fb7e 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -1104,7 +1104,12 @@ sub register { $_[0]->{zone_object}{$zone_num} = $object; } - +sub get_child_object_name { + my ($class,$zone_num) = @_; + my $object = $_[0]->{zone_object}{$zone_num}; + return $object->get_object_name() if defined ($object); +} + # MH-Style child objects # These allow zones to behave like Door_Items and Motion Sensors @@ -1113,7 +1118,11 @@ sub register { # ie. # $AD2USB = new AD2USB; # $Front_door = new AD2USB_Door_Item($AD2USB,1); +# states include open, closed and check # $Front_motion = new AD2USB_Motion_Item($AD2USB,2); +# states include motion and still +# +# inactivity timers are not working...don't know if those are relevant for panel items. package AD2USB_Door_Item; From 64349692cd1d904b24b9ebdf31dc8018181d34db Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 4 Jan 2014 13:50:30 -0800 Subject: [PATCH 004/180] AD2: Fix Comment Formatting to Allow for Proper Collapsing --- lib/AD2USB.pm | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 76577fb7e..8bcbb64f9 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -144,7 +144,7 @@ sub serial_startup { } #}}} -# module startup; hack because of the startup error +# module startup; hack because of the startup error {{{ sub startup { } @@ -823,7 +823,7 @@ sub GetStatusType { } #}}} -# Change zone statuses for zone indices from start to end +# Change zone statuses for zone indices from start to end {{{ sub ChangeZones { my $start = @_[0]; my $end = @_[1]; @@ -851,7 +851,7 @@ sub ChangeZones { } #}}} -# Change partition statuses for partition indices from start to end +# Change partition statuses for partition indices from start to end {{{ sub ChangePartitions { my $start = @_[0]; my $end = @_[1]; @@ -871,7 +871,7 @@ sub ChangePartitions { } } - +#}}} # Reset Ademco state to simulate a "now" on some value ie: zone, temp etc. {{{ sub ResetAdemcoState { @@ -1096,8 +1096,8 @@ sub cmd_list { &::print_log("$k"); } } - -##Used to register a child object to the zone. Allows for MH-style Door & Motion sensors +#}}} +##Used to register a child object to the zone. Allows for MH-style Door & Motion sensors {{{ sub register { my ($class, $object, $zone_num ) = @_; &::print_log("Registering Child Object $object->{zone_number} on zone $zone_num"); @@ -1110,7 +1110,7 @@ sub get_child_object_name { return $object->get_object_name() if defined ($object); } - +#}}} # MH-Style child objects # These allow zones to behave like Door_Items and Motion Sensors # to use, just create the item with the Master AD2USB object and the appropriate zone @@ -1200,7 +1200,7 @@ sub get_child_item_type { return $$self{item_type}; } -#Left in these methods to maintain compatibility. Since we're not tracking inactivity, these won't return proper results. +#Left in these methods to maintain compatibility. Since we're not tracking inactivity, these won't return proper results. {{{ sub set_alarm($$$) { my ($self, $time, $action, $repeat_time) = @_; @@ -1219,7 +1219,7 @@ sub set_inactivity_alarm($$$) { } - +#}}} package AD2USB_Motion_Item; @AD2USB_Motion_Item::ISA = ('Generic_Item'); @@ -1288,7 +1288,7 @@ sub get_child_item_type { return $$self{item_type}; } -#Left in these methods to maintain compatibility. Since we're not tracking inactivity, these won't return proper results. +#Left in these methods to maintain compatibility. Since we're not tracking inactivity, these won't return proper results. {{{ sub delay_off() { my ($self,$p_time) = @_; From 5fda62fa492c207f3e55cd414d83b6882a34abb0 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 4 Jan 2014 13:54:59 -0800 Subject: [PATCH 005/180] AD2: Bless Child Obj As Generic Obj; Remove States - Allows for use of all Generic_Item options including tie_events - Remove states because this is not an "editable" object --- lib/AD2USB.pm | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 8bcbb64f9..43f9a0fb4 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -1132,7 +1132,7 @@ sub new { my ($class,$object,$zone) = @_; - my $self={}; + my $self = new Generic_Item(); bless $self,$class; $$self{m_write} = 0; @@ -1141,7 +1141,6 @@ sub new $$self{'alarm_action'} = ''; $$self{last_open} = 0; $$self{last_closed} = 0; - @{$$self{states}} = ('open','closed','check'); $$self{zone_number} = $zone; $$self{master_object} = $object; $$self{item_type} = 'door'; @@ -1227,7 +1226,7 @@ sub new { my ($class,$object,$zone) = @_; - my $self={}; + my $self = new Generic_Item(); bless $self,$class; $$self{m_write} = 0; @@ -1236,7 +1235,6 @@ sub new $$self{'alarm_action'} = ''; $$self{last_still} = 0; $$self{last_motion} = 0; - @{$$self{states}} = ('motion','still','check'); $$self{zone_number} = $zone; $$self{master_object} = $object; $$self{item_type} = 'motion'; From 297bdb5d43a555791f42154104790a783b5359ef Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 4 Jan 2014 14:09:46 -0800 Subject: [PATCH 006/180] AD2: Remove Redundant Log Entry --- lib/AD2USB.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 43f9a0fb4..90ec245e2 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -1100,7 +1100,7 @@ sub cmd_list { ##Used to register a child object to the zone. Allows for MH-style Door & Motion sensors {{{ sub register { my ($class, $object, $zone_num ) = @_; - &::print_log("Registering Child Object $object->{zone_number} on zone $zone_num"); + &::print_log("Registering Child Object on zone $zone_num"); $_[0]->{zone_object}{$zone_num} = $object; } From 224cc492958b24970fc947a754eb0e90abb10a35 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 4 Jan 2014 14:42:19 -0800 Subject: [PATCH 007/180] AD2: Add Initial Structure for Seperating Out Socket Startup --- lib/AD2USB.pm | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 90ec245e2..ba659b0db 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -112,8 +112,13 @@ sub init { #}}} # module startup / enabling serial port {{{ sub serial_startup { - my $self = $Self; + my ($instance) = @_; + my $self = $Self; #WTH is this? my $port; my $BaudRate; my $ip; + + #If Set to Use Ser2Sock Interface stop processing now + if ($::config_parms{$instance . "_use_TCP"} == 1) {return;} + if ($::config_parms{'AD2USB_serial_port'} and $::config_parms{'AD2USB_serial_port'} ne '/dev/none') { $port = $::config_parms{'AD2USB_serial_port'}; $BaudRate = ( defined $::config_parms{AD2USB_baudrate} ) ? $main::config_parms{AD2USB_baudrate} : 115200; From 71b2d332f92fb56ef9bbda22b922f12ae81ae6f6 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 4 Jan 2014 14:45:50 -0800 Subject: [PATCH 008/180] AD2: Fix Tabbing in Serial_Setup For Easier Reading Tabs are set at 3 spaces which is odd --- lib/AD2USB.pm | 54 +++++++++++++++++++++++++-------------------------- 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index ba659b0db..7d7009c13 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -115,38 +115,38 @@ sub serial_startup { my ($instance) = @_; my $self = $Self; #WTH is this? my $port; my $BaudRate; my $ip; - + #If Set to Use Ser2Sock Interface stop processing now if ($::config_parms{$instance . "_use_TCP"} == 1) {return;} - - if ($::config_parms{'AD2USB_serial_port'} and $::config_parms{'AD2USB_serial_port'} ne '/dev/none') { - $port = $::config_parms{'AD2USB_serial_port'}; - $BaudRate = ( defined $::config_parms{AD2USB_baudrate} ) ? $main::config_parms{AD2USB_baudrate} : 115200; - if ( &main::serial_port_create( 'AD2USB', $port, $BaudRate, 'none', 'raw' ) ) { - init( $::Serial_Ports{AD2USB}{object}, $port ); - &main::print_log(" AD2USB.pm initializing port $port at $BaudRate baud") if $main::config_parms{debug} eq 'AD2USB'; + + if ($::config_parms{'AD2USB_serial_port'} and $::config_parms{'AD2USB_serial_port'} ne '/dev/none') { + $port = $::config_parms{'AD2USB_serial_port'}; + $BaudRate = ( defined $::config_parms{AD2USB_baudrate} ) ? $main::config_parms{AD2USB_baudrate} : 115200; + if ( &main::serial_port_create( 'AD2USB', $port, $BaudRate, 'none', 'raw' ) ) { + init( $::Serial_Ports{AD2USB}{object}, $port ); + &main::print_log(" AD2USB.pm initializing port $port at $BaudRate baud") if $main::config_parms{debug} eq 'AD2USB'; &::MainLoop_pre_add_hook( \&AD2USB::check_for_data, 1 ) if $main::Serial_Ports{AD2USB}{object}; - $::Year_Month_Now = &::time_date_stamp( 10, time ); # Not yet set when we init. - LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", " ========= AD2USB.pm Serial Initialized =========" ); - $connecttype = 'serial'; - } + $::Year_Month_Now = &::time_date_stamp( 10, time ); # Not yet set when we init. + LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", " ========= AD2USB.pm Serial Initialized =========" ); + $connecttype = 'serial'; + } } elsif ($::config_parms{'AD2USB_ser2sock_ip'}) { $recon_timer = new Timer; - $ip = $::config_parms{'AD2USB_ser2sock_ip'}; - $port = $::config_parms{'AD2USB_ser2sock_port'}; - &main::print_log(" AD2USB.pm initializing TCP session with $ip on port $port") if $main::config_parms{debug} eq 'AD2USB'; - $AD2USB_ser2sock = new Socket_Item(undef, undef, "$ip:$port", 'AD2USB', 'tcp', 'raw'); - $AD2USB_ser2sock_sender = new Socket_Item(undef, undef, "$ip:$port", 'AD2USB_SENDER', 'tcp', 'rawout'); - start $AD2USB_ser2sock; - start $AD2USB_ser2sock_sender; - &::MainLoop_pre_add_hook( \&AD2USB::check_for_data, 1 ); - $::Year_Month_Now = &::time_date_stamp( 10, time ); # Not yet set when we init. - LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", " ========= AD2USB.pm Socket Initialized =========" ); - $connecttype = 'tcp'; - } else { - warn "AD2USB.pm->startup AD2USB_serial_port or AD2USB_ser2sock_ip not defined in mh.ini file"; - } - } + $ip = $::config_parms{'AD2USB_ser2sock_ip'}; + $port = $::config_parms{'AD2USB_ser2sock_port'}; + &main::print_log(" AD2USB.pm initializing TCP session with $ip on port $port") if $main::config_parms{debug} eq 'AD2USB'; + $AD2USB_ser2sock = new Socket_Item(undef, undef, "$ip:$port", 'AD2USB', 'tcp', 'raw'); + $AD2USB_ser2sock_sender = new Socket_Item(undef, undef, "$ip:$port", 'AD2USB_SENDER', 'tcp', 'rawout'); + start $AD2USB_ser2sock; + start $AD2USB_ser2sock_sender; + &::MainLoop_pre_add_hook( \&AD2USB::check_for_data, 1 ); + $::Year_Month_Now = &::time_date_stamp( 10, time ); # Not yet set when we init. + LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", " ========= AD2USB.pm Socket Initialized =========" ); + $connecttype = 'tcp'; + } else { + warn "AD2USB.pm->startup AD2USB_serial_port or AD2USB_ser2sock_ip not defined in mh.ini file"; + } +} #}}} # module startup; hack because of the startup error {{{ From a7827967c4a12c96435cd19b88bf358eb33e2e8c Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 4 Jan 2014 15:26:22 -0800 Subject: [PATCH 009/180] AD2: Add Notes Before Moving Things Around --- lib/AD2USB.pm | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 7d7009c13..31748aa17 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -131,6 +131,9 @@ sub serial_startup { $connecttype = 'serial'; } } elsif ($::config_parms{'AD2USB_ser2sock_ip'}) { + #This shouldn't be in this routine, which is meant to startup serial items + #The current kludge is to use '/dev/none' to get this routine to run, but + #that seems silly. $recon_timer = new Timer; $ip = $::config_parms{'AD2USB_ser2sock_ip'}; $port = $::config_parms{'AD2USB_ser2sock_port'}; @@ -151,6 +154,11 @@ sub serial_startup { #}}} # module startup; hack because of the startup error {{{ sub startup { + ##This is called as a result of using a .*_module parameter in the ini file + ##if only purpose of _module paramter is to call this, why do we use the + ##parameter? + ##Perhaps move socket startup here? Then we would still need the _module + ##parameter } From fe223633bf4733575faf953a5742b8fe19b20d7e Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sun, 5 Jan 2014 17:10:40 -0800 Subject: [PATCH 010/180] AD2: Add Notes and Correct Tab Spacing in Check for Data Why are we hardcoding $Self? --- lib/AD2USB.pm | 48 +++++++++++++++++++++++++----------------------- 1 file changed, 25 insertions(+), 23 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 31748aa17..966ea2791 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -165,32 +165,34 @@ sub startup { #}}} # check for incoming data on serial port {{{ +# This is called once per loop by a Mainloop_pre hook sub check_for_data { - my $NewCmd; - - if ($connecttype eq 'serial') { - &main::check_for_generic_serial_data('AD2USB'); + my ($self) = @_; + my $NewCmd; + + if ($connecttype eq 'serial') { + &main::check_for_generic_serial_data('AD2USB'); $NewCmd = $main::Serial_Ports{'AD2USB'}{data}; - $main::Serial_Ports{'AD2USB'}{data} = ''; - } - - if ($connecttype eq 'tcp') { - if (active $AD2USB_ser2sock) { - $NewCmd = said $AD2USB_ser2sock; - } else { - # restart the TCP connection if its lost. + $main::Serial_Ports{'AD2USB'}{data} = ''; + } + + if ($connecttype eq 'tcp') { + if (active $AD2USB_ser2sock) { + $NewCmd = said $AD2USB_ser2sock; + } else { + # restart the TCP connection if its lost. if (inactive $recon_timer) { - &main::print_log("Connection to AD2USB was lost, I will try to reconnect in $::config_parms{'AD2USB_ser2sock_recon'} seconds"); - # LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "AD2USB.pm ser2sock connection lost! Trying to reconnect." ); - set $recon_timer $::config_parms{'AD2USB_ser2sock_recon'}, sub { - start $AD2USB_ser2sock; - start $AD2USB_ser2sock_sender; - } - } - } - } - - $self=$Self; + &main::print_log("Connection to AD2USB was lost, I will try to reconnect in $::config_parms{'AD2USB_ser2sock_recon'} seconds"); + # LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "AD2USB.pm ser2sock connection lost! Trying to reconnect." ); + set $recon_timer $::config_parms{'AD2USB_ser2sock_recon'}, sub { + start $AD2USB_ser2sock; + start $AD2USB_ser2sock_sender; + } + } + } + } + + $self=$Self; #WTH is this? # we need to buffer the information receive, because many command could be include in a single pass $NewCmd = $IncompleteCmd . $NewCmd if $IncompleteCmd; return if !$NewCmd; From e743551bacadd1e34b8a1edf40d38181ed55531b Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sun, 5 Jan 2014 17:12:42 -0800 Subject: [PATCH 011/180] AD2: Add Notes and Correct Tabs in Check for Data --- lib/AD2USB.pm | 91 ++++++++++++++++++++++++++------------------------- 1 file changed, 46 insertions(+), 45 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 966ea2791..39332a424 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -202,18 +202,20 @@ sub check_for_data { foreach my $c ( split( //, $NewCmd ) ) { if ( $c eq '#' ) { if ($Cmd) { - &main::print_log($Cmd); # This is a full command that was terminated by \r\n + ::print_log("[AD2USB] " . $Cmd) if $main::Debug{AD2USB} >= 1; my $status_type = GetStatusType($Cmd); if ($status_type >= 10) { # This is a panel message if (($Cmd ne $self->{panel_status}) || ($status_type == 11)) { + # This is a new message &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "NEW: $Cmd") if $main::config_parms{AD2USB_debug_log}; CheckCmd($Cmd); ResetAdemcoState(); $self->{panel_status} = $Cmd; } else { + # This is a duplicate message &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "DUPE: $Cmd") if $main::config_parms{AD2USB_debug_log}; } } @@ -222,7 +224,7 @@ sub check_for_data { &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "NONPANEL: $Cmd") if $main::config_parms{AD2USB_debug_log}; CheckCmd($Cmd); ResetAdemcoState(); - #$self->{panel_status} = $Cmd; + #$self->{panel_status} = $Cmd; } $Cmd = ''; } @@ -270,8 +272,8 @@ sub CheckCmd { case 11 { # IN FAULT LOOP my $status_codes = substr( $CmdStr, 1, 12 ); my $fault = substr( $CmdStr, 23, 3 ); - $fault = substr($CmdStr, 67, 2); - $fault = "0$fault"; + $fault = substr($CmdStr, 67, 2); #TODO Why do we set $fault twice? ^ + $fault = "0$fault"; my $panel_message = substr( $CmdStr, 61, 32); my $ZoneName = my $ZoneNum = $fault; @@ -280,56 +282,55 @@ sub CheckCmd { $ZoneNum =~ s/^0*//; $fault = $ZoneNum; - if (&MappedZones("00$ZoneNum")) { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Zone $ZoneNum is mapped to a Relay or RF ID, skipping normal monitoring!") } - else { - - #Check if this is the new lowest fault number and reset the zones before it - if (int($fault) <= int($self->{zone_lowest_fault})) { - $self->{zone_lowest_fault} = $fault; - #Reset zones to ready before the lowest - $start = 1; - $end = $self->{zone_lowest_fault} - 1; - ChangeZones( $start, $end, "ready", "bypass", 1); - } - - #Check if this is a new highest fault number and reset zones after it - if (int($fault) > int($self->{zone_highest_fault})) { - $self->{zone_highest_fault} = $fault; - #Reset zones to ready after the highest - $start = $self->{zone_highest_fault} + 1;; - $end = 11; - ChangeZones( $start, $end, "ready", "bypass", 1); - } - - # Check if this zone was already faulted - if ($self->{zone_status}{"$fault"} eq "fault") { - - #Check if this fault is less than the last fault (and must now be the new lowest zone) - if (int($fault) <= int($self->{zone_last_num})) { - #This is the new lowest zone + if (&MappedZones("00$ZoneNum")) { + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Zone $ZoneNum is mapped to a Relay or RF ID, skipping normal monitoring!") } + else { + #Check if this is the new lowest fault number and reset the zones before it + if (int($fault) <= int($self->{zone_lowest_fault})) { $self->{zone_lowest_fault} = $fault; #Reset zones to ready before the lowest $start = 1; $end = $self->{zone_lowest_fault} - 1; ChangeZones( $start, $end, "ready", "bypass", 1); - } - - #Check if this fault is equal to the last fault (and must now be the only zone) - if (int($fault) == int($self->{zone_last_num})) { - #Reset zones to ready after the only one - $start = int($fault) + 1; - $end = 11; - ChangeZones( $start, $end, "ready", "bypass", 1); } - #Check if this fault is greater than the last fault and reset the zones between it and the prior one - if (int($fault) > int($self->{zone_last_num})) { - $start = (($self->{zone_last_num} == $fault) ? 1 : int($self->{zone_last_num}) + 1); - $end = $fault - 1; + #Check if this is a new highest fault number and reset zones after it + if (int($fault) > int($self->{zone_highest_fault})) { + $self->{zone_highest_fault} = $fault; + #Reset zones to ready after the highest + $start = $self->{zone_highest_fault} + 1;; + $end = 11; ChangeZones( $start, $end, "ready", "bypass", 1); } - } + + # Check if this zone was already faulted + if ($self->{zone_status}{"$fault"} eq "fault") { + + #Check if this fault is less than the last fault (and must now be the new lowest zone) + if (int($fault) <= int($self->{zone_last_num})) { + #This is the new lowest zone + $self->{zone_lowest_fault} = $fault; + #Reset zones to ready before the lowest + $start = 1; + $end = $self->{zone_lowest_fault} - 1; + ChangeZones( $start, $end, "ready", "bypass", 1); + } + + #Check if this fault is equal to the last fault (and must now be the only zone) + if (int($fault) == int($self->{zone_last_num})) { + #Reset zones to ready after the only one + $start = int($fault) + 1; + $end = 11; + ChangeZones( $start, $end, "ready", "bypass", 1); + } + + #Check if this fault is greater than the last fault and reset the zones between it and the prior one + if (int($fault) > int($self->{zone_last_num})) { + $start = (($self->{zone_last_num} == $fault) ? 1 : int($self->{zone_last_num}) + 1); + $end = $fault - 1; + ChangeZones( $start, $end, "ready", "bypass", 1); + } + } #Not MappedZones $self->{zone_now_msg} = "$panel_message"; From 15b2849c1fb3380ea0008b4c3d05369ce340bc19 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sun, 5 Jan 2014 17:13:25 -0800 Subject: [PATCH 012/180] AD2: Add Notes and Correct Tabs in CheckCmd and GetStatusType --- lib/AD2USB.pm | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 39332a424..90c8f174a 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -348,8 +348,8 @@ sub CheckCmd { case 12 { # IN BYPASS FLASH LOOP my $status_codes = substr( $CmdStr, 1, 12 ); my $fault = substr( $CmdStr, 23, 3 ); -$fault = substr($CmdStr, 67, 2); -$fault = "0$fault"; + $fault = substr($CmdStr, 67, 2); + $fault = "0$fault"; my $panel_message = substr( $CmdStr, 61, 32); my $ZoneName = my $ZoneNum = $fault; @@ -801,6 +801,9 @@ sub GetStatusType { my $ll = length($AdemcoStr); if ($ll eq 94) { + # Keypad Message + # Format: Bit field,Numeric code,Raw data,Alphanumeric Keypad Message + # TODO I would be inclined to split by comma rather than use substr my $substatus = substr($AdemcoStr, 61, 5); if ( $substatus eq "FAULT" ) { &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Fault zones available: $AdemcoStr") if $main::config_parms{AD2USB_debug_log}; @@ -810,7 +813,7 @@ sub GetStatusType { &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Bypass zones available: $AdemcoStr") if $main::config_parms{AD2USB_debug_log}; return 12; } - elsif (index($AdemcoStr, "Hit *") >= 0) { + elsif ($AdemcoStr =~ m/Hit \*|Press \*/) { &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Faults available: $AdemcoStr") if $main::config_parms{AD2USB_debug_log}; return 10; } From c35cffe1f55a5c040e203190b7b688ac208e500a Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Mon, 6 Jan 2014 20:38:16 -0800 Subject: [PATCH 013/180] AD2: Fix Tabbing, Make Sure Setby is Self --- lib/AD2USB.pm | 32 +++++++++++++++----------------- 1 file changed, 15 insertions(+), 17 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 90c8f174a..cddbef976 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -267,8 +267,8 @@ sub CheckCmd { case 10 { # FAULTS AVAILABLE # &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Faults exist and are available to parse" ) if $main::config_parms{AD2USB_debug_log}; cmd( $self, "ShowFaults" ); - } - + } + case 11 { # IN FAULT LOOP my $status_codes = substr( $CmdStr, 1, 12 ); my $fault = substr( $CmdStr, 23, 3 ); @@ -330,15 +330,14 @@ sub CheckCmd { $end = $fault - 1; ChangeZones( $start, $end, "ready", "bypass", 1); } - } #Not MappedZones - + } #End Already Faulted - $self->{zone_now_msg} = "$panel_message"; - $self->{zone_now_status} = "fault"; - $self->{zone_now_name} = "$ZoneName"; - $self->{zone_now_num} = "$ZoneNum"; - ChangeZones( int($ZoneNum), int($ZoneNum), "fault", "", 1); - } + $self->{zone_now_msg} = "$panel_message"; + $self->{zone_now_status} = "fault"; + $self->{zone_now_name} = "$ZoneName"; + $self->{zone_now_num} = "$ZoneNum"; + ChangeZones( int($ZoneNum), int($ZoneNum), "fault", "", 1); + } #Not MappedZones $self->{partition_now_msg} = "$panel_message"; $self->{partition_now_status} = "not ready"; $self->{partition_now_num} = "$PartNum"; @@ -673,8 +672,7 @@ sub CheckCmd { } } - - case 4 { # RELAY STATUS + case 4 { # RELAY STATUS my $rel_id = substr( $CmdStr, 5, 2 ); my $rel_input_id = substr( $CmdStr, 8, 2 ); my $rel_status = substr( $CmdStr, 11, 2 ); @@ -864,7 +862,7 @@ sub ChangeZones { } $self->{zone_status}{"$i"} = $new_status; # Set child object status if it is registered to the zone - $$self{zone_object}{"$i"}->set($new_status) if defined $$self{zone_object}{"$i"}; + $$self{zone_object}{"$i"}->set($new_status, $$self{zone_object}{"$i"}) if defined $$self{zone_object}{"$i"}; } } } @@ -1118,14 +1116,14 @@ sub cmd_list { #}}} ##Used to register a child object to the zone. Allows for MH-style Door & Motion sensors {{{ sub register { - my ($class, $object, $zone_num ) = @_; + my ($self, $object, $zone_num ) = @_; &::print_log("Registering Child Object on zone $zone_num"); - $_[0]->{zone_object}{$zone_num} = $object; + $self->{zone_object}{$zone_num} = $object; } sub get_child_object_name { - my ($class,$zone_num) = @_; - my $object = $_[0]->{zone_object}{$zone_num}; + my ($self,$zone_num) = @_; + my $object = $self->{zone_object}{$zone_num}; return $object->get_object_name() if defined ($object); } From d2888e02eb01ccea1813af4132a3d9d92ce973a1 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 9 Jan 2014 17:51:00 -0800 Subject: [PATCH 014/180] AD2: Get Rid of CmdMsg Global Variabls, Simply DefineCmdMsg Can't use a global variable, otherwise users would not be able to have multiple panels setup in MH. Greatly simply DefineCmdMsg mess. --- lib/AD2USB.pm | 84 +++++++++++++++++++++++---------------------------- 1 file changed, 37 insertions(+), 47 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index cddbef976..1d3f9f14d 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -44,9 +44,7 @@ package AD2USB; @AD2USB::ISA = ('Generic_Item'); -my %CmdMsg; -my %CmdMsgRev; -my $Self; +my $Self; #Kludge my %ErrorCode; my $IncompleteCmd; my $connecttype; @@ -931,38 +929,7 @@ sub ResetAdemcoState { #}}} # Define hash with Ademco commands {{{ sub DefineCmdMsg { - my %OutputListco; - foreach my $key (keys(%::config_parms)) { - next if $key =~ /_MHINTERNAL_/; - next if $key !~ /^AD2USB_output_(\D+)_(\d+)$/; - if ($1 eq 'co') { - $OutputListco{"$::config_parms{$key}c"} = "$::config_parms{AD2USB_user_master_code}#70$2"; - $OutputListco{"$::config_parms{$key}o"} = "$::config_parms{AD2USB_user_master_code}#80$2"; - } - if ($1 eq 'oc') { - $OutputListco{"$::config_parms{$key}o"} = "$::config_parms{AD2USB_user_master_code}#80$2"; - $OutputListco{"$::config_parms{$key}c"} = "$::config_parms{AD2USB_user_master_code}#70$2"; - } - if ($1 eq 'o') { - $OutputListco{"$::config_parms{$key}o"} = "$::config_parms{AD2USB_user_master_code}#80$2"; - } - if ($1 eq 'c') { - $OutputListco{"$::config_parms{$key}c"} = "$::config_parms{AD2USB_user_master_code}#70$2"; - } - } - - my %ExpListc; - my $srpzonenum; - foreach my $key (keys(%::config_parms)) { - next if $key =~ /_MHINTERNAL_/; - next if $key !~ /^AD2USB_expander_(\d+)$/; - $srpzonenum = substr($::config_parms{$key}, 1); - $ExpListc{"exp$::config_parms{$key}c"} = "L$srpzonenum"."0"; - $ExpListc{"exp$::config_parms{$key}f"} = "L$srpzonenum"."1"; - $ExpListc{"exp$::config_parms{$key}p"} = "L$srpzonenum"."2"; - } - - %CmdMsg = ( + my %Return_Hash = ( "Disarm" => "$::config_parms{AD2USB_user_master_code}1", "ArmAway" => "$::config_parms{AD2USB_user_master_code}2", "ArmStay" => "$::config_parms{AD2USB_user_master_code}3", @@ -977,13 +944,36 @@ sub DefineCmdMsg { "AD2USBReboot" => "=", "AD2USBConfigure" => "!" ); - - my %newHash = (%OutputListco, %CmdMsg); - %CmdMsg = %newHash; - %newHash = (%ExpListc, %CmdMsg); - %CmdMsg = %newHash; - %CmdMsgRev = reverse %CmdMsg; - return; + + my $two_digit_zone; + foreach my $key (keys(%::config_parms)) { + #Create Commands for Relays + if ($key =~ /^AD2USB_output_(\D+)_(\d+)$/){ + if ($1 eq 'co') { + $Return_Hash{"$::config_parms{$key}c"} = "$::config_parms{AD2USB_user_master_code}#70$2"; + $Return_Hash{"$::config_parms{$key}o"} = "$::config_parms{AD2USB_user_master_code}#80$2"; + } + elsif ($1 eq 'oc') { + $Return_Hash{"$::config_parms{$key}o"} = "$::config_parms{AD2USB_user_master_code}#80$2"; + $Return_Hash{"$::config_parms{$key}c"} = "$::config_parms{AD2USB_user_master_code}#70$2"; + } + elsif ($1 eq 'o') { + $Return_Hash{"$::config_parms{$key}o"} = "$::config_parms{AD2USB_user_master_code}#80$2"; + } + elsif ($1 eq 'c') { + $Return_Hash{"$::config_parms{$key}c"} = "$::config_parms{AD2USB_user_master_code}#70$2"; + } + } + #Create Commands for Zone Expanders + elsif ($key =~ /^AD2USB_expander_(\d+)$/) { + $two_digit_zone = substr($::config_parms{$key}, 1); #Trim leading zero + $Return_Hash{"exp$::config_parms{$key}c"} = "L$two_digit_zone"."0"; + $Return_Hash{"exp$::config_parms{$key}f"} = "L$two_digit_zone"."1"; + $Return_Hash{"exp$::config_parms{$key}p"} = "L$two_digit_zone"."2"; + } + } + + return \%Return_Hash; } #}}} @@ -1013,11 +1003,10 @@ sub MappedZones { #}}} # Sending command to ADEMCO panel {{{ sub cmd { + my ( $self, $cmd, $password ) = @_; + $cmd = $self->{CmdMsg}->{$cmd}; - my ( $class, $cmd, $password ) = @_; - $cmd = $CmdMsg{$cmd}; - - $CmdName = ( exists $CmdMsgRev{$cmd} ) ? $CmdMsgRev{$cmd} : "unknown"; + $CmdName = ( exists $self->{CmdMsgRev}->{$cmd} ) ? $self->{CmdMsgRev}->{$cmd} : "unknown"; $CmdStr = $cmd; # Exit if unknown command @@ -1109,7 +1098,8 @@ sub partition_name { } sub cmd_list { - foreach my $k ( sort keys %CmdMsg ) { + my ($self) = @_; + foreach my $k ( sort keys %{$self->{CmdMsg}} ) { &::print_log("$k"); } } From 83b3ee9c01147939758b93f93cf4699602c26623 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 9 Jan 2014 17:57:00 -0800 Subject: [PATCH 015/180] AD2: Clean up new() Sub, Don't Change Config Hash Make new() sub much easier to read, get rid of verbose coding. Remove all changes to Config Hash, this should be read-only as it represents the contents of the ini file, this contents can be updated by MH --- lib/AD2USB.pm | 117 ++++++++++++++++++++++++-------------------------- 1 file changed, 57 insertions(+), 60 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 1d3f9f14d..a78f1ba7f 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -50,41 +50,38 @@ my $IncompleteCmd; my $connecttype; # Starting a new object {{{ +# Called by user code `$AD2USB = new AD2USB` sub new { my ($class) = @_; - my $self = {}; - $$self{panel_status} = 'Unknown'; - $$self{Log} = []; + ::print_log("Starting ADEMCO panel interface module"); + + my $self = new Generic_Item(); + + # Initialize Variables + $$self{last_cmd} = ''; + $$self{Log} = []; #Not clear why this is needed $$self{ac_power} = 0; $$self{battery_low} = 1; $$self{chime} = 0; + $$self{keys_sent} = 0; + $$self{reconnect_time} = $::config_parms{'AD2USB_ser2sock_recon'}; + $$self{reconnect_time} = 10 if !defined($$self{reconnect_time}); bless $self, $class; # load command hash - DefineCmdMsg(); + $$self{CmdMsg} = $self->DefineCmdMsg(); + $$self{CmdMsgRev} = {reverse %{$$self{CmdMsg}}}; #DeRef Hash, Rev, Conv to Ref + # The following logs default to being enabled, can only be disabled by + # proactively setting their ini parameters to 0: + # AD2USB_part_log AD2USB_zone_log AD2USB_debug_log - my @LogType = qw(AD2USB_part_log AD2USB_zone_log AD2USB_debug_log); - foreach (@LogType) { - if ( !exists $::config_parms{$_} ) { - $main::config_parms{$_} = 1; - &::print_log("Parameter $_ not defined in mh.private.ini, enabling by default"); - } - } - - if ( !exists $::config_parms{'AD2USB_ser2sock_recon'} ) { - $::config_parms{'AD2USB_ser2sock_recon'} = 10; - &::print_log("Parameter AD2USB_ser2sock_recon not defined in mh.private.ini, enabling by default"); - } - - &main::print_log("Starting ADEMCO panel interface module"); - $Self = $self; - - #Set all zones to ready + #Set all zones and partitions to ready ChangeZones( 1, 100, "ready", "ready", 0); ChangePartitions( 1, 1, "ready", 0); - $self->{keys_sent} = 0; + + $Self = $self; #Kludge return $self; } @@ -180,9 +177,9 @@ sub check_for_data { } else { # restart the TCP connection if its lost. if (inactive $recon_timer) { - &main::print_log("Connection to AD2USB was lost, I will try to reconnect in $::config_parms{'AD2USB_ser2sock_recon'} seconds"); + &main::print_log("Connection to AD2USB was lost, I will try to reconnect in $$self{reconnect_time} seconds"); # LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "AD2USB.pm ser2sock connection lost! Trying to reconnect." ); - set $recon_timer $::config_parms{'AD2USB_ser2sock_recon'}, sub { + set $recon_timer $$self{reconnect_time}, sub { start $AD2USB_ser2sock; start $AD2USB_ser2sock_sender; } @@ -205,24 +202,24 @@ sub check_for_data { my $status_type = GetStatusType($Cmd); if ($status_type >= 10) { # This is a panel message - if (($Cmd ne $self->{panel_status}) || ($status_type == 11)) { + if (($Cmd ne $self->{last_cmd}) || ($status_type == 11)) { # This is a new message - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "NEW: $Cmd") if $main::config_parms{AD2USB_debug_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "NEW: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); CheckCmd($Cmd); ResetAdemcoState(); - $self->{panel_status} = $Cmd; + $self->{last_cmd} = $Cmd; } else { # This is a duplicate message - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "DUPE: $Cmd") if $main::config_parms{AD2USB_debug_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "DUPE: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); } } else { # This is a relay or RF or zone expander message - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "NONPANEL: $Cmd") if $main::config_parms{AD2USB_debug_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "NONPANEL: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); CheckCmd($Cmd); ResetAdemcoState(); - #$self->{panel_status} = $Cmd; + #$self->{last_cmd} = $Cmd; } $Cmd = ''; } @@ -248,22 +245,22 @@ sub CheckCmd { switch ( $status_type ) { case -1 { # UNRECOGNIZED STATUS - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "UNKNOWN STATUS: $CmdStr" ) if $main::config_parms{AD2USB_debug_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "UNKNOWN STATUS: $CmdStr" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } case 0 { # Key send confirmation if ($self->{keys_sent} == 0) { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key sent from ANOTHER panel." ) if $main::config_parms{AD2USB_debug_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key sent from ANOTHER panel." ) unless ($main::config_parms{AD2USB_debug_log} == 0); } else { $self->{keys_sent}--; - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key received ($self->{keys_sent} left)" ) if $main::config_parms{AD2USB_debug_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key received ($self->{keys_sent} left)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } } case 10 { # FAULTS AVAILABLE -# &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Faults exist and are available to parse" ) if $main::config_parms{AD2USB_debug_log}; +# &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Faults exist and are available to parse" ) unless ($main::config_parms{AD2USB_debug_log} == 0); cmd( $self, "ShowFaults" ); } @@ -373,7 +370,7 @@ sub CheckCmd { my $status_codes = substr( $CmdStr, 1, 12 ); my $fault = substr( $CmdStr, 23, 3 ); my $panel_message = substr( $CmdStr, 61, 32); - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key received ($self->{keys_sent} left)" ) if $main::config_parms{AD2USB_debug_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key received ($self->{keys_sent} left)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); # READY $data = 0; @@ -466,7 +463,7 @@ sub CheckCmd { # PROGRAMMING MODE $data = 4; if ( substr($status_codes,$data,1) eq "1" ) { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel is in programming mode" ) if $main::config_parms{AD2USB_debug_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel is in programming mode" ) unless ($main::config_parms{AD2USB_debug_log} == 0); # Reset state for fault checks $self->{zone_last_status} = ""; @@ -508,7 +505,7 @@ sub CheckCmd { $data = 9; if ( substr($status_codes,$data,1) == "1" ) { $EventName = "ALARM WAS TRIGGERED"; - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName" ) if $main::config_parms{AD2USB_part_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName" ) unless ($main::config_parms{AD2USB_part_log} == 0); } # ALARM IS SOUNDING @@ -521,7 +518,7 @@ sub CheckCmd { my $ZoneNum = $fault; $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; $PartName = $main::config_parms{"AD2USB_part_$PartName"} if exists $main::config_parms{"AD2USB_part_$PartName"}; - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName - Zone $ZoneNum ($ZoneName)" ) if $main::config_parms{AD2USB_part_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName - Zone $ZoneNum ($ZoneName)" ) unless ($main::config_parms{AD2USB_part_log} == 0); $ZoneNum =~ s/^0*//; ChangeZones( int($ZoneNum), int($ZoneNum), "alarm", "", 1); $self->{zone_now_msg} = "$panel_message"; @@ -569,8 +566,8 @@ sub CheckCmd { my $loop_fault_4 = 0; $loop_fault_4 = 1 if (hex(substr($rf_status, 0, 1)) & 4) == 4; - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "WIRELESS: rf_id($rf_id) status($rf_status) loop1($loop_fault_1) loop2($loop_fault_2) loop3($loop_fault_3) loop4($loop_fault_4)" ) if $main::config_parms{AD2USB_debug_log}; - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "WIRELESS: rf_id($rf_id) status($rf_status) low_batt($low_batt) supervised($supervised)" ) if $main::config_parms{AD2USB_debug_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "WIRELESS: rf_id($rf_id) status($rf_status) loop1($loop_fault_1) loop2($loop_fault_2) loop3($loop_fault_3) loop4($loop_fault_4)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "WIRELESS: rf_id($rf_id) status($rf_status) low_batt($low_batt) supervised($supervised)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); my $ZoneStatus = "ready"; my $PartStatus = ""; @@ -636,7 +633,7 @@ sub CheckCmd { my $ZoneStatus; my $PartStatus; - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "EXPANDER: exp_id($exp_id) input($input_id) status($status)" ) if $main::config_parms{AD2USB_debug_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "EXPANDER: exp_id($exp_id) input($input_id) status($status)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); if (exists $main::config_parms{"AD2USB_expander_$exp_id$input_id"}) { # Assign zone @@ -679,7 +676,7 @@ sub CheckCmd { my $PartStatus; - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "RELAY: rel_id($rel_id) input($rel_input_id) status($rel_status)" ) if $main::config_parms{AD2USB_debug_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "RELAY: rel_id($rel_id) input($rel_input_id) status($rel_status)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); if (exists $main::config_parms{"AD2USB_relay_$rel_id$rel_input_id"}) { # Assign zone @@ -714,7 +711,7 @@ sub CheckCmd { } else { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "SOMETHING SERIOUSLY WRONG - UNKNOWN COMMAND" ) if $main::config_parms{AD2USB_debug_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "SOMETHING SERIOUSLY WRONG - UNKNOWN COMMAND" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } } @@ -730,14 +727,14 @@ sub CheckCmd { # BACKLIGHT $data = 3; if ( substr($status_codes,$data,1) == "1" ) { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel backlight is on" ) if $main::config_parms{AD2USB_debug_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel backlight is on" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } # BEEPS $data = 5; if ( substr($status_codes,$data,1) != "0" ) { $NumBeeps = substr($status_codes,$data,1); - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel beeped $NumBeeps times" ) if $main::config_parms{AD2USB_debug_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel beeped $NumBeeps times" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } # AC POWER @@ -754,11 +751,11 @@ sub CheckCmd { $data = 8; if ( substr($status_codes,$data,1) == "0" ) { $self->{chime} = 0; -# &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Chime is off" ) if $main::config_parms{AD2USB_debug_log}; +# &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Chime is off" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } else { $self->{chime} = 1; -# &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Chime is on" ) if $main::config_parms{AD2USB_debug_log}; +# &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Chime is on" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } # BATTERY LOW @@ -802,15 +799,15 @@ sub GetStatusType { # TODO I would be inclined to split by comma rather than use substr my $substatus = substr($AdemcoStr, 61, 5); if ( $substatus eq "FAULT" ) { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Fault zones available: $AdemcoStr") if $main::config_parms{AD2USB_debug_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Fault zones available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); return 11; } elsif ( $substatus eq "BYPAS" ) { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Bypass zones available: $AdemcoStr") if $main::config_parms{AD2USB_debug_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Bypass zones available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); return 12; } elsif ($AdemcoStr =~ m/Hit \*|Press \*/) { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Faults available: $AdemcoStr") if $main::config_parms{AD2USB_debug_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Faults available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); return 10; } else { @@ -819,19 +816,19 @@ sub GetStatusType { } } elsif (substr($AdemcoStr,0,5) eq "!RFX:") { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Wireless status received.") if $main::config_parms{AD2USB_debug_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Wireless status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); return 2; } elsif (substr($AdemcoStr,0,5) eq "!EXP:") { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Expander status received.") if $main::config_parms{AD2USB_debug_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Expander status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); return 3; } elsif (substr($AdemcoStr,0,5) eq "!REL:") { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Relay status received.") if $main::config_parms{AD2USB_debug_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Relay status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); return 4; } elsif ($AdemcoStr eq "!Sending...done") { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Command sent successfully.") if $main::config_parms{AD2USB_debug_log};; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Command sent successfully.") unless ($main::config_parms{AD2USB_debug_log} == 0); return 0; } return -1; @@ -850,13 +847,13 @@ sub ChangeZones { for ($i = $start; $i <= $end; $i++) { $current_status = $self->{zone_status}{"$i"}; if (($current_status ne $new_status) && ($current_status ne $neq_status)) { - if (($main::config_parms{AD2USB_zone_log}) && ($log == 1)) { + if (($main::config_parms{AD2USB_zone_log} != 0) && ($log == 1)) { my $ZoneNumPadded = $i; $ZoneNumPadded = sprintf("%3d", $ZoneNumPadded); $ZoneNumPadded =~ tr/ /0/; $ZoneName = "Unknown"; $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNumPadded"} if exists $main::config_parms{"AD2USB_zone_$ZoneNumPadded"}; - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Zone $i ($ZoneName) changed from '$current_status' to '$new_status'" ) if $main::config_parms{AD2USB_zone_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Zone $i ($ZoneName) changed from '$current_status' to '$new_status'" ) unless ($main::config_parms{AD2USB_zone_log} == 0); } $self->{zone_status}{"$i"} = $new_status; # Set child object status if it is registered to the zone @@ -877,9 +874,9 @@ sub ChangePartitions { for ($i = $start; $i <= $end; $i++) { $current_status = $self->{partition_status}{"$i"}; if ($current_status ne $new_status) { - if (($main::config_parms{AD2USB_part_log}) && ($log == 1)) { + if (($main::config_parms{AD2USB_part_log} != 0) && ($log == 1)) { $PartName = $main::config_parms{"AD2USB_part_$i"} if exists $main::config_parms{"AD2USB_part_$i"}; - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Partition $i ($PartName) changed from '$current_status' to '$new_status'" ) if $main::config_parms{AD2USB_part_log}; + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Partition $i ($PartName) changed from '$current_status' to '$new_status'" ) unless ($main::config_parms{AD2USB_part_log} == 0); } $self->{partition_status}{"$i"} = $new_status; } @@ -1021,8 +1018,8 @@ sub cmd { return; } - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", ">>> Sending to ADEMCO panel $CmdName ($cmd)" ) if $main::config_parms{AD2USB_debug_log}; - $class->{keys_sent} = $class->{keys_sent} + length($CmdStr); + &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", ">>> Sending to ADEMCO panel $CmdName ($cmd)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + $self->{keys_sent} = $self->{keys_sent} + length($CmdStr); if ($connecttype eq 'serial') { $main::Serial_Ports{AD2USB}{object}->write("$CmdStr"); } else { From 0c83226086e7b8e09bc7ebce0712223c1e54348e Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 9 Jan 2014 17:57:00 -0800 Subject: [PATCH 016/180] AD2: Remove Unnecessary Checks for MHINTERNAL No need for this if regex includes start and end of line --- lib/AD2USB.pm | 2 -- 1 file changed, 2 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index a78f1ba7f..2d2d99c1f 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -980,7 +980,6 @@ sub ZoneName { my @Name = ["none"]; foreach my $key (keys(%::config_parms)) { - next if $key =~ /_MHINTERNAL_/; next if $key !~ /^AD2USB_zone_(\d+)$/; $Name[int($1)]=$::config_parms{$key}; } @@ -990,7 +989,6 @@ sub ZoneName { sub MappedZones { foreach my $mkey (keys(%::config_parms)) { - next if $mkey =~ /_MHINTERNAL_/; next if $mkey !~ /^AD2USB_(relay|wireless|expander)_(\d+)$/; if ("@_" eq $::config_parms{$mkey}) { return 1 } } From 2c621ee19d9fa2c129b432313cb812a9e51a1867 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 9 Jan 2014 18:05:00 -0800 Subject: [PATCH 017/180] AD2: Remove LocalLogit Function No need for this --- lib/AD2USB.pm | 86 +++++++++++++++++++++------------------------------ 1 file changed, 36 insertions(+), 50 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 2d2d99c1f..15ba1c2f2 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -204,19 +204,19 @@ sub check_for_data { # This is a panel message if (($Cmd ne $self->{last_cmd}) || ($status_type == 11)) { # This is a new message - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "NEW: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "NEW: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); CheckCmd($Cmd); ResetAdemcoState(); $self->{last_cmd} = $Cmd; } else { # This is a duplicate message - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "DUPE: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "DUPE: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); } } else { # This is a relay or RF or zone expander message - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "NONPANEL: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "NONPANEL: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); CheckCmd($Cmd); ResetAdemcoState(); #$self->{last_cmd} = $Cmd; @@ -245,22 +245,22 @@ sub CheckCmd { switch ( $status_type ) { case -1 { # UNRECOGNIZED STATUS - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "UNKNOWN STATUS: $CmdStr" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "UNKNOWN STATUS: $CmdStr" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } case 0 { # Key send confirmation if ($self->{keys_sent} == 0) { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key sent from ANOTHER panel." ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key sent from ANOTHER panel." ) unless ($main::config_parms{AD2USB_debug_log} == 0); } else { $self->{keys_sent}--; - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key received ($self->{keys_sent} left)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key received ($self->{keys_sent} left)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } } case 10 { # FAULTS AVAILABLE -# &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Faults exist and are available to parse" ) unless ($main::config_parms{AD2USB_debug_log} == 0); +# ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Faults exist and are available to parse" ) unless ($main::config_parms{AD2USB_debug_log} == 0); cmd( $self, "ShowFaults" ); } @@ -278,7 +278,7 @@ sub CheckCmd { $fault = $ZoneNum; if (&MappedZones("00$ZoneNum")) { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Zone $ZoneNum is mapped to a Relay or RF ID, skipping normal monitoring!") } + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Zone $ZoneNum is mapped to a Relay or RF ID, skipping normal monitoring!") } else { #Check if this is the new lowest fault number and reset the zones before it if (int($fault) <= int($self->{zone_lowest_fault})) { @@ -370,7 +370,7 @@ sub CheckCmd { my $status_codes = substr( $CmdStr, 1, 12 ); my $fault = substr( $CmdStr, 23, 3 ); my $panel_message = substr( $CmdStr, 61, 32); - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key received ($self->{keys_sent} left)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key received ($self->{keys_sent} left)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); # READY $data = 0; @@ -463,7 +463,7 @@ sub CheckCmd { # PROGRAMMING MODE $data = 4; if ( substr($status_codes,$data,1) eq "1" ) { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel is in programming mode" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel is in programming mode" ) unless ($main::config_parms{AD2USB_debug_log} == 0); # Reset state for fault checks $self->{zone_last_status} = ""; @@ -505,7 +505,7 @@ sub CheckCmd { $data = 9; if ( substr($status_codes,$data,1) == "1" ) { $EventName = "ALARM WAS TRIGGERED"; - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName" ) unless ($main::config_parms{AD2USB_part_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName" ) unless ($main::config_parms{AD2USB_part_log} == 0); } # ALARM IS SOUNDING @@ -518,7 +518,7 @@ sub CheckCmd { my $ZoneNum = $fault; $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; $PartName = $main::config_parms{"AD2USB_part_$PartName"} if exists $main::config_parms{"AD2USB_part_$PartName"}; - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName - Zone $ZoneNum ($ZoneName)" ) unless ($main::config_parms{AD2USB_part_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName - Zone $ZoneNum ($ZoneName)" ) unless ($main::config_parms{AD2USB_part_log} == 0); $ZoneNum =~ s/^0*//; ChangeZones( int($ZoneNum), int($ZoneNum), "alarm", "", 1); $self->{zone_now_msg} = "$panel_message"; @@ -566,8 +566,8 @@ sub CheckCmd { my $loop_fault_4 = 0; $loop_fault_4 = 1 if (hex(substr($rf_status, 0, 1)) & 4) == 4; - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "WIRELESS: rf_id($rf_id) status($rf_status) loop1($loop_fault_1) loop2($loop_fault_2) loop3($loop_fault_3) loop4($loop_fault_4)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "WIRELESS: rf_id($rf_id) status($rf_status) low_batt($low_batt) supervised($supervised)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "WIRELESS: rf_id($rf_id) status($rf_status) loop1($loop_fault_1) loop2($loop_fault_2) loop3($loop_fault_3) loop4($loop_fault_4)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "WIRELESS: rf_id($rf_id) status($rf_status) low_batt($low_batt) supervised($supervised)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); my $ZoneStatus = "ready"; my $PartStatus = ""; @@ -633,7 +633,7 @@ sub CheckCmd { my $ZoneStatus; my $PartStatus; - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "EXPANDER: exp_id($exp_id) input($input_id) status($status)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "EXPANDER: exp_id($exp_id) input($input_id) status($status)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); if (exists $main::config_parms{"AD2USB_expander_$exp_id$input_id"}) { # Assign zone @@ -676,7 +676,7 @@ sub CheckCmd { my $PartStatus; - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "RELAY: rel_id($rel_id) input($rel_input_id) status($rel_status)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "RELAY: rel_id($rel_id) input($rel_input_id) status($rel_status)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); if (exists $main::config_parms{"AD2USB_relay_$rel_id$rel_input_id"}) { # Assign zone @@ -711,7 +711,7 @@ sub CheckCmd { } else { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "SOMETHING SERIOUSLY WRONG - UNKNOWN COMMAND" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "SOMETHING SERIOUSLY WRONG - UNKNOWN COMMAND" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } } @@ -727,21 +727,21 @@ sub CheckCmd { # BACKLIGHT $data = 3; if ( substr($status_codes,$data,1) == "1" ) { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel backlight is on" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel backlight is on" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } # BEEPS $data = 5; if ( substr($status_codes,$data,1) != "0" ) { $NumBeeps = substr($status_codes,$data,1); - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel beeped $NumBeeps times" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel beeped $NumBeeps times" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } # AC POWER $data = 7; if ( substr($status_codes,$data,1) == "0" ) { $$self{ac_power} = 0; - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "AC Power has been lost" ); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "AC Power has been lost" ); } else { $$self{ac_power} = 1; @@ -751,18 +751,18 @@ sub CheckCmd { $data = 8; if ( substr($status_codes,$data,1) == "0" ) { $self->{chime} = 0; -# &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Chime is off" ) unless ($main::config_parms{AD2USB_debug_log} == 0); +# ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Chime is off" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } else { $self->{chime} = 1; -# &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Chime is on" ) unless ($main::config_parms{AD2USB_debug_log} == 0); +# ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Chime is on" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } # BATTERY LOW $data = 11; if ( substr($status_codes,$data,1) == "1" ) { $self->{battery_low} = 1; - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel is low on battery" ); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel is low on battery" ); } else { $self->{battery_low} = 0; @@ -774,20 +774,6 @@ sub CheckCmd { } -#}}} -# local logit call {{{ -sub LocalLogit { - my $file = shift; - my $str = shift; - &::logit( "$file", "$str" ); - my $Timestamp = &::time_date_stamp(16); - $str =~ s/ +/ /; - unshift @{ $Self->{Log} }, "$Timestamp: $str" if $str !~ /Temperature/; - pop @{ $Self->{Log} } if scalar( @{ $Self->{Log} } ) > 60; - -} - -#}}} # Determine if the status string requires parsing {{{ sub GetStatusType { my $AdemcoStr = shift; @@ -799,36 +785,36 @@ sub GetStatusType { # TODO I would be inclined to split by comma rather than use substr my $substatus = substr($AdemcoStr, 61, 5); if ( $substatus eq "FAULT" ) { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Fault zones available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Fault zones available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); return 11; } elsif ( $substatus eq "BYPAS" ) { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Bypass zones available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Bypass zones available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); return 12; } elsif ($AdemcoStr =~ m/Hit \*|Press \*/) { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Faults available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Faults available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); return 10; } else { -# &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Standard status received: $AdemcoStr"); +# ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Standard status received: $AdemcoStr"); return 13; } } elsif (substr($AdemcoStr,0,5) eq "!RFX:") { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Wireless status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Wireless status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); return 2; } elsif (substr($AdemcoStr,0,5) eq "!EXP:") { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Expander status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Expander status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); return 3; } elsif (substr($AdemcoStr,0,5) eq "!REL:") { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Relay status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Relay status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); return 4; } elsif ($AdemcoStr eq "!Sending...done") { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Command sent successfully.") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Command sent successfully.") unless ($main::config_parms{AD2USB_debug_log} == 0); return 0; } return -1; @@ -853,7 +839,7 @@ sub ChangeZones { $ZoneNumPadded =~ tr/ /0/; $ZoneName = "Unknown"; $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNumPadded"} if exists $main::config_parms{"AD2USB_zone_$ZoneNumPadded"}; - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Zone $i ($ZoneName) changed from '$current_status' to '$new_status'" ) unless ($main::config_parms{AD2USB_zone_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Zone $i ($ZoneName) changed from '$current_status' to '$new_status'" ) unless ($main::config_parms{AD2USB_zone_log} == 0); } $self->{zone_status}{"$i"} = $new_status; # Set child object status if it is registered to the zone @@ -876,7 +862,7 @@ sub ChangePartitions { if ($current_status ne $new_status) { if (($main::config_parms{AD2USB_part_log} != 0) && ($log == 1)) { $PartName = $main::config_parms{"AD2USB_part_$i"} if exists $main::config_parms{"AD2USB_part_$i"}; - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Partition $i ($PartName) changed from '$current_status' to '$new_status'" ) unless ($main::config_parms{AD2USB_part_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Partition $i ($PartName) changed from '$current_status' to '$new_status'" ) unless ($main::config_parms{AD2USB_part_log} == 0); } $self->{partition_status}{"$i"} = $new_status; } @@ -1006,17 +992,17 @@ sub cmd { # Exit if unknown command if ( $CmdName =~ /^unknown/ ) { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Invalid ADEMCO panel command : $CmdName ($cmd)"); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Invalid ADEMCO panel command : $CmdName ($cmd)"); return; } # Exit if password is wrong if ( ($password ne $::config_parms{AD2USB_user_master_code}) && ($CmdName ne "ShowFaults" ) ) { - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Invalid password for command $CmdName ($password)"); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Invalid password for command $CmdName ($password)"); return; } - &LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", ">>> Sending to ADEMCO panel $CmdName ($cmd)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", ">>> Sending to ADEMCO panel $CmdName ($cmd)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); $self->{keys_sent} = $self->{keys_sent} + length($CmdStr); if ($connecttype eq 'serial') { $main::Serial_Ports{AD2USB}{object}->write("$CmdStr"); From 5ca00f48118d05a77530fc97a16cf45ea3e2a94e Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 9 Jan 2014 21:09:17 -0800 Subject: [PATCH 018/180] AD2: Convert to a Multi-Object Design by Removing Global Vars --- lib/AD2USB.pm | 54 ++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 41 insertions(+), 13 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 15ba1c2f2..04353e183 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -46,24 +46,25 @@ package AD2USB; my $Self; #Kludge my %ErrorCode; -my $IncompleteCmd; -my $connecttype; +my %Socket_Items; #Stores the socket instances and attributes +my %Interfaces; #Stores the relationships btw instances and interfaces # Starting a new object {{{ # Called by user code `$AD2USB = new AD2USB` sub new { - my ($class) = @_; - ::print_log("Starting ADEMCO panel interface module"); + my ($class, $instance) = @_; + $instance = "AD2USB" if (!defined($instance)); + ::print_log("Starting $instance instance of ADEMCO panel interface module"); my $self = new Generic_Item(); # Initialize Variables $$self{last_cmd} = ''; - $$self{Log} = []; #Not clear why this is needed $$self{ac_power} = 0; $$self{battery_low} = 1; $$self{chime} = 0; $$self{keys_sent} = 0; + $$self{instance} = $instance; $$self{reconnect_time} = $::config_parms{'AD2USB_ser2sock_recon'}; $$self{reconnect_time} = 10 if !defined($$self{reconnect_time}); @@ -81,12 +82,28 @@ sub new { ChangeZones( 1, 100, "ready", "ready", 0); ChangePartitions( 1, 1, "ready", 0); + #Store Object with Instance Name + $self->set_object_instance($instance); + $Self = $self; #Kludge return $self; } #}}} + +# Set/Get Object by Instance {{{ +sub get_object_by_instance{ + my ($instance) = @_; + return $Interfaces{$instance}; +} + +sub set_object_instance{ + my ($self, $instance) = @_; + $Interfaces{$instance} = $self; +} +#}}} + # serial port configuration {{{ sub init { @@ -778,7 +795,6 @@ sub CheckCmd { sub GetStatusType { my $AdemcoStr = shift; my $ll = length($AdemcoStr); - if ($ll eq 94) { # Keypad Message # Format: Bit field,Numeric code,Raw data,Alphanumeric Keypad Message @@ -985,6 +1001,7 @@ sub MappedZones { # Sending command to ADEMCO panel {{{ sub cmd { my ( $self, $cmd, $password ) = @_; + my $instance = $$self{instance}; $cmd = $self->{CmdMsg}->{$cmd}; $CmdName = ( exists $self->{CmdMsgRev}->{$cmd} ) ? $self->{CmdMsgRev}->{$cmd} : "unknown"; @@ -1002,15 +1019,26 @@ sub cmd { return; } - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", ">>> Sending to ADEMCO panel $CmdName ($cmd)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", ">>> Sending to ADEMCO panel $CmdName ($cmd)" ) unless ($main::config_parms{$instance . '_debug_log'} == 0); $self->{keys_sent} = $self->{keys_sent} + length($CmdStr); - if ($connecttype eq 'serial') { - $main::Serial_Ports{AD2USB}{object}->write("$CmdStr"); - } else { - set $AD2USB_ser2sock_sender "$CmdStr"; - } + if (defined $Socket_Items{$instance}) { + if ($Socket_Items{$instance . '_sender'}{'socket'}->active) { + $Socket_Items{$instance . '_sender'}{'socket'}->set("$CmdStr"); + } else { + # restart the TCP connection if its lost. + if ($Socket_Items{$instance}{recon_timer}->inactive) { + ::print_log("Connection to $instance sending instance of AD2USB was lost, I will try to reconnect in $$self{reconnect_time} seconds"); + $Socket_Items{$instance}{recon_timer}->set($$self{reconnect_time}, sub { + $Socket_Items{$instance}{'socket'}->start; + $Socket_Items{$instance . '_sender'}{'socket'}->set("$CmdStr"); + }); + } + } + } + else { + $main::Serial_Ports{$instance}{'socket'}->write("$CmdStr"); + } return "Sending to ADEMCO panel: $CmdName ($cmd)"; - } #}}} From 23705cf6e6764a5b4301d9d9702f4d7a20197140 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 9 Jan 2014 21:13:33 -0800 Subject: [PATCH 019/180] AD2: Rework Check_for_Data to Handle Object Oriented Programming Also cleanup parser to make a little easier --- lib/AD2USB.pm | 163 ++++++++++++++++++++++---------------------------- 1 file changed, 72 insertions(+), 91 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 04353e183..bf37495d2 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -125,130 +125,111 @@ sub init { # module startup / enabling serial port {{{ sub serial_startup { my ($instance) = @_; - my $self = $Self; #WTH is this? - my $port; my $BaudRate; my $ip; - - #If Set to Use Ser2Sock Interface stop processing now - if ($::config_parms{$instance . "_use_TCP"} == 1) {return;} - - if ($::config_parms{'AD2USB_serial_port'} and $::config_parms{'AD2USB_serial_port'} ne '/dev/none') { - $port = $::config_parms{'AD2USB_serial_port'}; - $BaudRate = ( defined $::config_parms{AD2USB_baudrate} ) ? $main::config_parms{AD2USB_baudrate} : 115200; - if ( &main::serial_port_create( 'AD2USB', $port, $BaudRate, 'none', 'raw' ) ) { - init( $::Serial_Ports{AD2USB}{object}, $port ); - &main::print_log(" AD2USB.pm initializing port $port at $BaudRate baud") if $main::config_parms{debug} eq 'AD2USB'; - &::MainLoop_pre_add_hook( \&AD2USB::check_for_data, 1 ) if $main::Serial_Ports{AD2USB}{object}; + my ($port, $BaudRate, $ip); + + if ($::config_parms{$instance . '_serial_port'} and + $::config_parms{$instance . '_serial_port'} ne '/dev/none') { + $port = $::config_parms{$instance .'_serial_port'}; + $BaudRate = ( defined $::config_parms{$instance . '_baudrate'} ) ? $main::config_parms{"$instance" . '_baudrate'} : 115200; + if ( &main::serial_port_create( $instance, $port, $BaudRate, 'none', 'raw' ) ) { + init( $::Serial_Ports{$instance}{object}, $port ); + ::print_log("[AD2USB] initializing $instance on port $port at $BaudRate baud") if $main::config_parms{debug} eq 'AD2USB'; + ::MainLoop_pre_add_hook( sub {AD2USB::check_for_data($instance, 'serial');}, 1 ) if $main::Serial_Ports{"$instance"}{object}; $::Year_Month_Now = &::time_date_stamp( 10, time ); # Not yet set when we init. - LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", " ========= AD2USB.pm Serial Initialized =========" ); - $connecttype = 'serial'; + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", " ========= AD2USB.pm Serial Initialized =========" ); } - } elsif ($::config_parms{'AD2USB_ser2sock_ip'}) { - #This shouldn't be in this routine, which is meant to startup serial items - #The current kludge is to use '/dev/none' to get this routine to run, but - #that seems silly. - $recon_timer = new Timer; - $ip = $::config_parms{'AD2USB_ser2sock_ip'}; - $port = $::config_parms{'AD2USB_ser2sock_port'}; - &main::print_log(" AD2USB.pm initializing TCP session with $ip on port $port") if $main::config_parms{debug} eq 'AD2USB'; - $AD2USB_ser2sock = new Socket_Item(undef, undef, "$ip:$port", 'AD2USB', 'tcp', 'raw'); - $AD2USB_ser2sock_sender = new Socket_Item(undef, undef, "$ip:$port", 'AD2USB_SENDER', 'tcp', 'rawout'); - start $AD2USB_ser2sock; - start $AD2USB_ser2sock_sender; - &::MainLoop_pre_add_hook( \&AD2USB::check_for_data, 1 ); - $::Year_Month_Now = &::time_date_stamp( 10, time ); # Not yet set when we init. - LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", " ========= AD2USB.pm Socket Initialized =========" ); - $connecttype = 'tcp'; - } else { - warn "AD2USB.pm->startup AD2USB_serial_port or AD2USB_ser2sock_ip not defined in mh.ini file"; } -} - -#}}} -# module startup; hack because of the startup error {{{ -sub startup { - ##This is called as a result of using a .*_module parameter in the ini file - ##if only purpose of _module paramter is to call this, why do we use the - ##parameter? - ##Perhaps move socket startup here? Then we would still need the _module - ##parameter } +#}}} +# startup /enable socket port {{{ +sub server_startup { + my ($instance) = @_; + $Socket_Items{"$instance"}{recon_timer} = new Timer; + $ip = $::config_parms{"$instance".'_server_ip'}; + $port = $::config_parms{"$instance" . '_server_port'}; + ::print_log(" AD2USB.pm initializing $instance TCP session with $ip on port $port") if $main::config_parms{debug} eq 'AD2USB'; + $Socket_Items{"$instance"}{'socket'} = new Socket_Item($instance, undef, "$ip:$port", 'AD2USB', 'tcp', 'raw'); + $Socket_Items{"$instance" . '_sender'}{'socket'} = new Socket_Item($instance . '_sender', undef, "$ip:$port", 'AD2USB_SENDER', 'tcp', 'rawout'); + $Socket_Items{"$instance"}{'socket'}->start; + $Socket_Items{"$instance" . '_sender'}{'socket'}->start; + &::MainLoop_pre_add_hook( sub {AD2USB::check_for_data($instance, 'tcp');}, 1 ); + $::Year_Month_Now = &::time_date_stamp( 10, time ); # Not yet set when we init. + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", " ========= AD2USB.pm Socket Initialized =========" ); +} #}}} + # check for incoming data on serial port {{{ # This is called once per loop by a Mainloop_pre hook sub check_for_data { - my ($self) = @_; + my ($instance, $connecttype) = @_; + my $self = get_object_by_instance($instance); my $NewCmd; if ($connecttype eq 'serial') { - &main::check_for_generic_serial_data('AD2USB'); - $NewCmd = $main::Serial_Ports{'AD2USB'}{data}; - $main::Serial_Ports{'AD2USB'}{data} = ''; + &main::check_for_generic_serial_data($instance); + $NewCmd = $main::Serial_Ports{$instance}{data}; + $main::Serial_Ports{$instance}{data} = ''; } if ($connecttype eq 'tcp') { - if (active $AD2USB_ser2sock) { - $NewCmd = said $AD2USB_ser2sock; + if ($Socket_Items{$instance}{'socket'}->active) { + $NewCmd = $Socket_Items{$instance}{'socket'}->said; } else { # restart the TCP connection if its lost. - if (inactive $recon_timer) { - &main::print_log("Connection to AD2USB was lost, I will try to reconnect in $$self{reconnect_time} seconds"); - # LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "AD2USB.pm ser2sock connection lost! Trying to reconnect." ); - set $recon_timer $$self{reconnect_time}, sub { - start $AD2USB_ser2sock; - start $AD2USB_ser2sock_sender; - } + if ($Socket_Items{$instance}{recon_timer}->inactive) { + &main::print_log("Connection to $instance instance of AD2USB was lost, I will try to reconnect in $$self{reconnect_time} seconds"); + # ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "AD2USB.pm ser2sock connection lost! Trying to reconnect." ); + $Socket_Items{$instance}{recon_timer}->set($$self{reconnect_time}, sub { + $Socket_Items{$instance}{'socket'}->start; + }); } } } - $self=$Self; #WTH is this? # we need to buffer the information receive, because many command could be include in a single pass - $NewCmd = $IncompleteCmd . $NewCmd if $IncompleteCmd; + $NewCmd = $self{IncompleteCmd} . $NewCmd if $self{IncompleteCmd}; + $self{IncompleteCmd} = ''; return if !$NewCmd; - $NewCmd =~ s/\r\n/#/g; # Replace newlines with # (use # as command delimiter) - #LocalLogit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "TCP DATA - - $NewCmd" ); - my $Cmd = ''; # Build up a command string by iterating each character - foreach my $c ( split( //, $NewCmd ) ) { - if ( $c eq '#' ) { - if ($Cmd) { - # This is a full command that was terminated by \r\n - ::print_log("[AD2USB] " . $Cmd) if $main::Debug{AD2USB} >= 1; - my $status_type = GetStatusType($Cmd); - if ($status_type >= 10) { - # This is a panel message - if (($Cmd ne $self->{last_cmd}) || ($status_type == 11)) { - # This is a new message - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "NEW: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); - CheckCmd($Cmd); - ResetAdemcoState(); - $self->{last_cmd} = $Cmd; - } - else { - # This is a duplicate message - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "DUPE: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); - } - } - else { - # This is a relay or RF or zone expander message - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "NONPANEL: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); + + #We have a command to examine, split by line endings and parse data + foreach my $Cmd (split("\n", $NewCmd)){ + #Split leaves part of line ending so full message can be confirmed + if (substr($Cmd, -1) eq "\r"){ + #strip off last line ending + $Cmd = substr($Cmd, 0, -1); + ::print_log("[AD2USB] " . $Cmd) if $main::Debug{AD2USB} >= 1; + my $status_type = GetStatusType($Cmd); + if ($status_type >= 10) { + # This is a panel message + if (($Cmd ne $self->{last_cmd}) || ($status_type == 11)) { + # This is a new message + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "NEW: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); CheckCmd($Cmd); ResetAdemcoState(); - #$self->{last_cmd} = $Cmd; + $self->{last_cmd} = $Cmd; + } + else { + # This is a duplicate message + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "DUPE: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); } - $Cmd = ''; } + else { + # This is a relay or RF or zone expander message + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "NONPANEL: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); + CheckCmd($Cmd); + ResetAdemcoState(); + #$self->{last_cmd} = $Cmd; + } + $Cmd = ''; } else { - # Append this character to the current command - $Cmd .= $c; + # Save partial command for next serial read + $self{IncompleteCmd} = $Cmd; } - } - # Save partial command for next serial read - $IncompleteCmd = $Cmd; } #}}} From d3ca92cb0a864bba1945f2affc56f87963cd36a2 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 9 Jan 2014 21:32:16 -0800 Subject: [PATCH 020/180] AD2: Add Some POD Documentation --- lib/AD2USB.pm | 78 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 78 insertions(+) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index bf37495d2..48816f41c 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -1,3 +1,61 @@ +=head1 B + +=head2 SYNOPSIS + +---Example Code and Usage--- + +=head2 DESCRIPTION + +Module that monitors a serial device for the AD2USB for known events and +maintains the state of the Ademco system in memory. Module also sends +instructions to the panel as requested. + +=head2 CONNFIGURATION + +This is only a start of the documentation of the configuration for this module. +At the moment, I am just documenting the main changes that I have made + +=head3 Serial Connections (USB or Serial) + +Add the following commands to your INI file: + +AD2USB_serial_port=/dev/ttyAMA0 + +=head3 IP Connections (Ser2Sock) + +AD2USB_server_ip=192.168.11.17 +AD2USB_server_port=10000 + +=head3 Code Inserts for All Devices + +$AD2USB = new AD2USB; + +=head3 For Additional Devices (Multiple Seperate Panels) + +Each additional device can be defined as follows: + +AD2USB_1_serial_port=/dev/ttyAMA0 + +OR + +AD2USB_1_server_ip=192.168.11.17 +AD2USB_1_server_port=10000 + +PLUS + +$AD2USB_1 = new AD2USB('AD2USB_1'); + +Each addition panel should be iterated by 1. +=head2 INHERITS + +L + +=head2 METHODS + +=over + +=cut + # ########################################################################### # Name: AD2USB Monitoring Module # @@ -1300,6 +1358,26 @@ sub set_inactivity_alarm($$$) { &::print_log("AD2USB_Motion_Item:: set_inactivity_alarm not supported"); } +=back + +=head2 INI PARAMETERS + +=head2 NOTES + +=head2 AUTHOR + +=head2 SEE ALSO + +=head2 LICENSE + +This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. + +This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + +=cut + 1; #}}} From 31ed86ff9046ddf75e7a79fc9e3a738f4f0d5fda Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Fri, 10 Jan 2014 17:55:00 -0800 Subject: [PATCH 021/180] AD2: Further Condense Check_For_Data; Add Additional Comments --- lib/AD2USB.pm | 42 ++++++++++++++++++++---------------------- 1 file changed, 20 insertions(+), 22 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 48816f41c..bff76e7dc 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -220,12 +220,14 @@ sub server_startup { #}}} # check for incoming data on serial port {{{ -# This is called once per loop by a Mainloop_pre hook +# This is called once per loop by a Mainloop_pre hook, it parses out the string +# of data into individual messages. sub check_for_data { my ($instance, $connecttype) = @_; my $self = get_object_by_instance($instance); my $NewCmd; + # Get the date from serial or tcp source if ($connecttype eq 'serial') { &main::check_for_generic_serial_data($instance); $NewCmd = $main::Serial_Ports{$instance}{data}; @@ -247,41 +249,37 @@ sub check_for_data { } } - # we need to buffer the information receive, because many command could be include in a single pass + # Return if nothing received + return if !$NewCmd; + + # Prepend any prior message fragment $NewCmd = $self{IncompleteCmd} . $NewCmd if $self{IncompleteCmd}; $self{IncompleteCmd} = ''; - return if !$NewCmd; - #We have a command to examine, split by line endings and parse data + # Split Data into Individual Messages and Then Send the Message to be Parsed foreach my $Cmd (split("\n", $NewCmd)){ - #Split leaves part of line ending so full message can be confirmed + # Split leaves part of line ending so full message can be confirmed if (substr($Cmd, -1) eq "\r"){ - #strip off last line ending + # Valid Message, Strip off last line ending $Cmd = substr($Cmd, 0, -1); ::print_log("[AD2USB] " . $Cmd) if $main::Debug{AD2USB} >= 1; + + # Get the Message Type, and Ignore Duplicate Status Messages my $status_type = GetStatusType($Cmd); - if ($status_type >= 10) { - # This is a panel message - if (($Cmd ne $self->{last_cmd}) || ($status_type == 11)) { - # This is a new message - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "NEW: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); - CheckCmd($Cmd); - ResetAdemcoState(); - $self->{last_cmd} = $Cmd; - } - else { - # This is a duplicate message - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "DUPE: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); - } + if ($status_type >= 10 && $Cmd eq $self->{last_cmd} && + $status_type != 11) { + # This is a duplicate panel message with no important status + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "DUPE: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); } else { - # This is a relay or RF or zone expander message + # This is a non-dupe panel message or a fault panel message or a + # relay or RF or zone expander message or something important + # Log the message, parse it, and store it to detect future dupes ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "NONPANEL: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); CheckCmd($Cmd); ResetAdemcoState(); - #$self->{last_cmd} = $Cmd; + $self->{last_cmd} = $Cmd if ($status_type >= 10); } - $Cmd = ''; } else { # Save partial command for next serial read From c9e116abf696d58fd4e85f4d70b6b8a07246a9ca Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Fri, 10 Jan 2014 18:10:00 -0800 Subject: [PATCH 022/180] AD2: Change GetStatusType to Return a Hash, Clean up Some Tabbing in CheckCmd, Removed Switch Package Returning a hash makes the code infinitely more readable, no longer need to remember the numbers for various message types. Removed Switch to make compatible with Perl 5.8.8 --- lib/AD2USB.pm | 908 +++++++++++++++++++++++++------------------------- 1 file changed, 445 insertions(+), 463 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index bff76e7dc..f11952297 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -96,8 +96,6 @@ L # THE SOFTWARE. ############################################################################### -use Switch; - package AD2USB; @AD2USB::ISA = ('Generic_Item'); @@ -266,8 +264,8 @@ sub check_for_data { # Get the Message Type, and Ignore Duplicate Status Messages my $status_type = GetStatusType($Cmd); - if ($status_type >= 10 && $Cmd eq $self->{last_cmd} && - $status_type != 11) { + if ($status_type->{keypad} && $Cmd eq $self->{last_cmd} && + (!$status_type->{fault})) { # This is a duplicate panel message with no important status ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "DUPE: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); } @@ -278,7 +276,7 @@ sub check_for_data { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "NONPANEL: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); CheckCmd($Cmd); ResetAdemcoState(); - $self->{last_cmd} = $Cmd if ($status_type >= 10); + $self->{last_cmd} = $Cmd if ($status_type->{keypad}); } } else { @@ -296,243 +294,235 @@ sub CheckCmd { my $status_type = GetStatusType($CmdStr); my $self = $Self; - switch ( $status_type ) { - - case -1 { # UNRECOGNIZED STATUS - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "UNKNOWN STATUS: $CmdStr" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - } - - case 0 { # Key send confirmation - if ($self->{keys_sent} == 0) { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key sent from ANOTHER panel." ) unless ($main::config_parms{AD2USB_debug_log} == 0); - } - else { - $self->{keys_sent}--; - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key received ($self->{keys_sent} left)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - } - + if ($status_type->{unknown}) { + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "UNKNOWN STATUS: $CmdStr" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + } + elsif ($status_type->{cmd_sent}) { + if ($self->{keys_sent} == 0) { + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key sent from ANOTHER panel." ) unless ($main::config_parms{AD2USB_debug_log} == 0); } - - case 10 { # FAULTS AVAILABLE -# ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Faults exist and are available to parse" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - cmd( $self, "ShowFaults" ); + else { + $self->{keys_sent}--; + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key received ($self->{keys_sent} left)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } + } + elsif ($status_type->{fault_avail}) { + #Send command to show faults + cmd( $self, "ShowFaults" ); + } + elsif ($status_type->{fault}) { + my $status_codes = substr( $CmdStr, 1, 12 ); + my $fault = substr( $CmdStr, 23, 3 ); + $fault = substr($CmdStr, 67, 2); #TODO Why do we set $fault twice? ^ + $fault = "0$fault"; + my $panel_message = substr( $CmdStr, 61, 32); + + my $ZoneName = my $ZoneNum = $fault; + my $PartNum = "1"; + $ZoneName = $main::config_parms{"AD2USB_zone_${ZoneNum}"} if exists $main::config_parms{"AD2USB_zone_${ZoneNum}"}; + $ZoneNum =~ s/^0*//; + $fault = $ZoneNum; + + if (&MappedZones("00$ZoneNum")) { + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Zone $ZoneNum is mapped to a Relay or RF ID, skipping normal monitoring!") } + else { + #Check if this is the new lowest fault number and reset the zones before it + if (int($fault) <= int($self->{zone_lowest_fault})) { + $self->{zone_lowest_fault} = $fault; + #Reset zones to ready before the lowest + $start = 1; + $end = $self->{zone_lowest_fault} - 1; + ChangeZones( $start, $end, "ready", "bypass", 1); + } - case 11 { # IN FAULT LOOP - my $status_codes = substr( $CmdStr, 1, 12 ); - my $fault = substr( $CmdStr, 23, 3 ); - $fault = substr($CmdStr, 67, 2); #TODO Why do we set $fault twice? ^ - $fault = "0$fault"; - my $panel_message = substr( $CmdStr, 61, 32); + #Check if this is a new highest fault number and reset zones after it + if (int($fault) > int($self->{zone_highest_fault})) { + $self->{zone_highest_fault} = $fault; + #Reset zones to ready after the highest + $start = $self->{zone_highest_fault} + 1;; + $end = 11; + ChangeZones( $start, $end, "ready", "bypass", 1); + } - my $ZoneName = my $ZoneNum = $fault; - my $PartNum = "1"; - $ZoneName = $main::config_parms{"AD2USB_zone_${ZoneNum}"} if exists $main::config_parms{"AD2USB_zone_${ZoneNum}"}; - $ZoneNum =~ s/^0*//; - $fault = $ZoneNum; + # Check if this zone was already faulted + if ($self->{zone_status}{"$fault"} eq "fault") { - if (&MappedZones("00$ZoneNum")) { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Zone $ZoneNum is mapped to a Relay or RF ID, skipping normal monitoring!") } - else { - #Check if this is the new lowest fault number and reset the zones before it - if (int($fault) <= int($self->{zone_lowest_fault})) { + #Check if this fault is less than the last fault (and must now be the new lowest zone) + if (int($fault) <= int($self->{zone_last_num})) { + #This is the new lowest zone $self->{zone_lowest_fault} = $fault; #Reset zones to ready before the lowest $start = 1; $end = $self->{zone_lowest_fault} - 1; ChangeZones( $start, $end, "ready", "bypass", 1); - } + } - #Check if this is a new highest fault number and reset zones after it - if (int($fault) > int($self->{zone_highest_fault})) { - $self->{zone_highest_fault} = $fault; - #Reset zones to ready after the highest - $start = $self->{zone_highest_fault} + 1;; + #Check if this fault is equal to the last fault (and must now be the only zone) + if (int($fault) == int($self->{zone_last_num})) { + #Reset zones to ready after the only one + $start = int($fault) + 1; $end = 11; ChangeZones( $start, $end, "ready", "bypass", 1); } - - # Check if this zone was already faulted - if ($self->{zone_status}{"$fault"} eq "fault") { - - #Check if this fault is less than the last fault (and must now be the new lowest zone) - if (int($fault) <= int($self->{zone_last_num})) { - #This is the new lowest zone - $self->{zone_lowest_fault} = $fault; - #Reset zones to ready before the lowest - $start = 1; - $end = $self->{zone_lowest_fault} - 1; - ChangeZones( $start, $end, "ready", "bypass", 1); - } - - #Check if this fault is equal to the last fault (and must now be the only zone) - if (int($fault) == int($self->{zone_last_num})) { - #Reset zones to ready after the only one - $start = int($fault) + 1; - $end = 11; - ChangeZones( $start, $end, "ready", "bypass", 1); - } - - #Check if this fault is greater than the last fault and reset the zones between it and the prior one - if (int($fault) > int($self->{zone_last_num})) { - $start = (($self->{zone_last_num} == $fault) ? 1 : int($self->{zone_last_num}) + 1); - $end = $fault - 1; - ChangeZones( $start, $end, "ready", "bypass", 1); - } - } #End Already Faulted - - $self->{zone_now_msg} = "$panel_message"; - $self->{zone_now_status} = "fault"; - $self->{zone_now_name} = "$ZoneName"; - $self->{zone_now_num} = "$ZoneNum"; - ChangeZones( int($ZoneNum), int($ZoneNum), "fault", "", 1); - } #Not MappedZones - $self->{partition_now_msg} = "$panel_message"; - $self->{partition_now_status} = "not ready"; - $self->{partition_now_num} = "$PartNum"; - ChangePartitions( int($PartNum), int($PartNum), "not ready", 1); - } - case 12 { # IN BYPASS FLASH LOOP - my $status_codes = substr( $CmdStr, 1, 12 ); - my $fault = substr( $CmdStr, 23, 3 ); - $fault = substr($CmdStr, 67, 2); - $fault = "0$fault"; - my $panel_message = substr( $CmdStr, 61, 32); + #Check if this fault is greater than the last fault and reset the zones between it and the prior one + if (int($fault) > int($self->{zone_last_num})) { + $start = (($self->{zone_last_num} == $fault) ? 1 : int($self->{zone_last_num}) + 1); + $end = $fault - 1; + ChangeZones( $start, $end, "ready", "bypass", 1); + } + } #End Already Faulted - my $ZoneName = my $ZoneNum = $fault; - my $PartNum = "1"; - $ZoneName = $main::config_parms{"AD2USB_zone_${ZoneNum}"} if exists $main::config_parms{"AD2USB_zone_${ZoneNum}"}; - $ZoneNum =~ s/^0*//; - $fault = $ZoneNum; - $self->{zone_now_msg} = "$panel_message"; - $self->{zone_now_status} = "bypass"; + $self->{zone_now_status} = "fault"; $self->{zone_now_name} = "$ZoneName"; $self->{zone_now_num} = "$ZoneNum"; - ChangeZones( int($ZoneNum), int($ZoneNum), "bypass", "", 1); - $self->{partition_now_msg} = "$panel_message"; - $self->{partition_now_status} = "not ready"; - $self->{partition_now_num} = "$PartNum"; - ChangePartitions( int($PartNum), int($PartNum), "not ready", 1); - - } - - case 13 { # NORMAL STATUS - - # Get three sections of the Ademco status message - my $status_codes = substr( $CmdStr, 1, 12 ); - my $fault = substr( $CmdStr, 23, 3 ); - my $panel_message = substr( $CmdStr, 61, 32); - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key received ($self->{keys_sent} left)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - - # READY - $data = 0; - if ( substr($status_codes,$data,1) == "1" ) { - my $start = 1; - my $end = 11; - if ( substr($status_codes,6,1) ne "1" ) { - # Reset all zones to ready if partition is ready and not bypassed - ChangeZones( $start, $end, "ready", "", 1); - } - else { - # If zones are bypassed, reset unbypassed zones to ready - for ($i = $start; $i <= $end; $i++) { - my $current_status = $self->{zone_status}{"$i"}; - if ($current_status eq "fault") { - ChangeZones($i, $i, "ready", "bypass", 1); - } + ChangeZones( int($ZoneNum), int($ZoneNum), "fault", "", 1); + } #Not MappedZones + $self->{partition_now_msg} = "$panel_message"; + $self->{partition_now_status} = "not ready"; + $self->{partition_now_num} = "$PartNum"; + ChangePartitions( int($PartNum), int($PartNum), "not ready", 1); + } + elsif ($status_type->{bypass}) { + my $status_codes = substr( $CmdStr, 1, 12 ); + my $fault = substr( $CmdStr, 23, 3 ); + $fault = substr($CmdStr, 67, 2); + $fault = "0$fault"; + my $panel_message = substr( $CmdStr, 61, 32); + + my $ZoneName = my $ZoneNum = $fault; + my $PartNum = "1"; + $ZoneName = $main::config_parms{"AD2USB_zone_${ZoneNum}"} if exists $main::config_parms{"AD2USB_zone_${ZoneNum}"}; + $ZoneNum =~ s/^0*//; + $fault = $ZoneNum; + + $self->{zone_now_msg} = "$panel_message"; + $self->{zone_now_status} = "bypass"; + $self->{zone_now_name} = "$ZoneName"; + $self->{zone_now_num} = "$ZoneNum"; + ChangeZones( int($ZoneNum), int($ZoneNum), "bypass", "", 1); + $self->{partition_now_msg} = "$panel_message"; + $self->{partition_now_status} = "not ready"; + $self->{partition_now_num} = "$PartNum"; + ChangePartitions( int($PartNum), int($PartNum), "not ready", 1); + + } + elsif ($status_type->{status}) { + + # Get three sections of the Ademco status message + my $status_codes = substr( $CmdStr, 1, 12 ); + my $fault = substr( $CmdStr, 23, 3 ); + my $panel_message = substr( $CmdStr, 61, 32); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key received ($self->{keys_sent} left)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + + # READY + $data = 0; + if ( substr($status_codes,$data,1) == "1" ) { + my $start = 1; + my $end = 11; + if ( substr($status_codes,6,1) ne "1" ) { + # Reset all zones to ready if partition is ready and not bypassed + ChangeZones( $start, $end, "ready", "", 1); + } + else { + # If zones are bypassed, reset unbypassed zones to ready + for ($i = $start; $i <= $end; $i++) { + my $current_status = $self->{zone_status}{"$i"}; + if ($current_status eq "fault") { + ChangeZones($i, $i, "ready", "bypass", 1); } } + } - my $PartName = my $PartNum = "1"; + my $PartName = my $PartNum = "1"; - $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} if exists $main::config_parms{"AD2USB_part_${PartNum}"}; - $self->{partition_now_msg} = "$panel_message"; - $self->{partition_now_num} = "$PartNum"; - $self->{partition_now_status} = "ready"; - ChangePartitions( int($PartNum), int($PartNum), "ready", 1); - $self->{zone_lowest_fault} = 999; - $self->{zone_highest_fault} = -1; + $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} if exists $main::config_parms{"AD2USB_part_${PartNum}"}; + $self->{partition_now_msg} = "$panel_message"; + $self->{partition_now_num} = "$PartNum"; + $self->{partition_now_status} = "ready"; + ChangePartitions( int($PartNum), int($PartNum), "ready", 1); + $self->{zone_lowest_fault} = 999; + $self->{zone_highest_fault} = -1; - # Reset state for fault checks - $self->{zone_last_status} = ""; - $self->{zone_last_num} = ""; - $self->{zone_last_name} = ""; - } + # Reset state for fault checks + $self->{zone_last_status} = ""; + $self->{zone_last_num} = ""; + $self->{zone_last_name} = ""; + } - # ARMED AWAY - $data = 1; - if ( substr($status_codes,$data,1) == "1" ) { - my $PartNum = my $PartName = "1"; - $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} if exists $main::config_parms{"AD2USB_part_${PartNum}"}; + # ARMED AWAY + $data = 1; + if ( substr($status_codes,$data,1) == "1" ) { + my $PartNum = my $PartName = "1"; + $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} if exists $main::config_parms{"AD2USB_part_${PartNum}"}; - my $mode = "ERROR"; - if (index($panel_message, "ALL SECURE")) { - $mode = "armed away"; - } - elsif (index($panel_message, "You may exit now")) { - $mode = "exit delay"; - } - elsif (index($panel_message, "or alarm occurs")) { - $mode = "entry delay"; - } - elsif (index($panel_message, "ZONE BYPASSED")) { - $mode = "armed away"; - } + my $mode = "ERROR"; + if (index($panel_message, "ALL SECURE")) { + $mode = "armed away"; + } + elsif (index($panel_message, "You may exit now")) { + $mode = "exit delay"; + } + elsif (index($panel_message, "or alarm occurs")) { + $mode = "entry delay"; + } + elsif (index($panel_message, "ZONE BYPASSED")) { + $mode = "armed away"; + } - set $self "$mode"; - $self->{partition_now_msg} = "$panel_message"; - $self->{partition_now_status} = "$mode"; - $self->{partition_now_num} = "$PartNum"; - ChangePartitions( int($PartNum), int($PartNum), "$mode", 1); + set $self "$mode"; + $self->{partition_now_msg} = "$panel_message"; + $self->{partition_now_status} = "$mode"; + $self->{partition_now_num} = "$PartNum"; + ChangePartitions( int($PartNum), int($PartNum), "$mode", 1); - # Reset state for fault checks - $self->{zone_last_status} = ""; - $self->{zone_last_num} = ""; - $self->{zone_last_name} = ""; - } + # Reset state for fault checks + $self->{zone_last_status} = ""; + $self->{zone_last_num} = ""; + $self->{zone_last_name} = ""; + } - # ARMED HOME - $data = 2; - if ( substr($status_codes,$data,1) eq "1" ) { - my $PartNum = my $PartName = "1"; - - my $mode = "armed stay"; - $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} if exists $main::config_parms{"AD2USB_part_${PartNum}"}; - $self->{partition_now_msg} = "$panel_message"; - $self->{partition_now_status} = "$mode"; - $self->{partition_now_num} = "$PartNum"; - ChangePartitions( int($PartNum), int($PartNum), "$mode", 1); - - # Reset state for fault checks - $self->{zone_last_status} = ""; - $self->{zone_last_num} = ""; - $self->{zone_last_name} = ""; - } + # ARMED HOME + $data = 2; + if ( substr($status_codes,$data,1) eq "1" ) { + my $PartNum = my $PartName = "1"; + + my $mode = "armed stay"; + $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} if exists $main::config_parms{"AD2USB_part_${PartNum}"}; + $self->{partition_now_msg} = "$panel_message"; + $self->{partition_now_status} = "$mode"; + $self->{partition_now_num} = "$PartNum"; + ChangePartitions( int($PartNum), int($PartNum), "$mode", 1); + + # Reset state for fault checks + $self->{zone_last_status} = ""; + $self->{zone_last_num} = ""; + $self->{zone_last_name} = ""; + } - # SKIP BACKLIGHT - $data = 3; + # SKIP BACKLIGHT + $data = 3; - # PROGRAMMING MODE - $data = 4; - if ( substr($status_codes,$data,1) eq "1" ) { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel is in programming mode" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + # PROGRAMMING MODE + $data = 4; + if ( substr($status_codes,$data,1) eq "1" ) { + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel is in programming mode" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - # Reset state for fault checks - $self->{zone_last_status} = ""; - $self->{zone_last_num} = ""; - $self->{zone_last_name} = ""; - } + # Reset state for fault checks + $self->{zone_last_status} = ""; + $self->{zone_last_num} = ""; + $self->{zone_last_name} = ""; + } - # SKIP BEEPS - $data = 5; + # SKIP BEEPS + $data = 5; - # A ZONE OR ZONES ARE BYPASSED - $data = 6; - if ( substr($status_codes,$data,1) == "1" ) { + # A ZONE OR ZONES ARE BYPASSED + $data = 6; + if ( substr($status_codes,$data,1) == "1" ) { - # Reset zones to ready that haven't appeared in the bypass loop + # Reset zones to ready that haven't appeared in the bypass loop # if ($self->{zone_last_status} eq "bypass") { # if (int($fault) < int($self->{zone_now_num})) { # $start = int($self->{zone_now_num}) + 1; @@ -543,173 +533,169 @@ sub CheckCmd { # $self->{zone_now_num} = "0"; # } - # Reset state for fault checks - $self->{zone_last_status} = ""; - $self->{zone_last_num} = ""; - $self->{zone_last_name} = ""; - } + # Reset state for fault checks + $self->{zone_last_status} = ""; + $self->{zone_last_num} = ""; + $self->{zone_last_name} = ""; + } - # SKIP AC POWER - $data = 7; + # SKIP AC POWER + $data = 7; - # SKIP CHIME MODE - $data = 8; + # SKIP CHIME MODE + $data = 8; - # ALARM WAS TRIGGERED (Sticky until disarm) - $data = 9; - if ( substr($status_codes,$data,1) == "1" ) { - $EventName = "ALARM WAS TRIGGERED"; - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName" ) unless ($main::config_parms{AD2USB_part_log} == 0); - } - - # ALARM IS SOUNDING - $data = 10; - if ( substr($status_codes,$data,1) == "1" ) { - $EventName = "ALARM IS SOUNDING"; - - #TODO: figure out how to get a partition number - my $PartName = my $PartNum = "1"; - my $ZoneNum = $fault; - $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; - $PartName = $main::config_parms{"AD2USB_part_$PartName"} if exists $main::config_parms{"AD2USB_part_$PartName"}; - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName - Zone $ZoneNum ($ZoneName)" ) unless ($main::config_parms{AD2USB_part_log} == 0); - $ZoneNum =~ s/^0*//; - ChangeZones( int($ZoneNum), int($ZoneNum), "alarm", "", 1); - $self->{zone_now_msg} = "$panel_message"; - $self->{zone_now_status} = "alarm"; - $self->{zone_now_num} = "$ZoneNum"; - $self->{partition_now_msg} = "$panel_message"; - $self->{partition_now_status} = "alarm"; - $self->{partition_now_num} = "$PartNum"; - ChangePartitions( int($PartNum), int($PartNum), "alarm", 1); - } + # ALARM WAS TRIGGERED (Sticky until disarm) + $data = 9; + if ( substr($status_codes,$data,1) == "1" ) { + $EventName = "ALARM WAS TRIGGERED"; + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName" ) unless ($main::config_parms{AD2USB_part_log} == 0); + } - # SKIP BATTERY LOW - $data = 11; + # ALARM IS SOUNDING + $data = 10; + if ( substr($status_codes,$data,1) == "1" ) { + $EventName = "ALARM IS SOUNDING"; + + #TODO: figure out how to get a partition number + my $PartName = my $PartNum = "1"; + my $ZoneNum = $fault; + $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; + $PartName = $main::config_parms{"AD2USB_part_$PartName"} if exists $main::config_parms{"AD2USB_part_$PartName"}; + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName - Zone $ZoneNum ($ZoneName)" ) unless ($main::config_parms{AD2USB_part_log} == 0); + $ZoneNum =~ s/^0*//; + ChangeZones( int($ZoneNum), int($ZoneNum), "alarm", "", 1); + $self->{zone_now_msg} = "$panel_message"; + $self->{zone_now_status} = "alarm"; + $self->{zone_now_num} = "$ZoneNum"; + $self->{partition_now_msg} = "$panel_message"; + $self->{partition_now_status} = "alarm"; + $self->{partition_now_num} = "$PartNum"; + ChangePartitions( int($PartNum), int($PartNum), "alarm", 1); } - case 2 { # WIRELESS STATUS - my $ZoneLoop = ""; - my $MZoneLoop = ""; - # Parse raw status strings - my $rf_id = substr( $CmdStr, 5, 7 ); - my $rf_status = substr( $CmdStr, 13, 2 ); - my $lc = 0; - my $wnum = 0; - - # UNKNOWN - my $unknown_1 = 0; - $unknown_1 = 1 if (hex(substr($rf_status, 1, 1)) & 1) == 1; - # Parse for low battery signal - my $low_batt = 0; - $low_batt = 1 if (hex(substr($rf_status, 1, 1)) & 2) == 2; - # Parse for supervision flag - my $supervised = 0; - $supervised = 1 if (hex(substr($rf_status, 1, 1)) & 4) == 4; - # UNKNOWN - my $unknown_8 = 0; - $unknown_8 = 1 if (hex(substr($rf_status, 1, 1)) & 8) == 8; - - # Parse loop faults - my $loop_fault_1 = 0; - $loop_fault_1 = 1 if (hex(substr($rf_status, 0, 1)) & 8) == 8; - my $loop_fault_2 = 0; - $loop_fault_2 = 1 if (hex(substr($rf_status, 0, 1)) & 2) == 2; - my $loop_fault_3 = 0; - $loop_fault_3 = 1 if (hex(substr($rf_status, 0, 1)) & 1) == 1; - my $loop_fault_4 = 0; - $loop_fault_4 = 1 if (hex(substr($rf_status, 0, 1)) & 4) == 4; - - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "WIRELESS: rf_id($rf_id) status($rf_status) loop1($loop_fault_1) loop2($loop_fault_2) loop3($loop_fault_3) loop4($loop_fault_4)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "WIRELESS: rf_id($rf_id) status($rf_status) low_batt($low_batt) supervised($supervised)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - - my $ZoneStatus = "ready"; - my $PartStatus = ""; - my @parsest; - my $sensortype; - - if (exists $main::config_parms{"AD2USB_wireless_$rf_id"}) { - # Assign zone - my @ParseNum = split(",", $main::config_parms{"AD2USB_wireless_$rf_id"}); - - # Assign status (zone and partition) - if ($low_batt == "1") { - $ZoneStatus = "low battery"; + # SKIP BATTERY LOW + $data = 11; + } + elsif ($status_type->{wireless}) { + my $ZoneLoop = ""; + my $MZoneLoop = ""; + # Parse raw status strings + my $rf_id = substr( $CmdStr, 5, 7 ); + my $rf_status = substr( $CmdStr, 13, 2 ); + my $lc = 0; + my $wnum = 0; + + # UNKNOWN + my $unknown_1 = 0; + $unknown_1 = 1 if (hex(substr($rf_status, 1, 1)) & 1) == 1; + # Parse for low battery signal + my $low_batt = 0; + $low_batt = 1 if (hex(substr($rf_status, 1, 1)) & 2) == 2; + # Parse for supervision flag + my $supervised = 0; + $supervised = 1 if (hex(substr($rf_status, 1, 1)) & 4) == 4; + # UNKNOWN + my $unknown_8 = 0; + $unknown_8 = 1 if (hex(substr($rf_status, 1, 1)) & 8) == 8; + + # Parse loop faults + my $loop_fault_1 = 0; + $loop_fault_1 = 1 if (hex(substr($rf_status, 0, 1)) & 8) == 8; + my $loop_fault_2 = 0; + $loop_fault_2 = 1 if (hex(substr($rf_status, 0, 1)) & 2) == 2; + my $loop_fault_3 = 0; + $loop_fault_3 = 1 if (hex(substr($rf_status, 0, 1)) & 1) == 1; + my $loop_fault_4 = 0; + $loop_fault_4 = 1 if (hex(substr($rf_status, 0, 1)) & 4) == 4; + + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "WIRELESS: rf_id($rf_id) status($rf_status) loop1($loop_fault_1) loop2($loop_fault_2) loop3($loop_fault_3) loop4($loop_fault_4)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "WIRELESS: rf_id($rf_id) status($rf_status) low_batt($low_batt) supervised($supervised)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + + my $ZoneStatus = "ready"; + my $PartStatus = ""; + my @parsest; + my $sensortype; + + if (exists $main::config_parms{"AD2USB_wireless_$rf_id"}) { + # Assign zone + my @ParseNum = split(",", $main::config_parms{"AD2USB_wireless_$rf_id"}); + + # Assign status (zone and partition) + if ($low_batt == "1") { + $ZoneStatus = "low battery"; + } + + foreach $wnum(@ParseNum) { + if ($lc eq 0 or $lc eq 2 or $lc eq 4 or $lc eq 6) { + $ZoneNum = $wnum; } - - foreach $wnum(@ParseNum) { - if ($lc eq 0 or $lc eq 2 or $lc eq 4 or $lc eq 6) { - $ZoneNum = $wnum; - } - - if ($lc eq 1 or $lc eq 3 or $lc eq 5 or $lc eq 7) { - @parsest = split("", $wnum); - $sensortype = $parsest[0]; - $ZoneLoop = $parsest[1]; - $ZoneName = "Unknown"; - $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; - - if ($ZoneLoop eq "1") {$MZoneLoop = $loop_fault_1} - if ($ZoneLoop eq "2") {$MZoneLoop = $loop_fault_2} - if ($ZoneLoop eq "3") {$MZoneLoop = $loop_fault_3} - if ($ZoneLoop eq "4") {$MZoneLoop = $loop_fault_4} - - if ("$MZoneLoop" eq "1") { - $ZoneStatus = "fault"; - } elsif ("$MZoneLoop" eq 0) { + + if ($lc eq 1 or $lc eq 3 or $lc eq 5 or $lc eq 7) { + @parsest = split("", $wnum); + $sensortype = $parsest[0]; + $ZoneLoop = $parsest[1]; + $ZoneName = "Unknown"; + $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; + + if ($ZoneLoop eq "1") {$MZoneLoop = $loop_fault_1} + if ($ZoneLoop eq "2") {$MZoneLoop = $loop_fault_2} + if ($ZoneLoop eq "3") {$MZoneLoop = $loop_fault_3} + if ($ZoneLoop eq "4") {$MZoneLoop = $loop_fault_4} + + if ("$MZoneLoop" eq "1") { + $ZoneStatus = "fault"; + } elsif ("$MZoneLoop" eq 0) { $ZoneStatus = "ready"; - } - - $self->{zone_now_msg} = "$CmdStr"; - $self->{zone_now_status} = "$ZoneStatus"; - $self->{zone_now_name} = "$ZoneName"; - $self->{zone_now_num} = "$ZoneNum"; - ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); - if ($sensortype eq "k") { - $ZoneStatus = "ready"; + } + + $self->{zone_now_msg} = "$CmdStr"; + $self->{zone_now_status} = "$ZoneStatus"; + $self->{zone_now_name} = "$ZoneName"; + $self->{zone_now_num} = "$ZoneNum"; + ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); + if ($sensortype eq "k") { + $ZoneStatus = "ready"; $self->{zone_now_msg} = "$CmdStr"; - $self->{zone_now_status} = "$ZoneStatus"; - $self->{zone_now_name} = "$ZoneName"; + $self->{zone_now_status} = "$ZoneStatus"; + $self->{zone_now_name} = "$ZoneName"; $self->{zone_now_num} = "$ZoneNum"; ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); - } + } } - $lc++ - } + $lc++ } - } + } + elsif ($status_type->{expander}) { + my $exp_id = substr( $CmdStr, 5, 2 ); + my $input_id = substr( $CmdStr, 8, 2 ); + my $status = substr( $CmdStr, 11, 2 ); + my $ZoneStatus; + my $PartStatus; + + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "EXPANDER: exp_id($exp_id) input($input_id) status($status)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + + if (exists $main::config_parms{"AD2USB_expander_$exp_id$input_id"}) { + # Assign zone + $ZoneNum = $main::config_parms{"AD2USB_expander_$exp_id$input_id"}; + $ZoneName = "Unknown"; + $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; + # Assign status (zone and partition) + + if ($status == 01) { + $ZoneStatus = "fault"; + $PartStatus = "not ready"; + } elsif ($status == 00) { + $ZoneStatus = "ready"; + $PartStatus = ""; + } - case 3 { # EXPANDER STATUS - my $exp_id = substr( $CmdStr, 5, 2 ); - my $input_id = substr( $CmdStr, 8, 2 ); - my $status = substr( $CmdStr, 11, 2 ); - my $ZoneStatus; - my $PartStatus; - - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "EXPANDER: exp_id($exp_id) input($input_id) status($status)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - - if (exists $main::config_parms{"AD2USB_expander_$exp_id$input_id"}) { - # Assign zone - $ZoneNum = $main::config_parms{"AD2USB_expander_$exp_id$input_id"}; - $ZoneName = "Unknown"; - $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; - # Assign status (zone and partition) - - - if ($status == 01) { - $ZoneStatus = "fault"; - $PartStatus = "not ready"; - } elsif ($status == 00) { - $ZoneStatus = "ready"; - $PartStatus = ""; - } - - $self->{zone_now_msg} = "$CmdStr"; - $self->{zone_now_status} = "$ZoneStatus"; - $self->{zone_now_name} = "$ZoneName"; - $self->{zone_now_num} = "$ZoneNum"; - ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); + $self->{zone_now_msg} = "$CmdStr"; + $self->{zone_now_status} = "$ZoneStatus"; + $self->{zone_now_name} = "$ZoneName"; + $self->{zone_now_num} = "$ZoneNum"; + ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); # if (($self->{partition_status}{int($PartNum)}) eq "ready") { #only change the partition status if the current status is "ready". We dont change if the system is armed. # if ($PartStatus ne "") { # $self->{partition_now_msg} = "$CmdStr"; @@ -718,159 +704,155 @@ sub CheckCmd { # ChangePartitions( int($PartNum), int($PartNum), "$PartStatus", 1); # } # } - } } + } + elsif ($status_type->{relay}) { + my $rel_id = substr( $CmdStr, 5, 2 ); + my $rel_input_id = substr( $CmdStr, 8, 2 ); + my $rel_status = substr( $CmdStr, 11, 2 ); + my $PartName = my $PartNum = "1"; + my $ZoneStatus; + my $PartStatus; + + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "RELAY: rel_id($rel_id) input($rel_input_id) status($rel_status)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + + if (exists $main::config_parms{"AD2USB_relay_$rel_id$rel_input_id"}) { + # Assign zone + $ZoneNum = $main::config_parms{"AD2USB_relay_$rel_id$rel_input_id"}; + $ZoneName = "Unknown"; + $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; + # Assign status (zone and partition) + + if ($rel_status == 01) { + $ZoneStatus = "fault"; + $PartStatus = "not ready"; + } elsif ($rel_status == 00) { + $ZoneStatus = "ready"; + $PartStatus = ""; + } - case 4 { # RELAY STATUS - my $rel_id = substr( $CmdStr, 5, 2 ); - my $rel_input_id = substr( $CmdStr, 8, 2 ); - my $rel_status = substr( $CmdStr, 11, 2 ); - my $PartName = my $PartNum = "1"; - my $ZoneStatus; - my $PartStatus; - - - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "RELAY: rel_id($rel_id) input($rel_input_id) status($rel_status)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - - if (exists $main::config_parms{"AD2USB_relay_$rel_id$rel_input_id"}) { - # Assign zone - $ZoneNum = $main::config_parms{"AD2USB_relay_$rel_id$rel_input_id"}; - $ZoneName = "Unknown"; - $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; - # Assign status (zone and partition) - - - if ($rel_status == 01) { - $ZoneStatus = "fault"; - $PartStatus = "not ready"; - } elsif ($rel_status == 00) { - $ZoneStatus = "ready"; - $PartStatus = ""; - } - - $self->{zone_now_msg} = "$CmdStr"; - $self->{zone_now_status} = "$ZoneStatus"; - $self->{zone_now_name} = "$ZoneName"; - $self->{zone_now_num} = "$ZoneNum"; - ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); - # if (($self->{partition_status}{int($PartNum)}) eq "ready") { #only change the partition status if the current status is "ready". We dont change if the system is armed. - # if ($PartStatus ne "") { - # $self->{partition_now_msg} = "$CmdStr"; - # $self->{partition_now_status} = "$PartStatus"; - # $self->{partition_now_num} = "$PartNum"; - # ChangePartitions( int($PartNum), int($PartNum), "$PartStatus", 1); - # } + $self->{zone_now_msg} = "$CmdStr"; + $self->{zone_now_status} = "$ZoneStatus"; + $self->{zone_now_name} = "$ZoneName"; + $self->{zone_now_num} = "$ZoneNum"; + ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); + # if (($self->{partition_status}{int($PartNum)}) eq "ready") { #only change the partition status if the current status is "ready". We dont change if the system is armed. + # if ($PartStatus ne "") { + # $self->{partition_now_msg} = "$CmdStr"; + # $self->{partition_now_status} = "$PartStatus"; + # $self->{partition_now_num} = "$PartNum"; + # ChangePartitions( int($PartNum), int($PartNum), "$PartStatus", 1); + # } # } - } - } - - else { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "SOMETHING SERIOUSLY WRONG - UNKNOWN COMMAND" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } } + else { + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "SOMETHING SERIOUSLY WRONG - UNKNOWN COMMAND" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + } # NORMAL STATUS TYPE # ALWAYS CHECK CHIME / AC POWER / BATTERY STATUS / BACKLIGHT / BEEPS - if ($status_type >= 10) { + if ($status_type->{keypad}) { - # PARSE codes - my $status_codes = substr( $CmdStr, 1, 12 ); - my $fault = substr( $CmdStr, 23, 3 ); - my $panel_message = substr( $CmdStr, 61, 32); + # PARSE codes + my $status_codes = substr( $CmdStr, 1, 12 ); + my $fault = substr( $CmdStr, 23, 3 ); + my $panel_message = substr( $CmdStr, 61, 32); - # BACKLIGHT - $data = 3; - if ( substr($status_codes,$data,1) == "1" ) { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel backlight is on" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - } + # BACKLIGHT + $data = 3; + if ( substr($status_codes,$data,1) == "1" ) { + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel backlight is on" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + } - # BEEPS - $data = 5; - if ( substr($status_codes,$data,1) != "0" ) { - $NumBeeps = substr($status_codes,$data,1); - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel beeped $NumBeeps times" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - } + # BEEPS + $data = 5; + if ( substr($status_codes,$data,1) != "0" ) { + $NumBeeps = substr($status_codes,$data,1); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel beeped $NumBeeps times" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + } - # AC POWER - $data = 7; - if ( substr($status_codes,$data,1) == "0" ) { - $$self{ac_power} = 0; - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "AC Power has been lost" ); - } - else { - $$self{ac_power} = 1; - } + # AC POWER + $data = 7; + if ( substr($status_codes,$data,1) == "0" ) { + $$self{ac_power} = 0; + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "AC Power has been lost" ); + } + else { + $$self{ac_power} = 1; + } - # CHIME MODE - $data = 8; - if ( substr($status_codes,$data,1) == "0" ) { - $self->{chime} = 0; + # CHIME MODE + $data = 8; + if ( substr($status_codes,$data,1) == "0" ) { + $self->{chime} = 0; # ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Chime is off" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - } - else { - $self->{chime} = 1; + } + else { + $self->{chime} = 1; # ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Chime is on" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - } - - # BATTERY LOW - $data = 11; - if ( substr($status_codes,$data,1) == "1" ) { - $self->{battery_low} = 1; - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel is low on battery" ); - } - else { - $self->{battery_low} = 0; - } + } + # BATTERY LOW + $data = 11; + if ( substr($status_codes,$data,1) == "1" ) { + $self->{battery_low} = 1; + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel is low on battery" ); + } + else { + $self->{battery_low} = 0; + } } - return; - } # Determine if the status string requires parsing {{{ +# Returns a hash reference containing the message type sub GetStatusType { my $AdemcoStr = shift; - my $ll = length($AdemcoStr); + my $ll = length($AdemcoStr); + my %msg_type; + + # Keypad Type Messages are 94 Characters Long if ($ll eq 94) { - # Keypad Message - # Format: Bit field,Numeric code,Raw data,Alphanumeric Keypad Message - # TODO I would be inclined to split by comma rather than use substr + $msg_type{keypad} = 1; my $substatus = substr($AdemcoStr, 61, 5); if ( $substatus eq "FAULT" ) { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Fault zones available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); - return 11; + $msg_type{fault} = 1; } elsif ( $substatus eq "BYPAS" ) { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Bypass zones available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); - return 12; + $msg_type{bypass} = 1; } elsif ($AdemcoStr =~ m/Hit \*|Press \*/) { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Faults available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); - return 10; + $msg_type{fault_avail} = 1; } else { -# ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Standard status received: $AdemcoStr"); - return 13; + $msg_type{status} = 1; } } elsif (substr($AdemcoStr,0,5) eq "!RFX:") { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Wireless status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); - return 2; + $msg_type{wireless} = 1; } elsif (substr($AdemcoStr,0,5) eq "!EXP:") { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Expander status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); - return 3; + $msg_type{expander} = 1; } elsif (substr($AdemcoStr,0,5) eq "!REL:") { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Relay status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); - return 4; + $msg_type{relay} = 1; } elsif ($AdemcoStr eq "!Sending...done") { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Command sent successfully.") unless ($main::config_parms{AD2USB_debug_log} == 0); - return 0; + $msg_type{cmd_sent} = 1; + } + else { + $msg_type{unknown} = 1; } - return -1; + return \%msg_type; } #}}} From 09a5365f4c5f11b55a4cfe5c80e0824ed1ea5204 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Fri, 10 Jan 2014 18:20:00 -0800 Subject: [PATCH 023/180] AD2: Remove Some Substr in GetStatusType, Add More Message Parsing Relying on substr is dangerous, particularly since a user can enable the !KPM: prefix. Add more message parsing to GetStatusType, this routine can likely be converted to parse_message and save a lot of code --- lib/AD2USB.pm | 68 ++++++++++++++++++++++++++++++--------------------- 1 file changed, 40 insertions(+), 28 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index f11952297..8fccc9714 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -263,7 +263,7 @@ sub check_for_data { ::print_log("[AD2USB] " . $Cmd) if $main::Debug{AD2USB} >= 1; # Get the Message Type, and Ignore Duplicate Status Messages - my $status_type = GetStatusType($Cmd); + my $status_type = $self->GetStatusType($Cmd); if ($status_type->{keypad} && $Cmd eq $self->{last_cmd} && (!$status_type->{fault})) { # This is a duplicate panel message with no important status @@ -274,7 +274,7 @@ sub check_for_data { # relay or RF or zone expander message or something important # Log the message, parse it, and store it to detect future dupes ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "NONPANEL: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); - CheckCmd($Cmd); + $self->CheckCmd($Cmd); ResetAdemcoState(); $self->{last_cmd} = $Cmd if ($status_type->{keypad}); } @@ -290,9 +290,8 @@ sub check_for_data { # Validate the command and perform action {{{ sub CheckCmd { - my $CmdStr = shift; - my $status_type = GetStatusType($CmdStr); - my $self = $Self; + my ($self, $CmdStr) = @_; + my $status_type = $self->GetStatusType($CmdStr); if ($status_type->{unknown}) { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "UNKNOWN STATUS: $CmdStr" ) unless ($main::config_parms{AD2USB_debug_log} == 0); @@ -420,7 +419,7 @@ sub CheckCmd { $data = 0; if ( substr($status_codes,$data,1) == "1" ) { my $start = 1; - my $end = 11; + my $end = 11; #Why hardcoded at 11 zones? if ( substr($status_codes,6,1) ne "1" ) { # Reset all zones to ready if partition is ready and not bypassed ChangeZones( $start, $end, "ready", "", 1); @@ -807,52 +806,65 @@ sub CheckCmd { } # Determine if the status string requires parsing {{{ -# Returns a hash reference containing the message type +# Returns a hash reference containing the message details sub GetStatusType { - my $AdemcoStr = shift; - my $ll = length($AdemcoStr); - my %msg_type; - - # Keypad Type Messages are 94 Characters Long - if ($ll eq 94) { - $msg_type{keypad} = 1; - my $substatus = substr($AdemcoStr, 61, 5); - if ( $substatus eq "FAULT" ) { + my ($self, $AdemcoStr) = @_; + my %message; + + # Panel Message Format + if ($AdemcoStr =~ /(!KPM:)?\[([\d-]*)\],(\d{3}),\[(.*)\],\"(.*)\"/) { + $message{keypad} = 1; + + # Parse The Cmd into Message Parts + $message{bit_field} = $2; + $message{numeric_code} = $3; + $message{raw_data} = $4; + $message{alphanumeric} = $5; + my @flags = ('ready', 'armed_away_flag', 'armed_home_flag', + 'backlight_flag', 'programming_flag', 'beep_count', 'bypassed_flag', 'ac_flag', + 'chime_flag', 'alarm_past_flag', 'alarm_now_flag', 'battery_low_flag', 'no_delay_flag', + 'fire_flag', 'zone_issue_flag', 'perimeter_only_flag'); + for (my $i = 0; $i <= 15; $i++){ + $message{$flags[$i]} = substr($message{bit_field}, $i, 1); + } + + # Determine the Message Type + if ( $message{alphanumeric} =~ m/^FAULT/) { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Fault zones available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); - $msg_type{fault} = 1; + $message{fault} = 1; } - elsif ( $substatus eq "BYPAS" ) { + elsif ( $message{alphanumeric} =~ m/^BYPAS/ ) { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Bypass zones available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); - $msg_type{bypass} = 1; + $message{bypass} = 1; } - elsif ($AdemcoStr =~ m/Hit \*|Press \*/) { + elsif ($message{alphanumeric} =~ m/Hit \*|Press \*/) { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Faults available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); - $msg_type{fault_avail} = 1; + $message{fault_avail} = 1; } else { - $msg_type{status} = 1; + $message{status} = 1; } } elsif (substr($AdemcoStr,0,5) eq "!RFX:") { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Wireless status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); - $msg_type{wireless} = 1; + $message{wireless} = 1; } elsif (substr($AdemcoStr,0,5) eq "!EXP:") { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Expander status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); - $msg_type{expander} = 1; + $message{expander} = 1; } elsif (substr($AdemcoStr,0,5) eq "!REL:") { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Relay status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); - $msg_type{relay} = 1; + $message{relay} = 1; } elsif ($AdemcoStr eq "!Sending...done") { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Command sent successfully.") unless ($main::config_parms{AD2USB_debug_log} == 0); - $msg_type{cmd_sent} = 1; + $message{cmd_sent} = 1; } else { - $msg_type{unknown} = 1; + $message{unknown} = 1; } - return \%msg_type; + return \%message; } #}}} From 708bbdd5cd0084953d13bbde6c8ed9182b1d0c67 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 11 Jan 2014 10:07:54 -0800 Subject: [PATCH 024/180] AD2: Significantly Simplify Fault Loop Logic Get rid of all of the complicated tests. Allow ChangeZones to loop around from a high zone to a low zone. NOTE: May need to add a check to ChangeZones to see if it is reseting a mapped zone. --- lib/AD2USB.pm | 114 ++++++++++++++++---------------------------------- 1 file changed, 35 insertions(+), 79 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 8fccc9714..c09ed4f9a 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -273,7 +273,7 @@ sub check_for_data { # This is a non-dupe panel message or a fault panel message or a # relay or RF or zone expander message or something important # Log the message, parse it, and store it to detect future dupes - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "NONPANEL: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "MSG: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); $self->CheckCmd($Cmd); ResetAdemcoState(); $self->{last_cmd} = $Cmd if ($status_type->{keypad}); @@ -310,77 +310,35 @@ sub CheckCmd { cmd( $self, "ShowFaults" ); } elsif ($status_type->{fault}) { - my $status_codes = substr( $CmdStr, 1, 12 ); - my $fault = substr( $CmdStr, 23, 3 ); - $fault = substr($CmdStr, 67, 2); #TODO Why do we set $fault twice? ^ - $fault = "0$fault"; - my $panel_message = substr( $CmdStr, 61, 32); + my $zone_padded = $status_type->{numeric_code}; + my $zone_no_pad = int($zone_padded); - my $ZoneName = my $ZoneNum = $fault; my $PartNum = "1"; - $ZoneName = $main::config_parms{"AD2USB_zone_${ZoneNum}"} if exists $main::config_parms{"AD2USB_zone_${ZoneNum}"}; - $ZoneNum =~ s/^0*//; - $fault = $ZoneNum; - - if (&MappedZones("00$ZoneNum")) { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Zone $ZoneNum is mapped to a Relay or RF ID, skipping normal monitoring!") } + my $ZoneName = $main::config_parms{"AD2USB_zone_${zone_padded}"} if exists $main::config_parms{"AD2USB_zone_${zone_padded}"}; + + # Each fault message tells us two things, 1) this zone is faulted and + # 2) all zones between this zone and the last fault are ready. + if (MappedZones($zone_padded)) { + #Why do we not reset mapped zones? Don't they appear in the fault loop + #too? + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Zone $zone_no_pad is mapped to a Relay, RF ID, or expander, skipping normal monitoring!") } else { - #Check if this is the new lowest fault number and reset the zones before it - if (int($fault) <= int($self->{zone_lowest_fault})) { - $self->{zone_lowest_fault} = $fault; - #Reset zones to ready before the lowest - $start = 1; - $end = $self->{zone_lowest_fault} - 1; - ChangeZones( $start, $end, "ready", "bypass", 1); + #Reset the zones between the current zone and the last zone. If zones + #are sequential do nothing, if same zone, reset all other zones + if ($self->{zone_last_num} - $zone_no_pad > 1 + || $self->{zone_last_num} - $zone_no_pad == 0) { + ChangeZones( $self->{zone_last_num}+1, $zone_no_pad-1, "ready", "bypass", 1); } - #Check if this is a new highest fault number and reset zones after it - if (int($fault) > int($self->{zone_highest_fault})) { - $self->{zone_highest_fault} = $fault; - #Reset zones to ready after the highest - $start = $self->{zone_highest_fault} + 1;; - $end = 11; - ChangeZones( $start, $end, "ready", "bypass", 1); - } - - # Check if this zone was already faulted - if ($self->{zone_status}{"$fault"} eq "fault") { - - #Check if this fault is less than the last fault (and must now be the new lowest zone) - if (int($fault) <= int($self->{zone_last_num})) { - #This is the new lowest zone - $self->{zone_lowest_fault} = $fault; - #Reset zones to ready before the lowest - $start = 1; - $end = $self->{zone_lowest_fault} - 1; - ChangeZones( $start, $end, "ready", "bypass", 1); - } - - #Check if this fault is equal to the last fault (and must now be the only zone) - if (int($fault) == int($self->{zone_last_num})) { - #Reset zones to ready after the only one - $start = int($fault) + 1; - $end = 11; - ChangeZones( $start, $end, "ready", "bypass", 1); - } - - #Check if this fault is greater than the last fault and reset the zones between it and the prior one - if (int($fault) > int($self->{zone_last_num})) { - $start = (($self->{zone_last_num} == $fault) ? 1 : int($self->{zone_last_num}) + 1); - $end = $fault - 1; - ChangeZones( $start, $end, "ready", "bypass", 1); - } - } #End Already Faulted - - $self->{zone_now_msg} = "$panel_message"; + $self->{zone_now_msg} = $status_type->{alphanumeric}; $self->{zone_now_status} = "fault"; - $self->{zone_now_name} = "$ZoneName"; - $self->{zone_now_num} = "$ZoneNum"; - ChangeZones( int($ZoneNum), int($ZoneNum), "fault", "", 1); - } #Not MappedZones - $self->{partition_now_msg} = "$panel_message"; + $self->{zone_now_name} = $ZoneName; + $self->{zone_now_num} = $zone_no_pad; + ChangeZones( $zone_no_pad, $zone_no_pad, "fault", "", 1); + } #End MappedZones + $self->{partition_now_msg} = $status_type->{alphanumeric}; $self->{partition_now_status} = "not ready"; - $self->{partition_now_num} = "$PartNum"; + $self->{partition_now_num} = $PartNum; ChangePartitions( int($PartNum), int($PartNum), "not ready", 1); } elsif ($status_type->{bypass}) { @@ -456,7 +414,7 @@ sub CheckCmd { my $PartNum = my $PartName = "1"; $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} if exists $main::config_parms{"AD2USB_part_${PartNum}"}; - my $mode = "ERROR"; + my $mode = "ERROR"; if (index($panel_message, "ALL SECURE")) { $mode = "armed away"; } @@ -870,28 +828,26 @@ sub GetStatusType { #}}} # Change zone statuses for zone indices from start to end {{{ sub ChangeZones { - my $start = @_[0]; - my $end = @_[1]; - my $new_status = @_[2]; - my $neq_status = @_[3]; - my $log = @_[4]; + my ($start, $end, $new_status, $neq_status, $log) = @_; + my $self = $Self; #Kludge - my $self = $Self; - for ($i = $start; $i <= $end; $i++) { + # Allow for reverse looping from 999->1 + my $reverse = ($start > $end)? 1 : 0; + for ($i = $start; (!$reverse && $i <= $end) || + ($reverse && ($i >= $start || $i <= $end)); $i++) { $current_status = $self->{zone_status}{"$i"}; if (($current_status ne $new_status) && ($current_status ne $neq_status)) { if (($main::config_parms{AD2USB_zone_log} != 0) && ($log == 1)) { - my $ZoneNumPadded = $i; - $ZoneNumPadded = sprintf("%3d", $ZoneNumPadded); - $ZoneNumPadded =~ tr/ /0/; - $ZoneName = "Unknown"; + my $ZoneNumPadded = sprintf("%03d", $i); + my $ZoneName = "Unknown"; $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNumPadded"} if exists $main::config_parms{"AD2USB_zone_$ZoneNumPadded"}; ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Zone $i ($ZoneName) changed from '$current_status' to '$new_status'" ) unless ($main::config_parms{AD2USB_zone_log} == 0); } $self->{zone_status}{"$i"} = $new_status; - # Set child object status if it is registered to the zone - $$self{zone_object}{"$i"}->set($new_status, $$self{zone_object}{"$i"}) if defined $$self{zone_object}{"$i"}; + # Set child object status if it is registered to the zone + $$self{zone_object}{"$i"}->set($new_status, $$self{zone_object}{"$i"}) if defined $$self{zone_object}{"$i"}; } + $i = 0 if $i == 999; #loop around } } From f6e4c3641142b0fab59202fa8fc05f94513389f0 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 11 Jan 2014 10:46:38 -0800 Subject: [PATCH 025/180] AD2: Simplyfy Bypass Logic --- lib/AD2USB.pm | 27 ++++++++------------------- 1 file changed, 8 insertions(+), 19 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index c09ed4f9a..2e8e98c4f 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -292,6 +292,8 @@ sub check_for_data { sub CheckCmd { my ($self, $CmdStr) = @_; my $status_type = $self->GetStatusType($CmdStr); + my $zone_padded = $status_type->{numeric_code}; + my $zone_no_pad = int($zone_padded); if ($status_type->{unknown}) { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "UNKNOWN STATUS: $CmdStr" ) unless ($main::config_parms{AD2USB_debug_log} == 0); @@ -310,9 +312,6 @@ sub CheckCmd { cmd( $self, "ShowFaults" ); } elsif ($status_type->{fault}) { - my $zone_padded = $status_type->{numeric_code}; - my $zone_no_pad = int($zone_padded); - my $PartNum = "1"; my $ZoneName = $main::config_parms{"AD2USB_zone_${zone_padded}"} if exists $main::config_parms{"AD2USB_zone_${zone_padded}"}; @@ -342,28 +341,18 @@ sub CheckCmd { ChangePartitions( int($PartNum), int($PartNum), "not ready", 1); } elsif ($status_type->{bypass}) { - my $status_codes = substr( $CmdStr, 1, 12 ); - my $fault = substr( $CmdStr, 23, 3 ); - $fault = substr($CmdStr, 67, 2); - $fault = "0$fault"; - my $panel_message = substr( $CmdStr, 61, 32); - - my $ZoneName = my $ZoneNum = $fault; my $PartNum = "1"; - $ZoneName = $main::config_parms{"AD2USB_zone_${ZoneNum}"} if exists $main::config_parms{"AD2USB_zone_${ZoneNum}"}; - $ZoneNum =~ s/^0*//; - $fault = $ZoneNum; + my $ZoneName = $main::config_parms{"AD2USB_zone_${zone_padded}"} if exists $main::config_parms{"AD2USB_zone_${zone_padded}"}; - $self->{zone_now_msg} = "$panel_message"; + $self->{zone_now_msg} = $status_type->{alphanumeric}; $self->{zone_now_status} = "bypass"; - $self->{zone_now_name} = "$ZoneName"; - $self->{zone_now_num} = "$ZoneNum"; + $self->{zone_now_name} = $ZoneName; + $self->{zone_now_num} = $zone_no_pad; ChangeZones( int($ZoneNum), int($ZoneNum), "bypass", "", 1); - $self->{partition_now_msg} = "$panel_message"; + $self->{partition_now_msg} = $status_type->{alphanumeric}; $self->{partition_now_status} = "not ready"; - $self->{partition_now_num} = "$PartNum"; + $self->{partition_now_num} = $PartNum; ChangePartitions( int($PartNum), int($PartNum), "not ready", 1); - } elsif ($status_type->{status}) { From ffe223bd59247b73fcda0655a27d158bca8bbb72 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 11 Jan 2014 12:42:37 -0800 Subject: [PATCH 026/180] AD2: Condense Status Type into Keypad Type Anytime we get a keypad message we can check the status bits. Stop using substr and use hash flags. --- lib/AD2USB.pm | 332 ++++++++++++++++++++++---------------------------- 1 file changed, 145 insertions(+), 187 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 2e8e98c4f..8ead41647 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -354,175 +354,6 @@ sub CheckCmd { $self->{partition_now_num} = $PartNum; ChangePartitions( int($PartNum), int($PartNum), "not ready", 1); } - elsif ($status_type->{status}) { - - # Get three sections of the Ademco status message - my $status_codes = substr( $CmdStr, 1, 12 ); - my $fault = substr( $CmdStr, 23, 3 ); - my $panel_message = substr( $CmdStr, 61, 32); - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key received ($self->{keys_sent} left)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - - # READY - $data = 0; - if ( substr($status_codes,$data,1) == "1" ) { - my $start = 1; - my $end = 11; #Why hardcoded at 11 zones? - if ( substr($status_codes,6,1) ne "1" ) { - # Reset all zones to ready if partition is ready and not bypassed - ChangeZones( $start, $end, "ready", "", 1); - } - else { - # If zones are bypassed, reset unbypassed zones to ready - for ($i = $start; $i <= $end; $i++) { - my $current_status = $self->{zone_status}{"$i"}; - if ($current_status eq "fault") { - ChangeZones($i, $i, "ready", "bypass", 1); - } - } - } - - my $PartName = my $PartNum = "1"; - - $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} if exists $main::config_parms{"AD2USB_part_${PartNum}"}; - $self->{partition_now_msg} = "$panel_message"; - $self->{partition_now_num} = "$PartNum"; - $self->{partition_now_status} = "ready"; - ChangePartitions( int($PartNum), int($PartNum), "ready", 1); - $self->{zone_lowest_fault} = 999; - $self->{zone_highest_fault} = -1; - - # Reset state for fault checks - $self->{zone_last_status} = ""; - $self->{zone_last_num} = ""; - $self->{zone_last_name} = ""; - } - - # ARMED AWAY - $data = 1; - if ( substr($status_codes,$data,1) == "1" ) { - my $PartNum = my $PartName = "1"; - $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} if exists $main::config_parms{"AD2USB_part_${PartNum}"}; - - my $mode = "ERROR"; - if (index($panel_message, "ALL SECURE")) { - $mode = "armed away"; - } - elsif (index($panel_message, "You may exit now")) { - $mode = "exit delay"; - } - elsif (index($panel_message, "or alarm occurs")) { - $mode = "entry delay"; - } - elsif (index($panel_message, "ZONE BYPASSED")) { - $mode = "armed away"; - } - - set $self "$mode"; - $self->{partition_now_msg} = "$panel_message"; - $self->{partition_now_status} = "$mode"; - $self->{partition_now_num} = "$PartNum"; - ChangePartitions( int($PartNum), int($PartNum), "$mode", 1); - - # Reset state for fault checks - $self->{zone_last_status} = ""; - $self->{zone_last_num} = ""; - $self->{zone_last_name} = ""; - } - - # ARMED HOME - $data = 2; - if ( substr($status_codes,$data,1) eq "1" ) { - my $PartNum = my $PartName = "1"; - - my $mode = "armed stay"; - $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} if exists $main::config_parms{"AD2USB_part_${PartNum}"}; - $self->{partition_now_msg} = "$panel_message"; - $self->{partition_now_status} = "$mode"; - $self->{partition_now_num} = "$PartNum"; - ChangePartitions( int($PartNum), int($PartNum), "$mode", 1); - - # Reset state for fault checks - $self->{zone_last_status} = ""; - $self->{zone_last_num} = ""; - $self->{zone_last_name} = ""; - } - - # SKIP BACKLIGHT - $data = 3; - - # PROGRAMMING MODE - $data = 4; - if ( substr($status_codes,$data,1) eq "1" ) { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel is in programming mode" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - - # Reset state for fault checks - $self->{zone_last_status} = ""; - $self->{zone_last_num} = ""; - $self->{zone_last_name} = ""; - } - - # SKIP BEEPS - $data = 5; - - # A ZONE OR ZONES ARE BYPASSED - $data = 6; - if ( substr($status_codes,$data,1) == "1" ) { - - # Reset zones to ready that haven't appeared in the bypass loop -# if ($self->{zone_last_status} eq "bypass") { -# if (int($fault) < int($self->{zone_now_num})) { -# $start = int($self->{zone_now_num}) + 1; -# $end = 12; -# } -# ChangeZones( $start, $end - 1, "ready", "", 1); -# $self->{zone_now_status} = ""; -# $self->{zone_now_num} = "0"; -# } - - # Reset state for fault checks - $self->{zone_last_status} = ""; - $self->{zone_last_num} = ""; - $self->{zone_last_name} = ""; - } - - # SKIP AC POWER - $data = 7; - - # SKIP CHIME MODE - $data = 8; - - # ALARM WAS TRIGGERED (Sticky until disarm) - $data = 9; - if ( substr($status_codes,$data,1) == "1" ) { - $EventName = "ALARM WAS TRIGGERED"; - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName" ) unless ($main::config_parms{AD2USB_part_log} == 0); - } - - # ALARM IS SOUNDING - $data = 10; - if ( substr($status_codes,$data,1) == "1" ) { - $EventName = "ALARM IS SOUNDING"; - - #TODO: figure out how to get a partition number - my $PartName = my $PartNum = "1"; - my $ZoneNum = $fault; - $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; - $PartName = $main::config_parms{"AD2USB_part_$PartName"} if exists $main::config_parms{"AD2USB_part_$PartName"}; - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName - Zone $ZoneNum ($ZoneName)" ) unless ($main::config_parms{AD2USB_part_log} == 0); - $ZoneNum =~ s/^0*//; - ChangeZones( int($ZoneNum), int($ZoneNum), "alarm", "", 1); - $self->{zone_now_msg} = "$panel_message"; - $self->{zone_now_status} = "alarm"; - $self->{zone_now_num} = "$ZoneNum"; - $self->{partition_now_msg} = "$panel_message"; - $self->{partition_now_status} = "alarm"; - $self->{partition_now_num} = "$PartNum"; - ChangePartitions( int($PartNum), int($PartNum), "alarm", 1); - } - - # SKIP BATTERY LOW - $data = 11; - } elsif ($status_type->{wireless}) { my $ZoneLoop = ""; my $MZoneLoop = ""; @@ -692,35 +523,139 @@ sub CheckCmd { # } } } - else { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "SOMETHING SERIOUSLY WRONG - UNKNOWN COMMAND" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - } # NORMAL STATUS TYPE - # ALWAYS CHECK CHIME / AC POWER / BATTERY STATUS / BACKLIGHT / BEEPS + # ALWAYS Check Bits in Keypad Message if ($status_type->{keypad}) { # PARSE codes - my $status_codes = substr( $CmdStr, 1, 12 ); - my $fault = substr( $CmdStr, 23, 3 ); my $panel_message = substr( $CmdStr, 61, 32); + # READY + if ( $status_type->{ready_flag} == "1" ) { + my $start = 1; + my $end = 11; #Why hardcoded at 11 zones? + if ( $status_type->{bypassed_flag} ne "1" ) { + # Reset all zones to ready if partition is ready and not bypassed + ChangeZones( $start, $end, "ready", "", 1); + } + else { + # If zones are bypassed, reset unbypassed zones to ready + for ($i = $start; $i <= $end; $i++) { + my $current_status = $self->{zone_status}{"$i"}; + if ($current_status eq "fault") { + ChangeZones($i, $i, "ready", "bypass", 1); + } + } + } + + my $PartName = my $PartNum = "1"; + + $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} if exists $main::config_parms{"AD2USB_part_${PartNum}"}; + $self->{partition_now_msg} = $status_type->{alphanumeric}; + $self->{partition_now_num} = "$PartNum"; + $self->{partition_now_status} = "ready"; + ChangePartitions( int($PartNum), int($PartNum), "ready", 1); + $self->{zone_lowest_fault} = 999; + $self->{zone_highest_fault} = -1; + + # Reset state for fault checks + $self->{zone_last_status} = ""; + $self->{zone_last_num} = ""; + $self->{zone_last_name} = ""; + } + + # ARMED AWAY + if ( $status_type->{armed_away_flag} == "1" ) { + my $PartNum = my $PartName = "1"; + $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} if exists $main::config_parms{"AD2USB_part_${PartNum}"}; + + my $mode = "ERROR"; + if (index($panel_message, "ALL SECURE")) { + $mode = "armed away"; + } + elsif (index($panel_message, "You may exit now")) { + $mode = "exit delay"; + } + elsif (index($panel_message, "or alarm occurs")) { + $mode = "entry delay"; + } + elsif (index($panel_message, "ZONE BYPASSED")) { + $mode = "armed away"; + } + + set $self "$mode"; + $self->{partition_now_msg} = $status_type->{alphanumeric}; + $self->{partition_now_status} = "$mode"; + $self->{partition_now_num} = "$PartNum"; + ChangePartitions( int($PartNum), int($PartNum), "$mode", 1); + + # Reset state for fault checks + $self->{zone_last_status} = ""; + $self->{zone_last_num} = ""; + $self->{zone_last_name} = ""; + } + + # ARMED HOME + if ( $status_type->{armed_home_flag} eq "1" ) { + my $PartNum = my $PartName = "1"; + + my $mode = "armed stay"; + $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} if exists $main::config_parms{"AD2USB_part_${PartNum}"}; + $self->{partition_now_msg} = $status_type->{alphanumeric}; + $self->{partition_now_status} = "$mode"; + $self->{partition_now_num} = "$PartNum"; + ChangePartitions( int($PartNum), int($PartNum), "$mode", 1); + + # Reset state for fault checks + $self->{zone_last_status} = ""; + $self->{zone_last_num} = ""; + $self->{zone_last_name} = ""; + } + # BACKLIGHT - $data = 3; - if ( substr($status_codes,$data,1) == "1" ) { + if ( $status_type->{backlight_flag} == "1" ) { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel backlight is on" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } + # PROGRAMMING MODE + if ( $status_type->{programming_flag} eq "1" ) { + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel is in programming mode" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + + # Reset state for fault checks + $self->{zone_last_status} = ""; + $self->{zone_last_num} = ""; + $self->{zone_last_name} = ""; + } + # BEEPS - $data = 5; - if ( substr($status_codes,$data,1) != "0" ) { - $NumBeeps = substr($status_codes,$data,1); + if ( $status_type->{beep_count} != "0" ) { + my $NumBeeps = $status_type->{beep_count}; ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel beeped $NumBeeps times" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } + # A ZONE OR ZONES ARE BYPASSED + if ( $status_type->{bypassed_flag} == "1" ) { + + # Reset zones to ready that haven't appeared in the bypass loop +# if ($self->{zone_last_status} eq "bypass") { +# if (int($fault) < int($self->{zone_now_num})) { +# $start = int($self->{zone_now_num}) + 1; +# $end = 12; +# } +# ChangeZones( $start, $end - 1, "ready", "", 1); +# $self->{zone_now_status} = ""; +# $self->{zone_now_num} = "0"; +# } + + # Reset state for fault checks + $self->{zone_last_status} = ""; + $self->{zone_last_num} = ""; + $self->{zone_last_name} = ""; + } + # AC POWER - $data = 7; - if ( substr($status_codes,$data,1) == "0" ) { + if ( $status_type->{ac_flag} == "0" ) { $$self{ac_power} = 0; ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "AC Power has been lost" ); } @@ -729,8 +664,7 @@ sub CheckCmd { } # CHIME MODE - $data = 8; - if ( substr($status_codes,$data,1) == "0" ) { + if ( $status_type{chime_flag} == "0" ) { $self->{chime} = 0; # ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Chime is off" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } @@ -739,9 +673,33 @@ sub CheckCmd { # ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Chime is on" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } + # ALARM WAS TRIGGERED (Sticky until disarm) + if ( $status_type{alarm_past_flag} == "1" ) { + $EventName = "ALARM WAS TRIGGERED"; + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName" ) unless ($main::config_parms{AD2USB_part_log} == 0); + } + + # ALARM IS SOUNDING + if ( $status_type{alarm_now_flag} == "1" ) { + $EventName = "ALARM IS SOUNDING"; + + #TODO: figure out how to get a partition number + my $PartName = my $PartNum = "1"; + $ZoneName = $main::config_parms{"AD2USB_zone_$zone_padded"} if exists $main::config_parms{"AD2USB_zone_$zone_padded"}; + $PartName = $main::config_parms{"AD2USB_part_$PartName"} if exists $main::config_parms{"AD2USB_part_$PartName"}; + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName - Zone $ZoneNum ($ZoneName)" ) unless ($main::config_parms{AD2USB_part_log} == 0); + ChangeZones( $zone_no_pad, $zone_no_pad, "alarm", "", 1); + $self->{zone_now_msg} = $status_type->{alphanumeric}; + $self->{zone_now_status} = "alarm"; + $self->{zone_now_num} = $zone_no_pad; + $self->{partition_now_msg} = $status_type->{alphanumeric}; + $self->{partition_now_status} = "alarm"; + $self->{partition_now_num} = "$PartNum"; + ChangePartitions( int($PartNum), int($PartNum), "alarm", 1); + } + # BATTERY LOW - $data = 11; - if ( substr($status_codes,$data,1) == "1" ) { + if ( $status_type->{battery_low_flag} == "1" ) { $self->{battery_low} = 1; ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel is low on battery" ); } @@ -767,7 +725,7 @@ sub GetStatusType { $message{numeric_code} = $3; $message{raw_data} = $4; $message{alphanumeric} = $5; - my @flags = ('ready', 'armed_away_flag', 'armed_home_flag', + my @flags = ('ready_flag', 'armed_away_flag', 'armed_home_flag', 'backlight_flag', 'programming_flag', 'beep_count', 'bypassed_flag', 'ac_flag', 'chime_flag', 'alarm_past_flag', 'alarm_now_flag', 'battery_low_flag', 'no_delay_flag', 'fire_flag', 'zone_issue_flag', 'perimeter_only_flag'); From d1105b9e319e55c179501c8daeafc0d2f4796b5a Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 11 Jan 2014 13:16:54 -0800 Subject: [PATCH 027/180] AD2: Enable Use Strict, Clean Up Warnings Wow, can't believe I missed that. --- lib/AD2USB.pm | 60 +++++++++++++++++++++++++-------------------------- 1 file changed, 30 insertions(+), 30 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 8ead41647..b50551693 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -97,6 +97,7 @@ L ############################################################################### package AD2USB; +use strict; @AD2USB::ISA = ('Generic_Item'); @@ -202,9 +203,9 @@ sub serial_startup { sub server_startup { my ($instance) = @_; - $Socket_Items{"$instance"}{recon_timer} = new Timer; - $ip = $::config_parms{"$instance".'_server_ip'}; - $port = $::config_parms{"$instance" . '_server_port'}; + $Socket_Items{"$instance"}{recon_timer} = ::Timer::new(); + my $ip = $::config_parms{"$instance".'_server_ip'}; + my $port = $::config_parms{"$instance" . '_server_port'}; ::print_log(" AD2USB.pm initializing $instance TCP session with $ip on port $port") if $main::config_parms{debug} eq 'AD2USB'; $Socket_Items{"$instance"}{'socket'} = new Socket_Item($instance, undef, "$ip:$port", 'AD2USB', 'tcp', 'raw'); $Socket_Items{"$instance" . '_sender'}{'socket'} = new Socket_Item($instance . '_sender', undef, "$ip:$port", 'AD2USB_SENDER', 'tcp', 'rawout'); @@ -251,8 +252,8 @@ sub check_for_data { return if !$NewCmd; # Prepend any prior message fragment - $NewCmd = $self{IncompleteCmd} . $NewCmd if $self{IncompleteCmd}; - $self{IncompleteCmd} = ''; + $NewCmd = $self->{IncompleteCmd} . $NewCmd if $self->{IncompleteCmd}; + $self->{IncompleteCmd} = ''; # Split Data into Individual Messages and Then Send the Message to be Parsed foreach my $Cmd (split("\n", $NewCmd)){ @@ -281,7 +282,7 @@ sub check_for_data { } else { # Save partial command for next serial read - $self{IncompleteCmd} = $Cmd; + $self->{IncompleteCmd} = $Cmd; } } } @@ -348,7 +349,7 @@ sub CheckCmd { $self->{zone_now_status} = "bypass"; $self->{zone_now_name} = $ZoneName; $self->{zone_now_num} = $zone_no_pad; - ChangeZones( int($ZoneNum), int($ZoneNum), "bypass", "", 1); + ChangeZones( $zone_no_pad, $zone_no_pad, "bypass", "", 1); $self->{partition_now_msg} = $status_type->{alphanumeric}; $self->{partition_now_status} = "not ready"; $self->{partition_now_num} = $PartNum; @@ -357,6 +358,8 @@ sub CheckCmd { elsif ($status_type->{wireless}) { my $ZoneLoop = ""; my $MZoneLoop = ""; + my $ZoneNum; + my $ZoneName; # Parse raw status strings my $rf_id = substr( $CmdStr, 5, 7 ); my $rf_status = substr( $CmdStr, 13, 2 ); @@ -455,8 +458,8 @@ sub CheckCmd { if (exists $main::config_parms{"AD2USB_expander_$exp_id$input_id"}) { # Assign zone - $ZoneNum = $main::config_parms{"AD2USB_expander_$exp_id$input_id"}; - $ZoneName = "Unknown"; + my $ZoneNum = $main::config_parms{"AD2USB_expander_$exp_id$input_id"}; + my $ZoneName = "Unknown"; $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; # Assign status (zone and partition) @@ -495,8 +498,8 @@ sub CheckCmd { if (exists $main::config_parms{"AD2USB_relay_$rel_id$rel_input_id"}) { # Assign zone - $ZoneNum = $main::config_parms{"AD2USB_relay_$rel_id$rel_input_id"}; - $ZoneName = "Unknown"; + my $ZoneNum = $main::config_parms{"AD2USB_relay_$rel_id$rel_input_id"}; + my $ZoneName = "Unknown"; $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; # Assign status (zone and partition) @@ -541,7 +544,7 @@ sub CheckCmd { } else { # If zones are bypassed, reset unbypassed zones to ready - for ($i = $start; $i <= $end; $i++) { + for (my $i = $start; $i <= $end; $i++) { my $current_status = $self->{zone_status}{"$i"}; if ($current_status eq "fault") { ChangeZones($i, $i, "ready", "bypass", 1); @@ -664,7 +667,7 @@ sub CheckCmd { } # CHIME MODE - if ( $status_type{chime_flag} == "0" ) { + if ( $status_type->{chime_flag} == "0" ) { $self->{chime} = 0; # ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Chime is off" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } @@ -674,20 +677,20 @@ sub CheckCmd { } # ALARM WAS TRIGGERED (Sticky until disarm) - if ( $status_type{alarm_past_flag} == "1" ) { - $EventName = "ALARM WAS TRIGGERED"; + if ( $status_type->{alarm_past_flag} == "1" ) { + my $EventName = "ALARM WAS TRIGGERED"; ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName" ) unless ($main::config_parms{AD2USB_part_log} == 0); } # ALARM IS SOUNDING - if ( $status_type{alarm_now_flag} == "1" ) { - $EventName = "ALARM IS SOUNDING"; + if ( $status_type->{alarm_now_flag} == "1" ) { + my $EventName = "ALARM IS SOUNDING"; #TODO: figure out how to get a partition number my $PartName = my $PartNum = "1"; - $ZoneName = $main::config_parms{"AD2USB_zone_$zone_padded"} if exists $main::config_parms{"AD2USB_zone_$zone_padded"}; + my $ZoneName = $main::config_parms{"AD2USB_zone_$zone_padded"} if exists $main::config_parms{"AD2USB_zone_$zone_padded"}; $PartName = $main::config_parms{"AD2USB_part_$PartName"} if exists $main::config_parms{"AD2USB_part_$PartName"}; - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName - Zone $ZoneNum ($ZoneName)" ) unless ($main::config_parms{AD2USB_part_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName - Zone $zone_no_pad ($ZoneName)" ) unless ($main::config_parms{AD2USB_part_log} == 0); ChangeZones( $zone_no_pad, $zone_no_pad, "alarm", "", 1); $self->{zone_now_msg} = $status_type->{alphanumeric}; $self->{zone_now_status} = "alarm"; @@ -780,9 +783,9 @@ sub ChangeZones { # Allow for reverse looping from 999->1 my $reverse = ($start > $end)? 1 : 0; - for ($i = $start; (!$reverse && $i <= $end) || + for (my $i = $start; (!$reverse && $i <= $end) || ($reverse && ($i >= $start || $i <= $end)); $i++) { - $current_status = $self->{zone_status}{"$i"}; + my $current_status = $self->{zone_status}{"$i"}; if (($current_status ne $new_status) && ($current_status ne $neq_status)) { if (($main::config_parms{AD2USB_zone_log} != 0) && ($log == 1)) { my $ZoneNumPadded = sprintf("%03d", $i); @@ -801,17 +804,14 @@ sub ChangeZones { #}}} # Change partition statuses for partition indices from start to end {{{ sub ChangePartitions { - my $start = @_[0]; - my $end = @_[1]; - my $new_status = @_[2]; - my $log = @_[3]; + my ($start, $end, $new_status, $log) = @_; my $self = $Self; - for ($i = $start; $i <= $end; $i++) { - $current_status = $self->{partition_status}{"$i"}; + for (my $i = $start; $i <= $end; $i++) { + my $current_status = $self->{partition_status}{"$i"}; if ($current_status ne $new_status) { if (($main::config_parms{AD2USB_part_log} != 0) && ($log == 1)) { - $PartName = $main::config_parms{"AD2USB_part_$i"} if exists $main::config_parms{"AD2USB_part_$i"}; + my $PartName = $main::config_parms{"AD2USB_part_$i"} if exists $main::config_parms{"AD2USB_part_$i"}; ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Partition $i ($PartName) changed from '$current_status' to '$new_status'" ) unless ($main::config_parms{AD2USB_part_log} == 0); } $self->{partition_status}{"$i"} = $new_status; @@ -938,8 +938,8 @@ sub cmd { my $instance = $$self{instance}; $cmd = $self->{CmdMsg}->{$cmd}; - $CmdName = ( exists $self->{CmdMsgRev}->{$cmd} ) ? $self->{CmdMsgRev}->{$cmd} : "unknown"; - $CmdStr = $cmd; + my $CmdName = ( exists $self->{CmdMsgRev}->{$cmd} ) ? $self->{CmdMsgRev}->{$cmd} : "unknown"; + my $CmdStr = $cmd; # Exit if unknown command if ( $CmdName =~ /^unknown/ ) { From 3b771cf9af2a4e874c9e1649af43c5c6acfc4db3 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 11 Jan 2014 14:32:06 -0800 Subject: [PATCH 028/180] AD2: Condense RF Parsing into GetStatusType Using hash keys makes the code much more condensed and easier to read. --- lib/AD2USB.pm | 65 ++++++++++++++++++++++++--------------------------- 1 file changed, 30 insertions(+), 35 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index b50551693..fb85e2345 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -361,48 +361,30 @@ sub CheckCmd { my $ZoneNum; my $ZoneName; # Parse raw status strings - my $rf_id = substr( $CmdStr, 5, 7 ); - my $rf_status = substr( $CmdStr, 13, 2 ); my $lc = 0; my $wnum = 0; - # UNKNOWN - my $unknown_1 = 0; - $unknown_1 = 1 if (hex(substr($rf_status, 1, 1)) & 1) == 1; - # Parse for low battery signal - my $low_batt = 0; - $low_batt = 1 if (hex(substr($rf_status, 1, 1)) & 2) == 2; - # Parse for supervision flag - my $supervised = 0; - $supervised = 1 if (hex(substr($rf_status, 1, 1)) & 4) == 4; - # UNKNOWN - my $unknown_8 = 0; - $unknown_8 = 1 if (hex(substr($rf_status, 1, 1)) & 8) == 8; - - # Parse loop faults - my $loop_fault_1 = 0; - $loop_fault_1 = 1 if (hex(substr($rf_status, 0, 1)) & 8) == 8; - my $loop_fault_2 = 0; - $loop_fault_2 = 1 if (hex(substr($rf_status, 0, 1)) & 2) == 2; - my $loop_fault_3 = 0; - $loop_fault_3 = 1 if (hex(substr($rf_status, 0, 1)) & 1) == 1; - my $loop_fault_4 = 0; - $loop_fault_4 = 1 if (hex(substr($rf_status, 0, 1)) & 4) == 4; - - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "WIRELESS: rf_id($rf_id) status($rf_status) loop1($loop_fault_1) loop2($loop_fault_2) loop3($loop_fault_3) loop4($loop_fault_4)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "WIRELESS: rf_id($rf_id) status($rf_status) low_batt($low_batt) supervised($supervised)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "WIRELESS: rf_id(" + .$status_type->{rf_id}.") status(".$status_type->{rf_status}.") loop1(" + .$status_type->{rf_loop_fault_1}.") loop2(".$status_type->{rf_loop_fault_2} + .") loop3(".$status_type->{rf_loop_fault_3}.") loop4(" + .$status_type->{rf_loop_fault_4}.")" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "WIRELESS: rf_id(" + .$status_type->{rf_id}.") status(".$status_type->{rf_status}.") low_batt(" + .$status_type->{rf_low_batt}.") supervised(".$status_type->{rf_supervised} + .")" ) unless ($main::config_parms{AD2USB_debug_log} == 0); my $ZoneStatus = "ready"; my $PartStatus = ""; my @parsest; my $sensortype; - if (exists $main::config_parms{"AD2USB_wireless_$rf_id"}) { + if (exists $main::config_parms{"AD2USB_wireless_".$status_type->{rf_id}}) { # Assign zone - my @ParseNum = split(",", $main::config_parms{"AD2USB_wireless_$rf_id"}); + my @ParseNum = split(",", $main::config_parms{"AD2USB_wireless_".$status_type->{rf_id}}); # Assign status (zone and partition) - if ($low_batt == "1") { + if ($status_type->{rf_low_batt} == "1") { $ZoneStatus = "low battery"; } @@ -418,10 +400,10 @@ sub CheckCmd { $ZoneName = "Unknown"; $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; - if ($ZoneLoop eq "1") {$MZoneLoop = $loop_fault_1} - if ($ZoneLoop eq "2") {$MZoneLoop = $loop_fault_2} - if ($ZoneLoop eq "3") {$MZoneLoop = $loop_fault_3} - if ($ZoneLoop eq "4") {$MZoneLoop = $loop_fault_4} + if ($ZoneLoop eq "1") {$MZoneLoop = $status_type->{rf_loop_fault_1}} + if ($ZoneLoop eq "2") {$MZoneLoop = $status_type->{rf_loop_fault_2}} + if ($ZoneLoop eq "3") {$MZoneLoop = $status_type->{rf_loop_fault_3}} + if ($ZoneLoop eq "4") {$MZoneLoop = $status_type->{rf_loop_fault_4}} if ("$MZoneLoop" eq "1") { $ZoneStatus = "fault"; @@ -753,9 +735,22 @@ sub GetStatusType { $message{status} = 1; } } - elsif (substr($AdemcoStr,0,5) eq "!RFX:") { + elsif ($AdemcoStr =~ /!RFX:(\d{7}),(\d{2})/) { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Wireless status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); $message{wireless} = 1; + $message{rf_id} = $1; + $message{rf_status} = $2; + + $message{rf_unknown_1} = ((hex(substr($message{rf_status}, 1, 1)) & 1) == 1) ? 1 : 0; + $message{rf_low_batt} = ((hex(substr($message{rf_status}, 1, 1)) & 2) == 2) ? 1 : 0; + $message{rf_supervised} = ((hex(substr($message{rf_status}, 1, 1)) & 4) == 4) ? 1 : 0; + $message{rf_unknown_8} = ((hex(substr($message{rf_status}, 1, 1)) & 8) == 8) ? 1 : 0; + + $message{rf_loop_fault_1} = ((hex(substr($message{rf_status}, 0, 1)) & 8) == 8) ? 1 : 0; + $message{rf_loop_fault_2} = ((hex(substr($message{rf_status}, 0, 1)) & 2) == 2) ? 1 : 0; + $message{rf_loop_fault_3} = ((hex(substr($message{rf_status}, 0, 1)) & 1) == 1) ? 1 : 0; + $message{rf_loop_fault_4} = ((hex(substr($message{rf_status}, 0, 1)) & 4) == 4) ? 1 : 0; + } elsif (substr($AdemcoStr,0,5) eq "!EXP:") { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Expander status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); From fce0d4225bdd8e08935e8afc38ec774f891ff3b6 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 11 Jan 2014 14:52:15 -0800 Subject: [PATCH 029/180] AD2: Cleanup Wireless Logic I have to admit I don't really understand all of the optional settings for wireless objects --- lib/AD2USB.pm | 29 +++++++---------------------- 1 file changed, 7 insertions(+), 22 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index fb85e2345..62efa2866 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -356,14 +356,6 @@ sub CheckCmd { ChangePartitions( int($PartNum), int($PartNum), "not ready", 1); } elsif ($status_type->{wireless}) { - my $ZoneLoop = ""; - my $MZoneLoop = ""; - my $ZoneNum; - my $ZoneName; - # Parse raw status strings - my $lc = 0; - my $wnum = 0; - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "WIRELESS: rf_id(" .$status_type->{rf_id}.") status(".$status_type->{rf_status}.") loop1(" .$status_type->{rf_loop_fault_1}.") loop2(".$status_type->{rf_loop_fault_2} @@ -374,29 +366,22 @@ sub CheckCmd { .$status_type->{rf_low_batt}.") supervised(".$status_type->{rf_supervised} .")" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - my $ZoneStatus = "ready"; - my $PartStatus = ""; - my @parsest; - my $sensortype; - if (exists $main::config_parms{"AD2USB_wireless_".$status_type->{rf_id}}) { - # Assign zone - my @ParseNum = split(",", $main::config_parms{"AD2USB_wireless_".$status_type->{rf_id}}); + my ($MZoneLoop, $PartStatus, $ZoneNum, $ZoneName); + my $lc = 0; + my $ZoneStatus = "ready"; # Assign status (zone and partition) if ($status_type->{rf_low_batt} == "1") { $ZoneStatus = "low battery"; } - foreach $wnum(@ParseNum) { - if ($lc eq 0 or $lc eq 2 or $lc eq 4 or $lc eq 6) { + foreach my $wnum(split(",", $main::config_parms{"AD2USB_wireless_".$status_type->{rf_id}})) { + if ($lc % 2 == 0) { $ZoneNum = $wnum; } - - if ($lc eq 1 or $lc eq 3 or $lc eq 5 or $lc eq 7) { - @parsest = split("", $wnum); - $sensortype = $parsest[0]; - $ZoneLoop = $parsest[1]; + else { + my ($sensortype, $ZoneLoop) = split("", $wnum); $ZoneName = "Unknown"; $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; From c5f42fc1e6326364c7c80698aa5a8797f685e6a5 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 11 Jan 2014 15:06:05 -0800 Subject: [PATCH 030/180] AD2: Cleanup Expander Logic --- lib/AD2USB.pm | 29 ++++++++++------------------- 1 file changed, 10 insertions(+), 19 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 62efa2866..7fe8c1048 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -415,42 +415,30 @@ sub CheckCmd { } } elsif ($status_type->{expander}) { - my $exp_id = substr( $CmdStr, 5, 2 ); - my $input_id = substr( $CmdStr, 8, 2 ); - my $status = substr( $CmdStr, 11, 2 ); - my $ZoneStatus; - my $PartStatus; + my $exp_id = $status_type->{exp_address}; + my $input_id = $status_type->{exp_channel}; + my $status = $status_type->{exp_status}; ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "EXPANDER: exp_id($exp_id) input($input_id) status($status)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); if (exists $main::config_parms{"AD2USB_expander_$exp_id$input_id"}) { - # Assign zone my $ZoneNum = $main::config_parms{"AD2USB_expander_$exp_id$input_id"}; my $ZoneName = "Unknown"; $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; # Assign status (zone and partition) + my $ZoneStatus = "ready"; + my $PartStatus = ""; if ($status == 01) { $ZoneStatus = "fault"; $PartStatus = "not ready"; - } elsif ($status == 00) { - $ZoneStatus = "ready"; - $PartStatus = ""; } - $self->{zone_now_msg} = "$CmdStr"; + $self->{zone_now_msg} = $status_type->{alphanumeric}; $self->{zone_now_status} = "$ZoneStatus"; $self->{zone_now_name} = "$ZoneName"; $self->{zone_now_num} = "$ZoneNum"; ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); - # if (($self->{partition_status}{int($PartNum)}) eq "ready") { #only change the partition status if the current status is "ready". We dont change if the system is armed. - # if ($PartStatus ne "") { - # $self->{partition_now_msg} = "$CmdStr"; - # $self->{partition_now_status} = "$PartStatus"; - # $self->{partition_now_num} = "$PartNum"; - # ChangePartitions( int($PartNum), int($PartNum), "$PartStatus", 1); - # } - # } } } elsif ($status_type->{relay}) { @@ -737,9 +725,12 @@ sub GetStatusType { $message{rf_loop_fault_4} = ((hex(substr($message{rf_status}, 0, 1)) & 4) == 4) ? 1 : 0; } - elsif (substr($AdemcoStr,0,5) eq "!EXP:") { + elsif ($AdemcoStr =~ /!EXP:(\d{2}),(\d{2}),(\d{2})/) { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Expander status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); $message{expander} = 1; + $message{exp_address} = $1; + $message{exp_channel} = $2; + $message{exp_status} = $3; } elsif (substr($AdemcoStr,0,5) eq "!REL:") { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Relay status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); From 42bd9d253ebf5c4cd036369e9419e7fe9b7957fa Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 11 Jan 2014 15:34:27 -0800 Subject: [PATCH 031/180] AD2: Condense Relay Logic --- lib/AD2USB.pm | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 7fe8c1048..430b8acbf 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -442,12 +442,9 @@ sub CheckCmd { } } elsif ($status_type->{relay}) { - my $rel_id = substr( $CmdStr, 5, 2 ); - my $rel_input_id = substr( $CmdStr, 8, 2 ); - my $rel_status = substr( $CmdStr, 11, 2 ); - my $PartName = my $PartNum = "1"; - my $ZoneStatus; - my $PartStatus; + my $rel_id = $status_type->{rel_address}; + my $rel_input_id = $status_type->{rel_channel}; + my $rel_status = $status_type->{rel_status}; ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "RELAY: rel_id($rel_id) input($rel_input_id) status($rel_status)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); @@ -456,14 +453,13 @@ sub CheckCmd { my $ZoneNum = $main::config_parms{"AD2USB_relay_$rel_id$rel_input_id"}; my $ZoneName = "Unknown"; $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; - # Assign status (zone and partition) + # Assign status (zone and partition) + my $ZoneStatus = "ready"; + my $PartStatus = ""; if ($rel_status == 01) { $ZoneStatus = "fault"; $PartStatus = "not ready"; - } elsif ($rel_status == 00) { - $ZoneStatus = "ready"; - $PartStatus = ""; } $self->{zone_now_msg} = "$CmdStr"; @@ -732,11 +728,14 @@ sub GetStatusType { $message{exp_channel} = $2; $message{exp_status} = $3; } - elsif (substr($AdemcoStr,0,5) eq "!REL:") { + elsif ($AdemcoStr =~ /!REL:(\d{2}),(\d{2}),(\d{2})/) { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Relay status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); $message{relay} = 1; + $message{rel_address} = $1; + $message{rel_channel} = $2; + $message{rel_status} = $3; } - elsif ($AdemcoStr eq "!Sending...done") { + elsif ($AdemcoStr =~ /!Sending\.\.\.done/) { ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Command sent successfully.") unless ($main::config_parms{AD2USB_debug_log} == 0); $message{cmd_sent} = 1; } From 96812779dc03cea29984dc868d281f8806adfcdd Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 11 Jan 2014 18:13:09 -0800 Subject: [PATCH 032/180] AD2: Cleanup Keypad Flag Checking Logic --- lib/AD2USB.pm | 113 ++++++++++++++++++++++---------------------------- 1 file changed, 50 insertions(+), 63 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 430b8acbf..68eeb0bbf 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -481,35 +481,22 @@ sub CheckCmd { # NORMAL STATUS TYPE # ALWAYS Check Bits in Keypad Message if ($status_type->{keypad}) { - - # PARSE codes - my $panel_message = substr( $CmdStr, 61, 32); + # Set things based on Bit Codes # READY - if ( $status_type->{ready_flag} == "1" ) { - my $start = 1; - my $end = 11; #Why hardcoded at 11 zones? - if ( $status_type->{bypassed_flag} ne "1" ) { - # Reset all zones to ready if partition is ready and not bypassed - ChangeZones( $start, $end, "ready", "", 1); - } - else { - # If zones are bypassed, reset unbypassed zones to ready - for (my $i = $start; $i <= $end; $i++) { - my $current_status = $self->{zone_status}{"$i"}; - if ($current_status eq "fault") { - ChangeZones($i, $i, "ready", "bypass", 1); - } - } - } + if ( $status_type->{ready_flag}) { + my $bypass = ($status_type->{bypassed_flag}) ? 'bypass' : ''; + # Reset all zones, if bypass enabled skip bypassed zones + ChangeZones( 1, 999, "ready", $bypass, 1); - my $PartName = my $PartNum = "1"; + my $PartName = my $PartNum = 1; - $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} if exists $main::config_parms{"AD2USB_part_${PartNum}"}; + $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} + if exists $main::config_parms{"AD2USB_part_${PartNum}"}; $self->{partition_now_msg} = $status_type->{alphanumeric}; - $self->{partition_now_num} = "$PartNum"; + $self->{partition_now_num} = $PartNum; $self->{partition_now_status} = "ready"; - ChangePartitions( int($PartNum), int($PartNum), "ready", 1); + ChangePartitions( $PartNum, $PartNum, "ready", 1); $self->{zone_lowest_fault} = 999; $self->{zone_highest_fault} = -1; @@ -520,25 +507,26 @@ sub CheckCmd { } # ARMED AWAY - if ( $status_type->{armed_away_flag} == "1" ) { - my $PartNum = my $PartName = "1"; - $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} if exists $main::config_parms{"AD2USB_part_${PartNum}"}; + if ( $status_type->{armed_away_flag}) { + my $PartNum = my $PartName = 1; + $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} + if exists $main::config_parms{"AD2USB_part_${PartNum}"}; my $mode = "ERROR"; - if (index($panel_message, "ALL SECURE")) { + if (index($status_type->{alphanumeric}, "ALL SECURE")) { $mode = "armed away"; } - elsif (index($panel_message, "You may exit now")) { + elsif (index($status_type->{alphanumeric}, "You may exit now")) { $mode = "exit delay"; } - elsif (index($panel_message, "or alarm occurs")) { + elsif (index($status_type->{alphanumeric}, "or alarm occurs")) { $mode = "entry delay"; } - elsif (index($panel_message, "ZONE BYPASSED")) { + elsif (index($status_type->{alphanumeric}, "ZONE BYPASSED")) { $mode = "armed away"; } - set $self "$mode"; + $self->set($mode); $self->{partition_now_msg} = $status_type->{alphanumeric}; $self->{partition_now_status} = "$mode"; $self->{partition_now_num} = "$PartNum"; @@ -551,11 +539,12 @@ sub CheckCmd { } # ARMED HOME - if ( $status_type->{armed_home_flag} eq "1" ) { - my $PartNum = my $PartName = "1"; + if ( $status_type->{armed_home_flag}) { + my $PartNum = my $PartName = 1; my $mode = "armed stay"; - $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} if exists $main::config_parms{"AD2USB_part_${PartNum}"}; + $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} + if exists $main::config_parms{"AD2USB_part_${PartNum}"}; $self->{partition_now_msg} = $status_type->{alphanumeric}; $self->{partition_now_status} = "$mode"; $self->{partition_now_num} = "$PartNum"; @@ -568,13 +557,15 @@ sub CheckCmd { } # BACKLIGHT - if ( $status_type->{backlight_flag} == "1" ) { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel backlight is on" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + if ( $status_type->{backlight_flag}) { + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel backlight is on" ) + unless ($main::config_parms{AD2USB_debug_log} == 0); } # PROGRAMMING MODE - if ( $status_type->{programming_flag} eq "1" ) { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel is in programming mode" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + if ( $status_type->{programming_flag}) { + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel is in programming mode" ) + unless ($main::config_parms{AD2USB_debug_log} == 0); # Reset state for fault checks $self->{zone_last_status} = ""; @@ -583,13 +574,14 @@ sub CheckCmd { } # BEEPS - if ( $status_type->{beep_count} != "0" ) { + if ( $status_type->{beep_count}) { my $NumBeeps = $status_type->{beep_count}; - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel beeped $NumBeeps times" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel beeped $NumBeeps times" ) + unless ($main::config_parms{AD2USB_debug_log} == 0); } # A ZONE OR ZONES ARE BYPASSED - if ( $status_type->{bypassed_flag} == "1" ) { + if ( $status_type->{bypassed_flag}) { # Reset zones to ready that haven't appeared in the bypass loop # if ($self->{zone_last_status} eq "bypass") { @@ -609,57 +601,52 @@ sub CheckCmd { } # AC POWER - if ( $status_type->{ac_flag} == "0" ) { + $$self{ac_power} = 1; + if ( !$status_type->{ac_flag} ) { $$self{ac_power} = 0; ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "AC Power has been lost" ); } - else { - $$self{ac_power} = 1; - } # CHIME MODE - if ( $status_type->{chime_flag} == "0" ) { - $self->{chime} = 0; -# ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Chime is off" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - } - else { - $self->{chime} = 1; -# ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Chime is on" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + $self->{chime} = 0; + if ( $status_type->{chime_flag}) { + $self->{chime} = 1;# ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Chime is off" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } # ALARM WAS TRIGGERED (Sticky until disarm) - if ( $status_type->{alarm_past_flag} == "1" ) { + if ( $status_type->{alarm_past_flag}) { my $EventName = "ALARM WAS TRIGGERED"; ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName" ) unless ($main::config_parms{AD2USB_part_log} == 0); } # ALARM IS SOUNDING - if ( $status_type->{alarm_now_flag} == "1" ) { + if ( $status_type->{alarm_now_flag}) { my $EventName = "ALARM IS SOUNDING"; #TODO: figure out how to get a partition number - my $PartName = my $PartNum = "1"; - my $ZoneName = $main::config_parms{"AD2USB_zone_$zone_padded"} if exists $main::config_parms{"AD2USB_zone_$zone_padded"}; - $PartName = $main::config_parms{"AD2USB_part_$PartName"} if exists $main::config_parms{"AD2USB_part_$PartName"}; - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName - Zone $zone_no_pad ($ZoneName)" ) unless ($main::config_parms{AD2USB_part_log} == 0); + my $PartName = my $PartNum = 1; + my $ZoneName = $main::config_parms{"AD2USB_zone_$zone_padded"} + if exists $main::config_parms{"AD2USB_zone_$zone_padded"}; + $PartName = $main::config_parms{"AD2USB_part_$PartName"} + if exists $main::config_parms{"AD2USB_part_$PartName"}; + ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName - Zone $zone_no_pad ($ZoneName)" ) + unless ($main::config_parms{AD2USB_part_log} == 0); ChangeZones( $zone_no_pad, $zone_no_pad, "alarm", "", 1); $self->{zone_now_msg} = $status_type->{alphanumeric}; $self->{zone_now_status} = "alarm"; $self->{zone_now_num} = $zone_no_pad; $self->{partition_now_msg} = $status_type->{alphanumeric}; $self->{partition_now_status} = "alarm"; - $self->{partition_now_num} = "$PartNum"; + $self->{partition_now_num} = $PartNum; ChangePartitions( int($PartNum), int($PartNum), "alarm", 1); } # BATTERY LOW - if ( $status_type->{battery_low_flag} == "1" ) { + $self->{battery_low} = 0; + if ( $status_type->{battery_low_flag}) { $self->{battery_low} = 1; ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel is low on battery" ); } - else { - $self->{battery_low} = 0; - } } return; } From 08b7a5e63560d67dfdd33fcd9b08a43f148fb909 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 11 Jan 2014 19:13:37 -0800 Subject: [PATCH 033/180] AD2: Condense Log Statements by Storing Long File Name in Variable --- lib/AD2USB.pm | 70 +++++++++++++++++++++++++-------------------------- 1 file changed, 34 insertions(+), 36 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 68eeb0bbf..bb816fb0b 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -124,6 +124,7 @@ sub new { $$self{instance} = $instance; $$self{reconnect_time} = $::config_parms{'AD2USB_ser2sock_recon'}; $$self{reconnect_time} = 10 if !defined($$self{reconnect_time}); + $$self{log_file} = "$::config_parms{data_dir}/logs/AD2USB.$::Year_Month_Now.log" bless $self, $class; @@ -192,8 +193,6 @@ sub serial_startup { init( $::Serial_Ports{$instance}{object}, $port ); ::print_log("[AD2USB] initializing $instance on port $port at $BaudRate baud") if $main::config_parms{debug} eq 'AD2USB'; ::MainLoop_pre_add_hook( sub {AD2USB::check_for_data($instance, 'serial');}, 1 ) if $main::Serial_Ports{"$instance"}{object}; - $::Year_Month_Now = &::time_date_stamp( 10, time ); # Not yet set when we init. - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", " ========= AD2USB.pm Serial Initialized =========" ); } } } @@ -212,8 +211,6 @@ sub server_startup { $Socket_Items{"$instance"}{'socket'}->start; $Socket_Items{"$instance" . '_sender'}{'socket'}->start; &::MainLoop_pre_add_hook( sub {AD2USB::check_for_data($instance, 'tcp');}, 1 ); - $::Year_Month_Now = &::time_date_stamp( 10, time ); # Not yet set when we init. - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", " ========= AD2USB.pm Socket Initialized =========" ); } #}}} @@ -240,7 +237,7 @@ sub check_for_data { # restart the TCP connection if its lost. if ($Socket_Items{$instance}{recon_timer}->inactive) { &main::print_log("Connection to $instance instance of AD2USB was lost, I will try to reconnect in $$self{reconnect_time} seconds"); - # ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "AD2USB.pm ser2sock connection lost! Trying to reconnect." ); + # ::logit( $self{log_file}, "AD2USB.pm ser2sock connection lost! Trying to reconnect." ); $Socket_Items{$instance}{recon_timer}->set($$self{reconnect_time}, sub { $Socket_Items{$instance}{'socket'}->start; }); @@ -268,13 +265,13 @@ sub check_for_data { if ($status_type->{keypad} && $Cmd eq $self->{last_cmd} && (!$status_type->{fault})) { # This is a duplicate panel message with no important status - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "DUPE: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $self{log_file}, "DUPE: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); } else { # This is a non-dupe panel message or a fault panel message or a # relay or RF or zone expander message or something important # Log the message, parse it, and store it to detect future dupes - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "MSG: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $self{log_file}, "MSG: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); $self->CheckCmd($Cmd); ResetAdemcoState(); $self->{last_cmd} = $Cmd if ($status_type->{keypad}); @@ -297,15 +294,15 @@ sub CheckCmd { my $zone_no_pad = int($zone_padded); if ($status_type->{unknown}) { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "UNKNOWN STATUS: $CmdStr" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $self{log_file}, "UNKNOWN STATUS: $CmdStr" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } elsif ($status_type->{cmd_sent}) { if ($self->{keys_sent} == 0) { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key sent from ANOTHER panel." ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $self{log_file}, "Key sent from ANOTHER panel." ) unless ($main::config_parms{AD2USB_debug_log} == 0); } else { $self->{keys_sent}--; - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Key received ($self->{keys_sent} left)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $self{log_file}, "Key received ($self->{keys_sent} left)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } } elsif ($status_type->{fault_avail}) { @@ -314,14 +311,15 @@ sub CheckCmd { } elsif ($status_type->{fault}) { my $PartNum = "1"; - my $ZoneName = $main::config_parms{"AD2USB_zone_${zone_padded}"} if exists $main::config_parms{"AD2USB_zone_${zone_padded}"}; + my $ZoneName = $main::config_parms{"AD2USB_zone_${zone_padded}"} + if exists $main::config_parms{"AD2USB_zone_${zone_padded}"}; # Each fault message tells us two things, 1) this zone is faulted and # 2) all zones between this zone and the last fault are ready. if (MappedZones($zone_padded)) { #Why do we not reset mapped zones? Don't they appear in the fault loop #too? - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Zone $zone_no_pad is mapped to a Relay, RF ID, or expander, skipping normal monitoring!") } + ::logit( $self{log_file}, "Zone $zone_no_pad is mapped to a Relay, RF ID, or expander, skipping normal monitoring!") } else { #Reset the zones between the current zone and the last zone. If zones #are sequential do nothing, if same zone, reset all other zones @@ -356,12 +354,12 @@ sub CheckCmd { ChangePartitions( int($PartNum), int($PartNum), "not ready", 1); } elsif ($status_type->{wireless}) { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "WIRELESS: rf_id(" + ::logit( $self{log_file}, "WIRELESS: rf_id(" .$status_type->{rf_id}.") status(".$status_type->{rf_status}.") loop1(" .$status_type->{rf_loop_fault_1}.") loop2(".$status_type->{rf_loop_fault_2} .") loop3(".$status_type->{rf_loop_fault_3}.") loop4(" .$status_type->{rf_loop_fault_4}.")" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "WIRELESS: rf_id(" + ::logit( $self{log_file}, "WIRELESS: rf_id(" .$status_type->{rf_id}.") status(".$status_type->{rf_status}.") low_batt(" .$status_type->{rf_low_batt}.") supervised(".$status_type->{rf_supervised} .")" ) unless ($main::config_parms{AD2USB_debug_log} == 0); @@ -419,7 +417,7 @@ sub CheckCmd { my $input_id = $status_type->{exp_channel}; my $status = $status_type->{exp_status}; - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "EXPANDER: exp_id($exp_id) input($input_id) status($status)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $self{log_file}, "EXPANDER: exp_id($exp_id) input($input_id) status($status)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); if (exists $main::config_parms{"AD2USB_expander_$exp_id$input_id"}) { my $ZoneNum = $main::config_parms{"AD2USB_expander_$exp_id$input_id"}; @@ -446,7 +444,7 @@ sub CheckCmd { my $rel_input_id = $status_type->{rel_channel}; my $rel_status = $status_type->{rel_status}; - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "RELAY: rel_id($rel_id) input($rel_input_id) status($rel_status)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $self{log_file}, "RELAY: rel_id($rel_id) input($rel_input_id) status($rel_status)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); if (exists $main::config_parms{"AD2USB_relay_$rel_id$rel_input_id"}) { # Assign zone @@ -558,13 +556,13 @@ sub CheckCmd { # BACKLIGHT if ( $status_type->{backlight_flag}) { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel backlight is on" ) + ::logit( $self{log_file}, "Panel backlight is on" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } # PROGRAMMING MODE if ( $status_type->{programming_flag}) { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel is in programming mode" ) + ::logit( $self{log_file}, "Panel is in programming mode" ) unless ($main::config_parms{AD2USB_debug_log} == 0); # Reset state for fault checks @@ -576,7 +574,7 @@ sub CheckCmd { # BEEPS if ( $status_type->{beep_count}) { my $NumBeeps = $status_type->{beep_count}; - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel beeped $NumBeeps times" ) + ::logit( $self{log_file}, "Panel beeped $NumBeeps times" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } @@ -604,19 +602,19 @@ sub CheckCmd { $$self{ac_power} = 1; if ( !$status_type->{ac_flag} ) { $$self{ac_power} = 0; - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "AC Power has been lost" ); + ::logit( $self{log_file}, "AC Power has been lost" ); } # CHIME MODE $self->{chime} = 0; if ( $status_type->{chime_flag}) { - $self->{chime} = 1;# ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Chime is off" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + $self->{chime} = 1;# ::logit( $self{log_file}, "Chime is off" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } # ALARM WAS TRIGGERED (Sticky until disarm) if ( $status_type->{alarm_past_flag}) { my $EventName = "ALARM WAS TRIGGERED"; - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName" ) unless ($main::config_parms{AD2USB_part_log} == 0); + ::logit( $self{log_file}, "$EventName" ) unless ($main::config_parms{AD2USB_part_log} == 0); } # ALARM IS SOUNDING @@ -629,7 +627,7 @@ sub CheckCmd { if exists $main::config_parms{"AD2USB_zone_$zone_padded"}; $PartName = $main::config_parms{"AD2USB_part_$PartName"} if exists $main::config_parms{"AD2USB_part_$PartName"}; - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "$EventName - Zone $zone_no_pad ($ZoneName)" ) + ::logit( $self{log_file}, "$EventName - Zone $zone_no_pad ($ZoneName)" ) unless ($main::config_parms{AD2USB_part_log} == 0); ChangeZones( $zone_no_pad, $zone_no_pad, "alarm", "", 1); $self->{zone_now_msg} = $status_type->{alphanumeric}; @@ -645,7 +643,7 @@ sub CheckCmd { $self->{battery_low} = 0; if ( $status_type->{battery_low_flag}) { $self->{battery_low} = 1; - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Panel is low on battery" ); + ::logit( $self{log_file}, "Panel is low on battery" ); } } return; @@ -676,15 +674,15 @@ sub GetStatusType { # Determine the Message Type if ( $message{alphanumeric} =~ m/^FAULT/) { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Fault zones available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $self{log_file}, "Fault zones available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); $message{fault} = 1; } elsif ( $message{alphanumeric} =~ m/^BYPAS/ ) { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Bypass zones available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $self{log_file}, "Bypass zones available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); $message{bypass} = 1; } elsif ($message{alphanumeric} =~ m/Hit \*|Press \*/) { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Faults available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $self{log_file}, "Faults available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); $message{fault_avail} = 1; } else { @@ -692,7 +690,7 @@ sub GetStatusType { } } elsif ($AdemcoStr =~ /!RFX:(\d{7}),(\d{2})/) { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Wireless status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $self{log_file}, "Wireless status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); $message{wireless} = 1; $message{rf_id} = $1; $message{rf_status} = $2; @@ -709,21 +707,21 @@ sub GetStatusType { } elsif ($AdemcoStr =~ /!EXP:(\d{2}),(\d{2}),(\d{2})/) { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Expander status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $self{log_file}, "Expander status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); $message{expander} = 1; $message{exp_address} = $1; $message{exp_channel} = $2; $message{exp_status} = $3; } elsif ($AdemcoStr =~ /!REL:(\d{2}),(\d{2}),(\d{2})/) { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Relay status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $self{log_file}, "Relay status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); $message{relay} = 1; $message{rel_address} = $1; $message{rel_channel} = $2; $message{rel_status} = $3; } elsif ($AdemcoStr =~ /!Sending\.\.\.done/) { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Command sent successfully.") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $self{log_file}, "Command sent successfully.") unless ($main::config_parms{AD2USB_debug_log} == 0); $message{cmd_sent} = 1; } else { @@ -748,7 +746,7 @@ sub ChangeZones { my $ZoneNumPadded = sprintf("%03d", $i); my $ZoneName = "Unknown"; $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNumPadded"} if exists $main::config_parms{"AD2USB_zone_$ZoneNumPadded"}; - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Zone $i ($ZoneName) changed from '$current_status' to '$new_status'" ) unless ($main::config_parms{AD2USB_zone_log} == 0); + ::logit( $self{log_file}, "Zone $i ($ZoneName) changed from '$current_status' to '$new_status'" ) unless ($main::config_parms{AD2USB_zone_log} == 0); } $self->{zone_status}{"$i"} = $new_status; # Set child object status if it is registered to the zone @@ -769,7 +767,7 @@ sub ChangePartitions { if ($current_status ne $new_status) { if (($main::config_parms{AD2USB_part_log} != 0) && ($log == 1)) { my $PartName = $main::config_parms{"AD2USB_part_$i"} if exists $main::config_parms{"AD2USB_part_$i"}; - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Partition $i ($PartName) changed from '$current_status' to '$new_status'" ) unless ($main::config_parms{AD2USB_part_log} == 0); + ::logit( $self{log_file}, "Partition $i ($PartName) changed from '$current_status' to '$new_status'" ) unless ($main::config_parms{AD2USB_part_log} == 0); } $self->{partition_status}{"$i"} = $new_status; } @@ -900,17 +898,17 @@ sub cmd { # Exit if unknown command if ( $CmdName =~ /^unknown/ ) { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Invalid ADEMCO panel command : $CmdName ($cmd)"); + ::logit( $self{log_file}, "Invalid ADEMCO panel command : $CmdName ($cmd)"); return; } # Exit if password is wrong if ( ($password ne $::config_parms{AD2USB_user_master_code}) && ($CmdName ne "ShowFaults" ) ) { - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", "Invalid password for command $CmdName ($password)"); + ::logit( $self{log_file}, "Invalid password for command $CmdName ($password)"); return; } - ::logit( "$main::config_parms{data_dir}/logs/AD2USB.$main::Year_Month_Now.log", ">>> Sending to ADEMCO panel $CmdName ($cmd)" ) unless ($main::config_parms{$instance . '_debug_log'} == 0); + ::logit( $self{log_file}, ">>> Sending to ADEMCO panel $CmdName ($cmd)" ) unless ($main::config_parms{$instance . '_debug_log'} == 0); $self->{keys_sent} = $self->{keys_sent} + length($CmdStr); if (defined $Socket_Items{$instance}) { if ($Socket_Items{$instance . '_sender'}{'socket'}->active) { From 6e27e87f3153a81a0d8af30761088ea551ecd026 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 11 Jan 2014 19:29:50 -0800 Subject: [PATCH 034/180] AD2: Make ResetAdemco OOP --- lib/AD2USB.pm | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index bb816fb0b..3e45fc071 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -273,7 +273,7 @@ sub check_for_data { # Log the message, parse it, and store it to detect future dupes ::logit( $self{log_file}, "MSG: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); $self->CheckCmd($Cmd); - ResetAdemcoState(); + $self->ResetAdemcoState(); $self->{last_cmd} = $Cmd if ($status_type->{keypad}); } } @@ -777,8 +777,7 @@ sub ChangePartitions { #}}} # Reset Ademco state to simulate a "now" on some value ie: zone, temp etc. {{{ sub ResetAdemcoState { - - my $self = $Self; + my ($self) = @_; # store faults (fault and bypass) for next message parsing if (($self->{zone_now_status} eq "fault") || ($self->{zone_now_status} eq "bypass")) { $self->{zone_last_status} = $self->{zone_now_status}; From 979d6fbef881728c5a4175dbc9ffeed26314ec02 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 11 Jan 2014 19:30:43 -0800 Subject: [PATCH 035/180] AD2: Reset All Zones, Even Those That are Mapped Not clear to me why we don't reset mapped zones. If it is necessary, we should be adding something to ChangeZones, not burying it all over the place. --- lib/AD2USB.pm | 31 ++++++++++++------------------- 1 file changed, 12 insertions(+), 19 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 3e45fc071..d27a8e001 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -311,29 +311,22 @@ sub CheckCmd { } elsif ($status_type->{fault}) { my $PartNum = "1"; - my $ZoneName = $main::config_parms{"AD2USB_zone_${zone_padded}"} - if exists $main::config_parms{"AD2USB_zone_${zone_padded}"}; + my $ZoneName = $main::config_parms{"AD2USB_zone_${zone_padded}"}; # Each fault message tells us two things, 1) this zone is faulted and # 2) all zones between this zone and the last fault are ready. - if (MappedZones($zone_padded)) { - #Why do we not reset mapped zones? Don't they appear in the fault loop - #too? - ::logit( $self{log_file}, "Zone $zone_no_pad is mapped to a Relay, RF ID, or expander, skipping normal monitoring!") } - else { - #Reset the zones between the current zone and the last zone. If zones - #are sequential do nothing, if same zone, reset all other zones - if ($self->{zone_last_num} - $zone_no_pad > 1 - || $self->{zone_last_num} - $zone_no_pad == 0) { - ChangeZones( $self->{zone_last_num}+1, $zone_no_pad-1, "ready", "bypass", 1); - } + + #Reset the zones between the current zone and the last zone. If zones + #are sequential do nothing, if same zone, reset all other zones + if ($self->{zone_last_num} - $zone_no_pad > 1 + || $self->{zone_last_num} - $zone_no_pad == 0) { + ChangeZones( $self->{zone_last_num}+1, $zone_no_pad-1, "ready", "bypass", 1); + } - $self->{zone_now_msg} = $status_type->{alphanumeric}; - $self->{zone_now_status} = "fault"; - $self->{zone_now_name} = $ZoneName; - $self->{zone_now_num} = $zone_no_pad; - ChangeZones( $zone_no_pad, $zone_no_pad, "fault", "", 1); - } #End MappedZones + $self->{zone_now_status} = "fault"; + $self->{zone_now_name} = $ZoneName; + $self->{zone_now_num} = $zone_no_pad; + ChangeZones( $zone_no_pad, $zone_no_pad, "fault", "", 1); $self->{partition_now_msg} = $status_type->{alphanumeric}; $self->{partition_now_status} = "not ready"; $self->{partition_now_num} = $PartNum; From 948f33564fc36e8981ce6d2d0067c8feb63f12ca Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 11 Jan 2014 19:31:38 -0800 Subject: [PATCH 036/180] AD2: Remove Zone_Now_Msg, Not Used Anytime it was set, it was being immediately cleared by ResetAdemco --- lib/AD2USB.pm | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index d27a8e001..fa85602ee 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -336,7 +336,6 @@ sub CheckCmd { my $PartNum = "1"; my $ZoneName = $main::config_parms{"AD2USB_zone_${zone_padded}"} if exists $main::config_parms{"AD2USB_zone_${zone_padded}"}; - $self->{zone_now_msg} = $status_type->{alphanumeric}; $self->{zone_now_status} = "bypass"; $self->{zone_now_name} = $ZoneName; $self->{zone_now_num} = $zone_no_pad; @@ -387,14 +386,12 @@ sub CheckCmd { $ZoneStatus = "ready"; } - $self->{zone_now_msg} = "$CmdStr"; $self->{zone_now_status} = "$ZoneStatus"; $self->{zone_now_name} = "$ZoneName"; $self->{zone_now_num} = "$ZoneNum"; ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); if ($sensortype eq "k") { $ZoneStatus = "ready"; - $self->{zone_now_msg} = "$CmdStr"; $self->{zone_now_status} = "$ZoneStatus"; $self->{zone_now_name} = "$ZoneName"; $self->{zone_now_num} = "$ZoneNum"; @@ -425,7 +422,6 @@ sub CheckCmd { $PartStatus = "not ready"; } - $self->{zone_now_msg} = $status_type->{alphanumeric}; $self->{zone_now_status} = "$ZoneStatus"; $self->{zone_now_name} = "$ZoneName"; $self->{zone_now_num} = "$ZoneNum"; @@ -453,7 +449,6 @@ sub CheckCmd { $PartStatus = "not ready"; } - $self->{zone_now_msg} = "$CmdStr"; $self->{zone_now_status} = "$ZoneStatus"; $self->{zone_now_name} = "$ZoneName"; $self->{zone_now_num} = "$ZoneNum"; @@ -623,7 +618,6 @@ sub CheckCmd { ::logit( $self{log_file}, "$EventName - Zone $zone_no_pad ($ZoneName)" ) unless ($main::config_parms{AD2USB_part_log} == 0); ChangeZones( $zone_no_pad, $zone_no_pad, "alarm", "", 1); - $self->{zone_now_msg} = $status_type->{alphanumeric}; $self->{zone_now_status} = "alarm"; $self->{zone_now_num} = $zone_no_pad; $self->{partition_now_msg} = $status_type->{alphanumeric}; @@ -782,13 +776,11 @@ sub ResetAdemcoState { if ( defined $self->{zone_now_num} ) { my $ZoneNum = $self->{zone_now_num}; $self->{zone_num}{$ZoneNum} = $self->{zone_now_num}; - $self->{zone_msg}{$ZoneNum} = $self->{zone_now_msg}; $self->{zone_status}{$ZoneNum} = $self->{zone_now_status}; $self->{zone_time}{$ZoneNum} = &::time_date_stamp( 17, time ); undef $self->{zone_now_num}; undef $self->{zone_now_name}; undef $self->{zone_now_status}; - undef $self->{zone_now_msg}; } # reset partition @@ -929,10 +921,6 @@ sub zone_now { return $_[0]->{zone_now_name} if defined $_[0]->{zone_now_name}; } -sub zone_msg { - return $_[0]->{zone_now_msg} if defined $_[0]->{zone_now_msg}; -} - sub zone_now_restore { return $_[0]->{zone_now_restore} if defined $_[0]->{zone_now_restore}; } From 460bd94be904dddc80e5804af4562158c0b8bda9 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 11 Jan 2014 19:42:58 -0800 Subject: [PATCH 037/180] AD2: Remove Zone_(Now|Last)_Name as Not Used These were always reset by ResetAdemco or not ever used --- lib/AD2USB.pm | 17 ----------------- 1 file changed, 17 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index fa85602ee..fff5b55b9 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -324,7 +324,6 @@ sub CheckCmd { } $self->{zone_now_status} = "fault"; - $self->{zone_now_name} = $ZoneName; $self->{zone_now_num} = $zone_no_pad; ChangeZones( $zone_no_pad, $zone_no_pad, "fault", "", 1); $self->{partition_now_msg} = $status_type->{alphanumeric}; @@ -337,7 +336,6 @@ sub CheckCmd { my $ZoneName = $main::config_parms{"AD2USB_zone_${zone_padded}"} if exists $main::config_parms{"AD2USB_zone_${zone_padded}"}; $self->{zone_now_status} = "bypass"; - $self->{zone_now_name} = $ZoneName; $self->{zone_now_num} = $zone_no_pad; ChangeZones( $zone_no_pad, $zone_no_pad, "bypass", "", 1); $self->{partition_now_msg} = $status_type->{alphanumeric}; @@ -387,13 +385,11 @@ sub CheckCmd { } $self->{zone_now_status} = "$ZoneStatus"; - $self->{zone_now_name} = "$ZoneName"; $self->{zone_now_num} = "$ZoneNum"; ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); if ($sensortype eq "k") { $ZoneStatus = "ready"; $self->{zone_now_status} = "$ZoneStatus"; - $self->{zone_now_name} = "$ZoneName"; $self->{zone_now_num} = "$ZoneNum"; ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); } @@ -423,7 +419,6 @@ sub CheckCmd { } $self->{zone_now_status} = "$ZoneStatus"; - $self->{zone_now_name} = "$ZoneName"; $self->{zone_now_num} = "$ZoneNum"; ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); } @@ -450,7 +445,6 @@ sub CheckCmd { } $self->{zone_now_status} = "$ZoneStatus"; - $self->{zone_now_name} = "$ZoneName"; $self->{zone_now_num} = "$ZoneNum"; ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); # if (($self->{partition_status}{int($PartNum)}) eq "ready") { #only change the partition status if the current status is "ready". We dont change if the system is armed. @@ -489,7 +483,6 @@ sub CheckCmd { # Reset state for fault checks $self->{zone_last_status} = ""; $self->{zone_last_num} = ""; - $self->{zone_last_name} = ""; } # ARMED AWAY @@ -521,7 +514,6 @@ sub CheckCmd { # Reset state for fault checks $self->{zone_last_status} = ""; $self->{zone_last_num} = ""; - $self->{zone_last_name} = ""; } # ARMED HOME @@ -539,7 +531,6 @@ sub CheckCmd { # Reset state for fault checks $self->{zone_last_status} = ""; $self->{zone_last_num} = ""; - $self->{zone_last_name} = ""; } # BACKLIGHT @@ -556,7 +547,6 @@ sub CheckCmd { # Reset state for fault checks $self->{zone_last_status} = ""; $self->{zone_last_num} = ""; - $self->{zone_last_name} = ""; } # BEEPS @@ -583,7 +573,6 @@ sub CheckCmd { # Reset state for fault checks $self->{zone_last_status} = ""; $self->{zone_last_num} = ""; - $self->{zone_last_name} = ""; } # AC POWER @@ -769,7 +758,6 @@ sub ResetAdemcoState { if (($self->{zone_now_status} eq "fault") || ($self->{zone_now_status} eq "bypass")) { $self->{zone_last_status} = $self->{zone_now_status}; $self->{zone_last_num} = $self->{zone_now_num}; - $self->{zone_last_name} = $self->{zone_now_name}; } # reset zone @@ -779,7 +767,6 @@ sub ResetAdemcoState { $self->{zone_status}{$ZoneNum} = $self->{zone_now_status}; $self->{zone_time}{$ZoneNum} = &::time_date_stamp( 17, time ); undef $self->{zone_now_num}; - undef $self->{zone_now_name}; undef $self->{zone_now_status}; } @@ -917,10 +904,6 @@ sub cmd { #}}} # user call from MH {{{ -sub zone_now { - return $_[0]->{zone_now_name} if defined $_[0]->{zone_now_name}; -} - sub zone_now_restore { return $_[0]->{zone_now_restore} if defined $_[0]->{zone_now_restore}; } From 32aa1c7146b63f68beef85fc8ef7d2ac4318fa11 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 11 Jan 2014 20:01:12 -0800 Subject: [PATCH 038/180] AD2: Remove Zone_(Now|Last)_Status, Remove Zone_Now_Num, Cut Back Zone_Last_Num First three served no purpose. Zone_Last_Num is used only to keep track of state in fault loop. --- lib/AD2USB.pm | 71 +++++++-------------------------------------------- 1 file changed, 9 insertions(+), 62 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index fff5b55b9..258f820bc 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -323,8 +323,7 @@ sub CheckCmd { ChangeZones( $self->{zone_last_num}+1, $zone_no_pad-1, "ready", "bypass", 1); } - $self->{zone_now_status} = "fault"; - $self->{zone_now_num} = $zone_no_pad; + $self->{zone_last_num} = $zone_no_pad; ChangeZones( $zone_no_pad, $zone_no_pad, "fault", "", 1); $self->{partition_now_msg} = $status_type->{alphanumeric}; $self->{partition_now_status} = "not ready"; @@ -334,9 +333,7 @@ sub CheckCmd { elsif ($status_type->{bypass}) { my $PartNum = "1"; my $ZoneName = $main::config_parms{"AD2USB_zone_${zone_padded}"} if exists $main::config_parms{"AD2USB_zone_${zone_padded}"}; - - $self->{zone_now_status} = "bypass"; - $self->{zone_now_num} = $zone_no_pad; + ChangeZones( $zone_no_pad, $zone_no_pad, "bypass", "", 1); $self->{partition_now_msg} = $status_type->{alphanumeric}; $self->{partition_now_status} = "not ready"; @@ -383,14 +380,10 @@ sub CheckCmd { } elsif ("$MZoneLoop" eq 0) { $ZoneStatus = "ready"; } - - $self->{zone_now_status} = "$ZoneStatus"; - $self->{zone_now_num} = "$ZoneNum"; + ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); if ($sensortype eq "k") { $ZoneStatus = "ready"; - $self->{zone_now_status} = "$ZoneStatus"; - $self->{zone_now_num} = "$ZoneNum"; ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); } } @@ -418,8 +411,6 @@ sub CheckCmd { $PartStatus = "not ready"; } - $self->{zone_now_status} = "$ZoneStatus"; - $self->{zone_now_num} = "$ZoneNum"; ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); } } @@ -444,8 +435,6 @@ sub CheckCmd { $PartStatus = "not ready"; } - $self->{zone_now_status} = "$ZoneStatus"; - $self->{zone_now_num} = "$ZoneNum"; ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); # if (($self->{partition_status}{int($PartNum)}) eq "ready") { #only change the partition status if the current status is "ready". We dont change if the system is armed. # if ($PartStatus ne "") { @@ -461,6 +450,12 @@ sub CheckCmd { # NORMAL STATUS TYPE # ALWAYS Check Bits in Keypad Message if ($status_type->{keypad}) { + # If this was not a fault message then clear log of last fault msg + # TODO This may need to be adjusted if there are some message types that + # can be received while a zone is faulted. Perhaps bypass messages or + # maybed armed messages? + $self->{zone_last_num} = ""; + # Set things based on Bit Codes # READY @@ -479,10 +474,6 @@ sub CheckCmd { ChangePartitions( $PartNum, $PartNum, "ready", 1); $self->{zone_lowest_fault} = 999; $self->{zone_highest_fault} = -1; - - # Reset state for fault checks - $self->{zone_last_status} = ""; - $self->{zone_last_num} = ""; } # ARMED AWAY @@ -510,10 +501,6 @@ sub CheckCmd { $self->{partition_now_status} = "$mode"; $self->{partition_now_num} = "$PartNum"; ChangePartitions( int($PartNum), int($PartNum), "$mode", 1); - - # Reset state for fault checks - $self->{zone_last_status} = ""; - $self->{zone_last_num} = ""; } # ARMED HOME @@ -527,10 +514,6 @@ sub CheckCmd { $self->{partition_now_status} = "$mode"; $self->{partition_now_num} = "$PartNum"; ChangePartitions( int($PartNum), int($PartNum), "$mode", 1); - - # Reset state for fault checks - $self->{zone_last_status} = ""; - $self->{zone_last_num} = ""; } # BACKLIGHT @@ -543,10 +526,6 @@ sub CheckCmd { if ( $status_type->{programming_flag}) { ::logit( $self{log_file}, "Panel is in programming mode" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - - # Reset state for fault checks - $self->{zone_last_status} = ""; - $self->{zone_last_num} = ""; } # BEEPS @@ -558,21 +537,6 @@ sub CheckCmd { # A ZONE OR ZONES ARE BYPASSED if ( $status_type->{bypassed_flag}) { - - # Reset zones to ready that haven't appeared in the bypass loop -# if ($self->{zone_last_status} eq "bypass") { -# if (int($fault) < int($self->{zone_now_num})) { -# $start = int($self->{zone_now_num}) + 1; -# $end = 12; -# } -# ChangeZones( $start, $end - 1, "ready", "", 1); -# $self->{zone_now_status} = ""; -# $self->{zone_now_num} = "0"; -# } - - # Reset state for fault checks - $self->{zone_last_status} = ""; - $self->{zone_last_num} = ""; } # AC POWER @@ -607,8 +571,6 @@ sub CheckCmd { ::logit( $self{log_file}, "$EventName - Zone $zone_no_pad ($ZoneName)" ) unless ($main::config_parms{AD2USB_part_log} == 0); ChangeZones( $zone_no_pad, $zone_no_pad, "alarm", "", 1); - $self->{zone_now_status} = "alarm"; - $self->{zone_now_num} = $zone_no_pad; $self->{partition_now_msg} = $status_type->{alphanumeric}; $self->{partition_now_status} = "alarm"; $self->{partition_now_num} = $PartNum; @@ -754,21 +716,6 @@ sub ChangePartitions { # Reset Ademco state to simulate a "now" on some value ie: zone, temp etc. {{{ sub ResetAdemcoState { my ($self) = @_; - # store faults (fault and bypass) for next message parsing - if (($self->{zone_now_status} eq "fault") || ($self->{zone_now_status} eq "bypass")) { - $self->{zone_last_status} = $self->{zone_now_status}; - $self->{zone_last_num} = $self->{zone_now_num}; - } - - # reset zone - if ( defined $self->{zone_now_num} ) { - my $ZoneNum = $self->{zone_now_num}; - $self->{zone_num}{$ZoneNum} = $self->{zone_now_num}; - $self->{zone_status}{$ZoneNum} = $self->{zone_now_status}; - $self->{zone_time}{$ZoneNum} = &::time_date_stamp( 17, time ); - undef $self->{zone_now_num}; - undef $self->{zone_now_status}; - } # reset partition if ( defined $self->{partition_now_num} ) { From ca1ed242bcfd2041a55ba044a45086c7db96aa78 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 11 Jan 2014 20:08:14 -0800 Subject: [PATCH 039/180] AD2: Fix Typos in Log Changes --- lib/AD2USB.pm | 62 +++++++++++++++++++++++++-------------------------- 1 file changed, 31 insertions(+), 31 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 258f820bc..3bc196677 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -124,7 +124,7 @@ sub new { $$self{instance} = $instance; $$self{reconnect_time} = $::config_parms{'AD2USB_ser2sock_recon'}; $$self{reconnect_time} = 10 if !defined($$self{reconnect_time}); - $$self{log_file} = "$::config_parms{data_dir}/logs/AD2USB.$::Year_Month_Now.log" + $$self{log_file} = "$::config_parms{data_dir}/logs/AD2USB.$::Year_Month_Now.log"; bless $self, $class; @@ -237,7 +237,7 @@ sub check_for_data { # restart the TCP connection if its lost. if ($Socket_Items{$instance}{recon_timer}->inactive) { &main::print_log("Connection to $instance instance of AD2USB was lost, I will try to reconnect in $$self{reconnect_time} seconds"); - # ::logit( $self{log_file}, "AD2USB.pm ser2sock connection lost! Trying to reconnect." ); + # ::logit( $$self{log_file}, "AD2USB.pm ser2sock connection lost! Trying to reconnect." ); $Socket_Items{$instance}{recon_timer}->set($$self{reconnect_time}, sub { $Socket_Items{$instance}{'socket'}->start; }); @@ -265,13 +265,13 @@ sub check_for_data { if ($status_type->{keypad} && $Cmd eq $self->{last_cmd} && (!$status_type->{fault})) { # This is a duplicate panel message with no important status - ::logit( $self{log_file}, "DUPE: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "DUPE: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); } else { # This is a non-dupe panel message or a fault panel message or a # relay or RF or zone expander message or something important # Log the message, parse it, and store it to detect future dupes - ::logit( $self{log_file}, "MSG: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "MSG: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); $self->CheckCmd($Cmd); $self->ResetAdemcoState(); $self->{last_cmd} = $Cmd if ($status_type->{keypad}); @@ -294,15 +294,15 @@ sub CheckCmd { my $zone_no_pad = int($zone_padded); if ($status_type->{unknown}) { - ::logit( $self{log_file}, "UNKNOWN STATUS: $CmdStr" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "UNKNOWN STATUS: $CmdStr" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } elsif ($status_type->{cmd_sent}) { if ($self->{keys_sent} == 0) { - ::logit( $self{log_file}, "Key sent from ANOTHER panel." ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "Key sent from ANOTHER panel." ) unless ($main::config_parms{AD2USB_debug_log} == 0); } else { $self->{keys_sent}--; - ::logit( $self{log_file}, "Key received ($self->{keys_sent} left)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "Key received ($self->{keys_sent} left)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } } elsif ($status_type->{fault_avail}) { @@ -341,12 +341,12 @@ sub CheckCmd { ChangePartitions( int($PartNum), int($PartNum), "not ready", 1); } elsif ($status_type->{wireless}) { - ::logit( $self{log_file}, "WIRELESS: rf_id(" + ::logit( $$self{log_file}, "WIRELESS: rf_id(" .$status_type->{rf_id}.") status(".$status_type->{rf_status}.") loop1(" .$status_type->{rf_loop_fault_1}.") loop2(".$status_type->{rf_loop_fault_2} .") loop3(".$status_type->{rf_loop_fault_3}.") loop4(" .$status_type->{rf_loop_fault_4}.")" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - ::logit( $self{log_file}, "WIRELESS: rf_id(" + ::logit( $$self{log_file}, "WIRELESS: rf_id(" .$status_type->{rf_id}.") status(".$status_type->{rf_status}.") low_batt(" .$status_type->{rf_low_batt}.") supervised(".$status_type->{rf_supervised} .")" ) unless ($main::config_parms{AD2USB_debug_log} == 0); @@ -396,7 +396,7 @@ sub CheckCmd { my $input_id = $status_type->{exp_channel}; my $status = $status_type->{exp_status}; - ::logit( $self{log_file}, "EXPANDER: exp_id($exp_id) input($input_id) status($status)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "EXPANDER: exp_id($exp_id) input($input_id) status($status)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); if (exists $main::config_parms{"AD2USB_expander_$exp_id$input_id"}) { my $ZoneNum = $main::config_parms{"AD2USB_expander_$exp_id$input_id"}; @@ -419,7 +419,7 @@ sub CheckCmd { my $rel_input_id = $status_type->{rel_channel}; my $rel_status = $status_type->{rel_status}; - ::logit( $self{log_file}, "RELAY: rel_id($rel_id) input($rel_input_id) status($rel_status)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "RELAY: rel_id($rel_id) input($rel_input_id) status($rel_status)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); if (exists $main::config_parms{"AD2USB_relay_$rel_id$rel_input_id"}) { # Assign zone @@ -518,20 +518,20 @@ sub CheckCmd { # BACKLIGHT if ( $status_type->{backlight_flag}) { - ::logit( $self{log_file}, "Panel backlight is on" ) + ::logit( $$self{log_file}, "Panel backlight is on" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } # PROGRAMMING MODE if ( $status_type->{programming_flag}) { - ::logit( $self{log_file}, "Panel is in programming mode" ) + ::logit( $$self{log_file}, "Panel is in programming mode" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } # BEEPS if ( $status_type->{beep_count}) { my $NumBeeps = $status_type->{beep_count}; - ::logit( $self{log_file}, "Panel beeped $NumBeeps times" ) + ::logit( $$self{log_file}, "Panel beeped $NumBeeps times" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } @@ -543,19 +543,19 @@ sub CheckCmd { $$self{ac_power} = 1; if ( !$status_type->{ac_flag} ) { $$self{ac_power} = 0; - ::logit( $self{log_file}, "AC Power has been lost" ); + ::logit( $$self{log_file}, "AC Power has been lost" ); } # CHIME MODE $self->{chime} = 0; if ( $status_type->{chime_flag}) { - $self->{chime} = 1;# ::logit( $self{log_file}, "Chime is off" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + $self->{chime} = 1;# ::logit( $$self{log_file}, "Chime is off" ) unless ($main::config_parms{AD2USB_debug_log} == 0); } # ALARM WAS TRIGGERED (Sticky until disarm) if ( $status_type->{alarm_past_flag}) { my $EventName = "ALARM WAS TRIGGERED"; - ::logit( $self{log_file}, "$EventName" ) unless ($main::config_parms{AD2USB_part_log} == 0); + ::logit( $$self{log_file}, "$EventName" ) unless ($main::config_parms{AD2USB_part_log} == 0); } # ALARM IS SOUNDING @@ -568,7 +568,7 @@ sub CheckCmd { if exists $main::config_parms{"AD2USB_zone_$zone_padded"}; $PartName = $main::config_parms{"AD2USB_part_$PartName"} if exists $main::config_parms{"AD2USB_part_$PartName"}; - ::logit( $self{log_file}, "$EventName - Zone $zone_no_pad ($ZoneName)" ) + ::logit( $$self{log_file}, "$EventName - Zone $zone_no_pad ($ZoneName)" ) unless ($main::config_parms{AD2USB_part_log} == 0); ChangeZones( $zone_no_pad, $zone_no_pad, "alarm", "", 1); $self->{partition_now_msg} = $status_type->{alphanumeric}; @@ -581,7 +581,7 @@ sub CheckCmd { $self->{battery_low} = 0; if ( $status_type->{battery_low_flag}) { $self->{battery_low} = 1; - ::logit( $self{log_file}, "Panel is low on battery" ); + ::logit( $$self{log_file}, "Panel is low on battery" ); } } return; @@ -612,15 +612,15 @@ sub GetStatusType { # Determine the Message Type if ( $message{alphanumeric} =~ m/^FAULT/) { - ::logit( $self{log_file}, "Fault zones available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "Fault zones available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); $message{fault} = 1; } elsif ( $message{alphanumeric} =~ m/^BYPAS/ ) { - ::logit( $self{log_file}, "Bypass zones available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "Bypass zones available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); $message{bypass} = 1; } elsif ($message{alphanumeric} =~ m/Hit \*|Press \*/) { - ::logit( $self{log_file}, "Faults available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "Faults available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); $message{fault_avail} = 1; } else { @@ -628,7 +628,7 @@ sub GetStatusType { } } elsif ($AdemcoStr =~ /!RFX:(\d{7}),(\d{2})/) { - ::logit( $self{log_file}, "Wireless status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "Wireless status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); $message{wireless} = 1; $message{rf_id} = $1; $message{rf_status} = $2; @@ -645,21 +645,21 @@ sub GetStatusType { } elsif ($AdemcoStr =~ /!EXP:(\d{2}),(\d{2}),(\d{2})/) { - ::logit( $self{log_file}, "Expander status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "Expander status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); $message{expander} = 1; $message{exp_address} = $1; $message{exp_channel} = $2; $message{exp_status} = $3; } elsif ($AdemcoStr =~ /!REL:(\d{2}),(\d{2}),(\d{2})/) { - ::logit( $self{log_file}, "Relay status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "Relay status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); $message{relay} = 1; $message{rel_address} = $1; $message{rel_channel} = $2; $message{rel_status} = $3; } elsif ($AdemcoStr =~ /!Sending\.\.\.done/) { - ::logit( $self{log_file}, "Command sent successfully.") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "Command sent successfully.") unless ($main::config_parms{AD2USB_debug_log} == 0); $message{cmd_sent} = 1; } else { @@ -684,7 +684,7 @@ sub ChangeZones { my $ZoneNumPadded = sprintf("%03d", $i); my $ZoneName = "Unknown"; $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNumPadded"} if exists $main::config_parms{"AD2USB_zone_$ZoneNumPadded"}; - ::logit( $self{log_file}, "Zone $i ($ZoneName) changed from '$current_status' to '$new_status'" ) unless ($main::config_parms{AD2USB_zone_log} == 0); + ::logit( $$self{log_file}, "Zone $i ($ZoneName) changed from '$current_status' to '$new_status'" ) unless ($main::config_parms{AD2USB_zone_log} == 0); } $self->{zone_status}{"$i"} = $new_status; # Set child object status if it is registered to the zone @@ -705,7 +705,7 @@ sub ChangePartitions { if ($current_status ne $new_status) { if (($main::config_parms{AD2USB_part_log} != 0) && ($log == 1)) { my $PartName = $main::config_parms{"AD2USB_part_$i"} if exists $main::config_parms{"AD2USB_part_$i"}; - ::logit( $self{log_file}, "Partition $i ($PartName) changed from '$current_status' to '$new_status'" ) unless ($main::config_parms{AD2USB_part_log} == 0); + ::logit( $$self{log_file}, "Partition $i ($PartName) changed from '$current_status' to '$new_status'" ) unless ($main::config_parms{AD2USB_part_log} == 0); } $self->{partition_status}{"$i"} = $new_status; } @@ -816,17 +816,17 @@ sub cmd { # Exit if unknown command if ( $CmdName =~ /^unknown/ ) { - ::logit( $self{log_file}, "Invalid ADEMCO panel command : $CmdName ($cmd)"); + ::logit( $$self{log_file}, "Invalid ADEMCO panel command : $CmdName ($cmd)"); return; } # Exit if password is wrong if ( ($password ne $::config_parms{AD2USB_user_master_code}) && ($CmdName ne "ShowFaults" ) ) { - ::logit( $self{log_file}, "Invalid password for command $CmdName ($password)"); + ::logit( $$self{log_file}, "Invalid password for command $CmdName ($password)"); return; } - ::logit( $self{log_file}, ">>> Sending to ADEMCO panel $CmdName ($cmd)" ) unless ($main::config_parms{$instance . '_debug_log'} == 0); + ::logit( $$self{log_file}, ">>> Sending to ADEMCO panel $CmdName ($cmd)" ) unless ($main::config_parms{$instance . '_debug_log'} == 0); $self->{keys_sent} = $self->{keys_sent} + length($CmdStr); if (defined $Socket_Items{$instance}) { if ($Socket_Items{$instance . '_sender'}{'socket'}->active) { From 528c9fb4d8558e74b2a72f8da208d09029f5a3ec Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 11 Jan 2014 22:29:43 -0800 Subject: [PATCH 040/180] AD2: Rearange Stuff --- lib/AD2USB.pm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 3bc196677..3e086ffea 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -323,8 +323,11 @@ sub CheckCmd { ChangeZones( $self->{zone_last_num}+1, $zone_no_pad-1, "ready", "bypass", 1); } - $self->{zone_last_num} = $zone_no_pad; + # Set this zone to faulted ChangeZones( $zone_no_pad, $zone_no_pad, "fault", "", 1); + + # Store Zone Number for Use in Fault Loop + $self->{zone_last_num} = $zone_no_pad; $self->{partition_now_msg} = $status_type->{alphanumeric}; $self->{partition_now_status} = "not ready"; $self->{partition_now_num} = $PartNum; From 0cdb1c4324c84c46be77557f003866e364c17e24 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sun, 12 Jan 2014 10:50:33 -0800 Subject: [PATCH 041/180] AD2: Prevent Zones Looping Unless Reverse --- lib/AD2USB.pm | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 3e086ffea..f733d98c4 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -116,7 +116,6 @@ sub new { my $self = new Generic_Item(); # Initialize Variables - $$self{last_cmd} = ''; $$self{ac_power} = 0; $$self{battery_low} = 1; $$self{chime} = 0; @@ -457,7 +456,7 @@ sub CheckCmd { # TODO This may need to be adjusted if there are some message types that # can be received while a zone is faulted. Perhaps bypass messages or # maybed armed messages? - $self->{zone_last_num} = ""; + $self->{zone_last_num} = "" unless $status_type->{fault}; # Set things based on Bit Codes @@ -466,7 +465,6 @@ sub CheckCmd { my $bypass = ($status_type->{bypassed_flag}) ? 'bypass' : ''; # Reset all zones, if bypass enabled skip bypassed zones ChangeZones( 1, 999, "ready", $bypass, 1); - my $PartName = my $PartNum = 1; $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} @@ -693,7 +691,7 @@ sub ChangeZones { # Set child object status if it is registered to the zone $$self{zone_object}{"$i"}->set($new_status, $$self{zone_object}{"$i"}) if defined $$self{zone_object}{"$i"}; } - $i = 0 if $i == 999; #loop around + $i = 0 if ($i == 999 && $reverse); #loop around } } From 28b571429435a30ed15c0aecf2ad0fa021d6471a Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sun, 12 Jan 2014 12:22:26 -0800 Subject: [PATCH 042/180] AD2: Add Zone_Now Function --- lib/AD2USB.pm | 38 +++++++++++++------------------------- 1 file changed, 13 insertions(+), 25 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index f733d98c4..97d3f2547 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -222,6 +222,9 @@ sub check_for_data { my $self = get_object_by_instance($instance); my $NewCmd; + # Clear Zone_Now Function + $self->{zone_now} = (); + # Get the date from serial or tcp source if ($connecttype eq 'serial') { &main::check_for_generic_serial_data($instance); @@ -688,6 +691,8 @@ sub ChangeZones { ::logit( $$self{log_file}, "Zone $i ($ZoneName) changed from '$current_status' to '$new_status'" ) unless ($main::config_parms{AD2USB_zone_log} == 0); } $self->{zone_status}{"$i"} = $new_status; + # Store Change for Zone_Now Function + $self->{zone_now}{"$i"} = 1; # Set child object status if it is registered to the zone $$self{zone_object}{"$i"}->set($new_status, $$self{zone_object}{"$i"}) if defined $$self{zone_object}{"$i"}; } @@ -852,39 +857,22 @@ sub cmd { #}}} # user call from MH {{{ -sub zone_now_restore { - return $_[0]->{zone_now_restore} if defined $_[0]->{zone_now_restore}; -} - -sub zone_now_tamper { - return $_[0]->{zone_now_tamper} if defined $_[0]->{zone_now_tamper}; -} - -sub zone_now_tamper_restore { - return $_[0]->{zone_now_tamper_restore} if defined $_[0]->{zone_now_tamper_restore}; -} - -sub zone_now_alarm { - return $_[0]->{zone_now_alarm} if defined $_[0]->{zone_now_alarm}; -} - -sub zone_now_alarm_restore { - return $_[0]->{zone_now_alarm_restore} if defined $_[0]->{zone_now_alarm_restore}; -} - -sub zone_now_fault { - return $_[0]->{zone_now_num} if defined $_[0]->{zone_now_num}; -} - sub status_zone { my ( $class, $zone ) = @_; return $_[0]->{zone_status}{$zone} if defined $_[0]->{zone_status}{$zone}; } +sub zone_now { + my ( $self, $zone ) = @_; + $zone =~ s/^0*//; + return $self->{zone_now}{$zone}; +} + sub zone_name { my ( $class, $zone_num ) = @_; $zone_num = sprintf "%03s", $zone_num; - my $ZoneName = $main::config_parms{"AD2USB_zone_$zone_num"} if exists $main::config_parms{"AD2USB_zone_$zone_num"}; + my $ZoneName = $main::config_parms{"AD2USB_zone_$zone_num"} + if exists $main::config_parms{"AD2USB_zone_$zone_num"}; return $ZoneName if $ZoneName; return $zone_num; } From 6aa21c305e8c85ebdd914e3e634db71911d4f3fa Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sun, 12 Jan 2014 12:43:04 -0800 Subject: [PATCH 043/180] AD2: Condense Zone_Name Calls into Function --- lib/AD2USB.pm | 29 +++++++---------------------- 1 file changed, 7 insertions(+), 22 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 97d3f2547..063552f80 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -313,7 +313,6 @@ sub CheckCmd { } elsif ($status_type->{fault}) { my $PartNum = "1"; - my $ZoneName = $main::config_parms{"AD2USB_zone_${zone_padded}"}; # Each fault message tells us two things, 1) this zone is faulted and # 2) all zones between this zone and the last fault are ready. @@ -337,7 +336,6 @@ sub CheckCmd { } elsif ($status_type->{bypass}) { my $PartNum = "1"; - my $ZoneName = $main::config_parms{"AD2USB_zone_${zone_padded}"} if exists $main::config_parms{"AD2USB_zone_${zone_padded}"}; ChangeZones( $zone_no_pad, $zone_no_pad, "bypass", "", 1); $self->{partition_now_msg} = $status_type->{alphanumeric}; @@ -357,7 +355,7 @@ sub CheckCmd { .")" ) unless ($main::config_parms{AD2USB_debug_log} == 0); if (exists $main::config_parms{"AD2USB_wireless_".$status_type->{rf_id}}) { - my ($MZoneLoop, $PartStatus, $ZoneNum, $ZoneName); + my ($MZoneLoop, $PartStatus, $ZoneNum); my $lc = 0; my $ZoneStatus = "ready"; @@ -372,9 +370,6 @@ sub CheckCmd { } else { my ($sensortype, $ZoneLoop) = split("", $wnum); - $ZoneName = "Unknown"; - $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; - if ($ZoneLoop eq "1") {$MZoneLoop = $status_type->{rf_loop_fault_1}} if ($ZoneLoop eq "2") {$MZoneLoop = $status_type->{rf_loop_fault_2}} if ($ZoneLoop eq "3") {$MZoneLoop = $status_type->{rf_loop_fault_3}} @@ -405,8 +400,6 @@ sub CheckCmd { if (exists $main::config_parms{"AD2USB_expander_$exp_id$input_id"}) { my $ZoneNum = $main::config_parms{"AD2USB_expander_$exp_id$input_id"}; - my $ZoneName = "Unknown"; - $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; # Assign status (zone and partition) my $ZoneStatus = "ready"; @@ -429,8 +422,6 @@ sub CheckCmd { if (exists $main::config_parms{"AD2USB_relay_$rel_id$rel_input_id"}) { # Assign zone my $ZoneNum = $main::config_parms{"AD2USB_relay_$rel_id$rel_input_id"}; - my $ZoneName = "Unknown"; - $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNum"} if exists $main::config_parms{"AD2USB_zone_$ZoneNum"}; # Assign status (zone and partition) my $ZoneStatus = "ready"; @@ -568,11 +559,10 @@ sub CheckCmd { #TODO: figure out how to get a partition number my $PartName = my $PartNum = 1; - my $ZoneName = $main::config_parms{"AD2USB_zone_$zone_padded"} if exists $main::config_parms{"AD2USB_zone_$zone_padded"}; $PartName = $main::config_parms{"AD2USB_part_$PartName"} if exists $main::config_parms{"AD2USB_part_$PartName"}; - ::logit( $$self{log_file}, "$EventName - Zone $zone_no_pad ($ZoneName)" ) + ::logit( $$self{log_file}, "$EventName - Zone $zone_no_pad (".$self->zone_name($zone_no_pad).")" ) unless ($main::config_parms{AD2USB_part_log} == 0); ChangeZones( $zone_no_pad, $zone_no_pad, "alarm", "", 1); $self->{partition_now_msg} = $status_type->{alphanumeric}; @@ -686,9 +676,9 @@ sub ChangeZones { if (($current_status ne $new_status) && ($current_status ne $neq_status)) { if (($main::config_parms{AD2USB_zone_log} != 0) && ($log == 1)) { my $ZoneNumPadded = sprintf("%03d", $i); - my $ZoneName = "Unknown"; - $ZoneName = $main::config_parms{"AD2USB_zone_$ZoneNumPadded"} if exists $main::config_parms{"AD2USB_zone_$ZoneNumPadded"}; - ::logit( $$self{log_file}, "Zone $i ($ZoneName) changed from '$current_status' to '$new_status'" ) unless ($main::config_parms{AD2USB_zone_log} == 0); + ::logit( $$self{log_file}, "Zone $i (".$self->zone_name($i) + .") changed from '$current_status' to '$new_status'" ) + unless ($main::config_parms{AD2USB_zone_log} == 0); } $self->{zone_status}{"$i"} = $new_status; # Store Change for Zone_Now Function @@ -727,11 +717,9 @@ sub ResetAdemcoState { if ( defined $self->{partition_now_num} ) { my $PartNum = $self->{partition_now_num}; $self->{partition}{$PartNum} = $self->{partition_now_num}; - $self->{partition_msg}{$PartNum} = $self->{partition_now_msg}; $self->{partition_status}{$PartNum} = $self->{partition_now_status}; $self->{partition_time}{$PartNum} = &::time_date_stamp( 17, time ); undef $self->{partition_now_num}; - undef $self->{partition_now_msg}; undef $self->{partition_now_status}; } @@ -869,12 +857,9 @@ sub zone_now { } sub zone_name { - my ( $class, $zone_num ) = @_; + my ( $self, $zone_num ) = @_; $zone_num = sprintf "%03s", $zone_num; - my $ZoneName = $main::config_parms{"AD2USB_zone_$zone_num"} - if exists $main::config_parms{"AD2USB_zone_$zone_num"}; - return $ZoneName if $ZoneName; - return $zone_num; + return $::config_parms{"AD2USB_zone_$zone_num"}; } sub partition_now { From 8db790f5c9502c63712f088550a53a9c4fc9e370 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sun, 12 Jan 2014 15:03:05 -0800 Subject: [PATCH 044/180] AD2: Add Framework for Partitions Not sure how they work exactly, so everything defaults to 1 --- lib/AD2USB.pm | 29 +++++++++++++++++++++++------ 1 file changed, 23 insertions(+), 6 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 063552f80..3a7ec1467 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -294,6 +294,7 @@ sub CheckCmd { my $status_type = $self->GetStatusType($CmdStr); my $zone_padded = $status_type->{numeric_code}; my $zone_no_pad = int($zone_padded); + my $partition = $status_type->{partition}; if ($status_type->{unknown}) { ::logit( $$self{log_file}, "UNKNOWN STATUS: $CmdStr" ) unless ($main::config_parms{AD2USB_debug_log} == 0); @@ -447,9 +448,6 @@ sub CheckCmd { # ALWAYS Check Bits in Keypad Message if ($status_type->{keypad}) { # If this was not a fault message then clear log of last fault msg - # TODO This may need to be adjusted if there are some message types that - # can be received while a zone is faulted. Perhaps bypass messages or - # maybed armed messages? $self->{zone_last_num} = "" unless $status_type->{fault}; # Set things based on Bit Codes @@ -559,7 +557,6 @@ sub CheckCmd { #TODO: figure out how to get a partition number my $PartName = my $PartNum = 1; - if exists $main::config_parms{"AD2USB_zone_$zone_padded"}; $PartName = $main::config_parms{"AD2USB_part_$PartName"} if exists $main::config_parms{"AD2USB_part_$PartName"}; ::logit( $$self{log_file}, "$EventName - Zone $zone_no_pad (".$self->zone_name($zone_no_pad).")" ) @@ -596,6 +593,15 @@ sub GetStatusType { $message{numeric_code} = $3; $message{raw_data} = $4; $message{alphanumeric} = $5; + + # Relevant Partition Data is Apparently Contained in the Raw Data, + # which contains a mask identifying the panels that each message is + # destined for. Apparently this can be used to determine the partition + # number. It isn't clear to me how this works, so for the time being + # everything is assumed to be partition 1. + $message{partition} = 1; + + # Decipher and Set Bit Flags my @flags = ('ready_flag', 'armed_away_flag', 'armed_home_flag', 'backlight_flag', 'programming_flag', 'beep_count', 'bypassed_flag', 'ac_flag', 'chime_flag', 'alarm_past_flag', 'alarm_now_flag', 'battery_low_flag', 'no_delay_flag', @@ -665,7 +671,7 @@ sub GetStatusType { #}}} # Change zone statuses for zone indices from start to end {{{ sub ChangeZones { - my ($start, $end, $new_status, $neq_status, $log) = @_; + my ($start, $end, $new_status, $neq_status, $log, $partition) = @_; my $self = $Self; #Kludge # Allow for reverse looping from 999->1 @@ -673,7 +679,9 @@ sub ChangeZones { for (my $i = $start; (!$reverse && $i <= $end) || ($reverse && ($i >= $start || $i <= $end)); $i++) { my $current_status = $self->{zone_status}{"$i"}; - if (($current_status ne $new_status) && ($current_status ne $neq_status)) { + # If partition set, then zone partition must equal that + if (($current_status ne $new_status) && ($current_status ne $neq_status) + && (!$partition || ($partition == $self->zone_partition($i)))) { if (($main::config_parms{AD2USB_zone_log} != 0) && ($log == 1)) { my $ZoneNumPadded = sprintf("%03d", $i); ::logit( $$self{log_file}, "Zone $i (".$self->zone_name($i) @@ -862,6 +870,15 @@ sub zone_name { return $::config_parms{"AD2USB_zone_$zone_num"}; } +sub zone_partition { + my ( $self, $zone_num ) = @_; + $zone_num = sprintf "%03s", $zone_num; + my $partition = $::config_parms{"AD2USB_zone_${zone_num}_partition"}; + # Default to partition 1 + $partition = 1 unless $partition; + return $partition; +} + sub partition_now { my ( $class, $part ) = @_; return $_[0]->{partition_now_num} if defined $_[0]->{partition_now_num}; From 2c3287b0be884476d4c9b74ad012fa981cfbdc5a Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sun, 12 Jan 2014 16:45:43 -0800 Subject: [PATCH 045/180] AD2: Enable Partition_Now and Status_Partition Functions --- lib/AD2USB.pm | 45 ++++++++++++++++++++++++++++++++------------- 1 file changed, 32 insertions(+), 13 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 3a7ec1467..a09fb2e27 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -222,8 +222,9 @@ sub check_for_data { my $self = get_object_by_instance($instance); my $NewCmd; - # Clear Zone_Now Function + # Clear Zone and Partition_Now Function $self->{zone_now} = (); + $self->{partition_now} = (); # Get the date from serial or tcp source if ($connecttype eq 'serial') { @@ -449,6 +450,7 @@ sub CheckCmd { if ($status_type->{keypad}) { # If this was not a fault message then clear log of last fault msg $self->{zone_last_num} = "" unless $status_type->{fault}; + $self->{partition_msg}{$partition} = $status_type->{alphanumeric}; # Set things based on Bit Codes @@ -678,7 +680,7 @@ sub ChangeZones { my $reverse = ($start > $end)? 1 : 0; for (my $i = $start; (!$reverse && $i <= $end) || ($reverse && ($i >= $start || $i <= $end)); $i++) { - my $current_status = $self->{zone_status}{"$i"}; + my $current_status = $$self{$self->zone_partition($i)}{zone_status}{$i}; # If partition set, then zone partition must equal that if (($current_status ne $new_status) && ($current_status ne $neq_status) && (!$partition || ($partition == $self->zone_partition($i)))) { @@ -688,9 +690,11 @@ sub ChangeZones { .") changed from '$current_status' to '$new_status'" ) unless ($main::config_parms{AD2USB_zone_log} == 0); } - $self->{zone_status}{"$i"} = $new_status; + $$self{$self->zone_partition($i)}{zone_status}{$i} = $new_status; # Store Change for Zone_Now Function $self->{zone_now}{"$i"} = 1; + # Store Change for Partition_Now Function + $self->{partition_now}{$partition} = 1; # Set child object status if it is registered to the zone $$self{zone_object}{"$i"}->set($new_status, $$self{zone_object}{"$i"}) if defined $$self{zone_object}{"$i"}; } @@ -854,8 +858,9 @@ sub cmd { # user call from MH {{{ sub status_zone { - my ( $class, $zone ) = @_; - return $_[0]->{zone_status}{$zone} if defined $_[0]->{zone_status}{$zone}; + my ( $self, $zone ) = @_; + $zone =~ s/^0*//; + return $$self{$self->zone_partition($zone)}{zone_status}{$zone}; } sub zone_now { @@ -880,20 +885,34 @@ sub zone_partition { } sub partition_now { - my ( $class, $part ) = @_; - return $_[0]->{partition_now_num} if defined $_[0]->{partition_now_num}; + my ( $self, $part ) = @_; + return $self->{partition_now}{$part}; } -sub partition_now_msg { - my ( $class, $part ) = @_; - return $_[0]->{partition_now_msg} if defined $_[0]->{partition_now_msg}; +sub partition_msg { + my ( $self, $part ) = @_; + return $self->{partition_msg}{part}; } sub partition_name { my ( $class, $part_num ) = @_; - my $PartName = $main::config_parms{"AD2USB_part_$part_num"} if exists $main::config_parms{"AD2USB_part_$part_num"}; - return $PartName if $PartName; - return $part_num; + return $main::config_parms{"AD2USB_part_$part_num"}; +} + +sub status_partition { + my ( $self, $partition ) = @_; + my %partition_zones = %{$$self{$partition}{zone_status}}; + my $partition_status = 'ready'; + for my $zone (keys %partition_zones){ + if ($partition_zones{$zone} eq 'fault'){ + $partition_status = 'fault'; + last; + } + elsif ($partition_zones{$zone} eq 'bypass'){ + $partition_status = 'bypass'; + } + } + return $partition_status; } sub cmd_list { From a0988d76d92b467b55d81189e0109b5482688a27 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sun, 12 Jan 2014 16:53:50 -0800 Subject: [PATCH 046/180] AD2: Get rid of Unnecessary Partition Variables --- lib/AD2USB.pm | 48 ++++++------------------------------------------ 1 file changed, 6 insertions(+), 42 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index a09fb2e27..051488b8e 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -331,19 +331,11 @@ sub CheckCmd { # Store Zone Number for Use in Fault Loop $self->{zone_last_num} = $zone_no_pad; - $self->{partition_now_msg} = $status_type->{alphanumeric}; - $self->{partition_now_status} = "not ready"; - $self->{partition_now_num} = $PartNum; - ChangePartitions( int($PartNum), int($PartNum), "not ready", 1); } elsif ($status_type->{bypass}) { my $PartNum = "1"; ChangeZones( $zone_no_pad, $zone_no_pad, "bypass", "", 1); - $self->{partition_now_msg} = $status_type->{alphanumeric}; - $self->{partition_now_status} = "not ready"; - $self->{partition_now_num} = $PartNum; - ChangePartitions( int($PartNum), int($PartNum), "not ready", 1); } elsif ($status_type->{wireless}) { ::logit( $$self{log_file}, "WIRELESS: rf_id(" @@ -459,16 +451,6 @@ sub CheckCmd { my $bypass = ($status_type->{bypassed_flag}) ? 'bypass' : ''; # Reset all zones, if bypass enabled skip bypassed zones ChangeZones( 1, 999, "ready", $bypass, 1); - my $PartName = my $PartNum = 1; - - $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} - if exists $main::config_parms{"AD2USB_part_${PartNum}"}; - $self->{partition_now_msg} = $status_type->{alphanumeric}; - $self->{partition_now_num} = $PartNum; - $self->{partition_now_status} = "ready"; - ChangePartitions( $PartNum, $PartNum, "ready", 1); - $self->{zone_lowest_fault} = 999; - $self->{zone_highest_fault} = -1; } # ARMED AWAY @@ -492,23 +474,11 @@ sub CheckCmd { } $self->set($mode); - $self->{partition_now_msg} = $status_type->{alphanumeric}; - $self->{partition_now_status} = "$mode"; - $self->{partition_now_num} = "$PartNum"; - ChangePartitions( int($PartNum), int($PartNum), "$mode", 1); } # ARMED HOME if ( $status_type->{armed_home_flag}) { - my $PartNum = my $PartName = 1; - - my $mode = "armed stay"; - $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} - if exists $main::config_parms{"AD2USB_part_${PartNum}"}; - $self->{partition_now_msg} = $status_type->{alphanumeric}; - $self->{partition_now_status} = "$mode"; - $self->{partition_now_num} = "$PartNum"; - ChangePartitions( int($PartNum), int($PartNum), "$mode", 1); + $self->set("armed stay"); } # BACKLIGHT @@ -555,19 +525,9 @@ sub CheckCmd { # ALARM IS SOUNDING if ( $status_type->{alarm_now_flag}) { - my $EventName = "ALARM IS SOUNDING"; - - #TODO: figure out how to get a partition number - my $PartName = my $PartNum = 1; - $PartName = $main::config_parms{"AD2USB_part_$PartName"} - if exists $main::config_parms{"AD2USB_part_$PartName"}; - ::logit( $$self{log_file}, "$EventName - Zone $zone_no_pad (".$self->zone_name($zone_no_pad).")" ) + ::logit( $$self{log_file}, "ALARM IS SOUNDING - Zone $zone_no_pad (".$self->zone_name($zone_no_pad).")" ) unless ($main::config_parms{AD2USB_part_log} == 0); ChangeZones( $zone_no_pad, $zone_no_pad, "alarm", "", 1); - $self->{partition_now_msg} = $status_type->{alphanumeric}; - $self->{partition_now_status} = "alarm"; - $self->{partition_now_num} = $PartNum; - ChangePartitions( int($PartNum), int($PartNum), "alarm", 1); } # BATTERY LOW @@ -908,6 +868,10 @@ sub status_partition { $partition_status = 'fault'; last; } + elsif ($partition_zones{$zone} eq 'alarm'){ + $partition_status = 'alarm'; + last; + } elsif ($partition_zones{$zone} eq 'bypass'){ $partition_status = 'bypass'; } From 172ae32d1192721e59d585d6b01ebf1edab323c0 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 16 Jan 2014 18:05:00 -0800 Subject: [PATCH 047/180] AD2: Create Method to Merge INI and Read Table A Settings Change all calls to config_parms to use this method --- lib/AD2USB.pm | 234 +++++++++++++++++++++----------------------------- 1 file changed, 100 insertions(+), 134 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 051488b8e..855701b31 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -105,6 +105,7 @@ my $Self; #Kludge my %ErrorCode; my %Socket_Items; #Stores the socket instances and attributes my %Interfaces; #Stores the relationships btw instances and interfaces +my %Configuration; #Stores the local config parms # Starting a new object {{{ # Called by user code `$AD2USB = new AD2USB` @@ -121,9 +122,9 @@ sub new { $$self{chime} = 0; $$self{keys_sent} = 0; $$self{instance} = $instance; - $$self{reconnect_time} = $::config_parms{'AD2USB_ser2sock_recon'}; + $$self{reconnect_time} = config_merge($instance.'_ser2sock_recon'); $$self{reconnect_time} = 10 if !defined($$self{reconnect_time}); - $$self{log_file} = "$::config_parms{data_dir}/logs/AD2USB.$::Year_Month_Now.log"; + $$self{log_file} = config_merge('data_dir')."/logs/AD2USB.$::Year_Month_Now.log"; bless $self, $class; @@ -161,6 +162,30 @@ sub set_object_instance{ } #}}} +# This routine merges the ini and read_table_a parameters. If an ini parameter +# exists it takes precedence over the read_table_a parameter +sub config_merge { + my ($parm) = @_; + if ($parm){ + return $::config_parms{$parm} if exists($::config_parms{$parm}); + return $Configuration{$parm}; + } + else { + #This is a request for the full hash + my %config_hash; + foreach my $mkey (keys(%::config_parms)) { + next if $mkey =~ /_MHINTERNAL_/; + $config_hash{$mkey} = $::config_parms{$mkey}; + } + return %config_hash; + } +} + +sub config_set{ + my ($parm, $value) = @_; + $Configuration{$parm} = $value; +} + # serial port configuration {{{ sub init { @@ -184,13 +209,13 @@ sub serial_startup { my ($instance) = @_; my ($port, $BaudRate, $ip); - if ($::config_parms{$instance . '_serial_port'} and - $::config_parms{$instance . '_serial_port'} ne '/dev/none') { - $port = $::config_parms{$instance .'_serial_port'}; - $BaudRate = ( defined $::config_parms{$instance . '_baudrate'} ) ? $main::config_parms{"$instance" . '_baudrate'} : 115200; + if (config_merge($instance . '_serial_port') and + config_merge($instance . '_serial_port') ne '/dev/none') { + $port = config_merge($instance .'_serial_port'); + $BaudRate = ( defined config_merge($instance . '_baudrate') ) ? config_merge("$instance" . '_baudrate') : 115200; if ( &main::serial_port_create( $instance, $port, $BaudRate, 'none', 'raw' ) ) { init( $::Serial_Ports{$instance}{object}, $port ); - ::print_log("[AD2USB] initializing $instance on port $port at $BaudRate baud") if $main::config_parms{debug} eq 'AD2USB'; + ::print_log("[AD2USB] initializing $instance on port $port at $BaudRate baud") if config_merge("debug") eq 'AD2USB'; ::MainLoop_pre_add_hook( sub {AD2USB::check_for_data($instance, 'serial');}, 1 ) if $main::Serial_Ports{"$instance"}{object}; } } @@ -202,11 +227,11 @@ sub server_startup { my ($instance) = @_; $Socket_Items{"$instance"}{recon_timer} = ::Timer::new(); - my $ip = $::config_parms{"$instance".'_server_ip'}; - my $port = $::config_parms{"$instance" . '_server_port'}; - ::print_log(" AD2USB.pm initializing $instance TCP session with $ip on port $port") if $main::config_parms{debug} eq 'AD2USB'; - $Socket_Items{"$instance"}{'socket'} = new Socket_Item($instance, undef, "$ip:$port", 'AD2USB', 'tcp', 'raw'); - $Socket_Items{"$instance" . '_sender'}{'socket'} = new Socket_Item($instance . '_sender', undef, "$ip:$port", 'AD2USB_SENDER', 'tcp', 'rawout'); + my $ip = config_merge("$instance".'_server_ip'); + my $port = config_merge("$instance" . '_server_port'); + ::print_log(" AD2USB.pm initializing $instance TCP session with $ip on port $port") if config_merge("debug") eq 'AD2USB'; + $Socket_Items{"$instance"}{'socket'} = new Socket_Item($instance, undef, "$ip:$port", $instance, 'tcp', 'raw'); + $Socket_Items{"$instance" . '_sender'}{'socket'} = new Socket_Item($instance . '_sender', undef, "$ip:$port", $instance . '_sender', 'tcp', 'rawout'); $Socket_Items{"$instance"}{'socket'}->start; $Socket_Items{"$instance" . '_sender'}{'socket'}->start; &::MainLoop_pre_add_hook( sub {AD2USB::check_for_data($instance, 'tcp');}, 1 ); @@ -268,15 +293,14 @@ sub check_for_data { if ($status_type->{keypad} && $Cmd eq $self->{last_cmd} && (!$status_type->{fault})) { # This is a duplicate panel message with no important status - ::logit( $$self{log_file}, "DUPE: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "DUPE: $Cmd") unless (config_merge($instance .'_debug_log') == 0); } else { # This is a non-dupe panel message or a fault panel message or a # relay or RF or zone expander message or something important # Log the message, parse it, and store it to detect future dupes - ::logit( $$self{log_file}, "MSG: $Cmd") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "MSG: $Cmd") unless (config_merge($instance.'_debug_log') == 0); $self->CheckCmd($Cmd); - $self->ResetAdemcoState(); $self->{last_cmd} = $Cmd if ($status_type->{keypad}); } } @@ -298,15 +322,15 @@ sub CheckCmd { my $partition = $status_type->{partition}; if ($status_type->{unknown}) { - ::logit( $$self{log_file}, "UNKNOWN STATUS: $CmdStr" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "UNKNOWN STATUS: $CmdStr" ) unless (config_merge($instance.'_debug_log') == 0); } elsif ($status_type->{cmd_sent}) { if ($self->{keys_sent} == 0) { - ::logit( $$self{log_file}, "Key sent from ANOTHER panel." ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "Key sent from ANOTHER panel." ) unless (config_merge($instance.'_debug_log') == 0); } else { $self->{keys_sent}--; - ::logit( $$self{log_file}, "Key received ($self->{keys_sent} left)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "Key received ($self->{keys_sent} left)" ) unless (config_merge($instance.'_debug_log') == 0); } } elsif ($status_type->{fault_avail}) { @@ -342,13 +366,13 @@ sub CheckCmd { .$status_type->{rf_id}.") status(".$status_type->{rf_status}.") loop1(" .$status_type->{rf_loop_fault_1}.") loop2(".$status_type->{rf_loop_fault_2} .") loop3(".$status_type->{rf_loop_fault_3}.") loop4(" - .$status_type->{rf_loop_fault_4}.")" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + .$status_type->{rf_loop_fault_4}.")" ) unless (config_merge($instance.'_debug_log') == 0); ::logit( $$self{log_file}, "WIRELESS: rf_id(" .$status_type->{rf_id}.") status(".$status_type->{rf_status}.") low_batt(" .$status_type->{rf_low_batt}.") supervised(".$status_type->{rf_supervised} - .")" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + .")" ) unless (config_merge($instance.'_debug_log') == 0); - if (exists $main::config_parms{"AD2USB_wireless_".$status_type->{rf_id}}) { + if (defined config_merge($instance . "_wireless_".$status_type->{rf_id})) { my ($MZoneLoop, $PartStatus, $ZoneNum); my $lc = 0; my $ZoneStatus = "ready"; @@ -358,7 +382,7 @@ sub CheckCmd { $ZoneStatus = "low battery"; } - foreach my $wnum(split(",", $main::config_parms{"AD2USB_wireless_".$status_type->{rf_id}})) { + foreach my $wnum(split(",", config_merge($instance."_wireless_".$status_type->{rf_id}))) { if ($lc % 2 == 0) { $ZoneNum = $wnum; } @@ -390,20 +414,11 @@ sub CheckCmd { my $input_id = $status_type->{exp_channel}; my $status = $status_type->{exp_status}; - ::logit( $$self{log_file}, "EXPANDER: exp_id($exp_id) input($input_id) status($status)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "EXPANDER: exp_id($exp_id) input($input_id) status($status)" ) unless (config_merge($instance.'_debug_log') == 0); - if (exists $main::config_parms{"AD2USB_expander_$exp_id$input_id"}) { - my $ZoneNum = $main::config_parms{"AD2USB_expander_$exp_id$input_id"}; - # Assign status (zone and partition) - - my $ZoneStatus = "ready"; - my $PartStatus = ""; - if ($status == 01) { - $ZoneStatus = "fault"; - $PartStatus = "not ready"; - } - - ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); + if (my $ZoneNum = config_merge($instance."_expander_$exp_id$input_id")) { + my $ZoneStatus = ($status == 01) ? "fault" : "ready"; + $self->ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); } } elsif ($status_type->{relay}) { @@ -411,29 +426,11 @@ sub CheckCmd { my $rel_input_id = $status_type->{rel_channel}; my $rel_status = $status_type->{rel_status}; - ::logit( $$self{log_file}, "RELAY: rel_id($rel_id) input($rel_input_id) status($rel_status)" ) unless ($main::config_parms{AD2USB_debug_log} == 0); - - if (exists $main::config_parms{"AD2USB_relay_$rel_id$rel_input_id"}) { - # Assign zone - my $ZoneNum = $main::config_parms{"AD2USB_relay_$rel_id$rel_input_id"}; - - # Assign status (zone and partition) - my $ZoneStatus = "ready"; - my $PartStatus = ""; - if ($rel_status == 01) { - $ZoneStatus = "fault"; - $PartStatus = "not ready"; - } + ::logit( $$self{log_file}, "RELAY: rel_id($rel_id) input($rel_input_id) status($rel_status)" ) unless (config_merge($instance.'_debug_log') == 0); - ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); - # if (($self->{partition_status}{int($PartNum)}) eq "ready") { #only change the partition status if the current status is "ready". We dont change if the system is armed. - # if ($PartStatus ne "") { - # $self->{partition_now_msg} = "$CmdStr"; - # $self->{partition_now_status} = "$PartStatus"; - # $self->{partition_now_num} = "$PartNum"; - # ChangePartitions( int($PartNum), int($PartNum), "$PartStatus", 1); - # } - # } + if (my $ZoneNum = config_merge($instance."_relay_$rel_id$rel_input_id")) { + my $ZoneStatus = ($rel_status == 01) ? "fault" : "ready"; + $self->ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); } } @@ -484,20 +481,20 @@ sub CheckCmd { # BACKLIGHT if ( $status_type->{backlight_flag}) { ::logit( $$self{log_file}, "Panel backlight is on" ) - unless ($main::config_parms{AD2USB_debug_log} == 0); + unless (config_merge($instance.'_debug_log') == 0); } # PROGRAMMING MODE if ( $status_type->{programming_flag}) { ::logit( $$self{log_file}, "Panel is in programming mode" ) - unless ($main::config_parms{AD2USB_debug_log} == 0); + unless (config_merge($instance.'_debug_log') == 0); } # BEEPS if ( $status_type->{beep_count}) { my $NumBeeps = $status_type->{beep_count}; ::logit( $$self{log_file}, "Panel beeped $NumBeeps times" ) - unless ($main::config_parms{AD2USB_debug_log} == 0); + unless (config_merge($instance.'_debug_log') == 0); } # A ZONE OR ZONES ARE BYPASSED @@ -514,20 +511,20 @@ sub CheckCmd { # CHIME MODE $self->{chime} = 0; if ( $status_type->{chime_flag}) { - $self->{chime} = 1;# ::logit( $$self{log_file}, "Chime is off" ) unless ($main::config_parms{AD2USB_debug_log} == 0); + $self->{chime} = 1;# ::logit( $$self{log_file}, "Chime is off" ) unless (config_merge($instance.'_debug_log') == 0); } # ALARM WAS TRIGGERED (Sticky until disarm) if ( $status_type->{alarm_past_flag}) { my $EventName = "ALARM WAS TRIGGERED"; - ::logit( $$self{log_file}, "$EventName" ) unless ($main::config_parms{AD2USB_part_log} == 0); + ::logit( $$self{log_file}, "$EventName" ) unless (config_merge($instance.'_part_log') == 0); } # ALARM IS SOUNDING if ( $status_type->{alarm_now_flag}) { ::logit( $$self{log_file}, "ALARM IS SOUNDING - Zone $zone_no_pad (".$self->zone_name($zone_no_pad).")" ) - unless ($main::config_parms{AD2USB_part_log} == 0); - ChangeZones( $zone_no_pad, $zone_no_pad, "alarm", "", 1); + unless (config_merge($instance.'_part_log') == 0); + $self->ChangeZones( $zone_no_pad, $zone_no_pad, "alarm", "", 1); } # BATTERY LOW @@ -574,15 +571,15 @@ sub GetStatusType { # Determine the Message Type if ( $message{alphanumeric} =~ m/^FAULT/) { - ::logit( $$self{log_file}, "Fault zones available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "Fault zones available: $AdemcoStr") unless (config_merge($instance.'_debug_log') == 0); $message{fault} = 1; } elsif ( $message{alphanumeric} =~ m/^BYPAS/ ) { - ::logit( $$self{log_file}, "Bypass zones available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "Bypass zones available: $AdemcoStr") unless (config_merge($instance.'_debug_log') == 0); $message{bypass} = 1; } elsif ($message{alphanumeric} =~ m/Hit \*|Press \*/) { - ::logit( $$self{log_file}, "Faults available: $AdemcoStr") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "Faults available: $AdemcoStr") unless (config_merge($instance.'_debug_log') == 0); $message{fault_avail} = 1; } else { @@ -590,7 +587,7 @@ sub GetStatusType { } } elsif ($AdemcoStr =~ /!RFX:(\d{7}),(\d{2})/) { - ::logit( $$self{log_file}, "Wireless status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "Wireless status received.") unless (config_merge($instance.'_debug_log') == 0); $message{wireless} = 1; $message{rf_id} = $1; $message{rf_status} = $2; @@ -607,21 +604,21 @@ sub GetStatusType { } elsif ($AdemcoStr =~ /!EXP:(\d{2}),(\d{2}),(\d{2})/) { - ::logit( $$self{log_file}, "Expander status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "Expander status received.") unless (config_merge($instance.'_debug_log') == 0); $message{expander} = 1; $message{exp_address} = $1; $message{exp_channel} = $2; $message{exp_status} = $3; } elsif ($AdemcoStr =~ /!REL:(\d{2}),(\d{2}),(\d{2})/) { - ::logit( $$self{log_file}, "Relay status received.") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "Relay status received.") unless (config_merge($instance.'_debug_log') == 0); $message{relay} = 1; $message{rel_address} = $1; $message{rel_channel} = $2; $message{rel_status} = $3; } elsif ($AdemcoStr =~ /!Sending\.\.\.done/) { - ::logit( $$self{log_file}, "Command sent successfully.") unless ($main::config_parms{AD2USB_debug_log} == 0); + ::logit( $$self{log_file}, "Command sent successfully.") unless (config_merge($instance.'_debug_log') == 0); $message{cmd_sent} = 1; } else { @@ -644,11 +641,11 @@ sub ChangeZones { # If partition set, then zone partition must equal that if (($current_status ne $new_status) && ($current_status ne $neq_status) && (!$partition || ($partition == $self->zone_partition($i)))) { - if (($main::config_parms{AD2USB_zone_log} != 0) && ($log == 1)) { + if ((config_merge($instance.'_zone_log') != 0) && ($log == 1)) { my $ZoneNumPadded = sprintf("%03d", $i); ::logit( $$self{log_file}, "Zone $i (".$self->zone_name($i) .") changed from '$current_status' to '$new_status'" ) - unless ($main::config_parms{AD2USB_zone_log} == 0); + unless (config_merge($instance.'_zone_log') == 0); } $$self{$self->zone_partition($i)}{zone_status}{$i} = $new_status; # Store Change for Zone_Now Function @@ -663,54 +660,21 @@ sub ChangeZones { } #}}} -# Change partition statuses for partition indices from start to end {{{ -sub ChangePartitions { - my ($start, $end, $new_status, $log) = @_; - - my $self = $Self; - for (my $i = $start; $i <= $end; $i++) { - my $current_status = $self->{partition_status}{"$i"}; - if ($current_status ne $new_status) { - if (($main::config_parms{AD2USB_part_log} != 0) && ($log == 1)) { - my $PartName = $main::config_parms{"AD2USB_part_$i"} if exists $main::config_parms{"AD2USB_part_$i"}; - ::logit( $$self{log_file}, "Partition $i ($PartName) changed from '$current_status' to '$new_status'" ) unless ($main::config_parms{AD2USB_part_log} == 0); - } - $self->{partition_status}{"$i"} = $new_status; - } - } -} - -#}}} -# Reset Ademco state to simulate a "now" on some value ie: zone, temp etc. {{{ -sub ResetAdemcoState { - my ($self) = @_; - - # reset partition - if ( defined $self->{partition_now_num} ) { - my $PartNum = $self->{partition_now_num}; - $self->{partition}{$PartNum} = $self->{partition_now_num}; - $self->{partition_status}{$PartNum} = $self->{partition_now_status}; - $self->{partition_time}{$PartNum} = &::time_date_stamp( 17, time ); - undef $self->{partition_now_num}; - undef $self->{partition_now_status}; - } - - return; -} -#}}} # Define hash with Ademco commands {{{ sub DefineCmdMsg { + my ($self) = @_; + my $instance = $self->{instance}; my %Return_Hash = ( - "Disarm" => "$::config_parms{AD2USB_user_master_code}1", - "ArmAway" => "$::config_parms{AD2USB_user_master_code}2", - "ArmStay" => "$::config_parms{AD2USB_user_master_code}3", - "ArmAwayMax" => "$::config_parms{AD2USB_user_master_code}4", - "Test" => "$::config_parms{AD2USB_user_master_code}5", - "Bypass" => "$::config_parms{AD2USB_user_master_code}6#", - "ArmStayInstant" => "$::config_parms{AD2USB_user_master_code}7", - "Code" => "$::config_parms{AD2USB_user_master_code}8", - "Chime" => "$::config_parms{AD2USB_user_master_code}9", + "Disarm" => config_merge($instance."_user_master_code")."1", + "ArmAway" => config_merge($instance."_user_master_code")."2", + "ArmStay" => config_merge($instance."_user_master_code")."3", + "ArmAwayMax" => config_merge($instance."_user_master_code")."4", + "Test" => config_merge($instance."_user_master_code")."5", + "Bypass" => config_merge($instance."_user_master_code")."6#", + "ArmStayInstant" => config_merge($instance."_user_master_code")."7", + "Code" => config_merge($instance."_user_master_code")."8", + "Chime" => config_merge($instance."_user_master_code")."9", "ToggleVoice" => '#024', "ShowFaults" => "*", "AD2USBReboot" => "=", @@ -718,30 +682,30 @@ sub DefineCmdMsg { ); my $two_digit_zone; - foreach my $key (keys(%::config_parms)) { + foreach my $key (keys {config_merge()}) { #Create Commands for Relays - if ($key =~ /^AD2USB_output_(\D+)_(\d+)$/){ + if ($key =~ /^${instance}_output_(\D+)_(\d+)$/){ if ($1 eq 'co') { - $Return_Hash{"$::config_parms{$key}c"} = "$::config_parms{AD2USB_user_master_code}#70$2"; - $Return_Hash{"$::config_parms{$key}o"} = "$::config_parms{AD2USB_user_master_code}#80$2"; + $Return_Hash{config_merge($key)."c"} = config_merge($instance."_user_master_code")."#70$2"; + $Return_Hash{config_merge($key)."o"} = config_merge($instance."_user_master_code")."#80$2"; } elsif ($1 eq 'oc') { - $Return_Hash{"$::config_parms{$key}o"} = "$::config_parms{AD2USB_user_master_code}#80$2"; - $Return_Hash{"$::config_parms{$key}c"} = "$::config_parms{AD2USB_user_master_code}#70$2"; + $Return_Hash{config_merge($key)."o"} = config_merge($instance."_user_master_code")."#80$2"; + $Return_Hash{config_merge($key)."c"} = config_merge($instance."_user_master_code")."#70$2"; } elsif ($1 eq 'o') { - $Return_Hash{"$::config_parms{$key}o"} = "$::config_parms{AD2USB_user_master_code}#80$2"; + $Return_Hash{config_merge($key)."o"} = config_merge($instance."_user_master_code")."#80$2"; } elsif ($1 eq 'c') { - $Return_Hash{"$::config_parms{$key}c"} = "$::config_parms{AD2USB_user_master_code}#70$2"; + $Return_Hash{config_merge($key)."c"} = config_merge($instance."_user_master_code")."#70$2"; } } #Create Commands for Zone Expanders - elsif ($key =~ /^AD2USB_expander_(\d+)$/) { - $two_digit_zone = substr($::config_parms{$key}, 1); #Trim leading zero - $Return_Hash{"exp$::config_parms{$key}c"} = "L$two_digit_zone"."0"; - $Return_Hash{"exp$::config_parms{$key}f"} = "L$two_digit_zone"."1"; - $Return_Hash{"exp$::config_parms{$key}p"} = "L$two_digit_zone"."2"; + elsif ($key =~ /^${instance}_expander_(\d+)$/) { + $two_digit_zone = substr(config_merge($key), 1); #Trim leading zero + $Return_Hash{"exp".config_merge($key)."c"} = "L$two_digit_zone"."0"; + $Return_Hash{"exp".config_merge($key)."f"} = "L$two_digit_zone"."1"; + $Return_Hash{"exp".config_merge($key)."p"} = "L$two_digit_zone"."2"; } } @@ -787,12 +751,12 @@ sub cmd { } # Exit if password is wrong - if ( ($password ne $::config_parms{AD2USB_user_master_code}) && ($CmdName ne "ShowFaults" ) ) { + if ( ($password ne config_merge($instance.'_user_master_code')) && ($CmdName ne "ShowFaults" ) ) { ::logit( $$self{log_file}, "Invalid password for command $CmdName ($password)"); return; } - ::logit( $$self{log_file}, ">>> Sending to ADEMCO panel $CmdName ($cmd)" ) unless ($main::config_parms{$instance . '_debug_log'} == 0); + ::logit( $$self{log_file}, ">>> Sending to ADEMCO panel $CmdName ($cmd)" ) unless (config_merge($instance . '_debug_log') == 0); $self->{keys_sent} = $self->{keys_sent} + length($CmdStr); if (defined $Socket_Items{$instance}) { if ($Socket_Items{$instance . '_sender'}{'socket'}->active) { @@ -831,14 +795,16 @@ sub zone_now { sub zone_name { my ( $self, $zone_num ) = @_; + my $instance = $self->{instance}; $zone_num = sprintf "%03s", $zone_num; - return $::config_parms{"AD2USB_zone_$zone_num"}; + return config_merge($instance."_zone_$zone_num"); } sub zone_partition { my ( $self, $zone_num ) = @_; + my $instance = $self->{instance}; $zone_num = sprintf "%03s", $zone_num; - my $partition = $::config_parms{"AD2USB_zone_${zone_num}_partition"}; + my $partition = config_merge("${instance}_zone_${zone_num}_partition"); # Default to partition 1 $partition = 1 unless $partition; return $partition; From dfd31253d751fb59176a00091d341b76430b532a Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 16 Jan 2014 18:10:00 -0800 Subject: [PATCH 048/180] AD2: Convert Routines to Object Oriented Code No more hardcoding $Self!! --- lib/AD2USB.pm | 58 +++++++++++++++++++++------------------------------ 1 file changed, 24 insertions(+), 34 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 855701b31..f72feae65 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -101,8 +101,6 @@ use strict; @AD2USB::ISA = ('Generic_Item'); -my $Self; #Kludge -my %ErrorCode; my %Socket_Items; #Stores the socket instances and attributes my %Interfaces; #Stores the relationships btw instances and interfaces my %Configuration; #Stores the local config parms @@ -137,14 +135,11 @@ sub new { # AD2USB_part_log AD2USB_zone_log AD2USB_debug_log #Set all zones and partitions to ready - ChangeZones( 1, 100, "ready", "ready", 0); - ChangePartitions( 1, 1, "ready", 0); + $self->ChangeZones( 1, 999, "ready", "ready", 0); #Store Object with Instance Name $self->set_object_instance($instance); - $Self = $self; #Kludge - return $self; } @@ -357,9 +352,7 @@ sub CheckCmd { $self->{zone_last_num} = $zone_no_pad; } elsif ($status_type->{bypass}) { - my $PartNum = "1"; - - ChangeZones( $zone_no_pad, $zone_no_pad, "bypass", "", 1); + $self->ChangeZones( $zone_no_pad, $zone_no_pad, "bypass", "", 1); } elsif ($status_type->{wireless}) { ::logit( $$self{log_file}, "WIRELESS: rf_id(" @@ -399,10 +392,10 @@ sub CheckCmd { $ZoneStatus = "ready"; } - ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); + $self->ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); if ($sensortype eq "k") { $ZoneStatus = "ready"; - ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); + $self->ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); } } $lc++ @@ -447,7 +440,12 @@ sub CheckCmd { if ( $status_type->{ready_flag}) { my $bypass = ($status_type->{bypassed_flag}) ? 'bypass' : ''; # Reset all zones, if bypass enabled skip bypassed zones - ChangeZones( 1, 999, "ready", $bypass, 1); + foreach my $partition (@partitions){ + $self->ChangeZones( 1, 999, "ready", $bypass, 1, $partition); + } + # TODO - If the partition is set to STAY, does a fault on a motion + # sensor cause the ready flag to be set to 0? If not, then we need + # to avoid alterning mapped zones. } # ARMED AWAY @@ -541,6 +539,7 @@ sub CheckCmd { # Returns a hash reference containing the message details sub GetStatusType { my ($self, $AdemcoStr) = @_; + my $instance = $self->{instance}; my %message; # Panel Message Format @@ -630,8 +629,8 @@ sub GetStatusType { #}}} # Change zone statuses for zone indices from start to end {{{ sub ChangeZones { - my ($start, $end, $new_status, $neq_status, $log, $partition) = @_; - my $self = $Self; #Kludge + my ($self, $start, $end, $new_status, $neq_status, $log, $partition) = @_; + my $instance = $self->{instance}; # Allow for reverse looping from 999->1 my $reverse = ($start > $end)? 1 : 0; @@ -714,24 +713,14 @@ sub DefineCmdMsg { #}}} # Define hash with all zone numbers and names {{{ -sub ZoneName { - #my $self = $Self; - my @Name = ["none"]; - - foreach my $key (keys(%::config_parms)) { - next if $key !~ /^AD2USB_zone_(\d+)$/; - $Name[int($1)]=$::config_parms{$key}; - } - return @Name; -} - - sub MappedZones { - foreach my $mkey (keys(%::config_parms)) { - next if $mkey !~ /^AD2USB_(relay|wireless|expander)_(\d+)$/; - if ("@_" eq $::config_parms{$mkey}) { return 1 } - } - return 0; + my ($self) = @_; + my $instance = $self->{instance}; + foreach my $mkey (keys(config_merge())) { + next if $mkey !~ /^${instance}_(relay|wireless|expander)_(\d+)$/; + if ("@_" eq config_merge($mkey)) { return 1 } + } + return 0; } #}}} @@ -821,8 +810,9 @@ sub partition_msg { } sub partition_name { - my ( $class, $part_num ) = @_; - return $main::config_parms{"AD2USB_part_$part_num"}; + my ( $self, $part_num ) = @_; + my $instance = $self->{instance}; + return config_merge("${instance}_part_$part_num"); } sub status_partition { @@ -857,7 +847,7 @@ sub register { my ($self, $object, $zone_num ) = @_; &::print_log("Registering Child Object on zone $zone_num"); $self->{zone_object}{$zone_num} = $object; - } +} sub get_child_object_name { my ($self,$zone_num) = @_; From 02d290242c8e9b832be601b1c9ce4bd2b29268a1 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 16 Jan 2014 18:20:00 -0800 Subject: [PATCH 049/180] AD2: Add Support for Partitions --- lib/AD2USB.pm | 83 +++++++++++++++++++++++++++++++++++---------------- 1 file changed, 57 insertions(+), 26 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index f72feae65..ad47efbc0 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -314,7 +314,8 @@ sub CheckCmd { my $status_type = $self->GetStatusType($CmdStr); my $zone_padded = $status_type->{numeric_code}; my $zone_no_pad = int($zone_padded); - my $partition = $status_type->{partition}; + my @partitions = $status_type->{partition}; + my $instance = $self->{instance}; if ($status_type->{unknown}) { ::logit( $$self{log_file}, "UNKNOWN STATUS: $CmdStr" ) unless (config_merge($instance.'_debug_log') == 0); @@ -333,23 +334,24 @@ sub CheckCmd { cmd( $self, "ShowFaults" ); } elsif ($status_type->{fault}) { - my $PartNum = "1"; - # Each fault message tells us two things, 1) this zone is faulted and # 2) all zones between this zone and the last fault are ready. - #Reset the zones between the current zone and the last zone. If zones - #are sequential do nothing, if same zone, reset all other zones - if ($self->{zone_last_num} - $zone_no_pad > 1 - || $self->{zone_last_num} - $zone_no_pad == 0) { - ChangeZones( $self->{zone_last_num}+1, $zone_no_pad-1, "ready", "bypass", 1); + #Loop through partions set in message + foreach my $partition (@partitions){ + #Reset the zones between the current zone and the last zone. If zones + #are sequential do nothing, if same zone, reset all other zones + if ($self->{zone_last_num}{$partition} - $zone_no_pad > 1 + || $self->{zone_last_num}{$partition} - $zone_no_pad == 0) { + $self->ChangeZones( $self->{zone_last_num}{$partition}+1, $zone_no_pad-1, "ready", "bypass", 1, $partition); + } + + # Set this zone to faulted + $self->ChangeZones( $zone_no_pad, $zone_no_pad, "fault", "", 1); + + # Store Zone Number for Use in Fault Loop + $self->{zone_last_num}{$partition} = $zone_no_pad; } - - # Set this zone to faulted - ChangeZones( $zone_no_pad, $zone_no_pad, "fault", "", 1); - - # Store Zone Number for Use in Fault Loop - $self->{zone_last_num} = $zone_no_pad; } elsif ($status_type->{bypass}) { $self->ChangeZones( $zone_no_pad, $zone_no_pad, "bypass", "", 1); @@ -431,8 +433,10 @@ sub CheckCmd { # ALWAYS Check Bits in Keypad Message if ($status_type->{keypad}) { # If this was not a fault message then clear log of last fault msg - $self->{zone_last_num} = "" unless $status_type->{fault}; - $self->{partition_msg}{$partition} = $status_type->{alphanumeric}; + foreach my $partition (@partitions){ + $self->{zone_last_num}{$partition} = "" unless $status_type->{fault}; + $self->{partition_msg}{$partition} = $status_type->{alphanumeric}; + } # Set things based on Bit Codes @@ -451,8 +455,8 @@ sub CheckCmd { # ARMED AWAY if ( $status_type->{armed_away_flag}) { my $PartNum = my $PartName = 1; - $PartName = $main::config_parms{"AD2USB_part_${PartNum}"} - if exists $main::config_parms{"AD2USB_part_${PartNum}"}; + $PartName = config_merge($instance."_part_${PartNum}") + if defined config_merge($instance."_part_${PartNum}"); my $mode = "ERROR"; if (index($status_type->{alphanumeric}, "ALL SECURE")) { @@ -552,13 +556,40 @@ sub GetStatusType { $message{raw_data} = $4; $message{alphanumeric} = $5; - # Relevant Partition Data is Apparently Contained in the Raw Data, - # which contains a mask identifying the panels that each message is - # destined for. Apparently this can be used to determine the partition - # number. It isn't clear to me how this works, so for the time being - # everything is assumed to be partition 1. - $message{partition} = 1; - + # Partition Data is Contained in the Raw Data, in the form of a bit mask + # identifying the panels that each message is destined for. By knowing + # which panels are on which partitions, we can determine the partition of + # this message. + my $address_mask = substr($message{raw_data}, 2, 8); + my @addresses; + for (my $b = 3; $b >= 0; $b--){ + my $byte = hex(uc substr($address_mask, -2)); + $address_mask = substr($address_mask, 0, -2); + for (my $i = 0; $i <= 7; $i++){ + push (@addresses, (($b*8)+$i)) if ($byte &0b1); + $byte = $byte >> 1; + } + } + #Place message in partition if address is equal to partition, or no + #address is specified (system wide messages). + my %partitions; + foreach my $key (keys {config_merge()}) { + if ($key =~ /^${instance}_partition_(\d)_address$/){ + $partitions{$1} = + config_merge($instance."_partition_".$1."_address"); + } + } + foreach my $partition (keys %partitions){ + my $part_addr = $partitions{$partition}; + if (grep($part_addr, @addresses) || + (scalar @addresses == 0)) { + push($message{partition}, $partition); + } + } + if (scalar $message{partition} == 0){ + $message{partition} = (1); #Default to partition 1 + } + # Decipher and Set Bit Flags my @flags = ('ready_flag', 'armed_away_flag', 'armed_home_flag', 'backlight_flag', 'programming_flag', 'beep_count', 'bypassed_flag', 'ac_flag', @@ -755,7 +786,7 @@ sub cmd { if ($Socket_Items{$instance}{recon_timer}->inactive) { ::print_log("Connection to $instance sending instance of AD2USB was lost, I will try to reconnect in $$self{reconnect_time} seconds"); $Socket_Items{$instance}{recon_timer}->set($$self{reconnect_time}, sub { - $Socket_Items{$instance}{'socket'}->start; + $Socket_Items{$instance . '_sender'}{'socket'}->start; $Socket_Items{$instance . '_sender'}{'socket'}->set("$CmdStr"); }); } From 3b1772cbed0cc591d247461705397775e600f93c Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 16 Jan 2014 18:22:00 -0800 Subject: [PATCH 050/180] AD2: Remove Old PartNum and PartName References --- lib/AD2USB.pm | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index ad47efbc0..6c5d33a94 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -454,10 +454,7 @@ sub CheckCmd { # ARMED AWAY if ( $status_type->{armed_away_flag}) { - my $PartNum = my $PartName = 1; - $PartName = config_merge($instance."_part_${PartNum}") - if defined config_merge($instance."_part_${PartNum}"); - + # TODO The setting of modes needs to be done on partitions my $mode = "ERROR"; if (index($status_type->{alphanumeric}, "ALL SECURE")) { $mode = "armed away"; From 38f62ccef1e0c4b8308b685bc69715f7cf4a8416 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 16 Jan 2014 18:32:00 -0800 Subject: [PATCH 051/180] AD2: Condense Logging into a Debug_log Function --- lib/AD2USB.pm | 69 ++++++++++++++++++++++++++------------------------- 1 file changed, 35 insertions(+), 34 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 6c5d33a94..e077e5dfa 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -288,13 +288,13 @@ sub check_for_data { if ($status_type->{keypad} && $Cmd eq $self->{last_cmd} && (!$status_type->{fault})) { # This is a duplicate panel message with no important status - ::logit( $$self{log_file}, "DUPE: $Cmd") unless (config_merge($instance .'_debug_log') == 0); + $self->debug_log("DUPE: $Cmd"); } else { # This is a non-dupe panel message or a fault panel message or a # relay or RF or zone expander message or something important # Log the message, parse it, and store it to detect future dupes - ::logit( $$self{log_file}, "MSG: $Cmd") unless (config_merge($instance.'_debug_log') == 0); + $self->debug_log("MSG: $Cmd"); $self->CheckCmd($Cmd); $self->{last_cmd} = $Cmd if ($status_type->{keypad}); } @@ -318,15 +318,15 @@ sub CheckCmd { my $instance = $self->{instance}; if ($status_type->{unknown}) { - ::logit( $$self{log_file}, "UNKNOWN STATUS: $CmdStr" ) unless (config_merge($instance.'_debug_log') == 0); + $self->debug_log("UNKNOWN STATUS: $CmdStr"); } elsif ($status_type->{cmd_sent}) { if ($self->{keys_sent} == 0) { - ::logit( $$self{log_file}, "Key sent from ANOTHER panel." ) unless (config_merge($instance.'_debug_log') == 0); + $self->debug_log("Key sent from ANOTHER panel."); } else { $self->{keys_sent}--; - ::logit( $$self{log_file}, "Key received ($self->{keys_sent} left)" ) unless (config_merge($instance.'_debug_log') == 0); + $self->debug_log("Key received ($self->{keys_sent} left)"); } } elsif ($status_type->{fault_avail}) { @@ -357,17 +357,17 @@ sub CheckCmd { $self->ChangeZones( $zone_no_pad, $zone_no_pad, "bypass", "", 1); } elsif ($status_type->{wireless}) { - ::logit( $$self{log_file}, "WIRELESS: rf_id(" + $self->debug_log( $$self{log_file}, "WIRELESS: rf_id(" .$status_type->{rf_id}.") status(".$status_type->{rf_status}.") loop1(" .$status_type->{rf_loop_fault_1}.") loop2(".$status_type->{rf_loop_fault_2} .") loop3(".$status_type->{rf_loop_fault_3}.") loop4(" - .$status_type->{rf_loop_fault_4}.")" ) unless (config_merge($instance.'_debug_log') == 0); - ::logit( $$self{log_file}, "WIRELESS: rf_id(" + .$status_type->{rf_loop_fault_4}.")" ); + $self->debug_log( $$self{log_file}, "WIRELESS: rf_id(" .$status_type->{rf_id}.") status(".$status_type->{rf_status}.") low_batt(" .$status_type->{rf_low_batt}.") supervised(".$status_type->{rf_supervised} - .")" ) unless (config_merge($instance.'_debug_log') == 0); + .")" ); - if (defined config_merge($instance . "_wireless_".$status_type->{rf_id})) { + if (defined $$self{wireless}{$status_type->{rf_id}}) { my ($MZoneLoop, $PartStatus, $ZoneNum); my $lc = 0; my $ZoneStatus = "ready"; @@ -479,21 +479,18 @@ sub CheckCmd { # BACKLIGHT if ( $status_type->{backlight_flag}) { - ::logit( $$self{log_file}, "Panel backlight is on" ) - unless (config_merge($instance.'_debug_log') == 0); + $self->debug_log("Panel backlight is on"); } # PROGRAMMING MODE if ( $status_type->{programming_flag}) { - ::logit( $$self{log_file}, "Panel is in programming mode" ) - unless (config_merge($instance.'_debug_log') == 0); + $self->debug_log("Panel is in programming mode"); } # BEEPS if ( $status_type->{beep_count}) { my $NumBeeps = $status_type->{beep_count}; - ::logit( $$self{log_file}, "Panel beeped $NumBeeps times" ) - unless (config_merge($instance.'_debug_log') == 0); + $self->debug_log("Panel beeped $NumBeeps times"); } # A ZONE OR ZONES ARE BYPASSED @@ -504,25 +501,24 @@ sub CheckCmd { $$self{ac_power} = 1; if ( !$status_type->{ac_flag} ) { $$self{ac_power} = 0; - ::logit( $$self{log_file}, "AC Power has been lost" ); + $self->debug_log("AC Power has been lost");; } # CHIME MODE $self->{chime} = 0; if ( $status_type->{chime_flag}) { - $self->{chime} = 1;# ::logit( $$self{log_file}, "Chime is off" ) unless (config_merge($instance.'_debug_log') == 0); + $self->{chime} = 1;# $self->debug_log("Chime is off"); } # ALARM WAS TRIGGERED (Sticky until disarm) if ( $status_type->{alarm_past_flag}) { my $EventName = "ALARM WAS TRIGGERED"; - ::logit( $$self{log_file}, "$EventName" ) unless (config_merge($instance.'_part_log') == 0); + $self->debug_log( $$self{log_file}, "$EventName" ); } # ALARM IS SOUNDING if ( $status_type->{alarm_now_flag}) { - ::logit( $$self{log_file}, "ALARM IS SOUNDING - Zone $zone_no_pad (".$self->zone_name($zone_no_pad).")" ) - unless (config_merge($instance.'_part_log') == 0); + $self->debug_log( $$self{log_file}, "ALARM IS SOUNDING - Zone $zone_no_pad (".$self->zone_name($zone_no_pad).")" ); $self->ChangeZones( $zone_no_pad, $zone_no_pad, "alarm", "", 1); } @@ -530,7 +526,7 @@ sub CheckCmd { $self->{battery_low} = 0; if ( $status_type->{battery_low_flag}) { $self->{battery_low} = 1; - ::logit( $$self{log_file}, "Panel is low on battery" ); + $self->debug_log("Panel is low on battery");; } } return; @@ -598,15 +594,15 @@ sub GetStatusType { # Determine the Message Type if ( $message{alphanumeric} =~ m/^FAULT/) { - ::logit( $$self{log_file}, "Fault zones available: $AdemcoStr") unless (config_merge($instance.'_debug_log') == 0); + $self->debug_log("Fault zones available: $AdemcoStr"); $message{fault} = 1; } elsif ( $message{alphanumeric} =~ m/^BYPAS/ ) { - ::logit( $$self{log_file}, "Bypass zones available: $AdemcoStr") unless (config_merge($instance.'_debug_log') == 0); + $self->debug_log("Bypass zones available: $AdemcoStr"); $message{bypass} = 1; } elsif ($message{alphanumeric} =~ m/Hit \*|Press \*/) { - ::logit( $$self{log_file}, "Faults available: $AdemcoStr") unless (config_merge($instance.'_debug_log') == 0); + $self->debug_log("Faults available: $AdemcoStr"); $message{fault_avail} = 1; } else { @@ -614,7 +610,7 @@ sub GetStatusType { } } elsif ($AdemcoStr =~ /!RFX:(\d{7}),(\d{2})/) { - ::logit( $$self{log_file}, "Wireless status received.") unless (config_merge($instance.'_debug_log') == 0); + $self->debug_log("Wireless status received."); $message{wireless} = 1; $message{rf_id} = $1; $message{rf_status} = $2; @@ -631,21 +627,21 @@ sub GetStatusType { } elsif ($AdemcoStr =~ /!EXP:(\d{2}),(\d{2}),(\d{2})/) { - ::logit( $$self{log_file}, "Expander status received.") unless (config_merge($instance.'_debug_log') == 0); + $self->debug_log("Expander status received."); $message{expander} = 1; $message{exp_address} = $1; $message{exp_channel} = $2; $message{exp_status} = $3; } elsif ($AdemcoStr =~ /!REL:(\d{2}),(\d{2}),(\d{2})/) { - ::logit( $$self{log_file}, "Relay status received.") unless (config_merge($instance.'_debug_log') == 0); + $self->debug_log("Relay status received."); $message{relay} = 1; $message{rel_address} = $1; $message{rel_channel} = $2; $message{rel_status} = $3; } elsif ($AdemcoStr =~ /!Sending\.\.\.done/) { - ::logit( $$self{log_file}, "Command sent successfully.") unless (config_merge($instance.'_debug_log') == 0); + $self->debug_log("Command sent successfully."); $message{cmd_sent} = 1; } else { @@ -668,11 +664,10 @@ sub ChangeZones { # If partition set, then zone partition must equal that if (($current_status ne $new_status) && ($current_status ne $neq_status) && (!$partition || ($partition == $self->zone_partition($i)))) { - if ((config_merge($instance.'_zone_log') != 0) && ($log == 1)) { + if ($log == 1) { my $ZoneNumPadded = sprintf("%03d", $i); - ::logit( $$self{log_file}, "Zone $i (".$self->zone_name($i) - .") changed from '$current_status' to '$new_status'" ) - unless (config_merge($instance.'_zone_log') == 0); + $self->debug_log( $$self{log_file}, "Zone $i (".$self->zone_name($i) + .") changed from '$current_status' to '$new_status'" ); } $$self{$self->zone_partition($i)}{zone_status}{$i} = $new_status; # Store Change for Zone_Now Function @@ -739,6 +734,12 @@ sub DefineCmdMsg { return \%Return_Hash; } +sub debug_log { + my ($self, $text) = @_; + my $instance = $$self{instance}; + ::logit( $$self{log_file}, $text) unless ($Configuration{$instance.'_debug_log'} == 0); +} + #}}} # Define hash with all zone numbers and names {{{ sub MappedZones { @@ -773,7 +774,7 @@ sub cmd { return; } - ::logit( $$self{log_file}, ">>> Sending to ADEMCO panel $CmdName ($cmd)" ) unless (config_merge($instance . '_debug_log') == 0); + $self->debug_log(">>> Sending to ADEMCO panel $CmdName ($cmd)"); $self->{keys_sent} = $self->{keys_sent} + length($CmdStr); if (defined $Socket_Items{$instance}) { if ($Socket_Items{$instance . '_sender'}{'socket'}->active) { From 58bd1ab668a03e8db666e92f990718739fd4004b Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 16 Jan 2014 18:42:00 -0800 Subject: [PATCH 052/180] AD2: Get Rid of Config_Merge Function That was an awful idea. --- lib/AD2USB.pm | 152 +++++++++++++++++++++++++++++--------------------- 1 file changed, 87 insertions(+), 65 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index e077e5dfa..c292928c5 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -120,9 +120,9 @@ sub new { $$self{chime} = 0; $$self{keys_sent} = 0; $$self{instance} = $instance; - $$self{reconnect_time} = config_merge($instance.'_ser2sock_recon'); + $$self{reconnect_time} = $::config_parms{$instance.'_ser2sock_recon'}; $$self{reconnect_time} = 10 if !defined($$self{reconnect_time}); - $$self{log_file} = config_merge('data_dir')."/logs/AD2USB.$::Year_Month_Now.log"; + $$self{log_file} = $::config_parms{'data_dir'}."/logs/AD2USB.$::Year_Month_Now.log"; bless $self, $class; @@ -140,6 +140,9 @@ sub new { #Store Object with Instance Name $self->set_object_instance($instance); + #Load the Parameters from the INI file + $self->read_parms($instance); + return $self; } @@ -157,30 +160,44 @@ sub set_object_instance{ } #}}} -# This routine merges the ini and read_table_a parameters. If an ini parameter -# exists it takes precedence over the read_table_a parameter -sub config_merge { - my ($parm) = @_; - if ($parm){ - return $::config_parms{$parm} if exists($::config_parms{$parm}); - return $Configuration{$parm}; - } - else { - #This is a request for the full hash - my %config_hash; - foreach my $mkey (keys(%::config_parms)) { - next if $mkey =~ /_MHINTERNAL_/; - $config_hash{$mkey} = $::config_parms{$mkey}; +# Reads the ini settings and pushes them into the appropriate Hashes +sub read_parms{ + my ($self, $instance) = @_; + foreach my $mkey (keys(%::config_parms)) { + next if $mkey =~ /_MHINTERNAL_/; + #Load All Configuration Settings + $Configuration{$mkey} = $::config_parms{$mkey} if $mkey =~ /^AD2USB_/; + #Put wireless settings in correct hash + if ($mkey =~ /^${instance}_wireless_(.*)/){ + $$self{wireless}{$1} = $::config_parms{$mkey}; + } + #Put expander settings in correct hash + if ($mkey =~ /^${instance}_expander_(.*)/){ + $$self{expander}{$1} = $::config_parms{$mkey}; + } + #Put relay settings in correct hash + if ($mkey =~ /^${instance}_relay_(.*)/){ + $$self{relay}{$1} = $::config_parms{$mkey}; + } + #Put Partition Addresses in Correct Hash + if ($mkey =~ /^${instance}_partition_(\d*)_address$/){ + $$self{partition_address}{$1} = $::config_parms{$mkey}; + } + #Put Zone Names in Correct Hash + if ($mkey =~ /^${instance}_partition_(\d*)$/){ + $$self{zone_name}{$1} = $::config_parms{$mkey}; + } + #Put Zone Partition Relationship in Correct Hash + if ($mkey =~ /^${instance}_zone_(\d*)_partition$/){ + $$self{zone_partition}{$1} = $::config_parms{$mkey}; + } + #Put Partition Name in Correct Hash + if ($mkey =~ /^${instance}_part_(\d)$/){ + $$self{partition_name}{$1} = $::config_parms{$mkey}; } - return %config_hash; } } -sub config_set{ - my ($parm, $value) = @_; - $Configuration{$parm} = $value; -} - # serial port configuration {{{ sub init { @@ -204,13 +221,13 @@ sub serial_startup { my ($instance) = @_; my ($port, $BaudRate, $ip); - if (config_merge($instance . '_serial_port') and - config_merge($instance . '_serial_port') ne '/dev/none') { - $port = config_merge($instance .'_serial_port'); - $BaudRate = ( defined config_merge($instance . '_baudrate') ) ? config_merge("$instance" . '_baudrate') : 115200; + if ($::config_parms{$instance . '_serial_port'} and + $::config_parms{$instance . '_serial_port'} ne '/dev/none') { + $port = $::config_parms{$instance .'_serial_port'}; + $BaudRate = ( defined $::config_parms{$instance . '_baudrate'} ) ? $::config_parms{"$instance" . '_baudrate'} : 115200; if ( &main::serial_port_create( $instance, $port, $BaudRate, 'none', 'raw' ) ) { init( $::Serial_Ports{$instance}{object}, $port ); - ::print_log("[AD2USB] initializing $instance on port $port at $BaudRate baud") if config_merge("debug") eq 'AD2USB'; + ::print_log("[AD2USB] initializing $instance on port $port at $BaudRate baud") if $main::Debug{'AD2USB'}; ::MainLoop_pre_add_hook( sub {AD2USB::check_for_data($instance, 'serial');}, 1 ) if $main::Serial_Ports{"$instance"}{object}; } } @@ -222,14 +239,14 @@ sub server_startup { my ($instance) = @_; $Socket_Items{"$instance"}{recon_timer} = ::Timer::new(); - my $ip = config_merge("$instance".'_server_ip'); - my $port = config_merge("$instance" . '_server_port'); - ::print_log(" AD2USB.pm initializing $instance TCP session with $ip on port $port") if config_merge("debug") eq 'AD2USB'; + my $ip = $::config_parms{"$instance".'_server_ip'}; + my $port = $::config_parms{"$instance" . '_server_port'}; + ::print_log(" AD2USB.pm initializing $instance TCP session with $ip on port $port") if $main::Debug{'AD2USB'}; $Socket_Items{"$instance"}{'socket'} = new Socket_Item($instance, undef, "$ip:$port", $instance, 'tcp', 'raw'); $Socket_Items{"$instance" . '_sender'}{'socket'} = new Socket_Item($instance . '_sender', undef, "$ip:$port", $instance . '_sender', 'tcp', 'rawout'); $Socket_Items{"$instance"}{'socket'}->start; $Socket_Items{"$instance" . '_sender'}{'socket'}->start; - &::MainLoop_pre_add_hook( sub {AD2USB::check_for_data($instance, 'tcp');}, 1 ); + ::MainLoop_pre_add_hook( sub {AD2USB::check_for_data($instance, 'tcp');}, 1 ); } #}}} @@ -377,7 +394,7 @@ sub CheckCmd { $ZoneStatus = "low battery"; } - foreach my $wnum(split(",", config_merge($instance."_wireless_".$status_type->{rf_id}))) { + foreach my $wnum(split(",", $$self{wireless}{$status_type->{rf_id}})) { if ($lc % 2 == 0) { $ZoneNum = $wnum; } @@ -409,9 +426,9 @@ sub CheckCmd { my $input_id = $status_type->{exp_channel}; my $status = $status_type->{exp_status}; - ::logit( $$self{log_file}, "EXPANDER: exp_id($exp_id) input($input_id) status($status)" ) unless (config_merge($instance.'_debug_log') == 0); + $self->debug_log("EXPANDER: exp_id($exp_id) input($input_id) status($status)"); - if (my $ZoneNum = config_merge($instance."_expander_$exp_id$input_id")) { + if (my $ZoneNum = $$self{expander}{$exp_id.$input_id}) { my $ZoneStatus = ($status == 01) ? "fault" : "ready"; $self->ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); } @@ -421,9 +438,9 @@ sub CheckCmd { my $rel_input_id = $status_type->{rel_channel}; my $rel_status = $status_type->{rel_status}; - ::logit( $$self{log_file}, "RELAY: rel_id($rel_id) input($rel_input_id) status($rel_status)" ) unless (config_merge($instance.'_debug_log') == 0); + $self->debug_log("RELAY: rel_id($rel_id) input($rel_input_id) status($rel_status)"); - if (my $ZoneNum = config_merge($instance."_relay_$rel_id$rel_input_id")) { + if (my $ZoneNum = $$self{relay}{$rel_id.$rel_input_id}) { my $ZoneStatus = ($rel_status == 01) ? "fault" : "ready"; $self->ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); } @@ -688,15 +705,15 @@ sub DefineCmdMsg { my ($self) = @_; my $instance = $self->{instance}; my %Return_Hash = ( - "Disarm" => config_merge($instance."_user_master_code")."1", - "ArmAway" => config_merge($instance."_user_master_code")."2", - "ArmStay" => config_merge($instance."_user_master_code")."3", - "ArmAwayMax" => config_merge($instance."_user_master_code")."4", - "Test" => config_merge($instance."_user_master_code")."5", - "Bypass" => config_merge($instance."_user_master_code")."6#", - "ArmStayInstant" => config_merge($instance."_user_master_code")."7", - "Code" => config_merge($instance."_user_master_code")."8", - "Chime" => config_merge($instance."_user_master_code")."9", + "Disarm" => $Configuration{$instance."_user_master_code"}."1", + "ArmAway" => $Configuration{$instance."_user_master_code"}."2", + "ArmStay" => $Configuration{$instance."_user_master_code"}."3", + "ArmAwayMax" => $Configuration{$instance."_user_master_code"}."4", + "Test" => $Configuration{$instance."_user_master_code"}."5", + "Bypass" => $Configuration{$instance."_user_master_code"}."6#", + "ArmStayInstant" => $Configuration{$instance."_user_master_code"}."7", + "Code" => $Configuration{$instance."_user_master_code"}."8", + "Chime" => $Configuration{$instance."_user_master_code"}."9", "ToggleVoice" => '#024', "ShowFaults" => "*", "AD2USBReboot" => "=", @@ -704,30 +721,30 @@ sub DefineCmdMsg { ); my $two_digit_zone; - foreach my $key (keys {config_merge()}) { + foreach my $key (keys %Configuration) { #Create Commands for Relays if ($key =~ /^${instance}_output_(\D+)_(\d+)$/){ if ($1 eq 'co') { - $Return_Hash{config_merge($key)."c"} = config_merge($instance."_user_master_code")."#70$2"; - $Return_Hash{config_merge($key)."o"} = config_merge($instance."_user_master_code")."#80$2"; + $Return_Hash{$Configuration{$key}."c"} = $Configuration{$instance."_user_master_code"}."#70$2"; + $Return_Hash{$Configuration{$key}."o"} = $Configuration{$instance."_user_master_code"}."#80$2"; } elsif ($1 eq 'oc') { - $Return_Hash{config_merge($key)."o"} = config_merge($instance."_user_master_code")."#80$2"; - $Return_Hash{config_merge($key)."c"} = config_merge($instance."_user_master_code")."#70$2"; + $Return_Hash{$Configuration{$key}."o"} = $Configuration{$instance."_user_master_code"}."#80$2"; + $Return_Hash{$Configuration{$key}."c"} = $Configuration{$instance."_user_master_code"}."#70$2"; } elsif ($1 eq 'o') { - $Return_Hash{config_merge($key)."o"} = config_merge($instance."_user_master_code")."#80$2"; + $Return_Hash{$Configuration{$key}."o"} = $Configuration{$instance."_user_master_code"}."#80$2"; } elsif ($1 eq 'c') { - $Return_Hash{config_merge($key)."c"} = config_merge($instance."_user_master_code")."#70$2"; + $Return_Hash{$Configuration{$key}."c"} = $Configuration{$instance."_user_master_code"}."#70$2"; } } #Create Commands for Zone Expanders elsif ($key =~ /^${instance}_expander_(\d+)$/) { - $two_digit_zone = substr(config_merge($key), 1); #Trim leading zero - $Return_Hash{"exp".config_merge($key)."c"} = "L$two_digit_zone"."0"; - $Return_Hash{"exp".config_merge($key)."f"} = "L$two_digit_zone"."1"; - $Return_Hash{"exp".config_merge($key)."p"} = "L$two_digit_zone"."2"; + $two_digit_zone = substr($Configuration{$key}, 1); #Trim leading zero + $Return_Hash{"exp".$Configuration{$key}."c"} = "L$two_digit_zone"."0"; + $Return_Hash{"exp".$Configuration{$key}."f"} = "L$two_digit_zone"."1"; + $Return_Hash{"exp".$Configuration{$key}."p"} = "L$two_digit_zone"."2"; } } @@ -743,12 +760,17 @@ sub debug_log { #}}} # Define hash with all zone numbers and names {{{ sub MappedZones { - my ($self) = @_; + my ($self, $zone) = @_; my $instance = $self->{instance}; - foreach my $mkey (keys(config_merge())) { - next if $mkey !~ /^${instance}_(relay|wireless|expander)_(\d+)$/; - if ("@_" eq config_merge($mkey)) { return 1 } - } + foreach my $mkey (keys $$self{relay}) { + if ($zone eq $$self{relay}{$mkey}) { return 1 } + } + foreach my $mkey (keys $$self{wireless}) { + if ($zone eq $$self{wireless}{$mkey}) { return 1 } + } + foreach my $mkey (keys $$self{expander}) { + if ($zone eq $$self{expander}{$mkey}) { return 1 } + } return 0; } @@ -769,7 +791,7 @@ sub cmd { } # Exit if password is wrong - if ( ($password ne config_merge($instance.'_user_master_code')) && ($CmdName ne "ShowFaults" ) ) { + if ( ($password ne $Configuration{$instance.'_user_master_code'}) && ($CmdName ne "ShowFaults" ) ) { ::logit( $$self{log_file}, "Invalid password for command $CmdName ($password)"); return; } @@ -815,14 +837,14 @@ sub zone_name { my ( $self, $zone_num ) = @_; my $instance = $self->{instance}; $zone_num = sprintf "%03s", $zone_num; - return config_merge($instance."_zone_$zone_num"); + return $$self{zone_name}{$zone_num}; } sub zone_partition { my ( $self, $zone_num ) = @_; my $instance = $self->{instance}; $zone_num = sprintf "%03s", $zone_num; - my $partition = config_merge("${instance}_zone_${zone_num}_partition"); + my $partition = $$self{zone_partition}{$zone_num}; # Default to partition 1 $partition = 1 unless $partition; return $partition; @@ -841,7 +863,7 @@ sub partition_msg { sub partition_name { my ( $self, $part_num ) = @_; my $instance = $self->{instance}; - return config_merge("${instance}_part_$part_num"); + return $$self{partition_name}{$part_num}; } sub status_partition { From 6b6a380b2e896d9aa17ca56a73bb9935af627173 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 16 Jan 2014 18:48:00 -0800 Subject: [PATCH 053/180] AD2: Fix Handling of Partitions --- lib/AD2USB.pm | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index c292928c5..e51feeed0 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -582,22 +582,17 @@ sub GetStatusType { } #Place message in partition if address is equal to partition, or no #address is specified (system wide messages). - my %partitions; - foreach my $key (keys {config_merge()}) { - if ($key =~ /^${instance}_partition_(\d)_address$/){ - $partitions{$1} = - config_merge($instance."_partition_".$1."_address"); - } - } - foreach my $partition (keys %partitions){ - my $part_addr = $partitions{$partition}; + foreach my $partition (keys %{$$self{partition_address}}){ + my $part_addr = $$self{partition_address}{$partition}; if (grep($part_addr, @addresses) || (scalar @addresses == 0)) { - push($message{partition}, $partition); + push(@{$message{partition}}, $partition); } } if (scalar $message{partition} == 0){ - $message{partition} = (1); #Default to partition 1 + # The addresses identified in this message did not match any defined + # partition addresses, default to putting in partition 1. + @{$message{partition}} = (1); #Default to partition 1 } # Decipher and Set Bit Flags @@ -692,7 +687,12 @@ sub ChangeZones { # Store Change for Partition_Now Function $self->{partition_now}{$partition} = 1; # Set child object status if it is registered to the zone - $$self{zone_object}{"$i"}->set($new_status, $$self{zone_object}{"$i"}) if defined $$self{zone_object}{"$i"}; + $$self{zone_object}{"$i"}->set($new_status, $$self{zone_object}{"$i"}) + if defined $$self{zone_object}{"$i"}; + my $zone_partition = $self->zone_partition($i); + my $partition_status = $self->status_partition($zone_partition); + $$self{parition_object}{$zone_partition}->set($partition_status, $$self{zone_object}{"$i"}) + if defined $$self{parition_object}{$zone_partition}; } $i = 0 if ($i == 999 && $reverse); #loop around } From 174be7e94237f59f22fc658787ecefcfd51e761b Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 16 Jan 2014 18:58:00 -0800 Subject: [PATCH 054/180] AD2: Cleanup Child Objects; Add New Objects Add an object for a partition. Cleanup unused function sof door and motion items. Some odd functions still remain. --- lib/AD2USB.pm | 102 ++++++++++++++------------------------------------ 1 file changed, 29 insertions(+), 73 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index e51feeed0..984ec79fd 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -893,11 +893,16 @@ sub cmd_list { } } #}}} -##Used to register a child object to the zone. Allows for MH-style Door & Motion sensors {{{ +##Used to register a child object to a zone or partition. Allows for MH-style Door & Motion sensors {{{ sub register { - my ($self, $object, $zone_num ) = @_; - &::print_log("Registering Child Object on zone $zone_num"); - $self->{zone_object}{$zone_num} = $object; + my ($self, $object, $num ) = @_; + &::print_log("Registering Child Object on zone $num"); + if ($object->isa('AD2USB_Motion_Item') || $object->isa('AD2USB_Door_Item')) { + $self->{zone_object}{$num} = $object; + } + elsif ($object->isa('AD2USB_Partition')) { + $self->{partition_object}{$num} = $object; + } } sub get_child_object_name { @@ -926,22 +931,17 @@ package AD2USB_Door_Item; sub new { - my ($class,$object,$zone) = @_; + my ($class,$interface,$zone,$partition) = @_; my $self = new Generic_Item(); bless $self,$class; - $$self{m_write} = 0; - $$self{m_timerCheck} = new Timer() unless $$self{m_timerCheck}; - $$self{m_timerAlarm} = new Timer() unless $$self{m_timerAlarm}; - $$self{'alarm_action'} = ''; $$self{last_open} = 0; $$self{last_closed} = 0; - $$self{zone_number} = $zone; - $$self{master_object} = $object; $$self{item_type} = 'door'; - $object->register($self,$zone); - + $interface->register($self,$zone); + $zone = sprintf("%03d", $zone); + $$self{zone_partition}{$zone} = $partition; return $self; } @@ -956,25 +956,13 @@ sub set &::print_log("AD2USB_Door_Item($$self{object_name})::set($p_state, $p_setby)") if $main::Debug{AD2USB}; } - if ($p_state =~ /^fault/) { + if ($p_state =~ /^fault/ || $p_state eq 'on') { $p_state = 'open'; $$self{last_open} = $::Time; - } elsif ($p_state =~ /^ready/) { + } elsif ($p_state =~ /^ready/ || $p_state eq 'off') { $p_state = 'closed'; $$self{last_closed} = $::Time; - - # Other door sensors? - } elsif ($p_state eq 'on') { - $p_state = 'open'; - $$self{last_open} = $::Time; - - } elsif ($p_state eq 'off') { - $p_state = 'closed'; - $$self{last_closed} = $::Time; - - } else { - $p_state = 'check'; } $self->SUPER::set($p_state,$p_setby); @@ -995,48 +983,23 @@ sub get_child_item_type { return $$self{item_type}; } -#Left in these methods to maintain compatibility. Since we're not tracking inactivity, these won't return proper results. {{{ - -sub set_alarm($$$) { - my ($self, $time, $action, $repeat_time) = @_; - $$self{'alarm_action'} = $action; - $$self{'alarm_time'} = $time; - $$self{'alarm_repeat_time'} = $repeat_time if defined $repeat_time; - &::print_log ("AD2USB_Door_Item:: set_alarm not supported"); - -} - -sub set_inactivity_alarm($$$) { - my ($self, $time, $action) = @_; - $$self{'inactivity_action'} = $action; - $$self{'inactivity_time'} = $time*3600; - &::print_log("AD2USB_Door_Item:: set_inactivity_alarm not supported"); - -} - #}}} package AD2USB_Motion_Item; @AD2USB_Motion_Item::ISA = ('Generic_Item'); sub new { - my ($class,$object,$zone) = @_; + my ($class,$interface,$zone,$partition) = @_; my $self = new Generic_Item(); bless $self,$class; - $$self{m_write} = 0; - $$self{m_timerCheck} = new Timer() unless $$self{m_timerCheck}; - $$self{m_timerAlarm} = new Timer() unless $$self{m_timerAlarm}; - $$self{'alarm_action'} = ''; $$self{last_still} = 0; $$self{last_motion} = 0; - $$self{zone_number} = $zone; - $$self{master_object} = $object; $$self{item_type} = 'motion'; - - $object->register($self,$zone); - + $interface->register($self,$zone); + $zone = sprintf("%03d", $zone); + $$self{zone_partition}{$zone} = $partition; return $self; } @@ -1055,13 +1018,9 @@ sub set if ($p_state =~ /^fault/i) { $p_state = 'motion'; $$self{last_motion} = $::Time; - } elsif ($p_state =~ /^ready/i) { $p_state = 'still'; $$self{last_still} = $::Time; - - } else { - $p_state = 'check'; } $self->SUPER::set($p_state, $p_setby); @@ -1082,22 +1041,19 @@ sub get_child_item_type { return $$self{item_type}; } -#Left in these methods to maintain compatibility. Since we're not tracking inactivity, these won't return proper results. {{{ -sub delay_off() +package AD2USB_Partition; +@AD2USB_Partition::ISA = ('Generic_Item'); + +sub new { - my ($self,$p_time) = @_; - $$self{m_delay_off} = $p_time if defined $p_time; - &::print_log("AD2USB_Motion_Item:: delay_off not supported"); - return $$self{m_delay_off}; + my ($class,$interface, $partition, $address) = @_; + my $self = new Generic_Item(); + bless $self,$class; + $$interface{partition_address}{$partition} = $address; + $interface->register($self,$partition); + return $self; } -sub set_inactivity_alarm($$$) { - my ($self, $time, $action) = @_; - $$self{'inactivity_action'} = $action; - $$self{'inactivity_time'} = $time*3600; - $$self{m_timerCheck}->set($time*3600, $self); - &::print_log("AD2USB_Motion_Item:: set_inactivity_alarm not supported"); -} =back From d849b54c1e84daca9b3087924d77616d97bfa76e Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Mon, 20 Jan 2014 20:24:53 -0800 Subject: [PATCH 055/180] AD2: Fix Debug Errors, Load Partition Data into Array Correctly --- lib/AD2USB.pm | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 984ec79fd..258c3f564 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -122,7 +122,8 @@ sub new { $$self{instance} = $instance; $$self{reconnect_time} = $::config_parms{$instance.'_ser2sock_recon'}; $$self{reconnect_time} = 10 if !defined($$self{reconnect_time}); - $$self{log_file} = $::config_parms{'data_dir'}."/logs/AD2USB.$::Year_Month_Now.log"; + my $year_mon = &::time_date_stamp( 10, time ); + $$self{log_file} = $::config_parms{'data_dir'}."/logs/AD2USB.$year_mon.log"; bless $self, $class; @@ -277,7 +278,7 @@ sub check_for_data { # restart the TCP connection if its lost. if ($Socket_Items{$instance}{recon_timer}->inactive) { &main::print_log("Connection to $instance instance of AD2USB was lost, I will try to reconnect in $$self{reconnect_time} seconds"); - # ::logit( $$self{log_file}, "AD2USB.pm ser2sock connection lost! Trying to reconnect." ); + # ::logit("AD2USB.pm ser2sock connection lost! Trying to reconnect." ); $Socket_Items{$instance}{recon_timer}->set($$self{reconnect_time}, sub { $Socket_Items{$instance}{'socket'}->start; }); @@ -331,7 +332,8 @@ sub CheckCmd { my $status_type = $self->GetStatusType($CmdStr); my $zone_padded = $status_type->{numeric_code}; my $zone_no_pad = int($zone_padded); - my @partitions = $status_type->{partition}; + my @partitions = @{$status_type->{partition}} + if exists $status_type->{partition}; my $instance = $self->{instance}; if ($status_type->{unknown}) { @@ -374,12 +376,12 @@ sub CheckCmd { $self->ChangeZones( $zone_no_pad, $zone_no_pad, "bypass", "", 1); } elsif ($status_type->{wireless}) { - $self->debug_log( $$self{log_file}, "WIRELESS: rf_id(" + $self->debug_log("WIRELESS: rf_id(" .$status_type->{rf_id}.") status(".$status_type->{rf_status}.") loop1(" .$status_type->{rf_loop_fault_1}.") loop2(".$status_type->{rf_loop_fault_2} .") loop3(".$status_type->{rf_loop_fault_3}.") loop4(" .$status_type->{rf_loop_fault_4}.")" ); - $self->debug_log( $$self{log_file}, "WIRELESS: rf_id(" + $self->debug_log("WIRELESS: rf_id(" .$status_type->{rf_id}.") status(".$status_type->{rf_status}.") low_batt(" .$status_type->{rf_low_batt}.") supervised(".$status_type->{rf_supervised} .")" ); @@ -461,12 +463,9 @@ sub CheckCmd { if ( $status_type->{ready_flag}) { my $bypass = ($status_type->{bypassed_flag}) ? 'bypass' : ''; # Reset all zones, if bypass enabled skip bypassed zones - foreach my $partition (@partitions){ + for my $partition (@partitions){ $self->ChangeZones( 1, 999, "ready", $bypass, 1, $partition); } - # TODO - If the partition is set to STAY, does a fault on a motion - # sensor cause the ready flag to be set to 0? If not, then we need - # to avoid alterning mapped zones. } # ARMED AWAY @@ -530,12 +529,12 @@ sub CheckCmd { # ALARM WAS TRIGGERED (Sticky until disarm) if ( $status_type->{alarm_past_flag}) { my $EventName = "ALARM WAS TRIGGERED"; - $self->debug_log( $$self{log_file}, "$EventName" ); + $self->debug_log("$EventName" ); } # ALARM IS SOUNDING if ( $status_type->{alarm_now_flag}) { - $self->debug_log( $$self{log_file}, "ALARM IS SOUNDING - Zone $zone_no_pad (".$self->zone_name($zone_no_pad).")" ); + $self->debug_log("ALARM IS SOUNDING - Zone $zone_no_pad (".$self->zone_name($zone_no_pad).")" ); $self->ChangeZones( $zone_no_pad, $zone_no_pad, "alarm", "", 1); } @@ -592,7 +591,7 @@ sub GetStatusType { if (scalar $message{partition} == 0){ # The addresses identified in this message did not match any defined # partition addresses, default to putting in partition 1. - @{$message{partition}} = (1); #Default to partition 1 + push(@{$message{partition}}, 1); #Default to partition 1 } # Decipher and Set Bit Flags @@ -678,7 +677,7 @@ sub ChangeZones { && (!$partition || ($partition == $self->zone_partition($i)))) { if ($log == 1) { my $ZoneNumPadded = sprintf("%03d", $i); - $self->debug_log( $$self{log_file}, "Zone $i (".$self->zone_name($i) + $self->debug_log( "Zone $i (".$self->zone_name($i) .") changed from '$current_status' to '$new_status'" ); } $$self{$self->zone_partition($i)}{zone_status}{$i} = $new_status; @@ -786,13 +785,13 @@ sub cmd { # Exit if unknown command if ( $CmdName =~ /^unknown/ ) { - ::logit( $$self{log_file}, "Invalid ADEMCO panel command : $CmdName ($cmd)"); + ::logit("Invalid ADEMCO panel command : $CmdName ($cmd)"); return; } # Exit if password is wrong if ( ($password ne $Configuration{$instance.'_user_master_code'}) && ($CmdName ne "ShowFaults" ) ) { - ::logit( $$self{log_file}, "Invalid password for command $CmdName ($password)"); + ::logit("Invalid password for command $CmdName ($password)"); return; } From c4dae63b5dc51f3b0f6ad3f5c690b66d903cf147 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Tue, 28 Jan 2014 18:00:00 -0800 Subject: [PATCH 056/180] AD2: Try to Clean Up State Messages This is only a start. --- lib/AD2USB.pm | 38 +++++++++++++++++++++++++++++--------- 1 file changed, 29 insertions(+), 9 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 258c3f564..9efbcc5e1 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -458,10 +458,16 @@ sub CheckCmd { } # Set things based on Bit Codes + + # Prep mode for future use + my $mode = ''; + $mode = 'fault' if $status_type->{fault}; # READY if ( $status_type->{ready_flag}) { my $bypass = ($status_type->{bypassed_flag}) ? 'bypass' : ''; + $mode = 'ready'; + $mode = 'bypass' if $bypass; # Reset all zones, if bypass enabled skip bypassed zones for my $partition (@partitions){ $self->ChangeZones( 1, 999, "ready", $bypass, 1, $partition); @@ -471,7 +477,7 @@ sub CheckCmd { # ARMED AWAY if ( $status_type->{armed_away_flag}) { # TODO The setting of modes needs to be done on partitions - my $mode = "ERROR"; + my $mode = "armed away - error"; if (index($status_type->{alphanumeric}, "ALL SECURE")) { $mode = "armed away"; } @@ -482,15 +488,25 @@ sub CheckCmd { $mode = "entry delay"; } elsif (index($status_type->{alphanumeric}, "ZONE BYPASSED")) { - $mode = "armed away"; + $mode = "armed away - bypass"; } - - $self->set($mode); } # ARMED HOME if ( $status_type->{armed_home_flag}) { - $self->set("armed stay"); + $mode = "armed stay - error"; + if (index($status_type->{alphanumeric}, "You may exit now")) { + $mode = "exit delay"; + } + elsif (index($status_type->{alphanumeric}, "or alarm occurs")) { + $mode = "entry delay"; + } + elsif (index($status_type->{alphanumeric}, "ZONE BYPASSED")) { + $mode = "armed stay - bypass"; + } + elsif (index($status_type->{alphanumeric}, "***STAY***")) { + $mode = "armed stay"; + } } # BACKLIGHT @@ -500,6 +516,7 @@ sub CheckCmd { # PROGRAMMING MODE if ( $status_type->{programming_flag}) { + $mode = "programming"; $self->debug_log("Panel is in programming mode"); } @@ -509,14 +526,11 @@ sub CheckCmd { $self->debug_log("Panel beeped $NumBeeps times"); } - # A ZONE OR ZONES ARE BYPASSED - if ( $status_type->{bypassed_flag}) { - } - # AC POWER $$self{ac_power} = 1; if ( !$status_type->{ac_flag} ) { $$self{ac_power} = 0; + $mode = "ac power lost"; $self->debug_log("AC Power has been lost");; } @@ -529,11 +543,13 @@ sub CheckCmd { # ALARM WAS TRIGGERED (Sticky until disarm) if ( $status_type->{alarm_past_flag}) { my $EventName = "ALARM WAS TRIGGERED"; + $mode = "alarm was triggered"; $self->debug_log("$EventName" ); } # ALARM IS SOUNDING if ( $status_type->{alarm_now_flag}) { + $mode = "alarm now sounding"; $self->debug_log("ALARM IS SOUNDING - Zone $zone_no_pad (".$self->zone_name($zone_no_pad).")" ); $self->ChangeZones( $zone_no_pad, $zone_no_pad, "alarm", "", 1); } @@ -542,8 +558,12 @@ sub CheckCmd { $self->{battery_low} = 0; if ( $status_type->{battery_low_flag}) { $self->{battery_low} = 1; + $mode = "battery low"; $self->debug_log("Panel is low on battery");; } + if ($mode ne $self->state && $mode ne ''){ + $self->set($mode); + } } return; } From 49fe3931e2fa16baf40531304aa33deefcd317f2 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Tue, 28 Jan 2014 18:10:00 -0800 Subject: [PATCH 057/180] AD2: Don't Reset Mapped Zones Based on Alpha Messages Mapped zones are faulted by direct messages received from the AD2. This correction fixes the following oddity: ------- Zones 1 and 3 are faulted. The Alpha message describing the Zone 3 fault just arrived. Zone 10, a mapped zone is then faulted. The fault is immediately detected by an EXP! message. MH updates the status of zone 10 to faulted. AD2 then starts over with the Alpha fault list by sending the Alpha message that Zone 1 is faulted. Since the last alpha fault received was zone 3, MH resets all zones between 3 -> 1 as ready, clearing out 10. Two messages later, the Alpha message for zone 10 arrives, putting zone 10 back in a faulted state. ------- This fixes the oddity by not reseting any mapped zones based on alpha messages. --- lib/AD2USB.pm | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 9efbcc5e1..92f35e8b7 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -360,9 +360,11 @@ sub CheckCmd { foreach my $partition (@partitions){ #Reset the zones between the current zone and the last zone. If zones #are sequential do nothing, if same zone, reset all other zones + #Do not reset mapped zones, specific messages are recevied for these if ($self->{zone_last_num}{$partition} - $zone_no_pad > 1 || $self->{zone_last_num}{$partition} - $zone_no_pad == 0) { - $self->ChangeZones( $self->{zone_last_num}{$partition}+1, $zone_no_pad-1, "ready", "bypass", 1, $partition); + $self->ChangeZones( $self->{zone_last_num}{$partition}+1, + $zone_no_pad-1, "ready", "bypass", 1, $partition,1); } # Set this zone to faulted @@ -684,7 +686,8 @@ sub GetStatusType { #}}} # Change zone statuses for zone indices from start to end {{{ sub ChangeZones { - my ($self, $start, $end, $new_status, $neq_status, $log, $partition) = @_; + my ($self, $start, $end, $new_status, $neq_status, $log, $partition, + $skip_mapped) = @_; my $instance = $self->{instance}; # Allow for reverse looping from 999->1 @@ -694,7 +697,8 @@ sub ChangeZones { my $current_status = $$self{$self->zone_partition($i)}{zone_status}{$i}; # If partition set, then zone partition must equal that if (($current_status ne $new_status) && ($current_status ne $neq_status) - && (!$partition || ($partition == $self->zone_partition($i)))) { + && (!$partition || ($partition == $self->zone_partition($i))) + && (!$skip_mapped || (!$self->is_zone_mapped($i))) { if ($log == 1) { my $ZoneNumPadded = sprintf("%03d", $i); $self->debug_log( "Zone $i (".$self->zone_name($i) @@ -778,9 +782,9 @@ sub debug_log { #}}} # Define hash with all zone numbers and names {{{ -sub MappedZones { +sub is_zone_mapped { my ($self, $zone) = @_; - my $instance = $self->{instance}; + $zone = sprintf "%03s", $zone; foreach my $mkey (keys $$self{relay}) { if ($zone eq $$self{relay}{$mkey}) { return 1 } } From d829384d16290dd1b677c2b0210ce8d335b88fa7 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Tue, 28 Jan 2014 18:30:00 -0800 Subject: [PATCH 058/180] AD2: Don't Perform Wrap-Around Reset, Unless Highest Zone is Consistent The alphanumeric fault messages are more complicated than i realized. The list of faulted zones restarts at the lowest faulted zone everytime a fault occurs. So for example, if zones 1-5 are faulted, and the panel has just finished sending the zone 3 fault message, if zone 7 is then faulted, the next message will be a zone 1 fault again. If we blindly perform wrap-around resets, it is very easy to create a "fluttering" zone when multiple zones are faulted. To cut down on the potential for fluttering, this change only performs a wrap-around reset if the highest faulted zone that is reported remains constant for 2 cycles. While not completly ensuring that all zones have been report, it is unlikely that the panel will be interrupted at exactly the same point in its cycle twice. The major downside of this, is that there may be a slight delay in reseting zones from fault -> ready. This is particularly true of the higher unmapped zones. --- lib/AD2USB.pm | 28 ++++++++++++++++++---------- 1 file changed, 18 insertions(+), 10 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 92f35e8b7..5f90201f2 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -353,18 +353,26 @@ sub CheckCmd { cmd( $self, "ShowFaults" ); } elsif ($status_type->{fault}) { - # Each fault message tells us two things, 1) this zone is faulted and - # 2) all zones between this zone and the last fault are ready. - #Loop through partions set in message foreach my $partition (@partitions){ - #Reset the zones between the current zone and the last zone. If zones - #are sequential do nothing, if same zone, reset all other zones + #If zone numbers are sequential, there is nothing to do. + #Reset the zones between the current zone and the last zone. #Do not reset mapped zones, specific messages are recevied for these - if ($self->{zone_last_num}{$partition} - $zone_no_pad > 1 - || $self->{zone_last_num}{$partition} - $zone_no_pad == 0) { - $self->ChangeZones( $self->{zone_last_num}{$partition}+1, - $zone_no_pad-1, "ready", "bypass", 1, $partition,1); + #If the current zone is lower than the previous zone, only reset zones + #in between if highest zone has remained constant for one full cycle + if ($self->{zone_last_num}{$partition} - $zone_no_pad != 1) { + if (($self->{zone_last_num}{$partition} <= $zone_no_pad) && + $self->{highest_zone}{$partition} != $self->{zone_last_num}{$partition}){ + $self->{highest_zone}{$partition} = $zone_no_pad; + # Do not reset the zones in between. This is a new highest zone + # number. Can't be sure if the zone list completed a full cycle + } + else { + $self->ChangeZones( $self->{zone_last_num}{$partition}+1, + $zone_no_pad-1, "ready", "bypass", 1, $partition,1); + $self->{highest_zone}{$partition} = $zone_no_pad + if ($self->{zone_last_num}{$partition} <= $zone_no_pad); + } } # Set this zone to faulted @@ -698,7 +706,7 @@ sub ChangeZones { # If partition set, then zone partition must equal that if (($current_status ne $new_status) && ($current_status ne $neq_status) && (!$partition || ($partition == $self->zone_partition($i))) - && (!$skip_mapped || (!$self->is_zone_mapped($i))) { + && (!$skip_mapped || (!$self->is_zone_mapped($i)))) { if ($log == 1) { my $ZoneNumPadded = sprintf("%03d", $i); $self->debug_log( "Zone $i (".$self->zone_name($i) From 72dd7953bf19866529455ce08b07ff26aa9754bb Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Wed, 29 Jan 2014 18:30:00 -0800 Subject: [PATCH 059/180] AD2: Optimize CPU Usage Try to optimize code as much as possible. On a dual core machine, using AD2 code seems to add between .3-.7% CPU usage to one of the cores. I think this is mostly a side effect of using a socket. --- lib/AD2USB.pm | 39 ++++++++++++++++++++++++--------------- 1 file changed, 24 insertions(+), 15 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 5f90201f2..e8daf4c00 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -122,6 +122,7 @@ sub new { $$self{instance} = $instance; $$self{reconnect_time} = $::config_parms{$instance.'_ser2sock_recon'}; $$self{reconnect_time} = 10 if !defined($$self{reconnect_time}); + $$self{max_zones} = 250; #The current max zones by any panel, can be increased my $year_mon = &::time_date_stamp( 10, time ); $$self{log_file} = $::config_parms{'data_dir'}."/logs/AD2USB.$year_mon.log"; @@ -136,7 +137,7 @@ sub new { # AD2USB_part_log AD2USB_zone_log AD2USB_debug_log #Set all zones and partitions to ready - $self->ChangeZones( 1, 999, "ready", "ready", 0); + $self->ChangeZones( 1, $$self{max_zones}, "ready", "ready", 0); #Store Object with Instance Name $self->set_object_instance($instance); @@ -307,13 +308,14 @@ sub check_for_data { (!$status_type->{fault})) { # This is a duplicate panel message with no important status $self->debug_log("DUPE: $Cmd"); +::print_log("[krk] end dupe " . &main::get_tickcount); } else { # This is a non-dupe panel message or a fault panel message or a # relay or RF or zone expander message or something important # Log the message, parse it, and store it to detect future dupes $self->debug_log("MSG: $Cmd"); - $self->CheckCmd($Cmd); + $self->CheckCmd($status_type); $self->{last_cmd} = $Cmd if ($status_type->{keypad}); } } @@ -328,8 +330,7 @@ sub check_for_data { # Validate the command and perform action {{{ sub CheckCmd { - my ($self, $CmdStr) = @_; - my $status_type = $self->GetStatusType($CmdStr); + my ($self, $status_type) = @_; my $zone_padded = $status_type->{numeric_code}; my $zone_no_pad = int($zone_padded); my @partitions = @{$status_type->{partition}} @@ -337,7 +338,7 @@ sub CheckCmd { my $instance = $self->{instance}; if ($status_type->{unknown}) { - $self->debug_log("UNKNOWN STATUS: $CmdStr"); + $self->debug_log("UNKNOWN STATUS: $status_type->{cmd}"); } elsif ($status_type->{cmd_sent}) { if ($self->{keys_sent} == 0) { @@ -480,7 +481,7 @@ sub CheckCmd { $mode = 'bypass' if $bypass; # Reset all zones, if bypass enabled skip bypassed zones for my $partition (@partitions){ - $self->ChangeZones( 1, 999, "ready", $bypass, 1, $partition); + $self->ChangeZones( 1, $$self{max_zones}, "ready", $bypass, 1, $partition); } } @@ -584,6 +585,7 @@ sub GetStatusType { my ($self, $AdemcoStr) = @_; my $instance = $self->{instance}; my %message; + $message{cmd} = $AdemcoStr; # Panel Message Format if ($AdemcoStr =~ /(!KPM:)?\[([\d-]*)\],(\d{3}),\[(.*)\],\"(.*)\"/) { @@ -697,8 +699,9 @@ sub ChangeZones { my ($self, $start, $end, $new_status, $neq_status, $log, $partition, $skip_mapped) = @_; my $instance = $self->{instance}; + $end = $$self{max_zones} if $end <=0 ; - # Allow for reverse looping from 999->1 + # Allow for reverse looping from max_zones->1 my $reverse = ($start > $end)? 1 : 0; for (my $i = $start; (!$reverse && $i <= $end) || ($reverse && ($i >= $start || $i <= $end)); $i++) { @@ -725,7 +728,7 @@ sub ChangeZones { $$self{parition_object}{$zone_partition}->set($partition_status, $$self{zone_object}{"$i"}) if defined $$self{parition_object}{$zone_partition}; } - $i = 0 if ($i == 999 && $reverse); #loop around + $i = 0 if ($i == $$self{max_zones} && $reverse); #loop around } } @@ -789,18 +792,24 @@ sub debug_log { } #}}} -# Define hash with all zone numbers and names {{{ +# Returns true if zone is mapped {{{ sub is_zone_mapped { my ($self, $zone) = @_; $zone = sprintf "%03s", $zone; - foreach my $mkey (keys $$self{relay}) { - if ($zone eq $$self{relay}{$mkey}) { return 1 } + if (defined $$self{relay}){ + foreach my $mkey (keys $$self{relay}) { + if ($zone eq $$self{relay}{$mkey}) { return 1 } + } } - foreach my $mkey (keys $$self{wireless}) { - if ($zone eq $$self{wireless}{$mkey}) { return 1 } + if (defined $$self{wireless}){ + foreach my $mkey (keys $$self{wireless}) { + if ($zone eq $$self{wireless}{$mkey}) { return 1 } + } } - foreach my $mkey (keys $$self{expander}) { - if ($zone eq $$self{expander}{$mkey}) { return 1 } + if (defined $$self{expander}){ + foreach my $mkey (keys $$self{expander}) { + if ($zone eq $$self{expander}{$mkey}) { return 1 } + } } return 0; } From 9083488a886b0794927e431f433b7a35496ac8d9 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Wed, 29 Jan 2014 18:32:00 -0800 Subject: [PATCH 060/180] AD2: Remove Extraneous Debuging Message --- lib/AD2USB.pm | 1 - 1 file changed, 1 deletion(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index e8daf4c00..27e9f8c2b 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -308,7 +308,6 @@ sub check_for_data { (!$status_type->{fault})) { # This is a duplicate panel message with no important status $self->debug_log("DUPE: $Cmd"); -::print_log("[krk] end dupe " . &main::get_tickcount); } else { # This is a non-dupe panel message or a fault panel message or a From b3ac8283a33013fd6d0d3c5d555235a529607723 Mon Sep 17 00:00:00 2001 From: Sean Mathews Date: Fri, 31 Jan 2014 06:55:42 +0000 Subject: [PATCH 061/180] fixed to work with newer MH and perl5. Added trending of barom the wm2 does not support it --- lib/Weather_daviswm2.pm | 141 ++++++++++++++++++++++++++++++++++++---- 1 file changed, 130 insertions(+), 11 deletions(-) diff --git a/lib/Weather_daviswm2.pm b/lib/Weather_daviswm2.pm index 20c018bcb..6ed731a4a 100644 --- a/lib/Weather_daviswm2.pm +++ b/lib/Weather_daviswm2.pm @@ -3,6 +3,7 @@ package Weather_daviswm2; # $Date$ # $Revision$ +use Tie::IxHash; use strict; use Weather_Common; eval 'use Digest::mhCRC qw(crc16);'; @@ -20,6 +21,43 @@ for the Davis Weather Monitor II weather stations. Matt Williams reworked it to interface correctly with mh and to make it a module Jack Edin was heavily involved in testing and was the impedus behind the creation of this module. +1/27/2014 +Sean Mathews + +sponsored by a close friend and fellow maker Jack Edin 1961-2012 RIP +Movie nights and project days will be missed. + +added barometric tendency calculation. The wm2 has a visual indicator of the barometric trend but +it can not be accessed via the serial port protocol. + +the barometric tendency indications based upon a given change over a one hour period. + http://www.erh.noaa.gov/box/glossary.htm + "Rising Rapidly" is indicated if the pressure increases > 2 mb (0.06") + "Rising Slowly" is indicated if the pressure increases >1 mb but < 2 mb (> 0.02" but < 0.06") + "Steady" is indicated if the pressure changes < 1 mb (< 0.02") + "Falling Slowly" is indicated if the pressure falls > 1 mb but < 2 mb (> 0.02" but < 0.06") + "Falling Rapidly" is indicated when the pressure decreases > 2 mb (>0.06") + "Unsteady" unknown lack of samples or last sample fluctuated by 0.03 or more + +in order to still get some trends before I have a long enough sample time I have opted to use this +psudo code. + collect a sample and add to fifo array + expire any samples older than 1 hours from the sample we just took + if last > 0 and deviation from last > .03" ( last is 0 on startup ) + report "Unsteady" + else + if the sample array has a minimum of 10 samples + find average oldest(head) 5 samples for oldest barom + find average newest(tail) 5 samples for current barom + report indicator based upon this calculation above + else + report "" + + + + + + Note: You must enable this module by setting the following parameters in mh{.private}.ini. Obviously you must point the port to the actual port to which the station is connected. serial_daviswm2_port=COM10 @@ -33,13 +71,18 @@ our $loopCommand = join "", "LOOP", chr(255), chr(255), chr(13); our $DavisWMII_port; our $lastRainReading = undef; our $lastRainReadingTime = undef; +my $barom_tendency = ""; +my %barom_samples = undef; +my $barom_samples = undef; + +$barom_samples = tie %barom_samples, 'Tie::IxHash'; sub startup{ my ($instance)=@_; $DavisWMII_port = new Serial_Item(undef, undef, 'serial_daviswm2'); &requestData; &::MainLoop_pre_add_hook(\&Weather_daviswm2::update,1); - &::trigger_set('&new_minute','&Weather_daviswm2::requestData','NoExpire','daviswm2 data request') + &::trigger_set('new_minute(1)','&Weather_daviswm2::requestData','NoExpire','daviswm2 data request') unless &::trigger_get('daviswm2 data request'); } @@ -93,7 +136,7 @@ sub process{ my @data = unpack('C*',$data); my $gotheader = 0; - if ($::Debug{Weather}) { + if ($::Debug{weather}) { my $debugInfo='daviswm2: Read from Davis WM II '; for (@data) { $debugInfo .= sprintf ("0x%x ",$_); @@ -118,15 +161,15 @@ sub process{ $rain_rate); # go through data until we have found a header - &::print_log ("daviswm2: looking for header") if $::Debug{Weather}; + &::print_log ("daviswm2: looking for header") if $::Debug{weather}; my $headerByte; while (defined($headerByte=shift(@data))) { next if $headerByte != 1; # need a 1 at start of data - &::print_log ("daviswm2: found header, checking length and crc16 of remaining data") if $::Debug{Weather}; + &::print_log ("daviswm2: found header, checking length and crc16 of remaining data") if $::Debug{weather}; $data=pack('C*',@data); if (length($data) < 17) { # we need 17 bytes left to proceed - &::print_log("daviswm2: not enough bytes left to process") if $::Debug{Weather}; - return $headerByte.$data; # need to return the header byte as well + &::print_log("daviswm2: not enough bytes left to process") if $::Debug{weather}; + return chr($headerByte).$data; # need to return the header byte as well } ($indoor_temp, $outdoor_temp, @@ -139,7 +182,7 @@ sub process{ $not_used, $crc16)=unpack('vvCvvCCvvn', $data); if (Digest::mhCRC::crc16(substr($data,0,15)) != $crc16) { - &::print_log ("daviswm2: wrong crc16, looking again for header") if $::Debug{Weather}; + &::print_log ("daviswm2: wrong crc16, looking again for header") if $::Debug{weather}; next; } # remove the 17 bytes that we just processed, we'll use the remainder as our return value @@ -149,20 +192,94 @@ sub process{ # return because we didn't find a header :-( if ($headerByte != 1) { - &::print_log ("daviswm2: ran out of bytes and didn't find a header") if $::Debug{Weather}; + &::print_log ("daviswm2: ran out of bytes and didn't find a header") if $::Debug{weather}; # don't use $data as return value as it only has a valid # value if a good header/packet is found return ''; } - &::print_log ("daviswm2: found a header with the right checksum") if $::Debug{Weather}; + &::print_log ("daviswm2: found a header with the right checksum") if $::Debug{weather}; # correct reading from reported to actual (just moving the decimal point) $indoor_temp/=10.0; $outdoor_temp/=10.0; $barometer/=1000.0; $total_rain/=10.0; + + + # barometric trend analysis + my $btr_current_sample_time = time; + + ## save our barometric reading + $barom_samples{$btr_current_sample_time} = $barometer; + + &::print_log ("daviswm2: barometric samples") if $::Debug{weather}; + + ## do the analysis on our dataset + my $btr_tmp_counter = 0; + my $btr_sum_head = 0.0; + my $btr_sum_tail = 0.0; + my ( $btr_datetime, $btr_barom , $btr_exflag, @btr_expire_list ); + while (( $btr_datetime, $btr_barom ) = each %barom_samples ) { + + # If the sample is older then 1 hour add to our remove list + my $datediff = $btr_current_sample_time - $btr_datetime; + if ( $datediff > 3600 ) { # 3600s = 1 hour + push ( @btr_expire_list, $btr_datetime ); + $btr_exflag = "*" if $::Debug{weather}; + } else { + $btr_exflag = " " if $::Debug{weather}; + } + if ( $barom_samples->Length >= 10 ) { + if ( $btr_tmp_counter < 5 ) { + $btr_sum_head += $btr_barom; + $btr_exflag .= "T" if $::Debug{weather}; + } else { + if ( $btr_tmp_counter >= $barom_samples->Length - 5 ) { + $btr_sum_tail += $btr_barom; + $btr_exflag .= "H" if $::Debug{weather}; + } + } + } + if ( $::Debug{weather} ) { + &::print_log ("daviswm2: " . localtime($btr_datetime) . " -> $btr_barom $btr_exflag $datediff" ); + } + $btr_tmp_counter++; + } + + ## calculate our average over 5 samples + $btr_sum_head /= 5.0; + $btr_sum_tail /= 5.0; + + ## calculate our difference + my $btr_diff = $btr_sum_tail - $btr_sum_head; + + ## fetch last sample + my $btr_last_diff = abs($barometer - $barom_samples->Values( $barom_samples->Length - 2 )); + my $btr_last_value = $barom_samples->Values( $barom_samples->Length - 2 ); + + &::print_log ("daviswm2: last value($btr_last_value) diff($btr_last_diff)" ) if $::Debug{weather}; + ## calculate tendency + if ( $btr_last_diff >= .03 or $barom_samples->Length < 15 ) { + &::print_log ("daviswm2: unsteading reading $btr_last_diff $btr_last_value" ) if $::Debug{weather}; + $barom_tendency = "unsteady"; + } else { + $barom_tendency = "rising rapidly" if $btr_diff > 0.06; + $barom_tendency = "rising slowly" if $btr_diff > 0.02 and $btr_diff < 0.06; + $barom_tendency = "steady" if abs($btr_diff) < 0.02; + $barom_tendency = "falling rapidly" if $btr_diff < -0.06; + $barom_tendency = "falling slowly" if $btr_diff < -0.02 and $btr_diff > -0.06; + } + + &::print_log ("daviswm2: head($btr_sum_head) tail($btr_sum_tail)") if $::Debug{weather}; + + ## remove expired values + foreach ( @btr_expire_list ) { + $barom_samples->DELETE($_); + } + + # calculate sea level pressure my $barometer_sea=convert_local_barom_to_sea_in($barometer); @@ -241,8 +358,10 @@ sub process{ $$wptr{HumidOutdoor}=$outdoor_humidity; $$wptr{RainTotal}=$total_rain; $$wptr{RainRate}=$rain_rate; - - if ($::Debug{Weather}) { + $$wptr{BaromDelta}=$barom_tendency; + $$wptr{Conditions}="cloudy"; + + if ($::Debug{weather}) { foreach my $key qw( TempIndoor TempOutdoor From e015b200262811091d59ebc4fd5afc824b3f253d Mon Sep 17 00:00:00 2001 From: Sean Mathews Date: Fri, 31 Jan 2014 08:20:50 +0000 Subject: [PATCH 062/180] remove missed test code --- lib/Weather_daviswm2.pm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lib/Weather_daviswm2.pm b/lib/Weather_daviswm2.pm index 6ed731a4a..e585ccce0 100644 --- a/lib/Weather_daviswm2.pm +++ b/lib/Weather_daviswm2.pm @@ -344,7 +344,7 @@ sub process{ ); } - $$wptr{TempIndoor}=$indoor_temp; + $$wptr{TempIndoor}=$indoor_temp-4; $$wptr{TempOutdoor}=$outdoor_temp; $$wptr{DewIndoor}=$indoor_dewpoint; $$wptr{DewOutdoor}=$outdoor_dewpoint; @@ -359,7 +359,6 @@ sub process{ $$wptr{RainTotal}=$total_rain; $$wptr{RainRate}=$rain_rate; $$wptr{BaromDelta}=$barom_tendency; - $$wptr{Conditions}="cloudy"; if ($::Debug{weather}) { foreach my $key qw( From 08ff775b69630d9f7639ca49f0220bfad3feee61 Mon Sep 17 00:00:00 2001 From: Sean Mathews Date: Fri, 31 Jan 2014 08:22:29 +0000 Subject: [PATCH 063/180] remove missed test code --- lib/Weather_daviswm2.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Weather_daviswm2.pm b/lib/Weather_daviswm2.pm index e585ccce0..933d4dabf 100644 --- a/lib/Weather_daviswm2.pm +++ b/lib/Weather_daviswm2.pm @@ -344,7 +344,7 @@ sub process{ ); } - $$wptr{TempIndoor}=$indoor_temp-4; + $$wptr{TempIndoor}=$indoor_temp; $$wptr{TempOutdoor}=$outdoor_temp; $$wptr{DewIndoor}=$indoor_dewpoint; $$wptr{DewOutdoor}=$outdoor_dewpoint; From 2f29a0efe21b2a065254577f778a75ad0ed08979 Mon Sep 17 00:00:00 2001 From: Sean Mathews Date: Fri, 31 Jan 2014 17:48:58 +0000 Subject: [PATCH 064/180] added BaromDelta to final debug output --- lib/Weather_daviswm2.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lib/Weather_daviswm2.pm b/lib/Weather_daviswm2.pm index 933d4dabf..cf86e7445 100644 --- a/lib/Weather_daviswm2.pm +++ b/lib/Weather_daviswm2.pm @@ -344,7 +344,7 @@ sub process{ ); } - $$wptr{TempIndoor}=$indoor_temp; + $$wptr{TempIndoor}=$indoor_temp-3; $$wptr{TempOutdoor}=$outdoor_temp; $$wptr{DewIndoor}=$indoor_dewpoint; $$wptr{DewOutdoor}=$outdoor_dewpoint; @@ -359,7 +359,8 @@ sub process{ $$wptr{RainTotal}=$total_rain; $$wptr{RainRate}=$rain_rate; $$wptr{BaromDelta}=$barom_tendency; - + $$wptr{Conditions}="rain"; + if ($::Debug{weather}) { foreach my $key qw( TempIndoor @@ -370,6 +371,7 @@ sub process{ WindAvgDir Barom BaromSea + BaromDelta HumidIndoor HumidOutdoor RainTotal From 25122068b6b5860656cbb1550e73deed8c1fe5ce Mon Sep 17 00:00:00 2001 From: Sean Mathews Date: Fri, 31 Jan 2014 17:56:39 +0000 Subject: [PATCH 065/180] remove debug data meh --- lib/Weather_daviswm2.pm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lib/Weather_daviswm2.pm b/lib/Weather_daviswm2.pm index cf86e7445..db38031b6 100644 --- a/lib/Weather_daviswm2.pm +++ b/lib/Weather_daviswm2.pm @@ -344,7 +344,7 @@ sub process{ ); } - $$wptr{TempIndoor}=$indoor_temp-3; + $$wptr{TempIndoor}=$indoor_temp; $$wptr{TempOutdoor}=$outdoor_temp; $$wptr{DewIndoor}=$indoor_dewpoint; $$wptr{DewOutdoor}=$outdoor_dewpoint; @@ -359,7 +359,6 @@ sub process{ $$wptr{RainTotal}=$total_rain; $$wptr{RainRate}=$rain_rate; $$wptr{BaromDelta}=$barom_tendency; - $$wptr{Conditions}="rain"; if ($::Debug{weather}) { foreach my $key qw( From 658313a8422e24518f46987a42d6f7ac497881d6 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sun, 2 Feb 2014 12:32:00 -0800 Subject: [PATCH 066/180] AD2: Redesign Declaration of Wireless Items; Grandfather in Old Ini Declaration The old design for the ini declaration was a little confusing. Plus, carrying it over directly into the Configation Hash did not allow for mht style declarations of a wireless object. The new design seems more logical to me and adds the framework to support an mht style declaration. The old design for ini declarations is stil supported for backwards compatibility. --- lib/AD2USB.pm | 78 +++++++++++++++++++++++++++++---------------------- 1 file changed, 44 insertions(+), 34 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 27e9f8c2b..3b694031b 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -171,7 +171,31 @@ sub read_parms{ $Configuration{$mkey} = $::config_parms{$mkey} if $mkey =~ /^AD2USB_/; #Put wireless settings in correct hash if ($mkey =~ /^${instance}_wireless_(.*)/){ - $$self{wireless}{$1} = $::config_parms{$mkey}; + if (index($::config_parms{$mkey}, ',') <= 0){ + #Supports new style ini parameter, wherein each zone is a separate entry: + #AD2USB_wireless_[RF_ID],[LOOP],[TYPE]=[ZONE] such as: + #AD2USB_wireless_1234567,1,k=10 + $$self{wireless}{$1} = $::config_parms{$mkey}; + } + else { + #This code supports the old style ini of wirelss parameters: + #AD2USB_wireless_[RF_ID]=[ZONE],[TYPE][LOOP](,repeat) such as: + #AD2USB_wireless_1234567=10,s1 + my $rf_id = $1; + my $lc = 0; + my $ZoneNum; + foreach my $wnum(split(",", $::config_parms{$mkey})) { + if ($lc % 2 == 0) { + $ZoneNum = $wnum; + } + else { + my ($sensortype, $ZoneLoop) = split("", $wnum); + $$self{wireless}{"$rf_id,$ZoneLoop,$sensortype"} + = $ZoneNum; + } + $lc++; + } + } } #Put expander settings in correct hash if ($mkey =~ /^${instance}_expander_(.*)/){ @@ -186,7 +210,7 @@ sub read_parms{ $$self{partition_address}{$1} = $::config_parms{$mkey}; } #Put Zone Names in Correct Hash - if ($mkey =~ /^${instance}_partition_(\d*)$/){ + if ($mkey =~ /^${instance}_zone_(\d*)$/){ $$self{zone_name}{$1} = $::config_parms{$mkey}; } #Put Zone Partition Relationship in Correct Hash @@ -386,8 +410,9 @@ sub CheckCmd { $self->ChangeZones( $zone_no_pad, $zone_no_pad, "bypass", "", 1); } elsif ($status_type->{wireless}) { + my $rf_id = $status_type->{rf_id}; $self->debug_log("WIRELESS: rf_id(" - .$status_type->{rf_id}.") status(".$status_type->{rf_status}.") loop1(" + .$rf_id.") status(".$status_type->{rf_status}.") loop1(" .$status_type->{rf_loop_fault_1}.") loop2(".$status_type->{rf_loop_fault_2} .") loop3(".$status_type->{rf_loop_fault_3}.") loop4(" .$status_type->{rf_loop_fault_4}.")" ); @@ -396,40 +421,25 @@ sub CheckCmd { .$status_type->{rf_low_batt}.") supervised(".$status_type->{rf_supervised} .")" ); - if (defined $$self{wireless}{$status_type->{rf_id}}) { - my ($MZoneLoop, $PartStatus, $ZoneNum); - my $lc = 0; - my $ZoneStatus = "ready"; + foreach my $rf_key (keys $$self{wireless}){ + if ($rf_key =~ /^${rf_id}(.*)/) { + my $LoopNum = 1; + my $SensorType = 's'; + ($LoopNum, $SensorType) = split(',', $1); + my $ZoneNum = $$self{wireless}{$rf_key}; - # Assign status (zone and partition) - if ($status_type->{rf_low_batt} == "1") { - $ZoneStatus = "low battery"; - } - - foreach my $wnum(split(",", $$self{wireless}{$status_type->{rf_id}})) { - if ($lc % 2 == 0) { - $ZoneNum = $wnum; + my $ZoneStatus = "ready"; + if ($status_type->{rf_low_batt} == "1") { + $ZoneStatus = "low battery"; } - else { - my ($sensortype, $ZoneLoop) = split("", $wnum); - if ($ZoneLoop eq "1") {$MZoneLoop = $status_type->{rf_loop_fault_1}} - if ($ZoneLoop eq "2") {$MZoneLoop = $status_type->{rf_loop_fault_2}} - if ($ZoneLoop eq "3") {$MZoneLoop = $status_type->{rf_loop_fault_3}} - if ($ZoneLoop eq "4") {$MZoneLoop = $status_type->{rf_loop_fault_4}} - - if ("$MZoneLoop" eq "1") { - $ZoneStatus = "fault"; - } elsif ("$MZoneLoop" eq 0) { - $ZoneStatus = "ready"; - } - - $self->ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); - if ($sensortype eq "k") { - $ZoneStatus = "ready"; - $self->ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); - } + if ($status_type->{'rf_loop_fault_'.$LoopNum}) { + $ZoneStatus = "fault"; } - $lc++ + + $self->ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); + $self->ChangeZones( int($ZoneNum), int($ZoneNum), "ready", "", 1) + if ($SensorType eq "k"); #Toggle key buttons back to ready + #Not sure this works, set functions are called per loop } } } From 8f85c2d384d0065fa7e60d3c6efa9542ee71556a Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sun, 2 Feb 2014 12:42:00 -0800 Subject: [PATCH 067/180] AD2: Condense Door and Motion Item Into a Single Class; Add Support for MHT Declarations They are essentially identical. This gets rid of the duplicative code. Added framework to support mht declaration of wireless, expander and relay items. --- lib/AD2USB.pm | 105 ++++++++++++++++++-------------------------------- 1 file changed, 38 insertions(+), 67 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 3b694031b..2aed6103e 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -944,10 +944,22 @@ sub cmd_list { #}}} ##Used to register a child object to a zone or partition. Allows for MH-style Door & Motion sensors {{{ sub register { - my ($self, $object, $num ) = @_; + my ($self, $object, $num, $expander,$relay,$wireless) = @_; &::print_log("Registering Child Object on zone $num"); - if ($object->isa('AD2USB_Motion_Item') || $object->isa('AD2USB_Door_Item')) { + if ($object->isa('AD2USB_Item')) { $self->{zone_object}{$num} = $object; + #Put wireless settings in correct hash + if (defined $wireless){ + $$self{wireless}{$wireless} = $num; + } + #Put expander settings in correct hash + if (defined $expander){ + $$self{expander}{$expander} = $num; + } + #Put relay settings in correct hash + if (defined $relay){ + $$self{relay}{$relay} = $num; + } } elsif ($object->isa('AD2USB_Partition')) { $self->{partition_object}{$num} = $object; @@ -974,23 +986,24 @@ sub get_child_object_name { # # inactivity timers are not working...don't know if those are relevant for panel items. -package AD2USB_Door_Item; +package AD2USB_Item; -@AD2USB_Door_Item::ISA = ('Generic_Item'); +@AD2USB_Item::ISA = ('Generic_Item'); sub new { - my ($class,$interface,$zone,$partition) = @_; + my ($class,$type,$interface,$zone,$partition,$expander,$relay,$wireless) = @_; my $self = new Generic_Item(); bless $self,$class; - $$self{last_open} = 0; - $$self{last_closed} = 0; - $$self{item_type} = 'door'; - $interface->register($self,$zone); + $$self{last_fault} = 0; + $$self{last_ready} = 0; + $$self{item_type} = lc($type); + $interface->register($self,$zone,$expander,$relay,$wireless); $zone = sprintf("%03d", $zone); $$self{zone_partition}{$zone} = $partition; + $self->set($interface->status_zone($zone), $self); #Set correct state on startup return $self; } @@ -1000,18 +1013,22 @@ sub set my ($self,$p_state,$p_setby) = @_; if (ref $p_setby and $p_setby->can('get_set_by')) { - &::print_log("AD2USB_Door_Item($$self{object_name})::set($p_state, $p_setby): $$p_setby{object_name} was set by " . $p_setby->get_set_by) if $main::Debug{AD2USB}; + ::print_log("AD2USB_Item($$self{object_name})::set($p_state, $p_setby): $$p_setby{object_name} was set by " . $p_setby->get_set_by) if $main::Debug{AD2USB}; } else { - &::print_log("AD2USB_Door_Item($$self{object_name})::set($p_state, $p_setby)") if $main::Debug{AD2USB}; + ::print_log("AD2USB_Item($$self{object_name})::set($p_state, $p_setby)") if $main::Debug{AD2USB}; } if ($p_state =~ /^fault/ || $p_state eq 'on') { - $p_state = 'open'; - $$self{last_open} = $::Time; + $p_state = 'fault'; + $p_state = 'open' if $$self{item_type} eq 'door'; + $p_state = 'motion' if $$self{item_type} eq 'motion'; + $$self{last_fault} = $::Time; } elsif ($p_state =~ /^ready/ || $p_state eq 'off') { - $p_state = 'closed'; - $$self{last_closed} = $::Time; + $p_state = 'ready'; + $p_state = 'closed' if $$self{item_type} eq 'door'; + $p_state = 'still' if $$self{item_type} eq 'motion'; + $$self{last_ready} = $::Time; } $self->SUPER::set($p_state,$p_setby); @@ -1019,70 +1036,22 @@ sub set sub get_last_close_time { my ($self) = @_; - return $$self{last_closed}; + return $$self{last_ready}; } sub get_last_open_time { my ($self) = @_; - return $$self{last_open}; -} - -sub get_child_item_type { - my ($self) = @_; - return $$self{item_type}; -} - -#}}} -package AD2USB_Motion_Item; -@AD2USB_Motion_Item::ISA = ('Generic_Item'); - -sub new -{ - my ($class,$interface,$zone,$partition) = @_; - - my $self = new Generic_Item(); - bless $self,$class; - - $$self{last_still} = 0; - $$self{last_motion} = 0; - $$self{item_type} = 'motion'; - $interface->register($self,$zone); - $zone = sprintf("%03d", $zone); - $$self{zone_partition}{$zone} = $partition; - return $self; - -} - -sub set -{ - my ($self,$p_state,$p_setby) = @_; - - - if (ref $p_setby and $p_setby->can('get_set_by')) { - &::print_log("AD2USB_Motion_Item($$self{object_name})::set($p_state, $p_setby): $$p_setby{object_name} was set by " . $p_setby->get_set_by) if $main::Debug{AD2USB}; - } else { - &::print_log("AD2USB_Motion_Item($$self{object_name})::set($p_state, $p_setby)") if $main::Debug{AD2USB}; - } - - if ($p_state =~ /^fault/i) { - $p_state = 'motion'; - $$self{last_motion} = $::Time; - } elsif ($p_state =~ /^ready/i) { - $p_state = 'still'; - $$self{last_still} = $::Time; - } - - $self->SUPER::set($p_state, $p_setby); + return $$self{last_fault}; } sub get_last_still_time { my ($self) = @_; - return $$self{last_still}; + return $$self{last_ready}; } sub get_last_motion_time { my ($self) = @_; - return $$self{last_motion}; + return $$self{last_fault}; } sub get_child_item_type { @@ -1090,6 +1059,8 @@ sub get_child_item_type { return $$self{item_type}; } +#}}} + package AD2USB_Partition; @AD2USB_Partition::ISA = ('Generic_Item'); From 02e6b6486c6de4409a0ba04e95211b31a17df208 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sun, 2 Feb 2014 12:52:00 -0800 Subject: [PATCH 068/180] AD2: Prevent Possibility of Infinite Loops in ChangeZones --- lib/AD2USB.pm | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 2aed6103e..eea858e93 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -384,7 +384,7 @@ sub CheckCmd { #Do not reset mapped zones, specific messages are recevied for these #If the current zone is lower than the previous zone, only reset zones #in between if highest zone has remained constant for one full cycle - if ($self->{zone_last_num}{$partition} - $zone_no_pad != 1) { + if ($zone_no_pad - $self->{zone_last_num}{$partition} != 1) { if (($self->{zone_last_num}{$partition} <= $zone_no_pad) && $self->{highest_zone}{$partition} != $self->{zone_last_num}{$partition}){ $self->{highest_zone}{$partition} = $zone_no_pad; @@ -708,12 +708,20 @@ sub ChangeZones { my ($self, $start, $end, $new_status, $neq_status, $log, $partition, $skip_mapped) = @_; my $instance = $self->{instance}; - $end = $$self{max_zones} if $end <=0 ; + #Prevent improper start and end to suppress never ending loops. + $end = $$self{max_zones} if ($end <=0 || $end > $$self{max_zones}); + $start = 1 if ($start <=0 || $start > $$self{max_zones}); # Allow for reverse looping from max_zones->1 my $reverse = ($start > $end)? 1 : 0; - for (my $i = $start; (!$reverse && $i <= $end) || - ($reverse && ($i >= $start || $i <= $end)); $i++) { + + # Prevent infinite loop scenario + my $y = 0; + + for (my $i = $start; ($y <= $$self{max_zones}) && + ((!$reverse && $i <= $end) || + ($reverse && ($i >= $start || $i <= $end))); + $i++) { my $current_status = $$self{$self->zone_partition($i)}{zone_status}{$i}; # If partition set, then zone partition must equal that if (($current_status ne $new_status) && ($current_status ne $neq_status) @@ -737,6 +745,7 @@ sub ChangeZones { $$self{parition_object}{$zone_partition}->set($partition_status, $$self{zone_object}{"$i"}) if defined $$self{parition_object}{$zone_partition}; } + $y++; $i = 0 if ($i == $$self{max_zones} && $reverse); #loop around } } From a830b41413b92cfc2f50a36f6c6ec85462f5df73 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Tue, 4 Feb 2014 18:02:00 -0800 Subject: [PATCH 069/180] AD2: Fix Typo in Partition Status --- lib/AD2USB.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index eea858e93..9e40d8785 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -742,8 +742,8 @@ sub ChangeZones { if defined $$self{zone_object}{"$i"}; my $zone_partition = $self->zone_partition($i); my $partition_status = $self->status_partition($zone_partition); - $$self{parition_object}{$zone_partition}->set($partition_status, $$self{zone_object}{"$i"}) - if defined $$self{parition_object}{$zone_partition}; + $$self{partition_object}{$zone_partition}->set($partition_status, $$self{zone_object}{"$i"}) + if defined $$self{partition_object}{$zone_partition}; } $y++; $i = 0 if ($i == $$self{max_zones} && $reverse); #loop around From 9ce1ef05baac7a2a9c828902ea302dc32fcb0c37 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Tue, 11 Feb 2014 18:18:00 -0800 Subject: [PATCH 070/180] AD2: Add POD Documentation --- lib/AD2USB.pm | 563 +++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 444 insertions(+), 119 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index 9e40d8785..ec2e3d288 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -10,42 +10,103 @@ Module that monitors a serial device for the AD2USB for known events and maintains the state of the Ademco system in memory. Module also sends instructions to the panel as requested. -=head2 CONNFIGURATION +=head2 CONFIGURATION -This is only a start of the documentation of the configuration for this module. -At the moment, I am just documenting the main changes that I have made +Older versions of this library relied almost exclusively on ini parameters. +This revised library provides extensive support for using an mht file to define +AD2USB objects and only requires setting ini parameters for the initial AD2USB +Interface configuration. [Feb 5, 2014] -=head3 Serial Connections (USB or Serial) +At minimum, you must define the Interface. In addition, this library provides +for the ability to define separate objects for each zone and relay. This allows +for the display of these zones as separate items in the MH interface and allows +users to interact directly with these objects using the basic Generic_Item +functions such as tie_event. -Add the following commands to your INI file: +Finally, this library permits the definition of Partitions. Partitions are +available on all Ademco panels, but they are likely foreign to most users as +more than one Partition is rarely used. In short, Partitions allow for what +appears to be multiple distinct alarm systems to share a single alarm board. +Each zone and alarm panel is assigned to a Partition. For example, a business +may use partition 1 for the front office and partition 2 for the warehouse, this +allows warehouse personel to arm/disarm the warehouse but not the front office +while providing a single point of contact for the alarm monitoring company. -AD2USB_serial_port=/dev/ttyAMA0 +Within MisterHouse, the Partition is used primarily as a stand in for the alarm +panel. The Partition object is used to arm/disarm the panel as well as to check +on the agregate state of all of the zones. -=head3 IP Connections (Ser2Sock) +=head3 Interface Configuration -AD2USB_server_ip=192.168.11.17 -AD2USB_server_port=10000 +There is a small difference in configuring the AD2 Interface for direct +connections (Serial or USB) or IP Connections (Ser2Sock). -=head3 Code Inserts for All Devices +=head4 AD2-Prefix -$AD2USB = new AD2USB; +This library envisions that a user may connect multiple AD2 Interfaces to +MisterHouse. In order to distinguish between each interface, each interface +must use a unique prefix. This prefix must take the following form: -=head3 For Additional Devices (Multiple Seperate Panels) + AD2USB[_digits] -Each additional device can be defined as follows: +Wherein the _digits suffix is optional. Each of the following prefixes +define separate Interfaces: -AD2USB_1_serial_port=/dev/ttyAMA0 + AD2USB + AD2USB_1 + AD2USB_11 -OR +=head4 Direct Connections (USB or Serial) -AD2USB_1_server_ip=192.168.11.17 -AD2USB_1_server_port=10000 +INI file: -PLUS + AD2USB_serial_port=/dev/ttyAMA0 -$AD2USB_1 = new AD2USB('AD2USB_1'); +Wherein the format for the parameter name is: + + AD2USB-Prefix_serial_port + +=head4 IP Connections (Ser2Sock) + +INI file: + + AD2USB_server_ip=192.168.11.17 + AD2USB_server_port=10000 + +Wherein the format for the parameter name is: + + AD2USB-Prefix_server_ip + AD2USB-Prefix_server_port + +=head4 Defining the Interface Object (All Connection Types) + +In addition to the above configuration, you must also define the interface +object. The object can be defined in either an mht file or user code. + +In mht file: + + AD2_INTERFACE, $AD2_Interface, AD2USB + +Wherein the format for the definition is: + + AD2_INTERFACE, Object Name, AD2USB-Prefix + +In user code: + + $AD2USB = new AD2USB(AD2USB); + +Wherein the format for the definition is: + + $AD2USB = new AD2USB(AD2USB-Prefix); + +=head3 Partition Configuration + +See AD2_Partition + +=head3 Zone Configuration + +See AD2_Item -Each addition panel should be iterated by 1. =head2 INHERITS L @@ -56,46 +117,6 @@ L =cut -# ########################################################################### -# Name: AD2USB Monitoring Module -# -# Description: -# Module that monitors a serial device for the AD2USB for known events and -# maintains the state of the Ademco system in memory. Module also sends -# instructions to the panel as requested. -# -# Author: Kirk Friedenberger (kfriedenberger@gmail.com) -# $Revision: $ -# $Date: $ -# -# Change log: -# - Added relay support (Wayne Gatlin, wayne@razorcla.ws) -# - Added 2-way zone expander support (Wayne Gatlin, wayne@razorcla.ws) -# - Completed Wireless support (Wayne Gatlin, wayne@razorcla.ws) -# - Added ser2sock support (Wayne Gatlin, wayne@razorcla.ws) -# - Added in child MH-Style objects (Door & Motion items) (H Plato, hplato@gmail.com) -############################################################################## -# Copyright Kirk Friedenberger (kfriedenberger@gmail.com), 2013, All rights reserved -############################################################################## -# Permission is hereby granted, free of charge, to any person obtaining a copy -# of this software and associated documentation files (the "Software"), to deal -# in the Software without restriction, including without limitation the rights -# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -# copies of the Software, and to permit persons to whom the Software is -# furnished to do so, subject to the following conditions: -# -# The above copyright notice and this permission notice shall be included in -# all copies or substantial portions of the Software. -# -# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN -# THE SOFTWARE. -############################################################################### - package AD2USB; use strict; @@ -105,8 +126,12 @@ my %Socket_Items; #Stores the socket instances and attributes my %Interfaces; #Stores the relationships btw instances and interfaces my %Configuration; #Stores the local config parms -# Starting a new object {{{ -# Called by user code `$AD2USB = new AD2USB` +=item C + +Instantiates a new object. + +=cut + sub new { my ($class, $instance) = @_; $instance = "AD2USB" if (!defined($instance)); @@ -140,7 +165,7 @@ sub new { $self->ChangeZones( 1, $$self{max_zones}, "ready", "ready", 0); #Store Object with Instance Name - $self->set_object_instance($instance); + $self->_set_object_instance($instance); #Load the Parameters from the INI file $self->read_parms($instance); @@ -148,21 +173,30 @@ sub new { return $self; } -#}}} +=item C + +Takes a scalar instance name, AD2-Prefix, and returns the object associated with +that name. + +=cut -# Set/Get Object by Instance {{{ sub get_object_by_instance{ my ($instance) = @_; return $Interfaces{$instance}; } -sub set_object_instance{ +sub _set_object_instance{ my ($self, $instance) = @_; $Interfaces{$instance} = $self; } -#}}} -# Reads the ini settings and pushes them into the appropriate Hashes +=item C + +Causes MH to read the ini parameters and load them into the local configuration +hash. This is necessary in order to join together ini and mht defined features. + +=cut + sub read_parms{ my ($self, $instance) = @_; foreach my $mkey (keys(%::config_parms)) { @@ -224,7 +258,12 @@ sub read_parms{ } } -# serial port configuration {{{ +=item C + +Used to initialize the serial port. + +=cut + sub init { my ($serial_port) = @_; @@ -241,8 +280,12 @@ sub init { } -#}}} -# module startup / enabling serial port {{{ +=item C + +Called by the MH main script as a result of defining a serial port. + +=cut + sub serial_startup { my ($instance) = @_; my ($port, $BaudRate, $ip); @@ -259,8 +302,12 @@ sub serial_startup { } } -#}}} -# startup /enable socket port {{{ +=item C + +Called by the MH main script as a result of defining a server port. + +=cut + sub server_startup { my ($instance) = @_; @@ -275,11 +322,16 @@ sub server_startup { ::MainLoop_pre_add_hook( sub {AD2USB::check_for_data($instance, 'tcp');}, 1 ); } -#}}} +=item C + +Called at the start of every loop. This checks either the serial or server port +for new data. If data is found, the data is broken down into individual +messages and sent to C to be parsed. The message is then +compared to the previous data received if this is a duplicate message it is +logged and ignored. If this is a new message it is sent to C. + +=cut -# check for incoming data on serial port {{{ -# This is called once per loop by a Mainloop_pre hook, it parses out the string -# of data into individual messages. sub check_for_data { my ($instance, $connecttype) = @_; my $self = get_object_by_instance($instance); @@ -349,8 +401,12 @@ sub check_for_data { } } -#}}} -# Validate the command and perform action {{{ +=item C + +This routine takes the parsed message and performs the necessary actions that +result. + +=cut sub CheckCmd { my ($self, $status_type) = @_; @@ -588,8 +644,13 @@ sub CheckCmd { return; } -# Determine if the status string requires parsing {{{ -# Returns a hash reference containing the message details +=item C + +This routine parses a message passed in the form of a string and returns a hash +filled with the resulting message data. + +=cut + sub GetStatusType { my ($self, $AdemcoStr) = @_; my $instance = $self->{instance}; @@ -702,8 +763,26 @@ sub GetStatusType { return \%message; } -#}}} -# Change zone statuses for zone indices from start to end {{{ +=item C + +This routine changes the defined zones to the state that was passed. + +$start = Zone number to start at +$end = Zone number to end at + +All zones between and including $start and $end will be updated. If $start is +greater than $end, the routine will loop around at the max_zones value. + +$new_status = The status to which the zones should be changed too. +$neq_status = Do not alter zones that are equal to this status. +$log = If true will log its actions +$partition = Only change zones on the defined partition +$skip_mapped= If true, zones which are mapped (expander, relay, wireless) will +not be affected + +=cut + sub ChangeZones { my ($self, $start, $end, $new_status, $neq_status, $log, $partition, $skip_mapped) = @_; @@ -750,9 +829,14 @@ sub ChangeZones { } } -#}}} +=item C + +Creates the Hash of available commands. + +This undoubtedly still needs work. + +=cut -# Define hash with Ademco commands {{{ sub DefineCmdMsg { my ($self) = @_; my $instance = $self->{instance}; @@ -803,14 +887,28 @@ sub DefineCmdMsg { return \%Return_Hash; } +=item C + +Used to log messages to the specific AD2USB log file. + +This can likely be eliminated once testing is complete and replaced with the new +debug routine in Generic_Item. + +=cut + sub debug_log { my ($self, $text) = @_; my $instance = $$self{instance}; ::logit( $$self{log_file}, $text) unless ($Configuration{$instance.'_debug_log'} == 0); } -#}}} -# Returns true if zone is mapped {{{ +=item C + +Takes a zone number as a parameter and returns true if it is mapped to a relay, +wireless, or expander. + +=cut + sub is_zone_mapped { my ($self, $zone) = @_; $zone = sprintf "%03s", $zone; @@ -832,8 +930,14 @@ sub is_zone_mapped { return 0; } -#}}} -# Sending command to ADEMCO panel {{{ +=item C + +Used to send commands to the Interface. + +Needs work. + +=cut + sub cmd { my ( $self, $cmd, $password ) = @_; my $instance = $$self{instance}; @@ -876,8 +980,15 @@ sub cmd { return "Sending to ADEMCO panel: $CmdName ($cmd)"; } -#}}} -# user call from MH {{{ +=item C + +Takes a zone number and returns its status. + +If an object exists for this zone you can also use: + +$object->state; + +=cut sub status_zone { my ( $self, $zone ) = @_; @@ -885,12 +996,32 @@ sub status_zone { return $$self{$self->zone_partition($zone)}{zone_status}{$zone}; } +=item C + +Takes a zone number and returns its status if the zone status was set on this +loop. + +If an object exists for this zone you can also use: + +$object->state_now; + +=cut + sub zone_now { my ( $self, $zone ) = @_; $zone =~ s/^0*//; return $self->{zone_now}{$zone}; } +=item C + +Takes a zone number and returns its name. + +The name is not used very much, likely was more necessary before zones were +made into individual objects. + +=cut + sub zone_name { my ( $self, $zone_num ) = @_; my $instance = $self->{instance}; @@ -898,6 +1029,12 @@ sub zone_name { return $$self{zone_name}{$zone_num}; } +=item C + +Takes a zone number and returns the partition that it is a member of. + +=cut + sub zone_partition { my ( $self, $zone_num ) = @_; my $instance = $self->{instance}; @@ -908,22 +1045,59 @@ sub zone_partition { return $partition; } +=item C + +Takes a partition number and returns its status if its status was set on this +loop. + +If an object exists for this partition you can also use: + +$object->state_now; + +=cut + sub partition_now { my ( $self, $part ) = @_; return $self->{partition_now}{$part}; } +=item C + +Takes a partition number and returns the last alphanumeric message that was sent +by this partition. + +=cut + sub partition_msg { my ( $self, $part ) = @_; return $self->{partition_msg}{part}; } +=item C + +Takes a partition number and returns its name. + +The name is not used very much, likely was more necessary before partitions were +made into individual objects. + +=cut + sub partition_name { my ( $self, $part_num ) = @_; my $instance = $self->{instance}; return $$self{partition_name}{$part_num}; } +=item C + +Takes a partition number and returns its status. + +If an object exists for this partition you can also use: + +$object->state; + +=cut + sub status_partition { my ( $self, $partition ) = @_; my %partition_zones = %{$$self{$partition}{zone_status}}; @@ -944,14 +1118,25 @@ sub status_partition { return $partition_status; } +=item C + +Returns the list of available commands. + +=cut + sub cmd_list { my ($self) = @_; foreach my $k ( sort keys %{$self->{CmdMsg}} ) { &::print_log("$k"); } } -#}}} -##Used to register a child object to a zone or partition. Allows for MH-style Door & Motion sensors {{{ + +=item C + +Used to associate child objects with the interface. + +=cut + sub register { my ($self, $object, $num, $expander,$relay,$wireless) = @_; &::print_log("Registering Child Object on zone $num"); @@ -975,30 +1160,75 @@ sub register { } } +=item C + +Takes a zone number and returns the name of the child object associated with it. + +=cut + sub get_child_object_name { my ($self,$zone_num) = @_; my $object = $self->{zone_object}{$zone_num}; return $object->get_object_name() if defined ($object); } -#}}} -# MH-Style child objects -# These allow zones to behave like Door_Items and Motion Sensors -# to use, just create the item with the Master AD2USB object and the appropriate zone -# -# ie. -# $AD2USB = new AD2USB; -# $Front_door = new AD2USB_Door_Item($AD2USB,1); -# states include open, closed and check -# $Front_motion = new AD2USB_Motion_Item($AD2USB,2); -# states include motion and still -# -# inactivity timers are not working...don't know if those are relevant for panel items. +=back + +=head1 B + +=head2 SYNOPSIS + +User code: + + $front_door = new AD2USB_Item('door','AD2USB', 5, 1); + $upstairs_motion = new AD2USB_Item('motion','AD2USB', 5, 1); + +See C for a more detailed description of the arguments. + +In mht file: + +[NOT COMPLETED YET] + +=head2 DESCRIPTION + +Provides support for creating MH-Style child objects for each zone. These allow +zones to behave like Generic_Items. For example, Generic_Item subroutines such +as C and C can be used with these devices. + +To use these, you must first create the appropriate AD2 Interface object. + +=head2 INHERITS + +L + +=head2 METHODS + +=over + +=cut package AD2USB_Item; @AD2USB_Item::ISA = ('Generic_Item'); +=item C + +Instantiates a new object. + +$type = May be either 'door' or 'motion'. This just defines the states for +the object +$interface = The AD2-Prefix of the interface that this zone is found on +$zone = The zone number of this zone +$partition = The partition number of this zone, usually 1 + +Zone Mapping + +$expander = If not null, the expander address that the zone is mapped to. +$relay = If not null, the relay address that the zone is mapped to. +$wireless = If not null, the wireless address that the zone is mapped to. + +=cut + sub new { my ($class,$type,$interface,$zone,$partition,$expander,$relay,$wireless) = @_; @@ -1017,6 +1247,12 @@ sub new } +=item C + +Sets the object's state. + +=cut + sub set { my ($self,$p_state,$p_setby) = @_; @@ -1042,37 +1278,127 @@ sub set $self->SUPER::set($p_state,$p_setby); } - + +=item C + +Returns the item type, either 'motion' or 'door'. + +=cut + +sub get_child_item_type { + my ($self) = @_; + return $$self{item_type}; +} + +=back + +=head2 Extraneous Methods + +The following methods seem to me to be unnecessary in light of the functions +available in C. + +=over + +=cut + +=item C + +Returns the time the object was closed. + +=cut + sub get_last_close_time { my ($self) = @_; return $$self{last_ready}; } +=item C + +Returns the time the object was opened. + +=cut + sub get_last_open_time { my ($self) = @_; return $$self{last_fault}; } +=item C + +Returns the time the object was still. + +=cut + sub get_last_still_time { my ($self) = @_; return $$self{last_ready}; } +=item C + +Returns the time the object was motion. + +=cut + sub get_last_motion_time { my ($self) = @_; return $$self{last_fault}; } -sub get_child_item_type { - my ($self) = @_; - return $$self{item_type}; -} +=back + +=head1 B + +=head2 SYNOPSIS -#}}} +User code: + + $partition_1 = new AD2USB_Partition('AD2USB', 1, 31); + +See C for a more detailed description of the arguments. + +In mht file: + +[NOT COMPLETED YET] + +=head2 DESCRIPTION + +Provides support for creating MH-Style child objects for each partition. + +For an explanation of what a partition is, please see the Description section +of C. + +The Partition is used primarily as a stand in for the alarm panel. The +Partition object is used to arm/disarm the panel as well as to check on the +agregate state of all of the zones that are within this partition. + +=head2 INHERITS + +L + +=head2 METHODS + +=over + +=cut package AD2USB_Partition; @AD2USB_Partition::ISA = ('Generic_Item'); +=item C + +Instantiates a new object. + +$interface = The AD2-Prefix of the interface that this zone is found on +$partition = The partition number, usually 1 +$address = The address of a panel that is assigned to this partition. For +non-addressable systems this should be set to 31. + +While there may be multiple panels on a partition, and as a result multiple +addresses, only ONE address is needed in $address. + +=cut + sub new { my ($class,$interface, $partition, $address) = @_; @@ -1092,6 +1418,11 @@ sub new =head2 AUTHOR +Kirk Friedenberger +Wayne Gatlin +H Plato +Kevin Robert Keegan + =head2 SEE ALSO =head2 LICENSE @@ -1104,10 +1435,4 @@ You should have received a copy of the GNU General Public License along with thi =cut -1; - -#}}} -#$Log:$ - -__END__ - +1; \ No newline at end of file From e3fc5933c0813afb28a750cfba485b11c351ca0d Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Tue, 11 Feb 2014 18:22:00 -0800 Subject: [PATCH 071/180] AD2: Convert from AD2USB -> AD2 All references to AD2USB has been replaced with AD2. This means all configuration settings and user code settings need to be updated as well. The change was necessary because this module will work with at leaast AD2Serial, AD2USB, AD2Pi, and likely many more AD2 style products that will be released in the future. --- lib/AD2USB.pm | 104 +++++++++++++++++++++++++------------------------- 1 file changed, 52 insertions(+), 52 deletions(-) diff --git a/lib/AD2USB.pm b/lib/AD2USB.pm index ec2e3d288..07b53b06f 100755 --- a/lib/AD2USB.pm +++ b/lib/AD2USB.pm @@ -1,4 +1,4 @@ -=head1 B +=head1 B =head2 SYNOPSIS @@ -6,7 +6,7 @@ =head2 DESCRIPTION -Module that monitors a serial device for the AD2USB for known events and +Module for interfacing with the AD2 line of products. Monitors known events and maintains the state of the Ademco system in memory. Module also sends instructions to the panel as requested. @@ -14,7 +14,7 @@ instructions to the panel as requested. Older versions of this library relied almost exclusively on ini parameters. This revised library provides extensive support for using an mht file to define -AD2USB objects and only requires setting ini parameters for the initial AD2USB +AD2 objects and only requires setting ini parameters for the initial AD2 Interface configuration. [Feb 5, 2014] At minimum, you must define the Interface. In addition, this library provides @@ -47,36 +47,36 @@ This library envisions that a user may connect multiple AD2 Interfaces to MisterHouse. In order to distinguish between each interface, each interface must use a unique prefix. This prefix must take the following form: - AD2USB[_digits] + AD2[_digits] Wherein the _digits suffix is optional. Each of the following prefixes define separate Interfaces: - AD2USB - AD2USB_1 - AD2USB_11 + AD2 + AD2_1 + AD2_11 =head4 Direct Connections (USB or Serial) INI file: - AD2USB_serial_port=/dev/ttyAMA0 + AD2_serial_port=/dev/ttyAMA0 Wherein the format for the parameter name is: - AD2USB-Prefix_serial_port + AD2-Prefix_serial_port =head4 IP Connections (Ser2Sock) INI file: - AD2USB_server_ip=192.168.11.17 - AD2USB_server_port=10000 + AD2_server_ip=192.168.11.17 + AD2_server_port=10000 Wherein the format for the parameter name is: - AD2USB-Prefix_server_ip - AD2USB-Prefix_server_port + AD2-Prefix_server_ip + AD2-Prefix_server_port =head4 Defining the Interface Object (All Connection Types) @@ -85,19 +85,19 @@ object. The object can be defined in either an mht file or user code. In mht file: - AD2_INTERFACE, $AD2_Interface, AD2USB + AD2_INTERFACE, $AD2_Interface, AD2 Wherein the format for the definition is: - AD2_INTERFACE, Object Name, AD2USB-Prefix + AD2_INTERFACE, Object Name, AD2-Prefix In user code: - $AD2USB = new AD2USB(AD2USB); + $AD2 = new AD2(AD2); Wherein the format for the definition is: - $AD2USB = new AD2USB(AD2USB-Prefix); + $AD2 = new AD2(AD2-Prefix); =head3 Partition Configuration @@ -117,10 +117,10 @@ L =cut -package AD2USB; +package AD2; use strict; -@AD2USB::ISA = ('Generic_Item'); +@AD2::ISA = ('Generic_Item'); my %Socket_Items; #Stores the socket instances and attributes my %Interfaces; #Stores the relationships btw instances and interfaces @@ -134,7 +134,7 @@ Instantiates a new object. sub new { my ($class, $instance) = @_; - $instance = "AD2USB" if (!defined($instance)); + $instance = "AD2" if (!defined($instance)); ::print_log("Starting $instance instance of ADEMCO panel interface module"); my $self = new Generic_Item(); @@ -149,7 +149,7 @@ sub new { $$self{reconnect_time} = 10 if !defined($$self{reconnect_time}); $$self{max_zones} = 250; #The current max zones by any panel, can be increased my $year_mon = &::time_date_stamp( 10, time ); - $$self{log_file} = $::config_parms{'data_dir'}."/logs/AD2USB.$year_mon.log"; + $$self{log_file} = $::config_parms{'data_dir'}."/logs/AD2.$year_mon.log"; bless $self, $class; @@ -159,7 +159,7 @@ sub new { # The following logs default to being enabled, can only be disabled by # proactively setting their ini parameters to 0: - # AD2USB_part_log AD2USB_zone_log AD2USB_debug_log + # AD2_part_log AD2_zone_log AD2_debug_log #Set all zones and partitions to ready $self->ChangeZones( 1, $$self{max_zones}, "ready", "ready", 0); @@ -202,19 +202,19 @@ sub read_parms{ foreach my $mkey (keys(%::config_parms)) { next if $mkey =~ /_MHINTERNAL_/; #Load All Configuration Settings - $Configuration{$mkey} = $::config_parms{$mkey} if $mkey =~ /^AD2USB_/; + $Configuration{$mkey} = $::config_parms{$mkey} if $mkey =~ /^AD2_/; #Put wireless settings in correct hash if ($mkey =~ /^${instance}_wireless_(.*)/){ if (index($::config_parms{$mkey}, ',') <= 0){ #Supports new style ini parameter, wherein each zone is a separate entry: - #AD2USB_wireless_[RF_ID],[LOOP],[TYPE]=[ZONE] such as: - #AD2USB_wireless_1234567,1,k=10 + #AD2_wireless_[RF_ID],[LOOP],[TYPE]=[ZONE] such as: + #AD2_wireless_1234567,1,k=10 $$self{wireless}{$1} = $::config_parms{$mkey}; } else { #This code supports the old style ini of wirelss parameters: - #AD2USB_wireless_[RF_ID]=[ZONE],[TYPE][LOOP](,repeat) such as: - #AD2USB_wireless_1234567=10,s1 + #AD2_wireless_[RF_ID]=[ZONE],[TYPE][LOOP](,repeat) such as: + #AD2_wireless_1234567=10,s1 my $rf_id = $1; my $lc = 0; my $ZoneNum; @@ -296,8 +296,8 @@ sub serial_startup { $BaudRate = ( defined $::config_parms{$instance . '_baudrate'} ) ? $::config_parms{"$instance" . '_baudrate'} : 115200; if ( &main::serial_port_create( $instance, $port, $BaudRate, 'none', 'raw' ) ) { init( $::Serial_Ports{$instance}{object}, $port ); - ::print_log("[AD2USB] initializing $instance on port $port at $BaudRate baud") if $main::Debug{'AD2USB'}; - ::MainLoop_pre_add_hook( sub {AD2USB::check_for_data($instance, 'serial');}, 1 ) if $main::Serial_Ports{"$instance"}{object}; + ::print_log("[AD2] initializing $instance on port $port at $BaudRate baud") if $main::Debug{'AD2'}; + ::MainLoop_pre_add_hook( sub {AD2::check_for_data($instance, 'serial');}, 1 ) if $main::Serial_Ports{"$instance"}{object}; } } } @@ -314,12 +314,12 @@ sub server_startup { $Socket_Items{"$instance"}{recon_timer} = ::Timer::new(); my $ip = $::config_parms{"$instance".'_server_ip'}; my $port = $::config_parms{"$instance" . '_server_port'}; - ::print_log(" AD2USB.pm initializing $instance TCP session with $ip on port $port") if $main::Debug{'AD2USB'}; + ::print_log(" AD2.pm initializing $instance TCP session with $ip on port $port") if $main::Debug{'AD2'}; $Socket_Items{"$instance"}{'socket'} = new Socket_Item($instance, undef, "$ip:$port", $instance, 'tcp', 'raw'); $Socket_Items{"$instance" . '_sender'}{'socket'} = new Socket_Item($instance . '_sender', undef, "$ip:$port", $instance . '_sender', 'tcp', 'rawout'); $Socket_Items{"$instance"}{'socket'}->start; $Socket_Items{"$instance" . '_sender'}{'socket'}->start; - ::MainLoop_pre_add_hook( sub {AD2USB::check_for_data($instance, 'tcp');}, 1 ); + ::MainLoop_pre_add_hook( sub {AD2::check_for_data($instance, 'tcp');}, 1 ); } =item C @@ -354,8 +354,8 @@ sub check_for_data { } else { # restart the TCP connection if its lost. if ($Socket_Items{$instance}{recon_timer}->inactive) { - &main::print_log("Connection to $instance instance of AD2USB was lost, I will try to reconnect in $$self{reconnect_time} seconds"); - # ::logit("AD2USB.pm ser2sock connection lost! Trying to reconnect." ); + &main::print_log("Connection to $instance instance of AD2 was lost, I will try to reconnect in $$self{reconnect_time} seconds"); + # ::logit("AD2.pm ser2sock connection lost! Trying to reconnect." ); $Socket_Items{$instance}{recon_timer}->set($$self{reconnect_time}, sub { $Socket_Items{$instance}{'socket'}->start; }); @@ -376,7 +376,7 @@ sub check_for_data { if (substr($Cmd, -1) eq "\r"){ # Valid Message, Strip off last line ending $Cmd = substr($Cmd, 0, -1); - ::print_log("[AD2USB] " . $Cmd) if $main::Debug{AD2USB} >= 1; + ::print_log("[AD2] " . $Cmd) if $main::Debug{AD2} >= 1; # Get the Message Type, and Ignore Duplicate Status Messages my $status_type = $self->GetStatusType($Cmd); @@ -852,8 +852,8 @@ sub DefineCmdMsg { "Chime" => $Configuration{$instance."_user_master_code"}."9", "ToggleVoice" => '#024', "ShowFaults" => "*", - "AD2USBReboot" => "=", - "AD2USBConfigure" => "!" + "AD2Reboot" => "=", + "AD2Configure" => "!" ); my $two_digit_zone; @@ -889,7 +889,7 @@ sub DefineCmdMsg { =item C -Used to log messages to the specific AD2USB log file. +Used to log messages to the specific AD2 log file. This can likely be eliminated once testing is complete and replaced with the new debug routine in Generic_Item. @@ -966,7 +966,7 @@ sub cmd { } else { # restart the TCP connection if its lost. if ($Socket_Items{$instance}{recon_timer}->inactive) { - ::print_log("Connection to $instance sending instance of AD2USB was lost, I will try to reconnect in $$self{reconnect_time} seconds"); + ::print_log("Connection to $instance sending instance of AD2 was lost, I will try to reconnect in $$self{reconnect_time} seconds"); $Socket_Items{$instance}{recon_timer}->set($$self{reconnect_time}, sub { $Socket_Items{$instance . '_sender'}{'socket'}->start; $Socket_Items{$instance . '_sender'}{'socket'}->set("$CmdStr"); @@ -1140,7 +1140,7 @@ Used to associate child objects with the interface. sub register { my ($self, $object, $num, $expander,$relay,$wireless) = @_; &::print_log("Registering Child Object on zone $num"); - if ($object->isa('AD2USB_Item')) { + if ($object->isa('AD2_Item')) { $self->{zone_object}{$num} = $object; #Put wireless settings in correct hash if (defined $wireless){ @@ -1155,7 +1155,7 @@ sub register { $$self{relay}{$relay} = $num; } } - elsif ($object->isa('AD2USB_Partition')) { + elsif ($object->isa('AD2_Partition')) { $self->{partition_object}{$num} = $object; } } @@ -1174,14 +1174,14 @@ sub get_child_object_name { =back -=head1 B +=head1 B =head2 SYNOPSIS User code: - $front_door = new AD2USB_Item('door','AD2USB', 5, 1); - $upstairs_motion = new AD2USB_Item('motion','AD2USB', 5, 1); + $front_door = new AD2_Item('door','AD2', 5, 1); + $upstairs_motion = new AD2_Item('motion','AD2', 5, 1); See C for a more detailed description of the arguments. @@ -1207,9 +1207,9 @@ L =cut -package AD2USB_Item; +package AD2_Item; -@AD2USB_Item::ISA = ('Generic_Item'); +@AD2_Item::ISA = ('Generic_Item'); =item C @@ -1258,9 +1258,9 @@ sub set my ($self,$p_state,$p_setby) = @_; if (ref $p_setby and $p_setby->can('get_set_by')) { - ::print_log("AD2USB_Item($$self{object_name})::set($p_state, $p_setby): $$p_setby{object_name} was set by " . $p_setby->get_set_by) if $main::Debug{AD2USB}; + ::print_log("AD2_Item($$self{object_name})::set($p_state, $p_setby): $$p_setby{object_name} was set by " . $p_setby->get_set_by) if $main::Debug{AD2}; } else { - ::print_log("AD2USB_Item($$self{object_name})::set($p_state, $p_setby)") if $main::Debug{AD2USB}; + ::print_log("AD2_Item($$self{object_name})::set($p_state, $p_setby)") if $main::Debug{AD2}; } if ($p_state =~ /^fault/ || $p_state eq 'on') { @@ -1347,13 +1347,13 @@ sub get_last_motion_time { =back -=head1 B +=head1 B =head2 SYNOPSIS User code: - $partition_1 = new AD2USB_Partition('AD2USB', 1, 31); + $partition_1 = new AD2_Partition('AD2', 1, 31); See C for a more detailed description of the arguments. @@ -1366,7 +1366,7 @@ In mht file: Provides support for creating MH-Style child objects for each partition. For an explanation of what a partition is, please see the Description section -of C. +of C. The Partition is used primarily as a stand in for the alarm panel. The Partition object is used to arm/disarm the panel as well as to check on the @@ -1382,8 +1382,8 @@ L =cut -package AD2USB_Partition; -@AD2USB_Partition::ISA = ('Generic_Item'); +package AD2_Partition; +@AD2_Partition::ISA = ('Generic_Item'); =item C From 04c41ca82d3ee0f10aff7282324f172f76376c69 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Tue, 11 Feb 2014 18:23:00 -0800 Subject: [PATCH 072/180] AD2: Rename AD2USB.pm -> AD2.pm --- lib/{AD2USB.pm => AD2.pm} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename lib/{AD2USB.pm => AD2.pm} (100%) diff --git a/lib/AD2USB.pm b/lib/AD2.pm similarity index 100% rename from lib/AD2USB.pm rename to lib/AD2.pm From 587e5473376993322ea145e0a16a32ddfcbf4182 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Tue, 11 Feb 2014 18:33:00 -0800 Subject: [PATCH 073/180] AD2: Add MHT definition for AD2_INTERFACE --- lib/read_table_A.pl | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/lib/read_table_A.pl b/lib/read_table_A.pl index 63ecc7f69..b08f8d61b 100644 --- a/lib/read_table_A.pl +++ b/lib/read_table_A.pl @@ -1036,6 +1036,14 @@ sub read_table_A { $code .= "use Philips_Hue;\n"; } } + #-------------- AD2 Objects ----------------- + elsif($type eq "AD2_INTERFACE") { + require AD2; + my ($name, $instance, @other) = @item_info; + $other = join ', ', (map {"'$_'"} @other); # Quote data + $object = "AD2($instance,$other)"; + } + #-------------- End AD2 Objects ------------- else { print "\nUnrecognized .mht entry: $record\n"; return; From 0fcbc8af1c51e50e55494a1c29e007a14646ef4e Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Wed, 12 Feb 2014 18:13:00 -0800 Subject: [PATCH 074/180] AD2: Add More MHT Definitions and Fix POD Documentation of Same --- lib/AD2.pm | 109 +++++++++++++++++++++++++++++++++++++++----- lib/read_table_A.pl | 39 ++++++++++++++++ 2 files changed, 137 insertions(+), 11 deletions(-) diff --git a/lib/AD2.pm b/lib/AD2.pm index 07b53b06f..f1e9ecfdc 100755 --- a/lib/AD2.pm +++ b/lib/AD2.pm @@ -50,7 +50,7 @@ must use a unique prefix. This prefix must take the following form: AD2[_digits] Wherein the _digits suffix is optional. Each of the following prefixes -define separate Interfaces: +would define a separate Interface: AD2 AD2_1 @@ -769,15 +769,20 @@ sub GetStatusType { This routine changes the defined zones to the state that was passed. $start = Zone number to start at + $end = Zone number to end at All zones between and including $start and $end will be updated. If $start is greater than $end, the routine will loop around at the max_zones value. $new_status = The status to which the zones should be changed too. + $neq_status = Do not alter zones that are equal to this status. + $log = If true will log its actions + $partition = Only change zones on the defined partition + $skip_mapped= If true, zones which are mapped (expander, relay, wireless) will not be affected @@ -1181,13 +1186,74 @@ sub get_child_object_name { User code: $front_door = new AD2_Item('door','AD2', 5, 1); - $upstairs_motion = new AD2_Item('motion','AD2', 5, 1); + $upstairs_motion = new AD2_Item('motion','AD2', 6, 1); + $generic_zone = new AD2_Item('','AD2', 7, 1); See C for a more detailed description of the arguments. In mht file: -[NOT COMPLETED YET] + AD2_DOOR_ITEM, $front_door, AD2, 5, 1, EXP=0101 + AD2_MOTION_ITEM, $upstairs_motion, AD2, 6, 1, REL=1301 + AD2_GENERIC_ITEM, $generic_zone, AD2, 7, 1, RFX=0014936,4,k + +Wherein the format for the definition is: + + AD2_DOOR_ITEM, Object Name, AD2-Prefix, Zone Number, Partition Number, Expander/Relay/Wireless Address + +The type of items can be DOOR (open/close) MOTION (motion/still) and GENERIC +(fault/ready). + +=head3 EXPANDER/RELAY/WIRELESS ADDRESS + +The last item is the Expander, Relay, or Wireless address if it applicable. For +hardwired zones this last item should be left blank. + +=head4 EXPANSION BOARDS + +For zones wired to an expansion board, the prefix EXP= should be used. The +address is the expansion board id (2 digits, 0 padded if required) concatenated +with the expansion input number (2 digits, 0 padded if required) such as 0101 or +1304. + +=head4 RELAY MAPPINGS + +The state of hardwired zones can only be obtained from the alphanumeric messages +that scroll by on the panel screens. If multiple zones are tripped, it may take +a few seconds for the status of a hardwired zone to be updated. Moreover, the +status of a hardwired zone cannot be obtained while the system is armed because +no alphanumeric messages are displayed while armed. + +To overcome these limitations, depending on your alarm panel model, you can map +a hardwired zone to a relay. In essence, if a zone that is mapped to a relay +the alarm panel will close the relay whenever the zone is faulted and open the +relay when the zone is ready. Luckily, this relay can be a virtual device. The +messages sent by the alarm panel to open/close a virtual relay are sent +immediatly and are not affected by the state of the alarm. + +To setup relay mappings, consult your alarm panel's instruction manual for +programing a relay board and mapping zones to it. Some alarm panels have limited +capabilities when it comes to relays. Specifically, you want to refer to section +of your manual that discusses *80 programming. + +For hardwired zones mapped to a relay board, the prefix REL= should be used. The +address is the relay board id (2 digits, 0 padded if required) concatenated +with the relay output number (2 digits, 0 padded if required) such as 0101 or +1304. + +=head4 WIRELESS DEVICES + +For wireless zones, the prefix RFX= should be used. The address is the wireless +ID (7 digits) followed by a comma, the loop number, followed by a comma, and the +wireless device type. All of this without any spaces. The loop number need +only be specified if it is not 1. Generally, the loop number for most devices +is 1. Similarly, the device type need only be specified if the wireless device +is a keypad, in which case the type is the letter k. The following are valid +wireless addresses: + + RFX=0014936,4,k + RFX=0101538 + RFX=5848878,1,k =head2 DESCRIPTION @@ -1215,17 +1281,30 @@ package AD2_Item; Instantiates a new object. -$type = May be either 'door' or 'motion'. This just defines the states for -the object +$type = May be either 'door', 'motion', or ''. This just defines the states for +the object. door = open/closed, motion = motion/still, '' = fault/ready + $interface = The AD2-Prefix of the interface that this zone is found on + $zone = The zone number of this zone + $partition = The partition number of this zone, usually 1 Zone Mapping $expander = If not null, the expander address that the zone is mapped to. + $relay = If not null, the relay address that the zone is mapped to. -$wireless = If not null, the wireless address that the zone is mapped to. + +$wireless = If not null, the wireless address that the zone is mapped to in the +form of [RF_ID],[LOOP],[TYPE]. + +The wireless address is the wireless ID (7 digits) followed by a comma, the +loop number, followed by a comma, and the wireless device type. All of this +without any spaces. The loop number need only be specified if it is not 1. +Generally, the loop number for most devices is 1. Similarly, the device type +need only be specified if the wireless device is a keypad, in which case the +type is the letter k. =cut @@ -1359,7 +1438,15 @@ See C for a more detailed description of the arguments. In mht file: -[NOT COMPLETED YET] + AD2_PARTITION, $partition_1, AD2, 1, 31 + +Wherein the format is + + AD2_PARTITION, Object Name, AD2-Prefix, Partition Number, Address + +The address is the address of a panel that is assigned to this partition. +Multiple panels may be assigned to a partition, only one address is required. +If your system is a non-addressable system, 31 should be used as the address. =head2 DESCRIPTION @@ -1390,7 +1477,9 @@ package AD2_Partition; Instantiates a new object. $interface = The AD2-Prefix of the interface that this zone is found on + $partition = The partition number, usually 1 + $address = The address of a panel that is assigned to this partition. For non-addressable systems this should be set to 31. @@ -1418,10 +1507,8 @@ sub new =head2 AUTHOR -Kirk Friedenberger -Wayne Gatlin -H Plato -Kevin Robert Keegan +Kirk Friedenberger , Wayne Gatlin +H Plato , Kevin Robert Keegan =head2 SEE ALSO diff --git a/lib/read_table_A.pl b/lib/read_table_A.pl index b08f8d61b..fef3b636a 100644 --- a/lib/read_table_A.pl +++ b/lib/read_table_A.pl @@ -1043,6 +1043,45 @@ sub read_table_A { $other = join ', ', (map {"'$_'"} @other); # Quote data $object = "AD2($instance,$other)"; } + elsif($type eq "AD2_DOOR_ITEM") { + require AD2; + my ($name, $instance, $zone, $partition, $address, @other) = @item_info; + my ($expander,$relay,$wireless); + $other = join ', ', (map {"'$_'"} @other); # Quote data + my ($map, $address) = split('=', $address); + $expander = $address if (uc($map) eq "EXP"); + $relay = $address if (uc($map) eq "REL"); + $wireless = $address if (uc($map) eq "RFX"); + $object = "AD2_Item('door',$instance,$zone,$partition,$expander,$relay,$wireless,$other)"; + } + elsif($type eq "AD2_MOTION_ITEM") { + require AD2; + my ($name, $instance, $zone, $partition, $address, @other) = @item_info; + my ($expander,$relay,$wireless); + $other = join ', ', (map {"'$_'"} @other); # Quote data + my ($map, $address) = split('=', $address); + $expander = $address if (uc($map) eq "EXP"); + $relay = $address if (uc($map) eq "REL"); + $wireless = $address if (uc($map) eq "RFX"); + $object = "AD2_Item('motion',$instance,$zone,$partition,$expander,$relay,$wireless,$other)"; + } + elsif($type eq "AD2_GENERIC_ITEM") { + require AD2; + my ($name, $instance, $zone, $partition, $address, @other) = @item_info; + my ($expander,$relay,$wireless); + $other = join ', ', (map {"'$_'"} @other); # Quote data + my ($map, $address) = split('=', $address); + $expander = $address if (uc($map) eq "EXP"); + $relay = $address if (uc($map) eq "REL"); + $wireless = $address if (uc($map) eq "RFX"); + $object = "AD2_Item('',$instance,$zone,$partition,$expander,$relay,$wireless,$other)"; + } + elsif($type eq "AD2_PARTITION") { + require AD2; + my ($name, $instance, $number, $address, @other) = @item_info; + $other = join ', ', (map {"'$_'"} @other); # Quote data + $object = "AD2_Partition($instance,$number,$address,$other)"; + } #-------------- End AD2 Objects ------------- else { print "\nUnrecognized .mht entry: $record\n"; From ad5c3d1c94968c4e9eaf681c18c2bb6fc613233e Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 27 Feb 2014 21:16:10 -0800 Subject: [PATCH 075/180] AD2: Clean Up A Few Bugs With MHT Definitions --- lib/AD2.pm | 17 ++++++++++------- lib/read_table_A.pl | 28 +++++++++++++++------------- 2 files changed, 25 insertions(+), 20 deletions(-) diff --git a/lib/AD2.pm b/lib/AD2.pm index f1e9ecfdc..051236375 100755 --- a/lib/AD2.pm +++ b/lib/AD2.pm @@ -85,7 +85,7 @@ object. The object can be defined in either an mht file or user code. In mht file: - AD2_INTERFACE, $AD2_Interface, AD2 + AD2_INTERFACE, AD2_Interface, AD2 Wherein the format for the definition is: @@ -1193,9 +1193,10 @@ See C for a more detailed description of the arguments. In mht file: - AD2_DOOR_ITEM, $front_door, AD2, 5, 1, EXP=0101 - AD2_MOTION_ITEM, $upstairs_motion, AD2, 6, 1, REL=1301 - AD2_GENERIC_ITEM, $generic_zone, AD2, 7, 1, RFX=0014936,4,k + AD2_DOOR_ITEM, back_door, AD2, 4, 1, HARDWIRED + AD2_DOOR_ITEM, front_door, AD2, 5, 1, EXP=0101 + AD2_MOTION_ITEM, upstairs_motion, AD2, 6, 1, REL=1301 + AD2_GENERIC_ITEM, generic_zone, AD2, 7, 1, RFX=0014936,4,k Wherein the format for the definition is: @@ -1204,10 +1205,10 @@ Wherein the format for the definition is: The type of items can be DOOR (open/close) MOTION (motion/still) and GENERIC (fault/ready). -=head3 EXPANDER/RELAY/WIRELESS ADDRESS +=head3 HARDWIRED/EXPANDER/RELAY/WIRELESS ADDRESS The last item is the Expander, Relay, or Wireless address if it applicable. For -hardwired zones this last item should be left blank. +hardwired zones this last item should be HARDWIRED. =head4 EXPANSION BOARDS @@ -1318,6 +1319,7 @@ sub new $$self{last_fault} = 0; $$self{last_ready} = 0; $$self{item_type} = lc($type); + $interface = AD2::get_object_by_instance($interface); $interface->register($self,$zone,$expander,$relay,$wireless); $zone = sprintf("%03d", $zone); $$self{zone_partition}{$zone} = $partition; @@ -1438,7 +1440,7 @@ See C for a more detailed description of the arguments. In mht file: - AD2_PARTITION, $partition_1, AD2, 1, 31 + AD2_PARTITION, partition_1, AD2, 1, 31 Wherein the format is @@ -1493,6 +1495,7 @@ sub new my ($class,$interface, $partition, $address) = @_; my $self = new Generic_Item(); bless $self,$class; + $interface = AD2::get_object_by_instance($interface); $$interface{partition_address}{$partition} = $address; $interface->register($self,$partition); return $self; diff --git a/lib/read_table_A.pl b/lib/read_table_A.pl index fef3b636a..b29e2fd51 100644 --- a/lib/read_table_A.pl +++ b/lib/read_table_A.pl @@ -1039,48 +1039,50 @@ sub read_table_A { #-------------- AD2 Objects ----------------- elsif($type eq "AD2_INTERFACE") { require AD2; - my ($name, $instance, @other) = @item_info; + my ($instance); + ($name, $instance, $grouplist, @other) = @item_info; $other = join ', ', (map {"'$_'"} @other); # Quote data - $object = "AD2($instance,$other)"; + $object = "AD2('$instance','$other')"; } elsif($type eq "AD2_DOOR_ITEM") { require AD2; - my ($name, $instance, $zone, $partition, $address, @other) = @item_info; - my ($expander,$relay,$wireless); + my ($instance,$expander,$relay,$wireless, $zone, $partition); + ($name, $instance, $zone, $partition, $address, $grouplist, @other) = @item_info; $other = join ', ', (map {"'$_'"} @other); # Quote data my ($map, $address) = split('=', $address); $expander = $address if (uc($map) eq "EXP"); $relay = $address if (uc($map) eq "REL"); $wireless = $address if (uc($map) eq "RFX"); - $object = "AD2_Item('door',$instance,$zone,$partition,$expander,$relay,$wireless,$other)"; + $object = "AD2_Item('door','$instance','$zone','$partition','$expander','$relay','$wireless','$other')"; } elsif($type eq "AD2_MOTION_ITEM") { require AD2; - my ($name, $instance, $zone, $partition, $address, @other) = @item_info; - my ($expander,$relay,$wireless); + my ($instance,$expander,$relay,$wireless, $zone, $partition); + ($name, $instance, $zone, $partition, $address, $grouplist, @other) = @item_info; $other = join ', ', (map {"'$_'"} @other); # Quote data my ($map, $address) = split('=', $address); $expander = $address if (uc($map) eq "EXP"); $relay = $address if (uc($map) eq "REL"); $wireless = $address if (uc($map) eq "RFX"); - $object = "AD2_Item('motion',$instance,$zone,$partition,$expander,$relay,$wireless,$other)"; + $object = "AD2_Item('motion','$instance','$zone','$partition','$expander','$relay','$wireless','$other')"; } elsif($type eq "AD2_GENERIC_ITEM") { require AD2; - my ($name, $instance, $zone, $partition, $address, @other) = @item_info; - my ($expander,$relay,$wireless); + my ($instance,$expander,$relay,$wireless, $zone, $partition); + ($name, $instance, $zone, $partition, $address, $grouplist, @other) = @item_info; $other = join ', ', (map {"'$_'"} @other); # Quote data my ($map, $address) = split('=', $address); $expander = $address if (uc($map) eq "EXP"); $relay = $address if (uc($map) eq "REL"); $wireless = $address if (uc($map) eq "RFX"); - $object = "AD2_Item('',$instance,$zone,$partition,$expander,$relay,$wireless,$other)"; + $object = "AD2_Item('','$instance','$zone','$partition','$expander','$relay','$wireless','$other')"; } elsif($type eq "AD2_PARTITION") { require AD2; - my ($name, $instance, $number, $address, @other) = @item_info; + my ($instance,$number); + ($name, $instance, $number, $address, $grouplist, @other) = @item_info; $other = join ', ', (map {"'$_'"} @other); # Quote data - $object = "AD2_Partition($instance,$number,$address,$other)"; + $object = "AD2_Partition('$instance','$number','$address','$other')"; } #-------------- End AD2 Objects ------------- else { From 4b1a455692738d915b809b51348b23980a648ba8 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sun, 16 Mar 2014 12:58:00 -0700 Subject: [PATCH 076/180] AD2: Derefernce Hash Before Running Keys to Enable Perl 5.8 Compatibility --- lib/AD2.pm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/AD2.pm b/lib/AD2.pm index 051236375..f6d03604c 100755 --- a/lib/AD2.pm +++ b/lib/AD2.pm @@ -477,7 +477,7 @@ sub CheckCmd { .$status_type->{rf_low_batt}.") supervised(".$status_type->{rf_supervised} .")" ); - foreach my $rf_key (keys $$self{wireless}){ + foreach my $rf_key (keys %{$$self{wireless}}){ if ($rf_key =~ /^${rf_id}(.*)/) { my $LoopNum = 1; my $SensorType = 's'; @@ -918,17 +918,17 @@ sub is_zone_mapped { my ($self, $zone) = @_; $zone = sprintf "%03s", $zone; if (defined $$self{relay}){ - foreach my $mkey (keys $$self{relay}) { + foreach my $mkey (keys %{$$self{relay}}) { if ($zone eq $$self{relay}{$mkey}) { return 1 } } } if (defined $$self{wireless}){ - foreach my $mkey (keys $$self{wireless}) { + foreach my $mkey (keys %{$$self{wireless}}) { if ($zone eq $$self{wireless}{$mkey}) { return 1 } } } if (defined $$self{expander}){ - foreach my $mkey (keys $$self{expander}) { + foreach my $mkey (keys %{$$self{expander}}) { if ($zone eq $$self{expander}{$mkey}) { return 1 } } } From e107334306f1eea5efbbd40f3d2fe10eeb4bd478 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Mon, 24 Mar 2014 17:45:00 -0700 Subject: [PATCH 077/180] Insteon_PLM_Parser: Completely ReWritten _parse_data Routine Changes the PLM parser to a First-In-First-Out style. This should resolve the issue found in hollie/misterhouse#374 where shorter messages were being excerpted out of the middle of larger messages. I believe the routine is significantly easier to read. Removed the use of the split routine which created really odd results, and was not the most logical code to follow. This also likely solves other latent issues that may not have been apparent. --- lib/Insteon_PLM.pm | 937 +++++++++++++++++++++++---------------------- 1 file changed, 489 insertions(+), 448 deletions(-) diff --git a/lib/Insteon_PLM.pm b/lib/Insteon_PLM.pm index b684dc8d5..434589772 100644 --- a/lib/Insteon_PLM.pm +++ b/lib/Insteon_PLM.pm @@ -512,488 +512,529 @@ sub _send_cmd { =item C<_parse_data()> -A complex routine that parses data comming in from the serial port. In many cases -multiple messages or fragments of messages may arrive at once. This routine sorts -through the string of hexadecimal characters and determines what type of message -has arrived and its full content. Based on the type of message, it is then -passed off to lower level message handling routines. +This routine parses data comming in from the serial port. In many cases +multiple messages or fragments of messages may arrive at once. This routine +attempts to parse this string of data into individual messages, unfortunately +the PLM does not have a unique message delimiter. Instead, all PLM messages +start with 02XX where XX is a two digit code corresponding to the message type. -=cut +The one caveat, is that the PLM may send simple 15 to indicate that it is busy. -sub _parse_data { - my ($self, $data) = @_; - my ($name, $val); +This routine uses a First-In-First-Out (FIFO) style for processing the data +stream by following this procedure: - # 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 $self->debuglevel(3, 'insteon'); - # 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} = ''; - } + 1. Prepend any prior data fragment left over from the last run + 2. Trim off any PLM busy messages + 3. Locate the first valid PLM prefix in the message + 4. Look for PLM ACK, NACK and BadCmd Responses + 5. Look for known Insteon message types + 6. Dispose of stale data that doesn't match known message types + 7. Save whatever data fragments remain for the next pass - &::print_log( "[Insteon_PLM] DEBUG3: Received PLM raw data: $data") if $self->debuglevel(3, 'insteon'); +Based on the type of message, it is then passed off to higher level message +handling routines. - # 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; - } - } +=cut - my $residue_data = ''; +sub _parse_data { + my ($self, $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 $debug_obj = $self; - $debug_obj = $self->active_message->setby if ($self->active_message->can('setby') && ref $self->active_message->setby); - &::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($parsed_data)) if $debug_obj->debuglevel(4, 'insteon'); - 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}) - { - if ($self->active_message->success_callback){ - package main; - eval ($self->active_message->success_callback); - &::print_log("[Insteon_PLM] WARN1: Error encountered during ack callback: " . $@) - if ($@ && $self->active_message->can('setby') - && ref $self->active_message->setby - && $self->active_message->setby->debuglevel(1, 'insteon')); - package Insteon_PLM; - } - # clear the active message because we're done - $self->clear_active_message(); - } - else - { - my $debug_obj = $self; - $debug_obj = $self->active_message->setby if ($self->active_message->can('setby') && ref $self->active_message->setby); - &::print_log("[Insteon_PLM] DEBUG3: Received PLM acknowledge: " - . $pending_message->to_string) if $debug_obj->debuglevel(3, 'insteon'); - } - - # 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; - if ($self->_aldb->{_success_callback}){ - $callback = $self->_aldb->{_success_callback}; - $self->_aldb->{_success_callback} = undef; - } elsif ($$self{_mem_callback}) - { - $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 ($@ && $self->active_message->can('setby') - && ref $self->active_message->setby - && $self->active_message->setby->debuglevel(1, 'insteon')); - 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"); - } - $self->_aldb->scandatetime(&main::get_tickcount); - &::print_log("[Insteon_PLM] " . $self->get_object_name - . " completed link memory scan: status: " . $self->_aldb->health()) - if $self->debuglevel(1, 'insteon'); - 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 $self->debuglevel(1, 'insteon'); - 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" ); - my $callback; - if ($self->_aldb->{_success_callback}){ - $callback = $self->_aldb->{_success_callback}; - $self->_aldb->{_success_callback} = undef; - } elsif ($$self{_mem_callback}) - { - $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 $self->debuglevel(1, 'insteon'); - package Insteon_PLM; - } - # clear the active message because we're done - # $self->clear_active_message(); - } - else - { - &::print_log("[Insteon_PLM] WARN: received NACK from PLM for " - . $pending_message->to_string()); - } - } - 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->active_message->no_hop_increase(1); - $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] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($parsed_data)) if $unknown_obj->debuglevel(4, 'insteon'); - &::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] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($parsed_data)) if $self->debuglevel(4, 'insteon'); - &::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; - } - $self->active_message->no_hop_increase(1); + my $debug_obj = $self; + $debug_obj = $self->active_message->setby + if (ref $self->active_message + && $self->active_message->can('setby') + && ref $self->active_message->setby); + + ::print_log( "[Insteon_PLM] DEBUG3: Received PLM raw data: $data") + if $self->debuglevel(3, 'insteon'); + + # STEP 1 Prepend any prior unprocessed data fragment + if ($$self{_data_fragment}) { + ::print_log("[Insteon_PLM] DEBUG3: Prepending prior data fragment". + ": $$self{_data_fragment}") + if $self->debuglevel(3, 'insteon'); + $data = $$self{_data_fragment} . $data; + } + + # Continue to Process Data until we can't + my $process_data = 1; + while ($process_data) { + ::print_log( "[Insteon_PLM] DEBUG3: Processing PLM raw data: $data") + if $self->debuglevel(3, 'insteon'); + + # Step 2 Is this a PLM Busy Message? + if (substr($data,0,2) eq '15') { + # The PLM can't receive any more commands at the moment + if ($self->active_message){ + 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 $self->debuglevel(3, 'insteon'); + $self->_set_timeout('xmit',$nack_delay * 1000); + $self->active_message->no_hop_increase(1); + $process_next_command = 0; + } else { + ::print_log("[Insteon_PLM] DEBUG3: Interface extremely busy." + . " No message to resend.") if $self->debuglevel(3, 'insteon'); + } + #Remove the leading NACK bytes and place whatever remains into fragment for next read + $data =~ s/^(15)*//; + } + + # STEP 3 Does $data start with a valid prefix? + my $record_type = substr($data,0,4); + unless (grep(/$record_type/, values(%prefix))){ + $data = $self->_next_valid_prefix($data); + ::print_log( "[Insteon_PLM] ERROR: Received data did not start " + . "with a valid prefix. Trimming to: $data"); + $record_type = substr($data,0,4); + } + + # STEP 4a Is this a PLM Response to a command we sent? Prep Vars + my ($is_ack, $is_nack, $is_badcmd, $ackcmd, $nackcmd, $badcmd); + my $pending_message = $self->active_message; + + if ($pending_message) { + # Prep Variables + my $prev_cmd = lc $pending_message->interface_data; + my $prev_cmd_length = length($prev_cmd); # Used to get msg data + + # Add PLM Prefix to Prior Command + 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; + } + + # Add ACK, NACK and BadCmd Suffixes + $ackcmd = $prev_cmd . '06'; + $nackcmd = $prev_cmd . '15'; + $badcmd = $prev_cmd . '0f'; + + # Does Data start with any of these messages? + $is_ack = 1 if ($data =~ /^($ackcmd)/); + $is_nack = 1 if ($data =~ /^($nackcmd)/); + $is_badcmd = 1 if ($data =~ /^($badcmd)/); + } + + # STEP 4b Is this a PLM Response to a command MH sent? + if ($is_ack) { + ::print_log( "[Insteon_PLM] DEBUG4:\n". + Insteon::MessageDecoder::plm_decode($data)) + if $debug_obj->debuglevel(4, 'insteon'); + + ::print_log("[Insteon_PLM] DEBUG3: Received PLM acknowledge: " + . $pending_message->to_string) if $debug_obj->debuglevel(3, 'insteon'); + + # Handle PLM ALDB Messages (Should these be here???) + if ($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}) { + if ($self->active_message->success_callback){ + package main; + eval ($self->active_message->success_callback); + &::print_log("[Insteon_PLM] WARN1: Error encountered during ack callback: " . $@) + if ($@ && $self->active_message->can('setby') + && ref $self->active_message->setby + && $self->active_message->setby->debuglevel(1, 'insteon')); + package Insteon_PLM; + } + # clear the active message because we're done + $self->clear_active_message(); + } + elsif ($record_type eq $prefix{all_link_manage_rec}) { + # Managing the PLM's ALDB + $self->clear_active_message(); + + my $callback; + if ($self->_aldb->{_success_callback}){ + $callback = $self->_aldb->{_success_callback}; + $self->_aldb->{_success_callback} = undef; + } + elsif ($$self{_mem_callback}) { + $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 ($@ && $self->active_message->can('setby') + && ref $self->active_message->setby + && $self->active_message->setby->debuglevel(1, 'insteon')); + package Insteon_PLM; } - else - { - $residue_data .= $parsed_data; + } + elsif ($record_type eq $prefix{x10_send}) { + # The PLM ACK is all we get for X10 + $self->clear_active_message(); + } + $data =~ s/^$ackcmd//; + } + elsif ($is_nack) { + ::print_log( "[Insteon_PLM] DEBUG4:\n". + Insteon::MessageDecoder::plm_decode($data)) + if $debug_obj->debuglevel(4, 'insteon'); + + # regardless, we're not retrying as we'll just get the same + $self->clear_active_message(); + + # More PLM ALDB Messages (Again should these be here???) + 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"); } - } - } #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})|($prefix{plm_user_reset})/,$residue_data)) - { - #ignore blanks.. the split does odd things - next if $parsed_data eq ''; - - if ($previous_parsed_data eq $parsed_data){ - # guard against repeats - ::print_log("[Insteon_PLM] DEBUG3: Dropped duplicate message: $parsed_data") if $self->debuglevel(3, 'insteon'); - next; - } - $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 - my $find_obj = Insteon::get_object(substr($parsed_data,4,6), '01'); - if (ref $find_obj) { - &::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($parsed_data)) if $find_obj->debuglevel(4, 'insteon'); - } - else { - &::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($parsed_data)) if $self->debuglevel(4, 'insteon'); - } + else { + $self->_aldb->health("good"); + } + $self->_aldb->scandatetime(&main::get_tickcount); + &::print_log("[Insteon_PLM] " . $self->get_object_name + . " completed link memory scan: status: " . $self->_aldb->health()) + if $self->debuglevel(1, 'insteon'); + 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 $self->debuglevel(1, 'insteon'); + package Insteon_PLM; + } + } + elsif ($record_type eq $prefix{all_link_send}) { + &::print_log("[Insteon_PLM] WARN: PLM ALDB does not have a link for this scene defined: " + . $pending_message->to_string . $@) + } + elsif ($record_type eq $prefix{all_link_start}) { + &::print_log("[Insteon_PLM] WARN: PLM unable to enter linking mode: " + . $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" ); + my $callback; + if ($self->_aldb->{_success_callback}){ + $callback = $self->_aldb->{_success_callback}; + $self->_aldb->{_success_callback} = undef; + } elsif ($$self{_mem_callback}){ + $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 $self->debuglevel(1, 'insteon'); + package Insteon_PLM; + } + } + else { + &::print_log("[Insteon_PLM] WARN: received NACK from PLM for " + . $pending_message->to_string()); + } + $data =~ s/^$nackcmd//; + } + elsif ($is_badcmd){ + ::print_log( "[Insteon_PLM] DEBUG4:\n". + Insteon::MessageDecoder::plm_decode($data)) + if $debug_obj->debuglevel(4, 'insteon'); + + ::print_log("[Insteon_PLM] WARN: received Bad Command Error" + ." from PLM for ". $pending_message->to_string()); + + $data =~ s/^$badcmd//; + } + elsif ($pending_message + && $data =~ /^($prefix{insteon_send}\w{12}06)|($prefix{insteon_send}\w{12}15)|($prefix{insteon_send}\w{12}0f)/) { + # This looks like a garbled PLM Response + my $unknown_deviceid = substr($data,4,6); + my $unknown_msg_flags = substr($data,10,2); + my $unknown_command = substr($data,12,2); + my $unknown_data = substr($data,14,2); + my $unknown_obj = &Insteon::get_object($unknown_deviceid, '01'); + if ($unknown_obj) { + &::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) + if $unknown_obj->debuglevel(4, 'insteon'); + &::print_log("[Insteon_PLM] WARN: encountered garbled PLM data '$data'" + . " but expected '$ackcmd'. Attempting to find next valid" + . " message."); + } + else { + &::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) + if $self->debuglevel(4, 'insteon'); + &::print_log("[Insteon_PLM] ERROR: encountered garbled PLM data '$data' " + . "that does not match any known device ID (expected '$ackcmd')." + . " Attempting to find next valid message."); + } + $self->active_message->no_hop_increase(1); + + # Because this was an unexpected response, find next + # possible prefix and process from there. Maybe this + # message was something else + $data = $self->_next_valid_prefix($data); + } + + # STEP 5 Is this valid data received from the network? + elsif ($record_type eq $prefix{insteon_received} and (length($data) >= 22)) { + #Insteon Standard Received + my $message_data = substr($data,4,18); + my $find_obj = Insteon::get_object(substr($data,4,6), '01'); + if (ref $find_obj) { + ::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) + if $find_obj->debuglevel(4, 'insteon'); + } + else { + ::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) + if $self->debuglevel(4, 'insteon'); + } $self->on_standard_insteon_received($message_data); - } - elsif ($parsed_prefix eq $prefix{insteon_ext_received} and ($message_length == 50)) - { #Insteon Extended Received - my $find_obj = Insteon::get_object(substr($parsed_data,4,6), '01'); - if (ref $find_obj) { - &::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($parsed_data)) if $find_obj->debuglevel(4, 'insteon'); - } - else { - &::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($parsed_data)) if $self->debuglevel(4, 'insteon'); - } + + $data = substr($data, 22); + } + elsif ($record_type eq $prefix{insteon_ext_received} and (length($data) >= 50)) { + #Insteon Extended Received + my $message_data = substr($data,4,46); + my $find_obj = Insteon::get_object(substr($data,4,6), '01'); + if (ref $find_obj) { + ::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) + if $find_obj->debuglevel(4, 'insteon'); + } + else { + ::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) + if $self->debuglevel(4, 'insteon'); + } $self->on_extended_insteon_received($message_data); - } - elsif($parsed_prefix eq $prefix{x10_received} and ($message_length == 8)) - { #X10 Received - &::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($parsed_data)) if $self->debuglevel(4, 'insteon'); - my $x10_message = new Insteon::X10Message($parsed_data); + + $data = substr($data, 50); + } + elsif ($record_type eq $prefix{x10_received} and (length($data) >= 8)) { + #X10 Received + my $message_data = substr($data,4,4); + ::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) + if $self->debuglevel(4, 'insteon'); + my $message_data = substr($data,0,8); + 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 $self->debuglevel(3, 'insteon'); - &::process_serial_data($x10_data,undef,$self); - } - elsif ($parsed_prefix eq $prefix{all_link_complete} and ($message_length == 20)) - { #ALL-Linking Completed - &::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($parsed_data)) if $self->debuglevel(4, 'insteon'); - my $link_address = substr($message_data,4,6); - &::print_log("[Insteon_PLM] DEBUG2: ALL-Linking Completed with $link_address ($message_data)") if $self->debuglevel(2, 'insteon'); - my $device_object = Insteon::get_object($link_address); - $device_object->devcat(substr($message_data,10,4)); - $device_object->firmware(substr($message_data,14,2)); - if (ref $self->active_message && - $self->active_message->success_callback){ - main::print_log("[Insteon::Insteon_PLM] DEBUG4: Now calling message success callback: " - . $self->active_message->success_callback) if $self->debuglevel(4, 'insteon'); - package main; - eval $self->active_message->success_callback; - ::print_log("[Insteon::Insteon_PLM] problem w/ success callback: $@") if $@; - package Insteon::BaseObject; - } - #Clear awaiting_ack flag - $self->active_message->setby->_process_command_stack(0); + ::print_log("[Insteon_PLM] DEBUG3: received x10 data: $x10_data") + if $self->debuglevel(3, 'insteon'); + ::process_serial_data($x10_data,undef,$self); + + $data = substr($data, 8); + } + elsif ($record_type eq $prefix{all_link_complete} and (length($data) >= 20)) { + #ALL-Linking Completed + my $message_data = substr($data,4,16); + ::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) + if $self->debuglevel(4, 'insteon'); + my $link_address = substr($message_data,4,6); + ::print_log("[Insteon_PLM] DEBUG2: ALL-Linking Completed with $link_address ($message_data)") + if $self->debuglevel(2, 'insteon'); + my $device_object = Insteon::get_object($link_address); + $device_object->devcat(substr($message_data,10,4)); + $device_object->firmware(substr($message_data,14,2)); + if (ref $self->active_message && + $self->active_message->success_callback){ + main::print_log("[Insteon::Insteon_PLM] DEBUG4: Now calling message success callback: " + . $self->active_message->success_callback) if $self->debuglevel(4, 'insteon'); + package main; + eval $self->active_message->success_callback; + ::print_log("[Insteon::Insteon_PLM] problem w/ success callback: $@") if $@; + package Insteon::BaseObject; + } + #Clear awaiting_ack flag + $self->active_message->setby->_process_command_stack(0); $self->clear_active_message(); - } - elsif ($parsed_prefix eq $prefix{all_link_clean_failed} and ($message_length == 12)) - { #ALL-Link Cleanup Failure Report - if ($self->active_message){ + + $data = substr($data, 20); + } + elsif ($record_type eq $prefix{all_link_clean_failed} and (length($data) >= 12)) { + #ALL-Link Cleanup Failure Report + my $message_data = substr($data,4,8); + if ($self->active_message){ # extract out the pertinent parts of the message for display purposes # bytes 0-1 - group; 2-7 device address my $failure_group = substr($message_data,0,2); my $failure_device = substr($message_data,2,6); my $failed_object = &Insteon::get_object($failure_device,'01'); if (ref $failed_object){ - &::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($parsed_data)) if $failed_object->debuglevel(4, 'insteon'); - &::print_log("[Insteon_PLM] DEBUG2: Received all-link cleanup failure from " . $failed_object->get_object_name - . " for all link group: $failure_group. Trying a direct cleanup.") if $failed_object->debuglevel(2, 'insteon'); - my $message = new Insteon::InsteonMessage('all_link_direct_cleanup', $failed_object, - $self->active_message->command, $failure_group); - push(@{$$failed_object{command_stack}}, $message); - $failed_object->_process_command_stack(); - } else { - &::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($parsed_data)) if $self->debuglevel(4, 'insteon'); - &::print_log("[Insteon_PLM] Received all-link cleanup failure from an unkown device id: " + ::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) + if $failed_object->debuglevel(4, 'insteon'); + ::print_log("[Insteon_PLM] DEBUG2: Received all-link cleanup failure from " . $failed_object->get_object_name + . " for all link group: $failure_group. Trying a direct cleanup.") + if $failed_object->debuglevel(2, 'insteon'); + my $message = new Insteon::InsteonMessage('all_link_direct_cleanup', $failed_object, + $self->active_message->command, $failure_group); + push(@{$$failed_object{command_stack}}, $message); + $failed_object->_process_command_stack(); + } + else { + ::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) + if $self->debuglevel(4, 'insteon'); + ::print_log("[Insteon_PLM] Received all-link cleanup failure from an unkown device id: " . "$failure_device and for all link group: $failure_group. You may " . "want to run delete orphans to remove this link from your PLM"); } - } else { - &::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($parsed_data)) if $self->debuglevel(4, 'insteon'); - &::print_log("[Insteon_PLM] DEBUG2: Received all-link cleanup failure." - . " But there is no pending message.") if $self->debuglevel(2, 'insteon'); - } - - } - elsif ($parsed_prefix eq $prefix{all_link_record} and ($message_length == 20)) - { #ALL-Link Record Response - &::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($parsed_data)) if $self->debuglevel(4, 'insteon'); - &::print_log("[Insteon_PLM] DEBUG2: ALL-Link Record Response:$message_data") if $self->debuglevel(2, 'insteon'); - $self->_aldb->parse_alllink($message_data); + } + else { + ::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) + if $self->debuglevel(4, 'insteon'); + ::print_log("[Insteon_PLM] DEBUG2: Received all-link cleanup failure." + . " But there is no pending message.") + if $self->debuglevel(2, 'insteon'); + } + + $data = substr($data, 12); + } + elsif ($record_type eq $prefix{all_link_record} and (length($data) >= 20)) { + #ALL-Link Record Response + my $message_data = substr($data,4,16); + &::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) + if $self->debuglevel(4, 'insteon'); + &::print_log("[Insteon_PLM] DEBUG2: ALL-Link Record Response:$message_data") + if $self->debuglevel(2, 'insteon'); + $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(); + + $data = substr($data, 20); + } + elsif ($record_type eq $prefix{plm_user_reset} and (length($data) >= 4)) { + &::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) + if $self->debuglevel(4, 'insteon'); + main::print_log("[Insteon_PLM] Detected PLM user reset to factory defaults"); + + $data = substr($data, 4); + } + elsif ($record_type eq $prefix{all_link_clean_status} and (length($data) >= 6)) { + #ALL-Link Cleanup Status Report + my $message_data = substr($data,4,2); + ::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) + if $self->debuglevel(4, 'insteon'); + my $cleanup_ack = substr($message_data,0,2); + if (ref $self->active_message){ + if ($cleanup_ack eq '15') { + &::print_log("[Insteon_PLM] WARN1: All-link cleanup failure for scene: " + . $self->active_message->setby->get_object_name . ". Retrying in 1 second.") + if $self->active_message->setby->debuglevel(1, 'insteon'); + # except that we should cause a bit of a delay to let things settle out + $self->_set_timeout('xmit', 1000); + $process_next_command = 0; + } + else { + my $message_to_string = ($self->active_message) ? $self->active_message->to_string() : ""; + &::print_log("[Insteon_PLM] Received all-link cleanup success: $message_to_string") + if $self->active_message->setby->debuglevel(1, 'insteon'); + if (ref $self->active_message && ref $self->active_message->setby){ + my $object = $self->active_message->setby; + $object->is_acknowledged(1); + $object->_process_command_stack(); + } + $self->clear_active_message(); + } + } + + $data = substr($data, 6); + } + elsif ($record_type eq $prefix{plm_info} and (length($data) >= 18)){ + ::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) + if $self->debuglevel(4, 'insteon'); + + $self->device_id(substr($data,0,6)); + $self->firmware(substr($data,10,2)); + $self->on_interface_info_received(); + + $data = substr($data, 18); + } + else { + # No more processing can be done now, wait for more data + $process_data = 0; + } + + # Step 6 Dispose of bad messages + # If this is a new fragment, reset the timer + if ( length($$self{_data_fragment}) == 0 + or (index($data,$$self{_data_fragment}) != 0)){ + $$self{_data_time} = time; + } + + # If the timer has expired, Find next message + if ($$self{_data_time} < (time -1) && length($data)) { + ::print_log("[Insteon_PLM] DEBUG3: ERROR: Could not process message." + ." Removing stale data from queue.") + if( $self->debuglevel(3, 'insteon')); + + # Dump 1 character from data + $data = substr($data,1); + + # Find next legitimate prefix + $data = $self->_next_valid_prefix($data); + + # Try and process next message, maybe it is all here + $process_data = 1; + } - $self->_aldb->get_next_alllink(); - } - elsif ($parsed_prefix eq $prefix{plm_user_reset} and ($message_length == 4)) - { - &::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($parsed_data)) if $self->debuglevel(4, 'insteon'); - main::print_log("[Insteon_PLM] Detected PLM user reset to factory defaults"); - } - elsif ($parsed_prefix eq $prefix{all_link_clean_status} and ($message_length == 6)) - { #ALL-Link Cleanup Status Report - &::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($parsed_data)) if $self->debuglevel(4, 'insteon'); - my $cleanup_ack = substr($message_data,0,2); - if (ref $self->active_message){ - if ($cleanup_ack eq '15') - { - &::print_log("[Insteon_PLM] WARN1: All-link cleanup failure for scene: " - . $self->active_message->setby->get_object_name . ". Retrying in 1 second.") - if $self->active_message->setby->debuglevel(1, 'insteon'); - $self->retry_active_message(); - # except that we should cause a bit of a delay to let things settle out - $self->_set_timeout('xmit', 1000); - $process_next_command = 0; - } - else - { - my $message_to_string = ($self->active_message) ? $self->active_message->to_string() : ""; - &::print_log("[Insteon_PLM] Received all-link cleanup success: $message_to_string") - if $self->active_message->setby->debuglevel(1, 'insteon'); - if (ref $self->active_message && ref $self->active_message->setby){ - my $object = $self->active_message->setby; - $object->is_acknowledged(1); - $object->_process_command_stack(); - } - $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)) - { - if ($self->active_message){ - 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 $self->debuglevel(3, 'insteon'); - $self->_set_timeout('xmit',$nack_delay * 1000); - $self->active_message->no_hop_increase(1); - $self->retry_active_message(); - $process_next_command = 0; - } else { - &::print_log("[Insteon_PLM] DEBUG3: Interface extremely busy." - . " No message to resend.") if $self->debuglevel(3, 'insteon'); - } - $nack_count++; - } - #Remove the leading NACK bytes and place whatever remains into fragment for next read - $parsed_data =~ s/^(15)*//; - if ($parsed_data ne ''){ - $$self{_data_fragment} .= $parsed_data; - ::print_log("[Insteon_PLM] DEBUG3: Saving parsed data fragment: " - . $parsed_data) if( $self->debuglevel(3, 'insteon')); - } - } - 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 - unless (($parsed_data eq $$self{_prior_data_fragment}) or ($parsed_data eq $$self{_data_fragment})) { - $$self{_data_fragment} .= $parsed_data; - main::print_log("[Insteon_PLM] DEBUG3: Saving parsed data fragment: " - . $parsed_data) if( $self->debuglevel(3, 'insteon')); - } - } + # Stop processing if nothing to do + $process_data = 0 if (length($data) == 0); } - unless( $entered_rcv_loop or $$self{_data_fragment}) { - $$self{_data_fragment} = $residue_data; - main::print_log("[Insteon_PLM] DEBUG3: Saving residue data fragment: " - . $residue_data) if( $residue_data and $self->debuglevel(3, 'insteon')); + # STEP 7 Save whatever fragment remains for future processing + if (length($data) > 0) { + ::print_log("[Insteon_PLM] DEBUG3: Saving data fragment: " + . $data) if( $self->debuglevel(3, 'insteon')); } + $$self{_data_fragment} = $data; + # Should we be moving on in the queue? if ($process_next_command) { $self->process_queue(); } + else { + $self->retry_active_message(); + } + +} + +=item C<_next_valid_prefix()> - return; +Looks for the first instance of a valid PLM prefix is a string of data and +returns that prefix and all subsequent data. + +=cut + +sub _next_valid_prefix { + my ($self, $data) = @_; + my $lowest_index = length($data); + for (values(%prefix)){ + if (($lowest_index > index($data, $_, 1)) + && (index($data, $_, 1) >= 0)){ + $lowest_index = index($data, $_, 1); + } + } + return substr($data,$lowest_index); } =item C From 016e681d237cb7d5aae2d73ad8f2eade559de939 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Wed, 26 Mar 2014 18:59:19 -0700 Subject: [PATCH 078/180] AD2: Add State Support to Partition --- lib/AD2.pm | 100 +++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 97 insertions(+), 3 deletions(-) diff --git a/lib/AD2.pm b/lib/AD2.pm index f6d03604c..3f20700a0 100755 --- a/lib/AD2.pm +++ b/lib/AD2.pm @@ -354,7 +354,7 @@ sub check_for_data { } else { # restart the TCP connection if its lost. if ($Socket_Items{$instance}{recon_timer}->inactive) { - &main::print_log("Connection to $instance instance of AD2 was lost, I will try to reconnect in $$self{reconnect_time} seconds"); + ::print_log("Connection to $instance instance of AD2 was lost, I will try to reconnect in $$self{reconnect_time} seconds"); # ::logit("AD2.pm ser2sock connection lost! Trying to reconnect." ); $Socket_Items{$instance}{recon_timer}->set($$self{reconnect_time}, sub { $Socket_Items{$instance}{'socket'}->start; @@ -937,9 +937,10 @@ sub is_zone_mapped { =item C -Used to send commands to the Interface. +Older method used to send commands to the Interface. -Needs work. +Has potential security flaws. It certainly allows for a brute force attack +to identify the Master Code. Potentially other flaws too. =cut @@ -985,6 +986,40 @@ sub cmd { return "Sending to ADEMCO panel: $CmdName ($cmd)"; } +=item C + +Used to send commands to the interface. + +=cut + +sub set { + my ($self, $p_state, $p_setby, $p_response) = @_; + my $instance = $$self{instance}; + $p_state = lc($p_state); + my $cmd = ( exists $self->{CmdMsg}->{$p_state} ) ? $self->{CmdMsg}->{$p_state} : $p_state; + + $self->debug_log(">>> Sending to ADEMCO panel $p_state ($cmd)"); + $self->{keys_sent} = $self->{keys_sent} + length($cmd); + if (defined $Socket_Items{$instance}) { + if ($Socket_Items{$instance . '_sender'}{'socket'}->active) { + $Socket_Items{$instance . '_sender'}{'socket'}->set("$cmd"); + } else { + # restart the TCP connection if its lost. + if ($Socket_Items{$instance}{recon_timer}->inactive) { + ::print_log("Connection to $instance sending instance of AD2 was lost, I will try to reconnect in $$self{reconnect_time} seconds"); + $Socket_Items{$instance}{recon_timer}->set($$self{reconnect_time}, sub { + $Socket_Items{$instance . '_sender'}{'socket'}->start; + $Socket_Items{$instance . '_sender'}{'socket'}->set("$cmd"); + }); + } + } + } + else { + $main::Serial_Ports{$instance}{'socket'}->write("$cmd"); + } + return; +} + =item C Takes a zone number and returns its status. @@ -1461,6 +1496,48 @@ The Partition is used primarily as a stand in for the alarm panel. The Partition object is used to arm/disarm the panel as well as to check on the agregate state of all of the zones that are within this partition. +The partition object can be set to: + + Disarm - Disarm the system + ArmAway - Arm the entire system with an exit delay + ArmStay - Arm the perimeter with an exit delay + ArmAwayMax - Arm entire system with NO delay + Test - Places the system into the test mode + Bypass - Bypass or exclude specific zones from arming + ArmStayInstant - Arm the perimeter with NO delay + Code - Used to program alarm including codes + Chime - Turns the the audible fault notification on/off + ToggleVoice - Turns on/off the audible voice if available + +All of the above commands require an alarm code except for the ToggleVoice +command. + +=head3 Use of Alarm Code + +You have two options for entering your alarm code. B, you can preprogram +your alarm code into you ini file using the following parameter: + + AD2_user_master_code=1234 + +Where, AD2 is your AD2-Prefix. If you elect to use this system, the above +commands can be run by anyone with access to your MisterHouse installation. +You will not be required to enter your alarm code again. This includes the +ability to disarm the system. Obviously, only elect this design if you are +comfortable with the security of your MisterHouse installation. + +Note: In the future, it may be possible to use a secondary code that allows for the +arming of the system, but not disarming. This would slightly decrease the +security risk, but would still create a "harassment" risk in that if your +MisterHouse installation is hacked, your alarm could easily be triggered. + +B if you do not place your alarm code in your ini file, you must then +set your alarm code before setting any of the above states. For example: + + $partition_1->set("1234"); + $partition_1->set("Disarm"); + +These commands must be sent within 4-5 seconds of each other. + =head2 INHERITS L @@ -1498,9 +1575,26 @@ sub new $interface = AD2::get_object_by_instance($interface); $$interface{partition_address}{$partition} = $address; $interface->register($self,$partition); + $$self{interface} = $interface; + @{$$self{states}} = ('Disarm', 'ArmAway','ArmStay','ArmAwayMax','Test','Bypass', + 'ArmStayInstant','Code','Chime','ToggleVoice'); return $self; } +sub set { + my ($self, $p_state, $p_setby, $p_response) = @_; + my $found_state = 0; + foreach my $test_state (@{$$self{states}}){ + if (lc($test_state) eq lc($p_state)){ + $found_state = 1; + } + } + if ($found_state){ + ::print_log("[AD2::Partition] Received request to " + . $p_state . " for parition " . $self->get_object_name); + $$self{interface}->cmd($p_state); + } +} =back From 1b7758e3904e96a68172c18fe645e3ba3b561747 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Wed, 26 Mar 2014 19:28:16 -0700 Subject: [PATCH 079/180] AD2: Fix Wireless Definition; Fix Resetting of Keyfobs Cannot use comma in mht definitions Keyfob was not likely ever set to fault, since fault and ready were set in same loop. --- lib/AD2.pm | 37 +++++++++++++++++++++---------------- 1 file changed, 21 insertions(+), 16 deletions(-) diff --git a/lib/AD2.pm b/lib/AD2.pm index 3f20700a0..37303f478 100755 --- a/lib/AD2.pm +++ b/lib/AD2.pm @@ -207,8 +207,8 @@ sub read_parms{ if ($mkey =~ /^${instance}_wireless_(.*)/){ if (index($::config_parms{$mkey}, ',') <= 0){ #Supports new style ini parameter, wherein each zone is a separate entry: - #AD2_wireless_[RF_ID],[LOOP],[TYPE]=[ZONE] such as: - #AD2_wireless_1234567,1,k=10 + #AD2_wireless_[RF_ID].[LOOP].[TYPE]=[ZONE] such as: + #AD2_wireless_1234567.1.k=10 $$self{wireless}{$1} = $::config_parms{$mkey}; } else { @@ -224,7 +224,7 @@ sub read_parms{ } else { my ($sensortype, $ZoneLoop) = split("", $wnum); - $$self{wireless}{"$rf_id,$ZoneLoop,$sensortype"} + $$self{wireless}{"$rf_id.$ZoneLoop.$sensortype"} = $ZoneNum; } $lc++; @@ -340,8 +340,16 @@ sub check_for_data { # Clear Zone and Partition_Now Function $self->{zone_now} = (); $self->{partition_now} = (); + + # Reset any wireless keyfobs to ready + foreach my $rf_key (keys %{$$self{wireless}}){ + if ($rf_key =~ /.*\..*\.k/i) { + $self->ChangeZones( int($$self{wireless}{$rf_key}), + int($$self{wireless}{$rf_key}), "ready", "", 1); + } + } - # Get the date from serial or tcp source + # Get the data from serial or tcp source if ($connecttype eq 'serial') { &main::check_for_generic_serial_data($instance); $NewCmd = $main::Serial_Ports{$instance}{data}; @@ -478,10 +486,10 @@ sub CheckCmd { .")" ); foreach my $rf_key (keys %{$$self{wireless}}){ - if ($rf_key =~ /^${rf_id}(.*)/) { + if ($rf_key =~ /^${rf_id}\.?(.*)/) { my $LoopNum = 1; my $SensorType = 's'; - ($LoopNum, $SensorType) = split(',', $1); + ($LoopNum, $SensorType) = split('.', $1); my $ZoneNum = $$self{wireless}{$rf_key}; my $ZoneStatus = "ready"; @@ -493,9 +501,6 @@ sub CheckCmd { } $self->ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); - $self->ChangeZones( int($ZoneNum), int($ZoneNum), "ready", "", 1) - if ($SensorType eq "k"); #Toggle key buttons back to ready - #Not sure this works, set functions are called per loop } } } @@ -1231,7 +1236,7 @@ In mht file: AD2_DOOR_ITEM, back_door, AD2, 4, 1, HARDWIRED AD2_DOOR_ITEM, front_door, AD2, 5, 1, EXP=0101 AD2_MOTION_ITEM, upstairs_motion, AD2, 6, 1, REL=1301 - AD2_GENERIC_ITEM, generic_zone, AD2, 7, 1, RFX=0014936,4,k + AD2_GENERIC_ITEM, generic_zone, AD2, 7, 1, RFX=0014936.4.k Wherein the format for the definition is: @@ -1280,16 +1285,16 @@ with the relay output number (2 digits, 0 padded if required) such as 0101 or =head4 WIRELESS DEVICES For wireless zones, the prefix RFX= should be used. The address is the wireless -ID (7 digits) followed by a comma, the loop number, followed by a comma, and the +ID (7 digits) followed by a period, the loop number, followed by a period, and the wireless device type. All of this without any spaces. The loop number need only be specified if it is not 1. Generally, the loop number for most devices is 1. Similarly, the device type need only be specified if the wireless device is a keypad, in which case the type is the letter k. The following are valid wireless addresses: - RFX=0014936,4,k + RFX=0014936.4.k RFX=0101538 - RFX=5848878,1,k + RFX=5848878.1.k =head2 DESCRIPTION @@ -1333,10 +1338,10 @@ $expander = If not null, the expander address that the zone is mapped to. $relay = If not null, the relay address that the zone is mapped to. $wireless = If not null, the wireless address that the zone is mapped to in the -form of [RF_ID],[LOOP],[TYPE]. +form of [RF_ID].[LOOP].[TYPE]. -The wireless address is the wireless ID (7 digits) followed by a comma, the -loop number, followed by a comma, and the wireless device type. All of this +The wireless address is the wireless ID (7 digits) followed by a period, the +loop number, followed by a period, and the wireless device type. All of this without any spaces. The loop number need only be specified if it is not 1. Generally, the loop number for most devices is 1. Similarly, the device type need only be specified if the wireless device is a keypad, in which case the From f2bf4f3d57199d3737d61cc822b0af437274c1fd Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Wed, 26 Mar 2014 20:41:55 -0700 Subject: [PATCH 080/180] AD2: Add support for Output Devices --- lib/AD2.pm | 167 ++++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 151 insertions(+), 16 deletions(-) diff --git a/lib/AD2.pm b/lib/AD2.pm index 37303f478..56cf4cff2 100755 --- a/lib/AD2.pm +++ b/lib/AD2.pm @@ -107,6 +107,12 @@ See AD2_Partition See AD2_Item +=head2 TODO + +- Add support for control of emulated zones on the AD2 device. Would allow +MisterHouse to "communicate" with the alarm panel. Perhaps to trigger an alarm +if certain conditions are met. + =head2 INHERITS L @@ -851,19 +857,19 @@ sub DefineCmdMsg { my ($self) = @_; my $instance = $self->{instance}; my %Return_Hash = ( - "Disarm" => $Configuration{$instance."_user_master_code"}."1", - "ArmAway" => $Configuration{$instance."_user_master_code"}."2", - "ArmStay" => $Configuration{$instance."_user_master_code"}."3", - "ArmAwayMax" => $Configuration{$instance."_user_master_code"}."4", - "Test" => $Configuration{$instance."_user_master_code"}."5", - "Bypass" => $Configuration{$instance."_user_master_code"}."6#", - "ArmStayInstant" => $Configuration{$instance."_user_master_code"}."7", - "Code" => $Configuration{$instance."_user_master_code"}."8", - "Chime" => $Configuration{$instance."_user_master_code"}."9", - "ToggleVoice" => '#024', - "ShowFaults" => "*", - "AD2Reboot" => "=", - "AD2Configure" => "!" + "Disarm" => $Configuration{$instance."_user_master_code"}."1", + "ArmAway" => $Configuration{$instance."_user_master_code"}."2", + "ArmStay" => $Configuration{$instance."_user_master_code"}."3", + "ArmAwayMax" => $Configuration{$instance."_user_master_code"}."4", + "Test" => $Configuration{$instance."_user_master_code"}."5", + "Bypass" => $Configuration{$instance."_user_master_code"}."6#", + "ArmStayInstant" => $Configuration{$instance."_user_master_code"}."7", + "Code" => $Configuration{$instance."_user_master_code"}."8", + "Chime" => $Configuration{$instance."_user_master_code"}."9", + "ToggleVoice" => '#024', + "ShowFaults" => "*", + "AD2Reboot" => "=", + "AD2Configure" => "!" ); my $two_digit_zone; @@ -897,6 +903,17 @@ sub DefineCmdMsg { return \%Return_Hash; } +sub output_cmd { + my ($self, $cmd, $output) = @_; + my $instance = $self->{instance}; + if ($cmd =~ /start/i){ + $Configuration{$instance."_user_master_code"}."#7$output"; + } + else { + $Configuration{$instance."_user_master_code"}."#8$output"; + } +} + =item C Used to log messages to the specific AD2 log file. @@ -1203,6 +1220,9 @@ sub register { elsif ($object->isa('AD2_Partition')) { $self->{partition_object}{$num} = $object; } + elsif ($object->isa('AD2_Output')) { + $self->{output_object}{$num} = $object; + } } =item C @@ -1252,7 +1272,7 @@ hardwired zones this last item should be HARDWIRED. =head4 EXPANSION BOARDS -For zones wired to an expansion board, the prefix EXP= should be used. The +For zones wired to an expansion board, the prefix B should be used. The address is the expansion board id (2 digits, 0 padded if required) concatenated with the expansion input number (2 digits, 0 padded if required) such as 0101 or 1304. @@ -1277,14 +1297,14 @@ programing a relay board and mapping zones to it. Some alarm panels have limite capabilities when it comes to relays. Specifically, you want to refer to section of your manual that discusses *80 programming. -For hardwired zones mapped to a relay board, the prefix REL= should be used. The +For hardwired zones mapped to a relay board, the prefix B should be used. The address is the relay board id (2 digits, 0 padded if required) concatenated with the relay output number (2 digits, 0 padded if required) such as 0101 or 1304. =head4 WIRELESS DEVICES -For wireless zones, the prefix RFX= should be used. The address is the wireless +For wireless zones, the prefix B should be used. The address is the wireless ID (7 digits) followed by a period, the loop number, followed by a period, and the wireless device type. All of this without any spaces. The loop number need only be specified if it is not 1. Generally, the loop number for most devices @@ -1599,6 +1619,121 @@ sub set { . $p_state . " for parition " . $self->get_object_name); $$self{interface}->cmd($p_state); } + else { + $$self{interface}->set($p_state); + } +} + +=back + +=head1 B + +=head2 SYNOPSIS + +User code: + + $desk_lamp = new AD2_Output('AD2', 01); + +See C for a more detailed description of the arguments. + +In mht file: + + AD2_OUTPUT, desk_lamp, AD2, 01 + +Wherein the format for the definition is: + + AD2_OUTPUT, Object Name, AD2-Prefix, Output Number + +=head2 DESCRIPTION + +Provides support for creating MH-Style child objects for each output device. +These allow output devices to behave like Generic_Items. For example, +Generic_Item subroutines such as C and C can be used +with these devices. + +To use these, you must first create the appropriate AD2 Interface object. + +An output device is generally a relay, but it could be an X10 device, connected +to the alarm panel. The alarm panel can control the state of this relay. See +the *80 programming menu for your alarm panel for more details. + +Note: These relays are not to be confused with the emulated relays that are used +to track the state of hardwired zones in some instances. + +=head3 Alarm Code + +See the note above above in the partition description regarding the use of the +alarm code. + +If you elect not to store you alarm code in you ini file, you will need to +set the code first and then call start/stop. For Example: + + $desk_lamp->set("1234"); + $desk_lamp->set("Start"); + + +=head2 INHERITS + +L + +=head2 METHODS + +=over + +=cut + +package AD2_Output; + +@AD2_Output::ISA = ('Generic_Item'); + +=item C + + +=cut + +sub new +{ + my ($class,$interface,$output) = @_; + + my $self = new Generic_Item(); + bless $self,$class; + + $interface = AD2::get_object_by_instance($interface); + $$self{interface} = $interface; + $output = sprintf("%02d", $output); + $$self{output} = $output; + $interface->register($self,$output); + @{$$self{states}} = ('Start','Stop'); + return $self; + +} + +=item C + +Sets the object's state. + +=cut + +sub set +{ + my ($self,$p_state,$p_setby) = @_; + + if (ref $p_setby and $p_setby->can('get_set_by')) { + ::print_log("AD2_Output($$self{object_name})::set($p_state, $p_setby): $$p_setby{object_name} was set by " . $p_setby->get_set_by) if $main::Debug{AD2}; + } else { + ::print_log("AD2_Output($$self{object_name})::set($p_state, $p_setby)") if $main::Debug{AD2}; + } + my $reported_state; + if ($p_state =~ /^start/i || $p_state =~ /^stop/i) { + $reported_state = $p_state; + $$self{interface}->output_cmd($p_state, $$self{output}); + } + else { + $reported_state = ''; + $$self{interface}->set($p_state); + } + + $self->SUPER::set($reported_state,$p_setby); } =back From d9d5cddfeb8fd751f2f86de77498fdc2150bda7e Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 27 Mar 2014 14:30:23 -0700 Subject: [PATCH 081/180] Insteon: Don't Skip Duplicate Messages, Just Warn --- lib/Insteon/BaseInterface.pm | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/lib/Insteon/BaseInterface.pm b/lib/Insteon/BaseInterface.pm index 31aff0d68..deb223b95 100644 --- a/lib/Insteon/BaseInterface.pm +++ b/lib/Insteon/BaseInterface.pm @@ -310,19 +310,17 @@ sub queue_message 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 $self->debuglevel(1, 'insteon'); + if ($self->_is_duplicate($message->interface_data) + && !($message->isa('Insteon::X10Message'))){ + ::print_log("[Insteon::BaseInterface] WARN queuing a ". + "duplicate command already in queue.") + if $self->debuglevel(1, 'insteon'); } - else - { - 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); + 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(); From d0c91fe56c6cd55c12f4a93499cac5b4854c8621 Mon Sep 17 00:00:00 2001 From: Jon Whitear Date: Sun, 24 Nov 2013 13:14:35 +1100 Subject: [PATCH 082/180] Cbus update to support current CGate --- code/public/cbus.pl | 73 ++++++++++++++++++++++++++++++++++----------- 1 file changed, 55 insertions(+), 18 deletions(-) diff --git a/code/public/cbus.pl b/code/public/cbus.pl index af913bd00..b6a38ced0 100755 --- a/code/public/cbus.pl +++ b/code/public/cbus.pl @@ -84,6 +84,12 @@ # Changed DEV to DEBUG for commonality. # Monitor and Talker attempt to always run unless in DEBUG state. # +# V3.0.1 2013-11-22 +# Fixed to work with C-Gate Version: v2.9.7 (build 2569), which returns +# cbus addresses in the form NETWORK/APPLICATION/GROUP rather than +# //PROJECT/NETWORK/APPLICATION/GROUP. +# Add logging to aid debugging cbus_builder +# Contributed by Jon Whitear # # How Cgate integrates with MH # @@ -153,7 +159,7 @@ ############################################################################## ############################################################################## ########### ############## -########### Globals, Startup, Menus, Voice COmmands ############## +########### Globals, Startup, Menus, Voice Commands ############## ########### ############## ############################################################################## ############################################################################## @@ -261,9 +267,9 @@ sub cbus_configure { if ($data eq 'Run') { load_def_file(); if (not defined $cbus_def) { - # Their was no cbus def file to load. + # There was no cbus def file to load. # Help out a new user, by auto-building the def file. - # Otherwise, their will be nothing to build. + # Otherwise, there will be nothing to build. print_log "CBus: Builder is initiating scan of CGate"; scan_cgate(); } @@ -315,11 +321,11 @@ sub load_def_file { $cbus_def_filename = $config_parms{code_dir} . "/" . $config_parms{cbus_dat_file}; if (not -e $cbus_def_filename) { - print_log "CBus: Definition file $cbus_def_filename does not exist"; + print_log "CBus: [load_def_file] XML definition file $cbus_def_filename does not exist"; return; } - print_log "CBus: Builder - Loading CBus config from file ". + print_log "CBus: Builder - Loading CBus config from XML file ". $cbus_def_filename; $cbus_def = XMLin($cbus_def_filename, ForceArray => ['mh_group', 'note'], @@ -330,7 +336,7 @@ sub load_def_file { delete $cbus_def->{'Creation_Date'}; delete $cbus_def->{'Version'}; - # print_log Dumper($cbus_def); + #print_log Dumper($cbus_def); } @@ -355,7 +361,7 @@ sub load_def_file { sub scan_cgate { # Initiate scan of CGate data # The scan is controlled by code in the Talker mh main loop code - print_log "CBus: Scanning CGate..."; + print_log "CBus: [scan_cgate] Scanning CGate..."; # Cleanup from any previous scan and initialise flags/counters @cbus_net_list = [ ]; @@ -423,12 +429,16 @@ sub write_def_file { ); # Write the file to disk + print_log "CBus: [write_def_file] Writing XML definition to $cbus_def_filename,"; $xml_file->XMLout($cbus_def, OutputFile => $cbus_def_filename, ); } -#sub dump_cbus_data { +sub dump_cbus_data { + + print_log "CBus: Device list function disabled"; + # # Basic diagnostic routine for dumping the cbus objects hash # my $count = 0; # my $msg = "

CBUS Device Listing

"; @@ -448,7 +458,7 @@ sub write_def_file { # # $msg .= "

List CBus Devices: Listed $count CBus devices

"; # display $msg; -#} +} # @@ -1058,6 +1068,8 @@ sub attempt_level_sync { $msg_code = $2; } +###### Message code 320: Tree information. Returned from the tree command. + if ($msg_code == 320) { if (not $cbus_got_tree_list) { if (not $cbus_units_config) { @@ -1073,6 +1085,7 @@ sub attempt_level_sync { } else { # CGate is listing CBus "groups" if ($cbus_data =~ /end/) { + print_log "CBus: end of CBus scan data, got tree list"; $cbus_got_tree_list = 1; } elsif ($cbus_data =~ /(\/\/.+\/\d+\/\d+\/\d+).+level=(\d+)/) { print_log "CBus: scanned group=$1 at level $2"; @@ -1082,17 +1095,24 @@ sub attempt_level_sync { } } +###### Message code 342: DBGet response (not documented in CGate Server Guide 1.0.) + } elsif ($msg_code == 342) { - if ($cbus_scanning_cgate) { - if ($cbus_data =~ /(\/\/.+\/\d+\/[a-z\d]+\/\d+)\/TagName=(.+)/) { + if ($cbus_scanning_cgate) { + + print_log "CBus: Message 342 response data: $cbus_data"; + + if ($cbus_data =~ /\d+\s+(\d+\/[a-z\d]+\/\d+)\/TagName=(.+)/) { my ($addr, $name) = ($1, $2); + $addr = "//$cbus_project_name/$addr"; + print_log "CBus: Address $addr, name $name"; $cbus_scan_last_addr_seen = $addr; # $name =~ s/ /_/g; Change spaces, depends on user usage... my $addr_type; if ($addr =~ /\/p\/(\d+)/) { # Data is for a CBus device eg. switch, relay, dimmer - $addr_type = 'unit'; + $addr_type = 'unit'; $addr = $1; } else { # Data is for a CBus "group" @@ -1124,9 +1144,12 @@ sub attempt_level_sync { }; } } + print_log "Cbus: end message"; } - } - + } + +###### Message code 300: Object information, for example: 300 1/56/1: level=200 + } elsif ($msg_code == 300) { if ($cbus_data =~ /(sessionID=.+)/) { @@ -1181,9 +1204,13 @@ sub attempt_level_sync { print_log "CBus: UNEXPECTED 300 msg \"$cbus_data\""; } +###### Message code 200: Completed successfully + } elsif ($msg_code == 200) { print_log "CBus: Cmd OK - $cbus_data" if $Debug{cbus}; +###### Message code 201: Service ready + } elsif ($msg_code == 201) { print_log "CBus: Comms established - $cbus_data"; @@ -1204,9 +1231,14 @@ sub attempt_level_sync { eval_with_timer $cmd, 2; } +###### Message code 401: Bad object or device ID + } elsif ($msg_code == 401) { print_log "CBus: $cbus_data"; +###### Message code 408: Indicates that a SET, GET or other method +###### failed for a given object + } elsif ($msg_code == 408) { print_log "CBus: **** Failed Cmd - $cbus_data"; if ($msg_id =~ /\[MisterHouse(\d+)\]/) { @@ -1221,6 +1253,8 @@ sub attempt_level_sync { } } +###### Message code unhandled + } else { print_log "CBus: Cmd port - UNHANDLED: $cbus_data"; } @@ -1251,6 +1285,7 @@ sub attempt_level_sync { } else { # All networks scanned - set completion flag ### FIXME - RichardM test with two networks?? + print_log "Cbus: leaving scanning mode"; $cbus_scanning_cgate = 0; print_log "CBus: CBus server scan complete"; write_def_file(); @@ -1259,17 +1294,19 @@ sub attempt_level_sync { } elsif ($cbus_got_tree_list) { if ($cbus_group_idx < @cbus_group_list) { my $group = $cbus_group_list[$cbus_group_idx++]; + print_log "Cbus: dbget group $group"; set $cbus_talker "dbget $group/TagName"; } elsif ($cbus_unit_idx < @cbus_unit_list) { my $unit = $cbus_unit_list[$cbus_unit_idx++]; + print_log "Cbus: dbget unit $unit"; set $cbus_talker "dbget $unit/TagName"; - } else { - if ($cbus_scan_last_addr_seen eq - $cbus_unit_list[$#cbus_unit_list]) { + } else { + if ($cbus_scan_last_addr_seen eq $cbus_unit_list[$#cbus_unit_list]) { # Tree Scan complete - set tree completion flag - $cbus_scanning_tree = 0; + print_log "Cbus: leaving scanning mode"; + $cbus_scanning_tree = 0; } } From d80455fac03fa47708b6e51c340f03079777e406 Mon Sep 17 00:00:00 2001 From: Jon Whitear Date: Mon, 25 Nov 2013 12:45:07 +1100 Subject: [PATCH 083/180] Cbus update to support new and old message response formats --- code/public/cbus.pl | 112 +++++++++++++++++++++++++++----------------- 1 file changed, 68 insertions(+), 44 deletions(-) diff --git a/code/public/cbus.pl b/code/public/cbus.pl index b6a38ced0..984b96680 100755 --- a/code/public/cbus.pl +++ b/code/public/cbus.pl @@ -85,11 +85,15 @@ # Monitor and Talker attempt to always run unless in DEBUG state. # # V3.0.1 2013-11-22 -# Fixed to work with C-Gate Version: v2.9.7 (build 2569), which returns -# cbus addresses in the form NETWORK/APPLICATION/GROUP rather than -# //PROJECT/NETWORK/APPLICATION/GROUP. -# Add logging to aid debugging cbus_builder -# Contributed by Jon Whitear +# Fixed to work with C-Gate Version: v2.9.7 (build 2569), which returns +# cbus addresses in the form NETWORK/APPLICATION/GROUP rather than +# //PROJECT/NETWORK/APPLICATION/GROUP. +# Add logging to aid debugging cbus_builder +# Contributed by Jon Whitear +# +# V3.0.2 2013-11-25 +# Add support for both formats of return code, i.e. NETWORK/APPLICATION/GROUP +# and //PROJECT/NETWORK/APPLICATION/GROUP. # # How Cgate integrates with MH # @@ -1054,6 +1058,51 @@ sub attempt_level_sync { } } +# +# Add an address or group to the hash +# + +sub add_address_to_hash { + my ($addr, $name) = @_; + my $addr_type; + + if ($addr =~ /\/p\/(\d+)/) { + # Data is for a CBus device eg. switch, relay, dimmer + $addr_type = 'unit'; + $addr = $1; + } else { + # Data is for a CBus "group" + $addr_type = 'group'; + } + + print_log "CBus: Addr $addr is $name of type $addr_type"; + + # Store the CBus name and address in the cbus_def hash + if ($addr_type eq 'group') { + if (not exists $cbus_def->{group}{$addr}) { + print_log "CBus: group not defined yet, ". + "adding $addr, $name"; + $cbus_def->{group}{$addr} = { + name => $name, + note =>["Added by MisterHouse $Date_Now $Time_Now"], + type => 'dimmer', + mh_group => ['CBus'] + }; + # print_log Dumper($cbus_def); + } + } elsif ($addr_type eq 'unit') { + if (not exists $cbus_def->{unit}{$addr}) { + print_log "CBus: unit not defined yet, ". + "adding $addr, $name"; + $cbus_def->{unit}{$addr} = { + name => $name, + note => ["Added by MisterHouse $Date_Now $Time_Now"] + }; + } + } + +} + # # Main MH Loop Code for ***** TALKER ***** # @@ -1103,50 +1152,25 @@ sub attempt_level_sync { print_log "CBus: Message 342 response data: $cbus_data"; if ($cbus_data =~ /\d+\s+(\d+\/[a-z\d]+\/\d+)\/TagName=(.+)/) { + #response matched against "new" format, i.e. network/app/group my ($addr, $name) = ($1, $2); $addr = "//$cbus_project_name/$addr"; - print_log "CBus: Address $addr, name $name"; + $cbus_scan_last_addr_seen = $addr; # $name =~ s/ /_/g; Change spaces, depends on user usage... - - my $addr_type; - if ($addr =~ /\/p\/(\d+)/) { - # Data is for a CBus device eg. switch, relay, dimmer - $addr_type = 'unit'; - $addr = $1; - } else { - # Data is for a CBus "group" - $addr_type = 'group'; - } - - print_log "CBus: Addr $addr is $name of type $addr_type"; - - # Store the CBus name and address in the cbus_def hash - if ($addr_type eq 'group') { - if (not exists $cbus_def->{group}{$addr}) { - print_log "CBus: group not defined yet, ". - "adding $addr, $name"; - $cbus_def->{group}{$addr} = { - name => $name, - note =>["Added by MisterHouse $Date_Now $Time_Now"], - type => 'dimmer', - mh_group => ['CBus'] - }; - # print_log Dumper($cbus_def); - } - } elsif ($addr_type eq 'unit') { - if (not exists $cbus_def->{unit}{$addr}) { - print_log "CBus: unit not defined yet, ". - "adding $addr, $name"; - $cbus_def->{unit}{$addr} = { - name => $name, - note => ["Added by MisterHouse $Date_Now $Time_Now"] - }; - } - } - print_log "Cbus: end message"; + add_address_to_hash($addr, $name); + + } elsif ($cbus_data =~ /(\/\/.+\/\d+\/[a-z\d]+\/\d+)\/TagName=(.+)/) { + #response matched against "old" format, i.e. //project/network/app/group + my ($addr, $name) = ($1, $2); + + $cbus_scan_last_addr_seen = $addr; + # $name =~ s/ /_/g; Change spaces, depends on user usage... + add_address_to_hash($addr, $name); + } - } + print_log "Cbus: end message"; + } ###### Message code 300: Object information, for example: 300 1/56/1: level=200 From d0550104fc5140c6c2b3f147b21877c0eb6c1605 Mon Sep 17 00:00:00 2001 From: Jon Whitear Date: Thu, 28 Nov 2013 11:08:18 +1100 Subject: [PATCH 084/180] Cbus update to add debug flag test to logging statements, i.e. reduce logging --- code/public/cbus.pl | 54 ++++++++++++++++++++++++++------------------- 1 file changed, 31 insertions(+), 23 deletions(-) diff --git a/code/public/cbus.pl b/code/public/cbus.pl index 984b96680..d3948ec54 100755 --- a/code/public/cbus.pl +++ b/code/public/cbus.pl @@ -91,10 +91,13 @@ # Add logging to aid debugging cbus_builder # Contributed by Jon Whitear # -# V3.0.2 2013-11-25 +# V3.0.2 2013-11-25 # Add support for both formats of return code, i.e. NETWORK/APPLICATION/GROUP # and //PROJECT/NETWORK/APPLICATION/GROUP. # +# V3.0.3 2013-11-28 +# Test debug flag for logging statements. +# # How Cgate integrates with MH # # All Cbus objects are defined in a standard XML file (cbus.xml), this file is @@ -247,6 +250,9 @@ sub cbus_configure { $cbus_system_debug = 1; print_log "CBus: DEBUG mode - No CGate communications started"; } + + print_log "CBus: MisterHouse CBus debug mode - additional logging enabled" if $Debug{cbus}; + } @@ -325,11 +331,11 @@ sub load_def_file { $cbus_def_filename = $config_parms{code_dir} . "/" . $config_parms{cbus_dat_file}; if (not -e $cbus_def_filename) { - print_log "CBus: [load_def_file] XML definition file $cbus_def_filename does not exist"; + print_log "CBus: load_def_file() XML definition file $cbus_def_filename does not exist"; return; } - print_log "CBus: Builder - Loading CBus config from XML file ". + print_log "CBus: load_def_file () Loading CBus config from XML file ". $cbus_def_filename; $cbus_def = XMLin($cbus_def_filename, ForceArray => ['mh_group', 'note'], @@ -365,7 +371,7 @@ sub load_def_file { sub scan_cgate { # Initiate scan of CGate data # The scan is controlled by code in the Talker mh main loop code - print_log "CBus: [scan_cgate] Scanning CGate..."; + print_log "CBus: scan_cgate() Scanning CGate..."; # Cleanup from any previous scan and initialise flags/counters @cbus_net_list = [ ]; @@ -380,7 +386,7 @@ sub scan_cgate { if (defined $cbus_project_name) { set $cbus_talker "project load " . $cbus_project_name; set $cbus_talker "project use " . $cbus_project_name; - print_log "CBus: Command - project start " . $cbus_project_name; + print_log "CBus: scan_cgate() Command - project start " . $cbus_project_name; set $cbus_talker "project start " . $cbus_project_name; } @@ -433,7 +439,7 @@ sub write_def_file { ); # Write the file to disk - print_log "CBus: [write_def_file] Writing XML definition to $cbus_def_filename,"; + print_log "CBus: write_def_file() Writing XML definition to $cbus_def_filename,"; $xml_file->XMLout($cbus_def, OutputFile => $cbus_def_filename, ); @@ -486,20 +492,20 @@ sub build_cbus_file { # Setup output filename if ($cbus_build_debug) { - print_log "CBus: Builder - Start CBus build in TEST mode"; + print_log "CBus: build_cbus_file() Start CBus build in TEST mode"; $cbus_file = $config_parms{code_dir} . "/cbus_procedures.pl.test"; } else { - print_log "CBus: Builder - Starting build"; + print_log "CBus: build_cbus_file() Starting build"; $cbus_file = $config_parms{code_dir} . "/cbus_procedures.pl"; } rename ($cbus_file, $cbus_file . '.old') - or print_log "CBus: Builder - Could not backup $cbus_file: $!"; + or print_log "CBus: build_cbus_file() Could not backup $cbus_file: $!"; - print_log "CBus: Builder - Saving CBus configs to $cbus_file"; + print_log "CBus: build_cbus_file() Saving CBus configs to $cbus_file"; open (CF, ">$cbus_file") - or print_log "CBus: Builder - Could not open $cbus_file: $!"; + or print_log "CBus: build_cbus_file() Could not open $cbus_file: $!"; print CF "# Category=CBus_Items\n#\n#\n"; print CF "# Created: $Time_Now, from cbus.xml file: \"$config_parms{cbus_dat_file}\"\n"; @@ -677,9 +683,9 @@ sub build_cbus_file { print CF "#\n#\n# EOF\n#\n#\n"; close (CF) - or print_log "Could not close $cbus_file: $!"; + or print_log "CBbus: build_cbus_file() Could not close $cbus_file: $!"; - print_log "CBus: Builder - Completed CBus build to $cbus_file"; + print_log "CBUs: build_cbus_file() Completed CBus build to $cbus_file"; } @@ -705,6 +711,7 @@ sub build_cbus_file { # Currently set to 5 seconds if ($New_Minute or ($New_Second and $cbus_monitor_retry++ > $CBUS_RETRY_SECS) ) { $cbus_monitor_retry = 0; + print_log "CBus: Restarting CBus Monitor" if $Debug{cbus}; cbus_monitor_start(); } } @@ -908,6 +915,7 @@ sub cbus_monitor_status { # Currently set to 5 seconds if ($New_Minute or ($New_Second and $cbus_talker_retry++ > $CBUS_RETRY_SECS)) { $cbus_talker_retry = 0; + print_log "CBus: Restarting CBus Talker" if $Debug{cbus}; cbus_talker_start(); } } @@ -1075,12 +1083,12 @@ sub add_address_to_hash { $addr_type = 'group'; } - print_log "CBus: Addr $addr is $name of type $addr_type"; + print_log "CBus: add_address_to_hash() Addr $addr is $name of type $addr_type"; # Store the CBus name and address in the cbus_def hash if ($addr_type eq 'group') { if (not exists $cbus_def->{group}{$addr}) { - print_log "CBus: group not defined yet, ". + print_log "CBus: add_address_to_hash() group not defined yet, ". "adding $addr, $name"; $cbus_def->{group}{$addr} = { name => $name, @@ -1092,7 +1100,7 @@ sub add_address_to_hash { } } elsif ($addr_type eq 'unit') { if (not exists $cbus_def->{unit}{$addr}) { - print_log "CBus: unit not defined yet, ". + print_log "CBus: add_address_to_hash() unit not defined yet, ". "adding $addr, $name"; $cbus_def->{unit}{$addr} = { name => $name, @@ -1134,7 +1142,7 @@ sub add_address_to_hash { } else { # CGate is listing CBus "groups" if ($cbus_data =~ /end/) { - print_log "CBus: end of CBus scan data, got tree list"; + print_log "CBus: end of CBus scan data, got tree list" if $Debug{cbus}; $cbus_got_tree_list = 1; } elsif ($cbus_data =~ /(\/\/.+\/\d+\/\d+\/\d+).+level=(\d+)/) { print_log "CBus: scanned group=$1 at level $2"; @@ -1149,7 +1157,7 @@ sub add_address_to_hash { } elsif ($msg_code == 342) { if ($cbus_scanning_cgate) { - print_log "CBus: Message 342 response data: $cbus_data"; + print_log "CBus: Message 342 response data: $cbus_data" if $Debug{cbus}; if ($cbus_data =~ /\d+\s+(\d+\/[a-z\d]+\/\d+)\/TagName=(.+)/) { #response matched against "new" format, i.e. network/app/group @@ -1169,7 +1177,7 @@ sub add_address_to_hash { add_address_to_hash($addr, $name); } - print_log "Cbus: end message"; + print_log "Cbus: end message" if $Debug{cbus}; } ###### Message code 300: Object information, for example: 300 1/56/1: level=200 @@ -1309,7 +1317,7 @@ sub add_address_to_hash { } else { # All networks scanned - set completion flag ### FIXME - RichardM test with two networks?? - print_log "Cbus: leaving scanning mode"; + print_log "Cbus: leaving scanning mode" if $Debug{cbus}; $cbus_scanning_cgate = 0; print_log "CBus: CBus server scan complete"; write_def_file(); @@ -1318,18 +1326,18 @@ sub add_address_to_hash { } elsif ($cbus_got_tree_list) { if ($cbus_group_idx < @cbus_group_list) { my $group = $cbus_group_list[$cbus_group_idx++]; - print_log "Cbus: dbget group $group"; + print_log "Cbus: dbget group $group" if $Debug{cbus}; set $cbus_talker "dbget $group/TagName"; } elsif ($cbus_unit_idx < @cbus_unit_list) { my $unit = $cbus_unit_list[$cbus_unit_idx++]; - print_log "Cbus: dbget unit $unit"; + print_log "Cbus: dbget unit $unit" if $Debug{cbus}; set $cbus_talker "dbget $unit/TagName"; } else { if ($cbus_scan_last_addr_seen eq $cbus_unit_list[$#cbus_unit_list]) { # Tree Scan complete - set tree completion flag - print_log "Cbus: leaving scanning mode"; + print_log "Cbus: leaving scanning mode" if $Debug{cbus}; $cbus_scanning_tree = 0; } } From 5061a690762332940b6955bce3a522fcf1dae335 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 27 Mar 2014 20:34:48 -0700 Subject: [PATCH 085/180] Insteon_MicroSwitch: Add Complete Support for Insteon MicroSwitch See the POD documentation for complete details, voice commands were added for all new commands. --- lib/Insteon/Lighting.pm | 337 ++++++++++++++++++++++++++++++++++++++++ lib/read_table_A.pl | 12 ++ 2 files changed, 349 insertions(+) diff --git a/lib/Insteon/Lighting.pm b/lib/Insteon/Lighting.pm index d1a18c5d6..9cbb76b39 100644 --- a/lib/Insteon/Lighting.pm +++ b/lib/Insteon/Lighting.pm @@ -1207,6 +1207,343 @@ This program is distributed in the hope that it will be useful, but WITHOUT ANY You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. +=head1 B + +=head2 SYNOPSIS + +User code: + + use Insteon::MicroSwitchRelay; + $light_device = new Insteon::MicroSwitchRelay('12.34.56',$myPLM); + +In mht file: + + INSTEON_MICROSWITCHRELAY, 12.34.56, light_device, All_Lights + +=head2 DESCRIPTION + +Provides support for the Insteon Micro On/Off Module. + +=head2 INHERITS + +L, +L + +=head2 METHODS + +=over + +=cut + +package Insteon::MicroSwitchRelay; + +use strict; +use Insteon::BaseInsteon; + +@Insteon::MicroSwitchRelay::ISA = ('Insteon::BaseLight','Insteon::DeviceController'); + +=item C + +Instantiates a new object. + +=cut + +sub new +{ + my ($class,$p_deviceid,$p_interface) = @_; + my $self = new Insteon::DimmableLight($p_deviceid,$p_interface); + $$self{operating_flags} = \%Insteon::MicroSwitchRelay::operating_flags; + bless $self,$class; + return $self; +} + +our %operating_flags = ( + 'momentary' => '21', + 'dual' => '1f', + 'latching' => '20', + 'single' => '1e', + '3-way' => '22', + '1-way' => '23', + 'blink_traffic' => '02', + 'no_blink_traffic' => '03', + 'no_blink_error' => '14', + 'blink_error' => '15', + 'beep_button' => '0a', + 'no_beep_button' => '0b', + 'p_lock' => '00', + 'p_unlock' => '01' +); + +=item C + +Can be used to set the mode of the device. Options are: + +Latching, Single_Momentary, Dual_Momentary + +=cut + +sub set_mode +{ + my ($self, $mode) = @_; + return unless defined $mode; + my $name = $self->get_object_name; + + ::print_log("[Insteon::MicroSwitch] Setting mode of $name to $mode."); + + if ($mode =~ /momentary/i) { + $self->set_operating_flag('momentary'); + } + else { + $self->set_operating_flag('latching'); + } + if ($mode =~ /dual/i) { + $self->set_operating_flag('dual'); + } + else { + $self->set_operating_flag('single'); + } +} + +=item C + +Only has an effect in latching mode. If set to true enables three way. + +=cut + +sub enable_3_way +{ + my ($self, $is_true) = @_; + return unless defined $is_true; + my $name = $self->get_object_name; + + if ($is_true) { + ::print_log("[Insteon::MicroSwitch] Setting $name to 3-way."); + $self->set_operating_flag('3-way'); + } + else { + ::print_log("[Insteon::MicroSwitch] Setting $name to 1-way."); + $self->set_operating_flag('1-way'); + } +} + +=item C + +If boolean is true, LED will blink on traffic. + +=cut + +sub enable_blink_traffic +{ + my ($self, $is_true) = @_; + return unless defined $is_true; + my $name = $self->get_object_name; + + if ($is_true) { + ::print_log("[Insteon::MicroSwitch] Setting LED on $name to". + " blink on traffic."); + $self->set_operating_flag('blink_traffic'); + } + else { + ::print_log("[Insteon::MicroSwitch] Setting LED on $name to". + " not blink on traffic."); + $self->set_operating_flag('no_blink_traffic'); + } +} + +=item C + +If boolean is true, LED will blink on error. + +=cut + +sub enable_blink_error +{ + my ($self, $is_true) = @_; + return unless defined $is_true; + my $name = $self->get_object_name; + + if ($is_true) { + ::print_log("[Insteon::MicroSwitch] Setting LED on $name to". + " blink on error."); + $self->set_operating_flag('blink_error'); + } + else { + ::print_log("[Insteon::MicroSwitch] Setting LED on $name to". + " not blink on error."); + $self->set_operating_flag('no_blink_error'); + } +} + +=item C + +If boolean is true, a beep will sound when button is pressed. + +=cut + +sub enable_beep_button +{ + my ($self, $is_true) = @_; + return unless defined $is_true; + my $name = $self->get_object_name; + + if ($is_true) { + ::print_log("[Insteon::MicroSwitch] Setting $name to". + " beep on button press."); + $self->set_operating_flag('beep_button'); + } + else { + ::print_log("[Insteon::MicroSwitch] Setting $name to". + " not beep on button press."); + $self->set_operating_flag('no_beep_button'); + } +} + +=item C + +Sets the LED to brightness percentage. + +=cut + +sub led_level +{ + my ($self, $level) = @_; + return unless defined $level; + my $name = $self->get_object_name; + + ::print_log("[Insteon::MicroSwitch] Setting LED level of $name to". + " $level."); + + #For whatever reason 100% = 127 and 50% = 64 + $level = $level * 1.28; + $level = 127 if $level > 127; + $level = 0 if $level < 0; + + my $extra = '000107' . sprintf('%02X', $level); + $extra .= '0' x (30 - length $extra); + my $message = new Insteon::InsteonMessage('insteon_ext_send', $self, 'extended_set_get', $extra); + $self->_send_cmd($message); +} + +=item C + +Returns a hash of voice commands where the key is the voice command name and the +value is the perl code to run when the voice command name is called. + +Higher classes which inherit this object may add to this list of voice commands by +redefining this routine while inheriting this routine using the SUPER function. + +This routine is called by L to generate the +necessary voice commands. + +=cut + +sub get_voice_cmds +{ + my ($self) = @_; + my $object_name = $self->get_object_name; + my %voice_cmds = ( + %{$self->SUPER::get_voice_cmds} + ); + if ($self->is_root){ + %voice_cmds = ( + %voice_cmds, + 'set latching mode' => "$object_name->set_mode(\"latching\")", + 'set single momentary mode' => "$object_name->set_mode(\"single_momentary\")", + 'set dual momentary mode' => "$object_name->set_mode(\"dual_momentary\")", + 'set to 3-way' => "$object_name->enable_3_way(1)", + 'set to 1-way' => "$object_name->enable_3_way(0)", + 'set LED to blink on traffic' => "$object_name->enable_blink_traffic(1)", + 'set LED to not blink on traffic' => "$object_name->enable_blink_traffic(0)", + 'set LED to blink on error' => "$object_name->enable_blink_error(1)", + 'set LED to not blink on error' => "$object_name->enable_blink_error(0)", + 'set device to beep on button press' => "$object_name->enable_beep_button(1)", + 'set device to not beep on button press' => "$object_name->enable_beep_button(0)", + 'set LED to 100%' => "$object_name->led_level(100)", + 'set LED to 50%' => "$object_name->led_level(50)", + 'set LED to 0%' => "$object_name->led_level(\"0\")", + ); + } + return \%voice_cmds; +} + +=back + +=head2 AUTHOR + +Kevin Robert Keegan + +=head2 LICENSE + +This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. + +This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + +=head1 B + +=head2 SYNOPSIS + +User code: + + use Insteon::MicroSwitch; + $light_device = new Insteon::MicroSwitch('12.34.56',$myPLM); + +In mht file: + + INSTEON_MICROSWITCH, 12.34.56, light_device, All_Lights + +=head2 DESCRIPTION + +Provides support for the Insteon Micro Dimmer Module. + +=head2 INHERITS + +L, +L + +=head2 METHODS + +=over + +=cut + +package Insteon::MicroSwitch; + +use strict; +use Insteon::BaseInsteon; + +@Insteon::MicroSwitch::ISA = ('Insteon::MicroSwitchRelay', 'Insteon::DimmableLight','Insteon::DeviceController'); + +=item C + +Instantiates a new object. + +=cut + +sub new +{ + my ($class,$p_deviceid,$p_interface) = @_; + my $self = new Insteon::DimmableLight($p_deviceid,$p_interface); + $$self{operating_flags} = \%Insteon::MicroSwitchRelay::operating_flags; + bless $self,$class; + return $self; +} + +=back + +=head2 AUTHOR + +Kevin Robert Keegan + +=head2 LICENSE + +This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. + +This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + =cut =head1 B diff --git a/lib/read_table_A.pl b/lib/read_table_A.pl index c21506318..edd141258 100644 --- a/lib/read_table_A.pl +++ b/lib/read_table_A.pl @@ -194,6 +194,18 @@ sub read_table_A { $other = join ', ', (map {"'$_'"} @other); # Quote data $object = "Insteon::iMeter(\'$address\', $other)"; } + elsif($type eq "INSTEON_MICROSWITCH") { + require Insteon::Lighting; + ($address, $name, $grouplist, @other) = @item_info; + $other = join ', ', (map {"'$_'"} @other); # Quote data + $object = "Insteon::MicroSwitch(\'$address\', $other)"; + } + elsif($type eq "INSTEON_MICROSWITCHRELAY") { + require Insteon::Lighting; + ($address, $name, $grouplist, @other) = @item_info; + $other = join ', ', (map {"'$_'"} @other); # Quote data + $object = "Insteon::MicroSwitchRelay(\'$address\', $other)"; + } # ---------------------------------------------------------------------- elsif($type eq 'FROG') { require 'FroggyRita.pm'; From 89bea206bed81a68aa85fb452201cd6b2c7c0b0f Mon Sep 17 00:00:00 2001 From: rudybrian Date: Fri, 28 Mar 2014 00:34:50 -0700 Subject: [PATCH 086/180] Added initial support for using a remote NCID server for caller ID --- lib/Telephony_Interface.pm | 63 +++++++++++++++++++++++++++----------- 1 file changed, 45 insertions(+), 18 deletions(-) diff --git a/lib/Telephony_Interface.pm b/lib/Telephony_Interface.pm index 2e56fab25..0c581acb8 100644 --- a/lib/Telephony_Interface.pm +++ b/lib/Telephony_Interface.pm @@ -5,7 +5,7 @@ use Telephony_Item; package Telephony_Interface; @Telephony_Interface::ISA = ('Telephony_Item'); -my ($hooks_added, @list_ports, %list_objects, %type_by_port, %caller_id_data); +my ($hooks_added, @list_ports, %list_objects, %type_by_port, %caller_id_data, $cid_server_connect); # US Robotics 56k Voice model 0525 -> rockewell @@ -16,7 +16,8 @@ my %table = (default => ['ATE1V1X4&C1&D2S0=0+VCID=1', 38400, 'dtr'] supra => ['ats0=0#cid=1', 38400, 'dtr'], cirruslogic => ['ats0=0+vcid=1', 38400, 'dtr'], zyxel => ['ATE1V1S40.2=1S41.6=1S42.2=1&L1M3N1', 38400, 'dtr'], - netcallerid => ['', 4800, '']); + netcallerid => ['', 4800, ''], + ncid => ['', 0, '']); sub new { my ($class, $name, $port, $type)= @_; @@ -56,21 +57,33 @@ sub open_port { my $name = $$self{name}; my $type = lc $$self{type}; my $port = $$self{port}; - return if $main::Serial_Ports{$name}; # Already open - push @list_ports, $name; - $type_by_port{$name} = $type; - my $baudrate = 38400; - my $handshake = 'dtr'; - if ($table{$type}) { - $baudrate = $table{$type}[1]; - $handshake = $table{$type}[2]; + if ($port =~ /.*:\d*/) { + # This is a hostname/IP:port, so open a Socket_Item instead + return if $main::Socket_Ports{$name}; # Already open + print "Telephony_Interface port open: n=$name t=$type p=$port\n" + if $main::Debug{phone}; + $cid_server_connect = new Socket_Item( undef, undef, $port, $name, 'tcp', 'record'); + start $cid_server_connect; + $type_by_port{$name} = $type; + push @list_ports, $name; } - print "Telephony_Interface port open: n=$name t=$type p=$port b=$baudrate h=$handshake\n" - if $main::Debug{phone}; - if ($port) { - &::serial_port_create($name, $port, $baudrate, $handshake); - push(@::Generic_Serial_Ports, $name); - &init unless $port =~ /proxy/; + else { + return if $main::Serial_Ports{$name}; # Already open + push @list_ports, $name; + $type_by_port{$name} = $type; + my $baudrate = 38400; + my $handshake = 'dtr'; + if ($table{$type}) { + $baudrate = $table{$type}[1]; + $handshake = $table{$type}[2]; + } + print "Telephony_Interface port open: n=$name t=$type p=$port b=$baudrate h=$handshake\n" + if $main::Debug{phone}; + if ($port) { + &::serial_port_create($name, $port, $baudrate, $handshake); + push(@::Generic_Serial_Ports, $name); + &init unless $port =~ /proxy/; + } } } @@ -90,7 +103,17 @@ sub reload_reset { sub check_for_data { for my $port (@list_ports) { - if (my $data = $main::Serial_Ports{$port}{data_record}) { + if ($cid_server_connect && (my $data = said $cid_server_connect)) { + print "Phone data: $data.\n" if $main::Debug{phone}; + if ($data =~ /^CID:/) { + &::print_log("Callerid: $data"); + &process_cid_data($port, $data); + } + else { + &process_phone_data($port, 'ring') if $data =~ /ring/i; + } + } + elsif (my $data = $main::Serial_Ports{$port}{data_record}) { $main::Serial_Ports{$port}{data_record} = undef; # Ignore garbage data (ascii is between ! thru ~) $data = '' if $data !~ /^[\n\r\t !-~]+$/; @@ -151,10 +174,14 @@ sub process_cid_data { ($name) = $data =~ /NAME(.*?)\++$/ unless $date; ($number) = $data =~ /NMBR(.+)\.{3}/ unless $name; } +# Old NCID format # NCID data=CID:*DATE*10202003*TIME*0019*NMBR*2125551212*MESG*NONE*NAME*INFORMATION* +# New NCID format +# NCID data=CID: *DATE*03272014*TIME*1734*LINE*1234*NMBR*2125551212*MESG*NONE*NAME*OUT-OF-AREA* # http://ncid.sourceforge.net/ elsif ($type eq 'ncid') { - ($date, $time, $number, $name) = $data =~/CID:\*DATE\*(\d{8})\*TIME\*(\d{4})\*NMBR\*(\d{10})\*MESG\*.*\*NAME\*([^\*]+)\*$/; + ($date, $time, $number, $name) = $data =~/CID:\s\*DATE\*(\d{8})\*TIME\*(\d{4})\*LINE\*[^\*]+\*NMBR\*(\d*)\*MESG\*.*\*NAME\*([^\*]+)\*$/; + print "Phone NCID: date='$date', time='$time', number='$number', name='$name'.\n" if $main::Debug{phone}; } elsif ($type eq 'zyxel'or $type eq 'motorola') { ($date) = $data =~ /TIME: *(\S+)\s\S+/s; From 0d8da01e5eb27e86fc58748c106306dc4230abe9 Mon Sep 17 00:00:00 2001 From: rudybrian Date: Fri, 28 Mar 2014 14:27:42 -0700 Subject: [PATCH 087/180] Some logging cleanup for #393 --- lib/Telephony_Interface.pm | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/lib/Telephony_Interface.pm b/lib/Telephony_Interface.pm index 0c581acb8..3306e0f0a 100644 --- a/lib/Telephony_Interface.pm +++ b/lib/Telephony_Interface.pm @@ -60,7 +60,7 @@ sub open_port { if ($port =~ /.*:\d*/) { # This is a hostname/IP:port, so open a Socket_Item instead return if $main::Socket_Ports{$name}; # Already open - print "Telephony_Interface port open: n=$name t=$type p=$port\n" + &::print_log("Telephony_Interface port open: n=$name t=$type p=$port") if $main::Debug{phone}; $cid_server_connect = new Socket_Item( undef, undef, $port, $name, 'tcp', 'record'); start $cid_server_connect; @@ -77,7 +77,7 @@ sub open_port { $baudrate = $table{$type}[1]; $handshake = $table{$type}[2]; } - print "Telephony_Interface port open: n=$name t=$type p=$port b=$baudrate h=$handshake\n" + &::print_log("Telephony_Interface port open: n=$name t=$type p=$port b=$baudrate h=$handshake") if $main::Debug{phone}; if ($port) { &::serial_port_create($name, $port, $baudrate, $handshake); @@ -104,7 +104,7 @@ sub reload_reset { sub check_for_data { for my $port (@list_ports) { if ($cid_server_connect && (my $data = said $cid_server_connect)) { - print "Phone data: $data.\n" if $main::Debug{phone}; + &::print_log("Phone data: $data.") if $main::Debug{phone}; if ($data =~ /^CID:/) { &::print_log("Callerid: $data"); &process_cid_data($port, $data); @@ -118,7 +118,7 @@ sub check_for_data { # Ignore garbage data (ascii is between ! thru ~) $data = '' if $data !~ /^[\n\r\t !-~]+$/; $caller_id_data{$port} .= ' ' . $data; - print "Phone data: $data.\n" if $main::Debug{phone}; + &::print_log("Phone data: $data.") if $main::Debug{phone}; if (($caller_id_data{$port} =~ /NAME.+NU?MBE?R/s) or ($caller_id_data{$port} =~ /NU?MBE?R.+NAME/s) or ($caller_id_data{$port} =~ /NU?MBE?R.+MESG/s) or @@ -141,7 +141,7 @@ sub process_phone_data { my ($port, $data) = @_; # Set all objects monitoring this port for my $object(@{$list_objects{$port}}) { - print "Setting Telephony_Interface object $$object{name} to $data.\n"; + &::print_log("Setting Telephony_Interface object $$object{name} to $data."); $object->SUPER::set('ring') if $data eq 'ring'; $object->ring_count($object->ring_count()+1); # Where/when does this get reset?? } @@ -181,7 +181,7 @@ sub process_cid_data { # http://ncid.sourceforge.net/ elsif ($type eq 'ncid') { ($date, $time, $number, $name) = $data =~/CID:\s\*DATE\*(\d{8})\*TIME\*(\d{4})\*LINE\*[^\*]+\*NMBR\*(\d*)\*MESG\*.*\*NAME\*([^\*]+)\*$/; - print "Phone NCID: date='$date', time='$time', number='$number', name='$name'.\n" if $main::Debug{phone}; + &::print_log("Phone NCID: date='$date', time='$time', number='$number', name='$name'.") if $main::Debug{phone}; } elsif ($type eq 'zyxel'or $type eq 'motorola') { ($date) = $data =~ /TIME: *(\S+)\s\S+/s; @@ -211,7 +211,7 @@ sub process_cid_data { $number = '' unless $number; unless ($name or $number) { - print "\nCallerid data not parsed: p=$port t=$type d=$data date=$date time=$time number=$number name=$name\n"; + &::print_log("Callerid data not parsed: p=$port t=$type d=$data date=$date time=$time number=$number name=$name"); return; } @@ -230,9 +230,10 @@ sub process_cid_data { $cid_type = 'N' if $number =~ /^[\d\- ]+$/; # Override the type if the number is known - print "Callerid data: port=$port type=$type cid_type=$cid_type name=$name number=$number date=$date time=$time\n data=$data.\n" - if $main::Debug{phone}; - + if ($main::Debug{phone}) { + &::print_log("Callerid data1: port=$port type=$type cid_type=$cid_type name=$name number=$number date=$date time=$time"); + &::print_log("Callerid data2: data=$data."); + } # Set all objects monitoring this port for my $object(@{$list_objects{$port}}) { $object->address($port); From c72dd48590789344ba94b8e8ae4257b5d7081127 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Fri, 28 Mar 2014 17:45:00 -0700 Subject: [PATCH 088/180] Insteon_Irrigation: Rename Poll_Valve_status to Request_Status It is really what the user would expect to recevie for a request_status Sadly, while the device will tell us if a program is running, it doesn't appear that it will tell us WHICH program is running --- lib/Insteon/Irrigation.pm | 22 +++++++++------------- 1 file changed, 9 insertions(+), 13 deletions(-) diff --git a/lib/Insteon/Irrigation.pm b/lib/Insteon/Irrigation.pm index fe7ca00d5..4af7f22f9 100755 --- a/lib/Insteon/Irrigation.pm +++ b/lib/Insteon/Irrigation.pm @@ -95,21 +95,27 @@ sub new { return $self; } -=item C +=item C Sends a message to the device requesting the valve status. The response from the device is printed to the log and stores the result in memory. =cut -sub poll_valve_status { - my ($self) = @_; +sub request_status { + my ($self, $requestor) = @_; my $subcmd = '02'; my $message = new Insteon::InsteonMessage('insteon_send', $self, 'sprinkler_control', $subcmd); $self->_send_cmd($message); return; } +#Deprecated Routine Name +sub poll_valve_status { + my ($self) = @_; + $self->request_status(); +} + =item C Used to directly control valves. Valve_id is a two digit number 00-07, @@ -275,16 +281,6 @@ sub _is_info_request { } -=item C - -This does nothing and returns 0, it prevents a request_status message, which the -device does not support, from being sent to the device. - -=cut - -# Overload methods we don't use, but would otherwise cause Insteon traffic. -sub request_status { return 0 } - =back =head2 AUTHOR From ed902cafb9436888af89a4b19724471295b0187b Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Fri, 28 Mar 2014 17:45:00 -0700 Subject: [PATCH 089/180] Insteon_Irrigation: Fix Documentation --- lib/Insteon/Irrigation.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Insteon/Irrigation.pm b/lib/Insteon/Irrigation.pm index 4af7f22f9..a3cdaf3e2 100755 --- a/lib/Insteon/Irrigation.pm +++ b/lib/Insteon/Irrigation.pm @@ -145,7 +145,7 @@ sub set_valve { =item C Used to directly control programs. Program_id is a two digit number 00-03, -valve_state may be on or off. +proggram_state may be on or off. =cut From 173b10c6ec2a3607f84e4d06c0f6be03aec3a358 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Fri, 28 Mar 2014 17:55:00 -0700 Subject: [PATCH 090/180] Insteon_Irrigation: Add Support for Get Timers Request Partial support was there, but not really enabled. --- lib/Insteon/Irrigation.pm | 61 ++++++++++++++++++++++++++++++++++----- 1 file changed, 53 insertions(+), 8 deletions(-) diff --git a/lib/Insteon/Irrigation.pm b/lib/Insteon/Irrigation.pm index a3cdaf3e2..4990fe877 100755 --- a/lib/Insteon/Irrigation.pm +++ b/lib/Insteon/Irrigation.pm @@ -229,19 +229,18 @@ sub get_pump_enabled() { return $$self{'pump_enabled'}; } -=item C +=item C -Sends a request to the device asking for it to respond with the current timers. -It does not appear that there is code to interpret the response provided by the -device. +Sends a request to the device asking for it to respond with the times for the +specified program. Program 0 is the default/manual timer. =cut sub get_timers() { - my ($self) = @_; + my ($self, $program) = @_; my $cmd = 'sprinkler_timers_request'; - my $subcmd = 0x1; - my $message = new Insteon::InsteonMessage('insteon_ext_send', $self, $cmd, $subcmd); + my $subcmd = sprintf("%02X", $program); + my $message = new Insteon::InsteonMessage('insteon_send', $self, $cmd, $subcmd); $self->_send_cmd($message); return; } @@ -271,7 +270,7 @@ sub _is_info_request { $$self{'valve_is_running'} = ($val >> 7) & 1; &::print_log("[Insteon::Irrigation] active_valve_id: $$self{'active_valve_id'}," . " valve_is_running: $$self{'valve_is_running'}, active_program: $$self{'active_program_number'}," - . " program_is_running: $$self{'program_is_running'}, pump_enabled: $$self{'pump_enabled'}") if $self->debuglevel(1, 'insteon'); + . " program_is_running: $$self{'program_is_running'}, pump_enabled: $$self{'pump_enabled'}"); } else { #Check if this was a generic info_request @@ -281,6 +280,52 @@ sub _is_info_request { } +=item C<_process_message()> + +Handles incoming messages from the device which are unique to this device, +specifically this handles the C response for the device, +all other responses are handed off to the C. + +=cut + +sub _process_message { + my ($self,$p_setby,%msg) = @_; + my $clear_message = 0; + my $pending_cmd = ($$self{_prior_msg}) ? $$self{_prior_msg}->command : $msg{command}; + my $ack_setby = (ref $$self{m_status_request_pending}) ? $$self{m_status_request_pending} : $p_setby; + if ($msg{is_ack} && $self->_is_info_request($pending_cmd,$ack_setby,%msg)) { + $clear_message = 1; + $$self{m_status_request_pending} = 0; + $self->_process_command_stack(%msg); + } + # The device uses cmd 0x41 differently depending on STD or EXT Msgs + elsif ($msg{command} eq "sprinkler_valve_off" && $msg{is_extended}) { + my $program = substr($msg{extra},0,2); + my $timer_1 = hex(substr($msg{extra},2,2)); + my $timer_2 = hex(substr($msg{extra},4,2)); + my $timer_3 = hex(substr($msg{extra},6,2)); + my $timer_4 = hex(substr($msg{extra},8,2)); + my $timer_5 = hex(substr($msg{extra},10,2)); + my $timer_6 = hex(substr($msg{extra},12,2)); + my $timer_7 = hex(substr($msg{extra},14,2)); + my $timer_8 = hex(substr($msg{extra},16,2)); + + #Print Resulting Message + ::print_log("[Insteon::Irrigation] The Timers for Program $program are" + ." as follows:\n Valve 1 = $timer_1\n Valve 2 = $timer_2\n" + ." Valve 3 = $timer_3\n Valve 4 = $timer_4\n Valve 5 = $timer_5\n" + ." Valve 6 = $timer_6\n Valve 7 = $timer_7\n Valve 8 = $timer_8"); + + #Clear message from message queue + $clear_message = 1; + $self->_process_command_stack(%msg); + } + else { + $clear_message = $self->SUPER::_process_message($p_setby,%msg); + } + return $clear_message; +} + =back =head2 AUTHOR From ff357794322912628ca47a54a91e265101aec7b7 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Fri, 28 Mar 2014 18:05:00 -0700 Subject: [PATCH 091/180] Insteon_Irrigation: Add Pump and Status Message Features --- lib/Insteon/Irrigation.pm | 51 ++++++++++++++++++++++++++++++++++++++- 1 file changed, 50 insertions(+), 1 deletion(-) diff --git a/lib/Insteon/Irrigation.pm b/lib/Insteon/Irrigation.pm index 4990fe877..58402d528 100755 --- a/lib/Insteon/Irrigation.pm +++ b/lib/Insteon/Irrigation.pm @@ -63,6 +63,7 @@ package Insteon::Irrigation; our %message_types = ( %Insteon::BaseDevice::message_types, + sprinkler_status => 0x27, sprinkler_control => 0x44, sprinkler_valve_on => 0x40, sprinkler_valve_off => 0x41, @@ -259,7 +260,8 @@ sub _is_info_request { or $cmd eq 'sprinkler_valve_on' or $cmd eq 'sprinkler_valve_off' or $cmd eq 'sprinkler_program_on' - or $cmd eq 'sprinkler_program_off') { + or $cmd eq 'sprinkler_program_off', + or $cmd eq 'sprinkler_status') { $is_info_request = 1; my $val = hex($msg{extra}); &::print_log("[Insteon::Irrigation] Processing data for $cmd with value: $val") if $self->debuglevel(1, 'insteon'); @@ -326,6 +328,53 @@ sub _process_message { return $clear_message; } +=item C + +If set to true, this will treat valve 8 as a water pump. This will make valve +8 turn on whenever any other valve is turned on. Setting to false, returns +valve 8 to a normal sprinkler valve + +=cut + +sub enable_pump { + my ($self, $enable) = @_; + my $subcmd = '08'; + if ($enable){ + $subcmd = '07'; + ::print_log("[Insteon::Irrigation] Enabling valve 8 pump feature."); + } + else { + ::print_log("[Insteon::Irrigation] Setting valve 8 to act as regular valve."); + } + my $message = new Insteon::InsteonMessage('insteon_send', $self, 'sprinkler_control', $subcmd); + $self->_send_cmd($message); + return; +} + +=item C + +If set to true, this will cause the device to send a status message whenever +a valve changes status during a program. If not set, MH will not be informed +of the status of each of the valves during a program. It is HIGHLY recommended +that you enable this feature. + +=cut + +sub enable_status { + my ($self, $enable) = @_; + my $subcmd = '0A'; + if ($enable){ + $subcmd = '09'; + ::print_log("[Insteon::Irrigation] Enabling valve status messages."); + } + else { + ::print_log("[Insteon::Irrigation] Disabling valve status messages."); + } + my $message = new Insteon::InsteonMessage('insteon_send', $self, 'sprinkler_control', $subcmd); + $self->_send_cmd($message); + return; +} + =back =head2 AUTHOR From 5528db38238bc79928bf2decebee11992d74ac49 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Fri, 28 Mar 2014 18:15:00 -0700 Subject: [PATCH 092/180] Insteon_Irrigation: Remove Status Broadcast Code, Insteon PLM Does not Support Every now and then I am reminded what an AWFUL protocol Insteon is. This is one of them. The EZFlora can be set to send out broadcast messages, however the PLM will not decode them. As a result, MisterHouse never sees them, and they are useless. According to the manual the PLM could be put into monitor mode allowing it to see these messages, however Insteon disabled that feature on the PLM. It is beyond stupid, that the PLM will not display a broadcast message sent from a device in its own link table. There is no security concern here. --- lib/Insteon/Irrigation.pm | 28 +--------------------------- 1 file changed, 1 insertion(+), 27 deletions(-) diff --git a/lib/Insteon/Irrigation.pm b/lib/Insteon/Irrigation.pm index 58402d528..880b517b5 100755 --- a/lib/Insteon/Irrigation.pm +++ b/lib/Insteon/Irrigation.pm @@ -63,7 +63,6 @@ package Insteon::Irrigation; our %message_types = ( %Insteon::BaseDevice::message_types, - sprinkler_status => 0x27, sprinkler_control => 0x44, sprinkler_valve_on => 0x40, sprinkler_valve_off => 0x41, @@ -260,8 +259,7 @@ sub _is_info_request { or $cmd eq 'sprinkler_valve_on' or $cmd eq 'sprinkler_valve_off' or $cmd eq 'sprinkler_program_on' - or $cmd eq 'sprinkler_program_off', - or $cmd eq 'sprinkler_status') { + or $cmd eq 'sprinkler_program_off') { $is_info_request = 1; my $val = hex($msg{extra}); &::print_log("[Insteon::Irrigation] Processing data for $cmd with value: $val") if $self->debuglevel(1, 'insteon'); @@ -351,30 +349,6 @@ sub enable_pump { return; } -=item C - -If set to true, this will cause the device to send a status message whenever -a valve changes status during a program. If not set, MH will not be informed -of the status of each of the valves during a program. It is HIGHLY recommended -that you enable this feature. - -=cut - -sub enable_status { - my ($self, $enable) = @_; - my $subcmd = '0A'; - if ($enable){ - $subcmd = '09'; - ::print_log("[Insteon::Irrigation] Enabling valve status messages."); - } - else { - ::print_log("[Insteon::Irrigation] Disabling valve status messages."); - } - my $message = new Insteon::InsteonMessage('insteon_send', $self, 'sprinkler_control', $subcmd); - $self->_send_cmd($message); - return; -} - =back =head2 AUTHOR From 50421cd2ce0a4c7996da0c730efa1f7b10ccd9ab Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Fri, 28 Mar 2014 18:15:00 -0700 Subject: [PATCH 093/180] Insteon_Irrigation: Enable Setting of Valve Timers --- lib/Insteon/Irrigation.pm | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/lib/Insteon/Irrigation.pm b/lib/Insteon/Irrigation.pm index 880b517b5..9acc510fe 100755 --- a/lib/Insteon/Irrigation.pm +++ b/lib/Insteon/Irrigation.pm @@ -245,6 +245,40 @@ sub get_timers() { return; } +=item C + +Sets the timers for the program. Program 0 is the manual/default timers that +are used if you just turn on a single timer. It is HIGHLY recommented that you +set the manual/default timer to the most number of minutes that you would ever +need for that zone. This will prevent accidental overwatering or flooding +should something happen to MisterHouse. + +Each valve time is specified in minutes with 255 being the maximum. + +By default, each valve is set to 30 minutes for each program. + +=cut + +sub set_timers() { + my ($self, $program, $v1, $v2, $v3, $v4, $v5, $v6, $v7, $v8) = @_; + #Command is reused in different format for EXT msgs + my $cmd = 'sprinkler_valve_on'; + my $extra = sprintf("%02X", $program); + $extra .= sprintf("%02X", $v1); + $extra .= sprintf("%02X", $v2); + $extra .= sprintf("%02X", $v3); + $extra .= sprintf("%02X", $v4); + $extra .= sprintf("%02X", $v5); + $extra .= sprintf("%02X", $v6); + $extra .= sprintf("%02X", $v7); + $extra .= sprintf("%02X", $v8); + $extra .= '0' x (30 - length $extra); + my $message = new Insteon::InsteonMessage('insteon_ext_send', $self, $cmd, $extra); + $self->_send_cmd($message); + return; +} + =item C<_is_info_request()> Used to intercept and handle unique EZFlora messages, all others are passed on From 843a76d6266a9c94e97a2afb8a7ac564f770e221 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Fri, 28 Mar 2014 20:58:24 -0700 Subject: [PATCH 094/180] PLM_Parser: Fix PLM Device ID Discovery BIIIIIG Bug this was causing the PLM device id to be identified wrong, leading to bad links and yadda yadda. --- lib/Insteon_PLM.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/Insteon_PLM.pm b/lib/Insteon_PLM.pm index 599639cf3..2bb9d66a9 100644 --- a/lib/Insteon_PLM.pm +++ b/lib/Insteon_PLM.pm @@ -965,8 +965,8 @@ sub _parse_data { ::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) if $self->debuglevel(4, 'insteon'); - $self->device_id(substr($data,0,6)); - $self->firmware(substr($data,10,2)); + $self->device_id(substr($data,4,6)); + $self->firmware(substr($data,14,2)); $self->on_interface_info_received(); $data = substr($data, 18); From 5dfdf313a4fa3c2f132eaafedd8c74353445617c Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Fri, 28 Mar 2014 22:00:50 -0700 Subject: [PATCH 095/180] Insteon_Irrigation: Add Status Check Timer --- lib/Insteon/Irrigation.pm | 82 +++++++++++++++++++++++++++++---------- 1 file changed, 62 insertions(+), 20 deletions(-) diff --git a/lib/Insteon/Irrigation.pm b/lib/Insteon/Irrigation.pm index 9acc510fe..73b2aa860 100755 --- a/lib/Insteon/Irrigation.pm +++ b/lib/Insteon/Irrigation.pm @@ -90,8 +90,11 @@ sub new { $$self{program_is_running} = undef; $$self{pump_enabled} = undef; $$self{valve_is_running} = undef; - $self->restore_data('active_valve_id', 'active_program_number', 'program_is_running', 'pump_enabled', 'valve_is_running'); + $self->restore_data('active_valve_id', 'active_program_number', + 'program_is_running', 'pump_enabled', 'valve_is_running', 'timer_0', + 'timer_1', 'timer_2', 'timer_3', 'timer_4'); $$self{message_types} = \%message_types; + $$self{status_timer} = new Timer; return $self; } @@ -229,15 +232,21 @@ sub get_pump_enabled() { return $$self{'pump_enabled'}; } -=item C +=item C Sends a request to the device asking for it to respond with the times for the -specified program. Program 0 is the default/manual timer. +all programs. The times are then cached in MisterHouse. + +The EZFlora does not update MisterHouse when a timer has expired. As a result, +MisterHouse has to query the device to periodically determine what is going on. +If MisterHouse has an understanding of the timers, it can query the device at +the proper times. =cut sub get_timers() { my ($self, $program) = @_; + $program = 0 unless (defined $program); my $cmd = 'sprinkler_timers_request'; my $subcmd = sprintf("%02X", $program); my $message = new Insteon::InsteonMessage('insteon_send', $self, $cmd, $subcmd); @@ -296,7 +305,6 @@ sub _is_info_request { or $cmd eq 'sprinkler_program_off') { $is_info_request = 1; my $val = hex($msg{extra}); - &::print_log("[Insteon::Irrigation] Processing data for $cmd with value: $val") if $self->debuglevel(1, 'insteon'); $$self{'active_valve_id'} = ($val & 7) + 1; $$self{'active_program_number'} = (($val >> 3) & 3) + 1; $$self{'program_is_running'} = ($val >> 5) & 1; @@ -305,6 +313,19 @@ sub _is_info_request { &::print_log("[Insteon::Irrigation] active_valve_id: $$self{'active_valve_id'}," . " valve_is_running: $$self{'valve_is_running'}, active_program: $$self{'active_program_number'}," . " program_is_running: $$self{'program_is_running'}, pump_enabled: $$self{'pump_enabled'}"); + + # Set a timer to check the status of the device after we expect the timer + # for the current valve to run out. + if ($$self{'valve_is_running'} && $$self{status_timer}->inactive){ + my $action = $self->get_object_name . "->request_status()"; + my $program = 0; + $program = $$self{'active_program_number'} + if ($$self{'program_is_running'}); + my $time = $self->_valve_timer($program, + $$self{'active_valve_id'}); + $time = ($time * 60) + 5; #Add 5 seconds to allow things to happen. + $$self{status_timer}->set($time,$action); + } } else { #Check if this was a generic info_request @@ -334,22 +355,31 @@ sub _process_message { } # The device uses cmd 0x41 differently depending on STD or EXT Msgs elsif ($msg{command} eq "sprinkler_valve_off" && $msg{is_extended}) { - my $program = substr($msg{extra},0,2); - my $timer_1 = hex(substr($msg{extra},2,2)); - my $timer_2 = hex(substr($msg{extra},4,2)); - my $timer_3 = hex(substr($msg{extra},6,2)); - my $timer_4 = hex(substr($msg{extra},8,2)); - my $timer_5 = hex(substr($msg{extra},10,2)); - my $timer_6 = hex(substr($msg{extra},12,2)); - my $timer_7 = hex(substr($msg{extra},14,2)); - my $timer_8 = hex(substr($msg{extra},16,2)); - - #Print Resulting Message - ::print_log("[Insteon::Irrigation] The Timers for Program $program are" - ." as follows:\n Valve 1 = $timer_1\n Valve 2 = $timer_2\n" - ." Valve 3 = $timer_3\n Valve 4 = $timer_4\n Valve 5 = $timer_5\n" - ." Valve 6 = $timer_6\n Valve 7 = $timer_7\n Valve 8 = $timer_8"); - + my $program = hex(substr($msg{extra},0,2)); + for (my $i; $i<= 8; $i++){ + my $time = hex(substr($msg{extra},$i*2,2)); + $self->_valve_timer($program, $i, $time); + } + + if ($program < 4){ + $self->get_timers($program+1); + } + else { + my $output = "[Insteon::Irrigation] The timers for " + . $self->get_object_name . " are:\n"; + $output .= " Program 0: Program 1: Program 2: ". + "Program 3: Program 4:\n"; + for (my $i_v = 0; $i_v <= 8; $i_v++){ + $output .= ' '; + for (my $i_p = 0; $i_p <= 4; $i_p++){ + $output .= " Valve $i_v:" . + sprintf("% 3d", $self->_valve_timer($i_p, $i_v, )); + } + $output .= "\n"; + } + ::print_log($output); + } + #Clear message from message queue $clear_message = 1; $self->_process_command_stack(%msg); @@ -360,6 +390,18 @@ sub _process_message { return $clear_message; } + +# Used to store and retreive the valve times +sub _valve_timer { + my ($self, $program, $valve, $time) = @_; + if (defined $time){ + # Not the ideal way to store this, but restore_data can't handle hashes + # or arrays. So we store the times in a string similar to the msg payload. + substr($$self{'timer_' . $program},(($valve-1)*3),3) = sprintf("%03d", $time); + } + return int(substr($$self{'timer_' . $program},(($valve-1)*3),3)); +} + =item C If set to true, this will treat valve 8 as a water pump. This will make valve From 03e310cb052cbd1fc8667adc429eb0d7c3910c59 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Fri, 28 Mar 2014 22:01:39 -0700 Subject: [PATCH 096/180] Revert "Insteon_Irrigation: Remove Status Broadcast Code, Insteon PLM Does not Support" This reverts commit 5528db38238bc79928bf2decebee11992d74ac49. I was a little wrong in my prior assessment. It turns out that with PLM Monitor Mode enabled, I can actually see these messages. --- lib/Insteon/Irrigation.pm | 28 +++++++++++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/lib/Insteon/Irrigation.pm b/lib/Insteon/Irrigation.pm index 73b2aa860..847a2f097 100755 --- a/lib/Insteon/Irrigation.pm +++ b/lib/Insteon/Irrigation.pm @@ -63,6 +63,7 @@ package Insteon::Irrigation; our %message_types = ( %Insteon::BaseDevice::message_types, + sprinkler_status => 0x27, sprinkler_control => 0x44, sprinkler_valve_on => 0x40, sprinkler_valve_off => 0x41, @@ -302,7 +303,8 @@ sub _is_info_request { or $cmd eq 'sprinkler_valve_on' or $cmd eq 'sprinkler_valve_off' or $cmd eq 'sprinkler_program_on' - or $cmd eq 'sprinkler_program_off') { + or $cmd eq 'sprinkler_program_off', + or $cmd eq 'sprinkler_status') { $is_info_request = 1; my $val = hex($msg{extra}); $$self{'active_valve_id'} = ($val & 7) + 1; @@ -425,6 +427,30 @@ sub enable_pump { return; } +=item C + +If set to true, this will cause the device to send a status message whenever +a valve changes status during a program. If not set, MH will not be informed +of the status of each of the valves during a program. It is HIGHLY recommended +that you enable this feature. + +=cut + +sub enable_status { + my ($self, $enable) = @_; + my $subcmd = '0A'; + if ($enable){ + $subcmd = '09'; + ::print_log("[Insteon::Irrigation] Enabling valve status messages."); + } + else { + ::print_log("[Insteon::Irrigation] Disabling valve status messages."); + } + my $message = new Insteon::InsteonMessage('insteon_send', $self, 'sprinkler_control', $subcmd); + $self->_send_cmd($message); + return; +} + =back =head2 AUTHOR From f5504faeb5f704d09d28a988e029eaebb762d307 Mon Sep 17 00:00:00 2001 From: rudybrian Date: Mon, 31 Mar 2014 15:04:47 -0700 Subject: [PATCH 097/180] Added reconnect logic for network connected callerID sources like NCID server (#393) --- lib/Telephony_Interface.pm | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/lib/Telephony_Interface.pm b/lib/Telephony_Interface.pm index 3306e0f0a..a3e5ba2a5 100644 --- a/lib/Telephony_Interface.pm +++ b/lib/Telephony_Interface.pm @@ -5,7 +5,7 @@ use Telephony_Item; package Telephony_Interface; @Telephony_Interface::ISA = ('Telephony_Item'); -my ($hooks_added, @list_ports, %list_objects, %type_by_port, %caller_id_data, $cid_server_connect); +my ($hooks_added, @list_ports, %list_objects, %type_by_port, %caller_id_data, $cid_server_connect, $cid_server_timer); # US Robotics 56k Voice model 0525 -> rockewell @@ -64,6 +64,8 @@ sub open_port { if $main::Debug{phone}; $cid_server_connect = new Socket_Item( undef, undef, $port, $name, 'tcp', 'record'); start $cid_server_connect; + $cid_server_timer = new Timer; + set $cid_server_timer 10; $type_by_port{$name} = $type; push @list_ports, $name; } @@ -103,14 +105,21 @@ sub reload_reset { sub check_for_data { for my $port (@list_ports) { - if ($cid_server_connect && (my $data = said $cid_server_connect)) { - &::print_log("Phone data: $data.") if $main::Debug{phone}; - if ($data =~ /^CID:/) { - &::print_log("Callerid: $data"); - &process_cid_data($port, $data); + if ($cid_server_connect) { + if (my $data = said $cid_server_connect) { + &::print_log("Phone data: $data.") if $main::Debug{phone}; + if ($data =~ /^CID:/) { + &::print_log("Callerid: $data"); + &process_cid_data($port, $data); + } + else { + &process_phone_data($port, 'ring') if $data =~ /ring/i; + } } - else { - &process_phone_data($port, 'ring') if $data =~ /ring/i; + elsif (!(active $cid_server_connect) && (expired $cid_server_timer)) { + &::print_log("Callerid: Socket is not active, attempting to reconnect."); + start $cid_server_connect; + set $cid_server_timer 10; # Set the timer for 10 seconds before we try again so we don't thrash } } elsif (my $data = $main::Serial_Ports{$port}{data_record}) { From 5f460d128a3c2cb38d078dc02a46974655be5b64 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Mon, 31 Mar 2014 17:45:00 -0700 Subject: [PATCH 098/180] Insteon_Irrigation: Add Support for Broadcast Messages The irrigation broadcast messages are sent whenever the device changes a valve as a result of a timer. To use broadcast messages they must be enabled on the device and the PLM must be put in monitor mode. If a broadcast message is received, it will reset the status_timer and save MH from having to send a valve status request. This results in much more accurate status reports for the valves. --- lib/Insteon/Irrigation.pm | 72 +++++++++++++++++++++++++-------------- 1 file changed, 46 insertions(+), 26 deletions(-) diff --git a/lib/Insteon/Irrigation.pm b/lib/Insteon/Irrigation.pm index 847a2f097..0b670a27b 100755 --- a/lib/Insteon/Irrigation.pm +++ b/lib/Insteon/Irrigation.pm @@ -303,31 +303,9 @@ sub _is_info_request { or $cmd eq 'sprinkler_valve_on' or $cmd eq 'sprinkler_valve_off' or $cmd eq 'sprinkler_program_on' - or $cmd eq 'sprinkler_program_off', - or $cmd eq 'sprinkler_status') { + or $cmd eq 'sprinkler_program_off') { $is_info_request = 1; - my $val = hex($msg{extra}); - $$self{'active_valve_id'} = ($val & 7) + 1; - $$self{'active_program_number'} = (($val >> 3) & 3) + 1; - $$self{'program_is_running'} = ($val >> 5) & 1; - $$self{'pump_enabled'} = ($val >> 6) & 1; - $$self{'valve_is_running'} = ($val >> 7) & 1; - &::print_log("[Insteon::Irrigation] active_valve_id: $$self{'active_valve_id'}," - . " valve_is_running: $$self{'valve_is_running'}, active_program: $$self{'active_program_number'}," - . " program_is_running: $$self{'program_is_running'}, pump_enabled: $$self{'pump_enabled'}"); - - # Set a timer to check the status of the device after we expect the timer - # for the current valve to run out. - if ($$self{'valve_is_running'} && $$self{status_timer}->inactive){ - my $action = $self->get_object_name . "->request_status()"; - my $program = 0; - $program = $$self{'active_program_number'} - if ($$self{'program_is_running'}); - my $time = $self->_valve_timer($program, - $$self{'active_valve_id'}); - $time = ($time * 60) + 5; #Add 5 seconds to allow things to happen. - $$self{status_timer}->set($time,$action); - } + $self->_process_status($msg{extra}); } else { #Check if this was a generic info_request @@ -336,6 +314,38 @@ sub _is_info_request { return $is_info_request; } +sub _process_status { + my ($self, $val) = @_; + $val = hex($val); + $$self{'active_valve_id'} = ($val & 7) + 1; + $$self{'active_program_number'} = (($val >> 3) & 3) + 1; + $$self{'program_is_running'} = ($val >> 5) & 1; + $$self{'pump_enabled'} = ($val >> 6) & 1; + $$self{'valve_is_running'} = ($val >> 7) & 1; + &::print_log("[Insteon::Irrigation] active_valve_id: $$self{'active_valve_id'}," + . " valve_is_running: $$self{'valve_is_running'}, active_program: $$self{'active_program_number'}," + . " program_is_running: $$self{'program_is_running'}, pump_enabled: $$self{'pump_enabled'}"); + + # Set a timer to check the status of the device after we expect the timer + # for the current valve to run out. + if ($$self{'valve_is_running'}){ + my $action = $self->get_object_name . "->_timer_query()"; + my $program = 0; + $program = $$self{'active_program_number'} + if ($$self{'program_is_running'}); + my $time = $self->_valve_timer($program, + $$self{'active_valve_id'}); + $time = ($time * 60) + 5; #Add 5 seconds to allow things to happen. + $$self{status_timer}->set($time,$action); + } +} + +# Used by the timer to check the status of the device. Will only run if MH +# believes that a valve is still on +sub _timer_query { + my ($self) = @_; + $self->request_status() if ($$self{'valve_is_running'}); +} =item C<_process_message()> @@ -355,6 +365,13 @@ sub _process_message { $$self{m_status_request_pending} = 0; $self->_process_command_stack(%msg); } + elsif ($msg{type} eq 'broadcast' && $msg{cmd_code} eq '27') { + #These are the broadcast status messages from the device. + $self->_process_status($msg{dev_attribs}); + ::print_log("[Insteon::Irrigation] Received broadcast status update.") + if $self->debuglevel(2, 'insteon'); + $self->_process_command_stack(%msg); + } # The device uses cmd 0x41 differently depending on STD or EXT Msgs elsif ($msg{command} eq "sprinkler_valve_off" && $msg{is_extended}) { my $program = hex(substr($msg{extra},0,2)); @@ -431,8 +448,11 @@ sub enable_pump { If set to true, this will cause the device to send a status message whenever a valve changes status during a program. If not set, MH will not be informed -of the status of each of the valves during a program. It is HIGHLY recommended -that you enable this feature. +of the status of each of the valves during a program. + +These messages appear to only be available if you put your PLM in monitor mode. +At the moment, there does not appear to be any downside to this, but use at +your own risk. =cut From 6c1f32afd6fe118cdf67784dafb2b94331a3215f Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Mon, 31 Mar 2014 17:45:00 -0700 Subject: [PATCH 099/180] Insteon_PLM: Add Ability to Set/Unset PLM Monitor Mode - Add routine to request and process PLM Config Settings - Add routine to set/unset monitor mode - Fix Typo in Command Length - Fix message parsing of broadcast messages. The message is not that long. Not sure what is_master is supposed to be, seems like it can only be cmd1, dev_attributes makes sense. --- lib/Insteon/BaseInterface.pm | 56 +++++++++++++++++++++++++++++++++++ lib/Insteon/Message.pm | 4 +-- lib/Insteon/MessageDecoder.pm | 2 +- lib/Insteon_PLM.pm | 7 +++++ 4 files changed, 66 insertions(+), 3 deletions(-) diff --git a/lib/Insteon/BaseInterface.pm b/lib/Insteon/BaseInterface.pm index deb223b95..61900f687 100644 --- a/lib/Insteon/BaseInterface.pm +++ b/lib/Insteon/BaseInterface.pm @@ -492,10 +492,66 @@ sub delete_orphan_links return $self->_aldb->delete_orphan_links($audit_mode) if $self->_aldb; } +=item C + +Used to obtain the configuration flags from the PLM. May be used in conjunction +with C. + +=cut + +sub plm_get_config { + my ($self) = @_; + $self->queue_message(new Insteon::InsteonMessage('plm_get_config', $self)); +} + +sub plm_config { + my ($self, $p_config) = @_; + $$self{config} = $p_config if defined $p_config; + return $$self{config}; +} + +=item C + +If boolean is true, enables monitor mode on the PLM, else disables monitor mode. +If you have manually set any other PLM flags (unlikely), you should first call +C to prevent these settings from being altered. + +=cut + +sub enable_monitor_mode { + my ($self, $enable) = @_; + my $config = hex($self->plm_config); + if ($enable){ + $config = $config | 64; + } + else { + $config = $config & 191; + } + my $message = new Insteon::InsteonMessage('plm_set_config', $self); + $message->interface_data(sprintf("%02X",$config)); + $self->queue_message($message); +} + ###################### ### EVENT HANDLERS ### ###################### +=item C + +Called to process the plm_get_config request sent by the C command. +Prints output to log. + +=cut + +sub on_interface_config_received +{ + my ($self,$data) = @_; + $data = $self->plm_config(substr($data,0,2)); + &::print_log("[Insteon_PLM] PLM config flags: $data") + if $self->debuglevel(1, 'insteon'); + $self->clear_active_message(); +} + =item C Called to process the plm_info request sent by the C command. diff --git a/lib/Insteon/Message.pm b/lib/Insteon/Message.pm index 9a2ed4a18..bb9c32f26 100644 --- a/lib/Insteon/Message.pm +++ b/lib/Insteon/Message.pm @@ -430,8 +430,8 @@ sub command_to_hash $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); + $msg{is_master} = substr($p_state,14,2); + $msg{dev_attribs} = substr($p_state,16,2); } elsif ($msgflag ==6) { diff --git a/lib/Insteon/MessageDecoder.pm b/lib/Insteon/MessageDecoder.pm index 297510ecb..7ba3b0976 100644 --- a/lib/Insteon/MessageDecoder.pm +++ b/lib/Insteon/MessageDecoder.pm @@ -132,7 +132,7 @@ my %plmcmdlen = ( '0270' => [3, 4], '0271' => [4, 5], '0272' => [2, 3], - '0273' => [5, 6], + '0273' => [2, 6], ); diff --git a/lib/Insteon_PLM.pm b/lib/Insteon_PLM.pm index 2bb9d66a9..3021aff31 100644 --- a/lib/Insteon_PLM.pm +++ b/lib/Insteon_PLM.pm @@ -971,6 +971,13 @@ sub _parse_data { $data = substr($data, 18); } + elsif ($record_type eq $prefix{plm_get_config} and (length($data) >= 12)){ + ::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) + if $self->debuglevel(4, 'insteon'); + my $message_data = substr($data,4,8); + $self->on_interface_config_received($message_data); + $data = substr($data, 18); + } else { # No more processing can be done now, wait for more data $process_data = 0; From 3abb3d94552dc0cc58440c6d5d427ec5d93f5718 Mon Sep 17 00:00:00 2001 From: hplato Date: Sun, 6 Apr 2014 11:04:47 -0600 Subject: [PATCH 100/180] modified: lib/X10_Items.pm --- lib/X10_Items.pm | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/lib/X10_Items.pm b/lib/X10_Items.pm index 343a560b8..76ee79559 100644 --- a/lib/X10_Items.pm +++ b/lib/X10_Items.pm @@ -76,7 +76,6 @@ Since this item is inherits from Generic_Item, you can use the set_with_timer me set_with_timer $watchdog_light '20%', 5 if file_unchanged $watchdog_file; - =head1 DESCRIPTION =head1 INHERITS @@ -243,6 +242,7 @@ sub set_interface { } elsif ( defined $interface_object and $interface_object->isa('Insteon_PLM')) { print "[X10] for id $id, x10 interface supplied ($interface) and supported by an Insteon PLM\n" if $localDebug; $self->{interface} = $interface_object; + $self->{interface}->add($self); } else { # we can't find a real interface, so use a Dummy_Interface print "[X10] warning, using dummy interface for id $id and supplied interface $interface\n" if $localDebug; @@ -1536,8 +1536,12 @@ sub init { # Note: name is require, as $self->{object_name} is not # set yet on startup :( sub new { - my ($class, $id, $name, $type) = @_; - my $self = X10_Item->new(); +## my ($class, $id, $name, $type) = @_; +## my $self = X10_Item->new(); + my ($class, $id, $name, $type, $interface) = @_; + print "[X10_Sensor] class=$class, id=$id, name=$name, interface=$interface\n" if $main::Debug{x10}; + my $self = X10_Item->new($id, $interface, $type); + $$self{state} = ''; bless $self, $class; From 28b163ec929ce7c3b0e59385695b077d845b681e Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Tue, 8 Apr 2014 17:45:00 -0700 Subject: [PATCH 101/180] Insteon_Irrigation: Standardize All Routines to Index from 1; Fix Get Timers Printout No Valve 0 - The underlying message structure is odd, sometimes things are indexed from 0 and sometimes from 1. This oddity should not be carried over into the user interface, it only causes confusion. --- lib/Insteon/Irrigation.pm | 50 ++++++++++++++++++--------------------- 1 file changed, 23 insertions(+), 27 deletions(-) diff --git a/lib/Insteon/Irrigation.pm b/lib/Insteon/Irrigation.pm index 0b670a27b..8bf030516 100755 --- a/lib/Insteon/Irrigation.pm +++ b/lib/Insteon/Irrigation.pm @@ -20,23 +20,21 @@ Turning on a valve: $v_valve_on = new Voice_Cmd "Turn on valve [1,2,3,4,5,6,7,8]"; if (my $valve = state_now $v_valve_on) { - $valve--; - set_valve $irrigation "0$valve", "on"; + set_valve $irrigation "$valve", "on"; } Turning off a valve: $v_valve_off = new Voice_Cmd "Turn off valve [1,2,3,4,5,6,7,8]"; if (my $valve = state_now $v_valve_off) { - $valve--; - set_valve $irrigation "0$valve", "off"; + set_valve $irrigation "$valve", "off"; } Requesting valve status: $v_valve_status = new Voice_Cmd "Request valve status"; if (state_now $v_valve_status) { - poll_valve_status $irrigation; + request_status $irrigation; } =head2 DESCRIPTION @@ -122,14 +120,14 @@ sub poll_valve_status { =item C -Used to directly control valves. Valve_id is a two digit number 00-07, -valve_state may be on or off. +Used to directly control valves. Valve_id may be 1-8, valve_state may be on +or off. =cut sub set_valve { my ($self, $valve_id, $state) = @_; - my $subcmd = $valve_id; + my $subcmd = sprintf("%02X", $valve_id-1); my $cmd = undef; if ($state eq 'on') { $cmd = 'sprinkler_valve_on'; @@ -148,14 +146,14 @@ sub set_valve { =item C -Used to directly control programs. Program_id is a two digit number 00-03, -proggram_state may be on or off. +Used to directly control programs. Program_id may be 1-4, program_state may be +on or off. =cut sub set_program { my ($self, $program_id, $state) = @_; - my $subcmd = $program_id; + my $subcmd = sprintf("%02X", $program_id-1); my $cmd = undef; if ($state eq 'on') { $cmd = 'sprinkler_program_on'; @@ -271,18 +269,16 @@ By default, each valve is set to 30 minutes for each program. =cut sub set_timers() { - my ($self, $program, $v1, $v2, $v3, $v4, $v5, $v6, $v7, $v8) = @_; + my ($self, $program, @time_array) = @_; #Command is reused in different format for EXT msgs my $cmd = 'sprinkler_valve_on'; my $extra = sprintf("%02X", $program); - $extra .= sprintf("%02X", $v1); - $extra .= sprintf("%02X", $v2); - $extra .= sprintf("%02X", $v3); - $extra .= sprintf("%02X", $v4); - $extra .= sprintf("%02X", $v5); - $extra .= sprintf("%02X", $v6); - $extra .= sprintf("%02X", $v7); - $extra .= sprintf("%02X", $v8); + foreach my $time (@time_array){ + #Store values in MH Cache + $self->_valve_timer($program, $time); + #compose message data + $extra .= sprintf("%02X", $time); + } $extra .= '0' x (30 - length $extra); my $message = new Insteon::InsteonMessage('insteon_ext_send', $self, $cmd, $extra); $self->_send_cmd($message); @@ -333,10 +329,10 @@ sub _process_status { my $program = 0; $program = $$self{'active_program_number'} if ($$self{'program_is_running'}); - my $time = $self->_valve_timer($program, - $$self{'active_valve_id'}); + my $time = $self->_valve_timer($program, $$self{'active_valve_id'}); $time = ($time * 60) + 5; #Add 5 seconds to allow things to happen. - $$self{status_timer}->set($time,$action); + #Only set the timer if it is something worthwhile ie actually set. + $$self{status_timer}->set($time,$action) if $time > 5; } } @@ -388,7 +384,7 @@ sub _process_message { . $self->get_object_name . " are:\n"; $output .= " Program 0: Program 1: Program 2: ". "Program 3: Program 4:\n"; - for (my $i_v = 0; $i_v <= 8; $i_v++){ + for (my $i_v = 1; $i_v <= 8; $i_v++){ $output .= ' '; for (my $i_p = 0; $i_p <= 4; $i_p++){ $output .= " Valve $i_v:" . @@ -410,7 +406,7 @@ sub _process_message { } -# Used to store and retreive the valve times +# Used to store and retreive the valve times from MH cache sub _valve_timer { my ($self, $program, $valve, $time) = @_; if (defined $time){ @@ -451,8 +447,8 @@ a valve changes status during a program. If not set, MH will not be informed of the status of each of the valves during a program. These messages appear to only be available if you put your PLM in monitor mode. -At the moment, there does not appear to be any downside to this, but use at -your own risk. +At the moment, there does not appear to be any downside to running MH with your +PLM in monitor mode, but do this at your own risk. =cut From 93cd62b02261420494a35024c07efb5d6509a01e Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Tue, 8 Apr 2014 19:30:42 -0700 Subject: [PATCH 102/180] Insteon_Irrigation: Add Child Objects for Valve and Programs Makes controlling valves and programs much easier from the web interface and other objects. Also allows the use of generic_items functions such as tie_event --- lib/Insteon/Irrigation.pm | 187 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 187 insertions(+) diff --git a/lib/Insteon/Irrigation.pm b/lib/Insteon/Irrigation.pm index 8bf030516..11ab2bed8 100755 --- a/lib/Insteon/Irrigation.pm +++ b/lib/Insteon/Irrigation.pm @@ -334,6 +334,22 @@ sub _process_status { #Only set the timer if it is something worthwhile ie actually set. $$self{status_timer}->set($time,$action) if $time > 5; } + + # Set child objects if they exist + my $valve = $$self{'active_valve_id'}; + my $program = $$self{'active_program_number'}; + my $valve_status = 'off'; + $valve_status = 'on' if ($$self{'valve_is_running'}); + my $program_status = 'off'; + $program_status = 'on' if ($$self{'program_is_running'}); + if (ref $$self{'child_valve_'.$valve} && + (lc($$self{'child_valve_'.$valve}->state) ne $valve_status)){ + $$self{'child_valve_'.$valve}->set_receive($valve_status); + } + if (ref $$self{'child_program_'.$program} && + (lc($$self{'child_program_'.$program}->state) ne $program_status)){ + $$self{'child_program_'.$program}->set_receive($program_status); + } } # Used by the timer to check the status of the device. Will only run if MH @@ -481,6 +497,177 @@ Kevin Robert Keegan L, L +=head1 Irrigation_valve + +=head1 DESCRIPTION + +A child object for an irrigation valve. + +=head1 SYNOPSIS + +When defining the children, you need to identify who their parent is. + + $valve_1 = new Insteon::Irrigation_valve($irrigation, 1); + $valve_1->set(ON); #Turn ON the valve for the default time + $valve_1->set('5 min'); #Turn ON the valve for 5 minutes only + $valve_1->set_states('off', '5 min', 'on'); #set the states to display + +=head1 AUTHOR + +Kevin Robert Keegan + +=head1 INHERITS + +B + +=head1 Methods + +=over + +=cut + +package Insteon::Irrigation_valve; +use strict; + +@Insteon::Irrigation_valve::ISA = ('Generic_Item'); + +sub new { + my ($class, $parent, $valve) = @_; + my $self = new Generic_Item(); + bless $self, $class; + $$self{parent} = $parent; + $$self{valve} = $valve; + @{$$self{states}} = ('Off', '5 min', '15 min', ' 30 min', 'On'); + $$self{parent}{'child_valve_'.$valve} = $self; + $$self{timer} = new Timer; + return $self; +} + +=item C + +Use just like the set function for any other descendant of a Generic_Item. + +Accepts on and off commands and will parse the number portion out of any command +into the number of minutes. So '5 min' will cause the valve to turn ON for 5 +minutes. + +NOTE: The maximum amount of time the valve can be turned on for is determined +by the default setting, contained in program 0. Turning on the child object +for longer than the default setting will result in the valve running for the +default length and then turning off. + +=cut + +sub set { + my ($self, $p_state, $p_setby, $p_response) = @_; + if ($p_state =~ /(on|off)/i){ + $p_state = $1; + ::print_log("[Insteon::Irrigation] Received request to set ". + $self->get_object_name . " $p_state."); + $$self{parent}->set_valve($$self{valve}, $p_state); + } + elsif ($p_state =~ /(\d*)/) { + $p_state = $1; + ::print_log("[Insteon::Irrigation] Received request to set ". + $self->get_object_name . " ON for $p_state minutes."); + $$self{parent}->set_valve($$self{valve}, 'on'); + #Set timer to turn off + my $action = $$self{parent}->get_object_name . "->set_valve(". + $$self{valve} .", 'off')"; + my $time = ($p_state * 60); + $$self{timer}->set($time,$action); + } + else { + ::print_log("[Insteon::Irrigation] Cannot set ". + $self->get_object_name . " to unknown state of $p_state."); + } +} + +sub set_receive { + my ($self, $p_state) = @_; + if ($p_state =~ /off/i){ + #Clear any off timers that are outstanding + $$self{timer}->unset; + } + $self->SUPER::set($p_state); +} + +=back + +=head1 Irrigation_program + +=head1 DESCRIPTION + +A child object for an irrigation program. + +=head1 SYNOPSIS + +When defining the children, you need to identify who their parent is. + + $program_1 = new Insteon::Irrigation_program($irrigation, 1); + $program_1->set(ON); #Turn ON the program + +=head1 AUTHOR + +Kevin Robert Keegan + +=head1 INHERITS + +B + +=head1 Methods + +=over + +=cut + +package Insteon::Irrigation_program; +use strict; + +@Insteon::Irrigation_program::ISA = ('Generic_Item'); + +sub new { + my ($class, $parent, $program) = @_; + my $self = new Generic_Item(); + bless $self, $class; + $$self{parent} = $parent; + $$self{program} = $program; + @{$$self{states}} = ('Off', 'On'); + $$self{parent}{'child_program_'.$program} = $self; + $$self{timer} = new Timer; + return $self; +} + +=item C + +Use just like the set function for any other descendant of a Generic_Item. + +Accepts on and off commands. + +=cut + +sub set { + my ($self, $p_state, $p_setby, $p_response) = @_; + if ($p_state =~ /(on|off)/i){ + $p_state = $1; + ::print_log("[Insteon::Irrigation] Received request to set ". + $self->get_object_name . " $p_state."); + $$self{parent}->set_valve($$self{valve}, $p_state); + } + else { + ::print_log("[Insteon::Irrigation] Cannot set ". + $self->get_object_name . " to unknown state of $p_state."); + } +} + +sub set_receive { + my ($self, $p_state) = @_; + $self->SUPER::set($p_state); +} + + +=back + =head2 LICENSE This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. From 5e90dd3bc780fe016db56d1160790940d16e8da1 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Wed, 9 Apr 2014 21:08:43 -0700 Subject: [PATCH 103/180] Insteon_Irrigation: Fix Bugs, Update Status of All Valves and Programs on Status --- lib/Insteon/Irrigation.pm | 48 +++++++++++++++++++++++---------------- 1 file changed, 28 insertions(+), 20 deletions(-) diff --git a/lib/Insteon/Irrigation.pm b/lib/Insteon/Irrigation.pm index 11ab2bed8..a46133b45 100755 --- a/lib/Insteon/Irrigation.pm +++ b/lib/Insteon/Irrigation.pm @@ -129,9 +129,9 @@ sub set_valve { my ($self, $valve_id, $state) = @_; my $subcmd = sprintf("%02X", $valve_id-1); my $cmd = undef; - if ($state eq 'on') { + if (lc($state) eq 'on') { $cmd = 'sprinkler_valve_on'; - } elsif ($state eq 'off') { + } elsif (lc($state) eq 'off') { $cmd = 'sprinkler_valve_off'; } unless ($cmd and $subcmd) { @@ -155,9 +155,9 @@ sub set_program { my ($self, $program_id, $state) = @_; my $subcmd = sprintf("%02X", $program_id-1); my $cmd = undef; - if ($state eq 'on') { + if (lc($state) eq 'on') { $cmd = 'sprinkler_program_on'; - } elsif ($state eq 'off') { + } elsif (lc($state) eq 'off') { $cmd = 'sprinkler_program_off'; } unless ($cmd and $subcmd) { @@ -338,17 +338,25 @@ sub _process_status { # Set child objects if they exist my $valve = $$self{'active_valve_id'}; my $program = $$self{'active_program_number'}; - my $valve_status = 'off'; - $valve_status = 'on' if ($$self{'valve_is_running'}); - my $program_status = 'off'; - $program_status = 'on' if ($$self{'program_is_running'}); - if (ref $$self{'child_valve_'.$valve} && - (lc($$self{'child_valve_'.$valve}->state) ne $valve_status)){ - $$self{'child_valve_'.$valve}->set_receive($valve_status); + + # Loop valves, updating state of all that have changed + for (my $v = 1; $v <= 8; $v++){ + my $valve_status = 'off'; + $valve_status = 'on' if ($$self{'valve_is_running'} && $v == $valve); + if (ref $$self{'child_valve_'.$v} && + (lc($$self{'child_valve_'.$v}->state) ne $valve_status)){ + $$self{'child_valve_'.$v}->set_receive($valve_status); + } } - if (ref $$self{'child_program_'.$program} && - (lc($$self{'child_program_'.$program}->state) ne $program_status)){ - $$self{'child_program_'.$program}->set_receive($program_status); + + # Loop programs, updating state of all that have changed + for (my $p = 1; $p <= 4; $p++){ + my $program_status = 'off'; + $program_status = 'on' if ($$self{'program_is_running'} && $p == $program); + if (ref $$self{'child_program_'.$p} && + (lc($$self{'child_program_'.$p}->state) ne $program_status)){ + $$self{'child_program_'.$p}->set_receive($program_status); + } } } @@ -539,7 +547,7 @@ sub new { $$self{valve} = $valve; @{$$self{states}} = ('Off', '5 min', '15 min', ' 30 min', 'On'); $$self{parent}{'child_valve_'.$valve} = $self; - $$self{timer} = new Timer; + $$self{state_timer} = new Timer; return $self; } @@ -566,7 +574,7 @@ sub set { $self->get_object_name . " $p_state."); $$self{parent}->set_valve($$self{valve}, $p_state); } - elsif ($p_state =~ /(\d*)/) { + elsif ($p_state =~ /(\d+)/) { $p_state = $1; ::print_log("[Insteon::Irrigation] Received request to set ". $self->get_object_name . " ON for $p_state minutes."); @@ -575,7 +583,7 @@ sub set { my $action = $$self{parent}->get_object_name . "->set_valve(". $$self{valve} .", 'off')"; my $time = ($p_state * 60); - $$self{timer}->set($time,$action); + $$self{state_timer}->set($time,$action); } else { ::print_log("[Insteon::Irrigation] Cannot set ". @@ -587,7 +595,7 @@ sub set_receive { my ($self, $p_state) = @_; if ($p_state =~ /off/i){ #Clear any off timers that are outstanding - $$self{timer}->unset; + $$self{state_timer}->set(0); } $self->SUPER::set($p_state); } @@ -634,7 +642,7 @@ sub new { $$self{program} = $program; @{$$self{states}} = ('Off', 'On'); $$self{parent}{'child_program_'.$program} = $self; - $$self{timer} = new Timer; + $$self{state_timer} = new Timer; return $self; } @@ -652,7 +660,7 @@ sub set { $p_state = $1; ::print_log("[Insteon::Irrigation] Received request to set ". $self->get_object_name . " $p_state."); - $$self{parent}->set_valve($$self{valve}, $p_state); + $$self{parent}->set_program($$self{program}, $p_state); } else { ::print_log("[Insteon::Irrigation] Cannot set ". From 1408caa17aa113a52ed870931b12ad6ae196f1c3 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Wed, 16 Apr 2014 21:04:13 -0700 Subject: [PATCH 104/180] Insteon: Add Methods to Support Delayed Deaf Device Communication --- lib/Insteon/BaseInsteon.pm | 49 +++++++++++++++++++++++++++++++++++++- 1 file changed, 48 insertions(+), 1 deletion(-) diff --git a/lib/Insteon/BaseInsteon.pm b/lib/Insteon/BaseInsteon.pm index 93cbc9e0d..bd8054992 100644 --- a/lib/Insteon/BaseInsteon.pm +++ b/lib/Insteon/BaseInsteon.pm @@ -1343,7 +1343,7 @@ sub new $self->restore_data('devcat', 'firmware', 'level', 'retry_count_log', 'fail_count_log', 'outgoing_count_log', 'incoming_count_log', 'corrupt_count_log', 'dupe_count_log', 'hops_left_count', 'max_hops_count', - 'outgoing_hop_count'); + 'outgoing_hop_count', 'awake_time'); $self->initialize(); $self->rate(undef); @@ -1385,6 +1385,53 @@ sub initialize # persist local, simple attribs } +=item C + +Used to store and return the associated awake time of a device. This only +applies to deaf devices. + +If provided, stores awake time. + +=cut + +sub awake_time +{ + my ($self, $p_time) = @_; + $$self{awake_time} = $p_time if $p_time; + return $$self{awake_time}; +} + +=item C + +Used to store and return the time of the last contact from a device. This only +applies to deaf devices. + +=cut + +sub last_contact +{ + my ($self, $p_time) = @_; + $$self{last_contact} = $p_time if $p_time; + return $$self{last_contact}; +} + +=item C + +Used to manually flag the device as awake for a period of time. This will +cause all messages from MH to be immediately sent to the device instead of +being held until next contact. This should be used when you have manually +set the device to be awake such as by holding the set button until the device +beeps. Used only for deaf devices. + +=cut + +sub manual_awake +{ + my ($self, $p_time) = @_; + $$self{manual_awake} = $p_time if $p_time; + return $$self{manual_awake}; +} + =item C Used to store and return the associated ramp rate of a device. From bd9f0a0c5fbe170abc2a300cd7fdf1867de3b0f8 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Wed, 16 Apr 2014 21:28:24 -0700 Subject: [PATCH 105/180] Insteon: Do Not Send Commands to Deaf Devices Not Awake --- lib/Insteon/BaseInsteon.pm | 29 ++++++++++++++++++++++++++--- 1 file changed, 26 insertions(+), 3 deletions(-) diff --git a/lib/Insteon/BaseInsteon.pm b/lib/Insteon/BaseInsteon.pm index bd8054992..8116ce563 100644 --- a/lib/Insteon/BaseInsteon.pm +++ b/lib/Insteon/BaseInsteon.pm @@ -982,7 +982,7 @@ sub _process_command_stack # for now, be "dumb" and just unset it $$self{awaiting_ack} = 0; } - if (!($$self{awaiting_ack})) { + if (!($$self{awaiting_ack}) && $self->is_awake) { my $callback = undef; my $message = pop(@{$$self{command_stack}}); # convert ptr to cmd hash @@ -1035,7 +1035,11 @@ sub _process_command_stack if $@ and $self->debuglevel(1, 'insteon'); package Insteon::BaseObject; } - } else { + } elsif (!$self->is_awake){ + ::print_log("[Insteon::BaseObject] ". $self->get_object_name . + " is deaf and not currently awake. Queuing commands" . + " until device wakes up."); + }else { # &::print_log("[Insteon_Device] " . $self->get_object_name . " command queued but not yet sent; awaiting ack from prior command") if $self->debuglevel(1, 'insteon'); } } @@ -1428,10 +1432,29 @@ beeps. Used only for deaf devices. sub manual_awake { my ($self, $p_time) = @_; - $$self{manual_awake} = $p_time if $p_time; + $$self{manual_awake} = time + $p_time if $p_time; return $$self{manual_awake}; } +=item C + +Returns true if the device has made contact within the time allowed by +C or if time allowed for C= time){ + $is_awake = 1; + } + $is_awake = 1 unless ($self->is_deaf); + return $is_awake; +} + =item C Used to store and return the associated ramp rate of a device. From 01090cd4beeace9fd0e869890bbdf082ce1b1a07 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Wed, 16 Apr 2014 21:35:40 -0700 Subject: [PATCH 106/180] Insteon: Set Last Contact on Received Message --- lib/Insteon/BaseInterface.pm | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/lib/Insteon/BaseInterface.pm b/lib/Insteon/BaseInterface.pm index 61900f687..2e453504a 100644 --- a/lib/Insteon/BaseInterface.pm +++ b/lib/Insteon/BaseInterface.pm @@ -607,6 +607,7 @@ sub on_standard_insteon_received $object->max_hops_count($msg{maxhops}) if $object->can('max_hops_count'); $object->hops_left_count($msg{hopsleft}) if $object->can('hops_left_count'); $object->incoming_count_log(1) if $object->can('incoming_count_log'); + $object->last_contact(time); if ($msg{type} ne 'broadcast') { $msg{command} = $object->message_type($msg{cmd_code}); @@ -739,6 +740,11 @@ sub on_standard_insteon_received # ask the object to process the received message and update its state $object->_process_message($self, %msg); } + if ($self->is_deaf){ + #See if deaf device has commands waiting to be + #sent + $self->_process_command_stack(); + } } else { @@ -788,6 +794,7 @@ sub on_extended_insteon_received $object->max_hops_count($msg{maxhops}) if $object->can('max_hops_count'); $object->hops_left_count($msg{hopsleft}) if $object->can('hops_left_count'); $object->incoming_count_log(1) if $object->can('incoming_count_log'); + $object->last_contact(time); if ($msg{type} ne 'broadcast') { $msg{command} = $object->message_type($msg{cmd_code}); @@ -808,6 +815,11 @@ sub on_extended_insteon_received } $self->clear_active_message(); } + if ($self->is_deaf){ + #See if deaf device has commands waiting to be + #sent + $self->_process_command_stack(); + } } else { From 6ecde9cdf4de1c905bf9d35e14bca3baf0e8bcb7 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Wed, 16 Apr 2014 21:39:06 -0700 Subject: [PATCH 107/180] Insteon: Set Default Awake Time --- lib/Insteon/BaseInsteon.pm | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/Insteon/BaseInsteon.pm b/lib/Insteon/BaseInsteon.pm index 8116ce563..0c7f4b705 100644 --- a/lib/Insteon/BaseInsteon.pm +++ b/lib/Insteon/BaseInsteon.pm @@ -1369,6 +1369,7 @@ sub new $$self{hops_left_count} = 0; $$self{max_hops_count} = 0; $$self{outgoing_hop_count} = 0; + $$self{awake_time} = 2 unless $$self{awake_time}; return $self; From 1521a3c0ed3546f8fefd7fc7248313931b2848ae Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Wed, 16 Apr 2014 22:06:54 -0700 Subject: [PATCH 108/180] Insteon: Move is_awake to BaseObject; Fix Coding Error in BaseInterface -_process_command_stack is in BaseObject, which requires is_awake to be there too, otherwise we get errors with InterfaceObjects -Fix stupid error s/$self/$object/ in BaseInterface --- lib/Insteon/BaseInsteon.pm | 39 ++++++++++++++++++------------------ lib/Insteon/BaseInterface.pm | 10 ++++----- 2 files changed, 25 insertions(+), 24 deletions(-) diff --git a/lib/Insteon/BaseInsteon.pm b/lib/Insteon/BaseInsteon.pm index 0c7f4b705..62c665233 100644 --- a/lib/Insteon/BaseInsteon.pm +++ b/lib/Insteon/BaseInsteon.pm @@ -1205,6 +1205,26 @@ sub is_responder } } +=item C + +Returns true if the device has made contact within the time allowed by +C or if time allowed for Cisa('Insteon::BaseDevice'); + my $is_awake = 0; + if (((time - $$self{last_contact}) <= $$self{awake_time}) || + $$self{manual_awake} >= time){ + $is_awake = 1; + } + $is_awake = 1 unless ($self->is_deaf); + return $is_awake; +} + =back =head2 INI PARAMETERS @@ -1437,25 +1457,6 @@ sub manual_awake return $$self{manual_awake}; } -=item C - -Returns true if the device has made contact within the time allowed by -C or if time allowed for C= time){ - $is_awake = 1; - } - $is_awake = 1 unless ($self->is_deaf); - return $is_awake; -} - =item C Used to store and return the associated ramp rate of a device. diff --git a/lib/Insteon/BaseInterface.pm b/lib/Insteon/BaseInterface.pm index 2e453504a..79df66673 100644 --- a/lib/Insteon/BaseInterface.pm +++ b/lib/Insteon/BaseInterface.pm @@ -740,11 +740,11 @@ sub on_standard_insteon_received # ask the object to process the received message and update its state $object->_process_message($self, %msg); } - if ($self->is_deaf){ + if ($object->is_deaf){ #See if deaf device has commands waiting to be #sent - $self->_process_command_stack(); - } + $object->_process_command_stack(); + } } else { @@ -815,10 +815,10 @@ sub on_extended_insteon_received } $self->clear_active_message(); } - if ($self->is_deaf){ + if ($object->is_deaf){ #See if deaf device has commands waiting to be #sent - $self->_process_command_stack(); + $object->_process_command_stack(); } } else From 3ce31270bd709c170718f43f3448bfbb6a6da23e Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 17 Apr 2014 17:35:00 -0700 Subject: [PATCH 109/180] Insteon: Move ALDB Delta Checking in Batch Scan to BaseDevice This is needed in order to allow for delayed scanning of deaf devices. As a side effect, it makes the code much more condensed and readable. --- lib/Insteon.pm | 31 ++++++++++--------------------- lib/Insteon/BaseInsteon.pm | 18 ++++++++++++------ 2 files changed, 22 insertions(+), 27 deletions(-) diff --git a/lib/Insteon.pm b/lib/Insteon.pm index f162a48e5..e4bafcd49 100755 --- a/lib/Insteon.pm +++ b/lib/Insteon.pm @@ -451,31 +451,20 @@ Gets the next device to scan. sub _get_next_linkscan { my($skip_unchanged, $changed_device) = @_; - my $checking = 0; - if (!defined($changed_device)) { - $current_scan_device = shift @_scan_devices; - if ($skip_unchanged && $current_scan_device && ($current_scan_device != &Insteon::active_interface)){ - ## check if aldb_delta has changed; - $current_scan_device->_aldb->{_aldb_unchanged_callback} = '&Insteon::_get_next_linkscan('.$skip_unchanged.')'; - $current_scan_device->_aldb->{_aldb_changed_callback} = '&Insteon::_get_next_linkscan('.$skip_unchanged.', '.$current_scan_device->get_object_name.')'; - $current_scan_device->_aldb->{_failure_callback} = '&Insteon::_get_next_linkscan_failure('.$skip_unchanged.')'; - $current_scan_device->_aldb->query_aldb_delta("check"); - $checking = 1; - } - } else { - $current_scan_device = $changed_device; - } - if ($current_scan_device && ($checking == 0)) - { - &main::print_log("[Scan all link tables] Now scanning: " + $current_scan_device = shift @_scan_devices; + if ($current_scan_device) { + ::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('.$skip_unchanged.')','&Insteon::_get_next_linkscan_failure('.$skip_unchanged.')'); - } elsif (scalar(@_scan_devices) == 0 && ($checking == 0)) - { - &main::print_log("[Scan all link tables] All tables have completed scanning"); + $current_scan_device->scan_link_table( + '&Insteon::_get_next_linkscan('.$skip_unchanged.')', + '&Insteon::_get_next_linkscan_failure('.$skip_unchanged.')', + $skip_unchanged); + } + else { + ::print_log("[Scan all link tables] All tables have completed scanning"); my $_scan_failure_cnt = scalar @_scan_device_failures; if ($_scan_failure_cnt){ my $obj_list; diff --git a/lib/Insteon/BaseInsteon.pm b/lib/Insteon/BaseInsteon.pm index 62c665233..268873416 100644 --- a/lib/Insteon/BaseInsteon.pm +++ b/lib/Insteon/BaseInsteon.pm @@ -1943,13 +1943,19 @@ Scans a device link table and caches a copy. 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); + my ($self, $success_callback, $failure_callback, $skip_unchanged) = @_; + my $aldb = $self->get_root()->_aldb; + if ($skip_unchanged) { + my $self_name = $self->get_object_name(); + ## check if aldb_delta has changed; + $aldb->{_aldb_unchanged_callback} = $success_callback; + $aldb->{_aldb_changed_callback} = $self_name."->scan_link_table( + '$success_callback', '$failure_callback')"; + $aldb->{_failure_callback} = $failure_callback; + $aldb->query_aldb_delta("check"); + } else { + $aldb->scan_link_table($success_callback, $failure_callback); } - } =item C From a010c9bee5c230399ba58f8c5d02c517d9612855 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 17 Apr 2014 17:40:00 -0700 Subject: [PATCH 110/180] Insteon: Queue Scans of Deaf Devices Last - Add log message explaining what is happening - Send command to scan each deaf device individually, this should result in the requests being queued, unless the device is awake - Because these commands will be fired off when the various devices are randomly awake, these have to be individual "uncoordinated" scans. In the worst case scenario, this will cause the scanning of numerous devices to happen at the same time. While not ideal, this can't simply be avoided, however, the stack should be robust enough to handle this without error now, although it may be confusing to the user. --- lib/Insteon.pm | 52 +++++++++++++++++++++++++++++++++----------------- 1 file changed, 35 insertions(+), 17 deletions(-) diff --git a/lib/Insteon.pm b/lib/Insteon.pm index e4bafcd49..52122ad48 100755 --- a/lib/Insteon.pm +++ b/lib/Insteon.pm @@ -311,7 +311,7 @@ Resets the message stats back to 0 for this device. 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 (@_scan_devices,@_scan_deaf_devices,@_scan_device_failures,$current_scan_device); my (@_sync_devices,@_sync_device_failures,$current_sync_device); my ($_stress_test_count, $_stress_test_one_pass, @_stress_test_devices); my ($_ping_count, @_ping_devices); @@ -386,6 +386,7 @@ sub scan_all_linktables my @candidate_devices = (); # clear @_scan_devices @_scan_devices = (); + @_scan_deaf_devices = (); @_scan_device_failures = (); $current_scan_device = undef; # alwayws include the active interface (e.g., plm) @@ -400,8 +401,7 @@ sub scan_all_linktables { my $candidate_object = $_; if ($candidate_object->is_root and - !($candidate_object->is_deaf - or $candidate_object->isa('Insteon::InterfaceController'))) + !($candidate_object->isa('Insteon::InterfaceController'))) { push @_scan_devices, $candidate_object; &main::print_log("[Scan all linktables] INFO1: " @@ -453,26 +453,44 @@ sub _get_next_linkscan my($skip_unchanged, $changed_device) = @_; $current_scan_device = shift @_scan_devices; if ($current_scan_device) { - ::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('.$skip_unchanged.')', - '&Insteon::_get_next_linkscan_failure('.$skip_unchanged.')', - $skip_unchanged); + if ($current_scan_device->is_deaf){ + # Store deaf devices for scanning at the end + push(@_scan_deaf_devices, $current_scan_device); + &Insteon::_get_next_linkscan($skip_unchanged); + } + else { + ::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('.$skip_unchanged.')', + '&Insteon::_get_next_linkscan_failure('.$skip_unchanged.')', + $skip_unchanged); + } } else { - ::print_log("[Scan all link tables] All tables have completed scanning"); - my $_scan_failure_cnt = scalar @_scan_device_failures; - if ($_scan_failure_cnt){ + ::print_log("[Scan all link tables] Completed scanning of all regular items."); + if (scalar @_scan_device_failures){ my $obj_list; for my $failed_obj (@_scan_device_failures){ $obj_list .= $failed_obj->get_object_name .", "; } - ::print_log("[Scan all link tables] However, some failures " - ."were noted with the following devices: $obj_list"); + ::print_log("[Scan all link tables] WARN, unable to " + ." complete a scan of the following devices: $obj_list"); + } + if (scalar @_scan_deaf_devices){ + my $obj_list; + for my $deaf_obj (@_scan_deaf_devices){ + $obj_list .= $deaf_obj->get_object_name .", "; + } + ::print_log("[Scan all link tables] Will attempt to scan" + ." the following deaf devices the next time they" + ." wakeup: $obj_list"); + for my $deaf_obj (@_scan_deaf_devices){ + $deaf_obj->scan_link_table('','',$skip_unchanged); + } } } } From 8b7be27b64ae7f031453ebdea7fdf916ecd38f22 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 17 Apr 2014 17:45:00 -0700 Subject: [PATCH 111/180] Insteon: Add Log Messages to Appear at Conclusion of Delayed Scan --- lib/Insteon.pm | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/lib/Insteon.pm b/lib/Insteon.pm index 52122ad48..552d96a28 100755 --- a/lib/Insteon.pm +++ b/lib/Insteon.pm @@ -489,7 +489,16 @@ sub _get_next_linkscan ." the following deaf devices the next time they" ." wakeup: $obj_list"); for my $deaf_obj (@_scan_deaf_devices){ - $deaf_obj->scan_link_table('','',$skip_unchanged); + my $success_callback = "::print_log(qq|[Scan all". + " link tables] Delayed scan successfully". + " completed for: " . + $deaf_obj->get_object_name . "|)"; + my $failure_callback = "::print_log(qq|[Scan all". + " link tables] WARN: The delayed scan ". + " failed for: " . + $deaf_obj->get_object_name . "|)"; + $deaf_obj->scan_link_table($success_callback, + $failure_callback,$skip_unchanged); } } } From 20b85c864ed6d9899ca41cb76fe181a11b351e33 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 17 Apr 2014 17:55:00 -0700 Subject: [PATCH 112/180] Insteon: Queue Sync Requests for Deaf Devices for Later Delivery Sync these links when the device wakes up Also clean up Sync_All_Links routine a bit --- lib/Insteon.pm | 21 ++++------ lib/Insteon/BaseInsteon.pm | 85 +++++++++++++++++++++++++++++++------- 2 files changed, 78 insertions(+), 28 deletions(-) diff --git a/lib/Insteon.pm b/lib/Insteon.pm index 552d96a28..067a416e7 100755 --- a/lib/Insteon.pm +++ b/lib/Insteon.pm @@ -548,31 +548,27 @@ call _get_next_linksync_failure() if sync_links() fails. 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) - { - + if (%sync_req) { $current_sync_device = $sync_req{'sync_object'}; } - else - { + else { $current_sync_device = undef; } - if ($current_sync_device) - { + 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)"); my $skip_deaf = 1; # 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()', $skip_deaf); + $current_sync_device->sync_links($sync_req{'audit_mode'}, + '&Insteon::_get_next_linksync()', + '&Insteon::_get_next_linksync_failure()', $skip_deaf); } - else - { + else { &main::print_log("[Sync all links] All links have completed syncing"); my $_sync_failure_cnt = scalar @_sync_device_failures; if ($_sync_failure_cnt){ @@ -581,7 +577,8 @@ sub _get_next_linksync $obj_list .= $failed_obj->get_object_name .", "; } ::print_log("[Sync all links] WARN! Failures occured, " - ."some links involving the following objects remain out-of-sync: $obj_list"); + ."some links involving the following objects " + ."remain out-of-sync: $obj_list"); } } diff --git a/lib/Insteon/BaseInsteon.pm b/lib/Insteon/BaseInsteon.pm index 268873416..82570c398 100644 --- a/lib/Insteon/BaseInsteon.pm +++ b/lib/Insteon/BaseInsteon.pm @@ -3145,13 +3145,7 @@ sub sync_links # Warn if device is deaf or ALDB out of sync my $insteon_object_is_syncable = 1; - if ($insteon_object->is_deaf && $skip_deaf) { - ::print_log("[Insteon::BaseController] $self_link_name is deaf, only responder links will be added to devices " - ."controlled by this device. To sync links on this device, put it in awake mode and run the 'Sync Links' " - ."command on this specific device."); - $insteon_object_is_syncable = 0; - } - elsif ($insteon_object->_aldb->health ne 'good' && $insteon_object->_aldb->health ne 'empty'){ + if ($insteon_object->_aldb->health ne 'good' && $insteon_object->_aldb->health ne 'empty'){ ::print_log("[Insteon::BaseController] WARN! The ALDB of $self_link_name is ".$insteon_object->_aldb->health .", links will be added to devices " ."linked to this device, but no links will be added to $self_link_name. Please rescan this device and attempt " @@ -3350,13 +3344,17 @@ sub _process_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); - } + my $link_member = $link_req{member}; + if ($link_member->is_deaf){ + $link_member->_build_deaf_sync_queue($link_req_ptr); + $self->_process_sync_queue(); + } + elsif ($link_req{cmd} eq 'update') { + $link_member->update_link(%link_req); + } + elsif ($link_req{cmd} eq 'add') { + $link_member->add_link(%link_req); + } } elsif ($$self{sync_queue_callback}) { my $callback = $$self{sync_queue_callback}; if ($$self{sync_queue_failure}){ @@ -3364,14 +3362,69 @@ sub _process_sync_queue { } package main; eval ($callback); - &::print_log("[Insteon::BaseController] error in sync links callback: " . $@) + ::print_log("[Insteon::BaseController] ERROR in sync links callback: " . $@) if $@ and $self->debuglevel(1, 'insteon'); package Insteon::BaseController; } else { - main::print_log($self->get_object_name." completed sync links"); + ::print_log("[Insteon::BaseController] Completed sync links for: " + .$self->get_object_name); + } +} + +###### +# +# The following three routines are used to queue links to be synced on deaf +# devices these requests will be processed the next time the device wakes up +# +###### + +sub _build_deaf_sync_queue { + my ($self, $link_req_ptr) = @_; + my %link_req = %$link_req_ptr; + my $self_link_name = $self->get_object_name; + %link_req = ( callback => "$self_link_name->_process_deaf_sync_queue()", + failure_callback => "$self_link_name->_process_deaf_sync_queue_failure()"); + push @{$$self{deaf_sync_queue}}, \%link_req; + if (!$$self{deaf_sync_queue_flag}){ + ::print_log("[Insteon::BaseController] Sync requests for " + .$self_link_name. " will not be processed until it is awake."); + $self->_process_deaf_sync_queue(); + } +} + +sub _process_deaf_sync_queue { + my ($self) = @_; + my $num_sync_queue = @{$$self{deaf_sync_queue}}; + if ($num_sync_queue) { + $$self{deaf_sync_queue_flag} = 1; #Sync requests are pending + my $link_req_ptr = shift(@{$$self{deaf_sync_queue}}); + my %link_req = %$link_req_ptr; + my $link_member = $link_req{member}; + if ($link_req{cmd} eq 'update') { + $link_member->update_link(%link_req); + } + elsif ($link_req{cmd} eq 'add') { + $link_member->add_link(%link_req); + } + } + else { + ::print_log($self->get_object_name." completed the delayed " + ."sync links request"); + if ($$self{deaf_sync_queue_failure}) { + ::print_log("However, some failures occured while " + ."syncing links on " . $self->get_object_name); + } + $$self{deaf_sync_queue_flag} = 0; + $$self{deaf_sync_queue_failure} = 0; } } +sub _process_deaf_sync_queue_failure { + my ($self) = @_; + $$self{deaf_sync_queue_failure} = 1; + $self->_process_deaf_sync_queue(); +} + =item C Checks each linked member of device. If the linked member is a C, From a9bae32c1fc5c62fd65b340885f7923909aed149 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 17 Apr 2014 20:25:03 -0700 Subject: [PATCH 113/180] Insteon: Revert Including Deaf Devices in Batch Commands - On further thought, including deaf devices in batch commands is a bad idea. Many deaf devices are rarely contacted, yet a user may run the batch commands frequently. This may result in a TON of queued messages for a deaf device, which may result in too much traffic when the device is finally contacted. - The better course of action seems to be to force users to run these same commands on the specific deaf devices. --- lib/Insteon.pm | 70 ++++++++++++-------------------------- lib/Insteon/BaseInsteon.pm | 29 ++++++++++------ 2 files changed, 40 insertions(+), 59 deletions(-) diff --git a/lib/Insteon.pm b/lib/Insteon.pm index 067a416e7..92bf173df 100755 --- a/lib/Insteon.pm +++ b/lib/Insteon.pm @@ -311,7 +311,7 @@ Resets the message stats back to 0 for this device. my (@_insteon_plm,@_insteon_device,@_insteon_link,@_scannable_link,$_scan_cnt,$_sync_cnt,$_sync_failure_cnt); my $init_complete; -my (@_scan_devices,@_scan_deaf_devices,@_scan_device_failures,$current_scan_device); +my (@_scan_devices,@_scan_device_failures,$current_scan_device); my (@_sync_devices,@_sync_device_failures,$current_sync_device); my ($_stress_test_count, $_stress_test_one_pass, @_stress_test_devices); my ($_ping_count, @_ping_devices); @@ -386,7 +386,6 @@ sub scan_all_linktables my @candidate_devices = (); # clear @_scan_devices @_scan_devices = (); - @_scan_deaf_devices = (); @_scan_device_failures = (); $current_scan_device = undef; # alwayws include the active interface (e.g., plm) @@ -395,12 +394,17 @@ sub scan_all_linktables push @candidate_devices, &Insteon::find_members("Insteon::BaseDevice"); # don't try to scan devices that are not responders - if (@candidate_devices) - { - foreach (@candidate_devices) - { + if (@candidate_devices) { + foreach (@candidate_devices) { my $candidate_object = $_; - if ($candidate_object->is_root and + if ($candidate_object->is_deaf){ + ::print_log("[Scan all linktables] INFO: !!! " + . $candidate_object->get_object_name + . " is deaf. To scan this object you" + . " must run 'Scan Link Table' on it" + . " directly."); + } + elsif ($candidate_object->is_root and !($candidate_object->isa('Insteon::InterfaceController'))) { push @_scan_devices, $candidate_object; @@ -408,16 +412,14 @@ sub scan_all_linktables . $candidate_object->get_object_name . " will be scanned.") if $candidate_object->debuglevel(1, 'insteon'); } - else - { + else { &main::print_log("[Scan all linktables] INFO: !!! " . $candidate_object->get_object_name . " is NOT a candidate for scanning."); } } } - else - { + else { &main::print_log("[Scan all linktables] WARN: No insteon devices could be found"); } $_scan_cnt = scalar @_scan_devices; @@ -453,22 +455,15 @@ sub _get_next_linkscan my($skip_unchanged, $changed_device) = @_; $current_scan_device = shift @_scan_devices; if ($current_scan_device) { - if ($current_scan_device->is_deaf){ - # Store deaf devices for scanning at the end - push(@_scan_deaf_devices, $current_scan_device); - &Insteon::_get_next_linkscan($skip_unchanged); - } - else { - ::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('.$skip_unchanged.')', - '&Insteon::_get_next_linkscan_failure('.$skip_unchanged.')', - $skip_unchanged); - } + ::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('.$skip_unchanged.')', + '&Insteon::_get_next_linkscan_failure('.$skip_unchanged.')', + $skip_unchanged); } else { ::print_log("[Scan all link tables] Completed scanning of all regular items."); @@ -480,27 +475,6 @@ sub _get_next_linkscan ::print_log("[Scan all link tables] WARN, unable to " ." complete a scan of the following devices: $obj_list"); } - if (scalar @_scan_deaf_devices){ - my $obj_list; - for my $deaf_obj (@_scan_deaf_devices){ - $obj_list .= $deaf_obj->get_object_name .", "; - } - ::print_log("[Scan all link tables] Will attempt to scan" - ." the following deaf devices the next time they" - ." wakeup: $obj_list"); - for my $deaf_obj (@_scan_deaf_devices){ - my $success_callback = "::print_log(qq|[Scan all". - " link tables] Delayed scan successfully". - " completed for: " . - $deaf_obj->get_object_name . "|)"; - my $failure_callback = "::print_log(qq|[Scan all". - " link tables] WARN: The delayed scan ". - " failed for: " . - $deaf_obj->get_object_name . "|)"; - $deaf_obj->scan_link_table($success_callback, - $failure_callback,$skip_unchanged); - } - } } } diff --git a/lib/Insteon/BaseInsteon.pm b/lib/Insteon/BaseInsteon.pm index 82570c398..eac142a2e 100644 --- a/lib/Insteon/BaseInsteon.pm +++ b/lib/Insteon/BaseInsteon.pm @@ -3145,7 +3145,13 @@ sub sync_links # Warn if device is deaf or ALDB out of sync my $insteon_object_is_syncable = 1; - if ($insteon_object->_aldb->health ne 'good' && $insteon_object->_aldb->health ne 'empty'){ + if ($insteon_object->is_deaf && $skip_deaf) { + ::print_log("[Insteon::BaseController] $self_link_name is deaf, only responder links will be added to devices " + ."controlled by this device. To sync links on this device, put it in awake mode and run the 'Sync Links' " + ."command on this specific device."); + $insteon_object_is_syncable = 0; + } + elsif ($insteon_object->_aldb->health ne 'good' && $insteon_object->_aldb->health ne 'empty'){ ::print_log("[Insteon::BaseController] WARN! The ALDB of $self_link_name is ".$insteon_object->_aldb->health .", links will be added to devices " ."linked to this device, but no links will be added to $self_link_name. Please rescan this device and attempt " @@ -3368,6 +3374,12 @@ sub _process_sync_queue { } else { ::print_log("[Insteon::BaseController] Completed sync links for: " .$self->get_object_name); + if ($$self{deaf_sync_queue_flag}){ + ::print_log("[Insteon::BaseController] Links on " + .$self->get_object_name . " will sync the next " + ."time the device is awake."); + $self->_process_deaf_sync_queue(); + } } } @@ -3382,21 +3394,16 @@ sub _build_deaf_sync_queue { my ($self, $link_req_ptr) = @_; my %link_req = %$link_req_ptr; my $self_link_name = $self->get_object_name; + $$self{deaf_sync_queue_flag} = 1; #Sync requests are pending %link_req = ( callback => "$self_link_name->_process_deaf_sync_queue()", failure_callback => "$self_link_name->_process_deaf_sync_queue_failure()"); push @{$$self{deaf_sync_queue}}, \%link_req; - if (!$$self{deaf_sync_queue_flag}){ - ::print_log("[Insteon::BaseController] Sync requests for " - .$self_link_name. " will not be processed until it is awake."); - $self->_process_deaf_sync_queue(); - } } sub _process_deaf_sync_queue { my ($self) = @_; my $num_sync_queue = @{$$self{deaf_sync_queue}}; if ($num_sync_queue) { - $$self{deaf_sync_queue_flag} = 1; #Sync requests are pending my $link_req_ptr = shift(@{$$self{deaf_sync_queue}}); my %link_req = %$link_req_ptr; my $link_member = $link_req{member}; @@ -3408,11 +3415,11 @@ sub _process_deaf_sync_queue { } } else { - ::print_log($self->get_object_name." completed the delayed " - ."sync links request"); + ::print_log("[Insteon::BaseController] Completed the delayed " + ."sync links request on " . $self->get_object_name); if ($$self{deaf_sync_queue_failure}) { - ::print_log("However, some failures occured while " - ."syncing links on " . $self->get_object_name); + ::print_log("[Insteon::BaseController] However, some " + ."failures occured."); } $$self{deaf_sync_queue_flag} = 0; $$self{deaf_sync_queue_failure} = 0; From 95db432a1d3fc812fcd4e0f08ff366bc8be94191 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 17 Apr 2014 20:28:52 -0700 Subject: [PATCH 114/180] Insteon: Allow Delete Orphans to Be Run on a Single Device. Using Delete Orphans on a single device is not generally advisable. Delete orphans works on the device level and not the link level, meaning it only cleans up a specific device, which may result in "half-links" Now, this shouldn't be too much of an issue for deaf devices as the batch command of Delete Orphans will allow "half links" to be created by deleting responder records from deaf devices. As a result, the command on a deaf device will simply clean up the half links. (I hope that makes sense) --- lib/Insteon/AllLinkDatabase.pm | 25 +++++++++++++++---------- lib/Insteon/BaseInsteon.pm | 4 ++-- 2 files changed, 17 insertions(+), 12 deletions(-) diff --git a/lib/Insteon/AllLinkDatabase.pm b/lib/Insteon/AllLinkDatabase.pm index b8bc0cd40..da816e5bc 100644 --- a/lib/Insteon/AllLinkDatabase.pm +++ b/lib/Insteon/AllLinkDatabase.pm @@ -435,19 +435,21 @@ scanned and processed. sub delete_orphan_links { - my ($self, $audit_mode, $failure_callback) = @_; + my ($self, $audit_mode, $failure_callback, $is_batch_mode) = @_; @{$$self{delete_queue}} = (); # reset the work queue $$self{delete_queue_processed} = 0; my $selfname = $$self{device}->get_object_name; # first, make sure that the health of ALDB is ok - if ($self->health ne 'good' || $$self{device}->is_deaf) { + if ($self->health ne 'good' || ($$self{device}->is_deaf && $is_batch_mode)) { my $sent_to_failure = 0; if ($$self{device}->is_deaf) { - ::print_log("[Insteon::AllLinkDatabase] Delete orphan links: Will not delete links on deaf device: $selfname"); + ::print_log("[Insteon::AllLinkDatabase] Will not delete ". + "links on deaf device: $selfname. Run 'Delete ". + "Orphan Links' directly on the device to do this."); } elsif ($self->health eq 'empty'){ - ::print_log("[Insteon::AllLinkDatabase] Delete orphan links: Skipping $selfname, because it has no links"); + ::print_log("[Insteon::AllLinkDatabase] Skipping $selfname, because it has no links"); } else { ::print_log("[Insteon::AllLinkDatabase] Delete orphan links: skipping $selfname because health: " @@ -464,7 +466,7 @@ sub delete_orphan_links } } if (!$$self{device}->isa('Insteon_PLM') && !$sent_to_failure){ - $self->_process_delete_queue(); + $self->_process_delete_queue($is_batch_mode); } return; } @@ -475,7 +477,7 @@ sub delete_orphan_links next LINKKEY if ($linkkey eq 'empty'); # Define delete request - my %delete_req = (callback => "$selfname->_aldb->_process_delete_queue()", + my %delete_req = (callback => "$selfname->_aldb->_process_delete_queue($is_batch_mode)", failure_callback => $failure_callback); # Delete duplicate entries @@ -661,12 +663,12 @@ sub delete_orphan_links ::print_log("[Insteon::AllLinkDatabase] ## Begin processing delete queue for: $selfname"); } if (!$$self{device}->isa('Insteon_PLM')) { - $self->_process_delete_queue(); + $self->_process_delete_queue($is_batch_mode); } } sub _process_delete_queue { - my ($self) = @_; + my ($self, $is_batch_mode) = @_; my $num_in_queue = @{$$self{delete_queue}}; if ($num_in_queue) { @@ -691,7 +693,9 @@ sub _process_delete_queue { { &::print_log("[Insteon::AllLinkDatabase] Nothing else to do for " . $$self{device}->get_object_name . " after deleting " . $$self{delete_queue_processed} . " links") if $self->{device}->debuglevel(1, 'insteon'); - $$self{device}->interface->_aldb->_process_delete_queue($$self{delete_queue_processed}); + if ($is_batch_mode){ + $$self{device}->interface->_aldb->_process_delete_queue($$self{delete_queue_processed}); + } } } @@ -2661,7 +2665,8 @@ sub _process_delete_queue { if ($delete_req{'root_object'}) { $$self{current_delete_device} = $delete_req{'root_object'}->get_object_name; - $delete_req{'root_object'}->delete_orphan_links(($delete_req{'audit_mode'}) ? 1 : 0, $failure_callback); + my $is_batch_mode = 1; + $delete_req{'root_object'}->delete_orphan_links(($delete_req{'audit_mode'}) ? 1 : 0, $failure_callback, $is_batch_mode); } else { diff --git a/lib/Insteon/BaseInsteon.pm b/lib/Insteon/BaseInsteon.pm index eac142a2e..b5ac971a5 100644 --- a/lib/Insteon/BaseInsteon.pm +++ b/lib/Insteon/BaseInsteon.pm @@ -2274,8 +2274,8 @@ does nothing. sub delete_orphan_links { - my ($self, $audit_mode, $failure_callback) = @_; - return $self->_aldb->delete_orphan_links($audit_mode, $failure_callback) if $self->_aldb; + my ($self, $audit_mode, $failure_callback, $is_batch_mode) = @_; + return $self->_aldb->delete_orphan_links($audit_mode, $failure_callback,$is_batch_mode) if $self->_aldb; } sub _process_delete_queue { From 56aecdeff10e2f495c133ff376a986f8c2344d75 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 17 Apr 2014 21:26:38 -0700 Subject: [PATCH 115/180] Insteon: Add Voice Commands for Deaf Devices Since batch commands will not work on deaf devices, needed to add two AUDIT commands Also add a Delete Orphans command --- lib/Insteon/BaseInsteon.pm | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/lib/Insteon/BaseInsteon.pm b/lib/Insteon/BaseInsteon.pm index b5ac971a5..2a497fada 100644 --- a/lib/Insteon/BaseInsteon.pm +++ b/lib/Insteon/BaseInsteon.pm @@ -925,6 +925,7 @@ sub _process_message } elsif ($msg{type} eq 'broadcast') { $self->devcat($msg{devcat}); $self->firmware($msg{firmware}); + $self->manual_awake(240); &::print_log("[Insteon::BaseObject] device category: $msg{devcat}" . " firmware: $msg{firmware} received for " . $self->{object_name}); } else { @@ -1139,6 +1140,14 @@ sub get_voice_cmds #here 'sync links' => $self->get_object_name . '->sync_links(0)' ); + # for deaf devices, the device level is the only version of sync links + # so add an audit command + if ($self->is_deaf && $self->is_root){ + %voice_cmds = ( + %voice_cmds, + '(AUDIT) sync links' => $self->get_object_name . '->sync_links(1)' + ); + } return \%voice_cmds; } @@ -2800,7 +2809,14 @@ sub get_voice_cmds 'run stress test' => "$object_name->stress_test(5)", 'run ping test' => "$object_name->ping(5)", 'log links' => "$object_name->log_alllink_table()" - ) + ); + if ($self->is_deaf){ + %voice_cmds = ( + %voice_cmds, + 'delete orphan links' => "$object_name->delete_orphan_links(0)", + '(AUDIT) delete orphan links' => "$object_name->delete_orphan_links(1)", + ); + } } return \%voice_cmds; } From 985581d4fbec89fc71b50e627c29e708dbee6175 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 17 Apr 2014 21:48:44 -0700 Subject: [PATCH 116/180] Insteon: Add voice commands for Deaf Devices; Monitor Mode Enabling Monitor Mode has other benefits. Adding it as a voice command option. Adding POD documentation for voice commands. --- lib/Insteon.pm | 71 ++++++++++++++++++++++++++++++++++++ lib/Insteon/BaseInsteon.pm | 1 + lib/Insteon/BaseInterface.pm | 4 +- 3 files changed, 75 insertions(+), 1 deletion(-) diff --git a/lib/Insteon.pm b/lib/Insteon.pm index 92bf173df..9792636f7 100755 --- a/lib/Insteon.pm +++ b/lib/Insteon.pm @@ -78,6 +78,10 @@ Deleting the orphan links will make your devices happier. If you have unintende links on your devices, they can run slower and may unnecessarily increase the number of messages sent on your network. +B This command will not run on deaf devices such as motion sensors or +remotelincs. These devices need to be "awake" to receive commands. So please +run this same command on deaf devices directly. + =item C Does the same thing as C but doesn't actually delete anything @@ -102,6 +106,10 @@ up. See the workflow described in C. +B This command will not run on deaf devices such as motion sensors or +remotelincs. These devices need to be "awake" to receive commands. So please +run this same command on deaf devices directly. + =item C Same as C but prints what it would do to the log, without doing @@ -134,6 +142,31 @@ Logs some details about each device to the log. See C =back +=item C + +Places the PLM into "Monitor Mode." The documentation is a little unclear on +what this does. In practice, this enables the PLM to receive B +messages from devices which are in the PLM's link database. So far, I have +encountered two important broadcast messages, 1) EZFlora (EZRain) can send +out broadcast messages whenever a valve changes state, 2) Each device will +send out a broadcast message whenever you hold down the set button for 10 +seconds. Within MisterHouse this message is used to mark a deaf device as +awake for 4 minutes. If Monitor Mode is not enabled, MisterHouse will not +see either of these messages. + +Please be warned, since the documentation is rather vague on what this setting +does, please consider this setting a B feature. Other users with other +setups or devices may discover problems with this setting, but at least for me +I do not see a downside to enabling this feature. + +=back + +=item C + +Disables B defined above. + +=back + =head3 Devices =over @@ -151,6 +184,11 @@ Turns the device off. Similar to C above, but this will only add links that are related to this device. Useful when adding a new device. +On deaf devices, this command will perform its tasks the next time the device +is awake. You can awaken a device temporarily by triggering it (walk in front +of a motion sensor, press a button on a remotelinc). Or you can place the +device in awake mode for a longer period of time. See B + =item C Will create the controller/responder links between the device and the PLM. @@ -300,6 +338,39 @@ controlled by MH and is not reset by calling C Resets the message stats back to 0 for this device. +=item C + +Flags the device as being awake for 4 minutes. Only applicable to deaf devices +such as motion sensors and remotelincs. You must first press and hold the set +button for 10 seconds on the device to put it into awake mode. Then tell +MisterHouse that you have done this by using this command. Alternatively, if +you enable B on the PLM, MisterHouse will see when you press the +set button of a device for ten seconds, and automatically mark it as awake for +you. + +=item C<(AUDIT) Sync Links> + +Only available on deaf devices such as motion sensors and remotelincs. Similar +to C above in the PLM, but this will only report links +that B be added to this device should you run B. + +=item C<(AUDIT) Delete Orphan Links> + +Only available on deaf devices such as motion sensors and remotelincs. Similar +to C above in the PLM, but this will only report links +that B be deleted from this device should you run B. + +=item C + +Only available on deaf devices such as motion sensors and remotelincs. Similar +to C above in the PLM, but this will only delete links +from this device that are unnecessary or no longer used. + +On deaf devices, this command will perform its tasks the next time the device +is awake. You can awaken a device temporarily by triggering it (walk in front +of a motion sensor, press a button on a remotelinc). Or you can place the +device in awake mode for a longer period of time. See B + =back =head2 METHODS diff --git a/lib/Insteon/BaseInsteon.pm b/lib/Insteon/BaseInsteon.pm index 2a497fada..11cd765b3 100644 --- a/lib/Insteon/BaseInsteon.pm +++ b/lib/Insteon/BaseInsteon.pm @@ -2815,6 +2815,7 @@ sub get_voice_cmds %voice_cmds, 'delete orphan links' => "$object_name->delete_orphan_links(0)", '(AUDIT) delete orphan links' => "$object_name->delete_orphan_links(1)", + 'mark as manually awake' => "$object_name->manual_awake(240)" ); } } diff --git a/lib/Insteon/BaseInterface.pm b/lib/Insteon/BaseInterface.pm index 79df66673..3ca403ea1 100644 --- a/lib/Insteon/BaseInterface.pm +++ b/lib/Insteon/BaseInterface.pm @@ -1017,7 +1017,9 @@ sub get_voice_cmds 'reset all message stats' => "Insteon::reset_all_message_stats", 'stress test ALL devices' => "Insteon::stress_test_all(5,1)", 'ping test ALL devices' => "Insteon::ping_all(5)", - 'log all device ALDB status' => "Insteon::log_all_ADLB_status" + 'log all device ALDB status' => "Insteon::log_all_ADLB_status", + 'enable monitor mode' => "$object_name->enable_monitor_mode(1)", + 'disable monitor mode' => "$object_name->enable_monitor_mode(0)", ); return \%voice_cmds; } From 8e00ab967af16c11367a3f38c1b8b33b8f1d25ca Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Fri, 18 Apr 2014 17:31:00 -0700 Subject: [PATCH 117/180] Insteon: Attempt to Reconnect PLM if it Appears to be Down - Add flag to track if a message sent to the PLM has been acknowledged by the PLM - On retry, if no receipt was acknowledged by the PLM, attempt to re-open the PLM serial port Should fix hollie/misterhouse#397 --- lib/Insteon/Message.pm | 24 ++++++++++++++++++++++++ lib/Insteon_PLM.pm | 37 +++++++++++++++++++++++++++++++++++++ 2 files changed, 61 insertions(+) diff --git a/lib/Insteon/Message.pm b/lib/Insteon/Message.pm index bb9c32f26..57b54d576 100644 --- a/lib/Insteon/Message.pm +++ b/lib/Insteon/Message.pm @@ -254,6 +254,10 @@ sub send if $self->setby->debuglevel(1, 'insteon'); $$self{no_hop_increase} = undef; } + + # If No PLM-Receipt has been received for this message + # then attempt to reconnect the PLM + $interface->serial_restart() unless $self->plm_receipt; } # need to set timeout as a function of retries; also need to alter hop count @@ -262,6 +266,10 @@ sub send $self->setby->outgoing_hop_count($self->setby->default_hop_count) if $self->setby->can('outgoing_hop_count'); } + + # Clear PLM-Receipt Flag + $self->plm_receipt(0); + $self->send_attempts($self->send_attempts + 1); $interface->_send_cmd($self, $self->send_timeout); if ($self->callback) @@ -327,6 +335,22 @@ sub to_string return $self->interface_data; } +=item C + +Used to track whether the PLM has acknowledged receiving this message, either +an ACK or NAK. This is used to determine situations in which the serial +connection to the PLM may have collapsed and may need to be restarted. + +=cut + +sub plm_receipt +{ + my ($self, $receipt) = @_; + $$self{plm_receipt} = $receipt if defined $receipt; + return $$self{plm_receipt}; +} + + =back =head2 INI PARAMETERS diff --git a/lib/Insteon_PLM.pm b/lib/Insteon_PLM.pm index 3021aff31..4b9686731 100644 --- a/lib/Insteon_PLM.pm +++ b/lib/Insteon_PLM.pm @@ -87,6 +87,25 @@ sub serial_startup { } +=item C + +Attempt to restart/reconnect the serial port connection. + +=cut + +sub serial_restart { + my ($self) = @_; + my $instance = $$self{port_name}; + my $PLM_use_tcp = $::config_parms{$instance . "_use_TCP"}; + + # TCP Port gets reconnected elsewhere + return if $PLM_use_tcp; + + ::print_log("[Insteon_PLM] WARN: The PLM did not respond to the last command." + ." The port may have closed, attempting to reopen the port."); + ::serial_port_open($instance); +} + =item C Instantiates a new object. @@ -620,6 +639,9 @@ sub _parse_data { # STEP 4b Is this a PLM Response to a command MH sent? if ($is_ack) { + #Note Receipt of PLM ACK + $pending_message->plm_receipt(1); + ::print_log( "[Insteon_PLM] DEBUG4:\n". Insteon::MessageDecoder::plm_decode($data)) if $debug_obj->debuglevel(4, 'insteon'); @@ -676,6 +698,9 @@ sub _parse_data { $data =~ s/^$ackcmd//; } elsif ($is_nack) { + #Note Receipt of PLM NAK + $pending_message->plm_receipt(1); + ::print_log( "[Insteon_PLM] DEBUG4:\n". Insteon::MessageDecoder::plm_decode($data)) if $debug_obj->debuglevel(4, 'insteon'); @@ -759,6 +784,9 @@ sub _parse_data { $data =~ s/^$nackcmd//; } elsif ($is_badcmd){ + #Note Receipt of PLM Bad Cmd + $pending_message->plm_receipt(1); + ::print_log( "[Insteon_PLM] DEBUG4:\n". Insteon::MessageDecoder::plm_decode($data)) if $debug_obj->debuglevel(4, 'insteon'); @@ -910,6 +938,9 @@ sub _parse_data { $data = substr($data, 12); } elsif ($record_type eq $prefix{all_link_record} and (length($data) >= 20)) { + #Note Receipt of PLM Response + $pending_message->plm_receipt(1); + #ALL-Link Record Response my $message_data = substr($data,4,16); &::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) @@ -962,6 +993,9 @@ sub _parse_data { $data = substr($data, 6); } elsif ($record_type eq $prefix{plm_info} and (length($data) >= 18)){ + #Note Receipt of PLM Response + $pending_message->plm_receipt(1); + ::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) if $self->debuglevel(4, 'insteon'); @@ -972,6 +1006,9 @@ sub _parse_data { $data = substr($data, 18); } elsif ($record_type eq $prefix{plm_get_config} and (length($data) >= 12)){ + #Note Receipt of PLM Response + $pending_message->plm_receipt(1); + ::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) if $self->debuglevel(4, 'insteon'); my $message_data = substr($data,4,8); From f547f938e03843b4bbccdb028987cc42c2dfd54e Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Fri, 18 Apr 2014 17:41:00 -0700 Subject: [PATCH 118/180] Insteon: Remove DeviceController Class Reorganize inheritance structure to be linear, rather than branched. We can likely merge BaseController down into BaseObject as well. --- lib/Insteon/BaseInsteon.pm | 121 +++++-------------------------------- lib/Insteon/Controller.pm | 3 +- lib/Insteon/Energy.pm | 10 ++- lib/Insteon/IOLinc.pm | 3 +- lib/Insteon/Irrigation.pm | 5 +- lib/Insteon/Lighting.pm | 35 ++++++----- lib/Insteon/Security.pm | 8 +-- lib/Insteon/Thermostat.pm | 4 +- 8 files changed, 43 insertions(+), 146 deletions(-) diff --git a/lib/Insteon/BaseInsteon.pm b/lib/Insteon/BaseInsteon.pm index 93cbc9e0d..176cc9e2d 100644 --- a/lib/Insteon/BaseInsteon.pm +++ b/lib/Insteon/BaseInsteon.pm @@ -11,7 +11,9 @@ In user code: =head2 DESCRIPTION -Generic class implementation of an Insteon Device. +Generic class implementation of an Insteon Object. This is inherited by all +insteon objects both real (SwitchLinc) and virtual (PLM Scene), with the +exception of the PLM itself, which does not inherit any of these functions. =head2 INHERITS @@ -1127,12 +1129,8 @@ sub get_voice_cmds { my ($self) = @_; my %voice_cmds = ( - #The Sync Links routine really resides in DeviceController, but that - #class seems a little redundant as in practice all devices are controllers - #in some sense. As a result, that class will likely be folded into - #BaseObject/Device at some future date. In order to avoid a bizarre - #inheritance of this routine by higher classes, this command was placed - #here + #The Sync Links routine really resides in BaseController, maybe move this + #there 'sync links' => $self->get_object_name . '->sync_links(0)' ); return \%voice_cmds; @@ -1249,7 +1247,10 @@ You should have received a copy of the GNU General Public License along with thi =head2 DESCRIPTION -Generic class implementation of a Base Insteon Device. +Generic class implementation of a Base Insteon Device such as a SwitchLinc. +This class is inherited by all physical Insteon devices with the +exception of the PLM itself, which does not inherit any of these functions. +These functions are also not inherited by virtual devices such as a PLM Scene. =head2 INHERITS @@ -1263,7 +1264,7 @@ L package Insteon::BaseDevice; -@Insteon::BaseDevice::ISA = ('Insteon::BaseObject'); +@Insteon::BaseDevice::ISA = ('Insteon::BaseController'); our %message_types = ( %Insteon::BaseObject::message_types, @@ -2809,9 +2810,6 @@ one group. This includes, KeyPadLincs, RemoteLincs, FanLincs, Thermostats Nothing. -This package is meant to provide supplemental support and should only be added -as a secondary inheritance to an object. - =head2 METHODS =over @@ -2948,7 +2946,8 @@ You should have received a copy of the GNU General Public License along with thi =head2 DESCRIPTION -Generic class implementation of an Insteon Controller. +Generic class implementation of an Insteon Controller, this is inherited by +both virtual (PLM Scene) and real (Switchlinc) objects. =head2 INHERITS @@ -2964,7 +2963,7 @@ package Insteon::BaseController; use strict; -@Insteon::BaseController::ISA = ('Generic_Item'); +@Insteon::BaseController::ISA = ('Insteon::BaseObject'); =item C @@ -3518,98 +3517,6 @@ You should have received a copy of the GNU General Public License along with thi =cut -#################################### -### ##################### -### DeviceController ############### -### ############### -#################################### - -=head1 B - -=head2 DESCRIPTION - -Generic class implementation of an Device Controller. - -=head2 INHERITS - -L - -=head2 METHODS - -=over - -=cut - -package Insteon::DeviceController; - -use strict; - -@Insteon::DeviceController::ISA = ('Insteon::BaseController'); - -=item C - -Instantiates a new object. - -=cut - -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; -} - -=item C - -Requests the current status of the device and calls C on the response. -This will trigger tied_events. - -=cut - -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); - } -} - -=back - -=head2 AUTHOR - -Gregg Liming / gregg@limings.net, Kevin Robert Keegan, Michael Stovenour - -=head2 LICENSE - -This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. - -You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. - -=cut - #################################### ### ############ ### InterfaceController ############ @@ -3620,7 +3527,7 @@ You should have received a copy of the GNU General Public License along with thi =head2 DESCRIPTION -Generic class implementation of an Interface Controller. These are the PLM Scenes. +Generic class implementation that supports PLM Scenes. =head2 INHERITS diff --git a/lib/Insteon/Controller.pm b/lib/Insteon/Controller.pm index f1ca08f7a..03d2ee285 100644 --- a/lib/Insteon/Controller.pm +++ b/lib/Insteon/Controller.pm @@ -41,7 +41,6 @@ must first be put into "awake mode." =head2 INHERITS L, -L, L =head2 METHODS @@ -55,7 +54,7 @@ package Insteon::RemoteLinc; use strict; use Insteon::BaseInsteon; -@Insteon::RemoteLinc::ISA = ('Insteon::BaseDevice','Insteon::DeviceController', 'Insteon::MultigroupDevice'); +@Insteon::RemoteLinc::ISA = ('Insteon::BaseDevice', 'Insteon::MultigroupDevice'); my %message_types = ( %Insteon::BaseDevice::message_types, diff --git a/lib/Insteon/Energy.pm b/lib/Insteon/Energy.pm index 496410eb6..ab30362d8 100644 --- a/lib/Insteon/Energy.pm +++ b/lib/Insteon/Energy.pm @@ -53,8 +53,7 @@ it may require a factory reset. =head2 INHERITS -L, -L +L =head2 METHODS @@ -67,7 +66,7 @@ use Insteon::BaseInsteon; package Insteon::SynchroLinc; -@Insteon::SynchroLinc::ISA = ('Insteon::BaseDevice','Insteon::DeviceController'); +@Insteon::SynchroLinc::ISA = ('Insteon::BaseDevice'); =item C @@ -414,8 +413,7 @@ the following examples: =head2 INHERITS -L, -L +L =head2 METHODS @@ -428,7 +426,7 @@ use Insteon::BaseInsteon; package Insteon::iMeter; -@Insteon::iMeter::ISA = ('Insteon::BaseDevice','Insteon::DeviceController'); +@Insteon::iMeter::ISA = ('Insteon::BaseDevice'); =item C diff --git a/lib/Insteon/IOLinc.pm b/lib/Insteon/IOLinc.pm index 9505c97e6..e95490ba4 100755 --- a/lib/Insteon/IOLinc.pm +++ b/lib/Insteon/IOLinc.pm @@ -85,7 +85,6 @@ in the definition may be enough to make it work, I don't yet know. =head2 INHERITS L, -L =head2 METHODS @@ -98,7 +97,7 @@ use Insteon::BaseInsteon; package Insteon::IOLinc; -@Insteon::IOLinc::ISA = ('Insteon::BaseDevice', 'Insteon::DeviceController'); +@Insteon::IOLinc::ISA = ('Insteon::BaseDevice'); my %operating_flags = ( 'program_lock_on' => '00', diff --git a/lib/Insteon/Irrigation.pm b/lib/Insteon/Irrigation.pm index fe7ca00d5..295a940ba 100755 --- a/lib/Insteon/Irrigation.pm +++ b/lib/Insteon/Irrigation.pm @@ -45,8 +45,7 @@ Provides basic support for the EzFlora (aka EzRain) sprinkler controller. =head2 INHERITS -L, -L +L =head2 METHODS @@ -59,7 +58,7 @@ use Insteon::BaseInsteon; package Insteon::Irrigation; -@Insteon::Irrigation::ISA = ('Insteon::BaseDevice','Insteon::DeviceController'); +@Insteon::Irrigation::ISA = ('Insteon::BaseDevice'); our %message_types = ( %Insteon::BaseDevice::message_types, diff --git a/lib/Insteon/Lighting.pm b/lib/Insteon/Lighting.pm index 9cbb76b39..ae245bd9b 100644 --- a/lib/Insteon/Lighting.pm +++ b/lib/Insteon/Lighting.pm @@ -464,7 +464,6 @@ Provides support for the Insteon ApplianceLinc. =head2 INHERITS L -L =head2 METHODS @@ -477,7 +476,7 @@ package Insteon::ApplianceLinc; use strict; use Insteon::BaseInsteon; -@Insteon::ApplianceLinc::ISA = ('Insteon::BaseLight','Insteon::DeviceController'); +@Insteon::ApplianceLinc::ISA = ('Insteon::BaseLight'); =item C @@ -530,7 +529,7 @@ Provides support for the Insteon LampLinc. =head2 INHERITS L, -L + =head2 METHODS @@ -543,7 +542,7 @@ package Insteon::LampLinc; use strict; use Insteon::BaseInsteon; -@Insteon::LampLinc::ISA = ('Insteon::DimmableLight','Insteon::DeviceController'); +@Insteon::LampLinc::ISA = ('Insteon::DimmableLight'); =item C @@ -596,7 +595,7 @@ Provides support for the Insteon SwitchLinc Relay. =head2 INHERITS L, -L + =head2 METHODS @@ -609,7 +608,7 @@ package Insteon::SwitchLincRelay; use strict; use Insteon::BaseInsteon; -@Insteon::SwitchLincRelay::ISA = ('Insteon::BaseLight','Insteon::DeviceController'); +@Insteon::SwitchLincRelay::ISA = ('Insteon::BaseLight'); =item C @@ -693,7 +692,7 @@ Provides support for the Insteon SwitchLinc. =head2 INHERITS L, -L + =head2 METHODS @@ -706,7 +705,7 @@ package Insteon::SwitchLinc; use strict; use Insteon::BaseInsteon; -@Insteon::SwitchLinc::ISA = ('Insteon::DimmableLight','Insteon::DeviceController'); +@Insteon::SwitchLinc::ISA = ('Insteon::DimmableLight'); =item C @@ -763,7 +762,7 @@ Provides support for the Insteon KeypadLinc Relay. =head2 INHERITS L, -L, +, L =head2 METHODS @@ -777,7 +776,7 @@ package Insteon::KeyPadLincRelay; use strict; use Insteon::BaseInsteon; -@Insteon::KeyPadLincRelay::ISA = ('Insteon::BaseLight','Insteon::DeviceController', 'Insteon::MultigroupDevice'); +@Insteon::KeyPadLincRelay::ISA = ('Insteon::BaseLight', 'Insteon::MultigroupDevice'); our %operating_flags = ( 'program_lock_on' => '00', @@ -1151,7 +1150,7 @@ Provides support for the Insteon KeypadLinc. =head2 INHERITS L, -L + =head2 METHODS @@ -1164,7 +1163,7 @@ package Insteon::KeyPadLinc; use strict; use Insteon::BaseInsteon; -@Insteon::KeyPadLinc::ISA = ('Insteon::KeyPadLincRelay', 'Insteon::DimmableLight','Insteon::DeviceController'); +@Insteon::KeyPadLinc::ISA = ('Insteon::KeyPadLincRelay', 'Insteon::DimmableLight'); =item C @@ -1227,7 +1226,7 @@ Provides support for the Insteon Micro On/Off Module. =head2 INHERITS L, -L + =head2 METHODS @@ -1240,7 +1239,7 @@ package Insteon::MicroSwitchRelay; use strict; use Insteon::BaseInsteon; -@Insteon::MicroSwitchRelay::ISA = ('Insteon::BaseLight','Insteon::DeviceController'); +@Insteon::MicroSwitchRelay::ISA = ('Insteon::BaseLight'); =item C @@ -1500,7 +1499,7 @@ Provides support for the Insteon Micro Dimmer Module. =head2 INHERITS L, -L + =head2 METHODS @@ -1513,7 +1512,7 @@ package Insteon::MicroSwitch; use strict; use Insteon::BaseInsteon; -@Insteon::MicroSwitch::ISA = ('Insteon::MicroSwitchRelay', 'Insteon::DimmableLight','Insteon::DeviceController'); +@Insteon::MicroSwitch::ISA = ('Insteon::MicroSwitchRelay', 'Insteon::DimmableLight'); =item C @@ -1568,7 +1567,7 @@ Provides support for the Insteon FanLinc. =head2 INHERITS L, -L, +, L =head2 METHODS @@ -1582,7 +1581,7 @@ package Insteon::FanLinc; use strict; use Insteon::BaseInsteon; -@Insteon::FanLinc::ISA = ('Insteon::DimmableLight','Insteon::DeviceController', 'Insteon::MultigroupDevice'); +@Insteon::FanLinc::ISA = ('Insteon::DimmableLight', 'Insteon::MultigroupDevice'); =item C diff --git a/lib/Insteon/Security.pm b/lib/Insteon/Security.pm index cdd325efd..16fc64e82 100644 --- a/lib/Insteon/Security.pm +++ b/lib/Insteon/Security.pm @@ -95,7 +95,6 @@ certain threshold. =head2 INHERITS L, -L =head2 METHODS @@ -108,7 +107,7 @@ package Insteon::MotionSensor; use strict; use Insteon::BaseInsteon; -@Insteon::MotionSensor::ISA = ('Insteon::BaseDevice', 'Insteon::DeviceController'); +@Insteon::MotionSensor::ISA = ('Insteon::BaseDevice'); =item C @@ -718,8 +717,7 @@ expense of additional battery usage. =head2 INHERITS -L, -L +L =head2 METHODS @@ -732,7 +730,7 @@ package Insteon::TriggerLinc; use strict; use Insteon::BaseInsteon; -@Insteon::TriggerLinc::ISA = ('Insteon::BaseDevice','Insteon::DeviceController'); +@Insteon::TriggerLinc::ISA = ('Insteon::BaseDevice'); my %message_types = ( %Insteon::BaseDevice::message_types diff --git a/lib/Insteon/Thermostat.pm b/lib/Insteon/Thermostat.pm index 979d00742..39d40be3f 100755 --- a/lib/Insteon/Thermostat.pm +++ b/lib/Insteon/Thermostat.pm @@ -150,8 +150,6 @@ Kevin Robert Keegan =head1 INHERITS -B - B =head1 Methods @@ -165,7 +163,7 @@ package Insteon::Thermostat; use strict; use Insteon::BaseInsteon; -@Insteon::Thermostat::ISA = ('Insteon::BaseDevice','Insteon::DeviceController'); +@Insteon::Thermostat::ISA = ('Insteon::BaseDevice'); # -------------------- START OF SUBROUTINES -------------------- From 531bc69089e6eadaefa104217df2310e28ca3364 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Fri, 18 Apr 2014 21:21:25 -0700 Subject: [PATCH 119/180] AD2: Fix Errors in Alpha Fault Processing; Add Better Notes; Fix Bug in Partition Checking for faults using the Alphanumeric messages is really complicated. The concept sounds simple, but building a test that doesn't get confused is difficult. I think this current system is more accurate, but a little slower to move from fault->ready. I added a lot more comments to explain my logic since code alone is not really enough. Also fixed a error in the partition child. --- lib/AD2.pm | 88 +++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 68 insertions(+), 20 deletions(-) diff --git a/lib/AD2.pm b/lib/AD2.pm index 56cf4cff2..1adfdf978 100755 --- a/lib/AD2.pm +++ b/lib/AD2.pm @@ -107,6 +107,18 @@ See AD2_Partition See AD2_Item +=head2 NOTES + +Hardwired zones are difficult for us to deal with. Due to their nature, the +AD2 board only receives Alphanumberic fault messages for these zones and never +receives ready messages. Due to the way these Alphanumeric fault messages +cycle around, the resetting of a hardwired zone from fault to ready may take +a bit longer then expected. Additionally, in certain circumstances a hardwired +zone will be reset from fault to ready improperly, it will be tripped back to +fault a few seconds later. The only way to avoid these annoyances is to map +your hardwired zones to fake relays. See the discussion of B +in the AD2_Item documentation below. + =head2 TODO - Add support for control of emulated zones on the AD2 device. Would allow @@ -449,27 +461,57 @@ sub CheckCmd { elsif ($status_type->{fault}) { #Loop through partions set in message foreach my $partition (@partitions){ - #If zone numbers are sequential, there is nothing to do. - #Reset the zones between the current zone and the last zone. - #Do not reset mapped zones, specific messages are recevied for these - #If the current zone is lower than the previous zone, only reset zones - #in between if highest zone has remained constant for one full cycle - if ($zone_no_pad - $self->{zone_last_num}{$partition} != 1) { - if (($self->{zone_last_num}{$partition} <= $zone_no_pad) && - $self->{highest_zone}{$partition} != $self->{zone_last_num}{$partition}){ - $self->{highest_zone}{$partition} = $zone_no_pad; - # Do not reset the zones in between. This is a new highest zone - # number. Can't be sure if the zone list completed a full cycle + #Parsing Alpha Fault messages is difficult. Only fault messages are + #reported, no per zone ready messages. Fault messages cycle through + #from lowest to highest. However, a new fault is immediately reported + #and the cycle then starts from the bottom again. + + #This means, that we can immediately set zones to fault. But to return + #to ready, we basically need the the highest and lowest zones to + #remain constant for one cycle before chaning all other zones back + #to ready. This works reasonable well, although there can be a big + #delay in returning a zone to ready. Additionally, in certain + #circumstances, a zone may be improperly returned to ready. + + #We do not mess with mapped zones, specific direct messages are + #recevied for these (luckily) + + #Setup variables for testing of cycle first + if ($zone_no_pad < $self->{zone_last_num}{$partition}){ + #This zone is lower than the last zone reported. + if($zone_no_pad == $self->{lowest_zone}{$partition}){ + #Same lowest zone as last time + $self->{lowest_zone_unchanged}{$partition} = 1; + } + else { + #New lowest zone, is at least a new cycle, could be new fault + $self->{lowest_zone}{$partition} = $zone_no_pad; + $self->{lowest_zone_unchanged}{$partition} = 0; + } + #Now examine previous zone, it becomes new highest zone + if($self->{zone_last_num}{$partition} == $self->{highest_zone}{$partition}){ + #Same highest zone as last time + $self->{highest_zone_unchanged}{$partition} = 1; } else { - $self->ChangeZones( $self->{zone_last_num}{$partition}+1, - $zone_no_pad-1, "ready", "bypass", 1, $partition,1); - $self->{highest_zone}{$partition} = $zone_no_pad - if ($self->{zone_last_num}{$partition} <= $zone_no_pad); + #New highest zone, is at least a new cycle, could be new fault + $self->{highest_zone}{$partition} = $self->{zone_last_num}{$partition}; + $self->{highest_zone_unchanged}{$partition} = 0; } } + + #If cycle is still consistent, then reset all zones between reported + #faults. Obviously skip this if the zones are sequentially increasing + #since there are no zones in between. + if ($self->{highest_zone_unchanged}{$partition} + && $self->{lowest_zone_unchanged}{$partition} + && (($zone_no_pad - $self->{zone_last_num}{$partition}) != 1)) { + #Reset the zones between the current zone and the last zone. + $self->ChangeZones( $self->{zone_last_num}{$partition}+1, + $zone_no_pad-1, "ready", "bypass", 1, $partition,1); + } - # Set this zone to faulted + # Always set the reported zone to fault $self->ChangeZones( $zone_no_pad, $zone_no_pad, "fault", "", 1); # Store Zone Number for Use in Fault Loop @@ -837,7 +879,7 @@ sub ChangeZones { if defined $$self{zone_object}{"$i"}; my $zone_partition = $self->zone_partition($i); my $partition_status = $self->status_partition($zone_partition); - $$self{partition_object}{$zone_partition}->set($partition_status, $$self{zone_object}{"$i"}) + $$self{partition_object}{$zone_partition}->set_receive($partition_status, $$self{zone_object}{"$i"}) if defined $$self{partition_object}{$zone_partition}; } $y++; @@ -985,7 +1027,6 @@ sub cmd { ::logit("Invalid password for command $CmdName ($password)"); return; } - $self->debug_log(">>> Sending to ADEMCO panel $CmdName ($cmd)"); $self->{keys_sent} = $self->{keys_sent} + length($CmdStr); if (defined $Socket_Items{$instance}) { @@ -1019,7 +1060,9 @@ sub set { my $instance = $$self{instance}; $p_state = lc($p_state); my $cmd = ( exists $self->{CmdMsg}->{$p_state} ) ? $self->{CmdMsg}->{$p_state} : $p_state; - +::print_log("AD2 ------------"); +use Carp; +print Carp::longmess; $self->debug_log(">>> Sending to ADEMCO panel $p_state ($cmd)"); $self->{keys_sent} = $self->{keys_sent} + length($cmd); if (defined $Socket_Items{$instance}) { @@ -1616,7 +1659,7 @@ sub set { } if ($found_state){ ::print_log("[AD2::Partition] Received request to " - . $p_state . " for parition " . $self->get_object_name); + . $p_state . " for partition " . $self->get_object_name); $$self{interface}->cmd($p_state); } else { @@ -1624,6 +1667,11 @@ sub set { } } +sub set_receive { + my ($self, $p_state, $p_setby, $p_response) = @_; + return $self->SUPER::set($p_state, $p_setby, $p_response); +} + =back =head1 B From 72980f8ac9c44d1a3cf15b5f42116e4e663b307b Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 19 Apr 2014 17:06:40 -0700 Subject: [PATCH 120/180] Add Serial_Port_Close Routine; Insteon Close Serial Port Before Restarting Add simple routine to mh "binary" that closes the serial port in the manner recommended by the Device::Serial_Port documentation. Change Insteon_PLM serial port restart routine to close the port before re-creating it --- bin/mh | 13 +++++++++++++ lib/Insteon_PLM.pm | 11 ++++++++++- 2 files changed, 23 insertions(+), 1 deletion(-) diff --git a/bin/mh b/bin/mh index 275842e31..b62216e8c 100755 --- a/bin/mh +++ b/bin/mh @@ -5702,6 +5702,19 @@ sub serial_port_open { # print "np=@serial_parms\n"; } +sub serial_port_close { + my ($name) = @_; + my $port = $Serial_Ports{$name}{port}; + + # Recommended Steps to Close a Serial Port from CPAN + $Serial_Ports{$name}{object}->close() || ::print_log("[Insteon_PLM] Close of serial port failed."); + undef $Serial_Ports{$name}{object}; + + # Remove all references in Global Vars + delete $Serial_Ports{object_by_port}{$port}; + delete $Serial_Ports{$name}; +} + sub set_sun_time { my @parms = (latitude => $config_parms{latitude}, longitude => $config_parms{longitude}, diff --git a/lib/Insteon_PLM.pm b/lib/Insteon_PLM.pm index 4b9686731..806594ef9 100644 --- a/lib/Insteon_PLM.pm +++ b/lib/Insteon_PLM.pm @@ -103,7 +103,16 @@ sub serial_restart { ::print_log("[Insteon_PLM] WARN: The PLM did not respond to the last command." ." The port may have closed, attempting to reopen the port."); - ::serial_port_open($instance); + + #prep vars + my $port = $::config_parms{$instance . "_serial_port"}; + my $speed = 19200; + + #close the port + ::serial_port_close($instance); + + #Try and open it again + ::serial_port_create($instance, $port, $speed,'none','raw'); } =item C From 1fddaeedf491279aa221a8ee928fadc43e91c454 Mon Sep 17 00:00:00 2001 From: jsiddall Date: Tue, 29 Apr 2014 20:37:15 -0400 Subject: [PATCH 121/180] Add Parport_Item.pm --- lib/Parport_Item.pm | 158 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 158 insertions(+) create mode 100755 lib/Parport_Item.pm diff --git a/lib/Parport_Item.pm b/lib/Parport_Item.pm new file mode 100755 index 000000000..97aee5eff --- /dev/null +++ b/lib/Parport_Item.pm @@ -0,0 +1,158 @@ +=head1 B + +=head2 SYNOPSIS + +Item which follows digital logic state on standard PC parallel port inputs. + +Each item should be defined with a pin number and description. + +Example: + + use Parport_Item; + $input1 = new Parport_Item('10', 'Test device on DB25 pin 10'); + + print "Parallel port pin 10 now $state\n" if $state = state_now $input1; + +=head2 DESCRIPTION + +All inputs are pulled high in a typical parallel port (+5 V) when disconnected/open. The item is considered on if the voltage is +5 V (logic high) and off if voltage is 0 V (logic low). Also note that even for those bits that would normally be inverted in the register (ex: pin 11, nBUSY) are are automatically uninverted such that all inputs work the same. + +Currently a parallel port item only supports the 5 input pins (DB25 pins 10, 11, 12, 13, and 15). + +For a description of the various pins see http://en.wikipedia.org/wiki/Parallel_port + +Currently the item tries to automatically determine the correct driver, and will default to the first port. This means it should work cross platform but has not been tested on any platform other than Linux + +=head2 INHERITS + +B + +=cut + + +#!/usr/bin/perl + +use Device::ParallelPort; +use strict; + +package Parport_Item; + +my $parport; +my $parport_uninitialized = 1; +my @Parport_Items; +my %input_pin_to_bit = ( + '10'=>'14', + '11'=>'15', + '12'=>'13', + '13'=>'12', + '15'=>'11' +); + +@Parport_Item::ISA = ('Generic_Item'); + +# Add a hook so this gets initialized at startup/reload (note: for serial items the startup sub gets called automatically) +&main::Reload_post_add_hook(\&Parport_Item::startup, 'persistent'); + +=head2 METHODS + +=over + +=item C + +=cut + +sub startup { + if ($parport_uninitialized) + { + $parport = Device::ParallelPort->new('auto:0'); + $parport_uninitialized = 0; + &::MainLoop_pre_add_hook(\&Parport_Item::get_pin_state, 'persistent'); + } +} + + +=item C + +=cut + +sub new +{ + my ($class, $pin, $logic_level_for_on, $description) = @_; + if (exists($input_pin_to_bit{$pin})) + { + my $self={}; + bless $self,$class; + $$self{'pin'} = $pin; + $$self{'description'} = $description; + $$self{state} = undef; + $$self{said} = undef; + $$self{state_now} = undef; + $$self{state_changed} = undef; + push @Parport_Items, $self; + push(@{$$self{states}}, 'on', 'off'); + + return $self; + } else + { + &main::print_log("Parport_Item: ERROR: Unsupported pin ($pin) for $description"); + die "Parport_Item: ERROR: Unsupported pin ($pin) for $description"; + } +} + + +=item C + +=cut + +sub get_pin_state { + # Check the state of input pins 10 times per second. This should be adequate for general use but the holdoff can be eliminated if fastest response is required. + if ($::New_Msecond_100) + { + foreach my $item (@Parport_Items) + { + my $pin = $item->{'pin'}; + + my $pin_state = $parport->get_bit($input_pin_to_bit{$pin}); + + # Only make an update if the state changed + # The register value for pin 11 (BUSY) is inverted so un-invert the logic here + if (($item->{'state'} eq 'on') && ((($pin eq '11') && ($pin_state == '1')) || ($pin_state == '0'))) + { + &Generic_Item::set_states_for_next_pass($item, 'off', 'Parallel Port'); + } elsif (($item->{'state'} eq 'off') && ((($pin eq '11') && ($pin_state == '0')) || ($pin_state == '1'))) + { + &Generic_Item::set_states_for_next_pass($item, 'on', 'Parallel Port'); + } + } + } +} + + +=back + +=head2 DEPENDENCIES: + +This code depends on the Perl modules C and may require C or C depending on your platform. These modules are available from CPAN. + +=head2 INI PARAMETERS + +NONE + +=head2 AUTHOR + +Jeff Siddall (news@siddall.name) + +=head2 SEE ALSO + +NONE + +=head2 LICENSE + +This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. + +This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + +=cut + From 61c8696c75c0ae3c69d8c47c84b1f710d65062c7 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Wed, 7 May 2014 17:13:35 -0700 Subject: [PATCH 122/180] Insteon: Add User Friendly Message when Responder Link Missing; Fix is_deaf crash Closes hollie/misterhouse#404 --- lib/Insteon/BaseInterface.pm | 28 +++++++++++++++++----------- 1 file changed, 17 insertions(+), 11 deletions(-) diff --git a/lib/Insteon/BaseInterface.pm b/lib/Insteon/BaseInterface.pm index 3ca403ea1..cb49b427d 100644 --- a/lib/Insteon/BaseInterface.pm +++ b/lib/Insteon/BaseInterface.pm @@ -661,41 +661,47 @@ sub on_standard_insteon_received } elsif ($msg{type} eq 'cleanup') { - my $setby_object = $object; - $object = &Insteon::get_object('000000', $msg{extra}); - if ($object) + my $group_object = &Insteon::get_object('000000', $msg{extra}); + if ($group_object) { # prevent re-processing transmit queue until after clearing occurs $self->transmit_in_progress(1); # Don't clear active message as ACK is only one of many if (($msg{extra} == $self->active_message->setby->group)){ &main::print_log("[Insteon::BaseInterface] DEBUG3: Cleanup message received for scene " - . $object->get_object_name . " from " . $setby_object->get_object_name) - if $object->debuglevel(3, 'insteon'); + . $group_object->get_object_name . " from " . $object->get_object_name) + if $group_object->debuglevel(3, 'insteon'); } elsif ($self->active_message->command_type eq 'all_link_direct_cleanup' && lc($self->active_message->setby->device_id) eq $msg{source}) { - &::print_log("[Insteon::BaseInterface] DEBUG2: ALL-Linking Direct Completed with ". $self->active_message->setby->get_object_name) if $object->debuglevel(2, 'insteon'); + &::print_log("[Insteon::BaseInterface] DEBUG2: ALL-Linking Direct Completed with ". $self->active_message->setby->get_object_name) if $group_object->debuglevel(2, 'insteon'); $self->clear_active_message(); } else { &main::print_log("[Insteon::BaseInterface] DEBUG3: Cleanup message received from " - . $setby_object->get_object_name . " for scene " - . $object->get_object_name . ", but group in recent message " + . $object->get_object_name . " for scene " + . $group_object->get_object_name . ", but group in recent message " . $msg{extra}. " did not match group in " . "prior sent message group " . $self->active_message->setby->group) - if $object->debuglevel(3, 'insteon'); + if $group_object->debuglevel(3, 'insteon'); } # If ACK or NACK received then PLM is still working on the ALL Link Command # Increase the command timeout to wait for next one $self->_set_timeout('command', 3000); } + elsif ($msg{is_nack} && lc($msg{extra}) eq 'ff'){ + ::print_log("[Insteon::BaseInterface] ERROR: " . $object->get_object_name + . " does not have a responder record for the most recent command" + . " sent by the PLM. Try scanning " . $object->get_object_name + . " and then running 'sync links' on the most recently used " + . " PLM Scene."); + } else { &main::print_log("[Insteon::BaseInterface] ERROR: received cleanup message from " - . $setby_object->get_object_name . " that does not correspond to a valid PLM group. Corrupted message is assumed " + . $object->get_object_name . " that does not correspond to a valid PLM group. Corrupted message is assumed " . "and will be skipped! Was group " . $msg{extra}); - $setby_object->corrupt_count_log(1) if $setby_object->can('corrupt_count_log'); + $object->corrupt_count_log(1) if $object->can('corrupt_count_log'); } } else #not direct or cleanup From 98e9a54fff4679ed3f03649c2b00902c7b49faa3 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Wed, 7 May 2014 17:17:49 -0700 Subject: [PATCH 123/180] AD2: Remove Debug Testing Line --- lib/AD2.pm | 3 --- 1 file changed, 3 deletions(-) diff --git a/lib/AD2.pm b/lib/AD2.pm index 1adfdf978..c8aaff163 100755 --- a/lib/AD2.pm +++ b/lib/AD2.pm @@ -1060,9 +1060,6 @@ sub set { my $instance = $$self{instance}; $p_state = lc($p_state); my $cmd = ( exists $self->{CmdMsg}->{$p_state} ) ? $self->{CmdMsg}->{$p_state} : $p_state; -::print_log("AD2 ------------"); -use Carp; -print Carp::longmess; $self->debug_log(">>> Sending to ADEMCO panel $p_state ($cmd)"); $self->{keys_sent} = $self->{keys_sent} + length($cmd); if (defined $Socket_Items{$instance}) { From b79f0e071f32470ddd48421637f8d70699c4d1fb Mon Sep 17 00:00:00 2001 From: Lieven Hollevoet Date: Sun, 11 May 2014 10:49:48 +0200 Subject: [PATCH 124/180] Fixes all defined(@array) entries in the lib code, except the site folder according to #406 --- lib/Generic_Item.pm | 2 +- lib/HomeBase.pm | 4 ++-- lib/Insteon/BaseInsteon.pm | 2 +- lib/Stargate.pm | 4 ++-- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/lib/Generic_Item.pm b/lib/Generic_Item.pm index ccf012947..01a143106 100644 --- a/lib/Generic_Item.pm +++ b/lib/Generic_Item.pm @@ -901,7 +901,7 @@ TODO sub get_fp_location { my ($self) = @_; - if (! defined @{$$self{location}} ) { return } + if (! @{$$self{location}} ) { return } return @{$$self{location}}; } diff --git a/lib/HomeBase.pm b/lib/HomeBase.pm index 5ae7d03e6..ee06e485b 100644 --- a/lib/HomeBase.pm +++ b/lib/HomeBase.pm @@ -137,7 +137,7 @@ sub read_flags { $flags = substr($flags, 2); } } - print "Homebase did not respond to read_flags request\n" unless defined @flags; + print "Homebase did not respond to read_flags request\n" unless @flags; return @flags; } else { @@ -160,7 +160,7 @@ sub read_variables { @vars = split /\r\n/, $buffer; my $count = @vars; print "$count HomeBase var records were read\n"; - print "Homebase did not respond to read_flags request\n" unless defined @vars; + print "Homebase did not respond to read_flags request\n" unless @vars; return @vars; } else { diff --git a/lib/Insteon/BaseInsteon.pm b/lib/Insteon/BaseInsteon.pm index 948ef3288..9ff1d1792 100644 --- a/lib/Insteon/BaseInsteon.pm +++ b/lib/Insteon/BaseInsteon.pm @@ -275,7 +275,7 @@ sub default_hop_count if (defined($hop_count)){ ::print_log("[Insteon::BaseObject] DEBUG3: Adding hop count of " . $hop_count . " to hop_array of " . $self->get_object_name) if $self->debuglevel(3, 'insteon'); - if (!defined(@{$$self{hop_array}})) { + if (!(@{$$self{hop_array}})) { unshift(@{$$self{hop_array}}, $$self{default_hop_count}); $$self{hop_sum} = $$self{default_hop_count}; } diff --git a/lib/Stargate.pm b/lib/Stargate.pm index 2c5ce2e5e..42d5084f9 100644 --- a/lib/Stargate.pm +++ b/lib/Stargate.pm @@ -1031,7 +1031,7 @@ sub read_flags $flags = substr($flags, 2); } } - print "Stargate did not respond to read_flags request\n" unless defined @flags; + print "Stargate did not respond to read_flags request\n" unless @flags; return @flags; } else @@ -1110,7 +1110,7 @@ sub read_variables @vars = split /\r\n/, $buffer; my $count = @vars; print "$count Stargate var records were read\n"; - print "Stargate did not respond to read_variables request\n" unless defined @vars; + print "Stargate did not respond to read_variables request\n" unless @vars; return @vars; } else From 6ed5832f6a127dcd4c70157458a90ec6071e6e9a Mon Sep 17 00:00:00 2001 From: Lieven Hollevoet Date: Mon, 12 May 2014 08:00:48 +0200 Subject: [PATCH 125/180] Additional fix based in feedback from @JaredF --- lib/Insteon/BaseInsteon.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Insteon/BaseInsteon.pm b/lib/Insteon/BaseInsteon.pm index 9ff1d1792..959149f94 100644 --- a/lib/Insteon/BaseInsteon.pm +++ b/lib/Insteon/BaseInsteon.pm @@ -275,7 +275,7 @@ sub default_hop_count if (defined($hop_count)){ ::print_log("[Insteon::BaseObject] DEBUG3: Adding hop count of " . $hop_count . " to hop_array of " . $self->get_object_name) if $self->debuglevel(3, 'insteon'); - if (!(@{$$self{hop_array}})) { + if (defined $$self->{hop_array} && !(@{$$self{hop_array}})) { unshift(@{$$self{hop_array}}, $$self{default_hop_count}); $$self{hop_sum} = $$self{default_hop_count}; } From 3e7ddafbdc3f8195482ba048ccdd6f7f9074bfde Mon Sep 17 00:00:00 2001 From: Lieven Hollevoet Date: Mon, 12 May 2014 09:33:23 +0200 Subject: [PATCH 126/180] Applied patch from @JaredF --- lib/Insteon/BaseInsteon.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Insteon/BaseInsteon.pm b/lib/Insteon/BaseInsteon.pm index 959149f94..fa4b3a075 100644 --- a/lib/Insteon/BaseInsteon.pm +++ b/lib/Insteon/BaseInsteon.pm @@ -275,7 +275,7 @@ sub default_hop_count if (defined($hop_count)){ ::print_log("[Insteon::BaseObject] DEBUG3: Adding hop count of " . $hop_count . " to hop_array of " . $self->get_object_name) if $self->debuglevel(3, 'insteon'); - if (defined $$self->{hop_array} && !(@{$$self{hop_array}})) { + if ($$self{hop_array} && !(@{$$self{hop_array}})) { unshift(@{$$self{hop_array}}, $$self{default_hop_count}); $$self{hop_sum} = $$self{default_hop_count}; } From 2df743230934864418c2d22b5cbaf969c2300517 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Wed, 14 May 2014 17:41:00 -0700 Subject: [PATCH 127/180] Insteon: Fix PLM Enable_Monitor Mode; Fix Deaf Device Syncing --- lib/Insteon/BaseInsteon.pm | 2 +- lib/Insteon_PLM.pm | 6 ++++++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/lib/Insteon/BaseInsteon.pm b/lib/Insteon/BaseInsteon.pm index 948ef3288..d619cac8f 100644 --- a/lib/Insteon/BaseInsteon.pm +++ b/lib/Insteon/BaseInsteon.pm @@ -3367,7 +3367,7 @@ sub _process_sync_queue { my $link_req_ptr = shift(@{$$self{sync_queue}}); my %link_req = %$link_req_ptr; my $link_member = $link_req{member}; - if ($link_member->is_deaf){ + if ($link_member->is_deaf && !$link_member->is_awake){ $link_member->_build_deaf_sync_queue($link_req_ptr); $self->_process_sync_queue(); } diff --git a/lib/Insteon_PLM.pm b/lib/Insteon_PLM.pm index 806594ef9..588dec1c9 100644 --- a/lib/Insteon_PLM.pm +++ b/lib/Insteon_PLM.pm @@ -704,6 +704,12 @@ sub _parse_data { $self->_clear_timeout('command'); $self->clear_active_message(); } + elsif ($record_type eq $prefix{plm_set_config}) { + # The PLM ACK is all we get in response to + # setting the config parameters + $self->clear_active_message(); + } + $data =~ s/^$ackcmd//; } elsif ($is_nack) { From ac3402e19bc3b54bef5f410285ba981aef693ff8 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Wed, 14 May 2014 17:43:00 -0700 Subject: [PATCH 128/180] Insteon Deaf Device: Send Queued Commands on Manual Awake --- lib/Insteon/BaseInsteon.pm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/Insteon/BaseInsteon.pm b/lib/Insteon/BaseInsteon.pm index d619cac8f..aede7a7e6 100644 --- a/lib/Insteon/BaseInsteon.pm +++ b/lib/Insteon/BaseInsteon.pm @@ -1464,6 +1464,8 @@ sub manual_awake { my ($self, $p_time) = @_; $$self{manual_awake} = time + $p_time if $p_time; + #Start sending any messages that are queued for the device + $self->_process_command_stack(); return $$self{manual_awake}; } From 340596023b038a44c215f68524fb319f03e55797 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 15 May 2014 09:56:57 -0700 Subject: [PATCH 129/180] Correct Defined Hop Array Check --- lib/Insteon/BaseInsteon.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Insteon/BaseInsteon.pm b/lib/Insteon/BaseInsteon.pm index fa4b3a075..9ff1d1792 100644 --- a/lib/Insteon/BaseInsteon.pm +++ b/lib/Insteon/BaseInsteon.pm @@ -275,7 +275,7 @@ sub default_hop_count if (defined($hop_count)){ ::print_log("[Insteon::BaseObject] DEBUG3: Adding hop count of " . $hop_count . " to hop_array of " . $self->get_object_name) if $self->debuglevel(3, 'insteon'); - if ($$self{hop_array} && !(@{$$self{hop_array}})) { + if (!(@{$$self{hop_array}})) { unshift(@{$$self{hop_array}}, $$self{default_hop_count}); $$self{hop_sum} = $$self{default_hop_count}; } From 0ba350dc7db408e8efcc5fe216b30cbd17ec7aca Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 15 May 2014 10:06:48 -0700 Subject: [PATCH 130/180] Further Fix Hop Array Definition Test --- lib/Insteon/BaseInsteon.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Insteon/BaseInsteon.pm b/lib/Insteon/BaseInsteon.pm index 9ff1d1792..2c07608be 100644 --- a/lib/Insteon/BaseInsteon.pm +++ b/lib/Insteon/BaseInsteon.pm @@ -275,7 +275,7 @@ sub default_hop_count if (defined($hop_count)){ ::print_log("[Insteon::BaseObject] DEBUG3: Adding hop count of " . $hop_count . " to hop_array of " . $self->get_object_name) if $self->debuglevel(3, 'insteon'); - if (!(@{$$self{hop_array}})) { + if (!$$self{hop_array} || !(@{$$self{hop_array}})) { unshift(@{$$self{hop_array}}, $$self{default_hop_count}); $$self{hop_sum} = $$self{default_hop_count}; } From 69a3734cf66b9c2ae3d9f2824cf8e89bcaac8815 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 15 May 2014 17:33:00 -0700 Subject: [PATCH 131/180] Insteon: Force Dimmable Items to Report off Rather than 0% --- lib/Insteon/Lighting.pm | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/lib/Insteon/Lighting.pm b/lib/Insteon/Lighting.pm index ae245bd9b..eb10871f0 100644 --- a/lib/Insteon/Lighting.pm +++ b/lib/Insteon/Lighting.pm @@ -190,10 +190,14 @@ sub derive_link_state if (grep(/$p_state/i, @{['on_fast', 'off', 'off_fast']})) { $link_state = $p_state; } - elsif ($p_state =~ /\d+%?/) + elsif ($p_state =~ /(\d+)%?/) { - $p_state =~ /(\d+)%?/; - $link_state = $1 . '%'; + if ($1 == 0) { + $link_state = 'off'; + } + else { + $link_state = $1 . '%'; + } } return $link_state; } From 7f607202d12319a748aac7b2a81fc0bd2bdf9598 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Fri, 13 Jun 2014 16:28:35 -0700 Subject: [PATCH 132/180] Insteon: Reset ACK, NACK, and BadCmd Flags on Each Run of Parse Data The loop may iterate multiple times, we need to reset these flags each time the loop processes. --- lib/Insteon_PLM.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/Insteon_PLM.pm b/lib/Insteon_PLM.pm index 588dec1c9..7aa631358 100644 --- a/lib/Insteon_PLM.pm +++ b/lib/Insteon_PLM.pm @@ -619,7 +619,8 @@ sub _parse_data { } # STEP 4a Is this a PLM Response to a command we sent? Prep Vars - my ($is_ack, $is_nack, $is_badcmd, $ackcmd, $nackcmd, $badcmd); + my ($is_ack, $is_nack, $is_badcmd) = (0) x 3; + my ($ackcmd, $nackcmd, $badcmd) = ("") x 3; my $pending_message = $self->active_message; if ($pending_message) { From e1d2c47d0aa744d24254585ae2c91ba40398c1af Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Fri, 13 Jun 2014 16:42:37 -0700 Subject: [PATCH 133/180] Insteon: Do Not Attempt to Clear the Active Message if it Does Not Exist in Parsing all_link_complete Fixes the bug that may occur when using the old deprecated "complete linking as responder" voice command. Fixes hollie/misterhouse#407 --- lib/Insteon_PLM.pm | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/lib/Insteon_PLM.pm b/lib/Insteon_PLM.pm index 7aa631358..1d58e3bab 100644 --- a/lib/Insteon_PLM.pm +++ b/lib/Insteon_PLM.pm @@ -900,19 +900,19 @@ sub _parse_data { my $device_object = Insteon::get_object($link_address); $device_object->devcat(substr($message_data,10,4)); $device_object->firmware(substr($message_data,14,2)); - if (ref $self->active_message && - $self->active_message->success_callback){ - main::print_log("[Insteon::Insteon_PLM] DEBUG4: Now calling message success callback: " - . $self->active_message->success_callback) if $self->debuglevel(4, 'insteon'); - package main; - eval $self->active_message->success_callback; - ::print_log("[Insteon::Insteon_PLM] problem w/ success callback: $@") if $@; - package Insteon::BaseObject; + if (ref $self->active_message) { + if ($self->active_message->success_callback){ + main::print_log("[Insteon::Insteon_PLM] DEBUG4: Now calling message success callback: " + . $self->active_message->success_callback) if $self->debuglevel(4, 'insteon'); + package main; + eval $self->active_message->success_callback; + ::print_log("[Insteon::Insteon_PLM] problem w/ success callback: $@") if $@; + package Insteon::BaseObject; + } + #Clear awaiting_ack flag + $self->active_message->setby->_process_command_stack(0); + $self->clear_active_message(); } - #Clear awaiting_ack flag - $self->active_message->setby->_process_command_stack(0); - $self->clear_active_message(); - $data = substr($data, 20); } elsif ($record_type eq $prefix{all_link_clean_failed} and (length($data) >= 12)) { From 29b3d67e815234f9d9efe38c1c1fc893d167604d Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Mon, 16 Jun 2014 17:33:00 -0700 Subject: [PATCH 134/180] AD2: Add Set_Receive to Process Received States from the Device Prior to this, we would accidentally send commands directly to the alarm by accident. --- lib/AD2.pm | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/lib/AD2.pm b/lib/AD2.pm index c8aaff163..8e8d0205c 100755 --- a/lib/AD2.pm +++ b/lib/AD2.pm @@ -691,7 +691,7 @@ sub CheckCmd { $self->debug_log("Panel is low on battery");; } if ($mode ne $self->state && $mode ne ''){ - $self->set($mode); + $self->set_receive($mode); } } return; @@ -1082,6 +1082,17 @@ sub set { return; } +=item C + +Used internally to update the state of the object inside MisterHouse. + +=cut + +sub set_receive { + my ($self, $p_state, $p_setby, $p_response) = @_; + return $self->SUPER::set($p_state, $p_setby, $p_response); +} + =item C Takes a zone number and returns its status. @@ -1774,6 +1785,8 @@ sub set $$self{interface}->output_cmd($p_state, $$self{output}); } else { + # This may be an attempt to send the alarm code, not sure if this is + # a good way to handle this $reported_state = ''; $$self{interface}->set($p_state); } From 365df636a0e79b0d62b14f14f3c6f72d733f941d Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Mon, 16 Jun 2014 17:45:00 -0700 Subject: [PATCH 135/180] AD2: Better Restore of Cached Zone States on Reboot Certain zone states, such as Bypass, can only be determined when they are set. As a result, we need to cache and save the zone states through a reboot, otherwise we will change a zone from bypass->ready whenever we reboot. This does leave open the possibility of incorrectly setting a zone state if the zone changed state while MisterHouse was down. --- lib/AD2.pm | 44 +++++++++++++++++++++++++++++++++++++------- 1 file changed, 37 insertions(+), 7 deletions(-) diff --git a/lib/AD2.pm b/lib/AD2.pm index 8e8d0205c..e7ef6707c 100755 --- a/lib/AD2.pm +++ b/lib/AD2.pm @@ -179,9 +179,6 @@ sub new { # proactively setting their ini parameters to 0: # AD2_part_log AD2_zone_log AD2_debug_log - #Set all zones and partitions to ready - $self->ChangeZones( 1, $$self{max_zones}, "ready", "ready", 0); - #Store Object with Instance Name $self->_set_object_instance($instance); @@ -191,6 +188,34 @@ sub new { return $self; } +=item C + +This is called by mh on exit to save the cached states of the zones to +persistant data. + +NOTE: It would probably be easier/better to simply have the child +objects each store their own state using the built-in MH methods. However, +this would require users to define the child objects and would break the +original code design. + +=cut + +sub restore_string +{ + my ($self) = @_; + # Do the normal restore_string + my $restore_string = $self->SUPER::restore_string(); + # Add our custom routine to save the zone states + for my $partition (keys %{$$self{partition_address}}){ + for my $zone (keys %{$$self{$partition}{zone_status}}){ + my $status = $$self{$partition}{zone_status}{$zone}; + $restore_string .= $self->{object_name} + . "->ChangeZones($zone, $zone, q~$status~, 0, 0, $partition, 0);\n"; + } + } + return $restore_string; +} + =item C Takes a scalar instance name, AD2-Prefix, and returns the object associated with @@ -806,10 +831,13 @@ sub GetStatusType { $message{rel_channel} = $2; $message{rel_status} = $3; } - elsif ($AdemcoStr =~ /!Sending\.\.\.done/) { + elsif ($AdemcoStr =~ /!Sending\.*done/) { $self->debug_log("Command sent successfully."); $message{cmd_sent} = 1; } + elsif ($AdemcoStr =~ /!SER2SOCK/) { + $self->debug_log("Ser2Sock Message: $AdemcoStr"); + } else { $message{unknown} = 1; } @@ -876,7 +904,8 @@ sub ChangeZones { $self->{partition_now}{$partition} = 1; # Set child object status if it is registered to the zone $$self{zone_object}{"$i"}->set($new_status, $$self{zone_object}{"$i"}) - if defined $$self{zone_object}{"$i"}; + if (defined $$self{zone_object}{"$i"} + && $$self{zone_object}{"$i"}->state ne $new_status); my $zone_partition = $self->zone_partition($i); my $partition_status = $self->status_partition($zone_partition); $$self{partition_object}{$zone_partition}->set_receive($partition_status, $$self{zone_object}{"$i"}) @@ -1252,8 +1281,8 @@ Used to associate child objects with the interface. sub register { my ($self, $object, $num, $expander,$relay,$wireless) = @_; - &::print_log("Registering Child Object on zone $num"); if ($object->isa('AD2_Item')) { + ::print_log("Registering Child Object for zone $num"); $self->{zone_object}{$num} = $object; #Put wireless settings in correct hash if (defined $wireless){ @@ -1269,9 +1298,11 @@ sub register { } } elsif ($object->isa('AD2_Partition')) { + ::print_log("Registering Child Object for partition $num"); $self->{partition_object}{$num} = $object; } elsif ($object->isa('AD2_Output')) { + ::print_log("Registering Child Object for output $num"); $self->{output_object}{$num} = $object; } } @@ -1434,7 +1465,6 @@ sub new $interface->register($self,$zone,$expander,$relay,$wireless); $zone = sprintf("%03d", $zone); $$self{zone_partition}{$zone} = $partition; - $self->set($interface->status_zone($zone), $self); #Set correct state on startup return $self; } From 757b3effc8596f81e69b2fdb13de577a1a7065e7 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Tue, 17 Jun 2014 09:36:59 -0700 Subject: [PATCH 136/180] Insteon: Parse PLM_Info Messages Before ACK/NACK/Bad Command Fixes hollie/misterhouse#413 --- lib/Insteon_PLM.pm | 53 ++++++++++++++++++++++++---------------------- 1 file changed, 28 insertions(+), 25 deletions(-) diff --git a/lib/Insteon_PLM.pm b/lib/Insteon_PLM.pm index 1d58e3bab..4385965ad 100644 --- a/lib/Insteon_PLM.pm +++ b/lib/Insteon_PLM.pm @@ -646,9 +646,35 @@ sub _parse_data { $is_nack = 1 if ($data =~ /^($nackcmd)/); $is_badcmd = 1 if ($data =~ /^($badcmd)/); } + + # Step 4b Check if this is a unique PLM Response + if ($record_type eq $prefix{plm_info} and (length($data) >= 18)){ + #Note Receipt of PLM Response + $pending_message->plm_receipt(1); + + ::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) + if $self->debuglevel(4, 'insteon'); + + $self->device_id(substr($data,4,6)); + $self->firmware(substr($data,14,2)); + $self->on_interface_info_received(); + + $data = substr($data, 18); + } + elsif ($record_type eq $prefix{plm_get_config} and (length($data) >= 12)){ + #Note Receipt of PLM Response + $pending_message->plm_receipt(1); + + ::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) + if $self->debuglevel(4, 'insteon'); + my $message_data = substr($data,4,8); + $self->on_interface_config_received($message_data); + $data = substr($data, 18); + } + - # STEP 4b Is this a PLM Response to a command MH sent? - if ($is_ack) { + # STEP 4c Is this a PLM Response to a command MH sent? + elsif ($is_ack) { #Note Receipt of PLM ACK $pending_message->plm_receipt(1); @@ -1008,29 +1034,6 @@ sub _parse_data { $data = substr($data, 6); } - elsif ($record_type eq $prefix{plm_info} and (length($data) >= 18)){ - #Note Receipt of PLM Response - $pending_message->plm_receipt(1); - - ::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) - if $self->debuglevel(4, 'insteon'); - - $self->device_id(substr($data,4,6)); - $self->firmware(substr($data,14,2)); - $self->on_interface_info_received(); - - $data = substr($data, 18); - } - elsif ($record_type eq $prefix{plm_get_config} and (length($data) >= 12)){ - #Note Receipt of PLM Response - $pending_message->plm_receipt(1); - - ::print_log( "[Insteon_PLM] DEBUG4:\n".Insteon::MessageDecoder::plm_decode($data)) - if $self->debuglevel(4, 'insteon'); - my $message_data = substr($data,4,8); - $self->on_interface_config_received($message_data); - $data = substr($data, 18); - } else { # No more processing can be done now, wait for more data $process_data = 0; From e060c15a5c06b4908d5240cff687617492987574 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 26 Jun 2014 17:45:00 -0700 Subject: [PATCH 137/180] AD2: Add Bypass Tracking Feature; Rearrange Change Zone Function Add a separate function for checking the bypassed state of a zone. Change status_zone function. It will only report a zone as bypassed if the zone is hardwired. All other zone types we can continue to track even when bypassed. Cleanup ChangeZoneState, it now only affects a single zone, the complicated looping for setting multiple zones is moved into the respective places in the code. --- lib/AD2.pm | 218 ++++++++++++++++++++++++++++++++++------------------- 1 file changed, 140 insertions(+), 78 deletions(-) diff --git a/lib/AD2.pm b/lib/AD2.pm index e7ef6707c..6b987dd22 100755 --- a/lib/AD2.pm +++ b/lib/AD2.pm @@ -210,7 +210,10 @@ sub restore_string for my $zone (keys %{$$self{$partition}{zone_status}}){ my $status = $$self{$partition}{zone_status}{$zone}; $restore_string .= $self->{object_name} - . "->ChangeZones($zone, $zone, q~$status~, 0, 0, $partition, 0);\n"; + . "->ChangeZoneState($zone, q~$status~, 0);\n"; + my $bypass = $$self{$partition}{zone_bypass}{$zone}; + $restore_string .= $self->{object_name} + . "->zone_bypassed($zone, $bypass);\n"; } } return $restore_string; @@ -387,8 +390,7 @@ sub check_for_data { # Reset any wireless keyfobs to ready foreach my $rf_key (keys %{$$self{wireless}}){ if ($rf_key =~ /.*\..*\.k/i) { - $self->ChangeZones( int($$self{wireless}{$rf_key}), - int($$self{wireless}{$rf_key}), "ready", "", 1); + $self->ChangeZoneState( int($$self{wireless}{$rf_key}), "ready", 1); } } @@ -532,19 +534,46 @@ sub CheckCmd { && $self->{lowest_zone_unchanged}{$partition} && (($zone_no_pad - $self->{zone_last_num}{$partition}) != 1)) { #Reset the zones between the current zone and the last zone. - $self->ChangeZones( $self->{zone_last_num}{$partition}+1, - $zone_no_pad-1, "ready", "bypass", 1, $partition,1); + my $start = $self->{zone_last_num}{$partition}+1; + my $end = $zone_no_pad-1; + + # Allow for reverse looping from max_zones->1 + my $reverse = ($start > $end)? 1 : 0; + + # Prevent infinite loop scenario + my $y = 0; + + # Loop through zones setting them as required + for (my $i = $start; ($y <= $$self{max_zones}) && + ((!$reverse && $i <= $end) || + ($reverse && ($i >= $start || $i <= $end))); + $i++) { + # Only alter zones in this partition + if ($partition == $self->zone_partition($i)) { + # Skip Mapped or Bypassed Zones + if (!$self->is_zone_mapped($i) && + !$self->zone_bypassed($i)){ + $self->ChangeZoneState( $i, "ready", 1); + } + } + $y++; + $i = 0 if ($i == $$self{max_zones} && $reverse); #loop around + } } # Always set the reported zone to fault - $self->ChangeZones( $zone_no_pad, $zone_no_pad, "fault", "", 1); + $self->ChangeZoneState( $zone_no_pad, "fault", 1); # Store Zone Number for Use in Fault Loop $self->{zone_last_num}{$partition} = $zone_no_pad; } } elsif ($status_type->{bypass}) { - $self->ChangeZones( $zone_no_pad, $zone_no_pad, "bypass", "", 1); + # Skip Mapped Zones + if (!$self->is_zone_mapped($zone_no_pad)){ + $self->ChangeZoneState( $zone_no_pad, "bypass", 1); + } + $self->zone_bypassed($zone_no_pad, 1); } elsif ($status_type->{wireless}) { my $rf_id = $status_type->{rf_id}; @@ -573,7 +602,7 @@ sub CheckCmd { $ZoneStatus = "fault"; } - $self->ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); + $self->ChangeZoneState( int($ZoneNum), "$ZoneStatus", 1); } } } @@ -586,7 +615,7 @@ sub CheckCmd { if (my $ZoneNum = $$self{expander}{$exp_id.$input_id}) { my $ZoneStatus = ($status == 01) ? "fault" : "ready"; - $self->ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); + $self->ChangeZoneState( int($ZoneNum), "$ZoneStatus", 1); } } elsif ($status_type->{relay}) { @@ -598,7 +627,7 @@ sub CheckCmd { if (my $ZoneNum = $$self{relay}{$rel_id.$rel_input_id}) { my $ZoneStatus = ($rel_status == 01) ? "fault" : "ready"; - $self->ChangeZones( int($ZoneNum), int($ZoneNum), "$ZoneStatus", "", 1); + $self->ChangeZoneState( int($ZoneNum), "$ZoneStatus", 1); } } @@ -619,12 +648,35 @@ sub CheckCmd { # READY if ( $status_type->{ready_flag}) { - my $bypass = ($status_type->{bypassed_flag}) ? 'bypass' : ''; + my $bypass = $status_type->{bypassed_flag}; $mode = 'ready'; $mode = 'bypass' if $bypass; # Reset all zones, if bypass enabled skip bypassed zones for my $partition (@partitions){ - $self->ChangeZones( 1, $$self{max_zones}, "ready", $bypass, 1, $partition); + for (my $i = 1; $i <= $$self{max_zones}; $i++){ + # Only work with zones in this partition + if ($partition == $self->zone_partition($i)) { + # Only change state of non-mapped zones + if (!$self->is_zone_mapped($i)){ + # Change if not-bypassed or bypass not enabled + if (!$bypass || !$self->zone_bypassed($i)){ + $self->ChangeZoneState( $i, "ready", 1); + } + } + } + } + } + } + + # NOT BYPASSED + if (!$status_type->{bypassed_flag}) { + for my $partition (@partitions){ + for (my $i = 1; $i <= $$self{max_zones}; $i++){ + # Only work with zones in this partition + if ($partition == $self->zone_partition($i)) { + $self->zone_bypassed( $zone_no_pad, 0); + } + } } } @@ -705,7 +757,7 @@ sub CheckCmd { if ( $status_type->{alarm_now_flag}) { $mode = "alarm now sounding"; $self->debug_log("ALARM IS SOUNDING - Zone $zone_no_pad (".$self->zone_name($zone_no_pad).")" ); - $self->ChangeZones( $zone_no_pad, $zone_no_pad, "alarm", "", 1); + $self->ChangeZoneState( $zone_no_pad, "alarm", 1); } # BATTERY LOW @@ -788,7 +840,7 @@ sub GetStatusType { $self->debug_log("Fault zones available: $AdemcoStr"); $message{fault} = 1; } - elsif ( $message{alphanumeric} =~ m/^BYPAS/ ) { + elsif ( $message{alphanumeric} =~ m/^BYPAS \d/ ) { $self->debug_log("Bypass zones available: $AdemcoStr"); $message{bypass} = 1; } @@ -841,78 +893,89 @@ sub GetStatusType { else { $message{unknown} = 1; } + return \%message; } -=item C +=item C -This routine changes the defined zones to the state that was passed. +This routine changes the defined zone to the state that was passed. Will also +update any child objects that exist as well as other necessary routines -$start = Zone number to start at +$zone = Zone number to start at -$end = Zone number to end at +$new_status = The status to which the zones should be changed too. -All zones between and including $start and $end will be updated. If $start is -greater than $end, the routine will loop around at the max_zones value. +$log = If true will log its actions -$new_status = The status to which the zones should be changed too. +=cut -$neq_status = Do not alter zones that are equal to this status. +sub ChangeZoneState { + my ($self, $zone, $new_status, $log) = @_; + my $instance = $self->{instance}; + + # This routine is called a lot, only update zones if they have changed + if ($self->status_zone($zone) ne $new_status){ + # Set the new state + $$self{$self->zone_partition($zone)}{zone_status}{$zone} = $new_status; + # Store Change for Zone_Now Function + $self->{zone_now}{"$zone"} = 1; + # Store Change for Partition_Now Function + $self->{partition_now}{$self->zone_partition($zone)} = 1; + $self->update_child_object($zone); + # Update child partition + my $zone_partition = $self->zone_partition($zone); + my $partition_status = $self->status_partition($zone_partition); + $$self{partition_object}{$zone_partition}->set_receive($partition_status, $$self{zone_object}{"$zone"}) + if defined $$self{partition_object}{$zone_partition}; + # Log everything if requested + if ($log == 1) { + my $ZoneNumPadded = sprintf("%03d", $zone); + $self->debug_log( "Zone $zone (".$self->zone_name($zone) + .") changed to '$new_status'" ); + } + } +} -$log = If true will log its actions +=item C -$partition = Only change zones on the defined partition +Sets or gets the bypass state of a zone. The state of mapped zones is always +accurately reported. Non-mapped hardwired zones have no state when they are +bypassed, we cannot determine their fault status. As such, the state of +non-mapped hardwired zones will be "bypass" when they are bypassed. -$skip_mapped= If true, zones which are mapped (expander, relay, wireless) will -not be affected +The state of child objects is similar with the exception that the state of +mapped zones will be appended with " - bypass" if they are currently bypassed. -=cut +This routine will always accurately return the bypass state of a zone. The +funtion will return true if bypassed or false if not. To set the bypass state +simply pass it as $bypass. -sub ChangeZones { - my ($self, $start, $end, $new_status, $neq_status, $log, $partition, - $skip_mapped) = @_; - my $instance = $self->{instance}; - #Prevent improper start and end to suppress never ending loops. - $end = $$self{max_zones} if ($end <=0 || $end > $$self{max_zones}); - $start = 1 if ($start <=0 || $start > $$self{max_zones}); +=cut - # Allow for reverse looping from max_zones->1 - my $reverse = ($start > $end)? 1 : 0; - - # Prevent infinite loop scenario - my $y = 0; - - for (my $i = $start; ($y <= $$self{max_zones}) && - ((!$reverse && $i <= $end) || - ($reverse && ($i >= $start || $i <= $end))); - $i++) { - my $current_status = $$self{$self->zone_partition($i)}{zone_status}{$i}; - # If partition set, then zone partition must equal that - if (($current_status ne $new_status) && ($current_status ne $neq_status) - && (!$partition || ($partition == $self->zone_partition($i))) - && (!$skip_mapped || (!$self->is_zone_mapped($i)))) { - if ($log == 1) { - my $ZoneNumPadded = sprintf("%03d", $i); - $self->debug_log( "Zone $i (".$self->zone_name($i) - .") changed from '$current_status' to '$new_status'" ); - } - $$self{$self->zone_partition($i)}{zone_status}{$i} = $new_status; - # Store Change for Zone_Now Function - $self->{zone_now}{"$i"} = 1; - # Store Change for Partition_Now Function - $self->{partition_now}{$partition} = 1; - # Set child object status if it is registered to the zone - $$self{zone_object}{"$i"}->set($new_status, $$self{zone_object}{"$i"}) - if (defined $$self{zone_object}{"$i"} - && $$self{zone_object}{"$i"}->state ne $new_status); - my $zone_partition = $self->zone_partition($i); - my $partition_status = $self->status_partition($zone_partition); - $$self{partition_object}{$zone_partition}->set_receive($partition_status, $$self{zone_object}{"$i"}) - if defined $$self{partition_object}{$zone_partition}; +sub zone_bypassed { + my ($self, $zone, $bypass) = @_; + if (defined $bypass) { + my $old_bypass = $self->zone_bypassed($zone); + $$self{$self->zone_partition($zone)}{zone_bypass}{$zone} = $bypass; + if ($old_bypass ne $bypass){ + $self->update_child_object($zone); } - $y++; - $i = 0 if ($i == $$self{max_zones} && $reverse); #loop around + } + return $$self{$self->zone_partition($zone)}{zone_bypass}{$zone}; +} + +sub update_child_object { + my ($self, $zone) = @_; + # Prep bypass variable + my $status = $self->status_zone($zone); + if ($self->zone_bypassed($zone) && $self->is_zone_mapped($zone)){ + $status .= " - bypass"; + } + # Set child object status if it is registered to the zone + if (defined $$self{zone_object}{"$zone"} && + $$self{zone_object}{"$zone"}->state ne $status) { + $$self{zone_object}{"$zone"}->set($status, $$self{zone_object}{"$zone"}); } } @@ -1284,6 +1347,7 @@ sub register { if ($object->isa('AD2_Item')) { ::print_log("Registering Child Object for zone $num"); $self->{zone_object}{$num} = $object; + $num = sprintf("%03d", $num); #Put wireless settings in correct hash if (defined $wireless){ $$self{wireless}{$wireless} = $num; @@ -1485,16 +1549,14 @@ sub set ::print_log("AD2_Item($$self{object_name})::set($p_state, $p_setby)") if $main::Debug{AD2}; } - if ($p_state =~ /^fault/ || $p_state eq 'on') { - $p_state = 'fault'; - $p_state = 'open' if $$self{item_type} eq 'door'; - $p_state = 'motion' if $$self{item_type} eq 'motion'; + if ($p_state =~ /^fault/) { + $p_state =~ s/fault/open/ if $$self{item_type} eq 'door'; + $p_state =~ s/fault/motion/ if $$self{item_type} eq 'motion'; $$self{last_fault} = $::Time; - } elsif ($p_state =~ /^ready/ || $p_state eq 'off') { - $p_state = 'ready'; - $p_state = 'closed' if $$self{item_type} eq 'door'; - $p_state = 'still' if $$self{item_type} eq 'motion'; + } elsif ($p_state =~ /^ready/) { + $p_state =~ s/ready/closed/ if $$self{item_type} eq 'door'; + $p_state =~ s/ready/still/ if $$self{item_type} eq 'motion'; $$self{last_ready} = $::Time; } From 72bfe7092eec3cc73e2a55d6937baf3c8f21ed04 Mon Sep 17 00:00:00 2001 From: JaredF Date: Thu, 26 Jun 2014 20:58:55 -0700 Subject: [PATCH 138/180] Adds support for the Insteon BulbLinc --- lib/Insteon/Lighting.pm | 127 ++++++++++++++++++++++++++++++++++++++++ lib/read_table_A.pl | 6 ++ web/bin/items.pl | 3 +- 3 files changed, 135 insertions(+), 1 deletion(-) diff --git a/lib/Insteon/Lighting.pm b/lib/Insteon/Lighting.pm index eb10871f0..aacee3ae7 100644 --- a/lib/Insteon/Lighting.pm +++ b/lib/Insteon/Lighting.pm @@ -1760,4 +1760,131 @@ You should have received a copy of the GNU General Public License along with thi =cut +=head1 B + +=head2 SYNOPSIS + +User code: + + use Insteon::BulbLinc; + $bulb_device = new Insteon::BulbLinc('12.34.56',$myPLM); + +In mht file: + + INSTEON_BULBLINC, 12.34.56, bulb_device, All_Lights + +=head2 DESCRIPTION + +Provides support for the Insteon BulbLinc. + +=head3 FEATURES + +The BulbLinc has no physical set button; therefore, linking is initiated by cutting and restoring power to the device. This feature can be disabled for environments in which all links are configured via software means. The 'disable_linking_on_startup' command provides for this option. + +=head2 INHERITS + +L, + +=head2 METHODS + +=over + +=cut + +package Insteon::BulbLinc; + +use strict; +use Insteon::BaseInsteon; + +@Insteon::BulbLinc::ISA = ('Insteon::DimmableLight'); + +our %operating_flags = ( + 'linking_on_powerup_on' => '01', + 'linking_on_powerup_off' => '00' +); + +=item C + +Instantiates a new object. + +=cut + +sub new +{ + my ($class,$p_deviceid,$p_interface) = @_; + + my $self = new Insteon::DimmableLight($p_deviceid,$p_interface); + $$self{operating_flags} = \%operating_flags; + bless $self,$class; + return $self; +} + +=item C + +If boolean is true, the BulbLinc will enter linking mode on power-up. + +=cut + +sub enable_linking_on_powerup +{ + my ($self, $is_true) = @_; + return unless defined $is_true; + my $name = $self->get_object_name; + + if ($is_true) { + ::print_log("[Insteon::BulbLinc] Enabling Linking on Startup on $name"); + $self->set_operating_flag('linking_on_powerup_on'); + } + else { + ::print_log("[Insteon::BulbLinc] Disabling Linking on Startup on $name"); + $self->set_operating_flag('linking_on_powerup_off'); + } +} + +=item C + +Returns a hash of voice commands where the key is the voice command name and the +value is the perl code to run when the voice command name is called. + +Higher classes which inherit this object may add to this list of voice commands by +redefining this routine while inheriting this routine using the SUPER function. + +This routine is called by L to generate the +necessary voice commands. + +=cut + +sub get_voice_cmds +{ + my ($self) = @_; + my $object_name = $self->get_object_name; + my %voice_cmds = ( + %{$self->SUPER::get_voice_cmds} + ); + if ($self->is_root){ + %voice_cmds = ( + %voice_cmds, + 'set linking on powerup on' => "$object_name->enable_linking_on_powerup(1)", + 'set linking on powerup off' => "$object_name->enable_linking_on_powerup(0)" + ); + } + return \%voice_cmds; +} + +=back + +=head2 AUTHOR + +Jared J. Fernandez + +=head2 LICENSE + +This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. + +This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + +=cut + 1 diff --git a/lib/read_table_A.pl b/lib/read_table_A.pl index 83d222e94..68a95ca74 100644 --- a/lib/read_table_A.pl +++ b/lib/read_table_A.pl @@ -99,6 +99,12 @@ sub read_table_A { $other = join ', ', (map {"'$_'"} @other); # Quote data $object = "Insteon::LampLinc(\'$address\',$other)"; } + elsif($type eq "INSTEON_BULBLINC") { + require Insteon::Lighting; + ($address, $name, $grouplist, @other) = @item_info; + $other = join ', ', (map {"'$_'"} @other); # Quote data + $object = "Insteon::BulbLinc(\'$address\',$other)"; + } elsif($type eq "INSTEON_APPLIANCELINC") { require Insteon::Lighting; ($address, $name, $grouplist, @other) = @item_info; diff --git a/web/bin/items.pl b/web/bin/items.pl index cc224b435..1e6bd2b21 100644 --- a/web/bin/items.pl +++ b/web/bin/items.pl @@ -65,7 +65,7 @@ sub web_items_list { '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_LAMPLINC','INSTEON_APPLIANCELINC', + 'GENERIC', 'GROUP', 'IBUTTON', 'INSTEON_PLM','INSTEON_LAMPLINC','INSTEON_BULBLINC','INSTEON_APPLIANCELINC', 'INSTEON_SWITCHLINC','INSTEON_SWITCHLINCRELAY','INSTEON_KEYPADLINC','INSTEON_KEYPADLINCRELAY', 'INSTEON_REMOTELINC','INSTEON_MOTIONSENSOR','INSTEON_TRIGGERLINC','INSTEON_ICONTROLLER', 'MP3PLAYER', 'One-Wire xAP Connector (OWX)', 'RF', 'SERIAL', @@ -141,6 +141,7 @@ sub web_items_list { UPBL => [qw(Name Interface NetworkID Address Groups)], INSTEON_PLM => [qw(Name)], INSTEON_LAMPLINC => [qw(Address Name Groups)], + INSTEON_BULBLINC => [qw(Address Name Groups)], INSTEON_APPLIANCELINC => [qw(Address Name Groups)], INSTEON_SWITCHLINC => [qw(Address Name Groups)], INSTEON_SWITCHLINCRELAY => [qw(Address Name Groups)], From ebb92fb65a3395d783c12b9ea70b7f3092ad5141 Mon Sep 17 00:00:00 2001 From: JaredF Date: Thu, 26 Jun 2014 21:27:48 -0700 Subject: [PATCH 139/180] Fixes minor semantics in POD wording --- lib/Insteon/Lighting.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/Insteon/Lighting.pm b/lib/Insteon/Lighting.pm index aacee3ae7..4db5a7338 100644 --- a/lib/Insteon/Lighting.pm +++ b/lib/Insteon/Lighting.pm @@ -1779,7 +1779,7 @@ Provides support for the Insteon BulbLinc. =head3 FEATURES -The BulbLinc has no physical set button; therefore, linking is initiated by cutting and restoring power to the device. This feature can be disabled for environments in which all links are configured via software means. The 'disable_linking_on_startup' command provides for this option. +The BulbLinc has no physical set button; therefore, linking is initiated by cutting and restoring power to the device. This feature can be disabled for environments where all links are configured via software means and this behavior is unnecessary. The 'enable_linking_on_powerup' command provides for this option. =head2 INHERITS @@ -1821,7 +1821,7 @@ sub new =item C -If boolean is true, the BulbLinc will enter linking mode on power-up. +If boolean is true, the BulbLinc will perform a "complete linking as responder" on every power-up. =cut From 45c43a5d2decfa455f5212edd46773b23fd56ac7 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Fri, 27 Jun 2014 17:45:00 -0700 Subject: [PATCH 140/180] Add Support for Pushbullet.com Notifications Pushbullet is similar to Pushover. It allows you to send notification messages directly from MH to your devices. A device can be an iOS or Android phone, a windows PC, or any Chrome browser. All of the clients are free and the service is free. Pushbullet has many features: - Send notes, urls, files, lists, and addresses - Add multiple devices and friends - Choose which devices and friends to send a particular push to Right now the code provides a user friendly mechanism to send notes. A low level module also provides raw support for sending whatever you want to the Pushbullet API. In future commits, I hope to make additional features easy to use. The addition of this feature to MH and some of the code was inspired by George Clark's work on the Pushover support. --- lib/Pushbullet.pm | 290 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 290 insertions(+) create mode 100644 lib/Pushbullet.pm diff --git a/lib/Pushbullet.pm b/lib/Pushbullet.pm new file mode 100644 index 000000000..0306ed287 --- /dev/null +++ b/lib/Pushbullet.pm @@ -0,0 +1,290 @@ + +=head1 B + +=head2 SYNOPSIS + +This module allows MisterHouse to push notification to Pushbullet.com devices. See http://pushbullet.com/ for details of the service and API. + +Pushbullet is similar to, but slightly simpler than Pushover. The Pushbullet clients are free. + +=head2 CONFIGURATION + +Configure the required pushbullet settings in your mh.private.ini file: + + Pushbullet_token = + Pushbullet_title = "MisterHouse" Default title for notes if none provided + Pushbullet_disable = 1 Disable notifications. Messages will still be logged + +Create a pushbullet instance in the .mht file, or in user code: + +.mht file: + + CODE, require Pushbullet; #noloop + CODE, my $push = new Pushbullet(); #noloop + +A user code file overriding parameters normally specified in mh.private.ini. All of the parameters are optional if properly configured in the ini file. + + my $push = new Pushbullet( {token => '1234qwer1234qewr1234qwer', + title => 'Home Notification', + }); + + +The following example shows how to push a note in the user code. The only +required parameter is the first, the note text. Any of the parameters provided +when initializing the Pushbullet instance may also be provided on the note +push. They will be merged with and override the default values provided on +initialization. See the method documentation for below more details. + + my $iden = $push->push_note( "Some important message", { title => 'Security Alert' }); + +The returned $iden is the pushed message identification hash. In the future +this can be used to delete and possibly modify a push. + +=head2 DESCRIPTION + +The Pushbullet instance establishes the defaults for pushes. + +=head2 INHERITS + +NONE + +=cut + +package Pushbullet; + +use strict; +use warnings; + +=head2 DEPENDENCIES + + Data::Dumper: Used for error reporting and debugging + LWP::UserAgent: Implements HTTPS for interaction with Pushbullet.com + JSON: Decodes responses from Pushbullet.com + +=cut + +use Data::Dumper; +use LWP::UserAgent; +use JSON; + +use constant TRACE => 0; # enable for verbose tracing + +=head2 METHODS + +=over + +=item C + +Creates a new Pushbullet object. The parameter hash is optional. Defaults will be taken from the mh.private.ini file or are hardcoded. + + my $push = Pushbullet->new( { + title => "Some title", # Set default title for messages + token => "xxxx...", # Set the API Token + server => "...", # Override the Pushbullet server URL. Defaults to the public pushbullet server + speak => 0 # Speak acknowledgments + }); + +Any of these parameters may be specified in mh.private.ini by prefixing them with "Pushbullet_" + +=cut + +sub new { + my ( $class, $params ) = @_; + + if ( defined $params && ref($params) ne 'HASH' ) { + &::print_log( +"[Pushbullet] ERROR! Pushbullet->new() invalid parameter hash - Pushbullet disabled" + ); + $params = {}; + $params->{disable} = 1; + } + + $params = {} unless defined $params; + + my $self = {}; + # Set configuration defaults + $self->{config}{speak} = 1; # Speak notifications and acknowledgments + $self->{config}{server} = 'https://api.pushbullet.com/'; + + # mh.private.ini settings override the defaults + foreach my $mkey (keys(%::config_parms)) { + next if $mkey =~ /_MHINTERNAL_/; + # Only look for pushbullet settings + if ($mkey =~ /^Pushbullet_(.*$)/) { + # Drop the prefix + $self->{config}{$1} = $::config_parms{$1}; + } + } + + # Passed parameters overriding the ini settings + for (keys %{$params}){ + $self->{config}{$_} = $params->{$_}; + } + + my $note = ( $self->{config}{disable} ) ? '- Notifications disabled' : ''; + + &::print_log("[Pushbullet] Pushbullet object initialized $note"); + &::print_log( "[Pushbullet] " . Data::Dumper::Dumper( \$self ) ) if TRACE; + + return bless( $self, $class ); + +} + +=item C + +A user friendly interface to push a note. The note text, p_note, is the only mandatory parameter. + +The optional parameter hash can be used to override defaults, or specify additional +information for the notification. The list is not exclusive. Additional parameters will be passed +in the POST to Pushbullet.com. This allows support of any API parameter as defined at http://docs.pushbullet.com + + $push->push_note("Some urgent message", { + title => "Some title", # Override title of message + token => "xxxx...", # Override the API Token - probably not useful + device_iden => "xxxx..." # The device to which the note should be sent to + }); + +By default, the device_iden is left blank, which causes the notes to be sent to +all devices on your account. + +=cut + +sub push_note { + my ( $self, $message, $params ) = @_; + + $params = $self->check_params_hash($params); + $params->{type} = "note"; #Force type to note when using this function + $params->{body} = $message || " "; + + return $self->push_hash($params); +} + +=item C + +This is routine provides direct raw access to the push process. It is not as user +friendly as the simpler push_note .... routines. + +The parameter hash is required, and the required keys must be used such as type. + +Other keys can override defaults, or specify additional information for the push. +The list is not exclusive. Additional parameters will be passed in the POST to +Pushbullet.com. This allows support of any API parameter as defined at +http://docs.pushbullet.com + + $push->push_hash( { + type => "note", + body => "Note text", + title => "Some title", # Override title of message + token => "xxxx...", # Override the API Token - probably not useful + device_iden => "xxxx..." # The device to which the note should be sent to + }); + +By default, the device_iden is left blank, which causes the pushes to be sent to +all devices on your account. + +=cut + +sub push_hash { + my ( $self, $params ) = @_; + + my $callparams = {}; + + # Allow passed parameter to override global disable parameter + my $disable = $self->{config}{disable}; + + # Copy the calling hash since we need to modify it. + if ( defined $params && ref($params) eq 'HASH' ) { + foreach ( keys %{$params} ) { + $disable = $params->{$_} if ( $_ eq 'disable' ); + # Skip non-pushbullet parameters + next if (grep(/$_/i, @{['disable', 'speak', 'server']})); + $callparams->{$_} = $params->{$_}; + } + } + + my $note = ($disable) ? '- Notifications disabled' : ''; + + # Merge in the message defaults, They can be overridden + foreach (keys $self->{config}) { + $callparams->{$_} = $self->{config}{$_} unless defined $callparams->{$_}; + } + + &::print_log( + "[Pushbullet] Push Hash parameters: " . Data::Dumper::Dumper( \$callparams ) ) + if TRACE; + + # Form browser and request + my $browser = LWP::UserAgent->new; + my $req = HTTP::Request->new( POST => $self->{config}{server} . 'v2/pushes'); + $req->content(JSON::encode_json($callparams)); + $req->authorization_basic( $self->{config}{token}, "" ); + $req->content_type('application/json'); # Posting JSON content is preferred + my $resp; + # Do not perform reqest if disabled + $resp = $browser->request( $req ) unless ($disable); + + # Determine best way to describe message and log it + my $description = $callparams->{title}; + $description = $callparams->{name} if (defined $callparams->{name}); + $description = $callparams->{body} if (defined $callparams->{body}); + &::print_log("[Pushbullet] message: $description $note"); + &::speak("Pushbullet notification $description $note") + if $self->{config}{speak}; + + return if $disable; # Don't check the response if posting is disabled + + &::print_log( + "[Pushbullet] Notify results: " . Data::Dumper::Dumper( \$resp ) ) + if TRACE; + + my $decoded_json = JSON::decode_json( $resp->content() ); + + &::print_log( "[Pushbullet] " . Data::Dumper::Dumper( \$decoded_json ) ) if TRACE; + + if ( $resp->is_success() ) { + # Return push iden + return $decoded_json->{'iden'}; + } + else { + &::print_log( +"[Pushbullet] ERROR: POST Failed: Status: $decoded_json->{status} - $decoded_json->{errors} " + ); + return; + } +} + +sub check_params_hash { + my ($self, $params) = @_; + if ( defined $params && ref($params) ne 'HASH' ) { + &::print_log( +"[Pushbullet] ERROR! called with invalid parameter hash - passed parameters ignored" + ); + return {}; + } + else { + return $params; + } +} + +1; + +=back + +=head2 AUTHOR + +Kevin Robert Keegan (based on template from Pushover.pm by George Clark) + +=head2 SEE ALSO + +http://Pushbullet.com/ + +=head2 LICENSE + +This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. + +This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + +=cut + From bdcdcb12c5ca05ba334a7adf8532a60d343195ca Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Fri, 27 Jun 2014 17:14:21 -0700 Subject: [PATCH 141/180] Pushbullet: Add Support for Link, Address, List, and File Pushes; Add delete push - Changed the push_note parameters slightly. - Added user friendly routines for additional push types - Add the ability to delete pushes --- lib/Pushbullet.pm | 231 +++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 206 insertions(+), 25 deletions(-) diff --git a/lib/Pushbullet.pm b/lib/Pushbullet.pm index 0306ed287..94fc49c61 100644 --- a/lib/Pushbullet.pm +++ b/lib/Pushbullet.pm @@ -40,6 +40,11 @@ initialization. See the method documentation for below more details. The returned $iden is the pushed message identification hash. In the future this can be used to delete and possibly modify a push. +The parameter device_iden is by default left blank, thus causing the push to be +sent to all of your devices. If you specify a device_iden, the push will be +sent to that device only. Alternatively, if you specify an email address, the +push will be sent to that user. + =head2 DESCRIPTION The Pushbullet instance establishes the defaults for pushes. @@ -67,7 +72,7 @@ use Data::Dumper; use LWP::UserAgent; use JSON; -use constant TRACE => 0; # enable for verbose tracing +use constant TRACE => 1; # enable for verbose tracing =head2 METHODS @@ -130,16 +135,24 @@ sub new { } -=item C +=back + +=head3 User Friendly Push_ Functions -A user friendly interface to push a note. The note text, p_note, is the only mandatory parameter. +The various push_note, push_link, push_address ... functions are designed to be +user friendly. Each function takes the required parameters as scalar values. +The last parameter is an optional hash, that can be used to pass additional +optional parameters to pushbullet. The optional parameter hash can be used to override defaults, or specify additional -information for the notification. The list is not exclusive. Additional parameters will be passed -in the POST to Pushbullet.com. This allows support of any API parameter as defined at http://docs.pushbullet.com +information for the notification. Additional parameters will be passed as part of +the JSON content to Pushbullet.com. This allows support of any API parameter +as defined at http://docs.pushbullet.com, even those that do not exist yet. - $push->push_note("Some urgent message", { - title => "Some title", # Override title of message +The following is an example of the push_note function. The other functions +work similarly. + + $push->push_note("MisterHouse Title", "Some urgent message", { token => "xxxx...", # Override the API Token - probably not useful device_iden => "xxxx..." # The device to which the note should be sent to }); @@ -147,14 +160,132 @@ in the POST to Pushbullet.com. This allows support of any API parameter as defi By default, the device_iden is left blank, which causes the notes to be sent to all devices on your account. +=over + +=cut + +=item C + +A user friendly interface to push a note. The note title and text, p_title p_body, +are the only mandatory parameters. + =cut sub push_note { - my ( $self, $message, $params ) = @_; + my ( $self, $title, $message, $params ) = @_; - $params = $self->check_params_hash($params); + $params = $self->_check_params_hash($params); $params->{type} = "note"; #Force type to note when using this function $params->{body} = $message || " "; + $params->{title} = $title || " "; + $params->{action} = "POST"; + $params->{path} = "v2/pushes"; + + return $self->push_hash($params); +} + +=item C + +A user friendly interface to push a url. The url title and address, p_title p_url, +are the only mandatory parameters. + +The url push can optionally include a message in the body. It can be passed to +the function as follows: + + $push->push_link("MisterHouse Docs", "http://misterhouse.net", { + body => "If you have questions about MisterHouse please go here." + }); + +=cut + +sub push_link { + my ( $self, $title, $url, $params ) = @_; + + $params = $self->_check_params_hash($params); + $params->{type} = "link"; #Force type to note when using this function + $params->{url} = $url || " "; + $params->{title} = $title || " "; + $params->{action} = "POST"; + $params->{path} = "v2/pushes"; + + return $self->push_hash($params); +} + +=item C + +A user friendly interface to push a geographic address. The address name and +address, p_name p_address, are the only mandatory parameters. + +=cut + +sub push_address { + my ( $self, $name, $address, $params ) = @_; + + $params = $self->_check_params_hash($params); + $params->{type} = "address"; #Force type to note when using this function + $params->{name} = $name || " "; + $params->{address} = $address || " "; + $params->{action} = "POST"; + $params->{path} = "v2/pushes"; + + return $self->push_hash($params); +} + +=item C + +A user friendly interface to push a list of items. The list title and +items, p_title p_item_array_ref, are the only mandatory parameters. + +p_item_array_ref must be passed as an array referrence. Such as: + + $push->push_list("Grocery List", "http://misterhouse.net", + ['apple', 'banana', 'orange'] + ); + +=cut + +sub push_list { + my ( $self, $title, $item_array_ref, $params ) = @_; + + $params = $self->_check_params_hash($params); + $params->{type} = "list"; #Force type to note when using this function + $params->{title} = $title || " "; + $params->{action} = "POST"; + $params->{path} = "v2/pushes"; + if ( defined $item_array_ref && ref($item_array_ref) eq 'ARRAY' ) { + $params->{items} = @$item_array_ref; + } + else { + $params->{items} = []; + } + + return $self->push_hash($params); +} + +=item C + +A user friendly interface to push a file. The file name, type, and +url are required parameters. + +p_type is a mime type, such as "image/jpeg" + +An optional body message can be passed as body on the parameter hash. + +Pushbullet offers a storage service that can be used to upload and store files +for pushing. Currently, this feature is not enabled in MisterHouse. + +=cut + +sub push_file { + my ( $self, $file_name, $file_type, $file_url, $params ) = @_; + + $params = $self->_check_params_hash($params); + $params->{type} = "file"; #Force type to note when using this function + $params->{file_name} = $file_name || " "; + $params->{file_type} = $file_type || " "; + $params->{file_url} = $file_url || " "; + $params->{action} = "POST"; + $params->{path} = "v2/pushes"; return $self->push_hash($params); } @@ -176,7 +307,9 @@ http://docs.pushbullet.com body => "Note text", title => "Some title", # Override title of message token => "xxxx...", # Override the API Token - probably not useful - device_iden => "xxxx..." # The device to which the note should be sent to + device_iden => "xxxx...", # The device to which the note should be sent to + action => "POST", # The request type to use (GET, POST, DELETE) + path => "v2/pushes" # This is the general path, some functions use slightly diff paths }); By default, the device_iden is left blank, which causes the pushes to be sent to @@ -189,36 +322,36 @@ sub push_hash { my $callparams = {}; - # Allow passed parameter to override global disable parameter - my $disable = $self->{config}{disable}; + # Load Ini Params if no other param specified can be overridden + foreach (keys $self->{config}) { + $params->{$_} = $self->{config}{$_} unless defined $params->{$_}; + } # Copy the calling hash since we need to modify it. if ( defined $params && ref($params) eq 'HASH' ) { foreach ( keys %{$params} ) { - $disable = $params->{$_} if ( $_ eq 'disable' ); # Skip non-pushbullet parameters - next if (grep(/$_/i, @{['disable', 'speak', 'server']})); + next if ($_ =~ /(disable|speak|server|action|token|path)/); $callparams->{$_} = $params->{$_}; } } + # Allow passed parameter to override global disable parameter + my $disable = $params->{disable}; my $note = ($disable) ? '- Notifications disabled' : ''; - # Merge in the message defaults, They can be overridden - foreach (keys $self->{config}) { - $callparams->{$_} = $self->{config}{$_} unless defined $callparams->{$_}; - } - &::print_log( "[Pushbullet] Push Hash parameters: " . Data::Dumper::Dumper( \$callparams ) ) if TRACE; # Form browser and request my $browser = LWP::UserAgent->new; - my $req = HTTP::Request->new( POST => $self->{config}{server} . 'v2/pushes'); - $req->content(JSON::encode_json($callparams)); - $req->authorization_basic( $self->{config}{token}, "" ); - $req->content_type('application/json'); # Posting JSON content is preferred + my $req = HTTP::Request->new( $params->{action} => $params->{server} . $params->{path}); + if (keys $callparams){ + $req->content(JSON::encode_json($callparams)); + $req->content_type('application/json'); # Posting JSON content is preferred + } + $req->authorization_basic( $params->{token}, "" ); my $resp; # Do not perform reqest if disabled $resp = $browser->request( $req ) unless ($disable); @@ -229,7 +362,7 @@ sub push_hash { $description = $callparams->{body} if (defined $callparams->{body}); &::print_log("[Pushbullet] message: $description $note"); &::speak("Pushbullet notification $description $note") - if $self->{config}{speak}; + if $params->{speak}; return if $disable; # Don't check the response if posting is disabled @@ -253,7 +386,55 @@ sub push_hash { } } -sub check_params_hash { +=item C + +This can be used to delete a push. The only required parameter is the p_push_iden. +This is the hash identification which is returned by the push_ functions. + +For example, you may only want a notification to last an hour: + + $push_timer = new Timer; + my $push_iden = $push->push_note("MisterHouse", "Good morning"); + set $push_timer 60*60, "get_object_by_name('push')->delete_push('$push_iden');"; + +The above code will require that you have registered the object by name using +register_object_by_name. + +=cut + +sub delete_push { + my ($self, $push_iden, $params) = @_; + + $params = $self->_check_params_hash($params); + $params->{action} = "DELETE"; + $params->{path} = "v2/pushes/" . $push_iden; + + return $self->push_hash($params); + +} + +sub get_push_history { + # Not yet supported + return 1; +} + +sub get_device_list { + # Not yet supported + return 1; +} + +sub get_contact_list { + # Not yet supported + return 1; +} + +sub upload_file { + # Not yet supported + return 1; +} + + +sub _check_params_hash { my ($self, $params) = @_; if ( defined $params && ref($params) ne 'HASH' ) { &::print_log( From 25040ba77be23dffae5cd3e87789b8d02839796e Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Fri, 27 Jun 2014 17:19:04 -0700 Subject: [PATCH 142/180] Pushbullet: Disable Trace --- lib/Pushbullet.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Pushbullet.pm b/lib/Pushbullet.pm index 94fc49c61..b718650d9 100644 --- a/lib/Pushbullet.pm +++ b/lib/Pushbullet.pm @@ -72,7 +72,7 @@ use Data::Dumper; use LWP::UserAgent; use JSON; -use constant TRACE => 1; # enable for verbose tracing +use constant TRACE => 0; # enable for verbose tracing =head2 METHODS From a529cb720a00d3daaa618f0a0cb164062d0bc419 Mon Sep 17 00:00:00 2001 From: JaredF Date: Mon, 7 Jul 2014 23:13:48 -0700 Subject: [PATCH 143/180] Fixes Stocks.pl 'Missing Symbols List' Error --- code/common/stocks.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/code/common/stocks.pl b/code/common/stocks.pl index bf4430ced..7c8b4d9b8 100644 --- a/code/common/stocks.pl +++ b/code/common/stocks.pl @@ -25,7 +25,7 @@ # More info on how this magic url was derived can be found here: # http://www.padz.net/~djpadz/YahooQuote/ -my $stock_url = 'http://quote.yahoo.com/d?f=snl1d1t1c1p2va2bapomwerr1dyj1x\&s=' . join('%20', @stock_symbols); +my $stock_url = 'http://download.finance.yahoo.com/d?f=snl1d1t1c1p2va2bapomwerr1dyj1x\&s=' . join('%20', @stock_symbols); my @stock_keys = ('SName', 'LName', 'Last', 'Date', 'Time', 'Change', 'PChange', 'Volume', 'Avg Volume', 'Bid', 'Ask', 'Prev Close', 'Open', 'Day Range', '52-Week Range', 'EPS', 'P/E Ratio', 'Div Pay Date', From 94eda5ada079e6e1977aaf21b8263261cea86d8d Mon Sep 17 00:00:00 2001 From: JaredF Date: Sat, 12 Jul 2014 11:44:14 -0700 Subject: [PATCH 144/180] Updates and fixes for weather_pollen.pl --- code/common/weather_pollen.pl | 55 ++++++++++++++++++++++++++--------- 1 file changed, 42 insertions(+), 13 deletions(-) diff --git a/code/common/weather_pollen.pl b/code/common/weather_pollen.pl index 09a64c404..8c6bd46d6 100644 --- a/code/common/weather_pollen.pl +++ b/code/common/weather_pollen.pl @@ -1,11 +1,11 @@ #Category=Weather -#@ This module gets the pollen forecast from www.pollen.com and puts the pollen +#@ This module gets the pollen forecast from wunderground.com and puts the pollen #@ type and pollen count into the %Weather hash. #@ #@ Uses mh.ini parameter zip_code -# get pollen count forecast from www.pollen.com and put it and the pollen +# Get pollen count forecast from wunderground.com and put it and the pollen # type into the %Weather hash. # Technically there is a 4 day forecast, but I have seen it vary so widely # from day 2 and what day 1 will say tomorrow that I don't count on it for @@ -14,36 +14,65 @@ #uses mh.ini parameter zip_code= # #info from: -#http://www.pollen.com/forecast.asp?PostalCode=64119 +#http://www.wunderground.com/DisplayPollen.asp?Zipcode=64119 +# +# weather_pollen.pl +# Original Author: Kent Noonan +# Revision: 1.3 +# Date: 07/12/2014 + +=begin comment + + 1.0 Initial Release + Kent Noonan - ca. 12/16/2001 + 1.1 Revisions + David J. Mark - 06/12/2006 + 1.2 Updated to use new Trigger design. + Bruce Winter - 06/25/2006 + 1.3 Updated to use Wunderground instead of Pollen.com because + Pollen.com has added annoying countermeasures to prevent + screenscraping that would take much more code to parse. Plus, + their encryption scheme could change at anytime, breaking the + script again. Wunderground is perfect in this case because the data is + much easier to scrape and they actually receive their pollen data from + Pollen.com anyway. I've also done some general cleanup & added + a log message to warn if parsing fails. + Jared J. Fernandez - 07/12/2014 + +=cut $v_get_pollen_forecast = new Voice_Cmd('[Get,Check] pollen forecast'); -# *** set info +$v_get_pollen_forecast->set_info("Downloads and parses the pollen forecast page from wunderground.com. The 'check' option reads out the result after parsing is complete."); $v_read_pollen_forecast = new Voice_Cmd('Read pollen forecast'); +$v_read_pollen_forecast->set_info("Reads out the previously fetched pollen forecast"); -$p_pollen_forecast = new Process_Item("get_url http://www.pollen.com/forecast.asp?postalcode=$config_parms{zip_code} $config_parms{data_dir}/web/pollen_forecast.html"); +$p_pollen_forecast = new Process_Item("get_url http://www.wunderground.com/DisplayPollen.asp?Zipcode=$config_parms{zip_code} $config_parms{data_dir}/web/pollen_forecast.html"); &parse_pollen_forecast if $Reload; sub parse_pollen_forecast { - my $count1; + my ($found1,$found2); open(FILE,"$config_parms{data_dir}/web/pollen_forecast.html"); while () { - if (/Predominant pollen:\s+(.+)\.<\/A>/i) { + if ((/Pollen Type:<\/strong>\s(\w+)\.<\/h3>/) && (!defined($found1))) { + $found1 = 1; $main::Weather{TodayPollenType}=$1; - } elsif ((/fimages\/std\/(\d+\.\d).gif/i) and (!defined($count1))) { - $count1="r"; + } elsif ((/

(\d+\.\d+)<\/p>/) && (!defined($found2))) { + $found2 = 1; $main::Weather{TodayPollenCount}=$1; } - + last if ($found1 && $found2); } close(FILE); + unless ($found1 && $found2) { + warn "Error parsing pollen info."; + } } - if ($state = said $v_get_pollen_forecast) { $v_get_pollen_forecast->respond("app=pollen Retrieving pollen forecast..."); start $p_pollen_forecast; @@ -52,7 +81,7 @@ sub parse_pollen_forecast { if (done_now $p_pollen_forecast){ &parse_pollen_forecast(); if ($v_get_pollen_forecast->{state} eq 'Check') { - $v_get_pollen_forecast->respond("app=pollen Today's pollen count is $main::Weather{TodayPollenCount}. The predominant pollens are " . lc($main::Weather{TodayPollenType})); + $v_get_pollen_forecast->respond("app=pollen Today's pollen count is $main::Weather{TodayPollenCount}. The predominant pollens are from " . lc($main::Weather{TodayPollenType} . ".")); } else { $v_get_pollen_forecast->respond("app=pollen Pollen forecast retrieved"); @@ -63,7 +92,7 @@ sub parse_pollen_forecast { if (said $v_read_pollen_forecast) { if ($Weather{TodayPollenCount}) { - $v_read_pollen_forecast->respond("app=pollen Today's pollen count is $main::Weather{TodayPollenCount}. The predominant pollens are " . lc($main::Weather{TodayPollenType})); + $v_read_pollen_forecast->respond("app=pollen Today's pollen count is $main::Weather{TodayPollenCount}. The predominant pollens are from " . lc($main::Weather{TodayPollenType}) . "."); } else { $v_read_pollen_forecast->respond("app=pollen I do not know the pollen count at the moment."); From ae138ba388b7481f491c47b438cc30d0ebce7bf4 Mon Sep 17 00:00:00 2001 From: JaredF Date: Mon, 7 Jul 2014 23:13:48 -0700 Subject: [PATCH 145/180] Fixes Stocks.pl 'Missing Symbols List' Error --- code/common/stocks.pl | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/code/common/stocks.pl b/code/common/stocks.pl index bf4430ced..97878b037 100644 --- a/code/common/stocks.pl +++ b/code/common/stocks.pl @@ -25,7 +25,7 @@ # More info on how this magic url was derived can be found here: # http://www.padz.net/~djpadz/YahooQuote/ -my $stock_url = 'http://quote.yahoo.com/d?f=snl1d1t1c1p2va2bapomwerr1dyj1x\&s=' . join('%20', @stock_symbols); +my $stock_url = 'http://download.finance.yahoo.com/d?f=snl1d1t1c1p2va2bapomwerr1dyj1x\&s=' . join('%20', @stock_symbols); my @stock_keys = ('SName', 'LName', 'Last', 'Date', 'Time', 'Change', 'PChange', 'Volume', 'Avg Volume', 'Bid', 'Ask', 'Prev Close', 'Open', 'Day Range', '52-Week Range', 'EPS', 'P/E Ratio', 'Div Pay Date', @@ -198,6 +198,8 @@ unless &trigger_get('get stocks'); } +# 07 Jul 14, Jared J. Fernandez +# Updated stocks URL due to change by Yahoo. # 27 Dec 05, David Norwood # Someone else also added back the stock alerts in the last release. I removed the duplicate code. From 27e7decc3031f62c2fe77e4f6a73087099f3e7a7 Mon Sep 17 00:00:00 2001 From: JaredF Date: Mon, 14 Jul 2014 23:58:31 -0700 Subject: [PATCH 146/180] Changed to use Claritin.com's JSON service. --- code/common/weather_pollen.pl | 68 ++++++++++++++++------------------- 1 file changed, 31 insertions(+), 37 deletions(-) diff --git a/code/common/weather_pollen.pl b/code/common/weather_pollen.pl index 8c6bd46d6..ac96ae54a 100644 --- a/code/common/weather_pollen.pl +++ b/code/common/weather_pollen.pl @@ -1,11 +1,11 @@ #Category=Weather -#@ This module gets the pollen forecast from wunderground.com and puts the pollen +#@ This module gets the pollen forecast from Claritin.com and puts the predominant pollen #@ type and pollen count into the %Weather hash. #@ #@ Uses mh.ini parameter zip_code -# Get pollen count forecast from wunderground.com and put it and the pollen +# Get pollen count forecast from Claritin.com and put it and the predominant pollen # type into the %Weather hash. # Technically there is a 4 day forecast, but I have seen it vary so widely # from day 2 and what day 1 will say tomorrow that I don't count on it for @@ -14,13 +14,13 @@ #uses mh.ini parameter zip_code= # #info from: -#http://www.wunderground.com/DisplayPollen.asp?Zipcode=64119 +#http://www.claritin.com/weatherpollenservice/weatherpollenservice.svc/getforecast/64119 # # weather_pollen.pl # Original Author: Kent Noonan # Revision: 1.3 -# Date: 07/12/2014 +# Date: 07/14/2014 =begin comment @@ -30,47 +30,43 @@ David J. Mark - 06/12/2006 1.2 Updated to use new Trigger design. Bruce Winter - 06/25/2006 - 1.3 Updated to use Wunderground instead of Pollen.com because - Pollen.com has added annoying countermeasures to prevent - screenscraping that would take much more code to parse. Plus, - their encryption scheme could change at anytime, breaking the - script again. Wunderground is perfect in this case because the data is - much easier to scrape and they actually receive their pollen data from - Pollen.com anyway. I've also done some general cleanup & added - a log message to warn if parsing fails. - Jared J. Fernandez - 07/12/2014 + 1.3 Updated to use the JSON WeatherPollenService from Claratin.com + since Pollen.com has added countermeasures to prevent screenscraping + that would take much more code to parse. The WeatherPollenService + has a better API that seems to provide the same data as most other + online pollen forecasting services. In addition to switching service + providers, I've also done some general cleanup & improvements. + Jared J. Fernandez - 07/14/2014 =cut +use JSON qw( decode_json ); + +my $pollen_file = "$config_parms{data_dir}/web/pollen_forecast.json"; + $v_get_pollen_forecast = new Voice_Cmd('[Get,Check] pollen forecast'); -$v_get_pollen_forecast->set_info("Downloads and parses the pollen forecast page from wunderground.com. The 'check' option reads out the result after parsing is complete."); +$v_get_pollen_forecast->set_info("Downloads and parses the pollen forecast data. The 'check' option reads out the result after parsing is complete."); $v_read_pollen_forecast = new Voice_Cmd('Read pollen forecast'); -$v_read_pollen_forecast->set_info("Reads out the previously fetched pollen forecast"); +$v_read_pollen_forecast->set_info("Reads out the previously fetched pollen forecast."); -$p_pollen_forecast = new Process_Item("get_url http://www.wunderground.com/DisplayPollen.asp?Zipcode=$config_parms{zip_code} $config_parms{data_dir}/web/pollen_forecast.html"); +$p_pollen_forecast = new Process_Item("get_url http://www.claritin.com/weatherpollenservice/weatherpollenservice.svc/getforecast/$config_parms{zip_code} $pollen_file"); -&parse_pollen_forecast if $Reload; +&parse_pollen_forecast if (($Reload) && (-e $pollen_file)); sub parse_pollen_forecast { - - my ($found1,$found2); - open(FILE,"$config_parms{data_dir}/web/pollen_forecast.html"); - while () { - if ((/Pollen Type:<\/strong>\s(\w+)\.<\/h3>/) && (!defined($found1))) { - $found1 = 1; - $main::Weather{TodayPollenType}=$1; - } elsif ((/

(\d+\.\d+)<\/p>/) && (!defined($found2))) { - $found2 = 1; - $main::Weather{TodayPollenCount}=$1; - } - last if ($found1 && $found2); - } - close(FILE); - unless ($found1 && $found2) { - warn "Error parsing pollen info."; + my @pollen_data = file_read($pollen_file) || warn "Unable to open pollen data file."; + # The JSON file that is retuned by the service is malformed; these substitutions clean it up so that the perl JSON module can parse it. + for (@pollen_data) { + s/\"\{/\{/; + s/\\//g; + s/\}\"/\}/; } - + my $json = decode_json(@pollen_data) || warn "Error parsing pollen info from file."; + $main::Weather{TodayPollenCount} = $json->{pollenForecast}{forecast}[0]; + $main::Weather{TomorrowPollenCount} = $json->{pollenForecast}{forecast}[1]; + $main::Weather{TodayPollenType} = $json->{pollenForecast}{pp}; + $main::Weather{TodayPollenType} =~ s/\.//; } if ($state = said $v_get_pollen_forecast) { @@ -84,10 +80,8 @@ sub parse_pollen_forecast { $v_get_pollen_forecast->respond("app=pollen Today's pollen count is $main::Weather{TodayPollenCount}. The predominant pollens are from " . lc($main::Weather{TodayPollenType} . ".")); } else { - $v_get_pollen_forecast->respond("app=pollen Pollen forecast retrieved"); + $v_get_pollen_forecast->respond("app=pollen Pollen forecast retrieved."); } - - } if (said $v_read_pollen_forecast) { From a8225ea4da35b61ea945cde11572bd6848483e06 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Tue, 15 Jul 2014 17:45:00 -0700 Subject: [PATCH 147/180] Insteon/X10: Skip Calling Set_Receive on PLM Not clear on what this does for a general X10 interface, but the Insteon PLM has no state, therefore it has no set_receive command. The safest thing to do is just to skip this call for Insteon PLMs. --- lib/X10_Items.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/X10_Items.pm b/lib/X10_Items.pm index 343a560b8..02091c261 100644 --- a/lib/X10_Items.pm +++ b/lib/X10_Items.pm @@ -423,7 +423,8 @@ sub set_receive { &set_x10_level($self, $state); $self->SUPER::set_receive($state, $set_by); - $self->{interface}->set_receive($state, $set_by); + $self->{interface}->set_receive($state, $set_by) + unless $self->{interface}->isa('Insteon_PLM'; } =item C From d0b69a5d6a6aed322420aa38c72274af456687c8 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Tue, 15 Jul 2014 17:45:00 -0700 Subject: [PATCH 148/180] Insteon/X10: Fix absent Parenthesis --- lib/X10_Items.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/X10_Items.pm b/lib/X10_Items.pm index 02091c261..bf5855611 100644 --- a/lib/X10_Items.pm +++ b/lib/X10_Items.pm @@ -424,7 +424,7 @@ sub set_receive { &set_x10_level($self, $state); $self->SUPER::set_receive($state, $set_by); $self->{interface}->set_receive($state, $set_by) - unless $self->{interface}->isa('Insteon_PLM'; + unless $self->{interface}->isa('Insteon_PLM'); } =item C From 275aff23abceaad0b1e18366d625d9c1f7ec1176 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 19 Jul 2014 10:11:51 -0700 Subject: [PATCH 149/180] Nest: First Draft of Nest Support - Adds read-only support for Nest Thermostats - Very little documentation --- lib/Nest.pm | 531 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 531 insertions(+) create mode 100644 lib/Nest.pm diff --git a/lib/Nest.pm b/lib/Nest.pm new file mode 100644 index 000000000..80742c68c --- /dev/null +++ b/lib/Nest.pm @@ -0,0 +1,531 @@ +package Nest_Interface; + +use strict; +use JSON; +use IO::Socket::SSL; +use IO::Socket::INET; +use IO::Select; +use URI::URL; +use HTTP::Response; +use HTTP::Request; + +@Nest::ISA = ('Socket_Item'); + +sub new { + my ($class, $port_name, $url) = @_; + my $self = {}; + $port_name = 'Nest' if !$port_name; + $$self{port_name} = $port_name; + $$self{url} = $url; + $$self{children} = []; + bless $self, $class; + $self->connect_stream($$self{url}); + return $self; +} + +sub connect_stream { + my ($self, $url) = @_; + $url = new URI::URL $url; + + if (defined $$self{socket}) { + $$self{socket}->close; + } + + $$self{socket} = IO::Socket::INET->new( + PeerHost => $url->host, PeerPort => $url->port, Blocking => 0 + ) or die $@; # first create simple N-B socket with IO::Socket::INET + + my $select = IO::Select->new($$self{socket}); # wait until it connected + if ($select->can_write) { + ::print_log "[Nest Interface] IO::Socket::INET connected"; + } + + # upgrade socket to IO::Socket::SSL + IO::Socket::SSL->start_SSL($$self{socket}, SSL_startHandshake => 0); + + # make non-blocking SSL handshake + while (1) { + if ($$self{socket}->connect_SSL) { # will not block + ::print_log "[Nest Interface] IO::Socket::SSL connected"; + last; + } + else { # handshake still incomplete + #::print_log "[Nest Interface] IO::Socket::SSL not connected yet"; + if ($SSL_ERROR == SSL_WANT_READ) { + $select->can_read; + } + elsif ($SSL_ERROR == SSL_WANT_WRITE) { + $select->can_write; + } + else { + die "[Nest Interface] IO::Socket::SSL unknown error: ", $SSL_ERROR; + } + } + } + + # Request specific location + my $request = HTTP::Request->new( + 'GET', + $url->full_path, + ["Accept", "text/event-stream", "Host", $url->host] + ); + $request->protocol('HTTP/1.1'); + #print "requesting data:\n" . $request->as_string; + $$self{socket}->syswrite($request->as_string) or die $!; + + # The first frame seems to always be the HTTP response without content + if ($select->can_read && $$self{socket}->sysread(my $buf, 1024)) { + my $r = HTTP::Response->parse( $buf ); + if ($r->code == 307){ + # This is a location redirect + $$self{socket}->close; + print "redirecting to " . $r->header( 'location' ) . "\n"; + $$self{socket} = $self->connect_stream($r->header( 'location' )); + } + elsif ($r->code == 401){ + die ("Error, your authorization was rejected. Please check your settings."); + } + elsif ($r->code == 200){ + # Successful response + print "Success: \n" . $r->as_string . "\n"; + $$self{'keep-alive'} = time; + } + else { + die ( + "Error unable to connect to stream response was: \n". + $r->as_string + ); + } + } + + return $$self{socket}; +} + +sub check_for_data { + my ($self) = @_; + if ($$self{socket}->connected && (time - $$self{'keep-alive'} < 70)) { + # sysread will only read the contents of a single SSL frame + if ($$self{socket}->sysread(my $buf, 1024)){ + $$self{data} .= $buf; + if ($buf =~ /\n\n$/){ + # We reached the end of the message packet + ::print_log("[Nest Data]" . $$self{data}); + + # Split out event and data for processing + my @lines = split("\n", $$self{data}); + my ($event, $data); + for (@lines){ + # Pull out events and data + my ($key, $value) = split(":", $_,2); + if ($key =~ /event/){ + $event = $value; + } + elsif ($key =~ /data/ && defined($event)){ + $data = $value; + } + + if (defined($event) && defined($data)){ + $self->parse_data($event, $data); + $event = ''; + $data = ''; + } + } + + # Clear data storage + $$self{data} = ""; + } + } + } + else { + # The connection died, or the keep-alive messages stopped, restart it + ::print_log("[Nest Interface] Connection died, restarting"); + $self->connect_stream($$self{url}); + } +} + +sub parse_data { + my ($self, $event, $data) = @_; + if ($event =~ /keep-alive/){ + $$self{'keep-alive'} = time; + ::print_log("[Nest Keep Alive]"); + } + elsif ($event =~ /put/){ + $$self{'keep-alive'} = time; + #This is the first JSON packet received after connecting + $$self{prev_JSON} = $$self{JSON}; + $$self{JSON} = decode_json $data; + if (!defined $$self{prev_JSON}){ + #this is the first run so convert the names to ids + $self->convert_to_ids($$self{monitor}); + } + $self->compare_json($$self{JSON}, $$self{prev_JSON}, $$self{monitor}); + } + elsif ($event =~ /auth_revoked/){ + # Sent when auth parameter is no longer valid + # Accoring to Nest, the auth token is essentially non-expiring, + # so this shouldn't happen. + die ("[Nest] The Nest authorization token has expired"); + } + return; +} + +sub print_devices { + my ($self) = @_; + my $output = "[Nest] The list of devices reported by Nest is:\n"; + for (keys %{$$self{JSON}{data}{devices}}){ + my $device_type = $_; + $output .= " $device_type =\n"; + for (keys %{$$self{JSON}{data}{devices}{$device_type}}){ + my $device_id = $_; + my $device_name = $$self{JSON}{data}{devices}{$device_type} + {$device_id}{name}; + $output .= " Name: $device_name ID: $device_id\n"; + } + } + ::print_log($output); +} + +sub print_structures { + my ($self) = @_; + my $output = "[Nest] The list of structures reported by Nest is:\n"; + for (keys %{$$self{JSON}{data}{structures}}){ + my $structure_id = $_; + my $structure_name = $$self{JSON}{data}{structures}{$structure_id}{name}; + $output .= " Name: $structure_name ID: $structure_id\n"; + } + ::print_log($output); +} + +# Used to register actions to take when a specific JSON value changes +# the variables $value and $state will be expanded on eval and will +# contain the name of the value that has changed and its new state + +sub register { + my ($self, $parent, $object, $value, $action) = @_; + push (@{$$self{register}}, [$parent, $object, $value,$action]); +} + +# Walk through the JSON hash and looks for changes from previous json hash if a +# change is found, looks for children to notify and notifies them. + +sub compare_json { + my ($self, $json, $prev_json, $monitor_hash) = @_; + while (my ($key, $value) = each %{$json}) { + # Use empty hash reference is it doesn't exist + my $prev_value = {}; + $prev_value = $$prev_json{$key} if exists $$prev_json{$key}; + my $monitior_value = {}; + $monitior_value = $$monitor_hash{$key} if exists $$monitor_hash{$key}; + if ('HASH' eq ref $value) { + $self->compare_json($value, $prev_value, $monitior_value); + } + elsif ($value ne $prev_value && ref $monitior_value eq 'ARRAY') { + for my $action (@{$monitior_value}){ + ::print_log("[Nest] eval'ing $action"); + package main; + eval($action); + ::print_log("[Nest] error in evaling action: " . $@) + if $@; + package Nest_Interface; + } + } + } +} + +##Converts the names in the register hash to IDs, and then puts them into +# the monitor hash. + +sub convert_to_ids { + my ($self) = @_; + for my $array_ref (@{$$self{register}}){ + my ($parent, $object, $value, $action) = @{$array_ref}; + my $device_id = $parent->device_id(); + if ($action eq ''){ + $action = $object->get_object_name . '->data_changed($key,$value)'; + } + if ($$parent{type} ne '') { + push(@{$$self{monitor}{data}{$$parent{class}}{$$parent{type}}{$device_id}{$value}},$action); + } + else { + push(@{$$self{monitor}{data}{$$parent{class}}{$device_id}{$value}},$action); + } + } + delete $$self{register}; +} + +package Nest_Child; + +use strict; + +@Nest_Child::ISA = ('Generic_Item'); + +sub new { + my ($class, $interface, $parent, $monitor_hash) = @_; + my $self = new Generic_Item(); + bless $self, $class; + $$self{interface} = $interface; + $$self{parent} = $parent; + $$self{parent} = $self if ($$self{parent} eq ''); + while (my ($monitor_value, $action) = each %{$monitor_hash}){ + $$self{interface}->register($$self{parent}, $self, $monitor_value, $action); + } + return $self; +} + +sub device_id { + my ($self) = @_; + my $type_hash; + if (defined $$self{type}) { + $type_hash = $$self{interface}{JSON}{data}{$$self{class}}{$$self{type}}; + } + else { + $type_hash = $$self{interface}{JSON}{data}{$$self{class}}; + } + for (keys %{$type_hash}){ + my $device_id = $_; + my $device_name = $$type_hash{$device_id}{name}; + if ($$self{name} eq $device_id || ($$self{name} eq $device_name)) { + return $device_id; + } + } + ::print_log("[Nest] ERROR, no device by the name " . $$self{name} . " was found."); + return 0; +} + +# Called by data_updated if data has changed. In most cases we can ignore the +# value name and just set the state of the child to new_value more sophisticated +# children can hijack this method to do more complex tasks + +sub data_changed { + my ($self, $value_name, $new_value) = @_; + ::print_log("[Nest] Data changed called $value_name, $new_value"); + $self->set_receive($new_value); +} + +sub set_receive { + my ($self, $p_state, $p_setby, $p_response) = @_; + $self->SUPER::set($p_state, $p_setby, $p_response); +} + +package Nest_Thermostat; + +use strict; + +@Nest_Thermostat::ISA = ('Nest_Child'); + +sub new { + my ($class, $name, $interface, $scale) = @_; + $scale = lc($scale); + $scale = "f" unless ($scale eq "c"); + my $monitor_value = "ambient_temperature_" . $scale; + my $self = new Nest_Child($interface, '', {$monitor_value=>''}); + bless $self, $class; + $$self{class} = 'devices', + $$self{type} = 'thermostats', + $$self{name} = $name, + $$self{scale} = $scale; + return $self; +} + +sub get_value { + my ($self, $value) = @_; + my $device_id = $self->device_id; + return $$self{interface}{JSON}{data}{devices}{thermostats}{$device_id}{$value}; +} + +sub get_temp { + my ($self) = @_; + return $self->get_value("ambient_temperature_" . $$self{scale}); +} + +# Used in the combined Heat - Cool Mode Only + +sub get_heat_sp { + my ($self) = @_; + return $self->get_value("target_temperature_high_" . $$self{scale}); +} + +# Used in the combined Heat - Cool Mode Only + +sub get_cool_sp { + my ($self) = @_; + return $self->get_value("target_temperature_low_" . $$self{scale}); +} + +# Used in either the Heating or Cooling mode + +sub get_target_sp { + my ($self) = @_; + return $self->get_value("target_temperature_" . $$self{scale}); +} + +sub get_mode { + my ($self) = @_; + return $self->get_value("hvac_mode"); +} + +#sub get_fan_mode, can we just look at fan_timeout and see if expired? + +#Oddity, the humidity is listed on the Nest website, but there is no +#api access listed or reported for it yet + +# Similarly, the api doesn't tell us if the device is heating or cooling atm + +package Nest_Thermo_Fan; + +#FAN [on,off how long?] (on, off) + +use strict; + +@Nest_Thermo_Fan::ISA = ('Nest_Child'); + +sub new { + my ($class, $parent) = @_; + my $self = new Nest_Child( + $$parent{interface}, + $parent, + {'fan_timer_active'=>''} + ); + bless $self, $class; + return $self; +} + +sub set_receive { + my ($self, $p_state, $p_setby, $p_response) = @_; + my $state = "on"; + $state = "off" if ($p_state eq 'false'); + $self->SUPER::set($state, $p_setby, $p_response); +} + +package Nest_Thermo_Leaf; + +#Leaf [on,off] + +use strict; + +@Nest_Thermo_Leaf::ISA = ('Nest_Child'); + +sub new { + my ($class, $parent) = @_; + my $self = new Nest_Child( + $$parent{interface}, + $parent, + {'has_leaf'=>''} + ); + bless $self, $class; + return $self; +} + +sub set_receive { + my ($self, $p_state, $p_setby, $p_response) = @_; + my $state = "on"; + $state = "off" if ($p_state eq 'false'); + $self->SUPER::set($state, $p_setby, $p_response); +} + +package Nest_Thermo_Mode; + +#Mode [current] (heat, cool, off, heat/cool) + +use strict; + +@Nest_Thermo_Mode::ISA = ('Nest_Child'); + +sub new { + my ($class, $parent) = @_; + my $self = new Nest_Child( + $$parent{interface}, + $parent, + {'hvac_mode'=>''} + ); + bless $self, $class; + return $self; +} + +#Target temp [temp] (warmer, cooler) + +package Nest_Thermo_Target; +use strict; +@Nest_Thermo_Target::ISA = ('Nest_Child'); + +sub new { + my ($class, $parent) = @_; + my $scale = $$parent{scale}; + my $self = new Nest_Child( + $$parent{interface}, + $parent, + {'target_temperature_' . $scale => ''} + ); + bless $self, $class; + return $self; +} + +#Target high for heat-cool [temp] (warmer, cooler) +package Nest_Thermo_Target_High; +use strict; +@Nest_Thermo_Target_High::ISA = ('Nest_Child'); + +sub new { + my ($class, $parent) = @_; + my $scale = $$parent{scale}; + my $self = new Nest_Child( + $$parent{interface}, + $parent, + {'target_temperature_high_' . $scale => ''} + ); + bless $self, $class; + return $self; +} + +#Target low for heat-cool [temp] (warmer, cooler) +package Nest_Thermo_Target_Low; +use strict; +@Nest_Thermo_Target_Low::ISA = ('Nest_Child'); + +sub new { + my ($class, $parent) = @_; + my $scale = $$parent{scale}; + my $self = new Nest_Child( + $$parent{interface}, + $parent, + {'target_temperature_low_' . $scale => ''} + ); + bless $self, $class; + return $self; +} + +#Target high for heat-cool [temp] (warmer, cooler) +package Nest_Thermo_Away_High; +use strict; +@Nest_Thermo_Away_High::ISA = ('Nest_Child'); + +sub new { + my ($class, $parent) = @_; + my $scale = $$parent{scale}; + my $self = new Nest_Child( + $$parent{interface}, + $parent, + {'away_temperature_high_' . $scale => ''} + ); + bless $self, $class; + return $self; +} + +#Target low for heat-cool [temp] (warmer, cooler) +package Nest_Thermo_Away_Low; +use strict; +@Nest_Thermo_Away_Low::ISA = ('Nest_Child'); + +sub new { + my ($class, $parent) = @_; + my $scale = $$parent{scale}; + my $self = new Nest_Child( + $$parent{interface}, + $parent, + {'away_temperature_low_' . $scale => ''} + ); + bless $self, $class; + return $self; +} + +##Home/Away is in the structure \ No newline at end of file From 1859ca8615cf44784b8dae433ae6d6e1499fe04c Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 19 Jul 2014 10:18:39 -0700 Subject: [PATCH 150/180] Nest: Move Get_Value into Nest_Child This will make it usable on both structures and smoke detectors Change device_id so it checks the name of parent, unlikely that device-children will need to get their IDs but this way it will work as expected. --- lib/Nest.pm | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/lib/Nest.pm b/lib/Nest.pm index 80742c68c..91e815106 100644 --- a/lib/Nest.pm +++ b/lib/Nest.pm @@ -275,6 +275,7 @@ sub new { sub device_id { my ($self) = @_; my $type_hash; + my $parent = $$self{parent}; if (defined $$self{type}) { $type_hash = $$self{interface}{JSON}{data}{$$self{class}}{$$self{type}}; } @@ -284,11 +285,11 @@ sub device_id { for (keys %{$type_hash}){ my $device_id = $_; my $device_name = $$type_hash{$device_id}{name}; - if ($$self{name} eq $device_id || ($$self{name} eq $device_name)) { + if ($$parent{name} eq $device_id || ($$parent{name} eq $device_name)) { return $device_id; } } - ::print_log("[Nest] ERROR, no device by the name " . $$self{name} . " was found."); + ::print_log("[Nest] ERROR, no device by the name " . $$parent{name} . " was found."); return 0; } @@ -307,6 +308,17 @@ sub set_receive { $self->SUPER::set($p_state, $p_setby, $p_response); } +sub get_value { + my ($self, $value) = @_; + my $device_id = $self->device_id; + if ($$self{type} ne '') { + return $$self{interface}{JSON}{data}{$$self{class}}{$$self{type}}{$device_id}{$value}; + } + else { + return $$self{interface}{JSON}{data}{$$self{class}}{$device_id}{$value}; + } +} + package Nest_Thermostat; use strict; @@ -327,12 +339,6 @@ sub new { return $self; } -sub get_value { - my ($self, $value) = @_; - my $device_id = $self->device_id; - return $$self{interface}{JSON}{data}{devices}{thermostats}{$device_id}{$value}; -} - sub get_temp { my ($self) = @_; return $self->get_value("ambient_temperature_" . $$self{scale}); From c503731824358e37ab3e2e504f7d15cdea442112 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 19 Jul 2014 11:04:46 -0700 Subject: [PATCH 151/180] Nest: Add Support for Smoke/CO Alarm - Still very little documentation --- lib/Nest.pm | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) diff --git a/lib/Nest.pm b/lib/Nest.pm index 91e815106..f8972b866 100644 --- a/lib/Nest.pm +++ b/lib/Nest.pm @@ -534,4 +534,67 @@ sub new { return $self; } +package Nest_Smoke_CO_Alarm; + +use strict; + +@Nest_Smoke_CO_Alarm::ISA = ('Nest_Child'); + +sub new { + my ($class, $name, $interface) = @_; + my $self = new Nest_Child($interface, '', { + 'co_alarm_state'=>'', + 'smoke_alarm_state'=>'', + 'battery_health'=>'' + }); + bless $self, $class; + $$self{class} = 'devices', + $$self{type} = 'smoke_co_alarms', + $$self{name} = $name, + return $self; +} + +sub data_changed { + my ($self, $value_name, $new_value) = @_; + ::print_log("[Nest_Smoke_CO_Alarm] Data changed called $value_name, $new_value"); + $$self{$value_name} = $new_value; + my $state = ''; + if ($$self{co_alarm_state} eq 'emergency'){ + $state .= 'Emergency - CO Detected - move to fresh air'; + } + if ($$self{smoke_alarm_state} eq 'emergency'){ + $state .= " / " if $state ne ''; + $state .= 'Emergency - Smoke Detected - move to fresh air'; + } + if ($$self{co_alarm_state} eq 'warning'){ + $state .= " / " if $state ne ''; + $state .= 'Warning - CO Detected'; + } + if ($$self{smoke_alarm_state} eq 'warning'){ + $state .= " / " if $state ne ''; + $state .= 'Warning - Smoke Detected'; + } + if ($$self{battery_health} eq 'replace'){ + $state .= " / " if $state ne ''; + $state .= 'Battery Low - replace soon'; + } + $state = 'ok' if ($state eq ''); + $self->set_receive($state); +} + +sub get_co { + my ($self) = @_; + return $self->get_value("co_alarm_state"); +} + +sub get_smoke { + my ($self) = @_; + return $self->get_value("smoke_alarm_state"); +} + +sub get_battery { + my ($self) = @_; + return $self->get_value("battery_health"); +} + ##Home/Away is in the structure \ No newline at end of file From 13477ca0a676c3365d17690026fc7a8d9d2a3f41 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 19 Jul 2014 11:23:55 -0700 Subject: [PATCH 152/180] Nest: Add Support for Structures --- lib/Nest.pm | 25 +++++++++++++++++++++++-- 1 file changed, 23 insertions(+), 2 deletions(-) diff --git a/lib/Nest.pm b/lib/Nest.pm index f8972b866..a7dff7757 100644 --- a/lib/Nest.pm +++ b/lib/Nest.pm @@ -276,7 +276,7 @@ sub device_id { my ($self) = @_; my $type_hash; my $parent = $$self{parent}; - if (defined $$self{type}) { + if ($$self{type} ne '') { $type_hash = $$self{interface}{JSON}{data}{$$self{class}}{$$self{type}}; } else { @@ -597,4 +597,25 @@ sub get_battery { return $self->get_value("battery_health"); } -##Home/Away is in the structure \ No newline at end of file +##Home/Away is in the structure + +package Nest_Structure; + +use strict; + +@Nest_Structure::ISA = ('Nest_Child'); + +sub new { + my ($class, $name, $interface) = @_; + my $self = new Nest_Child($interface, '', {'away'=>''}); + bless $self, $class; + $$self{class} = 'structures', + $$self{type} = '', + $$self{name} = $name, + return $self; +} + +sub get_away_status { + my ($self) = @_; + return $self->get_value("away"); +} \ No newline at end of file From 427eb990f9032fe6d9723075a2f759489fe7b40d Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 19 Jul 2014 13:26:35 -0700 Subject: [PATCH 153/180] Nest: Add Base Function for Sending Data to Nest Rearrange url and auth parameters --- lib/Nest.pm | 38 +++++++++++++++++++++++++++++++++++--- 1 file changed, 35 insertions(+), 3 deletions(-) diff --git a/lib/Nest.pm b/lib/Nest.pm index a7dff7757..dffe44523 100644 --- a/lib/Nest.pm +++ b/lib/Nest.pm @@ -12,19 +12,21 @@ use HTTP::Request; @Nest::ISA = ('Socket_Item'); sub new { - my ($class, $port_name, $url) = @_; + my ($class, $port_name, $auth, $url) = @_; my $self = {}; $port_name = 'Nest' if !$port_name; + $url = "https://developer-api.nest.com/.json" if !$url; $$self{port_name} = $port_name; $$self{url} = $url; - $$self{children} = []; + $$self{auth} = $auth; bless $self, $class; - $self->connect_stream($$self{url}); + $self->connect_stream(); return $self; } sub connect_stream { my ($self, $url) = @_; + $url = $$self{url} . "?auth=" . $$self{auth} if ($url eq ''); $url = new URI::URL $url; if (defined $$self{socket}) { @@ -169,6 +171,36 @@ sub parse_data { return; } +sub write_data { + my ($self, $parent, $value, $data, $url) = @_; + if ($url eq '') { + $url = 'https://developer-api.nest.com/'; + $url .= $$parent{class} . "/"; + $url .= $$parent{type} . "/" if ($$parent{type} ne ''); + $url .= $parent->device_id . "/"; + $url .= $value . "?auth=" . $$self{auth}; + } + ::print_log("Attempting $url"); + my $json = lc($data); + #true false and numbers should not have quotes + unless ($json eq 'true' || $json eq 'false' || $json =~ /^\d+(\.\d+)?$/){ + $json = '"' . $json . '"'; + } + my $req = HTTP::Request->new( 'PUT', $url ); + $req->header( 'Content-Type' => 'application/json' ); + $req->content( $json ); + $req->protocol('HTTP/1.1'); + ::print_log($req->as_string); + my $lwp = LWP::UserAgent->new; + my $r = $lwp->request( $req ); + if ($r->code == 307){ + # This is a location redirect + ::print_log "redirecting to " . $r->header( 'location' ) . "\n"; + return $self->write_data($parent, $value, $data, $r->header( 'location' )); + } + print $r->as_string; +} + sub print_devices { my ($self) = @_; my $output = "[Nest] The list of devices reported by Nest is:\n"; From 811f9a1b08953720a981c339181ded2c9bf243e8 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Sat, 19 Jul 2014 13:50:46 -0700 Subject: [PATCH 154/180] Nest: Add High Level Commands to Set Nest Values --- lib/Nest.pm | 67 +++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 65 insertions(+), 2 deletions(-) diff --git a/lib/Nest.pm b/lib/Nest.pm index dffe44523..eb6ed5895 100644 --- a/lib/Nest.pm +++ b/lib/Nest.pm @@ -402,7 +402,57 @@ sub get_mode { return $self->get_value("hvac_mode"); } -#sub get_fan_mode, can we just look at fan_timeout and see if expired? +sub get_fan_state { + my ($self) = @_; + return $self->get_value("fan_timer_active"); +} + +sub set_fan_state { + my ($self, $state) = @_; + $state = lc($state); + if ($state ne 'true' || $state ne 'false'){ + ::print_log("[Nest] set_fan_state must be true or false"); + return; + } + $$self{interface}->write_data($self, 'fan_timer_active', $state); +} + +sub set_target_temp { + my ($self, $state) = @_; + unless ($state =~ /^\d+(\.\d+)?$/){ + ::print_log("[Nest] set_target_temp must be a number"); + return; + } + $$self{interface}->write_data($self, 'target_temperature_' . $$self{scale}, $state); +} + +sub set_target_temp_high { + my ($self, $state) = @_; + unless ($state =~ /^\d+(\.\d+)?$/){ + ::print_log("[Nest] set_target_temp_high must be a number"); + return; + } + $$self{interface}->write_data($self, 'target_temperature_high_' . $$self{scale}, $state); +} + +sub set_target_temp_low { + my ($self, $state) = @_; + unless ($state =~ /^\d+(\.\d+)?$/){ + ::print_log("[Nest] set_target_temp_low must be a number"); + return; + } + $$self{interface}->write_data($self, 'target_temperature_low_' . $$self{scale}, $state); +} + +sub set_hvac_mode { + my ($self, $state) = @_; + $state = lc($state); + if ($state ne 'heat' || $state ne 'cool' || $state ne 'heat-cool' || $state ne 'off'){ + ::print_log("[Nest] set_hvac_mode must be one of: heat, cool, heat-cool, or off."); + return; + } + $$self{interface}->write_data($self, 'hvac_mode' . $$self{scale}, $state); +} #Oddity, the humidity is listed on the Nest website, but there is no #api access listed or reported for it yet @@ -650,4 +700,17 @@ sub new { sub get_away_status { my ($self) = @_; return $self->get_value("away"); -} \ No newline at end of file +} + +sub set_away_status { + my ($self, $state) = @_; + $state = lc($state); + if ($state ne 'home' || $state ne 'away'){ + ::print_log("[Nest] set_away_status must be either home or away."); + return; + } + $$self{interface}->write_data($self, 'away' . $$self{scale}, $state); +} + +#I did not add high level support for the ETA feature, although it can be +#set using the low level write_data function with a bit of work \ No newline at end of file From 026164995f9ed47dabc104c9e2f8abce9d32c341 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Mon, 21 Jul 2014 08:05:00 -0700 Subject: [PATCH 155/180] PushBullet: Fix Bug in Reading Token from ini; Fix example; Fix Error Message It looks like Pushbullet changed the structure of the JSON for error messages. This should now cause them to be printed for diagnostic purposes. Fixes issue reported in #422 by @hollie --- lib/Pushbullet.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/Pushbullet.pm b/lib/Pushbullet.pm index b718650d9..8569d204c 100644 --- a/lib/Pushbullet.pm +++ b/lib/Pushbullet.pm @@ -20,7 +20,7 @@ Create a pushbullet instance in the .mht file, or in user code: .mht file: CODE, require Pushbullet; #noloop - CODE, my $push = new Pushbullet(); #noloop + CODE, $push = new Pushbullet(); #noloop A user code file overriding parameters normally specified in mh.private.ini. All of the parameters are optional if properly configured in the ini file. @@ -117,7 +117,7 @@ sub new { # Only look for pushbullet settings if ($mkey =~ /^Pushbullet_(.*$)/) { # Drop the prefix - $self->{config}{$1} = $::config_parms{$1}; + $self->{config}{$1} = $::config_parms{"Pushbullet_".$1}; } } @@ -380,7 +380,7 @@ sub push_hash { } else { &::print_log( -"[Pushbullet] ERROR: POST Failed: Status: $decoded_json->{status} - $decoded_json->{errors} " +"[Pushbullet] ERROR: POST Failed: Status: $decoded_json->{error}{type} - $decoded_json->{error}{message} " ); return; } From 1a4b31be2597b5370bd63a020a04149dfa6e7795 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Mon, 21 Jul 2014 19:26:41 -0700 Subject: [PATCH 156/180] Insteon: Fix bug in Sync Links Which Prevented On Level Changes From Being Updated Fixes hollie/misterhouse#441 --- lib/Insteon/BaseInsteon.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Insteon/BaseInsteon.pm b/lib/Insteon/BaseInsteon.pm index a65d1b5dd..248ba7f01 100644 --- a/lib/Insteon/BaseInsteon.pm +++ b/lib/Insteon/BaseInsteon.pm @@ -3278,7 +3278,7 @@ sub sync_links $requires_update = 1; $cause .= "Ramp rate "; } - elsif ($cur_on_level-1 > $tgt_on_level && $cur_on_level+1 < $tgt_on_level){ + elsif ($cur_on_level-1 > $tgt_on_level || $cur_on_level+1 < $tgt_on_level){ $requires_update = 1; $cause .= "On level "; } From 054b54184c04ef8280fdf2564df842e64a389f14 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Mon, 21 Jul 2014 20:12:18 -0700 Subject: [PATCH 157/180] Nest: Make Child Objects Writable Including tracking setby and response variables --- lib/Nest.pm | 108 +++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 89 insertions(+), 19 deletions(-) diff --git a/lib/Nest.pm b/lib/Nest.pm index eb6ed5895..befc44937 100644 --- a/lib/Nest.pm +++ b/lib/Nest.pm @@ -180,7 +180,6 @@ sub write_data { $url .= $parent->device_id . "/"; $url .= $value . "?auth=" . $$self{auth}; } - ::print_log("Attempting $url"); my $json = lc($data); #true false and numbers should not have quotes unless ($json eq 'true' || $json eq 'false' || $json =~ /^\d+(\.\d+)?$/){ @@ -190,7 +189,6 @@ sub write_data { $req->header( 'Content-Type' => 'application/json' ); $req->content( $json ); $req->protocol('HTTP/1.1'); - ::print_log($req->as_string); my $lwp = LWP::UserAgent->new; my $r = $lwp->request( $req ); if ($r->code == 307){ @@ -198,7 +196,6 @@ sub write_data { ::print_log "redirecting to " . $r->header( 'location' ) . "\n"; return $self->write_data($parent, $value, $data, $r->header( 'location' )); } - print $r->as_string; } sub print_devices { @@ -337,6 +334,10 @@ sub data_changed { sub set_receive { my ($self, $p_state, $p_setby, $p_response) = @_; + if (defined $$self{parent}{state_pending}){ + ($p_setby, $p_response) = @{$$self{parent}{state_pending}}; + delete $$self{parent}{state_pending}; + } $self->SUPER::set($p_state, $p_setby, $p_response); } @@ -408,50 +409,55 @@ sub get_fan_state { } sub set_fan_state { - my ($self, $state) = @_; + my ($self, $state, $p_setby, $p_response) = @_; $state = lc($state); - if ($state ne 'true' || $state ne 'false'){ + if ($state ne 'true' && $state ne 'false'){ ::print_log("[Nest] set_fan_state must be true or false"); return; } $$self{interface}->write_data($self, 'fan_timer_active', $state); + $$self{state_pending} = [$p_setby, $p_response]; } sub set_target_temp { - my ($self, $state) = @_; + my ($self, $state, $p_setby, $p_response) = @_; unless ($state =~ /^\d+(\.\d+)?$/){ ::print_log("[Nest] set_target_temp must be a number"); return; } $$self{interface}->write_data($self, 'target_temperature_' . $$self{scale}, $state); + $$self{state_pending} = [$p_setby, $p_response]; } sub set_target_temp_high { - my ($self, $state) = @_; + my ($self, $state, $p_setby, $p_response) = @_; unless ($state =~ /^\d+(\.\d+)?$/){ ::print_log("[Nest] set_target_temp_high must be a number"); return; } $$self{interface}->write_data($self, 'target_temperature_high_' . $$self{scale}, $state); + $$self{state_pending} = [$p_setby, $p_response]; } sub set_target_temp_low { - my ($self, $state) = @_; + my ($self, $state, $p_setby, $p_response) = @_; unless ($state =~ /^\d+(\.\d+)?$/){ ::print_log("[Nest] set_target_temp_low must be a number"); return; } $$self{interface}->write_data($self, 'target_temperature_low_' . $$self{scale}, $state); + $$self{state_pending} = [$p_setby, $p_response]; } sub set_hvac_mode { - my ($self, $state) = @_; + my ($self, $state, $p_setby, $p_response) = @_; $state = lc($state); - if ($state ne 'heat' || $state ne 'cool' || $state ne 'heat-cool' || $state ne 'off'){ - ::print_log("[Nest] set_hvac_mode must be one of: heat, cool, heat-cool, or off."); + if ($state ne 'heat' && $state ne 'cool' && $state ne 'heat-cool' && $state ne 'off'){ + ::print_log("[Nest] set_hvac_mode must be one of: heat, cool, heat-cool, or off. Not $state."); return; } - $$self{interface}->write_data($self, 'hvac_mode' . $$self{scale}, $state); + $$self{state_pending} = [$p_setby, $p_response]; + $$self{interface}->write_data($self, 'hvac_mode', $state); } #Oddity, the humidity is listed on the Nest website, but there is no @@ -461,8 +467,6 @@ sub set_hvac_mode { package Nest_Thermo_Fan; -#FAN [on,off how long?] (on, off) - use strict; @Nest_Thermo_Fan::ISA = ('Nest_Child'); @@ -474,6 +478,7 @@ sub new { $parent, {'fan_timer_active'=>''} ); + $$self{states} = ['on','off']; bless $self, $class; return $self; } @@ -482,9 +487,20 @@ sub set_receive { my ($self, $p_state, $p_setby, $p_response) = @_; my $state = "on"; $state = "off" if ($p_state eq 'false'); + if (defined $$self{parent}{state_pending}){ + ($p_setby, $p_response) = @{$$self{parent}{state_pending}}; + delete $$self{parent}{state_pending}; + } $self->SUPER::set($state, $p_setby, $p_response); } +sub set { + my ($self, $p_state, $p_setby, $p_response) = @_; + $p_state = "true" if (lc($p_state) eq 'on'); + $p_state = "false" if (lc($p_state) eq 'off'); + $$self{parent}->set_fan_state($p_state,$p_setby,$p_response); +} + package Nest_Thermo_Leaf; #Leaf [on,off] @@ -508,6 +524,10 @@ sub set_receive { my ($self, $p_state, $p_setby, $p_response) = @_; my $state = "on"; $state = "off" if ($p_state eq 'false'); + if (defined $$self{parent}{state_pending}){ + ($p_setby, $p_response) = @{$$self{parent}{state_pending}}; + delete $$self{parent}{state_pending}; + } $self->SUPER::set($state, $p_setby, $p_response); } @@ -526,10 +546,17 @@ sub new { $parent, {'hvac_mode'=>''} ); + $$self{states} = ['heat', 'cool', 'heat-cool', 'off']; bless $self, $class; return $self; } +sub set { + my ($self, $p_state, $p_setby, $p_response) = @_; + ::print_log("Setting $p_setby, $p_response"); + $$self{parent}->set_hvac_mode($p_state,$p_setby,$p_response); +} + #Target temp [temp] (warmer, cooler) package Nest_Thermo_Target; @@ -544,10 +571,22 @@ sub new { $parent, {'target_temperature_' . $scale => ''} ); + $$self{states} = ['cooler','warmer']; bless $self, $class; return $self; } +sub set { + my ($self, $p_state, $p_setby, $p_response) = @_; + if (lc($p_state) eq 'warmer') { + $p_state = $$self{parent}->get_target_sp + 1; + } + elsif (lc($p_state) eq 'cooler') { + $p_state = $$self{parent}->get_target_sp - 1; + } + $$self{parent}->set_target_temp($p_state,$p_setby,$p_response); +} + #Target high for heat-cool [temp] (warmer, cooler) package Nest_Thermo_Target_High; use strict; @@ -561,10 +600,22 @@ sub new { $parent, {'target_temperature_high_' . $scale => ''} ); + $$self{states} = ['cooler','warmer']; bless $self, $class; return $self; } +sub set { + my ($self, $p_state, $p_setby, $p_response) = @_; + if (lc($p_state) eq 'warmer') { + $p_state = $$self{parent}->get_heat_sp + 1; + } + elsif (lc($p_state) eq 'cooler') { + $p_state = $$self{parent}->get_heat_sp - 1; + } + $$self{parent}->set_target_temp_high($p_state,$p_setby,$p_response); +} + #Target low for heat-cool [temp] (warmer, cooler) package Nest_Thermo_Target_Low; use strict; @@ -578,11 +629,23 @@ sub new { $parent, {'target_temperature_low_' . $scale => ''} ); + $$self{states} = ['cooler','warmer']; bless $self, $class; return $self; } -#Target high for heat-cool [temp] (warmer, cooler) +sub set { + my ($self, $p_state, $p_setby, $p_response) = @_; + if (lc($p_state) eq 'warmer') { + $p_state = $$self{parent}->get_cool_sp + 1; + } + elsif (lc($p_state) eq 'cooler') { + $p_state = $$self{parent}->get_cool_sp - 1; + } + $$self{parent}->set_target_temp_low($p_state,$p_setby,$p_response); +} + + package Nest_Thermo_Away_High; use strict; @Nest_Thermo_Away_High::ISA = ('Nest_Child'); @@ -599,7 +662,6 @@ sub new { return $self; } -#Target low for heat-cool [temp] (warmer, cooler) package Nest_Thermo_Away_Low; use strict; @Nest_Thermo_Away_Low::ISA = ('Nest_Child'); @@ -694,6 +756,7 @@ sub new { $$self{class} = 'structures', $$self{type} = '', $$self{name} = $name, + $$self{states} = ['home','away']; return $self; } @@ -703,14 +766,21 @@ sub get_away_status { } sub set_away_status { - my ($self, $state) = @_; + my ($self, $state, $p_setby, $p_response) = @_; $state = lc($state); - if ($state ne 'home' || $state ne 'away'){ + if ($state ne 'home' && $state ne 'away'){ ::print_log("[Nest] set_away_status must be either home or away."); return; } - $$self{interface}->write_data($self, 'away' . $$self{scale}, $state); + $$self{interface}->write_data($self, 'away', $state); + $$self{state_pending} = [$p_setby, $p_response]; } +sub set { + my ($self, $p_state, $p_setby, $p_response) = @_; + $self->set_away_status($p_state,$p_setby,$p_response); +} + + #I did not add high level support for the ETA feature, although it can be #set using the low level write_data function with a bit of work \ No newline at end of file From 97fe083ddb22587d56bb5726da20ac8f1f5ae0ef Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Mon, 21 Jul 2014 21:16:41 -0700 Subject: [PATCH 158/180] Insteon: Add User Option to Enable PLM Restart; Prevent Crashes This adds a new INI variable Insteon_PLM_reconnect_count By default this is set to 99, to disable any PLM reconnect attempts. If you have PLM disconnect issues, try setting it to 2 or 3. The setting waits for the number of missing ACK responses from the PLM before trying to reconnect. This also fixes an issue where trying to close an undefined port would completely crash MH, now it just results in a warning, but MisterHouse continues. --- bin/mh | 2 +- lib/Insteon/Message.pm | 39 +++++++++++++++++++++++++++++++++++++-- 2 files changed, 38 insertions(+), 3 deletions(-) diff --git a/bin/mh b/bin/mh index b62216e8c..db2a14347 100755 --- a/bin/mh +++ b/bin/mh @@ -5707,7 +5707,7 @@ sub serial_port_close { my $port = $Serial_Ports{$name}{port}; # Recommended Steps to Close a Serial Port from CPAN - $Serial_Ports{$name}{object}->close() || ::print_log("[Insteon_PLM] Close of serial port failed."); + $Serial_Ports{$name}{object}->close() if (defined $Serial_Ports{$name}{object}); undef $Serial_Ports{$name}{object}; # Remove all references in Global Vars diff --git a/lib/Insteon/Message.pm b/lib/Insteon/Message.pm index 57b54d576..9829361ab 100644 --- a/lib/Insteon/Message.pm +++ b/lib/Insteon/Message.pm @@ -256,8 +256,12 @@ sub send } # If No PLM-Receipt has been received for this message - # then attempt to reconnect the PLM - $interface->serial_restart() unless $self->plm_receipt; + # then check to see if we are supposed to restart the PLM + if (!$self->plm_receipt) { + if ($self->is_plm_down($interface) <= 0){ + $interface->serial_restart(); + } + } } # need to set timeout as a function of retries; also need to alter hop count @@ -350,6 +354,37 @@ sub plm_receipt return $$self{plm_receipt}; } +=item C + +Used to determine whether the PLM needs to be restarted. The PLM should ACK the +receipt of every command MisterHouse sends to it. If no ACK is received then +plm_receipt is zero on the retry attempt. If the number of sequential no ACK +instances for a specific command reaches the defined number, MisterHouse will +attempt to reconnect the PLM port. You can set the threshold to any number you +like, but if the no ACK number is higher than your retry number, which defaults +to 5, then the PLM will never be restarted. The no ACK number can be set using +the ini key: + +B + +by default this number will be set to 99, which in will prevent the PLM from +being restarted. If you have PLM disconnect issues, try setting this to 2 or 3. +The restart code has been known to be incompatible with certain perl installations. + +=cut + +sub is_plm_down +{ + my ($self, $interface) = @_; + my $instance = $$interface{port_name}; + my $reconnect_count = 99; + $reconnect_count = $::config_parms{$instance . "_reconnect_count"} + if defined $::config_parms{$instance . "_reconnect_count"}; + $$self{is_plm_down} = $reconnect_count unless defined $$self{is_plm_down}; + $$self{is_plm_down} -= 1; + return $$self{is_plm_down}; +} + =back From 529fc283f562048c4bc43a9b2c7fa8f030844d66 Mon Sep 17 00:00:00 2001 From: JaredF Date: Mon, 21 Jul 2014 23:46:17 -0700 Subject: [PATCH 159/180] Closes #235 --- lib/Voice_Text.pm | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lib/Voice_Text.pm b/lib/Voice_Text.pm index 8c1002e73..cb8396e8f 100644 --- a/lib/Voice_Text.pm +++ b/lib/Voice_Text.pm @@ -451,7 +451,8 @@ sub speak_text { my $google_file = "$main::config_parms{data_dir}/mh_temp.google-$random.mp3"; # Make the request, store the result in the google temp file - my $ua_request = HTTP::Request->new('GET' => "http://translate.google.com/translate_tts?tl=en&q=".qq[ $parms{text} ]); + my $language = ($main::config_parms{language}) ? lc($main::config_parms{language}) : "en"; + my $ua_request = HTTP::Request->new('GET' => "http://translate.google.com/translate_tts?tl=$language&q=".qq[ $parms{text} ]); my $ua_response = $ua->request($ua_request, $google_file); # Log the failure @@ -461,11 +462,12 @@ sub speak_text { } # Convert the returned mp3 file to a wav, and clean up the temp file - system("ffmpeg", "-loglevel", "panic", "-i", "$google_file", "$out_file"); + my $sound_converter = ($main::config_parms{sound_converter}) ? $main::config_parms{sound_converter} : "ffmpeg"; + system($sound_converter, '-v', 'panic', '-i', $google_file, $out_file); unlink($google_file); # Play the wav file, clean up only if we are not being forced to file - system($main::config_parms{sound_program}, $out_file) unless $parms{to_file}; + system("$main::config_parms{sound_program} $out_file") unless $parms{to_file}; unlink($out_file) unless $parms{to_file}; } elsif ($speak_pgm) { From 8e009a0485799f8243bf51c3314cb0b2621b9867 Mon Sep 17 00:00:00 2001 From: JaredF Date: Mon, 21 Jul 2014 23:46:17 -0700 Subject: [PATCH 160/180] Closes #446 --- lib/Voice_Text.pm | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lib/Voice_Text.pm b/lib/Voice_Text.pm index 8c1002e73..cb8396e8f 100644 --- a/lib/Voice_Text.pm +++ b/lib/Voice_Text.pm @@ -451,7 +451,8 @@ sub speak_text { my $google_file = "$main::config_parms{data_dir}/mh_temp.google-$random.mp3"; # Make the request, store the result in the google temp file - my $ua_request = HTTP::Request->new('GET' => "http://translate.google.com/translate_tts?tl=en&q=".qq[ $parms{text} ]); + my $language = ($main::config_parms{language}) ? lc($main::config_parms{language}) : "en"; + my $ua_request = HTTP::Request->new('GET' => "http://translate.google.com/translate_tts?tl=$language&q=".qq[ $parms{text} ]); my $ua_response = $ua->request($ua_request, $google_file); # Log the failure @@ -461,11 +462,12 @@ sub speak_text { } # Convert the returned mp3 file to a wav, and clean up the temp file - system("ffmpeg", "-loglevel", "panic", "-i", "$google_file", "$out_file"); + my $sound_converter = ($main::config_parms{sound_converter}) ? $main::config_parms{sound_converter} : "ffmpeg"; + system($sound_converter, '-v', 'panic', '-i', $google_file, $out_file); unlink($google_file); # Play the wav file, clean up only if we are not being forced to file - system($main::config_parms{sound_program}, $out_file) unless $parms{to_file}; + system("$main::config_parms{sound_program} $out_file") unless $parms{to_file}; unlink($out_file) unless $parms{to_file}; } elsif ($speak_pgm) { From 1ed93414070ea28ae421db0f61674a42d4548a01 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Tue, 22 Jul 2014 18:05:00 -0700 Subject: [PATCH 161/180] Nest: Add Massive Amount of Documentation --- lib/Nest.pm | 691 ++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 668 insertions(+), 23 deletions(-) diff --git a/lib/Nest.pm b/lib/Nest.pm index befc44937..467432232 100644 --- a/lib/Nest.pm +++ b/lib/Nest.pm @@ -1,6 +1,149 @@ +=head1 B + +=head2 SYNOPSIS + +This module allows MisterHouse to communicate with the public Nest API which +currently allows interation with Nest Thermostats and Smoke/CO Detectors. + +=head2 CONFIGURATION + +Nest uses OAuth technology to authorize access to your account. The nice thing +is that at any point in the future, you can sign into your Nest account and +revoke any access tokens that you have issued. + +To start the authorization process, go to the following URL: + +L + +Read everything on that page and follow the instructions. At the end of the +process, the webpage will provide you with a line to add to your mh.private.ini +file. It will be a long line! Copy the entire line and place it in your +mh.private.ini file: + + Nest_auth_token= + +Create a Nest instance in the .mht file, or in user code: + +.mht file: + + CODE, require Nest; #noloop + CODE, $nest = new Nest_Interface(); #noloop + CODE, $nest_thermo = new Nest_Thermostat('Entryway', $nest, 'f'); #noloop + CODE, $nest_thermo_mode = new Nest_Thermo_Mode($nest_thermo); #noloop + CODE, $nest_alarm = new Nest_Smoke_CO_Alarm('Kitchen', $nest); #noloop + CODE, $nest_home = new Nest_Structure('Home', $nest); #noloop + +Explanations of the parameters is contained below in the documentation for each +module. + +=head2 OVERVIEW + +Because this module uses the public Nest API, it should provide stable support +for a long time. However, by relying on the public API, this module is also +limited to supplying only the features currently supported by Nest. Currently +some features which are present on the device and the Nest website, such as +humidity, are not yet available in the API and as a result are not specifically +supported by this module. + +The low level commands in this module were written with the exepectation of +future additions to the public Nest API. The code should permit advanced users +to interact with any future additions to the API without requiring an update to +this module. + +This module is broken down into a few parts: + +=head3 NEST_INTERFACE + +This handles the interaction between the Nest API servers and MisterHouse. +This is the object that is required. An advanced user could interact with +the Nest API solely through this object. + +=head3 NEST_GENERIC + +This provides a generic base for building objects that receive data from the +interface. This object is inherited by all parent and child objects and +in most cases, a user will not need to worry about this object. + +=head3 PARENT ITEMS + +These currently include B, B, and +B. This classes provide more specific support for each of the +current Nest type of objects. These objects provide all of the access needed to +interact with each of the devices in a user friendly way. + +=head3 CHILD ITEMS + +Currently these are named B.... These are very specific objects +that provide very specific support for individual features on the Nest +Thermostats. I have in the past commonly referred to these as child objects. +In general, the state of these objects reports the state of a single parameter +on the thermostat. A few of the objects also offer writable features that allow +changing certain parameters on the thermostat. + +=cut + package Nest_Interface; +=head1 B + +=head2 SYNOPSIS + +This module allows MisterHouse to communicate with the public Nest API which +currently allows interation with Nest Thermostats and Smoke/CO Detectors. + +=head2 CONFIGURATION + +Nest uses OAuth technology to authorize access to your account. The nice thing +is that at any point in the future, you can sign into your Nest account and +revoke any access tokens that you have issued. + +To start the authorization process, go to the following URL: + +L + +Read everything on that page and follow the instructions. At the end of the +process, the webpage will provide you with a line to add to your mh.private.ini +file. It will be a long line! Copy the entire line and place it in your +mh.private.ini file: + + Nest_auth_token= + +Create a Nest instance in the .mht file, or in user code: + +.mht file: + + CODE, require Nest; #noloop + CODE, $nest = new Nest_Interface(); #noloop + +=head2 DESCRIPTION + +This handles the interaction between the Nest API servers and MisterHouse. +This is the object that is required. An advanced user could interact with +the Nest API solely through this object. + +=head2 INHERITS + +C + +=cut + +@Nest_Interface::ISA = ('Socket_Item'); + use strict; + +=head2 DEPENDENCIES + + JSON - Used for encoding/decoding the JSON data + IO::Socket::SSL - SSL Used to establish a secure connection to Nest servers + IO::Socket::INET - Nest uses a RESTful Streaming protocol which requires a + special code setup to keep the HTTP socket constantly open. + IO::Select - Used to manage the HTTP socket + URI::URL - Used for deciphering URLs + HTTP::Response - Used for handling the responses from Nest + HTTP::Request - Used for sending requests to Nest + +=cut + use JSON; use IO::Socket::SSL; use IO::Socket::INET; @@ -9,7 +152,16 @@ use URI::URL; use HTTP::Response; use HTTP::Request; -@Nest::ISA = ('Socket_Item'); +=head2 METHODS + +=over + +=item C + +Creates a new Nest Interface. The only required parameter is auth, which can +also be set using the INI parameter B. + +=cut sub new { my ($class, $port_name, $auth, $url) = @_; @@ -24,6 +176,8 @@ sub new { return $self; } +# Establishes the connection to Nest + sub connect_stream { my ($self, $url) = @_; $url = $$self{url} . "?auth=" . $$self{auth} if ($url eq ''); @@ -103,6 +257,8 @@ sub connect_stream { return $$self{socket}; } +# Run once per loop to check for data present on the connection + sub check_for_data { my ($self) = @_; if ($$self{socket}->connected && (time - $$self{'keep-alive'} < 70)) { @@ -145,6 +301,8 @@ sub check_for_data { } } +# If data is found on the connection with Nest, this parses out the data + sub parse_data { my ($self, $event, $data) = @_; if ($event =~ /keep-alive/){ @@ -171,6 +329,25 @@ sub parse_data { return; } +=item C + +This is used to write parameters to the Nest servers. + + $parent - (alternative) a reference to the parent object (thermostat, + smoke detector, structure) that this data should be written to + $value - The name of the value to write + $data - The data to be written + $url - (alternative) the full url to be written to + + +Either the parent or the URL must be defined. If the url is defined, it +will trump the parent. + +Advanced users can use this function to directly write JSON data to Nest. +Otherwise it is used by the more user friendly objects. + +=cut + sub write_data { my ($self, $parent, $value, $data, $url) = @_; if ($url eq '') { @@ -198,6 +375,12 @@ sub write_data { } } +=item C + +Prints the name and device_id of all devices found in the Nest account. + +=cut + sub print_devices { my ($self) = @_; my $output = "[Nest] The list of devices reported by Nest is:\n"; @@ -214,6 +397,12 @@ sub print_devices { ::print_log($output); } +=item C + +Prints the name and device_id of all structures found in the Nest account. + +=cut + sub print_structures { my ($self) = @_; my $output = "[Nest] The list of structures reported by Nest is:\n"; @@ -225,9 +414,17 @@ sub print_structures { ::print_log($output); } -# Used to register actions to take when a specific JSON value changes -# the variables $value and $state will be expanded on eval and will -# contain the name of the value that has changed and its new state +=item C + +Used to register actions to be run if a specific JSON value changes. + + $parent - The parent object on which the value should be monitored + (thermostat, smoke detector, structure) + $value - The parameter to monitor for changes + $action - A Code Reference to run when the json changes. The code reference + will be passed two arguments, the parameter name and value. + +=cut sub register { my ($self, $parent, $object, $value, $action) = @_; @@ -261,7 +458,7 @@ sub compare_json { } } -##Converts the names in the register hash to IDs, and then puts them into +# Converts the names in the register hash to IDs, and then puts them into # the monitor hash. sub convert_to_ids { @@ -282,11 +479,47 @@ sub convert_to_ids { delete $$self{register}; } -package Nest_Child; +package Nest_Generic; + +=back + +=head1 B + +=head2 SYNOPSIS + +This is a generic module primarily meant to be inherited by higher level more +user friendly modules. The average user should just ignore this module. + +=cut use strict; -@Nest_Child::ISA = ('Generic_Item'); +=head2 INHERITS + +C + +=cut + +@Nest_Generic::ISA = ('Generic_Item'); + +=head2 METHODS + +=over + +=item C + +Creates a new Nest_Generic. + + $interface - The Nest_Interface through which this device can be found. + $parent - The parent interface of this object, if not specified the + the parent will be set to Self. + $monitor_hash - A hash ref, {$value => $action}, where $value is the JSON + value that should be monitored with $action equal to the code + reference that should be run on changes. The hash ref can + contain an infinite number of key value pairs. If no action + is specified, it will use the default data_chanted routine. + +=cut sub new { my ($class, $interface, $parent, $monitor_hash) = @_; @@ -301,6 +534,12 @@ sub new { return $self; } +=item C + +Returns the device_id of an object. + +=cut + sub device_id { my ($self) = @_; my $type_hash; @@ -322,9 +561,13 @@ sub device_id { return 0; } -# Called by data_updated if data has changed. In most cases we can ignore the -# value name and just set the state of the child to new_value more sophisticated -# children can hijack this method to do more complex tasks +=item C + +The default action to be called when the JSON data has changed. In most cases +we can ignore the value name and just set the state of the child to new_value. +More sophisticated children can hijack this method to do more complex tasks. + +=cut sub data_changed { my ($self, $value_name, $new_value) = @_; @@ -332,6 +575,12 @@ sub data_changed { $self->set_receive($new_value); } +=item C + +Handles setting the state of the object inside MisterHouse + +=cut + sub set_receive { my ($self, $p_state, $p_setby, $p_response) = @_; if (defined $$self{parent}{state_pending}){ @@ -341,6 +590,12 @@ sub set_receive { $self->SUPER::set($p_state, $p_setby, $p_response); } +=item C + +Returns the JSON data contained in value for this device. + +=cut + sub get_value { my ($self, $value) = @_; my $device_id = $self->device_id; @@ -354,60 +609,153 @@ sub get_value { package Nest_Thermostat; +=back + +=head1 B + +=head2 SYNOPSIS + +This is a high level module for interacting with the Nest Thermostat. It is +generally user friendly and contains many functions which are similar to other +thermostat modules. + +The state of this object will be the ambient temperature reported by the +thermostat. This object does not accept set commands. You can use all of the +remaining C including c, c, c to +interact with this object. + +=head2 CONFIGURATION + +Create a Nest thermostat instance in the .mht file: + +.mht file: + + CODE, $nest_thermo = new Nest_Thermostat('Entryway', $nest, 'f'); #noloop + +The arguments: + + 1. The first argument can be either I or the I. + If using the name, this must be the exact verbatim name as listed on the Nest + website. Alternatively, if you want to allow for future name changes without + breaking your installation, you can get the device id using the + L routine. + 2. The second argument is the interface object + 3. The third argument is either [f,c] and denotes the temperature scale you prefer + +=cut + use strict; -@Nest_Thermostat::ISA = ('Nest_Child'); +=head2 INHERITS + +C + +=cut + +@Nest_Thermostat::ISA = ('Nest_Generic'); + +=head2 METHODS + +=over + +=item C + +Creates a new Nest_Generic. + + $name - The name or device if of the Thermostat + $interface - The interface object + $scale - Either [c,f] denoting your prefered temperature scale + + +=cut sub new { my ($class, $name, $interface, $scale) = @_; $scale = lc($scale); $scale = "f" unless ($scale eq "c"); my $monitor_value = "ambient_temperature_" . $scale; - my $self = new Nest_Child($interface, '', {$monitor_value=>''}); + my $self = new Nest_Generic($interface, '', {$monitor_value=>''}); bless $self, $class; $$self{class} = 'devices', $$self{type} = 'thermostats', $$self{name} = $name, $$self{scale} = $scale; - return $self; + return $self; } +=item C + +Returns the current ambient temperature. + +=cut + sub get_temp { my ($self) = @_; return $self->get_value("ambient_temperature_" . $$self{scale}); } -# Used in the combined Heat - Cool Mode Only +=item C + +Returns the current heat setpoint for the combined heat-cool mode. + +=cut sub get_heat_sp { my ($self) = @_; return $self->get_value("target_temperature_high_" . $$self{scale}); } -# Used in the combined Heat - Cool Mode Only +=item C + +Returns the current cool setpoint for the combined heat-cool mode. + +=cut sub get_cool_sp { my ($self) = @_; return $self->get_value("target_temperature_low_" . $$self{scale}); } -# Used in either the Heating or Cooling mode +=item C + +Returns the current target setpoint for either the heat or cool mode. The +combined heat-cool mode uses its own functions. + +=cut sub get_target_sp { my ($self) = @_; return $self->get_value("target_temperature_" . $$self{scale}); } +=item C + +Return the current mode. + +=cut + sub get_mode { my ($self) = @_; return $self->get_value("hvac_mode"); } +=item C + +Return the current fan state. + +=cut + sub get_fan_state { my ($self) = @_; return $self->get_value("fan_timer_active"); } +=item C + +Sets the fan state to $state, must be [true,false]. + +=cut + sub set_fan_state { my ($self, $state, $p_setby, $p_response) = @_; $state = lc($state); @@ -419,6 +767,12 @@ sub set_fan_state { $$self{state_pending} = [$p_setby, $p_response]; } +=item C + +Sets the target temp for the heat or cool mode to $state. + +=cut + sub set_target_temp { my ($self, $state, $p_setby, $p_response) = @_; unless ($state =~ /^\d+(\.\d+)?$/){ @@ -429,6 +783,12 @@ sub set_target_temp { $$self{state_pending} = [$p_setby, $p_response]; } +=item C + +Sets the heat target temp for the combined heat-cool mode to $state. + +=cut + sub set_target_temp_high { my ($self, $state, $p_setby, $p_response) = @_; unless ($state =~ /^\d+(\.\d+)?$/){ @@ -439,6 +799,12 @@ sub set_target_temp_high { $$self{state_pending} = [$p_setby, $p_response]; } +=item C + +Sets the cool target temp for the combined heat-cool mode to $state. + +=cut + sub set_target_temp_low { my ($self, $state, $p_setby, $p_response) = @_; unless ($state =~ /^\d+(\.\d+)?$/){ @@ -449,6 +815,12 @@ sub set_target_temp_low { $$self{state_pending} = [$p_setby, $p_response]; } +=item C + +Sets the mode to $state, must be [heat,cool,heat-cool,off] + +=cut + sub set_hvac_mode { my ($self, $state, $p_setby, $p_response) = @_; $state = lc($state); @@ -467,6 +839,32 @@ sub set_hvac_mode { package Nest_Thermo_Fan; +=back + +=head1 B + +=head2 SYNOPSIS + +This is a very high level module for interacting with the Nest Thermostat Fan. +This type of object is often referred to as a child device. It displays the +state of the fan and allows for enabling or disabling it. The object inherits +all of the C methods, including c, c, c, +c. + +=head2 CONFIGURATION + +.mht file: + + CODE, $thermo_fan = new Nest_Thermo_Fan($nest_thermo); #noloop + +The only argument required is the thermostat object. + +=head2 INHERITS + +C + +=cut + use strict; @Nest_Thermo_Fan::ISA = ('Nest_Child'); @@ -503,7 +901,28 @@ sub set { package Nest_Thermo_Leaf; -#Leaf [on,off] +=head1 B + +=head2 SYNOPSIS + +This is a very high level module for interacting with the Nest Thermostat Leaf. +This type of object is often referred to as a child device. It displays the +state of the leaf. The object inherits all of the C methods, +including c, c, c. + +=head2 CONFIGURATION + +.mht file: + + CODE, $thermo_leaf = new Nest_Thermo_Leaf($nest_thermo); #noloop + +The only argument required is the thermostat object. + +=head2 INHERITS + +C + +=cut use strict; @@ -533,7 +952,29 @@ sub set_receive { package Nest_Thermo_Mode; -#Mode [current] (heat, cool, off, heat/cool) +=head1 B + +=head2 SYNOPSIS + +This is a very high level module for interacting with the Nest Thermostat Mode. +This type of object is often referred to as a child device. It displays the +mode of the thermostat and allows for setting the modes. The object inherits +all of the C methods, including c, c, c, +c. + +=head2 CONFIGURATION + +.mht file: + + CODE, $thermo_mode = new Nest_Thermo_Mode($nest_thermo); #noloop + +The only argument required is the thermostat object. + +=head2 INHERITS + +C + +=cut use strict; @@ -645,6 +1086,30 @@ sub set { $$self{parent}->set_target_temp_low($p_state,$p_setby,$p_response); } +=head1 B + +=head2 SYNOPSIS + +This is a very high level module for interacting with the Nest Thermostat High +Away Target Temperature. +This type of object is often referred to as a child device. It displays the +setpoint of the thermostat and but cannot be changed. The object inherits +all of the C methods, including c, c, +c. + +=head2 CONFIGURATION + +.mht file: + + CODE, $thermo_param = new Nest_Thermo_Away_High($nest_thermo); #noloop + +The only argument required is the thermostat object. + +=head2 INHERITS + +C + +=cut package Nest_Thermo_Away_High; use strict; @@ -662,6 +1127,31 @@ sub new { return $self; } +=head1 B + +=head2 SYNOPSIS + +This is a very high level module for interacting with the Nest Thermostat High +Away Target Temperature. +This type of object is often referred to as a child device. It displays the +setpoint of the thermostat and but cannot be changed. The object inherits +all of the C methods, including c, c, +c. + +=head2 CONFIGURATION + +.mht file: + + CODE, $thermo_param = new Nest_Thermo_Away_Low($nest_thermo); #noloop + +The only argument required is the thermostat object. + +=head2 INHERITS + +C + +=cut + package Nest_Thermo_Away_Low; use strict; @Nest_Thermo_Away_Low::ISA = ('Nest_Child'); @@ -680,9 +1170,62 @@ sub new { package Nest_Smoke_CO_Alarm; +=head1 B + +=head2 SYNOPSIS + +This is a high level module for interacting with the Nest Smoke Alarm. It is +generally user friendly. + +The state of this object will be the combined state of both the CO and smoke +alarm plus the battery state. If everything it OK the state will be OK. Any +emergency state will be listed first, followed by a warning state, followed by +a battery health warning. You CANNOT set the state of this object, as the +detector is a read only device. You can use all of the the C +methods, including c, c, c, c to interact with +this object. + +=head2 CONFIGURATION + +Create a Nest smoke alarm instance in the .mht file: + +.mht file: + + CODE, $nest_alarm = new Nest_Smoke_CO_Alarm('Kitchen', $nest); #noloop + +The arguments: + + 1. The first argument can be either I or the I. + If using the name, this must be the exact verbatim name as listed on the Nest + website. Alternatively, if you want to allow for future name changes without + breaking your installation, you can get the device id using the + L routine. + 2. The second argument is the interface object + +=cut + use strict; -@Nest_Smoke_CO_Alarm::ISA = ('Nest_Child'); +=head2 INHERITS + +C + +=cut + +@Nest_Smoke_CO_Alarm::ISA = ('Nest_Generic'); + +=head2 METHODS + +=over + +=item C + +Creates a new Nest_Generic. + + $name - The name or device if of the Thermostat + $interface - The interface object + +=cut sub new { my ($class, $name, $interface) = @_; @@ -726,16 +1269,34 @@ sub data_changed { $self->set_receive($state); } +=item C + +Returns the carbon monoxide alarm state. [ok,warning,emergency] + +=cut + sub get_co { my ($self) = @_; return $self->get_value("co_alarm_state"); } +=item C + +Returns the smoke alarm state. [ok,warning,emergency] + +=cut + sub get_smoke { my ($self) = @_; return $self->get_value("smoke_alarm_state"); } +=item C + +Returns the detector battery health. [ok,replace] + +=cut + sub get_battery { my ($self) = @_; return $self->get_value("battery_health"); @@ -745,26 +1306,90 @@ sub get_battery { package Nest_Structure; +=back + +=head1 B + +=head2 SYNOPSIS + +This is a high level module for interacting with the Nest Structure object. It is +generally user friendly. + +The state of this object will be set to the home/away state of the structure. You +can use all of the the C methods, including c, c, c, +c to interact with this object. + +=head2 CONFIGURATION + +Create a Nest structure instance in the .mht file: + +.mht file: + + CODE, $nest_home = new Nest_Structure('Home', $nest); #noloop + +The arguments: + + 1. The first argument can be either I or the I. + If using the name, this must be the exact verbatim name as listed on the Nest + website. Alternatively, if you want to allow for future name changes without + breaking your installation, you can get the device id using the + L routine. + 2. The second argument is the interface object + +=cut + use strict; -@Nest_Structure::ISA = ('Nest_Child'); +=head2 INHERITS + +C + +=cut + +@Nest_Structure::ISA = ('Nest_Generic'); + +=head2 METHODS + +=over + +=item C + +Creates a new Nest_Generic. + + $name - The name or device if of the Thermostat + $interface - The interface object + +=cut sub new { my ($class, $name, $interface) = @_; - my $self = new Nest_Child($interface, '', {'away'=>''}); + my $self = new Nest_Generic($interface, '', {'away'=>''}); bless $self, $class; $$self{class} = 'structures', $$self{type} = '', $$self{name} = $name, $$self{states} = ['home','away']; - return $self; + return $self; } +=item C + +Returns the state of the structure. [home,away] + +=cut + sub get_away_status { my ($self) = @_; return $self->get_value("away"); } +=item C + +Sets the state of the structure. $State must be [home,away]. This will cause +all devices inside this structure to change to the set state. + +=cut + sub set_away_status { my ($self, $state, $p_setby, $p_response) = @_; $state = lc($state); @@ -783,4 +1408,24 @@ sub set { #I did not add high level support for the ETA feature, although it can be -#set using the low level write_data function with a bit of work \ No newline at end of file +#set using the low level write_data function with a bit of work + +=back + +=head1 AUTHOR + +Kevin Robert Keegan + +=head1 SEE ALSO + +http://developer.nest.com/ + +=head1 LICENSE + +This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. + +This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + +=cut \ No newline at end of file From 83c0a99475c933e3255159ed3a9ead76ffa1ffaa Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Tue, 22 Jul 2014 18:05:00 -0700 Subject: [PATCH 162/180] Fix Link Generation in Items and Modules Documenation Pages I don't know when or how this broke, but I made some changes to update_docs some months back. I noticed that on my local copy, the links on the Items and Modules pages were non-existant. This change fixes that. I also made a change to the pod.css so that CODE tags are mono-spaced formatted. --- bin/update_docs | 4 +++- docs/mh.pod | 6 +++--- web/lib/pod.css | 2 +- 3 files changed, 7 insertions(+), 5 deletions(-) diff --git a/bin/update_docs b/bin/update_docs index 8f222525d..199963405 100755 --- a/bin/update_docs +++ b/bin/update_docs @@ -280,9 +280,11 @@ else { foreach my $doc ( keys %podfiles ) { my $podfile = "$docdir/$doc"; my $ind = ""; + my $docdir2 = $docdir; if ( $doc eq "items.pod" or $doc eq "modules.pod" ) { $podfile = "$outdir/$doc"; $ind = "--noindex"; + $docdir2 = '..'; } $doc =~ s/\.pod$//i; my $htmlfile = "$outdir/$doc.html"; @@ -297,7 +299,7 @@ foreach my $doc ( keys %podfiles ) { pod2html( "--infile=$podfile", "--outfile=$htmlfile", "--noheader", - "--htmldir=$outdir", "--podroot=$docdir", + "--htmldir=$outdir", "--podroot=$docdir2", "--podpath=.", "--css=/lib/pod.css", $ind ); diff --git a/docs/mh.pod b/docs/mh.pod index a54284e52..78c7d1822 100644 --- a/docs/mh.pod +++ b/docs/mh.pod @@ -369,13 +369,13 @@ These constants are defined, so we can use them without quoting them The Misterhouse documentation refers to perl objects as items. Most of these are derived from L. -The old list of items is L. These will be moved to the +The old list of items is L. These will be moved to the new list soon. -The new list of items is L. This documentation is maintained +The new list of items is L. This documentation is maintained in the .pm files along side the code. -The list of modules that are not items is L. +The list of modules that are not items is L. =head2 List of functions diff --git a/web/lib/pod.css b/web/lib/pod.css index 276624913..8260ac834 100644 --- a/web/lib/pod.css +++ b/web/lib/pod.css @@ -3,7 +3,7 @@ hr, big { } code { - font-family: "Helvetica Neue", Arial, Helvetica, Geneva, sans-serif; + font-family: "Courier New", Courier, monospace; font-weight: bold; } From a41de771782e1e17e0425b006950e8e11d23f827 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Tue, 22 Jul 2014 18:15:00 -0700 Subject: [PATCH 163/180] Nest: Add Auth Ini Parameter; Reorganize Connect_Stream --- lib/Nest.pm | 78 +++++++++++++++++++++++++++-------------------------- 1 file changed, 40 insertions(+), 38 deletions(-) diff --git a/lib/Nest.pm b/lib/Nest.pm index 467432232..1d5ccc626 100644 --- a/lib/Nest.pm +++ b/lib/Nest.pm @@ -164,16 +164,18 @@ also be set using the INI parameter B. =cut sub new { - my ($class, $port_name, $auth, $url) = @_; + my ($class, $auth, $port_name, $url) = @_; my $self = {}; $port_name = 'Nest' if !$port_name; $url = "https://developer-api.nest.com/.json" if !$url; + $auth = $::config_parms{$port_name . "_auth_token"} if !$auth; $$self{port_name} = $port_name; $$self{url} = $url; $$self{auth} = $auth; - bless $self, $class; - $self->connect_stream(); - return $self; + bless $self, $class; + $self->connect_stream(); + ::MainLoop_pre_add_hook(sub {$self->check_for_data();}, 1); + return $self; } # Establishes the connection to Nest @@ -191,7 +193,7 @@ sub connect_stream { PeerHost => $url->host, PeerPort => $url->port, Blocking => 0 ) or die $@; # first create simple N-B socket with IO::Socket::INET - my $select = IO::Select->new($$self{socket}); # wait until it connected + my $select = IO::Select->new($$self{socket}); # wait until it connected if ($select->can_write) { ::print_log "[Nest Interface] IO::Socket::INET connected"; } @@ -260,44 +262,44 @@ sub connect_stream { # Run once per loop to check for data present on the connection sub check_for_data { - my ($self) = @_; + my ($self) = @_; if ($$self{socket}->connected && (time - $$self{'keep-alive'} < 70)) { - # sysread will only read the contents of a single SSL frame - if ($$self{socket}->sysread(my $buf, 1024)){ - $$self{data} .= $buf; - if ($buf =~ /\n\n$/){ - # We reached the end of the message packet - ::print_log("[Nest Data]" . $$self{data}); - - # Split out event and data for processing - my @lines = split("\n", $$self{data}); - my ($event, $data); - for (@lines){ - # Pull out events and data - my ($key, $value) = split(":", $_,2); - if ($key =~ /event/){ - $event = $value; - } - elsif ($key =~ /data/ && defined($event)){ - $data = $value; - } - - if (defined($event) && defined($data)){ - $self->parse_data($event, $data); - $event = ''; - $data = ''; - } - } - - # Clear data storage - $$self{data} = ""; - } - } + # sysread will only read the contents of a single SSL frame + if ($$self{socket}->sysread(my $buf, 1024)){ + $$self{data} .= $buf; + if ($buf =~ /\n\n$/){ + # We reached the end of the message packet + ::print_log("[Nest Data]" . $$self{data}); + + # Split out event and data for processing + my @lines = split("\n", $$self{data}); + my ($event, $data); + for (@lines){ + # Pull out events and data + my ($key, $value) = split(":", $_,2); + if ($key =~ /event/){ + $event = $value; + } + elsif ($key =~ /data/ && defined($event)){ + $data = $value; + } + + if (defined($event) && defined($data)){ + $self->parse_data($event, $data); + $event = ''; + $data = ''; + } + } + + # Clear data storage + $$self{data} = ""; + } + } } else { # The connection died, or the keep-alive messages stopped, restart it ::print_log("[Nest Interface] Connection died, restarting"); - $self->connect_stream($$self{url}); + $self->connect_stream(); } } From 143576e247206cbcaebe965d67477a44d21a909d Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Tue, 22 Jul 2014 18:15:00 -0700 Subject: [PATCH 164/180] Nest: Change from Passing a Scalar to a Code Ref Eval is heavily frowned upon. It is hard to create a nice scalar command, plus the error messages are often unhelpful. Using Code References is much easier and possibly allows for greater functionality as it can run on non-global objects. --- lib/Nest.pm | 16 ++++------------ 1 file changed, 4 insertions(+), 12 deletions(-) diff --git a/lib/Nest.pm b/lib/Nest.pm index 1d5ccc626..073b5f857 100644 --- a/lib/Nest.pm +++ b/lib/Nest.pm @@ -429,8 +429,8 @@ Used to register actions to be run if a specific JSON value changes. =cut sub register { - my ($self, $parent, $object, $value, $action) = @_; - push (@{$$self{register}}, [$parent, $object, $value,$action]); + my ($self, $parent, $value, $action) = @_; + push (@{$$self{register}}, [$parent, $value, $action]); } # Walk through the JSON hash and looks for changes from previous json hash if a @@ -449,12 +449,7 @@ sub compare_json { } elsif ($value ne $prev_value && ref $monitior_value eq 'ARRAY') { for my $action (@{$monitior_value}){ - ::print_log("[Nest] eval'ing $action"); - package main; - eval($action); - ::print_log("[Nest] error in evaling action: " . $@) - if $@; - package Nest_Interface; + &$action($key,$value); } } } @@ -466,11 +461,8 @@ sub compare_json { sub convert_to_ids { my ($self) = @_; for my $array_ref (@{$$self{register}}){ - my ($parent, $object, $value, $action) = @{$array_ref}; + my ($parent, $value, $action) = @{$array_ref}; my $device_id = $parent->device_id(); - if ($action eq ''){ - $action = $object->get_object_name . '->data_changed($key,$value)'; - } if ($$parent{type} ne '') { push(@{$$self{monitor}{data}{$$parent{class}}{$$parent{type}}{$device_id}{$value}},$action); } From eea84ff43609f25232b23b2037edf6410eb927ae Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Tue, 22 Jul 2014 18:25:00 -0700 Subject: [PATCH 165/180] Nest: Change Nest_Child to Nest_Generic Much less confusing name --- lib/Nest.pm | 140 +++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 106 insertions(+), 34 deletions(-) diff --git a/lib/Nest.pm b/lib/Nest.pm index 073b5f857..f66345d7d 100644 --- a/lib/Nest.pm +++ b/lib/Nest.pm @@ -517,15 +517,16 @@ Creates a new Nest_Generic. sub new { my ($class, $interface, $parent, $monitor_hash) = @_; - my $self = new Generic_Item(); - bless $self, $class; + my $self = new Generic_Item(); + bless $self, $class; $$self{interface} = $interface; $$self{parent} = $parent; $$self{parent} = $self if ($$self{parent} eq ''); while (my ($monitor_value, $action) = each %{$monitor_hash}){ - $$self{interface}->register($$self{parent}, $self, $monitor_value, $action); - } - return $self; + my $action = sub {$self->data_changed(@_);} if $action eq ''; + $$self{interface}->register($$self{parent}, $monitor_value, $action); + } + return $self; } =item C @@ -972,18 +973,18 @@ C use strict; -@Nest_Thermo_Mode::ISA = ('Nest_Child'); +@Nest_Thermo_Mode::ISA = ('Nest_Generic'); sub new { my ($class, $parent) = @_; - my $self = new Nest_Child( + my $self = new Nest_Generic( $$parent{interface}, $parent, {'hvac_mode'=>''} ); $$self{states} = ['heat', 'cool', 'heat-cool', 'off']; - bless $self, $class; - return $self; + bless $self, $class; + return $self; } sub set { @@ -992,23 +993,46 @@ sub set { $$self{parent}->set_hvac_mode($p_state,$p_setby,$p_response); } -#Target temp [temp] (warmer, cooler) +=head1 B + +=head2 SYNOPSIS + +This is a very high level module for interacting with the Nest Thermostat Target +Temperature. This is used in either the heat or the cool modes. +This type of object is often referred to as a child device. It displays the +setpoint of the thermostat and allows for setting the temperature. The object inherits +all of the C methods, including c, c, c, +c. + +=head2 CONFIGURATION + +.mht file: + + CODE, $thermo_param = new Nest_Thermo_Target($nest_thermo); #noloop + +The only argument required is the thermostat object. + +=head2 INHERITS + +C + +=cut package Nest_Thermo_Target; use strict; -@Nest_Thermo_Target::ISA = ('Nest_Child'); +@Nest_Thermo_Target::ISA = ('Nest_Generic'); sub new { my ($class, $parent) = @_; my $scale = $$parent{scale}; - my $self = new Nest_Child( + my $self = new Nest_Generic( $$parent{interface}, $parent, {'target_temperature_' . $scale => ''} ); $$self{states} = ['cooler','warmer']; - bless $self, $class; - return $self; + bless $self, $class; + return $self; } sub set { @@ -1022,22 +1046,46 @@ sub set { $$self{parent}->set_target_temp($p_state,$p_setby,$p_response); } -#Target high for heat-cool [temp] (warmer, cooler) +=head1 B + +=head2 SYNOPSIS + +This is a very high level module for interacting with the Nest Thermostat High +Target Temperature. This is used only in the heat-cool mode. +This type of object is often referred to as a child device. It displays the +setpoint of the thermostat and allows for setting the temperature. The object inherits +all of the C methods, including c, c, c, +c. + +=head2 CONFIGURATION + +.mht file: + + CODE, $thermo_param = new Nest_Thermo_Target_High($nest_thermo); #noloop + +The only argument required is the thermostat object. + +=head2 INHERITS + +C + +=cut + package Nest_Thermo_Target_High; use strict; -@Nest_Thermo_Target_High::ISA = ('Nest_Child'); +@Nest_Thermo_Target_High::ISA = ('Nest_Generic'); sub new { my ($class, $parent) = @_; my $scale = $$parent{scale}; - my $self = new Nest_Child( + my $self = new Nest_Generic( $$parent{interface}, $parent, {'target_temperature_high_' . $scale => ''} ); $$self{states} = ['cooler','warmer']; - bless $self, $class; - return $self; + bless $self, $class; + return $self; } sub set { @@ -1051,22 +1099,46 @@ sub set { $$self{parent}->set_target_temp_high($p_state,$p_setby,$p_response); } -#Target low for heat-cool [temp] (warmer, cooler) +=head1 B + +=head2 SYNOPSIS + +This is a very high level module for interacting with the Nest Thermostat Low +Target Temperature. This is used only in the heat-cool mode. +This type of object is often referred to as a child device. It displays the +setpoint of the thermostat and allows for setting the temperature. The object inherits +all of the C methods, including c, c, c, +c. + +=head2 CONFIGURATION + +.mht file: + + CODE, $thermo_param = new Nest_Thermo_Target_Low($nest_thermo); #noloop + +The only argument required is the thermostat object. + +=head2 INHERITS + +C + +=cut + package Nest_Thermo_Target_Low; use strict; -@Nest_Thermo_Target_Low::ISA = ('Nest_Child'); +@Nest_Thermo_Target_Low::ISA = ('Nest_Generic'); sub new { my ($class, $parent) = @_; my $scale = $$parent{scale}; - my $self = new Nest_Child( + my $self = new Nest_Generic( $$parent{interface}, $parent, {'target_temperature_low_' . $scale => ''} ); $$self{states} = ['cooler','warmer']; - bless $self, $class; - return $self; + bless $self, $class; + return $self; } sub set { @@ -1107,18 +1179,18 @@ C package Nest_Thermo_Away_High; use strict; -@Nest_Thermo_Away_High::ISA = ('Nest_Child'); +@Nest_Thermo_Away_High::ISA = ('Nest_Generic'); sub new { my ($class, $parent) = @_; my $scale = $$parent{scale}; - my $self = new Nest_Child( + my $self = new Nest_Generic( $$parent{interface}, $parent, {'away_temperature_high_' . $scale => ''} ); - bless $self, $class; - return $self; + bless $self, $class; + return $self; } =head1 B @@ -1148,18 +1220,18 @@ C package Nest_Thermo_Away_Low; use strict; -@Nest_Thermo_Away_Low::ISA = ('Nest_Child'); +@Nest_Thermo_Away_Low::ISA = ('Nest_Generic'); sub new { my ($class, $parent) = @_; my $scale = $$parent{scale}; - my $self = new Nest_Child( + my $self = new Nest_Generic( $$parent{interface}, $parent, {'away_temperature_low_' . $scale => ''} ); - bless $self, $class; - return $self; + bless $self, $class; + return $self; } package Nest_Smoke_CO_Alarm; @@ -1223,7 +1295,7 @@ Creates a new Nest_Generic. sub new { my ($class, $name, $interface) = @_; - my $self = new Nest_Child($interface, '', { + my $self = new Nest_Generic($interface, '', { 'co_alarm_state'=>'', 'smoke_alarm_state'=>'', 'battery_health'=>'' @@ -1232,7 +1304,7 @@ sub new { $$self{class} = 'devices', $$self{type} = 'smoke_co_alarms', $$self{name} = $name, - return $self; + return $self; } sub data_changed { From e7f6a5c8aa5ececcf48cde2376012c1d3c968866 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Tue, 22 Jul 2014 18:15:00 -0700 Subject: [PATCH 166/180] Nest: Fix some Tab/Space Errors --- lib/Nest.pm | 62 ++++++++++++++++++++++++++--------------------------- 1 file changed, 31 insertions(+), 31 deletions(-) diff --git a/lib/Nest.pm b/lib/Nest.pm index f66345d7d..52d600b65 100644 --- a/lib/Nest.pm +++ b/lib/Nest.pm @@ -577,12 +577,12 @@ Handles setting the state of the object inside MisterHouse =cut sub set_receive { - my ($self, $p_state, $p_setby, $p_response) = @_; - if (defined $$self{parent}{state_pending}){ - ($p_setby, $p_response) = @{$$self{parent}{state_pending}}; - delete $$self{parent}{state_pending}; - } - $self->SUPER::set($p_state, $p_setby, $p_response); + my ($self, $p_state, $p_setby, $p_response) = @_; + if (defined $$self{parent}{state_pending}){ + ($p_setby, $p_response) = @{$$self{parent}{state_pending}}; + delete $$self{parent}{state_pending}; + } + $self->SUPER::set($p_state, $p_setby, $p_response); } =item C @@ -862,35 +862,35 @@ C use strict; -@Nest_Thermo_Fan::ISA = ('Nest_Child'); +@Nest_Thermo_Fan::ISA = ('Nest_Generic'); sub new { my ($class, $parent) = @_; - my $self = new Nest_Child( + my $self = new Nest_Generic( $$parent{interface}, $parent, {'fan_timer_active'=>''} ); $$self{states} = ['on','off']; - bless $self, $class; - return $self; + bless $self, $class; + return $self; } sub set_receive { - my ($self, $p_state, $p_setby, $p_response) = @_; - my $state = "on"; - $state = "off" if ($p_state eq 'false'); - if (defined $$self{parent}{state_pending}){ - ($p_setby, $p_response) = @{$$self{parent}{state_pending}}; - delete $$self{parent}{state_pending}; - } - $self->SUPER::set($state, $p_setby, $p_response); + my ($self, $p_state, $p_setby, $p_response) = @_; + my $state = "on"; + $state = "off" if ($p_state eq 'false'); + if (defined $$self{parent}{state_pending}){ + ($p_setby, $p_response) = @{$$self{parent}{state_pending}}; + delete $$self{parent}{state_pending}; + } + $self->SUPER::set($state, $p_setby, $p_response); } sub set { my ($self, $p_state, $p_setby, $p_response) = @_; $p_state = "true" if (lc($p_state) eq 'on'); - $p_state = "false" if (lc($p_state) eq 'off'); + $p_state = "false" if (lc($p_state) eq 'off'); $$self{parent}->set_fan_state($p_state,$p_setby,$p_response); } @@ -921,28 +921,28 @@ C use strict; -@Nest_Thermo_Leaf::ISA = ('Nest_Child'); +@Nest_Thermo_Leaf::ISA = ('Nest_Generic'); sub new { my ($class, $parent) = @_; - my $self = new Nest_Child( + my $self = new Nest_Generic( $$parent{interface}, $parent, {'has_leaf'=>''} ); - bless $self, $class; - return $self; + bless $self, $class; + return $self; } sub set_receive { - my ($self, $p_state, $p_setby, $p_response) = @_; - my $state = "on"; - $state = "off" if ($p_state eq 'false'); - if (defined $$self{parent}{state_pending}){ - ($p_setby, $p_response) = @{$$self{parent}{state_pending}}; - delete $$self{parent}{state_pending}; - } - $self->SUPER::set($state, $p_setby, $p_response); + my ($self, $p_state, $p_setby, $p_response) = @_; + my $state = "on"; + $state = "off" if ($p_state eq 'false'); + if (defined $$self{parent}{state_pending}){ + ($p_setby, $p_response) = @{$$self{parent}{state_pending}}; + delete $$self{parent}{state_pending}; + } + $self->SUPER::set($state, $p_setby, $p_response); } package Nest_Thermo_Mode; From 2061313a81d5c043bace33d5294b1251bff7bde2 Mon Sep 17 00:00:00 2001 From: JaredF Date: Tue, 22 Jul 2014 22:29:17 -0700 Subject: [PATCH 167/180] Adds documentation for sound_converter ini parameter. --- bin/mh.ini | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/bin/mh.ini b/bin/mh.ini index 369a5d952..35c52ff2e 100644 --- a/bin/mh.ini +++ b/bin/mh.ini @@ -229,6 +229,12 @@ organizer_email = fred => fred@flintstone.org, bambi => bambi => flinstone.com sound_program=play +@ Set this to the program used to convert sound files from mp3 to wav. Currently +@ only used by the Google TTS engine. The default is ffmpeg, but this is unavailable +@ on some platforms, Ubuntu for example, which requires the use of avconv instead. + +sound_converter= + @ Set this to 1 to use fork, rather than system calls, when calling sound_program sound_fork= From ad9c9717fb89bf9ac4a2f8cbe95bc2279d97f864 Mon Sep 17 00:00:00 2001 From: JaredF Date: Wed, 23 Jul 2014 00:08:03 -0700 Subject: [PATCH 168/180] Updates mhl to treat exit code 99 as a normal restart. --- bin/mhl | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/bin/mhl b/bin/mhl index 32b43cf33..a0cef728b 100755 --- a/bin/mhl +++ b/bin/mhl @@ -13,7 +13,6 @@ while [ 1 = 1 ]; do echo echo Deleting startup file -# rm -f mh.started touch mh.startup # Avoid a memory leak problem in Red Hat 8 @@ -29,13 +28,18 @@ while [ 1 = 1 ]; do exit fi -# if [ ! -f mh.started ]; then - if [ -f mh.startup ]; then + if [ -f mh.startup ]; then echo mh failed on startup ... will not restart exit fi - echo mh had an unexpected exit ... sleep a bit, then restarting + if [ $rc = 99 ]; then + echo -n restart requested + else + echo -n mh had an unexpected exit + fi + + echo " ... sleep a bit, then restarting" date >> mh_restart.log sleep 5 From f91fdd5a527d621d270b8c13b639e4b7c7c3a5e6 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Wed, 23 Jul 2014 18:15:00 -0700 Subject: [PATCH 169/180] Nest: Avoid Blocking on Stream Connection; Remove Calls to Die - This adds a reconnect timer that prevents hammering the Nest server with reconnect attempts - Add readable error messages if something goes wrong - Completely disable interface if we receive an error that demonstrates that we will never be able to connect Fixes krkeegan/misterhouse#24 Partially Fixes krkeegan/misterhouse#26 --- lib/Nest.pm | 119 +++++++++++++++++++++++++++++++++++----------------- 1 file changed, 81 insertions(+), 38 deletions(-) diff --git a/lib/Nest.pm b/lib/Nest.pm index 52d600b65..6f75f208d 100644 --- a/lib/Nest.pm +++ b/lib/Nest.pm @@ -156,11 +156,20 @@ use HTTP::Request; =over -=item C +=item C Creates a new Nest Interface. The only required parameter is auth, which can also be set using the INI parameter B. +port_name - defaults to Nest. If you are using multiple Nest Interfaces, +I would imagine this to be very rare. Then the subsequent interfaces +must have a different port name. You must also change the prefix of the +auth INI parameter to match the new port name. + +url - I have no idea when this would be used. But if you wanted to use +a different url than what Nest provides, maybe for testing or some beta +group, then you can provide the url here. + =cut sub new { @@ -172,9 +181,11 @@ sub new { $$self{port_name} = $port_name; $$self{url} = $url; $$self{auth} = $auth; + $$self{reconnect_timer} = new Timer; + $$self{enabled} = 1; bless $self, $class; $self->connect_stream(); - ::MainLoop_pre_add_hook(sub {$self->check_for_data();}, 1); + ::MainLoop_pre_add_hook(sub {$self->check_for_data();}, 'persistent'); return $self; } @@ -187,12 +198,24 @@ sub connect_stream { if (defined $$self{socket}) { $$self{socket}->close; + delete $$self{socket}; + $self->reconnect_delay(1, $url); + return; } $$self{socket} = IO::Socket::INET->new( - PeerHost => $url->host, PeerPort => $url->port, Blocking => 0 - ) or die $@; # first create simple N-B socket with IO::Socket::INET + PeerHost => $url->host, + PeerPort => $url->port, + Blocking => 0, + Timeout => 30, + ); + unless ($$self{socket}) { + ::print_log("[Nest] ERROR connecting to Nest server: " . $@); + $self->reconnect_delay(); + return; + } + my $select = IO::Select->new($$self{socket}); # wait until it connected if ($select->can_write) { ::print_log "[Nest Interface] IO::Socket::INET connected"; @@ -216,7 +239,9 @@ sub connect_stream { $select->can_write; } else { - die "[Nest Interface] IO::Socket::SSL unknown error: ", $SSL_ERROR; + ::print_log("[Nest] ERROR connecting to Nest server: " . $SSL_ERROR); + $self->reconnect_delay(); + return; } } } @@ -229,47 +254,64 @@ sub connect_stream { ); $request->protocol('HTTP/1.1'); #print "requesting data:\n" . $request->as_string; - $$self{socket}->syswrite($request->as_string) or die $!; - - # The first frame seems to always be the HTTP response without content - if ($select->can_read && $$self{socket}->sysread(my $buf, 1024)) { - my $r = HTTP::Response->parse( $buf ); - if ($r->code == 307){ - # This is a location redirect - $$self{socket}->close; - print "redirecting to " . $r->header( 'location' ) . "\n"; - $$self{socket} = $self->connect_stream($r->header( 'location' )); - } - elsif ($r->code == 401){ - die ("Error, your authorization was rejected. Please check your settings."); - } - elsif ($r->code == 200){ - # Successful response - print "Success: \n" . $r->as_string . "\n"; - $$self{'keep-alive'} = time; - } - else { - die ( - "Error unable to connect to stream response was: \n". - $r->as_string - ); - } + unless ($$self{socket}->syswrite($request->as_string)){ + ::print_log("[Nest] ERROR connecting to Nest server: " . $!); + $self->reconnect_delay(); + return; } - + + $$self{'keep-alive'} = time; return $$self{socket}; } +# Used to try reconnecting after a delay if there was an error + +sub reconnect_delay { + my ($self, $seconds, $url) = @_; + my $action = sub {$self->connect_stream($url)}; + if (!$seconds) { + $seconds = 60; + ::print_log("[Nest] Will try to connect again in 1 minute."); + } + $$self{reconnect_timer}->set($seconds,$action); +} + # Run once per loop to check for data present on the connection sub check_for_data { my ($self) = @_; - if ($$self{socket}->connected && (time - $$self{'keep-alive'} < 70)) { + if (defined $$self{socket} + && $$self{socket}->connected + && (time - $$self{'keep-alive'} < 70)) { # sysread will only read the contents of a single SSL frame if ($$self{socket}->sysread(my $buf, 1024)){ $$self{data} .= $buf; - if ($buf =~ /\n\n$/){ - # We reached the end of the message packet - ::print_log("[Nest Data]" . $$self{data}); + if ($$self{data} =~ /^HTTP/){ # Start of new stream + my $r = HTTP::Response->parse( $buf ); + if ($r->code == 307){ + # This is a location redirect + ::print_log "redirecting to " . $r->header( 'location' ) . "\n"; + $$self{socket} = $self->connect_stream($r->header( 'location' )); + } + elsif ($r->code == 401){ + ::print_log("[Nest] ERROR, your authorization was rejected. " + ."Please check your settings."); + $$self{enabled} = 0; + } + elsif ($r->code == 200){ + # Successful response + ::print_log("[Nest] Successfully connected to stream"); + } + else { + ::print_log("[Nest] ERROR, unable to connect stream. " + ."Response was: " . $r->as_string); + $self->reconnect_delay(); + } + $$self{data} = ""; + } + elsif ($buf =~ /\n\n$/){ + # We reached the end of the message packet in an existing stream + ::print_log("[Nest Data] :\n" . $$self{data}); # Split out event and data for processing my @lines = split("\n", $$self{data}); @@ -296,10 +338,10 @@ sub check_for_data { } } } - else { + elsif ($$self{reconnect_timer}->inactive && $$self{enabled}) { # The connection died, or the keep-alive messages stopped, restart it ::print_log("[Nest Interface] Connection died, restarting"); - $self->connect_stream(); + $self->reconnect_delay(1); } } @@ -326,7 +368,8 @@ sub parse_data { # Sent when auth parameter is no longer valid # Accoring to Nest, the auth token is essentially non-expiring, # so this shouldn't happen. - die ("[Nest] The Nest authorization token has expired"); + ::print_log("[Nest] ERROR, your Nest authorization token has expired."); + $$self{enabled} = 0; } return; } From 40847ff19d52ea15042d78f86fec22c1030a04aa Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Wed, 23 Jul 2014 18:15:00 -0700 Subject: [PATCH 170/180] Nest: Move Write Data to a Process Item; Check Write Response This will prevent the write action from blocking if there is a delay connecting to the Nest server. The write process is a little complicated but should be very robust, it can handle queuing multiple write commands at once. Added a simple check of the write response, will now print an error message if the response is not OK. Fixes krkeegan/misterhouse#27 Fixes krkeegan/misterhouse#26 --- lib/Nest.pm | 67 ++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 66 insertions(+), 1 deletion(-) diff --git a/lib/Nest.pm b/lib/Nest.pm index 6f75f208d..745ef5842 100644 --- a/lib/Nest.pm +++ b/lib/Nest.pm @@ -182,6 +182,11 @@ sub new { $$self{url} = $url; $$self{auth} = $auth; $$self{reconnect_timer} = new Timer; + $$self{write_process} = new Process_Item; + $$self{write_process}->set_timeout(30); + $$self{write_process_active} = 0; + $$self{write_process_queue} = []; + $$self{write_process_code} = sub {$self->write_process_handler();}; $$self{enabled} = 1; bless $self, $class; $self->connect_stream(); @@ -407,6 +412,29 @@ sub write_data { unless ($json eq 'true' || $json eq 'false' || $json =~ /^\d+(\.\d+)?$/){ $json = '"' . $json . '"'; } + + # Use a process item to prevent blocking + if (!$$self{write_process_active}){ + $$self{write_process}->set("&Nest_Interface::_write_data_process('$url','$json')"); + $$self{write_process}->start(); + $$self{write_process_active} = 1; + + # Add hook to check for completion of process + ::MainLoop_pre_add_hook($$self{write_process_code}, 'persistent'); + } + else { + push( + @{$$self{write_process_queue}}, + "&Nest_Interface::_write_data_process('$url','$json')" + ); + } +} + +# This is run as a separate process to prevent blocking errors. Can't use get_url +# because it doesn't have the PUT method or the content-type header + +sub _write_data_process { + my ($url, $json) = @_; my $req = HTTP::Request->new( 'PUT', $url ); $req->header( 'Content-Type' => 'application/json' ); $req->content( $json ); @@ -416,7 +444,44 @@ sub write_data { if ($r->code == 307){ # This is a location redirect ::print_log "redirecting to " . $r->header( 'location' ) . "\n"; - return $self->write_data($parent, $value, $data, $r->header( 'location' )); + return _write_data_process($r->header( 'location' ), $json); + } + ::file_write("$::config_parms{data_dir}/nest.resp", $r->as_string()); +} + +# This routine is set as a hook when a write process is running. When the +# write process completes, this routine checks the contents of the response + +sub write_process_handler { + my ($self) = @_; + if ($$self{write_process}->done_now){ + my $resp_string = ::file_read("$::config_parms{data_dir}/nest.resp"); + unlink("$::config_parms{data_dir}/nest.resp"); + my $r = HTTP::Response->parse( $resp_string ); + if ($r->code == 401){ + ::print_log("[Nest] ERROR, your authorization was rejected. " + ."Please check your settings."); + } + elsif ($r->code == 200){ + # Successful response + ::print_log("[Nest] Successfully wrote data"); + } + else { + my $content = decode_json $r->content; + ::print_log("[Nest] ERROR, unable to write data to Nest server. " + . $r->status_line . " - " . $$content{error}); + } + + # Look see if there is a queue of write commands + if (scalar @{$$self{write_process_queue}}) { + my $process = shift @{$$self{write_process_queue}}; + $$self{write_process}->set($process); + $$self{write_process}->start(); + } + else{ + $$self{write_process_active} = 0; + ::MainLoop_pre_drop_hook($$self{write_process_code}); + } } } From 0ee8a9b0c466c41a60ca4f89f75c50fb2bf26490 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Wed, 23 Jul 2014 18:25:00 -0700 Subject: [PATCH 171/180] Nest: Convert Print Logging to Debug Format - Added a nifty debug routine that unifies the creation of uniform print_log messages Fixes krkeegan/misterhouse#25 --- lib/Nest.pm | 97 +++++++++++++++++++++++++++++++++-------------------- 1 file changed, 60 insertions(+), 37 deletions(-) diff --git a/lib/Nest.pm b/lib/Nest.pm index 745ef5842..c86c8f0fe 100644 --- a/lib/Nest.pm +++ b/lib/Nest.pm @@ -82,6 +82,28 @@ changing certain parameters on the thermostat. =cut +package Nest; + +# Used solely to provide a consistent logging feature + +use strict; + +#log levels +my $warn = 1; +my $info = 2; +my $trace = 3; + +sub debug { + my ($self, $message, $level) = @_; + $level = 0 if $level eq ''; + my $line = ''; + my @caller = caller(0); + if ($::Debug{'nest'} >= $level || $level == 0){ + $line = " at line " . $caller[2] if $::Debug{'nest'} >= $trace; + ::print_log("[" . $caller[0] . "] " . $message . $line); + } +} + package Nest_Interface; =head1 B @@ -123,11 +145,11 @@ the Nest API solely through this object. =head2 INHERITS -C +C =cut -@Nest_Interface::ISA = ('Socket_Item'); +@Nest_Interface::ISA = ('Nest'); use strict; @@ -216,14 +238,14 @@ sub connect_stream { ); unless ($$self{socket}) { - ::print_log("[Nest] ERROR connecting to Nest server: " . $@); + $self->debug("ERROR connecting to Nest server: " . $@); $self->reconnect_delay(); return; } my $select = IO::Select->new($$self{socket}); # wait until it connected if ($select->can_write) { - ::print_log "[Nest Interface] IO::Socket::INET connected"; + $self->debug("IO::Socket::INET connected", $info); } # upgrade socket to IO::Socket::SSL @@ -232,11 +254,10 @@ sub connect_stream { # make non-blocking SSL handshake while (1) { if ($$self{socket}->connect_SSL) { # will not block - ::print_log "[Nest Interface] IO::Socket::SSL connected"; + $self->debug("IO::Socket::SSL connected", $info); last; } else { # handshake still incomplete - #::print_log "[Nest Interface] IO::Socket::SSL not connected yet"; if ($SSL_ERROR == SSL_WANT_READ) { $select->can_read; } @@ -244,7 +265,7 @@ sub connect_stream { $select->can_write; } else { - ::print_log("[Nest] ERROR connecting to Nest server: " . $SSL_ERROR); + $self->debug("ERROR connecting to Nest server: " . $SSL_ERROR); $self->reconnect_delay(); return; } @@ -258,9 +279,8 @@ sub connect_stream { ["Accept", "text/event-stream", "Host", $url->host] ); $request->protocol('HTTP/1.1'); - #print "requesting data:\n" . $request->as_string; unless ($$self{socket}->syswrite($request->as_string)){ - ::print_log("[Nest] ERROR connecting to Nest server: " . $!); + $self->debug("ERROR connecting to Nest server: " . $!); $self->reconnect_delay(); return; } @@ -276,7 +296,7 @@ sub reconnect_delay { my $action = sub {$self->connect_stream($url)}; if (!$seconds) { $seconds = 60; - ::print_log("[Nest] Will try to connect again in 1 minute."); + $self->debug("Will try to connect again in 1 minute."); } $$self{reconnect_timer}->set($seconds,$action); } @@ -295,20 +315,20 @@ sub check_for_data { my $r = HTTP::Response->parse( $buf ); if ($r->code == 307){ # This is a location redirect - ::print_log "redirecting to " . $r->header( 'location' ) . "\n"; + $self->debug("redirecting to " . $r->header( 'location' ), $trace); $$self{socket} = $self->connect_stream($r->header( 'location' )); } elsif ($r->code == 401){ - ::print_log("[Nest] ERROR, your authorization was rejected. " + $self->debug("ERROR, your authorization was rejected. " ."Please check your settings."); $$self{enabled} = 0; } elsif ($r->code == 200){ # Successful response - ::print_log("[Nest] Successfully connected to stream"); + $self->debug("Successfully connected to stream", $warn); } else { - ::print_log("[Nest] ERROR, unable to connect stream. " + $self->debug("ERROR, unable to connect stream. " ."Response was: " . $r->as_string); $self->reconnect_delay(); } @@ -316,7 +336,7 @@ sub check_for_data { } elsif ($buf =~ /\n\n$/){ # We reached the end of the message packet in an existing stream - ::print_log("[Nest Data] :\n" . $$self{data}); + $self->debug("Data :\n" . $$self{data}, $trace); # Split out event and data for processing my @lines = split("\n", $$self{data}); @@ -345,7 +365,7 @@ sub check_for_data { } elsif ($$self{reconnect_timer}->inactive && $$self{enabled}) { # The connection died, or the keep-alive messages stopped, restart it - ::print_log("[Nest Interface] Connection died, restarting"); + $self->debug("Connection died, restarting", $warn); $self->reconnect_delay(1); } } @@ -356,7 +376,7 @@ sub parse_data { my ($self, $event, $data) = @_; if ($event =~ /keep-alive/){ $$self{'keep-alive'} = time; - ::print_log("[Nest Keep Alive]"); + $self->debug("Keep Alive", $info); } elsif ($event =~ /put/){ $$self{'keep-alive'} = time; @@ -373,7 +393,7 @@ sub parse_data { # Sent when auth parameter is no longer valid # Accoring to Nest, the auth token is essentially non-expiring, # so this shouldn't happen. - ::print_log("[Nest] ERROR, your Nest authorization token has expired."); + $self->debug("ERROR, your Nest authorization token has expired."); $$self{enabled} = 0; } return; @@ -413,6 +433,8 @@ sub write_data { $json = '"' . $json . '"'; } + $self->debug("writing $json to $url", $trace); + # Use a process item to prevent blocking if (!$$self{write_process_active}){ $$self{write_process}->set("&Nest_Interface::_write_data_process('$url','$json')"); @@ -443,7 +465,8 @@ sub _write_data_process { my $r = $lwp->request( $req ); if ($r->code == 307){ # This is a location redirect - ::print_log "redirecting to " . $r->header( 'location' ) . "\n"; + ::print_log("[Nest_Interface] redirecting to " . $r->header( 'location' )) + if $::Debug{'nest'} >=3; return _write_data_process($r->header( 'location' ), $json); } ::file_write("$::config_parms{data_dir}/nest.resp", $r->as_string()); @@ -459,16 +482,16 @@ sub write_process_handler { unlink("$::config_parms{data_dir}/nest.resp"); my $r = HTTP::Response->parse( $resp_string ); if ($r->code == 401){ - ::print_log("[Nest] ERROR, your authorization was rejected. " + $self->debug("ERROR, your authorization was rejected. " ."Please check your settings."); } elsif ($r->code == 200){ # Successful response - ::print_log("[Nest] Successfully wrote data"); + $self->debug("Successfully wrote data", $info); } else { my $content = decode_json $r->content; - ::print_log("[Nest] ERROR, unable to write data to Nest server. " + $self->debug("ERROR, unable to write data to Nest server. " . $r->status_line . " - " . $$content{error}); } @@ -493,7 +516,7 @@ Prints the name and device_id of all devices found in the Nest account. sub print_devices { my ($self) = @_; - my $output = "[Nest] The list of devices reported by Nest is:\n"; + my $output = "The list of devices reported by Nest is:\n"; for (keys %{$$self{JSON}{data}{devices}}){ my $device_type = $_; $output .= " $device_type =\n"; @@ -504,7 +527,7 @@ sub print_devices { $output .= " Name: $device_name ID: $device_id\n"; } } - ::print_log($output); + $self->debug($output); } =item C @@ -515,13 +538,13 @@ Prints the name and device_id of all structures found in the Nest account. sub print_structures { my ($self) = @_; - my $output = "[Nest] The list of structures reported by Nest is:\n"; + my $output = "The list of structures reported by Nest is:\n"; for (keys %{$$self{JSON}{data}{structures}}){ my $structure_id = $_; my $structure_name = $$self{JSON}{data}{structures}{$structure_id}{name}; $output .= " Name: $structure_name ID: $structure_id\n"; } - ::print_log($output); + $self->debug($output); } =item C @@ -602,7 +625,7 @@ C =cut -@Nest_Generic::ISA = ('Generic_Item'); +@Nest_Generic::ISA = ('Generic_Item', 'Nest'); =head2 METHODS @@ -660,7 +683,7 @@ sub device_id { return $device_id; } } - ::print_log("[Nest] ERROR, no device by the name " . $$parent{name} . " was found."); + $self->debug("ERROR, no device by the name " . $$parent{name} . " was found."); return 0; } @@ -674,7 +697,7 @@ More sophisticated children can hijack this method to do more complex tasks. sub data_changed { my ($self, $value_name, $new_value) = @_; - ::print_log("[Nest] Data changed called $value_name, $new_value"); + $self->debug("Data changed called $value_name, $new_value", $info); $self->set_receive($new_value); } @@ -863,7 +886,7 @@ sub set_fan_state { my ($self, $state, $p_setby, $p_response) = @_; $state = lc($state); if ($state ne 'true' && $state ne 'false'){ - ::print_log("[Nest] set_fan_state must be true or false"); + $self->debug("set_fan_state must be true or false"); return; } $$self{interface}->write_data($self, 'fan_timer_active', $state); @@ -879,7 +902,7 @@ Sets the target temp for the heat or cool mode to $state. sub set_target_temp { my ($self, $state, $p_setby, $p_response) = @_; unless ($state =~ /^\d+(\.\d+)?$/){ - ::print_log("[Nest] set_target_temp must be a number"); + $self->debug("set_target_temp must be a number"); return; } $$self{interface}->write_data($self, 'target_temperature_' . $$self{scale}, $state); @@ -895,7 +918,7 @@ Sets the heat target temp for the combined heat-cool mode to $state. sub set_target_temp_high { my ($self, $state, $p_setby, $p_response) = @_; unless ($state =~ /^\d+(\.\d+)?$/){ - ::print_log("[Nest] set_target_temp_high must be a number"); + $self->debug("set_target_temp_high must be a number"); return; } $$self{interface}->write_data($self, 'target_temperature_high_' . $$self{scale}, $state); @@ -911,7 +934,7 @@ Sets the cool target temp for the combined heat-cool mode to $state. sub set_target_temp_low { my ($self, $state, $p_setby, $p_response) = @_; unless ($state =~ /^\d+(\.\d+)?$/){ - ::print_log("[Nest] set_target_temp_low must be a number"); + $self->debug("set_target_temp_low must be a number"); return; } $$self{interface}->write_data($self, 'target_temperature_low_' . $$self{scale}, $state); @@ -928,7 +951,7 @@ sub set_hvac_mode { my ($self, $state, $p_setby, $p_response) = @_; $state = lc($state); if ($state ne 'heat' && $state ne 'cool' && $state ne 'heat-cool' && $state ne 'off'){ - ::print_log("[Nest] set_hvac_mode must be one of: heat, cool, heat-cool, or off. Not $state."); + $self->debug("set_hvac_mode must be one of: heat, cool, heat-cool, or off. Not $state."); return; } $$self{state_pending} = [$p_setby, $p_response]; @@ -1097,7 +1120,7 @@ sub new { sub set { my ($self, $p_state, $p_setby, $p_response) = @_; - ::print_log("Setting $p_setby, $p_response"); + $self->debug("Setting $p_state, $p_setby, $p_response", $info); $$self{parent}->set_hvac_mode($p_state,$p_setby,$p_response); } @@ -1417,7 +1440,7 @@ sub new { sub data_changed { my ($self, $value_name, $new_value) = @_; - ::print_log("[Nest_Smoke_CO_Alarm] Data changed called $value_name, $new_value"); + $self->debug("Data changed called $value_name, $new_value", $info); $$self{$value_name} = $new_value; my $state = ''; if ($$self{co_alarm_state} eq 'emergency'){ @@ -1568,7 +1591,7 @@ sub set_away_status { my ($self, $state, $p_setby, $p_response) = @_; $state = lc($state); if ($state ne 'home' && $state ne 'away'){ - ::print_log("[Nest] set_away_status must be either home or away."); + $self->debug("set_away_status must be either home or away."); return; } $$self{interface}->write_data($self, 'away', $state); From 9beec944cea01a1c87cb5f2ec9d34c49d91a87d6 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Wed, 23 Jul 2014 18:35:00 -0700 Subject: [PATCH 172/180] Nest: Allow for Multiple Pending_State; Add Interface as Setby for Startup Fixes krkeegan/misterhouse#28 --- lib/Nest.pm | 43 +++++++++++++++++++++---------------------- 1 file changed, 21 insertions(+), 22 deletions(-) diff --git a/lib/Nest.pm b/lib/Nest.pm index c86c8f0fe..75ebca38e 100644 --- a/lib/Nest.pm +++ b/lib/Nest.pm @@ -697,8 +697,16 @@ More sophisticated children can hijack this method to do more complex tasks. sub data_changed { my ($self, $value_name, $new_value) = @_; + my ($setby, $response); $self->debug("Data changed called $value_name, $new_value", $info); - $self->set_receive($new_value); + if (defined $$self{parent}{state_pending}{$value_name}){ + ($setby, $response) = @{$$self{parent}{state_pending}{$value_name}}; + delete $$self{parent}{state_pending}{$value_name}; + } + else { + $setby = $$self{interface}; + } + $self->set_receive($new_value, $setby, $response); } =item C @@ -709,10 +717,6 @@ Handles setting the state of the object inside MisterHouse sub set_receive { my ($self, $p_state, $p_setby, $p_response) = @_; - if (defined $$self{parent}{state_pending}){ - ($p_setby, $p_response) = @{$$self{parent}{state_pending}}; - delete $$self{parent}{state_pending}; - } $self->SUPER::set($p_state, $p_setby, $p_response); } @@ -890,7 +894,7 @@ sub set_fan_state { return; } $$self{interface}->write_data($self, 'fan_timer_active', $state); - $$self{state_pending} = [$p_setby, $p_response]; + $$self{state_pending}{fan_timer_active} = [$p_setby, $p_response]; } =item C @@ -905,8 +909,9 @@ sub set_target_temp { $self->debug("set_target_temp must be a number"); return; } - $$self{interface}->write_data($self, 'target_temperature_' . $$self{scale}, $state); - $$self{state_pending} = [$p_setby, $p_response]; + my $value = 'target_temperature_' . $$self{scale}; + $$self{interface}->write_data($self, $value, $state); + $$self{state_pending}{$value} = [$p_setby, $p_response]; } =item C @@ -921,8 +926,9 @@ sub set_target_temp_high { $self->debug("set_target_temp_high must be a number"); return; } - $$self{interface}->write_data($self, 'target_temperature_high_' . $$self{scale}, $state); - $$self{state_pending} = [$p_setby, $p_response]; + my $value = 'target_temperature_high_' . $$self{scale}; + $$self{interface}->write_data($self, $value, $state); + $$self{state_pending}{$value} = [$p_setby, $p_response]; } =item C @@ -937,8 +943,9 @@ sub set_target_temp_low { $self->debug("set_target_temp_low must be a number"); return; } - $$self{interface}->write_data($self, 'target_temperature_low_' . $$self{scale}, $state); - $$self{state_pending} = [$p_setby, $p_response]; + my $value = 'target_temperature_low_' . $$self{scale}; + $$self{interface}->write_data($self, $value, $state); + $$self{state_pending}{$value} = [$p_setby, $p_response]; } =item C @@ -954,7 +961,7 @@ sub set_hvac_mode { $self->debug("set_hvac_mode must be one of: heat, cool, heat-cool, or off. Not $state."); return; } - $$self{state_pending} = [$p_setby, $p_response]; + $$self{state_pending}{hvac_mode} = [$p_setby, $p_response]; $$self{interface}->write_data($self, 'hvac_mode', $state); } @@ -1011,10 +1018,6 @@ sub set_receive { my ($self, $p_state, $p_setby, $p_response) = @_; my $state = "on"; $state = "off" if ($p_state eq 'false'); - if (defined $$self{parent}{state_pending}){ - ($p_setby, $p_response) = @{$$self{parent}{state_pending}}; - delete $$self{parent}{state_pending}; - } $self->SUPER::set($state, $p_setby, $p_response); } @@ -1069,10 +1072,6 @@ sub set_receive { my ($self, $p_state, $p_setby, $p_response) = @_; my $state = "on"; $state = "off" if ($p_state eq 'false'); - if (defined $$self{parent}{state_pending}){ - ($p_setby, $p_response) = @{$$self{parent}{state_pending}}; - delete $$self{parent}{state_pending}; - } $self->SUPER::set($state, $p_setby, $p_response); } @@ -1595,7 +1594,7 @@ sub set_away_status { return; } $$self{interface}->write_data($self, 'away', $state); - $$self{state_pending} = [$p_setby, $p_response]; + $$self{state_pending}{away} = [$p_setby, $p_response]; } sub set { From 567540bd69a310609f52c4e21681b8448f7b9045 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 24 Jul 2014 19:40:50 -0700 Subject: [PATCH 173/180] Nest: Add Notes on Creating and Adding to Groups --- lib/Nest.pm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/Nest.pm b/lib/Nest.pm index 75ebca38e..3a8384470 100644 --- a/lib/Nest.pm +++ b/lib/Nest.pm @@ -28,10 +28,12 @@ Create a Nest instance in the .mht file, or in user code: CODE, require Nest; #noloop CODE, $nest = new Nest_Interface(); #noloop + CODE, $myhouse = new Group(); #noloop CODE, $nest_thermo = new Nest_Thermostat('Entryway', $nest, 'f'); #noloop CODE, $nest_thermo_mode = new Nest_Thermo_Mode($nest_thermo); #noloop CODE, $nest_alarm = new Nest_Smoke_CO_Alarm('Kitchen', $nest); #noloop CODE, $nest_home = new Nest_Structure('Home', $nest); #noloop + CODE, $myhouse->add($nest_thermo, $nest_thermo_mode, $nest_alarm, $nest_home); #noloop Explanations of the parameters is contained below in the documentation for each module. From 367d420470e6587984f2b6add98d74fbee17ff5c Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Fri, 25 Jul 2014 14:13:45 -0700 Subject: [PATCH 174/180] Insteon: Add INI Documenation to mh.ini Much of it was simply copied from the INI section in the Insteon POD documentation Closes hollie/misterhouse#448 --- bin/mh.ini | 83 +++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 82 insertions(+), 1 deletion(-) diff --git a/bin/mh.ini b/bin/mh.ini index 369a5d952..ffe2c1857 100644 --- a/bin/mh.ini +++ b/bin/mh.ini @@ -2054,9 +2054,90 @@ eib_errata=2 # Category = Insteon @ These are the states displayed on the tk and web menus -@ French: insteon_menu_states=on,off,normal,eco,plus,moins,plus2,moins2,plus3,moins3,+40,-40,5%,30%,60%,100% +@ French: insteon_menu_states=on,off,normal,eco,plus,moins,plus2,moins2,plus3,moins3,+40,-40,5%,30%,60%,100% +@ The default is off,20%,40%,50%,60%,80%,on insteon_menu_states=off,20%,40%,50%,60%,80%,on +@ This is a deprecated parameter that no longer does anything. +@ It is kept around on the off chance that it may be revived in the future. +@ The default is 10. +Insteon_PLM_max_queue_time=10 + +@ If set to 1, MisterHouse will request the status of all Insteon devices on startup. +@ This is useful for making sure that no devices changed their state while MisterHouse was off. +@ The routine will also check the engine version of each device to ensure that the proper ALDB object is created for them. +@ The default is enabled. Set to 0 to disable. +Insteon_PLM_scan_at_startup=1 + +@ Sets the number of times that MisterHouse will try to resend a failed message. +@ The Insteon specification calls for at least 3, MisterHouse defaults to 5. +Insteon_retry_count=5 + +@ Identifies the port on which the PLM is attached. +@ For example: Insteon_PLM_serial_port=/dev/ttyS4 +Insteon_PLM_serial_port= + +@ Setting this to 1, will enable MisterHouse to use a networked PLM such as the +@ Insteon Hub. This functionality seems fairly stable, but has not been +@ extensively tested. +@ +@ You will also need to set values for Insteon_PLM_TCP_host and Insteon_PLM_TCP_port +@ +@ There are a few quirks when using a networked PLM, they include: +@ +@ The communication may be slightly slower with the network PLM. In order to +@ prevent MisterHouse from clobbering the device it is recommended that you +@ set the Insteon_PLM_xmit_delay to 1 second. Testing may reveal that slightly +@ lower delays are also acceptable. +@ +@ Changes made using the hub's web interface will not be understood by MisterHouse. +@ Device states may become out of sync. (It is possible that future coding may +@ be able to overcome this limiation) +Insteon_PLM_use_TCP= + +@ If using a network PLM, set this to the IP address of the PLM. See Insteon_PLM_use_TCP +Insteon_PLM_TCP_host= + +@ If using a network PLM, set this to the port address of the PLM. Generally, the +@ port number is 9761. See Insteon_PLM_use_TCP +Insteon_PLM_TCP_port= + +@ Sets the minimum amount of seconds that must elapse between sending Insteon messages +@ to the PLM. Defaults to 0.25. +Insteon_PLM_xmit_delay=.25 + +@ Sets the minimum amount of seconds that must elapse between sending X10 messages +@ to the PLM. Defaults to 0.50. +Insteon_PLM_xmit_x10_delay=.50 + +@ Periodically, the PLM will report that it is too busy to accept a message from +@ MisterHouse. When this happens, MisterHouse will wait 1 second before trying +@ to send a message to the PLM. If this is set to 1, downgrades the delay to only +@ .3 seconds. Most of the issues which caused the PLM to overload have been handled +@ it is unlikely that you would need to set this. +Insteon_PLM_disable_throttling=0 + +@ The PLM acknowledges the receipt of a command from MisterHouse with an ACK +@ message. It is very rare for a well functioning PLM to fail to send the ACK +@ message. In many cases, the failure to receive an ACK message from the PLM +@ is a sign that the connection between MisterHouse and the PLM (Serial or USB) +@ has died. +@ +@ This setting defines the number of missed ACK messages that must occur for +@ MisterHouse to deem the PLM connection lost. The number of missed ACK messages +@ must all occur while sending a single Insteon command. So if you want this +@ to do anything, this number needs to be less than or equal to the +@ Insteon_retry_count. Once the number of missed ACK messages occurs, MisterHouse +@ will attempt to reconnect the PLM. For some people, the reconnect routine +@ causes errors, so you may want to test this out by manually pulling the +@ connection cable to the PLM to see how your system will react. +@ +@ By default, this is set to 99, essentially disabling an automatic restart. +@ +@ Note the ACK messages discussed here refer to PLM ACK messages not the ACK +@ messages received from an Insteon device in response to a command. +Insteon_PLM_reconnect_count=99 + ****************************************************************************** # Category = Misc From 8d0a4da1fbb280e368d9e857096f576ceb2993b1 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Fri, 25 Jul 2014 14:17:02 -0700 Subject: [PATCH 175/180] Insteon: Add POD documenation for Insteon_PLM_reconnect_count --- lib/Insteon_PLM.pm | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/lib/Insteon_PLM.pm b/lib/Insteon_PLM.pm index 4385965ad..5b91483ae 100644 --- a/lib/Insteon_PLM.pm +++ b/lib/Insteon_PLM.pm @@ -1211,6 +1211,28 @@ to send a message to the PLM. If this is set to 1, downgrades the delay to only .3 seconds. Most of the issues which caused the PLM to overload have been handled it is unlikely that you would need to set this. +=item Insteon_PLM_reconnect_count + +The PLM acknowledges the receipt of a command from MisterHouse with an ACK +message. It is very rare for a well functioning PLM to fail to send the ACK +message. In many cases, the failure to receive an ACK message from the PLM +is a sign that the connection between MisterHouse and the PLM (Serial or USB) +has died. + +This setting defines the number of missed ACK messages that must occur for +MisterHouse to deem the PLM connection lost. The number of missed ACK messages +must all occur while sending a single Insteon command. So if you want this +to do anything, this number needs to be less than or equal to the +Insteon_retry_count. Once the number of missed ACK messages occurs, MisterHouse +will attempt to reconnect the PLM. For some people, the reconnect routine +causes errors, so you may want to test this out by manually pulling the +connection cable to the PLM to see how your system will react. + +By default, this is set to 99, essentially disabling an automatic restart. + +Note the ACK messages discussed here refer to PLM ACK messages not the ACK +messages received from an Insteon device in response to a command. + =back =head2 NOTES From f31ea41e6da1f53385e5d259220f0a537189e84f Mon Sep 17 00:00:00 2001 From: JaredF Date: Tue, 29 Jul 2014 17:08:54 -0700 Subject: [PATCH 176/180] Fixes #456 --- code/common/weather_tides.pl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/code/common/weather_tides.pl b/code/common/weather_tides.pl index 9c73fe7b0..9507e6ea5 100644 --- a/code/common/weather_tides.pl +++ b/code/common/weather_tides.pl @@ -1,7 +1,7 @@ # Category = Weather #@ This script collects information about ocean tides, moonrise and moonset from the -#@ University of Southern Carolina Tide Predictor. +#@ University of Southern Carolina Tide Predictor. #@ Set the weather_tide_site ini parameter to the tide site closest to you. # 12/04/05 created by David Norwood based on idea by Joey French @@ -15,7 +15,7 @@ $v_read_tides = new Voice_Cmd 'When is the next [High Tide,Low Tide,Moonrise,Moonset]?'; $v_read_tides ->set_info('Show tide, moonrise and moonset information from the Internet'); $p_get_tides = new Process_Item; - $tide_site = $config_parms{'weather_tide_site'} if $config_parms{'weather_tide_site'}; + $tide_site = $config_parms{weather_tide_site} if $config_parms{weather_tide_site}; $tide_site = &escape($tide_site); set $p_get_tides "get_url http://tbone.biol.sc.edu/tide/tideshow.cgi?site=$tide_site $f_tides"; trigger_delete "get tide info"; From 2e232523676017ac35de558facbc2ce526f16e8b Mon Sep 17 00:00:00 2001 From: JaredF Date: Tue, 29 Jul 2014 20:37:39 -0700 Subject: [PATCH 177/180] Updated Documentation for weather_tides.pl --- bin/mh.ini | 9 +++++++++ code/common/weather_tides.pl | 3 ++- 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/bin/mh.ini b/bin/mh.ini index 8cee3ef41..f30ab54dc 100644 --- a/bin/mh.ini +++ b/bin/mh.ini @@ -2144,6 +2144,15 @@ Insteon_PLM_disable_throttling=0 @ messages received from an Insteon device in response to a command. Insteon_PLM_reconnect_count=99 +# ****************************************************************************** +# Category = Weather + +@ Used by the common code file weather_tides.pl to specify the nearest coastal region +@ from which to obtain tide data. Enter a location from the list at http://tbone.biol.sc.edu/tide, +@ for example, weather_tide_site=San Diego, San Diego Bay, California + +weather_tide_site= + ****************************************************************************** # Category = Misc diff --git a/code/common/weather_tides.pl b/code/common/weather_tides.pl index 9507e6ea5..ed6bfd0f8 100644 --- a/code/common/weather_tides.pl +++ b/code/common/weather_tides.pl @@ -4,7 +4,8 @@ #@ University of Southern Carolina Tide Predictor. #@ Set the weather_tide_site ini parameter to the tide site closest to you. -# 12/04/05 created by David Norwood based on idea by Joey French +# Version 1.1 07/29/14 Fixed description and ini parameter reference - Jared J. Fernandez +# Version 1.0 12/04/05 created by David Norwood based on idea by Joey French #noloop=start From 1af46e7514e3616bf1f48d3b66e8ea7e37d9f223 Mon Sep 17 00:00:00 2001 From: rudybrian Date: Thu, 31 Jul 2014 11:24:14 -0700 Subject: [PATCH 178/180] Added POD skeleton and a little documentation to lib/Telephony_Interface.pm (#393) --- lib/Telephony_Interface.pm | 120 +++++++++++++++++++++++++++++++++++++ 1 file changed, 120 insertions(+) diff --git a/lib/Telephony_Interface.pm b/lib/Telephony_Interface.pm index a3e5ba2a5..075964ddf 100644 --- a/lib/Telephony_Interface.pm +++ b/lib/Telephony_Interface.pm @@ -1,3 +1,45 @@ +=head1 B + +=head2 SYNOPSIS + +In the ini you must define a device such as: + + callerid_port = localhost:3333 + callerid_name = acheron-ncid + callerid_type = ncid + +=head2 DESCRIPTION + +Provides support for common serial and network attached Caller ID devices. +The majority of serial devices are basically modems, but some chipsets better +support CID features than others. The following CID device types are supported: + + default Default modem + motorola Motorola modem + powerbit Intertex (Powerbit, Telia) + rockwell Rockwell chipset modems + supra Supra modems + cirruslogic Cirrus Logic chipset modems + zyxel Zyxel modems + netcallerid NetCallerID devices (no longer available) + ncid NCID - Network Caller ID server + +=head3 NCID + +When using callerid_type = ncid, the callerid_port must be given in the format I such as: + + callerid_port = localhost:3333 + +=head2 INHERITS + +L + +=head2 METHODS + +=over + +=cut + use strict; use Telephony_Item; @@ -19,6 +61,12 @@ my %table = (default => ['ATE1V1X4&C1&D2S0=0+VCID=1', 38400, 'dtr'] netcallerid => ['', 4800, ''], ncid => ['', 0, '']); +=item C + +Instantiates a new object. + +=cut + sub new { my ($class, $name, $port, $type)= @_; my $self={}; @@ -52,6 +100,12 @@ sub new { return $self; } +=item C + +Open the given serial port or network socket. + +=cut + sub open_port { my ($self) = @_; my $name = $$self{name}; @@ -89,6 +143,12 @@ sub open_port { } } +=item C + +Initialize the serial device + +=cut + sub init { my ($self) = @_; my $name = $$self{name}; @@ -99,10 +159,22 @@ sub init { } } +=item C + +Unload any defined devices and force a reset. + +=cut + sub reload_reset { undef %list_objects; } +=item C + +Look for new data on the serial port or network socket. + +=cut + sub check_for_data { for my $port (@list_ports) { if ($cid_server_connect) { @@ -145,6 +217,12 @@ sub check_for_data { } } +=item C + +Process misc phone data like rings + +=cut + # Process Other phone data sub process_phone_data { my ($port, $data) = @_; @@ -156,6 +234,12 @@ sub process_phone_data { } } +=item C + +Process CID data from the device. + +=cut + # Process Caller ID data sub process_cid_data { my ($port, $data)= @_; @@ -254,6 +338,11 @@ sub process_cid_data { } } +=item C + +Set the device on or off hook + +=cut sub set { my ($self, $p_state, $p_setby) = @_; @@ -266,12 +355,43 @@ sub set { $self->SUPER::set($p_state, $p_setby); } +=item C + +Used for testing. + +=cut + sub set_test { my ($self, $data) = @_; my $name = $$self{name}; $main::Serial_Ports{$name}{data_record} = $data; } + +=back + +=head2 AUTHOR + +Chris Witte, +Bruce Winter, +Matthew Williams, +Brian Rudy + +=head2 SEE ALSO + +L + +=head2 LICENSE + +This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. + +This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + +=cut + + 1; __END__ From 9553e001435ab8fc50702261551a4bc7ae5b8314 Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Tue, 12 Aug 2014 15:53:17 -0700 Subject: [PATCH 179/180] X10/Insteon: Cherry-Pick Former Commit That was Erroneously Reverted Original commit message is below. 194cf56c2d46149b11d7a8732db41125991bc143 X10/Insteon: Remove Line Which Attempted to Add the X10 Device to the PLM Symptoms: the PLM states parameter contained the entire hashes of any X10 devices. This made get_states useless on the PLM (it should return an empty array). Instead it returned a bunch of garbage. This further lead to crashed in the json and xml servers. Cause: the $interface->add($X10_Object) command was calling the add subroutine in Device_Item. I am not even sure how the inheritance allowed this to happen. But this routine expected a list of states to be passed as the first parameter not an object. Solution: Remove the offending call to add. It is not clear why this was used (the commit notes demonstrate that this was added when support for X10 over Insteon was added). Perhaps the drafter intended to add the X10 device as a member of the PLM? However, the PLM itself has no members, PLM scenes are allowed to have members. Alternatively, perhaps the drafter intended to add the object to the list maintained by InsteonManager? Adding some code to the X10_Item would allow this to work in theory, however it isn't clear to me why you would want this. The list is maintained so that the insteon_manager can assist in link management, something not done by X10 devices. We have also been operating without adding the X10 items to the object list for quite some time without incident. Indeed no current calls to find_members would even return an X10 device as they all specifiy Insteon packages. Finally, perhaps this is some vestige of the old Insteon code. Removing the offending line solves the issue, and does not appear to have any adverse effects. --- lib/X10_Items.pm | 1 - 1 file changed, 1 deletion(-) diff --git a/lib/X10_Items.pm b/lib/X10_Items.pm index 0f39ba196..f08c1d8c1 100644 --- a/lib/X10_Items.pm +++ b/lib/X10_Items.pm @@ -242,7 +242,6 @@ sub set_interface { } elsif ( defined $interface_object and $interface_object->isa('Insteon_PLM')) { print "[X10] for id $id, x10 interface supplied ($interface) and supported by an Insteon PLM\n" if $localDebug; $self->{interface} = $interface_object; - $self->{interface}->add($self); } else { # we can't find a real interface, so use a Dummy_Interface print "[X10] warning, using dummy interface for id $id and supplied interface $interface\n" if $localDebug; From ad00ae0b64742adf9ff1ae44cefdd7ba6baa3c7a Mon Sep 17 00:00:00 2001 From: KRKeegan Date: Thu, 14 Aug 2014 08:23:00 -0700 Subject: [PATCH 180/180] Insteon: Fix Error In Set Receive Affecting Presence Monitor Items Fix bug as reported by jduda on the mailing list. --- lib/Insteon/BaseInsteon.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Insteon/BaseInsteon.pm b/lib/Insteon/BaseInsteon.pm index 248ba7f01..956930b4d 100644 --- a/lib/Insteon/BaseInsteon.pm +++ b/lib/Insteon/BaseInsteon.pm @@ -3489,7 +3489,7 @@ sub set_linked_devices $$self{members}{$member_ref}{resume_state} = $light->state; $member->manual($light, $ramp_rate); if (lc $link_state ne 'on'){ - $local_state = $light->$link_state; + $local_state = $light->derive_link_state($link_state); } $light->set_receive($local_state,$self); }