From b670e1579d9191a38a04400ddb8c7ba87bb434ba Mon Sep 17 00:00:00 2001 From: waynieack Date: Fri, 29 Jul 2016 16:19:22 -0500 Subject: [PATCH 1/7] Added alpha SCHEDULE module --- lib/SCHEDULE.pm | 120 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 120 insertions(+) create mode 100644 lib/SCHEDULE.pm diff --git a/lib/SCHEDULE.pm b/lib/SCHEDULE.pm new file mode 100644 index 000000000..19bcba251 --- /dev/null +++ b/lib/SCHEDULE.pm @@ -0,0 +1,120 @@ +package SCHEDULE; +@SCHEDULE::ISA = ('Generic_Item'); + + +sub new +{ + my ($class) = @_; + my $self = new Generic_Item(); + bless $self, $class; + @{$$self{states}} = ('ON','OFF'); + return $self; +} + + + +sub set { + my ($self, $p_state, $p_setby, $p_response) = @_; + $self->SUPER::set($p_state,$p_setby,1); + } + +sub set_schedule { + my ($self, $type, $p_state) = @_; + $self{'schedule'}{'type'} = lc($type); + my @cals; + #$self{'type'} = 'calendar'; + #$self{'schedule'}{'7'}{'28'}{'20'}{'41'}{'action'} = 'start'; + #$self{'schedule'}{'7'}{'28'}{'20'}{'42'}{'action'} = 'stop'; + if ($p_state =~ /-/) { @cals = split /-/, $p_state } + else { @cals = ($p_state) } + foreach my $values (@cals) { + my @calvals = split /,/, $values; + $self{'schedule'}{$calvals[1]}{$calvals[2]}{$calvals[3]}{$calvals[4]}{'action'} = lc($calvals[0]) if ($type eq 'calendar'); + $self{'schedule'}{lc($calvals[1])}{$calvals[2]}{$calvals[3]}{'action'} = lc($calvals[0]) if ($type eq 'daily'); + $self{'schedule'}{lc($calvals[1])}{$calvals[2]}{$calvals[3]}{'action'} = lc($calvals[0]) if ($type eq 'wdwe'); + $self{'schedule'}{$calvals[1]}{$calvals[2]}{'action'} = lc($calvals[0]) if ($type eq 'time'); + } + } + + + +=item C + +Used to associate child objects with the interface. + +=cut + +sub register { + my ($self, $object, $child, $start, $stop) = @_; + if ($object->isa('SCHEDULE_Generic')) { + ::print_log("Registering a SCHEDULE Child Object type SCHEDULE_Generic" ); + push @{$self->{generic_object}}, $object; + ::MainLoop_pre_add_hook( sub {SCHEDULE::check_date($self,$object);}, 'persistent'); + } +} + + + +sub check_date { + my ($self,$object) = @_; + if ($::New_Minute) { + ::print_log("[SCHEDULE] Checking schedule for ". $self->get_object_name." Sate is ". (state $self) . " Child object is ". $object->get_object_name); + if (lc(state $self) eq 'on') { + my $Week; + if ($::Weekday) { $Week = 'weekday' } elsif ($::Weekend) { $Week = 'weekend' } + if (($self{'schedule'}{'type'} eq 'calendar') && + (defined(my $action = $self{'schedule'}{$::Month}{$::Mday}{$::Hour}{$::Minute}{'action'}))) { + ::print_log("[SCHEDULE] Setting ".$object->{child}->get_object_name." state to ".$object->{$action}); + $object->{child}->SUPER::set($object->{$action},$self->get_object_name,1); + } + elsif (($self{'schedule'}{'type'} eq 'daily') && + (defined(my $action = $self{'schedule'}{lc($::Day)}{$::Hour}{$::Minute}{'action'}))) { + ::print_log("[SCHEDULE] Setting ".$object->{child}->get_object_name." state to ".$object->{$action}); + $object->{child}->SUPER::set($object->{$action},$self->get_object_name,1); + } + elsif (($self{'schedule'}{'type'} eq 'wdwe') && + (defined(my $action = $self{'schedule'}{$Week}{$::Hour}{$::Minute}{'action'}))) { + ::print_log("[SCHEDULE] Setting ".$object->{child}->get_object_name." state to ".$object->{$action}); + $object->{child}->SUPER::set($object->{$action},$self->get_object_name,1); + } + elsif (($self{'schedule'}{'type'} eq 'time') && + (defined(my $action = $self{'schedule'}{$::Hour}{$::Minute}{'action'}))) { + ::print_log("[SCHEDULE] Setting ".$object->{child}->get_object_name." state to ".$object->{$action}); + $object->{child}->SUPER::set($object->{$action},$self->get_object_name,1); + } + } + + } +} + + +package SCHEDULE_Generic; +@SCHEDULE_Generic::ISA = ('Generic_Item'); + + +sub new +{ + my ($class, $parent, $child, $start, $stop) = @_; + my $self = new Generic_Item(); + bless $self, $class; + $$self{parent} = $parent; + $$self{child} = $child; + $$self{start} = $start; + $$self{stop} = $stop; + $parent->register($self,$child,$start,$stop); + if (defined($start)) { + @{$$self{states}} = ($start,$stop); + } else { + @{$$self{states}} = ($child->get_states()); + } + return $self; +} + + + +sub set { + my ($self, $p_state, $p_setby, $p_response) = @_; + $self->SUPER::set($p_state,$p_setby,1); +} + + From 886e4112ffce4696d1ede70838454c0aa2f7daf3 Mon Sep 17 00:00:00 2001 From: waynieack Date: Thu, 20 Oct 2016 15:06:52 -0500 Subject: [PATCH 2/7] Revert to move to changes to branches --- lib/SCHEDULE.pm | 120 ------------------------------------------------ 1 file changed, 120 deletions(-) delete mode 100644 lib/SCHEDULE.pm diff --git a/lib/SCHEDULE.pm b/lib/SCHEDULE.pm deleted file mode 100644 index 19bcba251..000000000 --- a/lib/SCHEDULE.pm +++ /dev/null @@ -1,120 +0,0 @@ -package SCHEDULE; -@SCHEDULE::ISA = ('Generic_Item'); - - -sub new -{ - my ($class) = @_; - my $self = new Generic_Item(); - bless $self, $class; - @{$$self{states}} = ('ON','OFF'); - return $self; -} - - - -sub set { - my ($self, $p_state, $p_setby, $p_response) = @_; - $self->SUPER::set($p_state,$p_setby,1); - } - -sub set_schedule { - my ($self, $type, $p_state) = @_; - $self{'schedule'}{'type'} = lc($type); - my @cals; - #$self{'type'} = 'calendar'; - #$self{'schedule'}{'7'}{'28'}{'20'}{'41'}{'action'} = 'start'; - #$self{'schedule'}{'7'}{'28'}{'20'}{'42'}{'action'} = 'stop'; - if ($p_state =~ /-/) { @cals = split /-/, $p_state } - else { @cals = ($p_state) } - foreach my $values (@cals) { - my @calvals = split /,/, $values; - $self{'schedule'}{$calvals[1]}{$calvals[2]}{$calvals[3]}{$calvals[4]}{'action'} = lc($calvals[0]) if ($type eq 'calendar'); - $self{'schedule'}{lc($calvals[1])}{$calvals[2]}{$calvals[3]}{'action'} = lc($calvals[0]) if ($type eq 'daily'); - $self{'schedule'}{lc($calvals[1])}{$calvals[2]}{$calvals[3]}{'action'} = lc($calvals[0]) if ($type eq 'wdwe'); - $self{'schedule'}{$calvals[1]}{$calvals[2]}{'action'} = lc($calvals[0]) if ($type eq 'time'); - } - } - - - -=item C - -Used to associate child objects with the interface. - -=cut - -sub register { - my ($self, $object, $child, $start, $stop) = @_; - if ($object->isa('SCHEDULE_Generic')) { - ::print_log("Registering a SCHEDULE Child Object type SCHEDULE_Generic" ); - push @{$self->{generic_object}}, $object; - ::MainLoop_pre_add_hook( sub {SCHEDULE::check_date($self,$object);}, 'persistent'); - } -} - - - -sub check_date { - my ($self,$object) = @_; - if ($::New_Minute) { - ::print_log("[SCHEDULE] Checking schedule for ". $self->get_object_name." Sate is ". (state $self) . " Child object is ". $object->get_object_name); - if (lc(state $self) eq 'on') { - my $Week; - if ($::Weekday) { $Week = 'weekday' } elsif ($::Weekend) { $Week = 'weekend' } - if (($self{'schedule'}{'type'} eq 'calendar') && - (defined(my $action = $self{'schedule'}{$::Month}{$::Mday}{$::Hour}{$::Minute}{'action'}))) { - ::print_log("[SCHEDULE] Setting ".$object->{child}->get_object_name." state to ".$object->{$action}); - $object->{child}->SUPER::set($object->{$action},$self->get_object_name,1); - } - elsif (($self{'schedule'}{'type'} eq 'daily') && - (defined(my $action = $self{'schedule'}{lc($::Day)}{$::Hour}{$::Minute}{'action'}))) { - ::print_log("[SCHEDULE] Setting ".$object->{child}->get_object_name." state to ".$object->{$action}); - $object->{child}->SUPER::set($object->{$action},$self->get_object_name,1); - } - elsif (($self{'schedule'}{'type'} eq 'wdwe') && - (defined(my $action = $self{'schedule'}{$Week}{$::Hour}{$::Minute}{'action'}))) { - ::print_log("[SCHEDULE] Setting ".$object->{child}->get_object_name." state to ".$object->{$action}); - $object->{child}->SUPER::set($object->{$action},$self->get_object_name,1); - } - elsif (($self{'schedule'}{'type'} eq 'time') && - (defined(my $action = $self{'schedule'}{$::Hour}{$::Minute}{'action'}))) { - ::print_log("[SCHEDULE] Setting ".$object->{child}->get_object_name." state to ".$object->{$action}); - $object->{child}->SUPER::set($object->{$action},$self->get_object_name,1); - } - } - - } -} - - -package SCHEDULE_Generic; -@SCHEDULE_Generic::ISA = ('Generic_Item'); - - -sub new -{ - my ($class, $parent, $child, $start, $stop) = @_; - my $self = new Generic_Item(); - bless $self, $class; - $$self{parent} = $parent; - $$self{child} = $child; - $$self{start} = $start; - $$self{stop} = $stop; - $parent->register($self,$child,$start,$stop); - if (defined($start)) { - @{$$self{states}} = ($start,$stop); - } else { - @{$$self{states}} = ($child->get_states()); - } - return $self; -} - - - -sub set { - my ($self, $p_state, $p_setby, $p_response) = @_; - $self->SUPER::set($p_state,$p_setby,1); -} - - From bb0a6a8fb2dfd6657eff6f65dfd0c70bf5bf8630 Mon Sep 17 00:00:00 2001 From: waynieack Date: Thu, 20 Oct 2016 15:18:06 -0500 Subject: [PATCH 3/7] Updated Harmon Documentation --- lib/HARMON.pm | 1279 +++++++++++++++++++++++++++++-------------------- 1 file changed, 768 insertions(+), 511 deletions(-) diff --git a/lib/HARMON.pm b/lib/HARMON.pm index c63e686b8..a2f392d83 100755 --- a/lib/HARMON.pm +++ b/lib/HARMON.pm @@ -1,3 +1,4 @@ + =head1 B =head2 SYNOPSIS @@ -22,9 +23,9 @@ objects using the basic Generic_Item functions such as tie_event. There is a small difference in configuring the HARMON Interface for direct connections Serial or IP Connections (Ser2Sock). -=head4 Direct Connections (USB or Serial) -INI file: + +=head3 Direct Connections (USB or Serial) in INI file: HARMON_serial_port=/dev/ttyAMA0 @This is the serial device HARMON_baudrate=115200 @This must be 115200 @@ -32,41 +33,43 @@ INI file: Wherein the format for the parameter name is: HARMON_serial_port - HARMON_baudrate - -=head4 IP Connections (Ser2Sock) + HARMON_baudrate -INI file: -HARMON_server_ip=192.168.1.33 @IP address of the machine running ser2sock -HARMON_server_port=36000 @Port configured in the ser2sock config -HARMON_server_recon=10 @Amount of time to wait before trying to reconnect +=head3 IP Connections (Ser2Sock) in INI file: + + HARMON_server_ip=192.168.1.33 @IP address of the machine running ser2sock + HARMON_server_port=36000 @Port configured in the ser2sock config + HARMON_server_recon=10 @Amount of time to wait before trying to reconnect Wherein the format for the parameter name is: - HARMON-Prefix_server_ip - HARMON-Prefix_server_port + HARMON-Prefix_server_ip + HARMON-Prefix_server_port + +**NOTE: In the ser2sock configuration you must enable "raw_device_mode = 1". -** In the ser2sock configuration you must enable "raw_device_mode = 1". -=head4 Defining the Interface Object (All Connection Types) + +=head3 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 user code: - $HARMON = new HARMON('HARMON'); + $HARMON = new HARMON('HARMON'); + + Wherein the format for the definition is: -Wherein the format for the definition is: + $HARMON = new HARMON('HARMON'); - $HARMON = new HARMON('HARMON'); =head3 Power Configuration $HARMON_POWER_Z1 = new HARMON_Power('HARMON', 1); -Wherein the format for the definition is: + Wherein the format for the definition is: = new HARMON_Power(, ); @@ -75,27 +78,25 @@ Wherein the format for the definition is: $HARMON_VOLUME_Z1 = new HARMON_Volume('HARMON', 1); -Wherein the format for the definition is: + Wherein the format for the definition is: = new HARMON_Volume(, ); - =head3 Mute Configuration $HARMON_MUTE_Z1 = new HARMON_Mute('HARMON', 1); -Wherein the format for the definition is: + Wherein the format for the definition is: = new HARMON_Volume(, ); - =head3 Input Configuration $HARMON_INPUT_Z1 = new HARMON_Input('HARMON', 1); -Wherein the format for the definition is: + Wherein the format for the definition is: = new HARMON_Volume(, ); @@ -104,10 +105,11 @@ Wherein the format for the definition is: $HARMON_CONTROL_Z1 = new HARMON_Control('HARMON', 1); -Wherein the format for the definition is: + Wherein the format for the definition is: = new HARMON_Volume(, ); + =head2 TODO - Add the following commands and Acks: @@ -116,8 +118,8 @@ Specification: Discrete Volume When zone1 is on the Discrete volume command allows the user -to enter a specific volume e.go. -63dB. When -command received via RS232 –the AVR should +to enter a specific volume eg: -63dB. When +command received via RS232, the AVR should display the Volume OSD with the specified volume and adjust to that specified volume. 50, 43, 53, 45, 4E, 44, 02, 04, 80, 70, @@ -659,7 +661,6 @@ L =cut - package HARMON; @HARMON::ISA = ('Generic_Item'); @@ -667,399 +668,482 @@ package HARMON; #my %CmdMsg; my %CmdMsg = ( -"Z1_ON" => "8070C03F404F", -"Z1_OFF" => "80709F601F10", -"Z1_GET-PWR-STAT" => "807000003600", -"Z1_GET-VOL-STAT" => "807000003700", -"Z1_GET-BASS-STAT" => "807000003800", -"Z1_GET-MUTE-STAT" => "807000003A00", -"Z1_GET-FREQ" => "807000003400", -"Z1_SIRIUS-TUNE-UP" => "807000003200", -"Z1_SIRIUS-TUNE-DOWN" => "807000003300", -"Z1_AM-BAND" => "807000001201", -"Z1_FM-BAND" => "807000001202", -"Z1_SIRIUS-BAND" => "807000001203", -"Z1_VOL-UP" => "8070C7384748", -"Z1_VOL-DOWN" => "8070C8374847", -"Z1_MUTE" => "8070C13E414E", -"Z1_MENU" => "807000002100", -"Z1_UP" => "807000002200", -"Z1_DOWN" => "807000002300", -"Z1_LEFT" => "807000002400", -"Z1_RIGHT" => "807000002500", -"Z1_OK" => "807000002600", -"Z1_0" => "807000003C00", -"Z1_1" => "807000003D00", -"Z1_2" => "807000003E00", -"Z1_3" => "807000003F00", -"Z1_4" => "807000004000", -"Z1_5" => "807000004100", -"Z1_6" => "807000004200", -"Z1_7" => "807000004200", -"Z1_8" => "807000004400", -"Z1_9" => "807000004500", -"Z1_SAT" => "807000000901", -"Z1_BLURAY" => "807000000902", -"Z1_BRIDGE" => "807000000903", -"Z1_DVR" => "807000000904", -"Z1_SIRIUS" => "807000000906", -"Z1_FM" => "807000000907", -"Z1_AM" => "807000000908", -"Z1_TV" => "807000000909", -"Z1_GAME" => "80700000090A", -"Z1_MEDIA" => "80700000090B", -"Z1_AUX" => "80700000090C", -"Z1_INET-RADIO" => "80700000090D", -"Z1_NETWORK" => "80700000090E", -"Z1_SRC-A" => "80700000090F", -"Z1_SRC-B" => "807000000910", -"Z1_SRC-C" => "807000000911", -"Z1_SRC-D" => "807000000912", -"Z2_ON" => "807000000A00", -"Z2_OFF" => "807000001B00", -"Z2_GET-PWR-STAT" => "807000003600", -"Z2_GET-VOL-STAT" => "807000003700", -"Z2_GET-BASS-STAT" => "807000003800", -"Z2_GET-MUTE-STAT" => "807000003A00", -"Z2_GET-FREQ" => "807000003400", -"Z2_VOL-UP" => "86762BD4ADA2", -"Z2_VOL-DOWN" => "86762CD3AAA5", -"Z2_MUTE" => "86762AD5ACA3", -"Z2_MENU" => "807000002700", -"Z2_UP" => "807000002800", -"Z2_DOWN" => "807000002900", -"Z2_LEFT" => "807000002A00", -"Z2_RIGHT" => "807000002B00", -"Z2_OK" => "807000002C00", -"Z2_0" => "807000004600", -"Z2_1" => "807000004700", -"Z2_2" => "807000004800", -"Z2_3" => "807000004900", -"Z2_4" => "807000004A00", -"Z2_5" => "807000004B00", -"Z2_6" => "807000004C00", -"Z2_7" => "807000004D00", -"Z2_8" => "807000004E00", -"Z2_9" => "807000004F00", -"Z2_SAT" => "867600001B01", -"Z2_BLURAY" => "867600001B02", -"Z2_BRIDGE" => "867600001B03", -"Z2_DVR" => "867600001B04", -"Z2_SIRIUS" => "867600001B06", -"Z2_FM" => "867600001B07", -"Z2_AM" => "867600001B08", -"Z2_TV" => "867600001B09", -"Z2_GAME" => "867600001B0A", -"Z2_MEDIA" => "867600001B0B", -"Z2_AUX" => "867600001B0C", -"Z2_INET-RADIO" => "867600001B0D", -"Z2_NETWORK" => "867600001B0E", -"Z2_SRC-A" => "867600001B0F", -"Z2_SRC-B" => "867600001B10", -"Z2_SRC-C" => "867600001B11", -"Z2_SRC-D" => "867600001B12" + "Z1_ON" => "8070C03F404F", + "Z1_OFF" => "80709F601F10", + "Z1_GET-PWR-STAT" => "807000003600", + "Z1_GET-VOL-STAT" => "807000003700", + "Z1_GET-BASS-STAT" => "807000003800", + "Z1_GET-MUTE-STAT" => "807000003A00", + "Z1_GET-FREQ" => "807000003400", + "Z1_SIRIUS-TUNE-UP" => "807000003200", + "Z1_SIRIUS-TUNE-DOWN" => "807000003300", + "Z1_AM-BAND" => "807000001201", + "Z1_FM-BAND" => "807000001202", + "Z1_SIRIUS-BAND" => "807000001203", + "Z1_VOL-UP" => "8070C7384748", + "Z1_VOL-DOWN" => "8070C8374847", + "Z1_MUTE" => "8070C13E414E", + "Z1_MENU" => "807000002100", + "Z1_UP" => "807000002200", + "Z1_DOWN" => "807000002300", + "Z1_LEFT" => "807000002400", + "Z1_RIGHT" => "807000002500", + "Z1_OK" => "807000002600", + "Z1_0" => "807000003C00", + "Z1_1" => "807000003D00", + "Z1_2" => "807000003E00", + "Z1_3" => "807000003F00", + "Z1_4" => "807000004000", + "Z1_5" => "807000004100", + "Z1_6" => "807000004200", + "Z1_7" => "807000004200", + "Z1_8" => "807000004400", + "Z1_9" => "807000004500", + "Z1_SAT" => "807000000901", + "Z1_BLURAY" => "807000000902", + "Z1_BRIDGE" => "807000000903", + "Z1_DVR" => "807000000904", + "Z1_SIRIUS" => "807000000906", + "Z1_FM" => "807000000907", + "Z1_AM" => "807000000908", + "Z1_TV" => "807000000909", + "Z1_GAME" => "80700000090A", + "Z1_MEDIA" => "80700000090B", + "Z1_AUX" => "80700000090C", + "Z1_INET-RADIO" => "80700000090D", + "Z1_NETWORK" => "80700000090E", + "Z1_SRC-A" => "80700000090F", + "Z1_SRC-B" => "807000000910", + "Z1_SRC-C" => "807000000911", + "Z1_SRC-D" => "807000000912", + "Z2_ON" => "807000000A00", + "Z2_OFF" => "807000001B00", + "Z2_GET-PWR-STAT" => "807000003600", + "Z2_GET-VOL-STAT" => "807000003700", + "Z2_GET-BASS-STAT" => "807000003800", + "Z2_GET-MUTE-STAT" => "807000003A00", + "Z2_GET-FREQ" => "807000003400", + "Z2_VOL-UP" => "86762BD4ADA2", + "Z2_VOL-DOWN" => "86762CD3AAA5", + "Z2_MUTE" => "86762AD5ACA3", + "Z2_MENU" => "807000002700", + "Z2_UP" => "807000002800", + "Z2_DOWN" => "807000002900", + "Z2_LEFT" => "807000002A00", + "Z2_RIGHT" => "807000002B00", + "Z2_OK" => "807000002C00", + "Z2_0" => "807000004600", + "Z2_1" => "807000004700", + "Z2_2" => "807000004800", + "Z2_3" => "807000004900", + "Z2_4" => "807000004A00", + "Z2_5" => "807000004B00", + "Z2_6" => "807000004C00", + "Z2_7" => "807000004D00", + "Z2_8" => "807000004E00", + "Z2_9" => "807000004F00", + "Z2_SAT" => "867600001B01", + "Z2_BLURAY" => "867600001B02", + "Z2_BRIDGE" => "867600001B03", + "Z2_DVR" => "867600001B04", + "Z2_SIRIUS" => "867600001B06", + "Z2_FM" => "867600001B07", + "Z2_AM" => "867600001B08", + "Z2_TV" => "867600001B09", + "Z2_GAME" => "867600001B0A", + "Z2_MEDIA" => "867600001B0B", + "Z2_AUX" => "867600001B0C", + "Z2_INET-RADIO" => "867600001B0D", + "Z2_NETWORK" => "867600001B0E", + "Z2_SRC-A" => "867600001B0F", + "Z2_SRC-B" => "867600001B10", + "Z2_SRC-C" => "867600001B11", + "Z2_SRC-D" => "867600001B12" ); # Starting a new object sub new { - my ($class, $instance) = @_; - $instance = "HAROMN" if (!defined($instance)); - ::print_log("Starting $instance instance of HARMON interface module"); - - my $self = new Generic_Item(); - - # Initialize Variables - $$self{instance} = $instance; - $$self{reconnect_time} = $::config_parms{$instance.'_server_recon'}; - $$self{reconnect_time} = 10 if !defined($$self{reconnect_time}); - my $year_mon = &::time_date_stamp( 10, time ); - $$self{log_file} = $::config_parms{'data_dir'}."/logs/HARMON.$year_mon.log"; - - bless $self, $class; - - #Store Object with Instance Name - $self->_set_object_instance($instance); - return $self; -} + my ( $class, $instance ) = @_; + $instance = "HAROMN" if ( !defined($instance) ); + ::print_log("Starting $instance instance of HARMON interface module"); + + my $self = new Generic_Item(); + + # Initialize Variables + $$self{instance} = $instance; + $$self{reconnect_time} = $::config_parms{ $instance . '_server_recon' }; + $$self{reconnect_time} = 10 if !defined( $$self{reconnect_time} ); + my $year_mon = &::time_date_stamp( 10, time ); + $$self{log_file} = + $::config_parms{'data_dir'} . "/logs/HARMON.$year_mon.log"; -sub get_object_by_instance{ - my ($instance) = @_; - return $Interfaces{$instance}; + bless $self, $class; + + #Store Object with Instance Name + $self->_set_object_instance($instance); + return $self; } -sub _set_object_instance{ - my ($self, $instance) = @_; - $Interfaces{$instance} = $self; +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 { - 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); + 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 + select( undef, undef, undef, .100 ); # Sleep a bit } - - - sub serial_startup { - my ($instance) = @_; - my ($port, $BaudRate, $ip); - - if ($::config_parms{$instance . '_serial_port'}) { - $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("[HARMON] initializing $instance on port $port at $BaudRate baud") if $main::Debug{'HARMON'}; - ::MainLoop_pre_add_hook( sub {check_for_data($instance, 'serial');}, 1 ) if $main::Serial_Ports{"$instance"}{object}; - } - } + my ($instance) = @_; + my ( $port, $BaudRate, $ip ); + + if ( $::config_parms{ $instance . '_serial_port' } ) { + $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( + "[HARMON] initializing $instance on port $port at $BaudRate baud" + ) if $main::Debug{'HARMON'}; + ::MainLoop_pre_add_hook( + sub { check_for_data( $instance, 'serial' ); }, 1 ) + if $main::Serial_Ports{"$instance"}{object}; + } + } } 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(" HARMON.pm initializing $instance TCP session with $ip on port $port") if $main::Debug{'HARMON'}; - $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 {HARMON::check_for_data($instance, 'tcp');}, 1 ); + 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( + " HARMON.pm initializing $instance TCP session with $ip on port $port") + if $main::Debug{'HARMON'}; + $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 { HARMON::check_for_data( $instance, 'tcp' ); }, 1 ); } - sub check_for_data { - my ($instance, $connecttype) = @_; - my $self = get_object_by_instance($instance); - my $NewCmd; - my $AckMsg; - - -my %CmdAck = ( -"41565241434B020110" => "Z1_P_ON,Z2_P_OFF", -"41565241434B020111" => "Z1_P_ON,Z2_P_ON", -"41565241434B020100" => "Z1_P_OFF,Z2_P_OFF", -"41565241434B020101" => "Z1_P_OFF,Z2_P_ON", -"41565241434B0311" => "Z1_V_VOL-ACK", -"41565241434B0202" => "Z1_V_VOL-ACK-TOG", -"41565241434B0209" => "Z2_V_VOL-ACK", -"41565241434B020300" => "Z1_M_MUTE-OFF", -"41565241434B020301" => "Z1_M_MUTE-ON", -"41565241434B020A00" => "Z2_M_MUTE-OFF", -"41565241434B020A01" => "Z2_M_MUTE-ON", -"41565241434B03140100" => "Z1_M_MUTE-ON,Z2_M_MUTE-OFF", -"41565241434B03140101" => "Z1_M_MUTE-ON,Z2_M_MUTE-ON", -"41565241434B03140001" => "Z1_M_MUTE-OFF,Z2_M_MUTE-ON", -"41565241434B03140000" => "Z1_M_MUTE-OFF,Z2_M_MUTE-OFF", -"41565241434B020401" => "Z1_I_SAT", -"41565241434B020402" => "Z1_I_BLURAY", -"41565241434B020403" => "Z1_I_BRIDGE", -"41565241434B020404" => "Z1_I_DVR", -"41565241434B020406" => "Z1_I_SIRIUS", -"41565241434B020407" => "Z1_I_FM", -"41565241434B020408" => "Z1_I_AM", -"41565241434B020409" => "Z1_I_TV", -"41565241434B02040A" => "Z1_I_GAME", -"41565241434B02040B" => "Z1_I_MEDIA", -"41565241434B02040C" => "Z1_I_AUX", -"41565241434B02040D" => "Z1_I_INET-RADIO", -"41565241434B02040E" => "Z1_I_NETWORK", -"41565241434B02040F" => "Z1_I_SRC-A", -"41565241434B020410" => "Z1_I_SRC-B", -"41565241434B020411" => "Z1_I_SRC-C", -"41565241434B020412" => "Z1_I_SRC-D", -"41565241434B020801" => "Z2_I_SAT", -"41565241434B020802" => "Z2_I_BLURAY", -"41565241434B020803" => "Z2_I_BRIDGE", -"41565241434B020804" => "Z2_I_DVR", -"41565241434B020806" => "Z2_I_SIRIUS", -"41565241434B020807" => "Z2_I_FM", -"41565241434B020808" => "Z2_I_AM", -"41565241434B020809" => "Z2_I_TV", -"41565241434B02080A" => "Z2_I_GAME", -"41565241434B02080B" => "Z2_I_MEDIA", -"41565241434B02080C" => "Z2_I_AUX", -"41565241434B02080D" => "Z2_I_INET-RADIO", -"41565241434B02080E" => "Z2_I_NETWORK", -"41565241434B02080F" => "Z2_I_SRC-A", -"41565241434B020810" => "Z2_I_SRC-B", -"41565241434B020811" => "Z2_I_SRC-C", -"41565241434B020812" => "Z2_I_SRC-D" -); + my ( $instance, $connecttype ) = @_; + my $self = get_object_by_instance($instance); + my $NewCmd; + my $AckMsg; + + my %CmdAck = ( + "41565241434B020110" => "Z1_P_ON,Z2_P_OFF", + "41565241434B020111" => "Z1_P_ON,Z2_P_ON", + "41565241434B020100" => "Z1_P_OFF,Z2_P_OFF", + "41565241434B020101" => "Z1_P_OFF,Z2_P_ON", + "41565241434B0311" => "Z1_V_VOL-ACK", + "41565241434B0202" => "Z1_V_VOL-ACK-TOG", + "41565241434B0209" => "Z2_V_VOL-ACK", + "41565241434B020300" => "Z1_M_MUTE-OFF", + "41565241434B020301" => "Z1_M_MUTE-ON", + "41565241434B020A00" => "Z2_M_MUTE-OFF", + "41565241434B020A01" => "Z2_M_MUTE-ON", + "41565241434B03140100" => "Z1_M_MUTE-ON,Z2_M_MUTE-OFF", + "41565241434B03140101" => "Z1_M_MUTE-ON,Z2_M_MUTE-ON", + "41565241434B03140001" => "Z1_M_MUTE-OFF,Z2_M_MUTE-ON", + "41565241434B03140000" => "Z1_M_MUTE-OFF,Z2_M_MUTE-OFF", + "41565241434B020401" => "Z1_I_SAT", + "41565241434B020402" => "Z1_I_BLURAY", + "41565241434B020403" => "Z1_I_BRIDGE", + "41565241434B020404" => "Z1_I_DVR", + "41565241434B020406" => "Z1_I_SIRIUS", + "41565241434B020407" => "Z1_I_FM", + "41565241434B020408" => "Z1_I_AM", + "41565241434B020409" => "Z1_I_TV", + "41565241434B02040A" => "Z1_I_GAME", + "41565241434B02040B" => "Z1_I_MEDIA", + "41565241434B02040C" => "Z1_I_AUX", + "41565241434B02040D" => "Z1_I_INET-RADIO", + "41565241434B02040E" => "Z1_I_NETWORK", + "41565241434B02040F" => "Z1_I_SRC-A", + "41565241434B020410" => "Z1_I_SRC-B", + "41565241434B020411" => "Z1_I_SRC-C", + "41565241434B020412" => "Z1_I_SRC-D", + "41565241434B020801" => "Z2_I_SAT", + "41565241434B020802" => "Z2_I_BLURAY", + "41565241434B020803" => "Z2_I_BRIDGE", + "41565241434B020804" => "Z2_I_DVR", + "41565241434B020806" => "Z2_I_SIRIUS", + "41565241434B020807" => "Z2_I_FM", + "41565241434B020808" => "Z2_I_AM", + "41565241434B020809" => "Z2_I_TV", + "41565241434B02080A" => "Z2_I_GAME", + "41565241434B02080B" => "Z2_I_MEDIA", + "41565241434B02080C" => "Z2_I_AUX", + "41565241434B02080D" => "Z2_I_INET-RADIO", + "41565241434B02080E" => "Z2_I_NETWORK", + "41565241434B02080F" => "Z2_I_SRC-A", + "41565241434B020810" => "Z2_I_SRC-B", + "41565241434B020811" => "Z2_I_SRC-C", + "41565241434B020812" => "Z2_I_SRC-D" + ); + + # 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}; + $main::Serial_Ports{$instance}{data} = ''; + } + + if ( $connecttype eq 'tcp' ) { + if ( $Socket_Items{$instance}{'socket'}->active ) { + $NewCmd = + uc( + unpack( 'H*', ( $Socket_Items{$instance}{'socket'}->said ) ) ); + } + else { + # restart the TCP connection if its lost. + if ( $Socket_Items{$instance}{recon_timer}->inactive ) { + ::print_log( + "Connection to $instance instance of HARMON 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; + } + ); + } + } + } + + # Return if nothing received + return if !$NewCmd; + + # Prepend any prior message fragment + $NewCmd = $self->{IncompleteCmd} . $NewCmd if $self->{IncompleteCmd}; + $self->{IncompleteCmd} = ''; + my $msg; + my $zone_num; + &main::print_log("[HARMON] - Hex $NewCmd "); + my @NewCmds; + if ( $NewCmd =~ /^(\w{20})..$/ ) { $NewCmd = $1 } + if ( $NewCmd =~ /(\w{20})(\w{20})/ ) { @NewCmds = ( $1, $2 ) } + else { push @NewCmds, $NewCmd } + + foreach $NewCmd (@NewCmds) { + + #&main::print_log("[HARMON] - Hex $NewCmd - Lenght " . (length($NewCmd)) ); + if ( ( length($NewCmd) ) eq "20" ) { + $AckMsg = ( $CmdAck{"$NewCmd"} ); + if ( $AckMsg eq '' ) { + $AckMsg = ( $CmdAck{ ( substr( $NewCmd, 0, 18 ) ) } ); + } # try stripping the checksum + if ( $AckMsg eq '' ) { + $AckMsg = ( $CmdAck{ ( substr( $NewCmd, 0, 16 ) ) } ); + } # strip last 2 for vol caculations + #&main::print_log("[HARMON] - Ack $AckMsg - Hex $NewCmd "); + $AckMsg = &GetAckMsg( $AckMsg, $NewCmd ) + if &GetAckMsg( $AckMsg, $NewCmd ); + my @AckMsgs; + if ( $AckMsg =~ /,/ ) { @AckMsgs = split( ',', $AckMsg ) } + else { push @AckMsgs, $AckMsg } + foreach (@AckMsgs) { + + #&main::print_log("[HARMON] - ACK MSG $_"); + if ( $_ =~ /^Z(\d)_(\w)_VOL_(.*)/ ) { + $zone_num = $1; + $msg = $3; + } + elsif ( $_ =~ /^Z(\d)_(\w)_MUTE-(.*)/ ) { + $zone_num = $1; + $msg = $3; + } + elsif ( $_ =~ /^Z(\d)_(\w)_(.*)/ ) { + $zone_num = $1; + $msg = $3; + } + if ( $2 eq 'P' ) { $object_type = 'power_object'; } + elsif ( $2 eq 'V' ) { $object_type = 'volume_object'; } + elsif ( $2 eq 'M' ) { $object_type = 'mute_object'; } + elsif ( $2 eq 'I' ) { $object_type = 'input_object'; } + $self->set_child_state( $object_type, $zone_num, $msg ); + &main::print_log( + "[HARMON] - ACK MSG ($msg) - Zone ($zone_num) - Object Type ($object_type)" + ); + } + } + else { + # Save partial command for next serial read + $self->{IncompleteCmd} = $Cmd; + } + } +} - # 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}; - $main::Serial_Ports{$instance}{data} = ''; - } - - if ($connecttype eq 'tcp') { - if ($Socket_Items{$instance}{'socket'}->active) { - $NewCmd = uc(unpack('H*', ($Socket_Items{$instance}{'socket'}->said))); - } else { - # restart the TCP connection if its lost. - if ($Socket_Items{$instance}{recon_timer}->inactive) { - ::print_log("Connection to $instance instance of HARMON 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; - }); - } - } - } - - # Return if nothing received - return if !$NewCmd; - - # Prepend any prior message fragment - $NewCmd = $self->{IncompleteCmd} . $NewCmd if $self->{IncompleteCmd}; - $self->{IncompleteCmd} = ''; - my $msg; - my $zone_num; - &main::print_log("[HARMON] - Hex $NewCmd "); - my @NewCmds; - if ($NewCmd =~ /^(\w{20})..$/) { $NewCmd = $1 } - if ($NewCmd =~ /(\w{20})(\w{20})/) { @NewCmds = ($1,$2) } - else { push @NewCmds, $NewCmd } - foreach $NewCmd(@NewCmds) { - &main::print_log("[HARMON] - Hex $NewCmd - Lenght " . (length($NewCmd)) ); - if ((length($NewCmd)) eq "20") { - $AckMsg = ($CmdAck{"$NewCmd"}); - if ($AckMsg eq '') { $AckMsg = ($CmdAck{(substr ($NewCmd, 0, 18))});} # try stripping the checksum - if ($AckMsg eq '') { $AckMsg = ($CmdAck{(substr ($NewCmd, 0, 16))});} # strip last 2 for vol caculations - &main::print_log("[HARMON] - Ack $AckMsg - Hex $NewCmd "); - $AckMsg = &GetAckMsg($AckMsg,$NewCmd) if &GetAckMsg($AckMsg,$NewCmd); - my @AckMsgs; - if ($AckMsg =~ /,/) { @AckMsgs = split(',', $AckMsg) } - else { push @AckMsgs, $AckMsg } - foreach (@AckMsgs) { - &main::print_log("[HARMON] - ACK MSG $_"); - if ( $_ =~ /^Z(\d)_(\w)_VOL_(.*)/ ) { $zone_num = $1; $msg = $3; } - elsif ( $_ =~ /^Z(\d)_(\w)_MUTE-(.*)/ ) { $zone_num = $1; $msg = $3; } - elsif ( $_ =~ /^Z(\d)_(\w)_(.*)/ ) { $zone_num = $1; $msg = $3; } - if ($2 eq 'P') { $object_type = 'power_object'; } - elsif ($2 eq 'V') { $object_type = 'volume_object'; } - elsif ($2 eq 'M') { $object_type = 'mute_object'; } - elsif ($2 eq 'I') { $object_type = 'input_object'; } - $self->set_child_state($object_type, $zone_num, $msg); - &main::print_log("[HARMON] - ACK MSG ($msg) - Zone ($zone_num) - Object Type ($object_type)"); - } - } +sub GetAckMsg { + my $GAckMsg = $_[0]; + my $hex = $_[1]; + my $RetAckMsg; + if ( $GAckMsg =~ /(Z\d)_V_VOL-ACK/ ) { + $RetAckMsg = + "+" . ( hex( ( substr( ( substr( $hex, 16 ) ), 0, 2 ) ) ) ); + if ( $RetAckMsg > 0 and $RetAckMsg < 10 ) { + } else { - # Save partial command for next serial read - $self->{IncompleteCmd} = $Cmd; - } - } + $RetAckMsg = "-" . ( $RetAckMsg - 128 ); + } + $RetAckMsg = $1 . "_V_VOL_" . $RetAckMsg; + return $RetAckMsg; + } + return; } +sub set_child_state { + my ( $self, $object_type, $zone_num, $msg ) = @_; + my $child = $self->{$object_type}{$zone_num}; + $child->set_receive($msg) if defined $child; + if ( $object_type eq 'mute_object' ) { + + #&main::print_log("[HARMON] - ACK MSG ($msg) - Zone ($zone_num) - Object Type ($object_type) - MUTE_CMD ". $$child{mute_cmd}); + if ( $$child{mute_cmd} eq 'ON' and $msg eq 'OFF' ) { + $child->set( 'Z' . $zone_num . '_MUTE' ); + $$child{mute_cmd} = 0; + } + elsif ( $$child{mute_cmd} eq 'OFF' and $msg eq 'ON' ) { + $child->set( 'Z' . $zone_num . '_MUTE' ); + $$child{mute_cmd} = 0; + } + } +} +=item C +Used to associate child objects with the interface. +=cut -sub GetAckMsg { - my $GAckMsg = $_[0]; - my $hex = $_[1]; - my $RetAckMsg; - if ($GAckMsg =~ /(Z\d)_V_VOL-ACK/) { - $RetAckMsg = "+".(hex((substr ((substr ($hex, 16)),0 , 2)))); - if ($RetAckMsg > 0 and $RetAckMsg < 10) { - } else { - $RetAckMsg = "-".($RetAckMsg - 128); +sub register { + my ( $self, $object, $num ) = @_; + if ( $object->isa('HARMON_Volume') ) { + ::print_log("Registering Child Object for Harmon volume zone $num"); + $self->{volume_object}{$num} = $object; + } + elsif ( $object->isa('HARMON_Mute') ) { + ::print_log("Registering Child Object for Harmon mute zone $num"); + $self->{mute_object}{$num} = $object; + } + elsif ( $object->isa('HARMON_Power') ) { + ::print_log("Registering Child Object for Harmon power zone $num"); + $self->{power_object}{$num} = $object; + } + elsif ( $object->isa('HARMON_Input') ) { + ::print_log("Registering Child Object for Harmon input zone $num"); + $self->{input_object}{$num} = $object; + } +} + +sub set { + my ( $self, $p_state, $p_setby, $p_response ) = @_; + my $instance = $$self{instance}; + + #::print_log("[HARMON] State: $p_state - Hex: $CmdMsg{$p_state}"); + my $cmd = ( exists $CmdMsg{$p_state} ) ? $CmdMsg{$p_state} : $p_state; + $cmd = "504353454E440204$cmd"; + $cmd = pack( 'H*', $cmd ); + + #$self->debug_log(">>> Sending to HARMON receiver $p_state ($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 HARMON 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"); } - $RetAckMsg = $1."_V_VOL_".$RetAckMsg; - return $RetAckMsg; - } - return; - } + ); + } + } + } + else { + $main::Serial_Ports{$instance}{'socket'}->write("$cmd"); + } + return; +} +=back +=head1 B +=head2 SYNOPSIS -sub set_child_state { - my ($self, $object_type, $zone_num, $msg) = @_; - my $child = $self->{$object_type}{$zone_num}; - $child->set_receive($msg) if defined $child; - if ( $object_type eq 'mute_object' ) { - #&main::print_log("[HARMON] - ACK MSG ($msg) - Zone ($zone_num) - Object Type ($object_type) - MUTE_CMD ". $$child{mute_cmd}); - if ($$child{mute_cmd} eq 'ON' and $msg eq 'OFF' ) { $child->set('Z'.$zone_num.'_MUTE'); $$child{mute_cmd} = 0; } - elsif ($$child{mute_cmd} eq 'OFF' and $msg eq 'ON' ) { $child->set('Z'.$zone_num.'_MUTE'); $$child{mute_cmd} = 0; } - } -} +User code: -=item C -Used to associate child objects with the interface. + $HARMON_POWER_Z1 = new HARMON_Power('HARMON', 1); -=cut + Wherein the format for the definition is: -sub register { - my ($self, $object, $num) = @_; - if ($object->isa('HARMON_Volume')) { - ::print_log("Registering Child Object for Harmon volume zone $num"); - $self->{volume_object}{$num} = $object; - } - elsif ($object->isa('HARMON_Mute')) { - ::print_log("Registering Child Object for Harmon mute zone $num"); - $self->{mute_object}{$num} = $object; - } - elsif ($object->isa('HARMON_Power')) { - ::print_log("Registering Child Object for Harmon power zone $num"); - $self->{power_object}{$num} = $object; - } - elsif ($object->isa('HARMON_Input')) { - ::print_log("Registering Child Object for Harmon input zone $num"); - $self->{input_object}{$num} = $object; - } -} + = new HARMON_Power(, ); -sub set { - my ($self, $p_state, $p_setby, $p_response) = @_; - my $instance = $$self{instance}; - ::print_log("[HARMON] State: $p_state - Hex: $CmdMsg{$p_state}"); - my $cmd = ( exists $CmdMsg{$p_state} ) ? $CmdMsg{$p_state} : $p_state; - $cmd = "504353454E440204$cmd"; - $cmd = pack('H*', $cmd); - - #$self->debug_log(">>> Sending to HARMON receiver $p_state ($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 HARMON 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; -} +=head2 NOTES +=head2 DESCRIPTION + + + +=head2 INHERITS + +L + +=head2 METHODS + +=over + +=cut + package HARMON_Power; @HARMON_Power::ISA = ('Generic_Item'); @@ -1074,46 +1158,82 @@ $zone = The zone number, usually 1 =cut -sub new -{ - my ($class,$receiver,$zone ) = @_; - my $self = new Generic_Item(); - bless $self,$class; - $receiver = HARMON::get_object_by_instance($receiver); - #$$receiver{receiver_zone} = $self; - $receiver->register($self,$zone); - $$self{receiver} = $receiver; - $$self{zone} = $zone; - @{$$self{states}} = ('ON', 'OFF', 'GET-PWR-STAT'); - return $self; +sub new { + my ( $class, $receiver, $zone ) = @_; + my $self = new Generic_Item(); + bless $self, $class; + $receiver = HARMON::get_object_by_instance($receiver); + + #$$receiver{receiver_zone} = $self; + $receiver->register( $self, $zone ); + $$self{receiver} = $receiver; + $$self{zone} = $zone; + @{ $$self{states} } = ( 'ON', 'OFF', 'GET-PWR-STAT' ); + return $self; } sub set { - my ($self, $p_state, $p_setby, $p_response) = @_; - ::print_log("[HARMON::power] Received request to " - . $p_state . " for zone " . $self->get_object_name); - $p_state =~ s/ /-/g; - if ($p_state =~ /^GET-PWR-STAT/ ) { - $p_state = "Z".$$self{zone}."_".$p_state; - $$self{receiver}->set($p_state) - } - elsif ($p_state =~ /^Z\d_/) { - $$self{receiver}->set($p_state); - } - else { - $p_state = "Z".$$self{zone}."_".$p_state; - $$self{receiver}->set($p_state); - } - # $self->SUPER::set($p_state,$p_setby); + my ( $self, $p_state, $p_setby, $p_response ) = @_; + ::print_log( "[HARMON::power] Received request to " + . $p_state + . " for zone " + . $self->get_object_name ); + $p_state =~ s/ /-/g; + if ( $p_state =~ /^GET-PWR-STAT/ ) { + $p_state = "Z" . $$self{zone} . "_" . $p_state; + $$self{receiver}->set($p_state); + } + elsif ( $p_state =~ /^Z\d_/ ) { + $$self{receiver}->set($p_state); + } + else { + $p_state = "Z" . $$self{zone} . "_" . $p_state; + $$self{receiver}->set($p_state); + } + + # $self->SUPER::set($p_state,$p_setby); } - sub set_receive { - my ($self, $p_state, $p_setby, $p_response) = @_; - return $self->SUPER::set($p_state, $p_setby, $p_response); + my ( $self, $p_state, $p_setby, $p_response ) = @_; + return $self->SUPER::set( $p_state, $p_setby, $p_response ); ::print_log("[HARMON::power] set to $p_state"); } +=back + +=head1 B + +=head2 SYNOPSIS + +User code: + + + $HARMON_VOLUME_Z1 = new HARMON_Volume('HARMON', 1); + + Wherein the format for the definition is: + + = new HARMON_Volume(, ); + + + +=head2 NOTES + + + +=head2 DESCRIPTION + + + +=head2 INHERITS + +L + +=head2 METHODS + +=over + +=cut package HARMON_Volume; @HARMON_Volume::ISA = ('Generic_Item'); @@ -1129,43 +1249,78 @@ $zone = The zone number, usually 1 =cut -sub new -{ - my ($class,$receiver,$zone ) = @_; - my $self = new Generic_Item(); - bless $self,$class; - $receiver = HARMON::get_object_by_instance($receiver); - $receiver->register($self,$zone); - $$self{receiver} = $receiver; - $$self{zone} = $zone; - @{$$self{states}} = ('UP', 'DOWN', 'GET-VOL-STAT'); - return $self; +sub new { + my ( $class, $receiver, $zone ) = @_; + my $self = new Generic_Item(); + bless $self, $class; + $receiver = HARMON::get_object_by_instance($receiver); + $receiver->register( $self, $zone ); + $$self{receiver} = $receiver; + $$self{zone} = $zone; + @{ $$self{states} } = ( 'UP', 'DOWN', 'GET-VOL-STAT' ); + return $self; } sub set { - my ($self, $p_state, $p_setby, $p_response) = @_; - ::print_log("[HARMON::Volume] Received request " - . $p_state ." for ". $self->get_object_name ." for zone ".$$self{zone}); - if ($p_state =~ /^GET-VOL-STAT/ ) { - $p_state = "Z".$$self{zone}."_".$p_state; - $$self{receiver}->set($p_state) - } - elsif ($p_state =~ /^Z\d_VOL-/ or $p_state =~ /^Z\d_GET-VOL-STAT/) { - $$self{receiver}->set($p_state); - } - else { - $p_state = "Z".$$self{zone}."_VOL-".$p_state; - $$self{receiver}->set($p_state); - } - } - + my ( $self, $p_state, $p_setby, $p_response ) = @_; + ::print_log( "[HARMON::Volume] Received request " + . $p_state . " for " + . $self->get_object_name + . " for zone " + . $$self{zone} ); + if ( $p_state =~ /^GET-VOL-STAT/ ) { + $p_state = "Z" . $$self{zone} . "_" . $p_state; + $$self{receiver}->set($p_state); + } + elsif ( $p_state =~ /^Z\d_VOL-/ or $p_state =~ /^Z\d_GET-VOL-STAT/ ) { + $$self{receiver}->set($p_state); + } + else { + $p_state = "Z" . $$self{zone} . "_VOL-" . $p_state; + $$self{receiver}->set($p_state); + } +} sub set_receive { - my ($self, $p_state, $p_setby, $p_response) = @_; - return $self->SUPER::set($p_state, $p_setby, $p_response); + my ( $self, $p_state, $p_setby, $p_response ) = @_; + return $self->SUPER::set( $p_state, $p_setby, $p_response ); ::print_log("[HARMON::power] set to $p_state"); } +=back + +=head1 B + +=head2 SYNOPSIS + +User code: + + + $HARMON_MUTE_Z1 = new HARMON_Mute('HARMON', 1); + + Wherein the format for the definition is: + + = new HARMON_Volume(, ); + + + +=head2 NOTES + + + +=head2 DESCRIPTION + + + +=head2 INHERITS + +L + +=head2 METHODS + +=over + +=cut package HARMON_Mute; @HARMON_Mute::ISA = ('Generic_Item'); @@ -1181,45 +1336,80 @@ $zone = The zone number, usually 1 =cut -sub new -{ - my ($class,$receiver,$zone ) = @_; - my $self = new Generic_Item(); - bless $self,$class; - $receiver = HARMON::get_object_by_instance($receiver); - $receiver->register($self,$zone); - $$self{receiver} = $receiver; - $$self{zone} = $zone; - @{$$self{states}} = ('ON','OFF','MUTE','GET-MUTE-STAT'); - return $self; +sub new { + my ( $class, $receiver, $zone ) = @_; + my $self = new Generic_Item(); + bless $self, $class; + $receiver = HARMON::get_object_by_instance($receiver); + $receiver->register( $self, $zone ); + $$self{receiver} = $receiver; + $$self{zone} = $zone; + @{ $$self{states} } = ( 'ON', 'OFF', 'MUTE', 'GET-MUTE-STAT' ); + return $self; } sub set { - my ($self, $p_state, $p_setby, $p_response) = @_; - ::print_log("[HARMON::Mute] Received request " - . $p_state ." for ". $self->get_object_name ." for zone ".$$self{zone}); - if ($p_state =~ /^Z\d_MUTE/) { - $$self{receiver}->set($p_state); - } - elsif ($p_state =~ /^MUTE/ or $p_state =~ /^GET-MUTE-STAT/) { - $p_state = "Z".$$self{zone}."_".$p_state; - $$self{receiver}->set($p_state); - } - elsif ($p_state eq 'ON' or $p_state eq 'OFF') { - $$self{mute_cmd} = $p_state; - $p_state = "Z".$$self{zone}."_GET-MUTE-STAT"; - $$self{receiver}->set($p_state); - } - } - + my ( $self, $p_state, $p_setby, $p_response ) = @_; + ::print_log( "[HARMON::Mute] Received request " + . $p_state . " for " + . $self->get_object_name + . " for zone " + . $$self{zone} ); + if ( $p_state =~ /^Z\d_MUTE/ ) { + $$self{receiver}->set($p_state); + } + elsif ( $p_state =~ /^MUTE/ or $p_state =~ /^GET-MUTE-STAT/ ) { + $p_state = "Z" . $$self{zone} . "_" . $p_state; + $$self{receiver}->set($p_state); + } + elsif ( $p_state eq 'ON' or $p_state eq 'OFF' ) { + $$self{mute_cmd} = $p_state; + $p_state = "Z" . $$self{zone} . "_GET-MUTE-STAT"; + $$self{receiver}->set($p_state); + } +} sub set_receive { - my ($self, $p_state, $p_setby, $p_response) = @_; - return $self->SUPER::set($p_state, $p_setby, $p_response); + my ( $self, $p_state, $p_setby, $p_response ) = @_; + return $self->SUPER::set( $p_state, $p_setby, $p_response ); ::print_log("[HARMON::power] set to $p_state"); } +=back +=head1 B + +=head2 SYNOPSIS + +User code: + + + + $HARMON_INPUT_Z1 = new HARMON_Input('HARMON', 1); + + Wherein the format for the definition is: + + = new HARMON_Volume(, ); + + + +=head2 NOTES + + + +=head2 DESCRIPTION + + + +=head2 INHERITS + +L + +=head2 METHODS + +=over + +=cut package HARMON_Input; @HARMON_Input::ISA = ('Generic_Item'); @@ -1235,39 +1425,81 @@ $zone = The zone number, usually 1 =cut -sub new -{ - my ($class,$receiver,$zone ) = @_; - my $self = new Generic_Item(); - bless $self,$class; - $receiver = HARMON::get_object_by_instance($receiver); - $receiver->register($self,$zone); - $$self{receiver} = $receiver; - $$self{zone} = $zone; - @{$$self{states}} = ('SAT','BLURAY','BRIDGE','DVR','SIRIUS','FM','AM','TV','GAME','MEDIA','AUX','INET-RADIO','NETWORK','SRC-A','SRC-B','SRC-C','SRC-D'); - return $self; +sub new { + my ( $class, $receiver, $zone ) = @_; + my $self = new Generic_Item(); + bless $self, $class; + $receiver = HARMON::get_object_by_instance($receiver); + $receiver->register( $self, $zone ); + $$self{receiver} = $receiver; + $$self{zone} = $zone; + @{ $$self{states} } = ( + 'SAT', 'BLURAY', 'BRIDGE', 'DVR', + 'SIRIUS', 'FM', 'AM', 'TV', + 'GAME', 'MEDIA', 'AUX', 'INET-RADIO', + 'NETWORK', 'SRC-A', 'SRC-B', 'SRC-C', + 'SRC-D' + ); + return $self; } sub set { - my ($self, $p_state, $p_setby, $p_response) = @_; - ::print_log("[HARMON::Input] Received request " - . $p_state ." for ". $self->get_object_name ." for zone ".$$self{zone}); - if ($p_state =~ /^Z\d_/) { - $$self{receiver}->set($p_state); - } - else { - $p_state = "Z".$$self{zone}."_".$p_state; - $$self{receiver}->set($p_state); - } - } - + my ( $self, $p_state, $p_setby, $p_response ) = @_; + ::print_log( "[HARMON::Input] Received request " + . $p_state . " for " + . $self->get_object_name + . " for zone " + . $$self{zone} ); + if ( $p_state =~ /^Z\d_/ ) { + $$self{receiver}->set($p_state); + } + else { + $p_state = "Z" . $$self{zone} . "_" . $p_state; + $$self{receiver}->set($p_state); + } +} sub set_receive { - my ($self, $p_state, $p_setby, $p_response) = @_; - return $self->SUPER::set($p_state, $p_setby, $p_response); + my ( $self, $p_state, $p_setby, $p_response ) = @_; + return $self->SUPER::set( $p_state, $p_setby, $p_response ); ::print_log("[HARMON::power] set to $p_state"); } +=back + +=head1 B + +=head2 SYNOPSIS + +User code: + + + $HARMON_CONTROL_Z1 = new HARMON_Control('HARMON', 1); + + Wherein the format for the definition is: + + = new HARMON_Volume(, ); + + + +=head2 NOTES + + + +=head2 DESCRIPTION + + + +=head2 INHERITS + +L + +=head2 METHODS + +=over + +=cut + package HARMON_Control; @HARMON_Control::ISA = ('Generic_Item'); @@ -1282,30 +1514,55 @@ $zone = The zone number, usually 1 =cut -sub new -{ - my ($class,$receiver,$zone ) = @_; - my $self = new Generic_Item(); - bless $self,$class; - $receiver = HARMON::get_object_by_instance($receiver); - $receiver->register($self,$zone); - $$self{receiver} = $receiver; - $$self{zone} = $zone; - @{$$self{states}} = ('SIRIUS-TUNE-DOWN','SIRIUS-TUNE-UP','MENU','UP','DOWN','LEFT','RIGHT','OK','0','1','2','3','4','5','6','7','8','9'); - return $self; +sub new { + my ( $class, $receiver, $zone ) = @_; + my $self = new Generic_Item(); + bless $self, $class; + $receiver = HARMON::get_object_by_instance($receiver); + $receiver->register( $self, $zone ); + $$self{receiver} = $receiver; + $$self{zone} = $zone; + @{ $$self{states} } = ( + 'SIRIUS-TUNE-DOWN', 'SIRIUS-TUNE-UP', 'MENU', 'UP', 'DOWN', 'LEFT', + 'RIGHT', 'OK', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9' + ); + return $self; } sub set { - my ($self, $p_state, $p_setby, $p_response) = @_; - ::print_log("[HARMON::Control] Received request " - . $p_state ." for ". $self->get_object_name ." for zone ".$$self{zone}); - if ($p_state =~ /^Z\d_(.*)/) { - $$self{receiver}->set($p_state); - $self->SUPER::set($1,$p_setby); - } - else { - $self->SUPER::set($p_state,$p_setby); - $p_state = "Z".$$self{zone}."_". $p_state; - $$self{receiver}->set($p_state); - } - } + my ( $self, $p_state, $p_setby, $p_response ) = @_; + ::print_log( "[HARMON::Control] Received request " + . $p_state . " for " + . $self->get_object_name + . " for zone " + . $$self{zone} ); + if ( $p_state =~ /^Z\d_(.*)/ ) { + $$self{receiver}->set($p_state); + $self->SUPER::set( $1, $p_setby ); + } + else { + $self->SUPER::set( $p_state, $p_setby ); + $p_state = "Z" . $$self{zone} . "_" . $p_state; + $$self{receiver}->set($p_state); + } +} + +=back + +=head2 NOTES + +=head2 AUTHOR + +Wayne Gatlin + +=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 From 9dac309a1de37dc448d7c31b11e87073ad0dab5e Mon Sep 17 00:00:00 2001 From: waynieack Date: Thu, 20 Oct 2016 15:37:32 -0500 Subject: [PATCH 4/7] Updated Doorbird Documentation --- lib/DOORBIRD.pm | 594 ++++++++++++++++++++++++++++-------------------- 1 file changed, 344 insertions(+), 250 deletions(-) diff --git a/lib/DOORBIRD.pm b/lib/DOORBIRD.pm index be6e68bc0..6d08f505d 100644 --- a/lib/DOORBIRD.pm +++ b/lib/DOORBIRD.pm @@ -1,19 +1,12 @@ -=head1 B -=head2 SYNOPSIS +=head1 B -Doorbird module -written by Wayne Gatlin =head2 DESCRIPTION Module for interfacing with the Doorbird line of IP Doorbells. Monitors events sent by the doorbell such as doorbell button push, motion, built in door relay trigger. -For more info about Doorbird doorbells see: https://www.doorbird.com/ -For more info about the Doorbird open LAN API see: https://www.doorbird.com/api - - =head2 CONFIGURATION At minimum, you must define the Interface and one of the following objects @@ -22,21 +15,21 @@ for the display of these objects as separate items in the MH interface and allow users to interact directly with these objects using the basic Generic_Item functions such as tie_event. -The DOORBIRD_Bell and DOORBIRD_Motion objects are for tracking the state of the -doorbell bell button and the doorbell built in motion detector and are not for -controlling the doorbell from MH. +The DOORBIRD_Bell and DOORBIRD_Motion objects are for tracking the state of the +doorbell bell button and the doorbell built in motion detector and are not for +controlling the doorbell from MH. The DOORBIRD_Relay object is for tracking the state of the built-in "door relay" in the doorbell and to control the door relay and the doorbell IR light. The relay -is a standard dry contact relay that could be used for any purpose. +is a standard dry contact relay that could be used for any purpose. -Misterhouse receives the states of each object from the doorbell by configuring the +Misterhouse receives the states of each object from the doorbell by configuring the doorbell to send an HTTP get to MH when an action is realized, this method allows MH -to track the states even when they have been triggered by the android app. The -configuration of the doorbell happens when MH is started, so the doorbell must be +to track the states even when they have been triggered by the android app. The +configuration of the doorbell happens when MH is started, so the doorbell must be On and accessible by MH when MH is started. -=head3 Interface Configuration +=head2 Interface Configuration mh.private.ini configuration: @@ -44,50 +37,22 @@ In order to allow for multiple doorbells, instance names are used. the following are prefixed with the instance name (DOORBIRD). The IP of the misterhouse server: -DOORBIRD_mh_ip=192.168.1.10 - -Wherein the format for the definition is: -_mh_ip= - - -The port of the misterhouse server web: -DOORBIRD_mh_port=8080 - -Wherein the format for the definition is: -_mh_port= + DOORBIRD_mh_ip=192.168.1.10 +The port of the misterhouse server web: + DOORBIRD_mh_port=8080 The IP of the doorbell: -DOORBIRD_doorbell_ip=192.168.1.50 - -Wherein the format for the definition is: -_doorbell_ip= - + DOORBIRD_doorbell_ip=192.168.1.50 The username for the doorbell: -DOORBIRD_user=doorbirduser - -Wherein the format for the definition is: -_user= - + DOORBIRD_user=doorbirduser The password for the doorbell: -DOORBIRD_password=doorbirdpass - -Wherein the format for the definition is: -_password= - - -Optional to enable debugging log: -debug=doorbird + DOORBIRD_password=doorbirdpass -Wherein the format for the definition is: -debug= - -debug logs are stored in the /logs/ - -=head4 Defining the Interface Object +=head2 Defining the Interface Object In addition to the above configuration, you must also define the interface object. The object can be defined in the user code. @@ -100,34 +65,34 @@ Wherein the format for the definition is: $DOORBIRD = new DOORBIRD(INSTANCE); -=head4 Bell Object +=head2 Bell Object -$DOORBIRD_Bell = new DOORBIRD_Bell('DOORBIRD', 1); + $DOORBIRD_Bell = new DOORBIRD_Bell('DOORBIRD', 1); Wherein the format for the definition is: -$DOORBIRD_Bell = new DOORBIRD_Bell(INSTANCE, ENABLECONFIG); + $DOORBIRD_Bell = new DOORBIRD_Bell(INSTANCE, ENABLECONFIG); States: ON OFF -=head4 Motion Object +=head2 Motion Object -$DOORBIRD_Motion = new DOORBIRD_Motion('DOORBIRD', 1); + $DOORBIRD_Motion = new DOORBIRD_Motion('DOORBIRD', 1); Wherein the format for the definition is: -$DOORBIRD_Motion = new DOORBIRD_Motion(INSTANCE, ENABLECONFIG); + $DOORBIRD_Motion = new DOORBIRD_Motion(INSTANCE, ENABLECONFIG); States: ON OFF -=head4 Relay Object +=head2 Relay Object -$DOORBIRD_Relay = new DOORBIRD_Relay('DOORBIRD', 1); + $DOORBIRD_Relay = new DOORBIRD_Relay('DOORBIRD', 1); Wherein the format for the definition is: -$DOORBIRD_Relay = new DOORBIRD_Relay(INSTANCE, ENABLECONFIG); + $DOORBIRD_Relay = new DOORBIRD_Relay(INSTANCE, ENABLECONFIG); States: ON @@ -141,27 +106,27 @@ LIGHT_ON (to enable the IR light on the door bell) An example mh.private.ini: -DOORBIRD_mh_ip=192.168.1.10 -DOORBIRD_mh_port=8080 -DOORBIRD_doorbell_ip=192.168.1.50 -DOORBIRD_user=doorbirduser -DOORBIRD_password=doorbirdpass + DOORBIRD_mh_ip=192.168.1.10 + DOORBIRD_mh_port=8080 + DOORBIRD_doorbell_ip=192.168.1.50 + DOORBIRD_user=doorbirduser + DOORBIRD_password=doorbirdpass An example user code: -#noloop=start -use DOORBIRD; -$DOORBIRD = new DOORBIRD('DOORBIRD'); -$DOORBIRD_Bell = new DOORBIRD_Bell('DOORBIRD', 1); -$DOORBIRD_Motion = new DOORBIRD_Motion('DOORBIRD', 1); -$DOORBIRD_Relay = new DOORBIRD_Relay('DOORBIRD', 1); -#noloop=stop - -if ($state = state_changed $DOORBIRD_Motion) { - run_voice_cmd 'start cam 8' if ($state eq 'on'); - run_voice_cmd 'stop cam 8' if ($state eq 'off'); -} + #noloop=start + use DOORBIRD; + $DOORBIRD = new DOORBIRD('DOORBIRD'); + $DOORBIRD_Bell = new DOORBIRD_Bell('DOORBIRD', 1); + $DOORBIRD_Motion = new DOORBIRD_Motion('DOORBIRD', 1); + $DOORBIRD_Relay = new DOORBIRD_Relay('DOORBIRD', 1); + #noloop=stop + + if ($state = state_changed $DOORBIRD_Motion) { + run_voice_cmd 'start cam 8' if ($state eq 'on'); + run_voice_cmd 'stop cam 8' if ($state eq 'off'); + } =head2 INHERITS @@ -173,49 +138,48 @@ L =cut - package DOORBIRD; @DOORBIRD::ISA = ('Generic_Item'); sub new { - my ($class, $instance) = @_; - $instance = "DOORBIRD" if (!defined($instance)); - ::print_log("Starting $instance instance of DOORBIRD interface module"); - - my $self = new Generic_Item(); - - # Initialize Variables - $$self{instance} = $instance; - $$self{mh_ip} = $::config_parms{$instance.'_mh_ip'}; - $$self{mh_port} = $::config_parms{$instance.'_mh_port'}; - $$self{doorbell_ip} = $::config_parms{$instance.'_doorbell_ip'}; - $$self{user} = $::config_parms{$instance.'_user'}; - $$self{password} = $::config_parms{$instance.'_password'}; - my $year_mon = &::time_date_stamp( 10, time ); - $$self{log_file} = $::config_parms{'data_dir'}.'/logs/'.$instance.'_'.$year_mon.'.log'; - - bless $self, $class; - - #Store Object with Instance Name - $self->_set_object_instance($instance); - return $self; + my ( $class, $instance ) = @_; + $instance = "DOORBIRD" if ( !defined($instance) ); + ::print_log("Starting $instance instance of DOORBIRD interface module"); + + my $self = new Generic_Item(); + + # Initialize Variables + $$self{instance} = $instance; + $$self{mh_ip} = $::config_parms{ $instance . '_mh_ip' }; + $$self{mh_port} = $::config_parms{ $instance . '_mh_port' }; + $$self{doorbell_ip} = $::config_parms{ $instance . '_doorbell_ip' }; + $$self{user} = $::config_parms{ $instance . '_user' }; + $$self{password} = $::config_parms{ $instance . '_password' }; + my $year_mon = &::time_date_stamp( 10, time ); + $$self{log_file} = + $::config_parms{'data_dir'} . "/logs/DOORBIRD.$year_mon.log"; + + bless $self, $class; + + #Store Object with Instance Name + $self->_set_object_instance($instance); + return $self; } -sub get_object_by_instance{ - my ($instance) = @_; - return $Interfaces{$instance}; +sub get_object_by_instance { + my ($instance) = @_; + return $Interfaces{$instance}; } -sub _set_object_instance{ - my ($self, $instance) = @_; - $Interfaces{$instance} = $self; +sub _set_object_instance { + my ( $self, $instance ) = @_; + $Interfaces{$instance} = $self; } sub init { } - =item C Used to associate child objects with the interface. @@ -223,60 +187,92 @@ Used to associate child objects with the interface. =cut sub register { - my ($self,$object,$config,$class) = @_; - if ($object->isa('DOORBIRD_Bell')) { - ::print_log("Registering Child Object for Doorbird bell"); - $self->{bell_object} = $object; - if (defined($self->{bell_object})) { sleep 3 } - $self->configure_bell($object,'doorbell',$class) if ($config); - } - elsif ($object->isa('DOORBIRD_Motion')) { - ::print_log("Registering Child Object for Doorbird motion"); - $self->{motion_object} = $object; - if (defined($self->{motion_object})) { sleep 3 } - $self->configure_bell($object,'motionsensor',$class) if ($config); - } - elsif ($object->isa('DOORBIRD_Relay')) { - ::print_log("Registering Child Object for Doorbird relay"); - $self->{relay_object} = $object; - if (defined($self->{relay_object})) { sleep 3 } - $self->configure_bell($object,'dooropen',$class) if ($config); - } + my ( $self, $object, $config, $class ) = @_; + if ( $object->isa('DOORBIRD_Bell') ) { + ::print_log("Registering Child Object for Doorbird bell"); + $self->{bell_object} = $object; + if ( defined( $self->{bell_object} ) ) { sleep 3 } + $self->configure_bell( $object, 'doorbell', $class ) if ($config); + } + elsif ( $object->isa('DOORBIRD_Motion') ) { + ::print_log("Registering Child Object for Doorbird motion"); + $self->{motion_object} = $object; + if ( defined( $self->{motion_object} ) ) { sleep 3 } + $self->configure_bell( $object, 'motionsensor', $class ) if ($config); + } + elsif ( $object->isa('DOORBIRD_Relay') ) { + ::print_log("Registering Child Object for Doorbird relay"); + $self->{relay_object} = $object; + if ( defined( $self->{relay_object} ) ) { sleep 3 } + $self->configure_bell( $object, 'dooropen', $class ) if ($config); + } } - - sub configure_bell { - my ($self,$object,$type,$class) = @_; - use LWP::UserAgent; - my $ua = LWP::UserAgent->new(); - $ua->timeout($httptimeout); - my $req = $ua->get('http://'.$$self{user}.':'.$$self{password}.'@'.$$self{doorbell_ip}.'/bha-api/notification.cgi?url=http://'.$$self{mh_ip}.':'.$$self{mh_port}.'/mh/set?$'.$class.'?ON&user=&password=&event='.$type.'&subscribe=1'); + my ( $self, $object, $type, $class ) = @_; + use LWP::UserAgent; + my $ua = LWP::UserAgent->new(); + $ua->timeout($httptimeout); + my $req = + $ua->get( 'http://' + . $$self{user} . ':' + . $$self{password} . '@' + . $$self{doorbell_ip} + . '/bha-api/notification.cgi?url=http://' + . $$self{mh_ip} . ':' + . $$self{mh_port} + . '/mh/set;no_response?$' + . $class + . '?ON&user=&password=&event=' + . $type + . '&subscribe=1' ); } - sub send_command { - my ($self,$object,$type,$class) = @_; - use LWP::UserAgent; - my $ua = LWP::UserAgent->new(); - $ua->timeout($httptimeout); - $self->debug_log("[DOORBIRD] Sent request /bha-api/$type.cgi",4); - my $req = $ua->get('http://'.$$self{user}.':'.$$self{password}.'@'.$$self{doorbell_ip}.'/bha-api/'.$type.'.cgi'); + my ( $self, $object, $type, $class ) = @_; + use LWP::UserAgent; + my $ua = LWP::UserAgent->new(); + $ua->timeout($httptimeout); + ::print_log("[DOORBIRD] Sent request /bha-api/$type.cgi"); + my $req = + $ua->get( 'http://' + . $$self{user} . ':' + . $$self{password} . '@' + . $$self{doorbell_ip} + . '/bha-api/' + . $type + . '.cgi' ); } +=back -=item C +=head1 B -Used to log messages to the specific log file. +=head2 SYNOPSIS -=cut +User code: -sub debug_log { - my ($self, $text, $level) = @_; - my $instance = $$self{instance}; - ::logit( $$self{log_file}, $text) if $main::Debug{lc($instance)}; -} + $DOORBIRD_Bell = new DOORBIRD_Bell('DOORBIRD', 1); + + Wherein the format for the definition is: + $DOORBIRD_Bell = new DOORBIRD_Bell(INSTANCE, ENABLECONFIG); +See C for a more detailed description of the arguments. + + +=head2 DESCRIPTION + + Tracks doorbell button pushes in MH. + +=head2 INHERITS + +L + +=head2 METHODS + +=over + +=cut package DOORBIRD_Bell; @DOORBIRD_Bell::ISA = ('Generic_Item'); @@ -288,47 +284,82 @@ Instantiates a new object. $doorbell = The DOORBIRD of the doorbell that this zone is found on $config = If you want this module to configure the DOORBIRD doorbell - to post updates to MH, then this value should be a 1, else 0. - If you disable auto configure (0), you must manually configure - the doorbell using the API with the MH URL you want the doorbell - to post to. +to post updates to MH, then this value should be a 1, else 0. +If you disable auto configure (0), you must manually configure +the doorbell using the API with the MH URL you want the doorbell +to post to. =cut -sub new -{ - my ($class,$doorbell,$config) = @_; - my $self = new Generic_Item(); - bless $self,$class; - $doorbell = DOORBIRD::get_object_by_instance($doorbell); - $doorbell->register($self,$config,$class); - $$self{doorbell} = $doorbell; - #@{$$self{states}} = ('ON','OFF'); - return $self; +sub new { + my ( $class, $doorbell, $config ) = @_; + my $self = new Generic_Item(); + bless $self, $class; + $doorbell = DOORBIRD::get_object_by_instance($doorbell); + $doorbell->register( $self, $config, $class ); + $$self{doorbell} = $doorbell; + + #@{$$self{states}} = ('ON','OFF'); + return $self; } sub set { - my ($self, $p_state, $p_setby, $p_response) = @_; - if ($p_state eq 'ON') { - $$self{doorbell}->debug_log("[DOORBIRD::Bell] Received request " - . $p_state ." for ". $self->get_object_name,1); - $self->SUPER::set($p_state,$p_setby); - $self->set_with_timer('TON', 2, 'TOFF') - } - if ($p_state eq 'TOFF') { - $$self{doorbell}->debug_log("[DOORBIRD::Bell] Received request OFF" - ." by timer for ". $self->get_object_name,1); - $self->SUPER::set('OFF','TIMER'); - } - if ($p_state eq 'OFF') { - $$self{doorbell}->debug_log("[DOORBIRD::Bell] Received request " - . $p_state ." for ". $self->get_object_name,1); - $self->SUPER::set('OFF','TIMER'); - } + my ( $self, $p_state, $p_setby, $p_response ) = @_; + if ( $p_state eq 'ON' ) { + ::print_log( "[DOORBIRD::Bell] Received request " + . $p_state . " for " + . $self->get_object_name ); + $self->SUPER::set( $p_state, $p_setby ); + $self->set_with_timer( 'TON', 2, 'TOFF' ); + } + if ( $p_state eq 'TOFF' ) { + ::print_log( "[DOORBIRD::Bell] Received request OFF" + . " by timer for " + . $self->get_object_name ); + $self->SUPER::set( 'OFF', 'TIMER' ); + } + if ( $p_state eq 'OFF' ) { + ::print_log( "[DOORBIRD::Bell] Received request " + . $p_state . " for " + . $self->get_object_name ); + $self->SUPER::set( 'OFF', 'TIMER' ); + } } +=back + +=head1 B + +=head2 SYNOPSIS + +User code: + + $DOORBIRD_Motion = new DOORBIRD_Motion('DOORBIRD', 1); + Wherein the format for the definition is: + $DOORBIRD_Motion = new DOORBIRD_Motion(INSTANCE, ENABLECONFIG); + + States: + ON + OFF + +See C for a more detailed description of the arguments. + + +=head2 DESCRIPTION + +Tracks doorbell motion in MH. + +=head2 INHERITS + +L + +=head2 METHODS + +=over + +=cut package DOORBIRD_Motion; @DOORBIRD_Motion::ISA = ('Generic_Item'); @@ -340,48 +371,86 @@ Instantiates a new object. $doorbell = The DOORBIRD doorbell that this motion sensor is found on $config = If you want this module to configure the DOORBIRD doorbell - to post updates to MH, then this value should be a 1, else 0. - If you disable auto configure (0), you must manually configure - the doorbell using the API with the MH URL you want the doorbell - to post to. +to post updates to MH, then this value should be a 1, else 0. +If you disable auto configure (0), you must manually configure +the doorbell using the API with the MH URL you want the doorbell +to post to. =cut -sub new -{ - my ($class,$doorbell,$config) = @_; - my $self = new Generic_Item(); - bless $self,$class; - $doorbell = DOORBIRD::get_object_by_instance($doorbell); - $doorbell->register($self,$config,$class); - $$self{doorbell} = $doorbell; - #@{$$self{states}} = ('ON','OFF'); - return $self; +sub new { + my ( $class, $doorbell, $config ) = @_; + my $self = new Generic_Item(); + bless $self, $class; + $doorbell = DOORBIRD::get_object_by_instance($doorbell); + $doorbell->register( $self, $config, $class ); + $$self{doorbell} = $doorbell; + + #@{$$self{states}} = ('ON','OFF'); + return $self; } sub set { - my ($self, $p_state, $p_setby, $p_response) = @_; - if ($p_state eq 'ON') { - $$self{doorbell}->debug_log("[DOORBIRD::Motion] Received request " - . $p_state ." for ". $self->get_object_name); - $self->SUPER::set($p_state,$p_setby,1); - $self->set_with_timer('TON', 20, 'TOFF') - } - if ($p_state eq 'TOFF') { - $$self{doorbell}->debug_log("[DOORBIRD::Motion] Received request OFF" - ." by timer for ". $self->get_object_name,1); - $self->SUPER::set('OFF','TIMER'); - } - if ($p_state eq 'OFF') { - $$self{doorbell}->debug_log("[DOORBIRD::Motion] Received request " - . $p_state ." for ". $self->get_object_name,1); - $self->SUPER::set('OFF','TIMER'); - } + my ( $self, $p_state, $p_setby, $p_response ) = @_; + if ( $p_state eq 'ON' ) { + ::print_log( "[DOORBIRD::Motion] Received request " + . $p_state . " for " + . $self->get_object_name ); + $self->SUPER::set( $p_state, $p_setby ); + $self->set_with_timer( 'TON', 20, 'TOFF' ); + } + if ( $p_state eq 'TOFF' ) { + ::print_log( "[DOORBIRD::Motion] Received request OFF" + . " by timer for " + . $self->get_object_name ); + $self->SUPER::set( 'OFF', 'TIMER' ); + } + if ( $p_state eq 'OFF' ) { + ::print_log( "[DOORBIRD::Motion] Received request " + . $p_state . " for " + . $self->get_object_name ); + $self->SUPER::set( 'OFF', 'TIMER' ); + } } +=back + +=head1 B + +=head2 SYNOPSIS + +User code: + + $DOORBIRD_Relay = new DOORBIRD_Relay('DOORBIRD', 1); + + Wherein the format for the definition is: + $DOORBIRD_Relay = new DOORBIRD_Relay(INSTANCE, ENABLECONFIG); + +States: +ON +OFF + + Control States: + TOGGLE (to trigger the relay) + LIGHT_ON (to enable the IR light on the door bell) + +See C for a more detailed description of the arguments. + + +=head2 DESCRIPTION + +Tracks/controls doorbell relay in MH. + +=head2 INHERITS + +L +=head2 METHODS +=over + +=cut package DOORBIRD_Relay; @DOORBIRD_Relay::ISA = ('Generic_Item'); @@ -393,53 +462,78 @@ Instantiates a new object. $doorbell = The DOORBIRD doorbell that this door relay is found on $config = If you want this module to configure the DOORBIRD doorbell - to post updates to MH, then this value should be a 1, else 0. - If you disable auto configure (0), you must manually configure - the doorbell using the API with the MH URL you want the doorbell - to post to. +to post updates to MH, then this value should be a 1, else 0. +If you disable auto configure (0), you must manually configure +the doorbell using the API with the MH URL you want the doorbell +to post to. =cut -sub new -{ - my ($class,$doorbell,$config) = @_; - my $self = new Generic_Item(); - bless $self,$class; - $doorbell = DOORBIRD::get_object_by_instance($doorbell); - $doorbell->register($self,$config,$class); - $$self{doorbell} = $doorbell; - @{$$self{states}} = ('TOGGLE','LIGHT-ON'); - return $self; +sub new { + my ( $class, $doorbell, $config ) = @_; + my $self = new Generic_Item(); + bless $self, $class; + $doorbell = DOORBIRD::get_object_by_instance($doorbell); + $doorbell->register( $self, $config, $class ); + $$self{doorbell} = $doorbell; + @{ $$self{states} } = ( 'TOGGLE', 'LIGHT_ON' ); + return $self; } sub set { - my ($self, $p_state, $p_setby, $p_response) = @_; - if ($p_state eq 'ON') { - $$self{doorbell}->debug_log("[DOORBIRD::Relay] Received request " - . $p_state ." for ". $self->get_object_name,1); - $self->SUPER::set($p_state,$p_setby); - $self->set_with_timer('TON', 2, 'TOFF') - } - if ($p_state eq 'TOFF') { - $$self{doorbell}->debug_log("[DOORBIRD::Relay] Received request OFF" - ." by timer for ". $self->get_object_name,1); - $self->SUPER::set('OFF','TIMER'); - } - if ($p_state eq 'OFF') { - $$self{doorbell}->debug_log("[DOORBIRD::Relay] Received request " - . $p_state ." for ". $self->get_object_name,1); - $self->SUPER::set('OFF','TIMER'); - } - if ($p_state eq 'TOGGLE') { - $$self{doorbell}->debug_log("[DOORBIRD::Relay] Received request " - . $p_state ." for ". $self->get_object_name,1); - $$self{doorbell}->send_command($object,'open-door',$class); - } - if ($p_state eq 'LIGHT-ON') { - $$self{doorbell}->debug_log("[DOORBIRD::Relay] Received request " - . $p_state ." for ". $self->get_object_name,1); - $$self{doorbell}->send_command($object,'light-on',$class); - } + my ( $self, $p_state, $p_setby, $p_response ) = @_; + if ( $p_state eq 'ON' ) { + ::print_log( "[DOORBIRD::Relay] Received request " + . $p_state . " for " + . $self->get_object_name ); + $self->SUPER::set( $p_state, $p_setby ); + $self->set_with_timer( 'TON', 2, 'TOFF' ); + } + if ( $p_state eq 'TOFF' ) { + ::print_log( "[DOORBIRD::Relay] Received request OFF" + . " by timer for " + . $self->get_object_name ); + $self->SUPER::set( 'OFF', 'TIMER' ); + } + if ( $p_state eq 'OFF' ) { + ::print_log( "[DOORBIRD::Relay] Received request " + . $p_state . " for " + . $self->get_object_name ); + $self->SUPER::set( 'OFF', 'TIMER' ); + } + if ( $p_state eq 'TOGGLE' ) { + ::print_log( "[DOORBIRD::Relay] Received request " + . $p_state . " for " + . $self->get_object_name ); + $$self{doorbell}->send_command( $object, 'open-door', $class ); + } + if ( $p_state eq 'LIGHT_ON' ) { + ::print_log( "[DOORBIRD::Relay] Received request " + . $p_state . " for " + . $self->get_object_name ); + $self->send_command( $object, 'light-on', $class ); + } } +=back + +=head2 INI PARAMETERS + +=head2 NOTES + +=head2 AUTHOR + +Wayne Gatlin + +=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 From d8ad96649247f0c3255d0f81c7dd4327fb313cfb Mon Sep 17 00:00:00 2001 From: waynieack Date: Thu, 20 Oct 2016 15:44:09 -0500 Subject: [PATCH 5/7] Revert "Updated Doorbird Documentation" This reverts commit 9dac309a1de37dc448d7c31b11e87073ad0dab5e. --- lib/DOORBIRD.pm | 594 ++++++++++++++++++++---------------------------- 1 file changed, 250 insertions(+), 344 deletions(-) diff --git a/lib/DOORBIRD.pm b/lib/DOORBIRD.pm index 6d08f505d..be6e68bc0 100644 --- a/lib/DOORBIRD.pm +++ b/lib/DOORBIRD.pm @@ -1,12 +1,19 @@ - =head1 B +=head2 SYNOPSIS + +Doorbird module +written by Wayne Gatlin =head2 DESCRIPTION Module for interfacing with the Doorbird line of IP Doorbells. Monitors events sent by the doorbell such as doorbell button push, motion, built in door relay trigger. +For more info about Doorbird doorbells see: https://www.doorbird.com/ +For more info about the Doorbird open LAN API see: https://www.doorbird.com/api + + =head2 CONFIGURATION At minimum, you must define the Interface and one of the following objects @@ -15,21 +22,21 @@ for the display of these objects as separate items in the MH interface and allow users to interact directly with these objects using the basic Generic_Item functions such as tie_event. -The DOORBIRD_Bell and DOORBIRD_Motion objects are for tracking the state of the -doorbell bell button and the doorbell built in motion detector and are not for -controlling the doorbell from MH. +The DOORBIRD_Bell and DOORBIRD_Motion objects are for tracking the state of the +doorbell bell button and the doorbell built in motion detector and are not for +controlling the doorbell from MH. The DOORBIRD_Relay object is for tracking the state of the built-in "door relay" in the doorbell and to control the door relay and the doorbell IR light. The relay -is a standard dry contact relay that could be used for any purpose. +is a standard dry contact relay that could be used for any purpose. -Misterhouse receives the states of each object from the doorbell by configuring the +Misterhouse receives the states of each object from the doorbell by configuring the doorbell to send an HTTP get to MH when an action is realized, this method allows MH -to track the states even when they have been triggered by the android app. The -configuration of the doorbell happens when MH is started, so the doorbell must be +to track the states even when they have been triggered by the android app. The +configuration of the doorbell happens when MH is started, so the doorbell must be On and accessible by MH when MH is started. -=head2 Interface Configuration +=head3 Interface Configuration mh.private.ini configuration: @@ -37,22 +44,50 @@ In order to allow for multiple doorbells, instance names are used. the following are prefixed with the instance name (DOORBIRD). The IP of the misterhouse server: - DOORBIRD_mh_ip=192.168.1.10 +DOORBIRD_mh_ip=192.168.1.10 + +Wherein the format for the definition is: +_mh_ip= + + +The port of the misterhouse server web: +DOORBIRD_mh_port=8080 + +Wherein the format for the definition is: +_mh_port= -The port of the misterhouse server web: - DOORBIRD_mh_port=8080 The IP of the doorbell: - DOORBIRD_doorbell_ip=192.168.1.50 +DOORBIRD_doorbell_ip=192.168.1.50 + +Wherein the format for the definition is: +_doorbell_ip= + The username for the doorbell: - DOORBIRD_user=doorbirduser +DOORBIRD_user=doorbirduser + +Wherein the format for the definition is: +_user= + The password for the doorbell: - DOORBIRD_password=doorbirdpass +DOORBIRD_password=doorbirdpass + +Wherein the format for the definition is: +_password= + + +Optional to enable debugging log: +debug=doorbird +Wherein the format for the definition is: +debug= + +debug logs are stored in the /logs/ -=head2 Defining the Interface Object + +=head4 Defining the Interface Object In addition to the above configuration, you must also define the interface object. The object can be defined in the user code. @@ -65,34 +100,34 @@ Wherein the format for the definition is: $DOORBIRD = new DOORBIRD(INSTANCE); -=head2 Bell Object +=head4 Bell Object - $DOORBIRD_Bell = new DOORBIRD_Bell('DOORBIRD', 1); +$DOORBIRD_Bell = new DOORBIRD_Bell('DOORBIRD', 1); Wherein the format for the definition is: - $DOORBIRD_Bell = new DOORBIRD_Bell(INSTANCE, ENABLECONFIG); +$DOORBIRD_Bell = new DOORBIRD_Bell(INSTANCE, ENABLECONFIG); States: ON OFF -=head2 Motion Object +=head4 Motion Object - $DOORBIRD_Motion = new DOORBIRD_Motion('DOORBIRD', 1); +$DOORBIRD_Motion = new DOORBIRD_Motion('DOORBIRD', 1); Wherein the format for the definition is: - $DOORBIRD_Motion = new DOORBIRD_Motion(INSTANCE, ENABLECONFIG); +$DOORBIRD_Motion = new DOORBIRD_Motion(INSTANCE, ENABLECONFIG); States: ON OFF -=head2 Relay Object +=head4 Relay Object - $DOORBIRD_Relay = new DOORBIRD_Relay('DOORBIRD', 1); +$DOORBIRD_Relay = new DOORBIRD_Relay('DOORBIRD', 1); Wherein the format for the definition is: - $DOORBIRD_Relay = new DOORBIRD_Relay(INSTANCE, ENABLECONFIG); +$DOORBIRD_Relay = new DOORBIRD_Relay(INSTANCE, ENABLECONFIG); States: ON @@ -106,27 +141,27 @@ LIGHT_ON (to enable the IR light on the door bell) An example mh.private.ini: - DOORBIRD_mh_ip=192.168.1.10 - DOORBIRD_mh_port=8080 - DOORBIRD_doorbell_ip=192.168.1.50 - DOORBIRD_user=doorbirduser - DOORBIRD_password=doorbirdpass +DOORBIRD_mh_ip=192.168.1.10 +DOORBIRD_mh_port=8080 +DOORBIRD_doorbell_ip=192.168.1.50 +DOORBIRD_user=doorbirduser +DOORBIRD_password=doorbirdpass An example user code: - #noloop=start - use DOORBIRD; - $DOORBIRD = new DOORBIRD('DOORBIRD'); - $DOORBIRD_Bell = new DOORBIRD_Bell('DOORBIRD', 1); - $DOORBIRD_Motion = new DOORBIRD_Motion('DOORBIRD', 1); - $DOORBIRD_Relay = new DOORBIRD_Relay('DOORBIRD', 1); - #noloop=stop - - if ($state = state_changed $DOORBIRD_Motion) { - run_voice_cmd 'start cam 8' if ($state eq 'on'); - run_voice_cmd 'stop cam 8' if ($state eq 'off'); - } +#noloop=start +use DOORBIRD; +$DOORBIRD = new DOORBIRD('DOORBIRD'); +$DOORBIRD_Bell = new DOORBIRD_Bell('DOORBIRD', 1); +$DOORBIRD_Motion = new DOORBIRD_Motion('DOORBIRD', 1); +$DOORBIRD_Relay = new DOORBIRD_Relay('DOORBIRD', 1); +#noloop=stop + +if ($state = state_changed $DOORBIRD_Motion) { + run_voice_cmd 'start cam 8' if ($state eq 'on'); + run_voice_cmd 'stop cam 8' if ($state eq 'off'); +} =head2 INHERITS @@ -138,48 +173,49 @@ L =cut + package DOORBIRD; @DOORBIRD::ISA = ('Generic_Item'); sub new { - my ( $class, $instance ) = @_; - $instance = "DOORBIRD" if ( !defined($instance) ); - ::print_log("Starting $instance instance of DOORBIRD interface module"); - - my $self = new Generic_Item(); - - # Initialize Variables - $$self{instance} = $instance; - $$self{mh_ip} = $::config_parms{ $instance . '_mh_ip' }; - $$self{mh_port} = $::config_parms{ $instance . '_mh_port' }; - $$self{doorbell_ip} = $::config_parms{ $instance . '_doorbell_ip' }; - $$self{user} = $::config_parms{ $instance . '_user' }; - $$self{password} = $::config_parms{ $instance . '_password' }; - my $year_mon = &::time_date_stamp( 10, time ); - $$self{log_file} = - $::config_parms{'data_dir'} . "/logs/DOORBIRD.$year_mon.log"; - - bless $self, $class; - - #Store Object with Instance Name - $self->_set_object_instance($instance); - return $self; + my ($class, $instance) = @_; + $instance = "DOORBIRD" if (!defined($instance)); + ::print_log("Starting $instance instance of DOORBIRD interface module"); + + my $self = new Generic_Item(); + + # Initialize Variables + $$self{instance} = $instance; + $$self{mh_ip} = $::config_parms{$instance.'_mh_ip'}; + $$self{mh_port} = $::config_parms{$instance.'_mh_port'}; + $$self{doorbell_ip} = $::config_parms{$instance.'_doorbell_ip'}; + $$self{user} = $::config_parms{$instance.'_user'}; + $$self{password} = $::config_parms{$instance.'_password'}; + my $year_mon = &::time_date_stamp( 10, time ); + $$self{log_file} = $::config_parms{'data_dir'}.'/logs/'.$instance.'_'.$year_mon.'.log'; + + bless $self, $class; + + #Store Object with Instance Name + $self->_set_object_instance($instance); + return $self; } -sub get_object_by_instance { - my ($instance) = @_; - return $Interfaces{$instance}; +sub get_object_by_instance{ + my ($instance) = @_; + return $Interfaces{$instance}; } -sub _set_object_instance { - my ( $self, $instance ) = @_; - $Interfaces{$instance} = $self; +sub _set_object_instance{ + my ($self, $instance) = @_; + $Interfaces{$instance} = $self; } sub init { } + =item C Used to associate child objects with the interface. @@ -187,92 +223,60 @@ Used to associate child objects with the interface. =cut sub register { - my ( $self, $object, $config, $class ) = @_; - if ( $object->isa('DOORBIRD_Bell') ) { - ::print_log("Registering Child Object for Doorbird bell"); - $self->{bell_object} = $object; - if ( defined( $self->{bell_object} ) ) { sleep 3 } - $self->configure_bell( $object, 'doorbell', $class ) if ($config); - } - elsif ( $object->isa('DOORBIRD_Motion') ) { - ::print_log("Registering Child Object for Doorbird motion"); - $self->{motion_object} = $object; - if ( defined( $self->{motion_object} ) ) { sleep 3 } - $self->configure_bell( $object, 'motionsensor', $class ) if ($config); - } - elsif ( $object->isa('DOORBIRD_Relay') ) { - ::print_log("Registering Child Object for Doorbird relay"); - $self->{relay_object} = $object; - if ( defined( $self->{relay_object} ) ) { sleep 3 } - $self->configure_bell( $object, 'dooropen', $class ) if ($config); - } + my ($self,$object,$config,$class) = @_; + if ($object->isa('DOORBIRD_Bell')) { + ::print_log("Registering Child Object for Doorbird bell"); + $self->{bell_object} = $object; + if (defined($self->{bell_object})) { sleep 3 } + $self->configure_bell($object,'doorbell',$class) if ($config); + } + elsif ($object->isa('DOORBIRD_Motion')) { + ::print_log("Registering Child Object for Doorbird motion"); + $self->{motion_object} = $object; + if (defined($self->{motion_object})) { sleep 3 } + $self->configure_bell($object,'motionsensor',$class) if ($config); + } + elsif ($object->isa('DOORBIRD_Relay')) { + ::print_log("Registering Child Object for Doorbird relay"); + $self->{relay_object} = $object; + if (defined($self->{relay_object})) { sleep 3 } + $self->configure_bell($object,'dooropen',$class) if ($config); + } } + + sub configure_bell { - my ( $self, $object, $type, $class ) = @_; - use LWP::UserAgent; - my $ua = LWP::UserAgent->new(); - $ua->timeout($httptimeout); - my $req = - $ua->get( 'http://' - . $$self{user} . ':' - . $$self{password} . '@' - . $$self{doorbell_ip} - . '/bha-api/notification.cgi?url=http://' - . $$self{mh_ip} . ':' - . $$self{mh_port} - . '/mh/set;no_response?$' - . $class - . '?ON&user=&password=&event=' - . $type - . '&subscribe=1' ); + my ($self,$object,$type,$class) = @_; + use LWP::UserAgent; + my $ua = LWP::UserAgent->new(); + $ua->timeout($httptimeout); + my $req = $ua->get('http://'.$$self{user}.':'.$$self{password}.'@'.$$self{doorbell_ip}.'/bha-api/notification.cgi?url=http://'.$$self{mh_ip}.':'.$$self{mh_port}.'/mh/set?$'.$class.'?ON&user=&password=&event='.$type.'&subscribe=1'); } + sub send_command { - my ( $self, $object, $type, $class ) = @_; - use LWP::UserAgent; - my $ua = LWP::UserAgent->new(); - $ua->timeout($httptimeout); - ::print_log("[DOORBIRD] Sent request /bha-api/$type.cgi"); - my $req = - $ua->get( 'http://' - . $$self{user} . ':' - . $$self{password} . '@' - . $$self{doorbell_ip} - . '/bha-api/' - . $type - . '.cgi' ); + my ($self,$object,$type,$class) = @_; + use LWP::UserAgent; + my $ua = LWP::UserAgent->new(); + $ua->timeout($httptimeout); + $self->debug_log("[DOORBIRD] Sent request /bha-api/$type.cgi",4); + my $req = $ua->get('http://'.$$self{user}.':'.$$self{password}.'@'.$$self{doorbell_ip}.'/bha-api/'.$type.'.cgi'); } -=back - -=head1 B - -=head2 SYNOPSIS - -User code: - $DOORBIRD_Bell = new DOORBIRD_Bell('DOORBIRD', 1); +=item C - Wherein the format for the definition is: - $DOORBIRD_Bell = new DOORBIRD_Bell(INSTANCE, ENABLECONFIG); - -See C for a more detailed description of the arguments. - - -=head2 DESCRIPTION - - Tracks doorbell button pushes in MH. - -=head2 INHERITS +Used to log messages to the specific log file. -L - -=head2 METHODS +=cut -=over +sub debug_log { + my ($self, $text, $level) = @_; + my $instance = $$self{instance}; + ::logit( $$self{log_file}, $text) if $main::Debug{lc($instance)}; +} -=cut package DOORBIRD_Bell; @DOORBIRD_Bell::ISA = ('Generic_Item'); @@ -284,82 +288,47 @@ Instantiates a new object. $doorbell = The DOORBIRD of the doorbell that this zone is found on $config = If you want this module to configure the DOORBIRD doorbell -to post updates to MH, then this value should be a 1, else 0. -If you disable auto configure (0), you must manually configure -the doorbell using the API with the MH URL you want the doorbell -to post to. + to post updates to MH, then this value should be a 1, else 0. + If you disable auto configure (0), you must manually configure + the doorbell using the API with the MH URL you want the doorbell + to post to. =cut -sub new { - my ( $class, $doorbell, $config ) = @_; - my $self = new Generic_Item(); - bless $self, $class; - $doorbell = DOORBIRD::get_object_by_instance($doorbell); - $doorbell->register( $self, $config, $class ); - $$self{doorbell} = $doorbell; - - #@{$$self{states}} = ('ON','OFF'); - return $self; +sub new +{ + my ($class,$doorbell,$config) = @_; + my $self = new Generic_Item(); + bless $self,$class; + $doorbell = DOORBIRD::get_object_by_instance($doorbell); + $doorbell->register($self,$config,$class); + $$self{doorbell} = $doorbell; + #@{$$self{states}} = ('ON','OFF'); + return $self; } sub set { - my ( $self, $p_state, $p_setby, $p_response ) = @_; - if ( $p_state eq 'ON' ) { - ::print_log( "[DOORBIRD::Bell] Received request " - . $p_state . " for " - . $self->get_object_name ); - $self->SUPER::set( $p_state, $p_setby ); - $self->set_with_timer( 'TON', 2, 'TOFF' ); - } - if ( $p_state eq 'TOFF' ) { - ::print_log( "[DOORBIRD::Bell] Received request OFF" - . " by timer for " - . $self->get_object_name ); - $self->SUPER::set( 'OFF', 'TIMER' ); - } - if ( $p_state eq 'OFF' ) { - ::print_log( "[DOORBIRD::Bell] Received request " - . $p_state . " for " - . $self->get_object_name ); - $self->SUPER::set( 'OFF', 'TIMER' ); - } + my ($self, $p_state, $p_setby, $p_response) = @_; + if ($p_state eq 'ON') { + $$self{doorbell}->debug_log("[DOORBIRD::Bell] Received request " + . $p_state ." for ". $self->get_object_name,1); + $self->SUPER::set($p_state,$p_setby); + $self->set_with_timer('TON', 2, 'TOFF') + } + if ($p_state eq 'TOFF') { + $$self{doorbell}->debug_log("[DOORBIRD::Bell] Received request OFF" + ." by timer for ". $self->get_object_name,1); + $self->SUPER::set('OFF','TIMER'); + } + if ($p_state eq 'OFF') { + $$self{doorbell}->debug_log("[DOORBIRD::Bell] Received request " + . $p_state ." for ". $self->get_object_name,1); + $self->SUPER::set('OFF','TIMER'); + } } -=back - -=head1 B - -=head2 SYNOPSIS - -User code: - - $DOORBIRD_Motion = new DOORBIRD_Motion('DOORBIRD', 1); - Wherein the format for the definition is: - $DOORBIRD_Motion = new DOORBIRD_Motion(INSTANCE, ENABLECONFIG); - - States: - ON - OFF - -See C for a more detailed description of the arguments. - - -=head2 DESCRIPTION - -Tracks doorbell motion in MH. - -=head2 INHERITS - -L - -=head2 METHODS - -=over - -=cut package DOORBIRD_Motion; @DOORBIRD_Motion::ISA = ('Generic_Item'); @@ -371,86 +340,48 @@ Instantiates a new object. $doorbell = The DOORBIRD doorbell that this motion sensor is found on $config = If you want this module to configure the DOORBIRD doorbell -to post updates to MH, then this value should be a 1, else 0. -If you disable auto configure (0), you must manually configure -the doorbell using the API with the MH URL you want the doorbell -to post to. + to post updates to MH, then this value should be a 1, else 0. + If you disable auto configure (0), you must manually configure + the doorbell using the API with the MH URL you want the doorbell + to post to. =cut -sub new { - my ( $class, $doorbell, $config ) = @_; - my $self = new Generic_Item(); - bless $self, $class; - $doorbell = DOORBIRD::get_object_by_instance($doorbell); - $doorbell->register( $self, $config, $class ); - $$self{doorbell} = $doorbell; - - #@{$$self{states}} = ('ON','OFF'); - return $self; +sub new +{ + my ($class,$doorbell,$config) = @_; + my $self = new Generic_Item(); + bless $self,$class; + $doorbell = DOORBIRD::get_object_by_instance($doorbell); + $doorbell->register($self,$config,$class); + $$self{doorbell} = $doorbell; + #@{$$self{states}} = ('ON','OFF'); + return $self; } sub set { - my ( $self, $p_state, $p_setby, $p_response ) = @_; - if ( $p_state eq 'ON' ) { - ::print_log( "[DOORBIRD::Motion] Received request " - . $p_state . " for " - . $self->get_object_name ); - $self->SUPER::set( $p_state, $p_setby ); - $self->set_with_timer( 'TON', 20, 'TOFF' ); - } - if ( $p_state eq 'TOFF' ) { - ::print_log( "[DOORBIRD::Motion] Received request OFF" - . " by timer for " - . $self->get_object_name ); - $self->SUPER::set( 'OFF', 'TIMER' ); - } - if ( $p_state eq 'OFF' ) { - ::print_log( "[DOORBIRD::Motion] Received request " - . $p_state . " for " - . $self->get_object_name ); - $self->SUPER::set( 'OFF', 'TIMER' ); - } + my ($self, $p_state, $p_setby, $p_response) = @_; + if ($p_state eq 'ON') { + $$self{doorbell}->debug_log("[DOORBIRD::Motion] Received request " + . $p_state ." for ". $self->get_object_name); + $self->SUPER::set($p_state,$p_setby,1); + $self->set_with_timer('TON', 20, 'TOFF') + } + if ($p_state eq 'TOFF') { + $$self{doorbell}->debug_log("[DOORBIRD::Motion] Received request OFF" + ." by timer for ". $self->get_object_name,1); + $self->SUPER::set('OFF','TIMER'); + } + if ($p_state eq 'OFF') { + $$self{doorbell}->debug_log("[DOORBIRD::Motion] Received request " + . $p_state ." for ". $self->get_object_name,1); + $self->SUPER::set('OFF','TIMER'); + } } -=back - -=head1 B - -=head2 SYNOPSIS - -User code: - - $DOORBIRD_Relay = new DOORBIRD_Relay('DOORBIRD', 1); - - Wherein the format for the definition is: - $DOORBIRD_Relay = new DOORBIRD_Relay(INSTANCE, ENABLECONFIG); - -States: -ON -OFF - - Control States: - TOGGLE (to trigger the relay) - LIGHT_ON (to enable the IR light on the door bell) - -See C for a more detailed description of the arguments. - - -=head2 DESCRIPTION - -Tracks/controls doorbell relay in MH. - -=head2 INHERITS - -L -=head2 METHODS -=over - -=cut package DOORBIRD_Relay; @DOORBIRD_Relay::ISA = ('Generic_Item'); @@ -462,78 +393,53 @@ Instantiates a new object. $doorbell = The DOORBIRD doorbell that this door relay is found on $config = If you want this module to configure the DOORBIRD doorbell -to post updates to MH, then this value should be a 1, else 0. -If you disable auto configure (0), you must manually configure -the doorbell using the API with the MH URL you want the doorbell -to post to. + to post updates to MH, then this value should be a 1, else 0. + If you disable auto configure (0), you must manually configure + the doorbell using the API with the MH URL you want the doorbell + to post to. =cut -sub new { - my ( $class, $doorbell, $config ) = @_; - my $self = new Generic_Item(); - bless $self, $class; - $doorbell = DOORBIRD::get_object_by_instance($doorbell); - $doorbell->register( $self, $config, $class ); - $$self{doorbell} = $doorbell; - @{ $$self{states} } = ( 'TOGGLE', 'LIGHT_ON' ); - return $self; +sub new +{ + my ($class,$doorbell,$config) = @_; + my $self = new Generic_Item(); + bless $self,$class; + $doorbell = DOORBIRD::get_object_by_instance($doorbell); + $doorbell->register($self,$config,$class); + $$self{doorbell} = $doorbell; + @{$$self{states}} = ('TOGGLE','LIGHT-ON'); + return $self; } sub set { - my ( $self, $p_state, $p_setby, $p_response ) = @_; - if ( $p_state eq 'ON' ) { - ::print_log( "[DOORBIRD::Relay] Received request " - . $p_state . " for " - . $self->get_object_name ); - $self->SUPER::set( $p_state, $p_setby ); - $self->set_with_timer( 'TON', 2, 'TOFF' ); - } - if ( $p_state eq 'TOFF' ) { - ::print_log( "[DOORBIRD::Relay] Received request OFF" - . " by timer for " - . $self->get_object_name ); - $self->SUPER::set( 'OFF', 'TIMER' ); - } - if ( $p_state eq 'OFF' ) { - ::print_log( "[DOORBIRD::Relay] Received request " - . $p_state . " for " - . $self->get_object_name ); - $self->SUPER::set( 'OFF', 'TIMER' ); - } - if ( $p_state eq 'TOGGLE' ) { - ::print_log( "[DOORBIRD::Relay] Received request " - . $p_state . " for " - . $self->get_object_name ); - $$self{doorbell}->send_command( $object, 'open-door', $class ); - } - if ( $p_state eq 'LIGHT_ON' ) { - ::print_log( "[DOORBIRD::Relay] Received request " - . $p_state . " for " - . $self->get_object_name ); - $self->send_command( $object, 'light-on', $class ); - } + my ($self, $p_state, $p_setby, $p_response) = @_; + if ($p_state eq 'ON') { + $$self{doorbell}->debug_log("[DOORBIRD::Relay] Received request " + . $p_state ." for ". $self->get_object_name,1); + $self->SUPER::set($p_state,$p_setby); + $self->set_with_timer('TON', 2, 'TOFF') + } + if ($p_state eq 'TOFF') { + $$self{doorbell}->debug_log("[DOORBIRD::Relay] Received request OFF" + ." by timer for ". $self->get_object_name,1); + $self->SUPER::set('OFF','TIMER'); + } + if ($p_state eq 'OFF') { + $$self{doorbell}->debug_log("[DOORBIRD::Relay] Received request " + . $p_state ." for ". $self->get_object_name,1); + $self->SUPER::set('OFF','TIMER'); + } + if ($p_state eq 'TOGGLE') { + $$self{doorbell}->debug_log("[DOORBIRD::Relay] Received request " + . $p_state ." for ". $self->get_object_name,1); + $$self{doorbell}->send_command($object,'open-door',$class); + } + if ($p_state eq 'LIGHT-ON') { + $$self{doorbell}->debug_log("[DOORBIRD::Relay] Received request " + . $p_state ." for ". $self->get_object_name,1); + $$self{doorbell}->send_command($object,'light-on',$class); + } } -=back - -=head2 INI PARAMETERS - -=head2 NOTES - -=head2 AUTHOR - -Wayne Gatlin - -=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 From 25f79eead9a8f812c4130e54ecd61a5a8ab409f9 Mon Sep 17 00:00:00 2001 From: waynieack Date: Thu, 20 Oct 2016 15:46:38 -0500 Subject: [PATCH 6/7] Updated Doorbird Documentation --- lib/DOORBIRD.pm | 594 ++++++++++++++++++++++++++++-------------------- 1 file changed, 344 insertions(+), 250 deletions(-) diff --git a/lib/DOORBIRD.pm b/lib/DOORBIRD.pm index be6e68bc0..6d08f505d 100644 --- a/lib/DOORBIRD.pm +++ b/lib/DOORBIRD.pm @@ -1,19 +1,12 @@ -=head1 B -=head2 SYNOPSIS +=head1 B -Doorbird module -written by Wayne Gatlin =head2 DESCRIPTION Module for interfacing with the Doorbird line of IP Doorbells. Monitors events sent by the doorbell such as doorbell button push, motion, built in door relay trigger. -For more info about Doorbird doorbells see: https://www.doorbird.com/ -For more info about the Doorbird open LAN API see: https://www.doorbird.com/api - - =head2 CONFIGURATION At minimum, you must define the Interface and one of the following objects @@ -22,21 +15,21 @@ for the display of these objects as separate items in the MH interface and allow users to interact directly with these objects using the basic Generic_Item functions such as tie_event. -The DOORBIRD_Bell and DOORBIRD_Motion objects are for tracking the state of the -doorbell bell button and the doorbell built in motion detector and are not for -controlling the doorbell from MH. +The DOORBIRD_Bell and DOORBIRD_Motion objects are for tracking the state of the +doorbell bell button and the doorbell built in motion detector and are not for +controlling the doorbell from MH. The DOORBIRD_Relay object is for tracking the state of the built-in "door relay" in the doorbell and to control the door relay and the doorbell IR light. The relay -is a standard dry contact relay that could be used for any purpose. +is a standard dry contact relay that could be used for any purpose. -Misterhouse receives the states of each object from the doorbell by configuring the +Misterhouse receives the states of each object from the doorbell by configuring the doorbell to send an HTTP get to MH when an action is realized, this method allows MH -to track the states even when they have been triggered by the android app. The -configuration of the doorbell happens when MH is started, so the doorbell must be +to track the states even when they have been triggered by the android app. The +configuration of the doorbell happens when MH is started, so the doorbell must be On and accessible by MH when MH is started. -=head3 Interface Configuration +=head2 Interface Configuration mh.private.ini configuration: @@ -44,50 +37,22 @@ In order to allow for multiple doorbells, instance names are used. the following are prefixed with the instance name (DOORBIRD). The IP of the misterhouse server: -DOORBIRD_mh_ip=192.168.1.10 - -Wherein the format for the definition is: -_mh_ip= - - -The port of the misterhouse server web: -DOORBIRD_mh_port=8080 - -Wherein the format for the definition is: -_mh_port= + DOORBIRD_mh_ip=192.168.1.10 +The port of the misterhouse server web: + DOORBIRD_mh_port=8080 The IP of the doorbell: -DOORBIRD_doorbell_ip=192.168.1.50 - -Wherein the format for the definition is: -_doorbell_ip= - + DOORBIRD_doorbell_ip=192.168.1.50 The username for the doorbell: -DOORBIRD_user=doorbirduser - -Wherein the format for the definition is: -_user= - + DOORBIRD_user=doorbirduser The password for the doorbell: -DOORBIRD_password=doorbirdpass - -Wherein the format for the definition is: -_password= - - -Optional to enable debugging log: -debug=doorbird + DOORBIRD_password=doorbirdpass -Wherein the format for the definition is: -debug= - -debug logs are stored in the /logs/ - -=head4 Defining the Interface Object +=head2 Defining the Interface Object In addition to the above configuration, you must also define the interface object. The object can be defined in the user code. @@ -100,34 +65,34 @@ Wherein the format for the definition is: $DOORBIRD = new DOORBIRD(INSTANCE); -=head4 Bell Object +=head2 Bell Object -$DOORBIRD_Bell = new DOORBIRD_Bell('DOORBIRD', 1); + $DOORBIRD_Bell = new DOORBIRD_Bell('DOORBIRD', 1); Wherein the format for the definition is: -$DOORBIRD_Bell = new DOORBIRD_Bell(INSTANCE, ENABLECONFIG); + $DOORBIRD_Bell = new DOORBIRD_Bell(INSTANCE, ENABLECONFIG); States: ON OFF -=head4 Motion Object +=head2 Motion Object -$DOORBIRD_Motion = new DOORBIRD_Motion('DOORBIRD', 1); + $DOORBIRD_Motion = new DOORBIRD_Motion('DOORBIRD', 1); Wherein the format for the definition is: -$DOORBIRD_Motion = new DOORBIRD_Motion(INSTANCE, ENABLECONFIG); + $DOORBIRD_Motion = new DOORBIRD_Motion(INSTANCE, ENABLECONFIG); States: ON OFF -=head4 Relay Object +=head2 Relay Object -$DOORBIRD_Relay = new DOORBIRD_Relay('DOORBIRD', 1); + $DOORBIRD_Relay = new DOORBIRD_Relay('DOORBIRD', 1); Wherein the format for the definition is: -$DOORBIRD_Relay = new DOORBIRD_Relay(INSTANCE, ENABLECONFIG); + $DOORBIRD_Relay = new DOORBIRD_Relay(INSTANCE, ENABLECONFIG); States: ON @@ -141,27 +106,27 @@ LIGHT_ON (to enable the IR light on the door bell) An example mh.private.ini: -DOORBIRD_mh_ip=192.168.1.10 -DOORBIRD_mh_port=8080 -DOORBIRD_doorbell_ip=192.168.1.50 -DOORBIRD_user=doorbirduser -DOORBIRD_password=doorbirdpass + DOORBIRD_mh_ip=192.168.1.10 + DOORBIRD_mh_port=8080 + DOORBIRD_doorbell_ip=192.168.1.50 + DOORBIRD_user=doorbirduser + DOORBIRD_password=doorbirdpass An example user code: -#noloop=start -use DOORBIRD; -$DOORBIRD = new DOORBIRD('DOORBIRD'); -$DOORBIRD_Bell = new DOORBIRD_Bell('DOORBIRD', 1); -$DOORBIRD_Motion = new DOORBIRD_Motion('DOORBIRD', 1); -$DOORBIRD_Relay = new DOORBIRD_Relay('DOORBIRD', 1); -#noloop=stop - -if ($state = state_changed $DOORBIRD_Motion) { - run_voice_cmd 'start cam 8' if ($state eq 'on'); - run_voice_cmd 'stop cam 8' if ($state eq 'off'); -} + #noloop=start + use DOORBIRD; + $DOORBIRD = new DOORBIRD('DOORBIRD'); + $DOORBIRD_Bell = new DOORBIRD_Bell('DOORBIRD', 1); + $DOORBIRD_Motion = new DOORBIRD_Motion('DOORBIRD', 1); + $DOORBIRD_Relay = new DOORBIRD_Relay('DOORBIRD', 1); + #noloop=stop + + if ($state = state_changed $DOORBIRD_Motion) { + run_voice_cmd 'start cam 8' if ($state eq 'on'); + run_voice_cmd 'stop cam 8' if ($state eq 'off'); + } =head2 INHERITS @@ -173,49 +138,48 @@ L =cut - package DOORBIRD; @DOORBIRD::ISA = ('Generic_Item'); sub new { - my ($class, $instance) = @_; - $instance = "DOORBIRD" if (!defined($instance)); - ::print_log("Starting $instance instance of DOORBIRD interface module"); - - my $self = new Generic_Item(); - - # Initialize Variables - $$self{instance} = $instance; - $$self{mh_ip} = $::config_parms{$instance.'_mh_ip'}; - $$self{mh_port} = $::config_parms{$instance.'_mh_port'}; - $$self{doorbell_ip} = $::config_parms{$instance.'_doorbell_ip'}; - $$self{user} = $::config_parms{$instance.'_user'}; - $$self{password} = $::config_parms{$instance.'_password'}; - my $year_mon = &::time_date_stamp( 10, time ); - $$self{log_file} = $::config_parms{'data_dir'}.'/logs/'.$instance.'_'.$year_mon.'.log'; - - bless $self, $class; - - #Store Object with Instance Name - $self->_set_object_instance($instance); - return $self; + my ( $class, $instance ) = @_; + $instance = "DOORBIRD" if ( !defined($instance) ); + ::print_log("Starting $instance instance of DOORBIRD interface module"); + + my $self = new Generic_Item(); + + # Initialize Variables + $$self{instance} = $instance; + $$self{mh_ip} = $::config_parms{ $instance . '_mh_ip' }; + $$self{mh_port} = $::config_parms{ $instance . '_mh_port' }; + $$self{doorbell_ip} = $::config_parms{ $instance . '_doorbell_ip' }; + $$self{user} = $::config_parms{ $instance . '_user' }; + $$self{password} = $::config_parms{ $instance . '_password' }; + my $year_mon = &::time_date_stamp( 10, time ); + $$self{log_file} = + $::config_parms{'data_dir'} . "/logs/DOORBIRD.$year_mon.log"; + + bless $self, $class; + + #Store Object with Instance Name + $self->_set_object_instance($instance); + return $self; } -sub get_object_by_instance{ - my ($instance) = @_; - return $Interfaces{$instance}; +sub get_object_by_instance { + my ($instance) = @_; + return $Interfaces{$instance}; } -sub _set_object_instance{ - my ($self, $instance) = @_; - $Interfaces{$instance} = $self; +sub _set_object_instance { + my ( $self, $instance ) = @_; + $Interfaces{$instance} = $self; } sub init { } - =item C Used to associate child objects with the interface. @@ -223,60 +187,92 @@ Used to associate child objects with the interface. =cut sub register { - my ($self,$object,$config,$class) = @_; - if ($object->isa('DOORBIRD_Bell')) { - ::print_log("Registering Child Object for Doorbird bell"); - $self->{bell_object} = $object; - if (defined($self->{bell_object})) { sleep 3 } - $self->configure_bell($object,'doorbell',$class) if ($config); - } - elsif ($object->isa('DOORBIRD_Motion')) { - ::print_log("Registering Child Object for Doorbird motion"); - $self->{motion_object} = $object; - if (defined($self->{motion_object})) { sleep 3 } - $self->configure_bell($object,'motionsensor',$class) if ($config); - } - elsif ($object->isa('DOORBIRD_Relay')) { - ::print_log("Registering Child Object for Doorbird relay"); - $self->{relay_object} = $object; - if (defined($self->{relay_object})) { sleep 3 } - $self->configure_bell($object,'dooropen',$class) if ($config); - } + my ( $self, $object, $config, $class ) = @_; + if ( $object->isa('DOORBIRD_Bell') ) { + ::print_log("Registering Child Object for Doorbird bell"); + $self->{bell_object} = $object; + if ( defined( $self->{bell_object} ) ) { sleep 3 } + $self->configure_bell( $object, 'doorbell', $class ) if ($config); + } + elsif ( $object->isa('DOORBIRD_Motion') ) { + ::print_log("Registering Child Object for Doorbird motion"); + $self->{motion_object} = $object; + if ( defined( $self->{motion_object} ) ) { sleep 3 } + $self->configure_bell( $object, 'motionsensor', $class ) if ($config); + } + elsif ( $object->isa('DOORBIRD_Relay') ) { + ::print_log("Registering Child Object for Doorbird relay"); + $self->{relay_object} = $object; + if ( defined( $self->{relay_object} ) ) { sleep 3 } + $self->configure_bell( $object, 'dooropen', $class ) if ($config); + } } - - sub configure_bell { - my ($self,$object,$type,$class) = @_; - use LWP::UserAgent; - my $ua = LWP::UserAgent->new(); - $ua->timeout($httptimeout); - my $req = $ua->get('http://'.$$self{user}.':'.$$self{password}.'@'.$$self{doorbell_ip}.'/bha-api/notification.cgi?url=http://'.$$self{mh_ip}.':'.$$self{mh_port}.'/mh/set?$'.$class.'?ON&user=&password=&event='.$type.'&subscribe=1'); + my ( $self, $object, $type, $class ) = @_; + use LWP::UserAgent; + my $ua = LWP::UserAgent->new(); + $ua->timeout($httptimeout); + my $req = + $ua->get( 'http://' + . $$self{user} . ':' + . $$self{password} . '@' + . $$self{doorbell_ip} + . '/bha-api/notification.cgi?url=http://' + . $$self{mh_ip} . ':' + . $$self{mh_port} + . '/mh/set;no_response?$' + . $class + . '?ON&user=&password=&event=' + . $type + . '&subscribe=1' ); } - sub send_command { - my ($self,$object,$type,$class) = @_; - use LWP::UserAgent; - my $ua = LWP::UserAgent->new(); - $ua->timeout($httptimeout); - $self->debug_log("[DOORBIRD] Sent request /bha-api/$type.cgi",4); - my $req = $ua->get('http://'.$$self{user}.':'.$$self{password}.'@'.$$self{doorbell_ip}.'/bha-api/'.$type.'.cgi'); + my ( $self, $object, $type, $class ) = @_; + use LWP::UserAgent; + my $ua = LWP::UserAgent->new(); + $ua->timeout($httptimeout); + ::print_log("[DOORBIRD] Sent request /bha-api/$type.cgi"); + my $req = + $ua->get( 'http://' + . $$self{user} . ':' + . $$self{password} . '@' + . $$self{doorbell_ip} + . '/bha-api/' + . $type + . '.cgi' ); } +=back -=item C +=head1 B -Used to log messages to the specific log file. +=head2 SYNOPSIS -=cut +User code: -sub debug_log { - my ($self, $text, $level) = @_; - my $instance = $$self{instance}; - ::logit( $$self{log_file}, $text) if $main::Debug{lc($instance)}; -} + $DOORBIRD_Bell = new DOORBIRD_Bell('DOORBIRD', 1); + + Wherein the format for the definition is: + $DOORBIRD_Bell = new DOORBIRD_Bell(INSTANCE, ENABLECONFIG); +See C for a more detailed description of the arguments. + + +=head2 DESCRIPTION + + Tracks doorbell button pushes in MH. + +=head2 INHERITS + +L + +=head2 METHODS + +=over + +=cut package DOORBIRD_Bell; @DOORBIRD_Bell::ISA = ('Generic_Item'); @@ -288,47 +284,82 @@ Instantiates a new object. $doorbell = The DOORBIRD of the doorbell that this zone is found on $config = If you want this module to configure the DOORBIRD doorbell - to post updates to MH, then this value should be a 1, else 0. - If you disable auto configure (0), you must manually configure - the doorbell using the API with the MH URL you want the doorbell - to post to. +to post updates to MH, then this value should be a 1, else 0. +If you disable auto configure (0), you must manually configure +the doorbell using the API with the MH URL you want the doorbell +to post to. =cut -sub new -{ - my ($class,$doorbell,$config) = @_; - my $self = new Generic_Item(); - bless $self,$class; - $doorbell = DOORBIRD::get_object_by_instance($doorbell); - $doorbell->register($self,$config,$class); - $$self{doorbell} = $doorbell; - #@{$$self{states}} = ('ON','OFF'); - return $self; +sub new { + my ( $class, $doorbell, $config ) = @_; + my $self = new Generic_Item(); + bless $self, $class; + $doorbell = DOORBIRD::get_object_by_instance($doorbell); + $doorbell->register( $self, $config, $class ); + $$self{doorbell} = $doorbell; + + #@{$$self{states}} = ('ON','OFF'); + return $self; } sub set { - my ($self, $p_state, $p_setby, $p_response) = @_; - if ($p_state eq 'ON') { - $$self{doorbell}->debug_log("[DOORBIRD::Bell] Received request " - . $p_state ." for ". $self->get_object_name,1); - $self->SUPER::set($p_state,$p_setby); - $self->set_with_timer('TON', 2, 'TOFF') - } - if ($p_state eq 'TOFF') { - $$self{doorbell}->debug_log("[DOORBIRD::Bell] Received request OFF" - ." by timer for ". $self->get_object_name,1); - $self->SUPER::set('OFF','TIMER'); - } - if ($p_state eq 'OFF') { - $$self{doorbell}->debug_log("[DOORBIRD::Bell] Received request " - . $p_state ." for ". $self->get_object_name,1); - $self->SUPER::set('OFF','TIMER'); - } + my ( $self, $p_state, $p_setby, $p_response ) = @_; + if ( $p_state eq 'ON' ) { + ::print_log( "[DOORBIRD::Bell] Received request " + . $p_state . " for " + . $self->get_object_name ); + $self->SUPER::set( $p_state, $p_setby ); + $self->set_with_timer( 'TON', 2, 'TOFF' ); + } + if ( $p_state eq 'TOFF' ) { + ::print_log( "[DOORBIRD::Bell] Received request OFF" + . " by timer for " + . $self->get_object_name ); + $self->SUPER::set( 'OFF', 'TIMER' ); + } + if ( $p_state eq 'OFF' ) { + ::print_log( "[DOORBIRD::Bell] Received request " + . $p_state . " for " + . $self->get_object_name ); + $self->SUPER::set( 'OFF', 'TIMER' ); + } } +=back + +=head1 B + +=head2 SYNOPSIS + +User code: + + $DOORBIRD_Motion = new DOORBIRD_Motion('DOORBIRD', 1); + Wherein the format for the definition is: + $DOORBIRD_Motion = new DOORBIRD_Motion(INSTANCE, ENABLECONFIG); + + States: + ON + OFF + +See C for a more detailed description of the arguments. + + +=head2 DESCRIPTION + +Tracks doorbell motion in MH. + +=head2 INHERITS + +L + +=head2 METHODS + +=over + +=cut package DOORBIRD_Motion; @DOORBIRD_Motion::ISA = ('Generic_Item'); @@ -340,48 +371,86 @@ Instantiates a new object. $doorbell = The DOORBIRD doorbell that this motion sensor is found on $config = If you want this module to configure the DOORBIRD doorbell - to post updates to MH, then this value should be a 1, else 0. - If you disable auto configure (0), you must manually configure - the doorbell using the API with the MH URL you want the doorbell - to post to. +to post updates to MH, then this value should be a 1, else 0. +If you disable auto configure (0), you must manually configure +the doorbell using the API with the MH URL you want the doorbell +to post to. =cut -sub new -{ - my ($class,$doorbell,$config) = @_; - my $self = new Generic_Item(); - bless $self,$class; - $doorbell = DOORBIRD::get_object_by_instance($doorbell); - $doorbell->register($self,$config,$class); - $$self{doorbell} = $doorbell; - #@{$$self{states}} = ('ON','OFF'); - return $self; +sub new { + my ( $class, $doorbell, $config ) = @_; + my $self = new Generic_Item(); + bless $self, $class; + $doorbell = DOORBIRD::get_object_by_instance($doorbell); + $doorbell->register( $self, $config, $class ); + $$self{doorbell} = $doorbell; + + #@{$$self{states}} = ('ON','OFF'); + return $self; } sub set { - my ($self, $p_state, $p_setby, $p_response) = @_; - if ($p_state eq 'ON') { - $$self{doorbell}->debug_log("[DOORBIRD::Motion] Received request " - . $p_state ." for ". $self->get_object_name); - $self->SUPER::set($p_state,$p_setby,1); - $self->set_with_timer('TON', 20, 'TOFF') - } - if ($p_state eq 'TOFF') { - $$self{doorbell}->debug_log("[DOORBIRD::Motion] Received request OFF" - ." by timer for ". $self->get_object_name,1); - $self->SUPER::set('OFF','TIMER'); - } - if ($p_state eq 'OFF') { - $$self{doorbell}->debug_log("[DOORBIRD::Motion] Received request " - . $p_state ." for ". $self->get_object_name,1); - $self->SUPER::set('OFF','TIMER'); - } + my ( $self, $p_state, $p_setby, $p_response ) = @_; + if ( $p_state eq 'ON' ) { + ::print_log( "[DOORBIRD::Motion] Received request " + . $p_state . " for " + . $self->get_object_name ); + $self->SUPER::set( $p_state, $p_setby ); + $self->set_with_timer( 'TON', 20, 'TOFF' ); + } + if ( $p_state eq 'TOFF' ) { + ::print_log( "[DOORBIRD::Motion] Received request OFF" + . " by timer for " + . $self->get_object_name ); + $self->SUPER::set( 'OFF', 'TIMER' ); + } + if ( $p_state eq 'OFF' ) { + ::print_log( "[DOORBIRD::Motion] Received request " + . $p_state . " for " + . $self->get_object_name ); + $self->SUPER::set( 'OFF', 'TIMER' ); + } } +=back + +=head1 B + +=head2 SYNOPSIS + +User code: + + $DOORBIRD_Relay = new DOORBIRD_Relay('DOORBIRD', 1); + + Wherein the format for the definition is: + $DOORBIRD_Relay = new DOORBIRD_Relay(INSTANCE, ENABLECONFIG); + +States: +ON +OFF + + Control States: + TOGGLE (to trigger the relay) + LIGHT_ON (to enable the IR light on the door bell) + +See C for a more detailed description of the arguments. + + +=head2 DESCRIPTION + +Tracks/controls doorbell relay in MH. + +=head2 INHERITS + +L +=head2 METHODS +=over + +=cut package DOORBIRD_Relay; @DOORBIRD_Relay::ISA = ('Generic_Item'); @@ -393,53 +462,78 @@ Instantiates a new object. $doorbell = The DOORBIRD doorbell that this door relay is found on $config = If you want this module to configure the DOORBIRD doorbell - to post updates to MH, then this value should be a 1, else 0. - If you disable auto configure (0), you must manually configure - the doorbell using the API with the MH URL you want the doorbell - to post to. +to post updates to MH, then this value should be a 1, else 0. +If you disable auto configure (0), you must manually configure +the doorbell using the API with the MH URL you want the doorbell +to post to. =cut -sub new -{ - my ($class,$doorbell,$config) = @_; - my $self = new Generic_Item(); - bless $self,$class; - $doorbell = DOORBIRD::get_object_by_instance($doorbell); - $doorbell->register($self,$config,$class); - $$self{doorbell} = $doorbell; - @{$$self{states}} = ('TOGGLE','LIGHT-ON'); - return $self; +sub new { + my ( $class, $doorbell, $config ) = @_; + my $self = new Generic_Item(); + bless $self, $class; + $doorbell = DOORBIRD::get_object_by_instance($doorbell); + $doorbell->register( $self, $config, $class ); + $$self{doorbell} = $doorbell; + @{ $$self{states} } = ( 'TOGGLE', 'LIGHT_ON' ); + return $self; } sub set { - my ($self, $p_state, $p_setby, $p_response) = @_; - if ($p_state eq 'ON') { - $$self{doorbell}->debug_log("[DOORBIRD::Relay] Received request " - . $p_state ." for ". $self->get_object_name,1); - $self->SUPER::set($p_state,$p_setby); - $self->set_with_timer('TON', 2, 'TOFF') - } - if ($p_state eq 'TOFF') { - $$self{doorbell}->debug_log("[DOORBIRD::Relay] Received request OFF" - ." by timer for ". $self->get_object_name,1); - $self->SUPER::set('OFF','TIMER'); - } - if ($p_state eq 'OFF') { - $$self{doorbell}->debug_log("[DOORBIRD::Relay] Received request " - . $p_state ." for ". $self->get_object_name,1); - $self->SUPER::set('OFF','TIMER'); - } - if ($p_state eq 'TOGGLE') { - $$self{doorbell}->debug_log("[DOORBIRD::Relay] Received request " - . $p_state ." for ". $self->get_object_name,1); - $$self{doorbell}->send_command($object,'open-door',$class); - } - if ($p_state eq 'LIGHT-ON') { - $$self{doorbell}->debug_log("[DOORBIRD::Relay] Received request " - . $p_state ." for ". $self->get_object_name,1); - $$self{doorbell}->send_command($object,'light-on',$class); - } + my ( $self, $p_state, $p_setby, $p_response ) = @_; + if ( $p_state eq 'ON' ) { + ::print_log( "[DOORBIRD::Relay] Received request " + . $p_state . " for " + . $self->get_object_name ); + $self->SUPER::set( $p_state, $p_setby ); + $self->set_with_timer( 'TON', 2, 'TOFF' ); + } + if ( $p_state eq 'TOFF' ) { + ::print_log( "[DOORBIRD::Relay] Received request OFF" + . " by timer for " + . $self->get_object_name ); + $self->SUPER::set( 'OFF', 'TIMER' ); + } + if ( $p_state eq 'OFF' ) { + ::print_log( "[DOORBIRD::Relay] Received request " + . $p_state . " for " + . $self->get_object_name ); + $self->SUPER::set( 'OFF', 'TIMER' ); + } + if ( $p_state eq 'TOGGLE' ) { + ::print_log( "[DOORBIRD::Relay] Received request " + . $p_state . " for " + . $self->get_object_name ); + $$self{doorbell}->send_command( $object, 'open-door', $class ); + } + if ( $p_state eq 'LIGHT_ON' ) { + ::print_log( "[DOORBIRD::Relay] Received request " + . $p_state . " for " + . $self->get_object_name ); + $self->send_command( $object, 'light-on', $class ); + } } +=back + +=head2 INI PARAMETERS + +=head2 NOTES + +=head2 AUTHOR + +Wayne Gatlin + +=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 From 0226bad9a8c58ab75622d755cca5bd98df6e63ac Mon Sep 17 00:00:00 2001 From: waynieack Date: Fri, 21 Oct 2016 21:36:58 -0500 Subject: [PATCH 7/7] Fixes for broken code due to NOAA site changes. Zone is no longer needed when get_weather is called. Bug #631 --- bin/get_weather | 12 +- lib/site/Geo/WeatherNOAA.pm | 1115 +++++++++++++++++++---------------- 2 files changed, 620 insertions(+), 507 deletions(-) diff --git a/bin/get_weather b/bin/get_weather index 1a753d514..83fda2bb1 100755 --- a/bin/get_weather +++ b/bin/get_weather @@ -59,7 +59,6 @@ Usage: -city xxx => xxx is the City you want. -state xxx => xxx is the State you want. - -zone xxx => xxx is the Zone (for forecast) you want. -data xxx => xxx is either conditions, forecast, or all. Default is all. @@ -76,10 +75,9 @@ eof my ( $conditions, $forecast, %data ); my %config_parms; -$parms{city} = 'Rochester' unless $parms{city}; -$parms{zone} = $parms{city} unless $parms{zone}; -$parms{state} = 'MN' unless $parms{state}; -$parms{data} = 'all' unless $parms{data}; +$parms{city} = 'Rochester' unless $parms{city}; +$parms{state} = 'MN' unless $parms{state}; +$parms{data} = 'all' unless $parms{data}; $data{conditions}++ if $parms{data} eq 'all' or $parms{data} eq 'conditions'; $data{forecast}++ if $parms{data} eq 'all' or $parms{data} eq 'forecast'; @@ -110,9 +108,9 @@ if ( $data{conditions} ) { } if ( $data{forecast} ) { - print "Getting the forecast for $parms{zone}, $parms{state}\n"; + print "Getting the forecast for $parms{city}, $parms{state}\n"; $forecast = - print_forecast( $parms{zone}, $parms{state}, undef, undef, undef, 1 ); + print_forecast( $parms{city}, $parms{state}, undef, undef, undef, 1 ); $forecast =~ s/Geo::WeatherNOAA.pm .+\n//; # Drop geo version #$forecast =~ s/\.\.\./\. /g; $forecast =~ s/(\()(EDT|EST|CDT|CST|MDT|MST|PDT|PST)(\) *)//g; diff --git a/lib/site/Geo/WeatherNOAA.pm b/lib/site/Geo/WeatherNOAA.pm index a5e6387c9..4b74570ab 100644 --- a/lib/site/Geo/WeatherNOAA.pm +++ b/lib/site/Geo/WeatherNOAA.pm @@ -1,6 +1,6 @@ - -# $Id$ - +# $Id: WeatherNOAA.pm,v 4.38 2006/12/10 21:58:11 msolomon Exp $ +# $Id: WeatherNOAA.pm,v 4.39 2016/08/17 21:58:11 rsteeves Exp $ +# $Id: WeatherNOAA.pm,v 4.40 2016/09/28 21:58:11 wgatlin Exp $ package Geo::WeatherNOAA; @@ -14,28 +14,26 @@ use Text::Wrap; require Exporter; @ISA = qw(Exporter); + # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @EXPORT = qw( - make_noaa_table + make_noaa_table - print_forecast - print_current + print_forecast + print_current - get_city_zone - process_city_zone + get_city_zone + process_city_zone - get_city_hourly - process_city_hourly + get_city_hourly + process_city_hourly ); -my $revision = '$Revision$'; - $revision =~ m/: (\d+)/; - $revision = $1; - $VERSION = $revision; - -my $URL_BASE = 'http://www.weather.gov/view/prodsByState.php';#'http://iwin.nws.noaa.gov/iwin/'; +$VERSION = do { my @r = ( q$Revision: 4.40 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; +my $URL_BASE = 'http://forecast.weather.gov/product.php?site='; +my $ZONE_SEARCH_URL = 'http://forecast.weather.gov/zipcity.php'; use vars '$proxy_from_env'; $proxy_from_env = 0; @@ -43,27 +41,26 @@ $proxy_from_env = 0; # Preloaded methods go here. sub print_forecast { - my ($city, $state, $filename, $fileopt, $UA) = @_; - my $in = get_city_zone($city,$state,$filename,$fileopt,$UA); + my ( $city, $state, $filename, $fileopt, $UA ) = @_; + my $in = get_city_zone( $city, $state, $filename, $fileopt, $UA ); - my $out; + my $out; - $out = "Geo::WeatherNOAA.pm v.$Geo::WeatherNOAA::VERSION\n"; + $out = "Geo::WeatherNOAA.pm v.$Geo::WeatherNOAA::VERSION\n"; - my ($date,$warnings,$forecast) = - process_city_zone($city,$state,$filename,$fileopt); + my ( $date, $warnings, $forecast ) = + process_city_zone( $city, $state, $filename, $fileopt ); - $out .= "As of $date:\n"; - foreach my $warning (@$warnings) { - $out .= wrap('WARNING: ',' ',"$warning\n"); - } - foreach my $key (keys %$forecast) { - $out .= wrap('',' ',"$key: $forecast->{$key}\n"); - } - return $out + $out .= "As of $date:\n"; + foreach my $warning (@$warnings) { + $out .= wrap( 'WARNING: ', ' ', "$warning\n" ); + } + foreach my $key ( keys %$forecast ) { + $out .= wrap( '', ' ', "$key: $forecast->{$key}\n" ); + } + return $out; } - ######################################################################### ######################################################################### # @@ -72,241 +69,295 @@ sub print_forecast { ######################################################################### ######################################################################### sub process_city_zone { - my ($city, $state, $filename, $fileopt, $UA) = @_; - my $in = get_city_zone($city,$state,$filename,$fileopt,$UA); - - # Return error if problem getting URL - if ($in =~ /Error/) { - my %error; - my @null; - $error{'Error'} = 'Error'; - $error{'Network Error'} = $in; - return ('',\@null,\%error); - } - - # Split coverage, date, and forecast - # - my ($coverage, $date, $forecast) = ($in =~ /(^.*?)\012 # Coverage - (\d.*?)\012 # Date - (.*)/sx); # Entire Forecast - - # Format Coverage - # - $coverage =~ s/corrected//gi; # Remove stat word - $coverage =~ s/(\/|-|\.\.\.)/, /g; # Turn weird punct to commas - $coverage =~ s/,\s*$//; # Remove last comma - $coverage = ucfirst_words($coverage); # Make caps correct - - # Format date (easy) - # - $date = format_date($date); - - # Vars for forecast - # - my %forecast; - tie %forecast, "Tie::IxHash"; - my @warnings; - - # Iterate through forecast and assign warnings to list or pairs to hash - # - my $forecast_item; # Used as place holder for line breaks of $value - my $warnings_done = 0; # Flag for warnings (Always at top of forcast) - - foreach my $line (split "\012",$forecast) { - # Be-gone if we've got temp data (will include parse for that later) - last if $line =~ /^\.$in|; + my $in = shift; + my $size = shift || 2; + my $font_face = $main::font_face || 'FACE="Helvetica, Lucida, Ariel"'; + return qq|$in|; } sub make_noaa_table { - my ($city, $state, $filename, $fileopt, $UA, $max_items) = @_; - - $fileopt ||= 'get'; - $max_items && $max_items--; - $max_items ||= 4; - - my $med_bg = $main::med_bg || '#ddddff'; - my $light_bg = $main::light_bg || '#eeeeff'; - my $font_face = $main::font_face || 'FACE="Helvetica, Lucida, Ariel"'; - - my $locfilename; - $locfilename = $filename . "_hourly"; - my $current = process_city_hourly( $city,$state,$locfilename,$fileopt,$UA ); - - $locfilename = $filename . "_zone"; - my ($date,$warnings,$forecast,$coverage) = process_city_zone( $city,$state,$locfilename,$fileopt,$UA); - my $cols = (keys %$forecast); - $cols = $max_items if $cols > $max_items; - my $out; - $out .= qq|\n|; - $out .= qq|\n|; - $out .= qq|\n"; - $out .= qq|\n"; - - # Add one to make cols real width of table - # - $cols++; - - # Add warnings, if needed - # - if (@$warnings) { - $out .= qq|\n|; - foreach my $warning (@$warnings) { - $out .= qq|\n|; - $out .= qq|\t\n|; - } - } - - # Iterate over the first $max_items items in forecast - # - my $bottom; # add this after the iteration; - $out .= qq|\n|; - $bottom .= qq|\n|; - foreach my $key ( (keys %$forecast)[0..($cols - 1)] ) { - #print STDERR "DEBUG: $key\n"; - $out .= "\t\n"; - $bottom .= "\t\n"; - } - $out .= "\n" . $bottom . "\n"; - - # Add coverage area - $out .= qq|\n|; - $out .= qq| \n|; - $out .= qq| \n|; - $out .= qq|\n|; - - # Add credits - # - my $wx_cred = 'NOAA forecast made ' . - "$date by " . - "" . - "Geo::WeatherNOAA V.$Geo::WeatherNOAA::VERSION"; - $out .= qq|\n|; - $out .= qq|\n"; - $out .= qq|
\n|; - $out .= font('Current') . "\n|; - $out .= font($current) . "\n
|; - $out .= qq|\n|; - $out .= qq|\t$warning\n
" . font($key) . "" . font($forecast->{$key}) . "
| . font('Area') . qq|| . font($coverage,1) . qq|
| . font($wx_cred) . "
\n|; + my ( $city, $state, $filename, $fileopt, $UA, $max_items ) = @_; + + $fileopt ||= 'get'; + $max_items && $max_items--; + $max_items ||= 4; + + my $med_bg = $main::med_bg || '#ddddff'; + my $light_bg = $main::light_bg || '#eeeeff'; + my $font_face = $main::font_face || 'FACE="Helvetica, Lucida, Ariel"'; + + my $locfilename; + $locfilename = $filename . "_hourly"; + my $current = + process_city_hourly( $city, $state, $locfilename, $fileopt, $UA ); + + $locfilename = $filename . "_zone"; + my ( $date, $warnings, $forecast, $coverage ) = + process_city_zone( $city, $state, $locfilename, $fileopt, $UA ); + my $cols = ( keys %$forecast ); + $cols = $max_items if $cols > $max_items; + my $out; + $out .= qq|\n|; + $out .= qq|\n|; + $out .= qq|\n"; + $out .= qq|\n"; + + # Add one to make cols real width of table + # + $cols++; + # Add warnings, if needed + # + if (@$warnings) { + $out .= qq|\n|; + foreach my $warning (@$warnings) { + $out .= qq|\n|; + $out .= qq|\t\n|; + } + } + # Iterate over the first $max_items items in forecast + # + my $bottom; # add this after the iteration; + $out .= qq|\n|; + $bottom .= qq|\n|; + foreach my $key ( ( keys %$forecast )[ 0 .. ( $cols - 1 ) ] ) { + + #print STDERR "DEBUG: $key\n"; + $out .= "\t\n"; + $bottom .= "\t\n"; + } + $out .= "\n" . $bottom . "\n"; + + # Add coverage area + $out .= qq|\n|; + $out .= qq| \n|; + $out .= qq| \n|; + $out .= qq|\n|; + + # Add credits + # + my $wx_cred = + 'NOAA forecast made ' + . "$date by " + . "" + . "Geo::WeatherNOAA V.$Geo::WeatherNOAA::VERSION"; + $out .= qq|\n|; + $out .= qq|\n"; + $out .= qq|
\n|; + $out .= font('Current') . "\n|; + $out .= font($current) . "\n
|; + $out .= qq|\n|; + $out .= qq|\t$warning\n
" . font($key) . "" . font( $forecast->{$key} ) . "
| . font('Area') . qq|| . font( $coverage, 1 ) . qq|
| . font($wx_cred) . "
\n|; } @@ -314,77 +365,110 @@ sub make_noaa_table { ############################################################################## ## ## Misc funcs -## +## ############################################################################## ############################################################################## +sub get_zone { + my ( $URL, $CityState, $UA ) = @_; + + $URL or die "No URL to get!"; + + # Create the useragent and get the data + # + if ( !$UA ) { + $UA = new LWP::UserAgent; + if ( $ENV{'HTTP_PROXY'} or $ENV{'http_proxy'} ) { + $UA->env_proxy; + } + } + + $UA->agent("WeatherNOAA/$VERSION"); + + my $ua = LWP::UserAgent->new(); + my $response = + $ua->post( $URL, { 'inputstring' => $CityState, 'siteid' => 'chr' } ); + my $location = $response->header('Location'); + + if ( $location =~ /&site=(...)&/ ) { + return $1; + } + else { + return; + } +} + sub get_url { - my ($URL, $UA) = @_; + my ( $URL, $UA ) = @_; - $URL or die "No URL to get!"; + $URL or die "No URL to get!"; # Create the useragent and get the data # - if (! $UA) { - $UA = new LWP::UserAgent; - $UA->env_proxy if $proxy_from_env; + if ( !$UA ) { + $UA = new LWP::UserAgent; + if ( $ENV{'HTTP_PROXY'} or $ENV{'http_proxy'} ) { + $UA->env_proxy; + } } $UA->agent("WeatherNOAA/$VERSION"); - + # Create a request my $req = new HTTP::Request GET => $URL; my $res = $UA->request($req); - if ($res->is_success) { - return $res->content; + if ( $res->is_success ) { + return $res->content; } else { - return; + return; } -} # getURL() +} # getURL() sub get_data { - my ($URL,$filename,$fileopt,$UA) = @_; - - $fileopt ||= 'get'; - - my $data; # Data - - if ( ($fileopt eq 'get') || ($fileopt eq 'save') ) { - print STDERR "Retrieving $URL\n" if $main::opt_v; - $data = get_url($URL,$UA) || - return "Error getting data from $URL"; - if ( $fileopt eq 'save' ) { - print STDERR "Writing $URL to $filename\n" if $main::opt_v; - open(OUT,">$filename") or die "Cannot create $filename"; - print OUT $data; - close OUT; - $fileopt = 'usefile'; - } - } - if ( $fileopt eq 'usefile' ) { - print STDERR "Reading data from $filename\n" if $main::opt_v; - open(FILE,$filename) or die "Cannot read $filename"; - while () { $data .= $_; } - } - return $data; -} # get_fh + my ( $URL, $filename, $fileopt, $UA ) = @_; + + $fileopt ||= 'get'; + + my $data; # Data + + if ( ( $fileopt eq 'get' ) || ( $fileopt eq 'save' ) ) { + print STDERR "Retrieving $URL\n" if $main::opt_v; + $data = get_url( $URL, $UA ) + || return "Error getting data from $URL"; + if ( $fileopt eq 'save' ) { + print STDERR "Writing $URL to $filename\n" if $main::opt_v; + open( OUT, ">$filename" ) or die "Cannot create $filename"; + print OUT $data; + close OUT; + $fileopt = 'usefile'; + } + } + if ( $fileopt eq 'usefile' ) { + print STDERR "Reading data from $filename\n" if $main::opt_v; + open( FILE, $filename ) or die "Cannot read $filename"; + while () { $data .= $_; } + } + return $data; +} # get_fh sub format_date { - my $in = shift; - $in =~ s/^(\d+)(\d\d)\s(AM|PM)\s(\w+)\s(\w+)\s(\w+)\s0*(\d+)/$1:$2\L$3\E ($4) \u\L$5\E\E \u\L$6 $7,/; - $in =~ tr/\015//d; # \r - return $in; + my $in = shift; + $in =~ + s/^(\d+)(\d\d)\s(AM|PM)\s(\w+)\s(\w+)\s(\w+)\s0*(\d+)/$1:$2\L$3\E ($4) \u\L$5\E\E \u\L$6 $7,/; + $in =~ tr/\015//d; # \r + return $in; } + sub sent_caps { - my $in = shift; - $in = ucfirst(lc($in)); - $in =~ s/(\.\W+)(\w)/$1\U$2/g; # Proper sentance caps - return $in; + my $in = shift; + $in = ucfirst( lc($in) ); + $in =~ s/(\.\W+)(\w)/$1\U$2/g; # Proper sentance caps + return $in; } sub ucfirst_words { - my ($in) = @_; - return join " ", map ucfirst(lc($_)),(split /\s+/, $in); + my ($in) = @_; + return join " ", map ucfirst( lc($_) ), ( split /\s+/, $in ); } ######################################################################### @@ -396,183 +480,210 @@ sub ucfirst_words { ######################################################################### sub get_city_hourly { - my ($city,$state,$filename,$fileopt,$UA) = @_; - - # City and state in all caps please - # - $city = uc $city; - $state = uc $state; - - # work var - my ($fields,$line,$date,$time); - - # Get data - # -# my $URL = $URL_BASE . lc $state . '/hourly.html'; - my $URL = $URL_BASE . '?state=' . lc $state . '&prodtype=hourly'; - -#print STDERR "Getting data\n"; - my $data = get_data($URL,$filename,$fileopt,$UA); - #print STDERR "Got data\n"; - - # required for new data format: - $data =~ s/\012\s/\012/g; - - # Return error if there's an error - if ($data =~ /Error/) { - my %retHash; - $retHash{ERROR} = $data; - return \%retHash; - } - - $data =~ s/\015//g; # \r - - # Get line for our city from Data - # - foreach (split /\012/, $data) { - chomp; - $date = $_ if /^\s*(\d+)(\d\d)\s+(AM|PM)\s+(\w+)/; - $time = "$1:$2 $3" if (($1) && ($2) && ($3)); - $fields = $_ if /^CITY/; - $line = $_ if /^$city\s/; - - # Newest data seems to be at the top of the file - last if $line; - } - $date = format_date($date); - - # Set pack strings - # - my $fields_pack_str; - my $values_pack_str; - if ( ($fields =~ /TMP/) and ($fields =~ /\sDP\s/) ) { - #print STDERR "NEW FORMAT!\n"; - $fields_pack_str = - '@0 A15 @15 A9 @25 A3 @29 A2 @33 A2 @36 A8 @47 A5 @54 A7'; - $values_pack_str = - '@0 A15 @15 A8 @24 A4 @28 A4 @32 A3 @36 A8 @46 A7 @53 A8'; - } - else { - #print STDERR "OLD FORMAT!\n"; - $fields_pack_str = - '@0 A15 @15 A9 @24 A5 @29 A5 @35 A4 @39 A8 @47 A8 @55 A8'; - $values_pack_str = - '@0 A15 @15 A9 @24 A5 @29 A5 @34 A4 @39 A8 @47 A8 @55 A8'; - } - - # unpack gives error of the string is smaller than the unpack string - $line .= ' ' x (64 - length($line)) if length($line) < 64; - - return { } unless ( ($line) && ($fields) ); # Return ref to empty hash - - my @fields; - push @fields, 'DATE', 'TIME', unpack $fields_pack_str, $fields if $fields; - #'@0 A15 @15 A9 @24 A5 @29 A5 @35 A4 @39 A8 @47 A8 @55 A8', $fields if $fields; - my @values; - push @values, $date, $time, unpack $values_pack_str, $line; - #print STDERR "$line\n"; - #'@0 A15 @15 A9 @24 A5 @29 A5 @34 A4 @39 A8 @47 A8 @55 A8', $line; - - - - return { } if $values[3] eq 'NOT AVBL'; # Return ref to empty hash - - my %retValue; - foreach my $i (0..$#fields) { - # Convert odd fieldnames to standard - $fields[$i] = 'DEWPT' if $fields[$i] eq 'DP'; - $fields[$i] = 'TEMP' if $fields[$i] eq 'TMP'; - - # Assign value - $retValue{$fields[$i]} = $values[$i]; - } - - return \%retValue; - -} # get_city_hourly() + my ( $city, $state, $filename, $fileopt, $UA ) = @_; + + # City and state in all caps please + # + $city = uc $city; + $state = uc $state; + + # work var + my ( $fields, $line, $date, $time ); + + # Get data + # + my $zone = &get_zone( $ZONE_SEARCH_URL, "$city, $state" ); + my $URL = + $URL_BASE + . $zone + . '&issuedby=' + . $zone + . '&product=RWR&format=txt&version=1&glossary=0'; + + #print STDERR "Getting data from $URL\n"; + my $data = get_data( $URL, $filename, $fileopt, $UA ); + my $datalength = length($data); + + #print STDERR "Got data ($datalength)\n"; + + # Return error if there's an error + if ( $data =~ /Error/ ) { + my %retHash; + $retHash{ERROR} = $data; + return \%retHash; + } + + $data =~ s/\015//g; # \r + + #print STDERR "LOOKING FOR: " . $city . "\n"; + + # Get line for our city from Data + # + foreach ( split /\012/, $data ) { + chomp; + s/^\s*//; + $date = $_ if /^\s*(\d+)(\d\d)\s+(AM|PM)\s+(\w+)/; + $time = "$1:$2 $3" if ( ($1) && ($2) && ($3) ); + $fields = $_ if /^CITY/; + $line = $_ if /^$city/; + + #print STDERR "LINE: $line\n" if $line; + + # Newest data seems to be at the top of the file + last if $line; + } + $date = format_date($date); + + # Set pack strings + # + my $fields_pack_str; + my $values_pack_str; + if ( ( $fields =~ /TMP/ ) and ( $fields =~ /\sDP\s/ ) ) { + + #print STDERR "NEW FORMAT!\n"; + $fields_pack_str = + '@0 A15 @15 A9 @25 A3 @29 A2 @33 A2 @36 A8 @47 A5 @54 A7'; + $values_pack_str = + '@0 A15 @15 A8 @24 A4 @28 A4 @32 A3 @36 A8 @46 A7 @53 A8'; + } + else { + #print STDERR "OLD FORMAT!\n"; + $fields_pack_str = + '@0 A15 @15 A9 @24 A5 @29 A5 @35 A4 @39 A8 @47 A8 @55 A8'; + $values_pack_str = + '@0 A15 @15 A9 @24 A5 @29 A5 @34 A4 @39 A8 @47 A8 @55 A8'; + } + + # unpack gives error of the string is smaller than the unpack string + $line .= ' ' x ( 64 - length($line) ) if length($line) < 64; + + return {} unless ( ($line) && ($fields) ); # Return ref to empty hash + + my @fields; + push @fields, 'DATE', 'TIME', unpack $fields_pack_str, $fields if $fields; + + #'@0 A15 @15 A9 @24 A5 @29 A5 @35 A4 @39 A8 @47 A8 @55 A8', $fields if $fields; + my @values; + push @values, $date, $time, unpack $values_pack_str, $line; + + #print STDERR "$line\n"; + #'@0 A15 @15 A9 @24 A5 @29 A5 @34 A4 @39 A8 @47 A8 @55 A8', $line; + + return {} if $values[3] eq 'NOT AVBL'; # Return ref to empty hash + + my %retValue; + foreach my $i ( 0 .. $#fields ) { + + # Convert odd fieldnames to standard + $fields[$i] = 'DEWPT' if $fields[$i] eq 'DP'; + $fields[$i] = 'TEMP' if $fields[$i] eq 'TMP'; + + # Assign value + $retValue{ $fields[$i] } = $values[$i]; + } + + return \%retValue; + +} # get_city_hourly() sub print_current { - my ($city,$state,$filename,$fileopt,$UA) = @_; - my $in = process_city_hourly($city, $state, $filename, $fileopt,$UA); - return wrap('',' ',$in) + my ( $city, $state, $filename, $fileopt, $UA ) = @_; + my $in = process_city_hourly( $city, $state, $filename, $fileopt, $UA ); + return wrap( '', ' ', $in ); } - sub process_city_hourly { - my ($city,$state,$filename,$fileopt,$UA) = @_; - my $in = get_city_hourly($city, $state, $filename, $fileopt,$UA); - - $state = uc($state); - - return $in->{ERROR} if $in->{ERROR}; - $in->{CITY} or return "No data available"; - $in->{CITY} = ucfirst_words($in->{CITY}); - - my %sky = ( - 'SUNNY' => 'sunny skies', - 'MOSUNNY' => 'mostly sunny skies', - 'PTSUNNY' => 'partly sunny skies', - 'CLEAR' => 'clear weather', - 'DRIZZLE' => 'a drizzle', - 'CLOUDY' => 'cloudy skies', - 'MOCLDY' => 'mostly cloudy skies', - 'PTCLDY' => 'partly cloudy skies', - 'LGT RAIN' => 'light rain', - 'FRZ DRZL' => 'freezing drizzle', - 'FLURRIES' => 'flurries', - 'LGT SNOW' => 'light snow', - 'SNOW' => 'snow', - 'N/A' => 'N/A', - 'NOT AVBL' => '*not available*', - 'FAIR' => 'fair weather'); - - # Format the wind direction and speed - # - my %compass = qw/N north S south E east W west/; -# my $direction = join '',map $compass{$_},split(/(\w)\d/g, $in->{WIND}); - my $direction = join '',map $compass{$_},split(/(\w)\d/, $in->{WIND}); # Drop /g to avoid perl 5.8 warning - my ($speed) = ($in->{WIND} =~ /(\d+)/); - my ($gusts) = ($in->{WIND} =~ /G(\d+)/); - - if ($in->{WIND} eq 'CALM') { - $in->{WIND} = 'calm'; - } - else { - $in->{WIND} = "$direction at ${speed} mph"; - $in->{WIND} .= ", gusts up to ${gusts} mph" if $gusts; - } - - # Format relative humidity and ibarometric pressure - # - my $rh_pres; - if ($in->{RH}) { - $rh_pres = " The relative humidity was $in->{RH}\%"; - } - if ($in->{PRES}) { - my %rise_fall = qw/R rising S steady F falling/; -# bbw Avoide a perl 5.8 warning -# my $direction = join '',map $rise_fall{$_},split(/\d(\w)/g, $in->{PRES}); - my $direction = join '',map $rise_fall{$_},split(/\d(\w)/, $in->{PRES}); - $in->{PRES} =~ tr/RSF//d; - if ($rh_pres) { - $rh_pres .= ", and b"; - } - else { - $rh_pres .= " B"; - } - $rh_pres .= "arometric pressure was $direction from $in->{PRES} in"; - } - $rh_pres .= '.' if $rh_pres; + my ( $city, $state, $filename, $fileopt, $UA ) = @_; + my $in = get_city_hourly( $city, $state, $filename, $fileopt, $UA ); + + $state = uc($state); + + return $in->{ERROR} if $in->{ERROR}; + $in->{CITY} or return "No data available"; + $in->{CITY} = ucfirst_words( $in->{CITY} ); + + my %sky = ( + 'SUNNY' => 'sunny skies', + 'MOSUNNY' => 'mostly sunny skies', + 'PTSUNNY' => 'partly sunny skies', + 'CLEAR' => 'clear weather', + 'DRIZZLE' => 'a drizzle', + 'CLOUDY' => 'cloudy skies', + 'MOCLDY' => 'mostly cloudy skies', + 'PTCLDY' => 'partly cloudy skies', + 'LGT RAIN' => 'light rain', + 'FRZ DRZL' => 'freezing drizzle', + 'FLURRIES' => 'flurries', + 'LGT SNOW' => 'light snow', + 'SNOW' => 'snow', + 'N/A' => 'N/A', + 'NOT AVBL' => '*not available*', + 'FAIR' => 'fair weather' + ); + + # Format the wind direction and speed + # + my %compass = qw/N north S south E east W west/; + + # my $direction = join '',map $compass{$_},split(/(\w)\d/g, $in->{WIND}); + my $direction; + { + $direction = $in->{WIND}; + $direction =~ s/(.*?)G.*/$1/; # Remove gusts + $direction =~ s/\d//g; # Remove digits + if ($direction) { + $direction = $compass{$direction}; + } + } + my ($speed) = ( $in->{WIND} =~ /(\d+)/ ); + my ($gusts) = ( $in->{WIND} =~ /G(\d+)/ ); - # Format output sentence - # - my $out; - $out = "At $in->{TIME}, $in->{CITY}, $state conditions were "; - $out .= $sky{$in->{'SKY/WX'}} . " "; - $out .= "at $in->{TEMP}°F, wind was $in->{WIND}. $rh_pres\n"; - return $out; + if ( $in->{WIND} eq 'CALM' ) { + $in->{WIND} = 'calm'; + } + else { + $in->{WIND} = "$direction at ${speed} mph"; + $in->{WIND} .= ", gusts up to ${gusts} mph" if $gusts; + } -} # process_city_hourly() + # Format relative humidity and ibarometric pressure + # + my $rh_pres; + if ( $in->{RH} ) { + $rh_pres = " The relative humidity was $in->{RH}\%"; + } + if ( $in->{PRES} ) { + my %rise_fall = qw/R rising S steady F falling/; + + # my $direction = join '',map $rise_fall{$_},split(/\d(\w)/g, $in->{PRES}); + my $direction; + { + $direction = $in->{PRES}; + $direction = ( $direction =~ /.*(\w)$/ )[0]; + if ($direction) { + $direction = $rise_fall{$direction}; + } + } + $in->{PRES} =~ tr/RSF//d; + if ($rh_pres) { + $rh_pres .= ", and b"; + } + else { + $rh_pres .= " B"; + } + $rh_pres .= "arometric pressure was $direction from $in->{PRES} in"; + } + $rh_pres .= '.' if $rh_pres; + + # Format output sentence + # + my $out; + $out = "At $in->{TIME}, $in->{CITY}, $state conditions were "; + $out .= $sky{ $in->{'SKY/WX'} } . " "; + $out .= "at $in->{TEMP}°F, wind was $in->{WIND}. $rh_pres\n"; + return $out; + +} # process_city_hourly() # Autoload methods go after =cut, and are processed by the autosplit program. @@ -587,13 +698,13 @@ Geo::WeatherNOAA - Perl extension for interpreting the NOAA weather data =head1 SYNOPSIS use Geo::WeatherNOAA; - ($date,$warnings,$forecast,$coverage) = + ($date,$warnings,$forecast,$coverage) = process_city_zone('newport','ri','','get'); foreach $key (keys %$forecast) { - print "$key: $forecast->{$key}\n"; + print "$key: $forecast->{$key}\n"; } - + print process_city_hourly('newport news', 'va', '', 'get'); or @@ -653,65 +764,68 @@ if FILEOPT is "save" FILEOPT can be one of the following - - save - will get and save the data to FILENAME - - get - will retrieve new data (not store it) - - usefile - will not retrieve data from URL, - use FILENAME for data + - save + will get and save the data to FILENAME + - get + will retrieve new data (not store it) + - usefile + will not retrieve data from URL, + use FILENAME for data The fifth argument is for a user created LWP::UserAgent(3) which can -be configured to work with firewalls. See the LWP::UserAgent(3) manpage -for specific instructions. A basic example is like this: +be configured to work with firewalls. See the LWP::UserAgent(3) manpage +for specific instructions. A basic example is like this: my $ua = new LWP::UserAgent; $ua->proxy(['http', 'ftp'], 'http://proxy.my.net:8080/'); -If you merely wish to set your proxy data from environment -variables (as in $ua-env_proxy>), simply set - - $Geo::WeatherNOAA::proxy_from_env = 1; - +NOTE: You may also set the environment variable http_proxy +and the auto-generated LWP::UserAgent will use LWP::UserAgent::env_proxy(). +See LWP::UserAgent for more details. =item * process_city_zone(CITY,STATE,FILENAME,FILEOPT,LWP_UserAgent) Call CITY, STATE, FILENAME (explained above), FILEOPT(explained above), and UserAgent (Explained above). +Note that in August 2016 the NOAA site stopped using STATE as the defining +field, instead using 3-digit regional codes, available at: +http://forecast.weather.gov/product_sites.php?site=CRH&product=ZFP +All of the $state values should be the 3-digit code. + The return is a three element list containing a) a string of the date/time of the forecast, b) a reference to the list of warnings (if any), and c) a reference to the hash of forecast. I recommend calling it like this: - ($date, $warnings, $forecast, $coverage) = + ($date, $warnings, $forecast, $coverage) = process_city_zone('newport news','va', - '/tmp/va_zone.html', 'save'); + '/tmp/va_zone.html', 'save'); Explanation of this call, it returns: - $date - - Scalar of the date of the forecast + $date + - Scalar of the date of the forecast - $warnings - - Reference to the warnings list - - EXAMPLE: - foreach (@$warnings) { print; } - - $forecast - - Reference to the forecast KEY, VALUE pairs - - EXAMPLE: - foreach $key (keys %$forecast) { - print "$key: $forecast->{$key}\n"; - } + $warnings + - Reference to the warnings list + - EXAMPLE: + foreach (@$warnings) { print; } - $coverage - - Scalar of the coverage area of the forecast + $forecast + - Reference to the forecast KEY, VALUE pairs + - EXAMPLE: + foreach $key (keys %$forecast) { + print "$key: $forecast->{$key}\n"; + } + + $coverage + - Scalar of the coverage area of the forecast =item * get_city_zone(CITY,STATE,FILENAME,FILEOPT,LWP_UserAgent) This sub is to get the block of data from the data source, which is -chosen with the FILEOPTswitch. +chosen with the FILEOPTswitch. =item * get_city_hourly(CITY,STATE,FILENAME,FILEOPT,LWP_UserAgent) @@ -722,7 +836,7 @@ and UserAgent. This function returns a reference to a hash containing the data. It -Same FILEOPTand LWP_UserAgent from above, and process the +Same FILEOPTand LWP_UserAgent from above, and process the current weather data into an english sentence. =back @@ -740,3 +854,4 @@ http://www.seva.net/~msolomon/ perl(1), Tie::IxHash(3), LWP::Simple(3), LWP::UserAgent(3). =cut +