From f5a70fa8faa2a8c72172be83ce7024f3bba02d78 Mon Sep 17 00:00:00 2001 From: Pmatis Date: Mon, 30 Sep 2013 01:27:22 -0400 Subject: [PATCH 01/18] Add PA zone type of 'object', clean up code, enhance to allow for mixed zone types, tested X10, xPL, xAP, object and wdio. xPL and xAP were only tested to send to the designated IP address - verified with netcat on target computer. --- code/common/pa_control.pl | 53 +++--- lib/PAobj.pm | 358 ++++++++++++++++++++++++-------------- lib/read_table_A.pl | 92 +++++----- 3 files changed, 305 insertions(+), 198 deletions(-) diff --git a/code/common/pa_control.pl b/code/common/pa_control.pl index 514d2348b..fa35a6eb7 100644 --- a/code/common/pa_control.pl +++ b/code/common/pa_control.pl @@ -13,20 +13,20 @@ Centralized control of various PA zone types. Author: - Steve Switzer + Steve Switzer (Pmatis) steve@switzerny.org License: This free software is licensed under the terms of the GNU public license. Requires: - PAobj.pm from the lib directory - pa.mht, or other mht file listing all of your PA zones. See end of file for ezample + PAobj.pm from the lib directory + pa.mht, or other mht file listing all of your PA zones. See end of file for ezample Special Thanks to: Bruce Winter - MH Jason Sharpee - Example Perl Modules to "steal",learn from. :) - Ross Towbin - Providing me with code snippets for "setting weeder with more than 8 ports" + Ross Towbin - Providing me with code snippets for "setting weeder with more than 8 ports" @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ =cut @@ -34,15 +34,11 @@ use PAobj; #noloop=start -my $pa_port = $config_parms{pa_port}; my $pa_delay = $config_parms{pa_delay}; -my $pa_type = $config_parms{pa_type}; my $pa_timer = $config_parms{pa_timer}; -$pa_port = 'weeder' unless $pa_port; $pa_delay = 0.5 unless $pa_delay; -$pa_type = 'wdio' unless $pa_type; $pa_timer = 60 unless $pa_timer; -$pactrl = new PAobj($pa_type,$pa_port); +$pactrl = new PAobj(); $pactrl->set_delay($pa_delay); $v_pa_test = new Voice_Cmd('test pa'); $v_pa_speakers = new Voice_Cmd('speakers [on,off]'); @@ -58,8 +54,8 @@ if (said $v_pa_test) { my $state = $v_pa_test->{state}; $v_pa_test->respond('app=pa Testing PA...'); - #speak "nolog=1 rooms=all mode=unmuted volume=100 Hello. This is a PA system test."; - speak "nolog=1 rooms=downstairs mode=unmuted volume=100 Hi!"; + speak "nolog=1 rooms=all mode=unmuted volume=80 Hello. This is a PA system test."; + #speak "nolog=1 rooms=downstairs mode=unmuted volume=100 Hi!"; } # turn all speakers on/off @@ -84,15 +80,16 @@ sub pa_control_stub { return if $mode eq 'mute' or $mode eq 'offline'; my $rooms = $parms{rooms}; - print "pa_stub db: rooms=$rooms, mode=$mode\n" if $Debug{pa}; - my $results = $pactrl->set($rooms,ON,$mode); - print "PA set results: $results\n" if $Debug{pa}; + print "PA: control_stub: rooms=$rooms, mode=$mode\n" if $Debug{pa}; + my $results = $pactrl->set($rooms,ON,$mode,%parms); + print "PA: control_stub set results: $results\n" if $Debug{pa}; set $pa_speaker_timer $pa_timer if $results; } #Turn off speakers when MH says it's done speaking/playing if (state_now $mh_speakers eq OFF) { unset $pa_speaker_timer; + print "PA: Turning speakers off\n" if $Debug{pa}; $pactrl->set('allspeakers',OFF,'normal'); } @@ -100,9 +97,8 @@ sub pa_control_stub { $pa_speaker_timer = new Timer; set $pa_speaker_timer 60 if state_now $mh_speakers eq ON; if (expired $pa_speaker_timer) { -#print "Timer expired\n"; + print "PA: Timer expired.\n" if $Debug{pa}; set $mh_speakers OFF; - #$pactrl->set('allspeakers',OFF,'normal'); } =begin comment @@ -111,18 +107,25 @@ sub pa_control_stub { Example pa.mht file: # -# Type Address Name Groups Serial Name Other +#Type Address Name Groups Serial Other # - -PA, AA, kitchen, all|default|mainfloor, weeder, wdio -PA, AB, server, all|basement, weeder, wdio -PA, AG, master, all|default|upstairs, weeder, wdio +PA, AA, kitchen, all|default|mainfloor, weeder, wdio +PA, AB, server, all|basement, weeder, wdio +PA, AG, master, all|default|upstairs, weeder2, wdio_old +PA, B12, garage, all|outside, , X10 +PA, objname, living, all|mainfloor, , object +PA, 192.168.0.1,family, all|mainfloor, , xap +PA, 192.168.0.2,dining, all|mainfloor, , xpl Type: "PA", constant. This must be there. -Address: 2 characters. First character is the weeder address, the second is the pin - if the command to turn on the pin you want is: BHC, then the Address is: BC +Address: Address or Object name. + If Other is "object", then this should be an object name that can accept an ON or OFF + For Weeder, 2 characters. First character is the weeder address, the second is the pin + if the command to turn on the pin you want is: BHC, then the Address is: BC + For X10, the X10 address of the (likely) relay device. + For xAP and xPL, use the IP address or hostname of the target device. Name: Give a name to the pa zone, usually the room name. You use these in the speak and play commands with rooms=. @@ -135,11 +138,11 @@ sub pa_control_stub { rooms= parm. If no rooms are specified, all zones in the "default" group will be used. -Serial Name: The name of the serial port that you use for communcating to the IO device. +Serial: The name of the serial port that you use for communcating to the IO device. The default is "weeder". Note that this can be changed with an INI parm. Other: Optional. Sets the type of PA control. Defaults to 'wdio'. Available options are: - wdio,wdio_old,X10 + wdio,wdio_old,X10,xpl,xap,object @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ =cut diff --git a/lib/PAobj.pm b/lib/PAobj.pm index 2c230ae2e..34299cc86 100644 --- a/lib/PAobj.pm +++ b/lib/PAobj.pm @@ -5,7 +5,6 @@ Example initialization: use PAobj; - $paobj = new PAobj('wdio','weeder'); Enable pa_control.pl using "Common code activation" in the IA5 interface to activate an instance of this PA code. @@ -43,18 +42,11 @@ sub last_char sub new { - my ($class,$pa_type,$pa_port) = @_; + my ($class) = @_; my $self={}; bless $self,$class; - $pa_type = 'wdio' unless $pa_type; - $pa_port = 'weeder' unless $pa_port; - - $$self{pa_type} = $pa_type; - $$self{pa_type_init} = 0; - - $$self{pa_port} = $pa_port; $$self{pa_delay} = 0.5; return $self; @@ -63,63 +55,84 @@ sub new sub init { my ($self) = @_; %pa_zone_types=(); - my $ref = &::get_object_by_name("pa_allspeakers"); - if (!$ref) { + my $ref2 = &::get_object_by_name("pa_allspeakers"); + if (!$ref2) { &::print_log("\n\nWARNING! PA Zones were not found! Your *.mht file probably doesn't list the PA zones correctly.\n\n"); return 0; } $self->check_group('default'); -# my @speakers = $self->get_speakers('allspeakers'); -# for my $room (@speakers) { -# my $paobjname = "pa_$room"; -# my $ref = &::get_object_by_name($paobjname); -# my $pa_zone_type = $pa_zone_type_by_zone{$paobjname}; -# print "db INIT room=$room, zonetype=$pa_zone_type\n"; -# $pa_zone_types{$pa_zone_type}++ unless $pa_zone_types{$$ref{pa_type}}; -# } - + my @speakers = $self->get_speakers('allspeakers'); + my (@speakers_wdio,@speakers_x10,@speakers_obj,@speakers_xap,@speakers_xpl); - if ($$self{pa_type} =~ /^wdio/i) { - $self->init_weeder(); + for my $room (@speakers) { + my $ref = &::get_object_by_name("pa_$room"); + my $type = $ref->get_type(); + print "PAObj: init: room=$room\n"; + print "PAObj: init: room=$room, zonetype=$type\n"; + $pa_zone_types{$type}++ unless $pa_zone_types{$type}; + + if($type eq 'wdio') { + push(@speakers_wdio,$room); + } + if($type eq 'x10') { + push(@speakers_x10,$room); + } + if($type eq 'xap') { + push(@speakers_xap,$room); + } + if($type eq 'xpl') { + push(@speakers_xpl,$room); + } + if($type eq 'object') { + push(@speakers_obj,$room); + } + } + + print "PAObj: speakers_wdio: $#speakers_wdio\n" if $main::Debug{pa}; + print "PAObj: speakers_x10: $#speakers_x10\n" if $main::Debug{pa}; + print "PAObj: speakers_xap: $#speakers_xap\n" if $main::Debug{pa}; + print "PAObj: speakers_xpl: $#speakers_xpl\n" if $main::Debug{pa}; + print "PAObj: speakers_obj: $#speakers_obj\n" if $main::Debug{pa}; + + if ($#speakers_wdio > -1) { + $self->init_weeder(@speakers_wdio); return 0 unless %pa_weeder_max_port; - } elsif (lc $$self{pa_type} eq 'x10') { - print "x10 PA type initialized...\n" if $main::Debug{pa}; - } elsif (lc $$self{pa_type} eq 'xap') { - print "xAP PA type initialized...\n" if $main::Debug{pa}; - } elsif (lc $$self{pa_type} eq 'xpl') { - print "xPL PA type initialized...\n" if $main::Debug{pa}; - } else { - &::print_log("\n\nWARNING! Unrecognized PA type of \"$$self{pa_type}\". PA code probably will not work.\n\n"); - return 0; + } + if ($pa_zone_types{'x10'}) { + print "PAObj: x10 PA type initialized...\n" if $main::Debug{pa}; + } + if ($pa_zone_types{'xap'}) { + print "PAObj: xAP PA type initialized...\n" if $main::Debug{pa}; + } + if ($pa_zone_types{'xpl'}) { + print "PAObj: xPL PA type initialized...\n" if $main::Debug{pa}; } return 1; } sub init_weeder { - my ($self) = @_; + my ($self,@speakers) = @_; my (%weeder_ref,%weeder_max); - my @speakers = $self->get_speakers('allspeakers'); undef %pa_weeder_max_port; for my $room (@speakers) { - print "db init PA Room loaded: $room\n" if $main::Debug{pa}; - my $ref = &::get_object_by_name("pa_$room"); + print "PAObj: init PA Room loaded: $room\n" if $main::Debug{pa}; + my $ref = &::get_object_by_name('pa_' . $room . '_obj'); $ref->{state} = 'off'; - print "db pa type: $$self{pa_type}\n" if $main::Debug{pa}; my ($card,$id); ($card,$id) = $ref->{id_by_state}{'on'} =~ /^D?(.)H(.)/s; $weeder_ref{$card} = '' unless $weeder_ref{$card}; $weeder_ref{$card} .= $id; - print "db init card: $card, id: $id, Room: $room, List: $weeder_ref{$card}\n" if $main::Debug{pa}; + print "PAObj: init card: $card, id: $id, Room: $room, List: $weeder_ref{$card}\n" if $main::Debug{pa}; } for my $card ('A' .. 'P','a' .. 'p') { if ($weeder_ref{$card}) { my $data = $weeder_ref{$card}; $weeder_max{$card}=$self->last_char($data); - print "\ndb init weeder board=$card, ports=$data, max port=" . $weeder_max{$card} . "\n" if $main::Debug{pa}; + print "\nPAObj: init weeder board=$card, ports=$data, max port=" . $weeder_max{$card} . "\n" if $main::Debug{pa}; } } %pa_weeder_max_port = %weeder_max; @@ -127,101 +140,147 @@ sub init_weeder sub set { - my ($self,$rooms,$state,$mode) = @_; + my ($self,$rooms,$state,$mode,%voiceparms) = @_; my $results = 0; - print "db: pa_type: $$self{pa_type}, delay: $$self{pa_delay}\n" if $main::Debug{pa}; - - print "pa db: set,mode: " . $mode . "\n" if $main::Debug{pa}; - print "pa db: set,rooms: " . $rooms . "\n" if $main::Debug{pa}; + print "PAObj: delay: $$self{pa_delay}\n" if $main::Debug{pa}; + print "PAObj: set,mode: " . $mode . "\n" if $main::Debug{pa}; + print "PAObj: set,rooms: " . $rooms . "\n" if $main::Debug{pa}; my @speakers = $self->get_speakers($rooms); @speakers = $self->get_speakers('') if $#speakers == -1; @speakers = $self->get_speakers_speakable($mode,@speakers); - $results = $self->set_weeder($state,@speakers) if substr(lc $$self{pa_type}, 0, 4) eq 'wdio'; - $results = $self->set_x10($state,@speakers) if lc $$self{pa_type} eq 'x10'; -# $results = $self->set_xap($state,@speakers) if lc $$self{pa_type} eq 'xap'; -# $results = $self->set_xpl($state,@speakers) if lc $$self{pa_type} eq 'xpl'; + + my (@speakers_wdio,@speakers_x10,@speakers_obj,@speakers_xap,@speakers_xpl); + + for my $room (@speakers) { + my $ref = &::get_object_by_name("pa_$room"); + my $type = lc $ref->get_type(); + if($type eq 'wdio' || $type eq 'wdio_old') { + print "PAObj: speakers_wdio: Adding $room\n" if $main::Debug{pa}; + push(@speakers_wdio,$room); + } + if($type eq 'x10') { + print "PAObj: speakers_x10: Adding $room\n" if $main::Debug{pa}; + push(@speakers_x10,$room); + } + if($type eq 'xap') { + print "PAObj: speakers_xap: Adding $room\n" if $main::Debug{pa}; + push(@speakers_xap,$room) if $state eq 'on'; #Only need to send if speech is starting + } + if($type eq 'xpl') { + print "PAObj: speakers_xpl: Adding $room\n" if $main::Debug{pa}; + push(@speakers_xpl,$room) if $state eq 'on'; #Only need to send if speech is starting + } + if($type eq 'object') { + print "PAObj: speakers_object: Adding $room\n" if $main::Debug{pa}; + push(@speakers_obj,$room); + } + } + + print "PAObj: speakers_wdio: $#speakers_wdio\n" if $main::Debug{pa}; + print "PAObj: speakers_x10: $#speakers_x10\n" if $main::Debug{pa}; + print "PAObj: speakers_xap: $#speakers_xap\n" if $main::Debug{pa}; + print "PAObj: speakers_xpl: $#speakers_xpl\n" if $main::Debug{pa}; + print "PAObj: speakers_obj: $#speakers_obj\n" if $main::Debug{pa}; + + #TODO: Properly handle $results across multiple types + #TODO: Break up the wdio zones based on serial port, in case there are more than one. + $results = $self->set_weeder($state,'weeder',@speakers_wdio) if $#speakers_wdio > -1; + $results = $self->set_x10($state,@speakers_x10) if $#speakers_x10 > -1; + $results = $self->set_xap($state,\@speakers_xap,\%voiceparms) if $#speakers_xap > -1; + $results = $self->set_xpl($state,\@speakers_xpl,\%voiceparms) if $#speakers_xpl > -1; + $results = $self->set_obj($state,@speakers_obj) if $#speakers_obj > -1; + select undef, undef, undef, $$self{pa_delay} if $results; return $results; } -sub set_x10 +sub set_obj { my ($self,$state,@speakers) = @_; - my $x10_list; - my $pa_x10_hc; - for my $room (@speakers) { - my $ref = &::get_object_by_name("pa_$room"); + print "PAObj: set_obj: " . $room . " / " . $state . "\n" if $main::Debug{pa}; + my $ref = &::get_object_by_name("pa_$room"); if ($ref) { - $ref->{state} = $state; - my ($id) = $ref->{x10_id}; - print "db pa set_x10 id: $id, Room: $room\n" if $main::Debug{pa}; - $pa_x10_hc = substr($id,1,1) unless $pa_x10_hc; - $x10_list .= substr($id,1,2); - } + $ref->set($state); + } } +} - $self->print_speaker_states() if $main::Debug{pa}; - $x10_list = 'X' . $x10_list . $pa_x10_hc; - $x10_list .= ($state eq 'on') ? 'J':'K'; - print "db pa x10 cmd: $x10_list\n" if $main::Debug{pa}; +sub set_x10 +{ + my ($self,$state,@speakers) = @_; + my ($x10_list,$pa_x10_hc,$ref,$refobj); + + for my $room (@speakers) { + print "PAObj: set_x10: " . $room . " / " . $state . "\n" if $main::Debug{pa}; + $ref = &::get_object_by_name('pa_'.$room); + $refobj = &::get_object_by_name('pa_'.$room.'_obj'); + if ($refobj && $ref) { + my ($id) = $ref->get_address(); + print "PAObj: set_x10 ID: $id, State: $state, Room: $room\n" if $main::Debug{pa}; + $refobj->set($state); + } + } } sub set_xap { - my ($self,$rooms,$mode,%voiceparms) = @_; - my @speakers = $self->get_speakers($rooms); - @speakers = $self->get_speakers('') if $#speakers == -1; - @speakers = $self->get_speakers_speakable($mode, @speakers); + my ($self,$state,$param1,$param2) = @_; + my @speakers = @$param1; + my %voiceparms = %$param2; + return unless $#speakers > -1; for my $room (@speakers) { - my $ref = &::get_object_by_name("paxap_$room"); + print "PAObj: set_xap: " . $room . " / " . $state . "\n" if $main::Debug{pa}; + my $ref = &::get_object_by_name('pa_'.$room.'_obj'); if ($ref) { - $ref->send_message($ref->target_address, $ref->class_name => {say => $voiceparms{text}, voice => $voiceparms{voice} }); - print "db pa xap cmd: $ref->{object_name} is sending voice text: $voiceparms{text}\n" if $main::Debug{pa}; + $ref->send_message($ref->target_address, $ref->class_name => {say => $voiceparms{text}, volume => $voiceparms{volume}, mode => $voiceparms{mode}, voice => $voiceparms{voice} }); + print "PAObj: xap cmd: $ref->{object_name} is sending voice text: $voiceparms{text}\n" if $main::Debug{pa}; } else { - print "unable to locate object: paxap_$room\n" if $main::Debug{pa}; + print "PAObj: Unable to locate object for: pa_$room\n" if $main::Debug{pa}; } } } sub set_xpl { - my ($self,$rooms,$mode,%voiceparms) = @_; - my @speakers = $self->get_speakers($rooms); - @speakers = $self->get_speakers('') if $#speakers == -1; - @speakers = $self->get_speakers_speakable($mode, @speakers); + my ($self,$state,$param1,$param2) = @_; + my @speakers = @$param1; + my %voiceparms = %$param2; + return unless $#speakers > -1; for my $room (@speakers) { - my $ref = &::get_object_by_name("paxpl_$room"); - if ($ref) { - my $max_length = $::config_parms{"paxpl_$room" . "_maxlength"}; + print "PAObj: set_xpl: " . $room . " / " . $state . "\n" if $main::Debug{pa}; + my $ref = &::get_object_by_name('pa_'.$room.'_obj'); + if ($ref) { + my $max_length = $::config_parms{"pa_$room" . "_maxlength"}; $max_length = 0 unless $max_length; my $text = $voiceparms{text}; if ($max_length) { $text = substr($text, 0, $max_length) if $max_length < length($text); } - $ref->send_cmnd($ref->class_name => {speech => $text, voice => $voiceparms{voice} }); - print "db pa xpl cmd: $ref->{object_name} is sending voice text: $voiceparms{text}\n" if $main::Debug{pa}; - } else { - print "unable to locate object: paxpl_$room\n" if $main::Debug{pa}; - } + $ref->send_cmnd($ref->class_name => {speech => $text, voice => $voiceparms{voice}, volume => $voiceparms{volume}, mode => $voiceparms{mode} }); + print "PAObj: set_xpl: $ref->{object_name} is sending voice text: $voiceparms{text}\n" if $main::Debug{pa}; + } else { + print "PAObj: Unable to locate object for: pa_$room\n" if $main::Debug{pa}; + } } } sub set_weeder { - my ($self,$state,@speakers) = @_; + my ($self,$state,$weeder_port,@speakers) = @_; my %weeder_ref; my $weeder_command=''; my $command=''; for my $room (@speakers) { - my $ref = &::get_object_by_name("pa_$room"); - if ($ref) { + print "PAObj: set_weeder: " . $room . " / " . $state . "\n" if $main::Debug{pa}; + my $ref = &::get_object_by_name('pa_'.$room.'_obj'); + if ($ref) { $ref->{state} = $state; my ($card,$id) = $ref->{id_by_state}{'on'} =~ /^D?(.)H(.)/s; $weeder_ref{$card}='' unless $weeder_ref{$card}; $weeder_ref{$card} .= $id; - print "card: $card, id: $id, Room: $room\n" if $main::Debug{pa}; - } + print "PAObj: card: $card, id: $id, Room: $room\n" if $main::Debug{pa}; + } } $self->print_speaker_states() if $main::Debug{pa}; @@ -234,10 +293,10 @@ sub set_weeder $weeder_command .= "$command\\r" if $command; } } - return 0 unless $command; - print "sending $weeder_command to the weeder card(s)\n" if $main::Debug{pa}; + return 0 unless $weeder_command; + print "PAObj: Sending $weeder_command to the weeder card(s)\n" if $main::Debug{pa}; $weeder_command =~ s/\\r/\r/g; - &Serial_Item::send_serial_data($$self{pa_port}, $weeder_command) if $main::Serial_Ports{$$self{pa_port}}{object}; + &Serial_Item::send_serial_data($weeder_port, $weeder_command) if $main::Serial_Ports{$weeder_port}{object}; return 1; } @@ -255,7 +314,7 @@ sub get_weeder_string for $bit ('A' .. $pa_weeder_max_port{$card}) { $id = $card . 'L' . $bit; - $id = "D$id" if $$self{pa_type} eq 'wdio_old'; + $id = "D$id" if $$self{pa_type} eq 'wdio_old'; #TODO: Find way to implement this with new code my $ref = &Device_Item::item_by_id($id); if ($ref) { $state = $ref->{state}; @@ -265,7 +324,7 @@ sub get_weeder_string } $bit_flag = ($state eq 'on') ? 1 : 0; # get 0 or 1 - print "db get_weeder_string card: $card, bit=$bit state=$bit_flag\n" if $main::Debug{pa}; + print "PAObj: get_weeder_string card: $card, bit=$bit state=$bit_flag\n" if $main::Debug{pa}; $byte_code += ($bit_flag << $bit_counter); # get bit in byte position if ($bit_counter++ >= 3) { @@ -275,13 +334,13 @@ sub get_weeder_string } } - # we have to do this again -- in case we don't have bits on a byte boundry + # we have to do this again -- in case we don't have bits on a byte boundary if ($bit_counter > 0) { # pre-pend our string with the new value $weeder_code = $decimal_to_hex{$byte_code} . $weeder_code; } - if ($$self{pa_type} eq 'wdio_old') { + if ($$self{pa_type} eq 'wdio_old') { #TODO: Find way to implement this with new code $card = "D$card"; $weeder_code = 'h' . $weeder_code; } @@ -293,7 +352,7 @@ sub get_speakers my ($self,$rooms) = @_; my @pazones; - print "pa db: get_speakers,rooms: " . $rooms . "\n" if $main::Debug{pa}; + print "PAObj: get_speakers,rooms: " . $rooms . "\n" if $main::Debug{pa}; if ($::mh_speakers->{rooms}) { $rooms = $::mh_speakers->{rooms}; $::mh_speakers->{rooms} = ''; @@ -305,28 +364,22 @@ sub get_speakers no strict 'refs'; my $ref = &::get_object_by_name("pa_$room"); if ($ref) { - print "pa db: name=$ref->{object_name}\n" if $main::Debug{pa}; + print "PAObj: name=$ref->{object_name}\n" if $main::Debug{pa}; if (UNIVERSAL::isa($ref,'Group')) { - print "pa db: It's a group!\n" if $main::Debug{pa}; + print "PAObj: It's a group!\n" if $main::Debug{pa}; for my $grouproom ($ref->list) { $grouproom = $grouproom->get_object_name; $grouproom =~ s/^\$pa_//; - $grouproom =~ s/^\$paxpl_//; - $grouproom =~ s/^\$paxap_//; - print "pa db: - member: $grouproom\n" if $main::Debug{pa}; + $grouproom =~ s/^\$paxpl_//; + $grouproom =~ s/^\$paxap_//; + print "PAObj: - member: $grouproom\n" if $main::Debug{pa}; push(@pazones, $grouproom); } } else { push(@pazones, $room); } - } elsif (lc $$self{pa_type} eq 'xpl') { - $ref = &::get_object_by_name("paxpl_$room"); - push(@pazones, $room) if $ref; - } elsif (lc $$self{pa_type} eq 'xap') { - $ref = &::get_object_by_name("paxap_$room"); - push(@pazones, $room) if $ref; } else { - &::print_log("WARNING: PA zone of '$room' not found!"); + &::print_log("PAObj: WARNING: PA zone of '$room' not found!"); } } return @pazones; @@ -335,13 +388,13 @@ sub get_speakers sub check_group { my ($self,$group) = @_; - print "db check group=$group\n" if $main::Debug{pa}; + print "PAObj: check group=$group\n" if $main::Debug{pa}; my $ref = &::get_object_by_name("pa_$group"); if (!$ref) {print "Error! Group does not exist: $group\n"; return;} my @list = $ref->list; - print "db check group=$group, list=$#list\n" if $main::Debug{pa}; + print "PAObj: check group=$group, list=$#list\n" if $main::Debug{pa}; if ($#list == -1) { - print "db check populating group: $group!\n" if $main::Debug{pa}; + print "PAObj: check populating group: $group!\n" if $main::Debug{pa}; for my $room ($self->get_speakers('allspeakers')) { my $ref2 = &::get_object_by_name("pa_$room"); $ref->add($ref2); @@ -358,17 +411,14 @@ sub get_speakers_speakable return @pazones if $mode eq 'mute' or $mode eq 'offline'; for my $room (@zones) { - my $ref = &::get_object_by_name("pa_$room"); - $ref = &::get_object_by_name("paxpl_$room") if lc $$self{pa_type} eq 'xpl'; - $ref = &::get_object_by_name("paxap_$room") if !$ref and $$self{pa_type} eq 'xap'; - print "pa db: ref=$ref\n" if $main::Debug{pa}; - print "pa db: name=$ref->{object_name}\n" if $main::Debug{pa}; + my $ref = &::get_object_by_name("pa_$room"); + print "PAObj: speakable: name=$ref->{object_name}\n" if $main::Debug{pa}; if ($ref->{sleeping} == 0) { $ref->{mode} = 'normal' unless $ref->{mode}; my $gss_mode = $ref->{mode}; if ($gss_mode ne 'sleeping' && ($gss_mode eq 'normal' || $mode eq 'unmuted')) { push(@pazones,$room); - print "pa db: pushing $room into pazones array:$#pazones\n" if $main::Debug{pa}; + print "PAObj: speakable: Pushing $room into pazones array:$#pazones\n" if $main::Debug{pa}; } } } @@ -388,20 +438,76 @@ sub print_speaker_states my ($ref,$room); for my $speaker (@speakers) { $ref = &::get_object_by_name("pa_$speaker"); - $ref = &::get_object_by_name("paxpl_$speaker") if !$ref and $$self{pa_type} eq 'xpl'; - $ref = &::get_object_by_name("paxap_$speaker") if !$ref and $$self{pa_type} eq 'xap'; $room = $ref->{object_name}; - if ($$self{pa_type} eq 'xpl') { - $room =~ s/^\$paxpl_//; - } elsif ($$self{pa_type} eq 'xap') { - $room =~ s/^\$paxap_//; - } else { - $room =~ s/^\$pa_//; - } - print "db name=$room, state=$ref->{state}\n" if $main::Debug{pa}; + $room =~ s/^\$pa_//; + print "PAObj: name=$room, state=$ref->{state}\n" if $main::Debug{pa}; } } +package PAobj_zone; + +@PAobj_zone::ISA = ('Generic_Item'); + +sub last_char +{ + my ($self,$string) = @_; + my @chars=split(//, $string); + return((sort @chars)[-1]); +} + +#Type Address Name Groups Serial Other +sub new +{ + my ($class,$paz_address,$paz_name,$paz_groups,$paz_serial,$paz_other) = @_; + my $self={}; + + bless $self,$class; + + $$self{name} = $paz_name; + $$self{address} = $paz_address; + $$self{groups} = $paz_groups; + $$self{serial} = $paz_serial; + $$self{other} = $paz_other; + + return $self; +} + +sub init +{ + my ($self) = @_; +} + +sub get_address +{ + my ($self) = @_; + return $$self{address}; +} + +sub get_name +{ + my ($self) = @_; + return $$self{name}; +} + +sub get_groups +{ + my ($self) = @_; + return $$self{groups}; +} + +sub get_serial +{ + my ($self) = @_; + return $$self{serial}; +} + +sub get_type +{ + my ($self) = @_; + return $$self{other}; +} + + 1; diff --git a/lib/read_table_A.pl b/lib/read_table_A.pl index 93ca9a499..0d197677e 100644 --- a/lib/read_table_A.pl +++ b/lib/read_table_A.pl @@ -22,7 +22,7 @@ sub read_table_init_A { %groups=(); %objects=(); %packages=(); - %addresses=(); + %addresses=(); } sub read_table_A { @@ -517,65 +517,63 @@ sub read_table_A { } elsif ($type eq "PA") { require 'PAobj.pm'; - my $pa_type; - ($address, $name, $grouplist, $other, $pa_type, @other) = @item_info; - # $other is being used as the serial name + my ($pa_type, $serial); + ($address, $name, $grouplist, $serial, $pa_type, @other) = @item_info; $pa_type = 'wdio' unless $pa_type; if( ! $packages{PAobj}++ ) { # first time for this object type? $code .= "my (%pa_weeder_max_port,%pa_zone_types,%pa_zone_type_by_zone);\n"; } -# if ($config_parms{pa_type} ne $pa_type) { - if(1==0) { - print "ERROR! INI parm \"pa_type\"=$main::config_parms{pa_type}, but PA item $name is a type of $pa_type. Skipping PA zone.\n - r=$record\n"; - return; - } else { -# $name = "pa_$name"; - - $grouplist = "|$grouplist|allspeakers"; - $grouplist =~ s/\|\|/\|/g; - $grouplist =~ s/\|/\|pa_/g; - $grouplist =~ s/^\|//; - $grouplist .= '|hidden'; + $code .= sprintf "\n\$%-35s = new PAobj_zone('%s','%s','%s','%s','%s');\n","pa_$name", $address, $name, $grouplist, $serial, $pa_type; + $name = "pa_$name"; - if ($pa_type =~ /^wdio/i) { - $name = "pa_$name"; - # AHB / ALB or DBH / DBL - $address =~ s/^(\S)(\S)$/$1H$2/;# if $pa_type eq 'wdio'; - $address = "D$address" if $pa_type eq 'wdio_old'; -# $address =~ s/^(\S)(\S)$/DBH$2/ if $pa_type eq 'wdio_old'; - $code .= sprintf "\n\$%-35s = new Serial_Item('%s','on','%s');\n",$name,$address,$other; -# $code .= sprintf "\n\$\$%s{pa_type} = '%s';\n",$name,$pa_type; + $grouplist = "|$grouplist|allspeakers"; + $grouplist =~ s/\|\|/\|/g; + $grouplist =~ s/\|/\|pa_/g; + $grouplist =~ s/^\|//; + $grouplist .= '|hidden'; -# $code .= sprintf "\$pa_zone_types{%s}++ unless \$pa_zone_types{%s};\n",$pa_type,$pa_type; -# $code .= sprintf "\$pa_zone_type_by_zone{%s} = '%s';\n",$name,$pa_type; + if ($pa_type =~ /^wdio/i) { + # AHB / ALB or DBH / DBL + $address =~ s/^(\S)(\S)$/$1H$2/;# if $pa_type eq 'wdio'; + $address = "D$address" if $pa_type eq 'wdio_old'; + $code .= sprintf "\$%-35s = new Serial_Item('%s','on','%s');\n",$name.'_obj',$address,$serial; - $address =~ s/^(\S{1,2})H(\S)$/$1L$2/; -# $address =~ s/^(\S)H(\S)$/$1L$2/ if $pa_type eq 'wdio'; -# $address =~ s/^D(\S)H(\S)$/D$1L$2/ if $pa_type eq 'wdio_old'; - $code .= sprintf "\$%-35s -> add ('%s','off');\n",$name,$address; + $address =~ s/^(\S{1,2})H(\S)$/$1L$2/; + $code .= sprintf "\$%-35s -> add ('%s','off');\n",$name.'_obj',$address; - $object = ''; - } elsif (lc $pa_type eq 'x10') { - $name = "pa_$name"; - $other = join ', ', (map {"'$_'"} @other); # Quote data - $object = "X10_Appliance('$address', $other)"; - } elsif (lc $pa_type eq 'xap') { - $name = "paxap_$name"; - $code .= sprintf "\n\$%-35s = new xAP_Item('%s');\n",$name,$address; - $code .= sprintf "\$%-35s -> target_address('%s');\n",$name,$address; - $code .= sprintf "\$%-35s -> class_name('%s');\n",$name,$other; - } elsif (lc $pa_type eq 'xpl') { - $name = "paxpl_$name"; - $code .= sprintf "\n\$%-35s = new xPL_Item('%s');\n",$name,$address; - $code .= sprintf "\$%-35s -> target_address('%s');\n",$name,$address; - $code .= sprintf "\$%-35s -> class_name('%s');\n",$name,$other; + $object = ''; + } elsif (lc $pa_type eq 'object') { + if($name =~ /^pa_pa_/i) { + print "\nObject name \"$name\" starts with \"pa_\". This will cause conflicts. Ignoring entry"; } else { - print "\nUnrecognized .mht entry for PA: $record\n"; - return; + $code .= sprintf "\$%-35s -> tie_items(\$%s,'off','off');\n",$name,$address; + $code .= sprintf "\$%-35s -> tie_items(\$%s,'on','on');\n",$name,$address; } + } elsif (lc $pa_type eq 'x10') { + $other = join ', ', (map {"'$_'"} @other); # Quote data + $code .= sprintf "\$%-35s = new X10_Appliance('%s','%s');\n",$name.'_obj',$address, $serial; + $code .= sprintf "\$%-35s -> hidden(1);\n", $name.'_obj'; + $code .= sprintf "\$%-35s -> tie_items(\$%s,'off','off');\n",$name,$name.'_obj'; + $code .= sprintf "\$%-35s -> tie_items(\$%s,'on','on');\n",$name,$name.'_obj'; + } elsif (lc $pa_type eq 'xap') { + $code .= sprintf "\$%-35s = new xAP_Item('%s');\n",$name.'_obj',$address; + $code .= sprintf "\$%-35s -> hidden(1);\n", $name.'_obj'; + $code .= sprintf "\$%-35s -> target_address('%s');\n",$name.'_obj',$address; + $code .= sprintf "\$%-35s -> class_name('%s');\n",$name.'_obj',$serial; + $code .= sprintf "\$%-35s -> tie_items(\$%s,'on','on');\n",$name,$name.'_obj'; + } elsif (lc $pa_type eq 'xpl') { + $code .= sprintf "\$%-35s = new xPL_Item('%s');\n",$name.'_obj',$address; + $code .= sprintf "\$%-35s -> hidden(1);\n", $name.'_obj'; + $code .= sprintf "\$%-35s -> target_address('%s');\n",$name.'_obj',$address; + $code .= sprintf "\$%-35s -> class_name('%s');\n",$name.'_obj',$serial; + $code .= sprintf "\$%-35s -> tie_items(\$%s,'on','on');\n",$name,$name.'_obj'; + } else { + print "\nUnrecognized .mht entry for PA: $record\n"; + return; } + } elsif($type =~ /^EIB/) { ($address, $name, $grouplist, @other) = @item_info; From 539e194b0823c725d3088389e4c53da6e1d9397d Mon Sep 17 00:00:00 2001 From: Pmatis Date: Mon, 30 Sep 2013 01:47:53 -0400 Subject: [PATCH 02/18] Clarify usage of zones of type object. --- code/common/pa_control.pl | 2 ++ 1 file changed, 2 insertions(+) diff --git a/code/common/pa_control.pl b/code/common/pa_control.pl index fa35a6eb7..3e9129813 100644 --- a/code/common/pa_control.pl +++ b/code/common/pa_control.pl @@ -126,6 +126,8 @@ sub pa_control_stub { if the command to turn on the pin you want is: BHC, then the Address is: BC For X10, the X10 address of the (likely) relay device. For xAP and xPL, use the IP address or hostname of the target device. + For "object", use the name of the object (without the $). You may use anything that + responds ON and OFF set commands. Tested with and Insteon device. Name: Give a name to the pa zone, usually the room name. You use these in the speak and play commands with rooms=. From c23ab978376337c01c7a59931af9c75ca0751ab5 Mon Sep 17 00:00:00 2001 From: Pmatis Date: Tue, 1 Oct 2013 22:58:25 -0400 Subject: [PATCH 03/18] Imporove logging and add debug levels. --- code/common/pa_control.pl | 3 +- lib/PAobj.pm | 107 ++++++++++++++++++-------------------- 2 files changed, 54 insertions(+), 56 deletions(-) diff --git a/code/common/pa_control.pl b/code/common/pa_control.pl index 3e9129813..bff9da14b 100644 --- a/code/common/pa_control.pl +++ b/code/common/pa_control.pl @@ -63,6 +63,7 @@ my $state = $v_pa_speakers->{state}; $v_pa_speakers->respond("app=pa Turning speakers $state..."); $state = ($state eq 'on') ? ON : OFF; + print "PA: Turning speakers $state\n" if $Debug{pa}; $pactrl->set('allspeakers',$state,'unmuted'); } @@ -82,7 +83,7 @@ sub pa_control_stub { my $rooms = $parms{rooms}; print "PA: control_stub: rooms=$rooms, mode=$mode\n" if $Debug{pa}; my $results = $pactrl->set($rooms,ON,$mode,%parms); - print "PA: control_stub set results: $results\n" if $Debug{pa}; + print "PA: control_stub set results: $results\n" if $Debug{pa} >=2; set $pa_speaker_timer $pa_timer if $results; } diff --git a/lib/PAobj.pm b/lib/PAobj.pm index 34299cc86..e0d96cbd9 100644 --- a/lib/PAobj.pm +++ b/lib/PAobj.pm @@ -57,7 +57,7 @@ sub init { %pa_zone_types=(); my $ref2 = &::get_object_by_name("pa_allspeakers"); if (!$ref2) { - &::print_log("\n\nWARNING! PA Zones were not found! Your *.mht file probably doesn't list the PA zones correctly.\n\n"); + print("\n\nWARNING! PA Zones were not found! Your *.mht file probably doesn't list the PA zones correctly.\n\n"); return 0; } $self->check_group('default'); @@ -68,8 +68,7 @@ sub init { for my $room (@speakers) { my $ref = &::get_object_by_name("pa_$room"); my $type = $ref->get_type(); - print "PAObj: init: room=$room\n"; - print "PAObj: init: room=$room, zonetype=$type\n"; + &::print_log("PAObj: init: room=$room, zonetype=$type"); $pa_zone_types{$type}++ unless $pa_zone_types{$type}; if($type eq 'wdio') { @@ -89,24 +88,24 @@ sub init { } } - print "PAObj: speakers_wdio: $#speakers_wdio\n" if $main::Debug{pa}; - print "PAObj: speakers_x10: $#speakers_x10\n" if $main::Debug{pa}; - print "PAObj: speakers_xap: $#speakers_xap\n" if $main::Debug{pa}; - print "PAObj: speakers_xpl: $#speakers_xpl\n" if $main::Debug{pa}; - print "PAObj: speakers_obj: $#speakers_obj\n" if $main::Debug{pa}; + &::print_log("PAObj: speakers_wdio: $#speakers_wdio") if $main::Debug{pa} || $#speakers_wdio gt -1; + &::print_log("PAObj: speakers_x10: $#speakers_x10") if $main::Debug{pa} || $#speakers_x10 gt -1; + &::print_log("PAObj: speakers_xap: $#speakers_xap") if $main::Debug{pa} || $#speakers_xap gt -1; + &::print_log("PAObj: speakers_xpl: $#speakers_xpl") if $main::Debug{pa} || $#speakers_xpl gt -1; + &::print_log("PAObj: speakers_obj: $#speakers_obj") if $main::Debug{pa} || $#speakers_obj gt -1; if ($#speakers_wdio > -1) { $self->init_weeder(@speakers_wdio); return 0 unless %pa_weeder_max_port; } if ($pa_zone_types{'x10'}) { - print "PAObj: x10 PA type initialized...\n" if $main::Debug{pa}; + &::print_log("PAObj: x10 PA type initialized...") if $main::Debug{pa}; } if ($pa_zone_types{'xap'}) { - print "PAObj: xAP PA type initialized...\n" if $main::Debug{pa}; + &::print_log("PAObj: xAP PA type initialized...") if $main::Debug{pa}; } if ($pa_zone_types{'xpl'}) { - print "PAObj: xPL PA type initialized...\n" if $main::Debug{pa}; + &::print_log("PAObj: xPL PA type initialized...") if $main::Debug{pa}; } return 1; } @@ -117,7 +116,7 @@ sub init_weeder my (%weeder_ref,%weeder_max); undef %pa_weeder_max_port; for my $room (@speakers) { - print "PAObj: init PA Room loaded: $room\n" if $main::Debug{pa}; + &::print_log("PAObj: init PA Room loaded: $room") if $main::Debug{pa}; my $ref = &::get_object_by_name('pa_' . $room . '_obj'); $ref->{state} = 'off'; my ($card,$id); @@ -125,14 +124,14 @@ sub init_weeder $weeder_ref{$card} = '' unless $weeder_ref{$card}; $weeder_ref{$card} .= $id; - print "PAObj: init card: $card, id: $id, Room: $room, List: $weeder_ref{$card}\n" if $main::Debug{pa}; + &::print_log("PAObj: init card: $card, id: $id, Room: $room, List: $weeder_ref{$card}") if $main::Debug{pa}; } for my $card ('A' .. 'P','a' .. 'p') { if ($weeder_ref{$card}) { my $data = $weeder_ref{$card}; $weeder_max{$card}=$self->last_char($data); - print "\nPAObj: init weeder board=$card, ports=$data, max port=" . $weeder_max{$card} . "\n" if $main::Debug{pa}; + &::print_log("PAObj: init weeder board=$card, ports=$data, max port=" . $weeder_max{$card}) if $main::Debug{pa}; } } %pa_weeder_max_port = %weeder_max; @@ -142,13 +141,14 @@ sub set { my ($self,$rooms,$state,$mode,%voiceparms) = @_; my $results = 0; - print "PAObj: delay: $$self{pa_delay}\n" if $main::Debug{pa}; - print "PAObj: set,mode: " . $mode . "\n" if $main::Debug{pa}; - print "PAObj: set,rooms: " . $rooms . "\n" if $main::Debug{pa}; + &::print_log("PAObj: delay: $$self{pa_delay}\n") if $main::Debug{pa} >=3; + &::print_log("PAObj: set,mode: " . $mode . ",rooms: " . $rooms) if $main::Debug{pa} >=3; my @speakers = $self->get_speakers($rooms); @speakers = $self->get_speakers('') if $#speakers == -1; + &::print_log("PAObj: Proposed rooms: ".join(', ', @speakers)) if $main::Debug{pa} >=2; @speakers = $self->get_speakers_speakable($mode,@speakers); + &::print_log("PAObj: Will speak in rooms: ".join(', ', @speakers)) if $main::Debug{pa}; my (@speakers_wdio,@speakers_x10,@speakers_obj,@speakers_xap,@speakers_xpl); @@ -156,32 +156,32 @@ sub set my $ref = &::get_object_by_name("pa_$room"); my $type = lc $ref->get_type(); if($type eq 'wdio' || $type eq 'wdio_old') { - print "PAObj: speakers_wdio: Adding $room\n" if $main::Debug{pa}; + &::print_log("PAObj: speakers_wdio: Adding $room") if $main::Debug{pa} >=3; push(@speakers_wdio,$room); } if($type eq 'x10') { - print "PAObj: speakers_x10: Adding $room\n" if $main::Debug{pa}; + &::print_log("PAObj: speakers_x10: Adding $room") if $main::Debug{pa} >=3; push(@speakers_x10,$room); } if($type eq 'xap') { - print "PAObj: speakers_xap: Adding $room\n" if $main::Debug{pa}; + &::print_log("PAObj: speakers_xap: Adding $room") if $main::Debug{pa} >=3; push(@speakers_xap,$room) if $state eq 'on'; #Only need to send if speech is starting } if($type eq 'xpl') { - print "PAObj: speakers_xpl: Adding $room\n" if $main::Debug{pa}; + &::print_log("PAObj: speakers_xpl: Adding $room") if $main::Debug{pa} >=3; push(@speakers_xpl,$room) if $state eq 'on'; #Only need to send if speech is starting } if($type eq 'object') { - print "PAObj: speakers_object: Adding $room\n" if $main::Debug{pa}; + &::print_log("PAObj: speakers_object: Adding $room") if $main::Debug{pa} >=3; push(@speakers_obj,$room); } } - print "PAObj: speakers_wdio: $#speakers_wdio\n" if $main::Debug{pa}; - print "PAObj: speakers_x10: $#speakers_x10\n" if $main::Debug{pa}; - print "PAObj: speakers_xap: $#speakers_xap\n" if $main::Debug{pa}; - print "PAObj: speakers_xpl: $#speakers_xpl\n" if $main::Debug{pa}; - print "PAObj: speakers_obj: $#speakers_obj\n" if $main::Debug{pa}; + &::print_log("PAObj: speakers_wdio: $#speakers_wdio") if $main::Debug{pa} >=2 || $#speakers_wdio gt -1; + &::print_log("PAObj: speakers_x10: $#speakers_x10") if $main::Debug{pa} >=2 || $#speakers_x10 gt -1; + &::print_log("PAObj: speakers_xap: $#speakers_xap") if $main::Debug{pa} >=2 || $#speakers_xap gt -1; + &::print_log("PAObj: speakers_xpl: $#speakers_xpl") if $main::Debug{pa} >=2 || $#speakers_xpl gt -1; + &::print_log("PAObj: speakers_obj: $#speakers_obj") if $main::Debug{pa} >=2 || $#speakers_obj gt -1; #TODO: Properly handle $results across multiple types #TODO: Break up the wdio zones based on serial port, in case there are more than one. @@ -200,7 +200,7 @@ sub set_obj { my ($self,$state,@speakers) = @_; for my $room (@speakers) { - print "PAObj: set_obj: " . $room . " / " . $state . "\n" if $main::Debug{pa}; + &::print_log("PAObj: set_obj: " . $room . " / " . $state) if $main::Debug{pa} >=2; my $ref = &::get_object_by_name("pa_$room"); if ($ref) { $ref->set($state); @@ -214,12 +214,12 @@ sub set_x10 my ($x10_list,$pa_x10_hc,$ref,$refobj); for my $room (@speakers) { - print "PAObj: set_x10: " . $room . " / " . $state . "\n" if $main::Debug{pa}; + &::print_log("PAObj: set_x10: " . $room . " / " . $state) if $main::Debug{pa} >=3; $ref = &::get_object_by_name('pa_'.$room); $refobj = &::get_object_by_name('pa_'.$room.'_obj'); if ($refobj && $ref) { my ($id) = $ref->get_address(); - print "PAObj: set_x10 ID: $id, State: $state, Room: $room\n" if $main::Debug{pa}; + &::print_log("PAObj: set_x10 ID: $id, State: $state, Room: $room") if $main::Debug{pa} >=2; $refobj->set($state); } } @@ -231,13 +231,13 @@ sub set_xap { my %voiceparms = %$param2; return unless $#speakers > -1; for my $room (@speakers) { - print "PAObj: set_xap: " . $room . " / " . $state . "\n" if $main::Debug{pa}; + &::print_log("PAObj: set_xap: " . $room . " / " . $state) if $main::Debug{pa} >=3; my $ref = &::get_object_by_name('pa_'.$room.'_obj'); if ($ref) { $ref->send_message($ref->target_address, $ref->class_name => {say => $voiceparms{text}, volume => $voiceparms{volume}, mode => $voiceparms{mode}, voice => $voiceparms{voice} }); - print "PAObj: xap cmd: $ref->{object_name} is sending voice text: $voiceparms{text}\n" if $main::Debug{pa}; + &::print_log("PAObj: xap cmd: $ref->{object_name} is sending voice text: $voiceparms{text}") if $main::Debug{pa}; } else { - print "PAObj: Unable to locate object for: pa_$room\n" if $main::Debug{pa}; + &::print_log("PAObj: Unable to locate object for: pa_$room"); } } } @@ -248,7 +248,7 @@ sub set_xpl { my %voiceparms = %$param2; return unless $#speakers > -1; for my $room (@speakers) { - print "PAObj: set_xpl: " . $room . " / " . $state . "\n" if $main::Debug{pa}; + &::print_log("PAObj: set_xpl: " . $room . " / " . $state) if $main::Debug{pa} >=3; my $ref = &::get_object_by_name('pa_'.$room.'_obj'); if ($ref) { my $max_length = $::config_parms{"pa_$room" . "_maxlength"}; @@ -258,9 +258,9 @@ sub set_xpl { $text = substr($text, 0, $max_length) if $max_length < length($text); } $ref->send_cmnd($ref->class_name => {speech => $text, voice => $voiceparms{voice}, volume => $voiceparms{volume}, mode => $voiceparms{mode} }); - print "PAObj: set_xpl: $ref->{object_name} is sending voice text: $voiceparms{text}\n" if $main::Debug{pa}; + &::print_log("PAObj: set_xpl: $ref->{object_name} is sending voice text: $voiceparms{text}") if $main::Debug{pa}; } else { - print "PAObj: Unable to locate object for: pa_$room\n" if $main::Debug{pa}; + &::print_log("PAObj: Unable to locate object for: pa_$room"); } } } @@ -272,18 +272,18 @@ sub set_weeder my $weeder_command=''; my $command=''; for my $room (@speakers) { - print "PAObj: set_weeder: " . $room . " / " . $state . "\n" if $main::Debug{pa}; + &::print_log("PAObj: set_weeder: " . $room . " / " . $state) if $main::Debug{pa} >=3; my $ref = &::get_object_by_name('pa_'.$room.'_obj'); if ($ref) { $ref->{state} = $state; my ($card,$id) = $ref->{id_by_state}{'on'} =~ /^D?(.)H(.)/s; $weeder_ref{$card}='' unless $weeder_ref{$card}; $weeder_ref{$card} .= $id; - print "PAObj: card: $card, id: $id, Room: $room\n" if $main::Debug{pa}; + &::print_log("PAObj: card: $card, id: $id, Room: $room") if $main::Debug{pa} >=2; } } - $self->print_speaker_states() if $main::Debug{pa}; + $self->print_speaker_states() if $main::Debug{pa} >=3; for my $card ('A' .. 'P','a' .. 'p') { if ($weeder_ref{$card}) { @@ -294,7 +294,7 @@ sub set_weeder } } return 0 unless $weeder_command; - print "PAObj: Sending $weeder_command to the weeder card(s)\n" if $main::Debug{pa}; + &::print_log("PAObj: Sending $weeder_command to the weeder card(s)") if $main::Debug{pa}; $weeder_command =~ s/\\r/\r/g; &Serial_Item::send_serial_data($weeder_port, $weeder_command) if $main::Serial_Ports{$weeder_port}{object}; return 1; @@ -303,7 +303,6 @@ sub set_weeder sub get_weeder_string { my ($self,$card,$data) = @_; - my $bit_counter=0; my ($bit_flag,$state,$ref,$bit,$byte_code,$weeder_code,$id); @@ -324,7 +323,7 @@ sub get_weeder_string } $bit_flag = ($state eq 'on') ? 1 : 0; # get 0 or 1 - print "PAObj: get_weeder_string card: $card, bit=$bit state=$bit_flag\n" if $main::Debug{pa}; + &::print_log("PAObj: get_weeder_string card: $card, bit=$bit state=$bit_flag") if $main::Debug{pa} >=2; $byte_code += ($bit_flag << $bit_counter); # get bit in byte position if ($bit_counter++ >= 3) { @@ -352,7 +351,7 @@ sub get_speakers my ($self,$rooms) = @_; my @pazones; - print "PAObj: get_speakers,rooms: " . $rooms . "\n" if $main::Debug{pa}; + &::print_log("PAObj: get_speakers,rooms: " . $rooms) if $main::Debug{pa} >=2; if ($::mh_speakers->{rooms}) { $rooms = $::mh_speakers->{rooms}; $::mh_speakers->{rooms} = ''; @@ -364,15 +363,15 @@ sub get_speakers no strict 'refs'; my $ref = &::get_object_by_name("pa_$room"); if ($ref) { - print "PAObj: name=$ref->{object_name}\n" if $main::Debug{pa}; + &::print_log("PAObj: name=$ref->{object_name}") if $main::Debug{pa}; if (UNIVERSAL::isa($ref,'Group')) { - print "PAObj: It's a group!\n" if $main::Debug{pa}; + &::print_log("PAObj: It's a group!") if $main::Debug{pa} >=2; for my $grouproom ($ref->list) { $grouproom = $grouproom->get_object_name; $grouproom =~ s/^\$pa_//; $grouproom =~ s/^\$paxpl_//; $grouproom =~ s/^\$paxap_//; - print "PAObj: - member: $grouproom\n" if $main::Debug{pa}; + &::print_log("PAObj: - member: $grouproom\n") if $main::Debug{pa} >=2; push(@pazones, $grouproom); } } else { @@ -388,13 +387,13 @@ sub get_speakers sub check_group { my ($self,$group) = @_; - print "PAObj: check group=$group\n" if $main::Debug{pa}; + &::print_log("PAObj: check group=$group") if $main::Debug{pa} >=2; my $ref = &::get_object_by_name("pa_$group"); - if (!$ref) {print "Error! Group does not exist: $group\n"; return;} + if (!$ref) {&::print_log("PAObj: check group: Error! Group does not exist: $group"); return;} my @list = $ref->list; - print "PAObj: check group=$group, list=$#list\n" if $main::Debug{pa}; + &::print_log("PAObj: check group=$group, list=$#list") if $main::Debug{pa} >=2; if ($#list == -1) { - print "PAObj: check populating group: $group!\n" if $main::Debug{pa}; + &::print_log("PAObj: check populating group: $group!") if $main::Debug{pa}; for my $room ($self->get_speakers('allspeakers')) { my $ref2 = &::get_object_by_name("pa_$room"); $ref->add($ref2); @@ -412,13 +411,13 @@ sub get_speakers_speakable for my $room (@zones) { my $ref = &::get_object_by_name("pa_$room"); - print "PAObj: speakable: name=$ref->{object_name}\n" if $main::Debug{pa}; + &::print_log("PAObj: speakable: name=$ref->{object_name}") if $main::Debug{pa} >=3; if ($ref->{sleeping} == 0) { $ref->{mode} = 'normal' unless $ref->{mode}; my $gss_mode = $ref->{mode}; if ($gss_mode ne 'sleeping' && ($gss_mode eq 'normal' || $mode eq 'unmuted')) { push(@pazones,$room); - print "PAObj: speakable: Pushing $room into pazones array:$#pazones\n" if $main::Debug{pa}; + &::print_log("PAObj: speakable: Pushing $room into pazones array:$#pazones") if $main::Debug{pa} >=2; } } } @@ -440,7 +439,7 @@ sub print_speaker_states $ref = &::get_object_by_name("pa_$speaker"); $room = $ref->{object_name}; $room =~ s/^\$pa_//; - print "PAObj: name=$room, state=$ref->{state}\n" if $main::Debug{pa}; + &::print_log("PAObj: name=$room, state=$ref->{state}") if $main::Debug{pa}; } } @@ -507,10 +506,8 @@ sub get_type return $$self{other}; } - 1; - =back =head2 INI PARAMETERS From 86b5dc16e140cb6b791e6438d0ba35e2de4929b9 Mon Sep 17 00:00:00 2001 From: Pmatis Date: Wed, 9 Oct 2013 02:18:40 -0400 Subject: [PATCH 04/18] Initial addition of Audrey aupport --- code/common/pa_control.pl | 51 +++++++-- lib/Audrey_Play.pm | 65 ++++++++++++ lib/PAobj.pm | 216 +++++++++++++++++++++++++++----------- lib/read_table_A.pl | 10 +- 4 files changed, 265 insertions(+), 77 deletions(-) create mode 100644 lib/Audrey_Play.pm diff --git a/code/common/pa_control.pl b/code/common/pa_control.pl index bff9da14b..da32500e7 100644 --- a/code/common/pa_control.pl +++ b/code/common/pa_control.pl @@ -48,8 +48,10 @@ $pactrl->init() if $Startup or $Reload; # Hooks to flag which rooms to turn on based on "rooms=" parm in speak command +&Speak_parms_add_hook(\&pa_parms_stub) if $Reload; &Speak_pre_add_hook(\&pa_control_stub) if $Reload; -&Play_pre_add_hook (\&pa_control_stub) if $Reload; +&Play_parms_add_hook(\&pa_parms_stub) if $Reload; +&Play_pre_add_hook(\&pa_control_stub) if $Reload; if (said $v_pa_test) { my $state = $v_pa_test->{state}; @@ -67,38 +69,65 @@ $pactrl->set('allspeakers',$state,'unmuted'); } -sub pa_control_stub { - my (%parms) = @_; - my @pazones; - my $mode = $parms{mode}; - unless ($mode) { +sub pa_parms_stub { + my ($parms) = @_; + unless ($parms->{mode}) { if (defined $mode_mh) { # *** Outdated (?) - $mode = state $mode_mh; + $parms->{mode} = state $mode_mh; } else { - $mode = $Save{mode}; + $parms->{mode} = $Save{mode}; } } + return if $parms->{mode} eq 'mute' or $parms->{mode} eq 'offline'; + + my $results = $pactrl->prep_parms($parms); + + my %pa_zones = $pactrl->get_pa_zones(); + push(@{$parms->{web_hook}},\&pa_web_hook) if $pa_zones{audrey} ne ''; + + print "PA: parms_stub set results: $results\n" if $Debug{pa} >=2; + +} + +sub pa_control_stub { + my (%parms) = @_; + my @pazones; + my $mode = $parms{mode}; +# unless ($mode) { +# if (defined $mode_mh) { # *** Outdated (?) +# $mode = state $mode_mh; +# } else { +# $mode = $Save{mode}; +# } +# } return if $mode eq 'mute' or $mode eq 'offline'; my $rooms = $parms{rooms}; print "PA: control_stub: rooms=$rooms, mode=$mode\n" if $Debug{pa}; - my $results = $pactrl->set($rooms,ON,$mode,%parms); + my $results = $pactrl->audio_hook(ON,%parms); print "PA: control_stub set results: $results\n" if $Debug{pa} >=2; set $pa_speaker_timer $pa_timer if $results; + return $results; } +sub pa_web_hook { + my (%parms) = @_; + $pactrl->web_hook(\%parms); +} + + #Turn off speakers when MH says it's done speaking/playing if (state_now $mh_speakers eq OFF) { unset $pa_speaker_timer; print "PA: Turning speakers off\n" if $Debug{pa}; - $pactrl->set('allspeakers',OFF,'normal'); + $pactrl->audio_hook(OFF,'normal'); } #Setup Fail-safe speaker shutoff $pa_speaker_timer = new Timer; set $pa_speaker_timer 60 if state_now $mh_speakers eq ON; if (expired $pa_speaker_timer) { - print "PA: Timer expired.\n" if $Debug{pa}; + print "PA: Timer expired. Forcing PA speakers off.\n" if $Debug{pa}; set $mh_speakers OFF; } diff --git a/lib/Audrey_Play.pm b/lib/Audrey_Play.pm new file mode 100644 index 000000000..550739e14 --- /dev/null +++ b/lib/Audrey_Play.pm @@ -0,0 +1,65 @@ +use strict; + +package Audrey_Play; + +=head1 NAME + +B - This object can be used to play sound files on the Audrey. + +=head1 SYNOPSIS + + +blah blah + + + +=head1 DESCRIPTION + +=head1 INHERITS + +B + +=head1 METHODS + +=over + +=cut + +@Audrey_Play::ISA = ('Generic_Item'); + +my $address; + +sub Init { + #&::MainLoop_pre_add_hook( \&Weather_Item::check_weather, 1 ); +} + +=item C + +$ip is the IP address of the Audrey. + +=cut + +sub new { + my ($class, $ip) = @_; + my $self = { }; + $self->{address}=$ip; + + if ($ip) { + &::print_log("Creating Audrey_Play object..."); + } else { + warn 'Empty expression is not allowed.'; + } + + bless $self, $class; + return $self; +} + +sub play { + my ($self,$web_file) = @_; + &::print_log("Called 'play' in Audrey_Play object..."); + my $MHWeb = $::Info{IPAddress_local} . ":" . $::config_parms{http_port}; + &::print_log($MHWeb); + &::run("get_url -quiet http://" . $self->{address} . "/mhspeak.shtml?http://" . $MHWeb . "/" . $web_file . " /dev/null"); +} + +1; \ No newline at end of file diff --git a/lib/PAobj.pm b/lib/PAobj.pm index e0d96cbd9..f75832ffe 100644 --- a/lib/PAobj.pm +++ b/lib/PAobj.pm @@ -27,7 +27,7 @@ B use strict; -my (%pa_weeder_max_port,%pa_zone_types,%pa_zone_type_by_zone); +my (%pa_weeder_max_port,%pa_zone_types,%pa_zones); package PAobj; @@ -63,12 +63,12 @@ sub init { $self->check_group('default'); my @speakers = $self->get_speakers('allspeakers'); - my (@speakers_wdio,@speakers_x10,@speakers_obj,@speakers_xap,@speakers_xpl); + my (@speakers_wdio,@speakers_x10,@speakers_obj,@speakers_xap,@speakers_xpl,@speakers_audrey); for my $room (@speakers) { my $ref = &::get_object_by_name("pa_$room"); my $type = $ref->get_type(); - &::print_log("PAObj: init: room=$room, zonetype=$type"); + &::print_log("PAobj: init: room=$room, zonetype=$type"); $pa_zone_types{$type}++ unless $pa_zone_types{$type}; if($type eq 'wdio') { @@ -86,26 +86,30 @@ sub init { if($type eq 'object') { push(@speakers_obj,$room); } + if($type eq 'audrey') { + push(@speakers_audrey,$room); + } } - &::print_log("PAObj: speakers_wdio: $#speakers_wdio") if $main::Debug{pa} || $#speakers_wdio gt -1; - &::print_log("PAObj: speakers_x10: $#speakers_x10") if $main::Debug{pa} || $#speakers_x10 gt -1; - &::print_log("PAObj: speakers_xap: $#speakers_xap") if $main::Debug{pa} || $#speakers_xap gt -1; - &::print_log("PAObj: speakers_xpl: $#speakers_xpl") if $main::Debug{pa} || $#speakers_xpl gt -1; - &::print_log("PAObj: speakers_obj: $#speakers_obj") if $main::Debug{pa} || $#speakers_obj gt -1; + &::print_log("PAobj: speakers_wdio: $#speakers_wdio") if $main::Debug{pa} || $#speakers_wdio gt -1; + &::print_log("PAobj: speakers_x10: $#speakers_x10") if $main::Debug{pa} || $#speakers_x10 gt -1; + &::print_log("PAobj: speakers_xap: $#speakers_xap") if $main::Debug{pa} || $#speakers_xap gt -1; + &::print_log("PAobj: speakers_xpl: $#speakers_xpl") if $main::Debug{pa} || $#speakers_xpl gt -1; + &::print_log("PAobj: speakers_obj: $#speakers_obj") if $main::Debug{pa} || $#speakers_obj gt -1; + &::print_log("PAobj: speakers_audrey: $#speakers_audrey") if $main::Debug{pa} || $#speakers_audrey gt -1; if ($#speakers_wdio > -1) { $self->init_weeder(@speakers_wdio); return 0 unless %pa_weeder_max_port; } if ($pa_zone_types{'x10'}) { - &::print_log("PAObj: x10 PA type initialized...") if $main::Debug{pa}; + &::print_log("PAobj: x10 PA type initialized...") if $main::Debug{pa}; } if ($pa_zone_types{'xap'}) { - &::print_log("PAObj: xAP PA type initialized...") if $main::Debug{pa}; + &::print_log("PAobj: xAP PA type initialized...") if $main::Debug{pa}; } if ($pa_zone_types{'xpl'}) { - &::print_log("PAObj: xPL PA type initialized...") if $main::Debug{pa}; + &::print_log("PAobj: xPL PA type initialized...") if $main::Debug{pa}; } return 1; } @@ -116,7 +120,7 @@ sub init_weeder my (%weeder_ref,%weeder_max); undef %pa_weeder_max_port; for my $room (@speakers) { - &::print_log("PAObj: init PA Room loaded: $room") if $main::Debug{pa}; + &::print_log("PAobj: init PA Room loaded: $room") if $main::Debug{pa}; my $ref = &::get_object_by_name('pa_' . $room . '_obj'); $ref->{state} = 'off'; my ($card,$id); @@ -124,83 +128,146 @@ sub init_weeder $weeder_ref{$card} = '' unless $weeder_ref{$card}; $weeder_ref{$card} .= $id; - &::print_log("PAObj: init card: $card, id: $id, Room: $room, List: $weeder_ref{$card}") if $main::Debug{pa}; + &::print_log("PAobj: init card: $card, id: $id, Room: $room, List: $weeder_ref{$card}") if $main::Debug{pa}; } for my $card ('A' .. 'P','a' .. 'p') { if ($weeder_ref{$card}) { my $data = $weeder_ref{$card}; $weeder_max{$card}=$self->last_char($data); - &::print_log("PAObj: init weeder board=$card, ports=$data, max port=" . $weeder_max{$card}) if $main::Debug{pa}; + &::print_log("PAobj: init weeder board=$card, ports=$data, max port=" . $weeder_max{$card}) if $main::Debug{pa}; } } %pa_weeder_max_port = %weeder_max; } -sub set +sub prep_parms { - my ($self,$rooms,$state,$mode,%voiceparms) = @_; - my $results = 0; - &::print_log("PAObj: delay: $$self{pa_delay}\n") if $main::Debug{pa} >=3; - &::print_log("PAObj: set,mode: " . $mode . ",rooms: " . $rooms) if $main::Debug{pa} >=3; + my ($self,$parms) = @_; + #my $self = {}; + &::print_log("PAobj: delay: $$self{pa_delay}\n") if $main::Debug{pa} >=3; + &::print_log("PAobj: set,mode: " . $parms->{mode} . ",rooms: " . $parms->{rooms}) if $main::Debug{pa} >=3; - my @speakers = $self->get_speakers($rooms); + my @speakers = $self->get_speakers($parms->{rooms}); @speakers = $self->get_speakers('') if $#speakers == -1; - &::print_log("PAObj: Proposed rooms: ".join(', ', @speakers)) if $main::Debug{pa} >=2; - @speakers = $self->get_speakers_speakable($mode,@speakers); - &::print_log("PAObj: Will speak in rooms: ".join(', ', @speakers)) if $main::Debug{pa}; - - my (@speakers_wdio,@speakers_x10,@speakers_obj,@speakers_xap,@speakers_xpl); + &::print_log("PAobj: Proposed rooms: ".join(', ', @speakers)) if $main::Debug{pa} >=2; + @speakers = $self->get_speakers_speakable($parms->{mode},@speakers); + &::print_log("PAobj: Will speak in rooms: ".join(', ', @speakers)) if $main::Debug{pa}; + + $parms->{pa_zones} = join(',', @speakers); + + my (@speakers_wdio,@speakers_x10,@speakers_obj,@speakers_xap,@speakers_xpl,@speakers_audrey); for my $room (@speakers) { my $ref = &::get_object_by_name("pa_$room"); my $type = lc $ref->get_type(); if($type eq 'wdio' || $type eq 'wdio_old') { - &::print_log("PAObj: speakers_wdio: Adding $room") if $main::Debug{pa} >=3; + &::print_log("PAobj: speakers_wdio: Adding $room") if $main::Debug{pa} >=3; push(@speakers_wdio,$room); } if($type eq 'x10') { - &::print_log("PAObj: speakers_x10: Adding $room") if $main::Debug{pa} >=3; + &::print_log("PAobj: speakers_x10: Adding $room") if $main::Debug{pa} >=3; push(@speakers_x10,$room); } if($type eq 'xap') { - &::print_log("PAObj: speakers_xap: Adding $room") if $main::Debug{pa} >=3; - push(@speakers_xap,$room) if $state eq 'on'; #Only need to send if speech is starting + &::print_log("PAobj: speakers_xap: Adding $room") if $main::Debug{pa} >=3; + push(@speakers_xap,$room); } if($type eq 'xpl') { - &::print_log("PAObj: speakers_xpl: Adding $room") if $main::Debug{pa} >=3; - push(@speakers_xpl,$room) if $state eq 'on'; #Only need to send if speech is starting + &::print_log("PAobj: speakers_xpl: Adding $room") if $main::Debug{pa} >=3; + push(@speakers_xpl,$room); } if($type eq 'object') { - &::print_log("PAObj: speakers_object: Adding $room") if $main::Debug{pa} >=3; + &::print_log("PAobj: speakers_object: Adding $room") if $main::Debug{pa} >=3; push(@speakers_obj,$room); } + if($type eq 'audrey') { + &::print_log("PAobj: speakers_audrey: Adding $room") if $main::Debug{pa} >=3; + push(@speakers_audrey,$room); + } } - &::print_log("PAObj: speakers_wdio: $#speakers_wdio") if $main::Debug{pa} >=2 || $#speakers_wdio gt -1; - &::print_log("PAObj: speakers_x10: $#speakers_x10") if $main::Debug{pa} >=2 || $#speakers_x10 gt -1; - &::print_log("PAObj: speakers_xap: $#speakers_xap") if $main::Debug{pa} >=2 || $#speakers_xap gt -1; - &::print_log("PAObj: speakers_xpl: $#speakers_xpl") if $main::Debug{pa} >=2 || $#speakers_xpl gt -1; - &::print_log("PAObj: speakers_obj: $#speakers_obj") if $main::Debug{pa} >=2 || $#speakers_obj gt -1; + &::print_log("PAobj: speakers_wdio: $#speakers_wdio") if $main::Debug{pa} >=2 || $#speakers_wdio gt -1; + &::print_log("PAobj: speakers_x10: $#speakers_x10") if $main::Debug{pa} >=2 || $#speakers_x10 gt -1; + &::print_log("PAobj: speakers_xap: $#speakers_xap") if $main::Debug{pa} >=2 || $#speakers_xap gt -1; + &::print_log("PAobj: speakers_xpl: $#speakers_xpl") if $main::Debug{pa} >=2 || $#speakers_xpl gt -1; + &::print_log("PAobj: speakers_obj: $#speakers_obj") if $main::Debug{pa} >=2 || $#speakers_obj gt -1; + &::print_log("PAobj: speakers_audrey: $#speakers_audrey") if $main::Debug{pa} >=2 || $#speakers_audrey gt -1; + + + $pa_zones{wdio}=join(',',@speakers_wdio); + $pa_zones{x10}=join(',',@speakers_x10); + $pa_zones{xap}=join(',',@speakers_xap); + $pa_zones{xpl}=join(',',@speakers_xpl); + $pa_zones{obj}=join(',',@speakers_obj); + $pa_zones{audrey}=join(',',@speakers_audrey); + + $parms->{web_file}="web_file";# if $#speakers_wdio gt -1; + + if( + 1 + && $pa_zones{wdio} eq '' + && $pa_zones{x10} eq '' + && $pa_zones{xap} eq '' + && $pa_zones{xpl} eq '' + && $pa_zones{obj} eq '' + + ) { + $$parms{to_file}='/dev/null'; + } + + return 1; + +} + +sub audio_hook +{ + my ($self,$state,%voiceparms) = @_; + my $results = 0; +# my @speakers = split(',', $voiceparms{pa_zones}); + + my @speakers_wdio=split(',',$pa_zones{wdio}); + my @speakers_x10=split(',',$pa_zones{x10}); + my @speakers_xap=split(',',$pa_zones{xap}); + my @speakers_xpl=split(',',$pa_zones{xpl}); + my @speakers_obj=split(',',$pa_zones{obj}); #TODO: Properly handle $results across multiple types #TODO: Break up the wdio zones based on serial port, in case there are more than one. + $results=0; $results = $self->set_weeder($state,'weeder',@speakers_wdio) if $#speakers_wdio > -1; $results = $self->set_x10($state,@speakers_x10) if $#speakers_x10 > -1; $results = $self->set_xap($state,\@speakers_xap,\%voiceparms) if $#speakers_xap > -1; $results = $self->set_xpl($state,\@speakers_xpl,\%voiceparms) if $#speakers_xpl > -1; $results = $self->set_obj($state,@speakers_obj) if $#speakers_obj > -1; - + select undef, undef, undef, $$self{pa_delay} if $results; + &::print_log("PAobj: set results: $results"); + + $results=0; + if($pa_zones{wdio} ne '') {$results=1;print_log('------> wdio detected, talking...');} return $results; } +sub web_hook +{ + my ($self,$parms) = @_; + &::print_log("PAobj: web_hook! Audrey: " . $pa_zones{audrey}); + return unless $pa_zones{audrey} ne ''; + my $results=0; + my @speakers_audrey=split(',', $pa_zones{audrey}); + + $results = $self->set_audrey($parms->{web_file},@speakers_audrey); + + return $results; +} + sub set_obj { my ($self,$state,@speakers) = @_; for my $room (@speakers) { - &::print_log("PAObj: set_obj: " . $room . " / " . $state) if $main::Debug{pa} >=2; + &::print_log("PAobj: set_obj: " . $room . " / " . $state) if $main::Debug{pa} >=2; my $ref = &::get_object_by_name("pa_$room"); if ($ref) { $ref->set($state); @@ -208,18 +275,34 @@ sub set_obj } } +sub set_audrey +{ + my ($self,$speakFile,@speakers) = @_; + &::print_log("PAobj: set_audrey: file: " . $speakFile) if $main::Debug{pa} >=4; + &::print_log("PAobj: set_audrey: count: " . $#speakers) if $main::Debug{pa} >=4; + + for my $room (@speakers) { + #my $ref = &::get_object_by_name('pa_'.$room); + my $refobj = &::get_object_by_name('pa_'.$room.'_obj'); + if ($refobj) { + &::print_log("PAobj: set_audrey: " . $room . " / " . $speakFile) if $main::Debug{pa} >=2; + $refobj->play($speakFile); + } + } +} + sub set_x10 { my ($self,$state,@speakers) = @_; my ($x10_list,$pa_x10_hc,$ref,$refobj); for my $room (@speakers) { - &::print_log("PAObj: set_x10: " . $room . " / " . $state) if $main::Debug{pa} >=3; + &::print_log("PAobj: set_x10: " . $room . " / " . $state) if $main::Debug{pa} >=3; $ref = &::get_object_by_name('pa_'.$room); $refobj = &::get_object_by_name('pa_'.$room.'_obj'); if ($refobj && $ref) { my ($id) = $ref->get_address(); - &::print_log("PAObj: set_x10 ID: $id, State: $state, Room: $room") if $main::Debug{pa} >=2; + &::print_log("PAobj: set_x10 ID: $id, State: $state, Room: $room") if $main::Debug{pa} >=2; $refobj->set($state); } } @@ -231,13 +314,13 @@ sub set_xap { my %voiceparms = %$param2; return unless $#speakers > -1; for my $room (@speakers) { - &::print_log("PAObj: set_xap: " . $room . " / " . $state) if $main::Debug{pa} >=3; + &::print_log("PAobj: set_xap: " . $room . " / " . $state) if $main::Debug{pa} >=3; my $ref = &::get_object_by_name('pa_'.$room.'_obj'); if ($ref) { $ref->send_message($ref->target_address, $ref->class_name => {say => $voiceparms{text}, volume => $voiceparms{volume}, mode => $voiceparms{mode}, voice => $voiceparms{voice} }); - &::print_log("PAObj: xap cmd: $ref->{object_name} is sending voice text: $voiceparms{text}") if $main::Debug{pa}; + &::print_log("PAobj: xap cmd: $ref->{object_name} is sending voice text: $voiceparms{text}") if $main::Debug{pa}; } else { - &::print_log("PAObj: Unable to locate object for: pa_$room"); + &::print_log("PAobj: Unable to locate object for: pa_$room"); } } } @@ -248,7 +331,7 @@ sub set_xpl { my %voiceparms = %$param2; return unless $#speakers > -1; for my $room (@speakers) { - &::print_log("PAObj: set_xpl: " . $room . " / " . $state) if $main::Debug{pa} >=3; + &::print_log("PAobj: set_xpl: " . $room . " / " . $state) if $main::Debug{pa} >=3; my $ref = &::get_object_by_name('pa_'.$room.'_obj'); if ($ref) { my $max_length = $::config_parms{"pa_$room" . "_maxlength"}; @@ -258,9 +341,9 @@ sub set_xpl { $text = substr($text, 0, $max_length) if $max_length < length($text); } $ref->send_cmnd($ref->class_name => {speech => $text, voice => $voiceparms{voice}, volume => $voiceparms{volume}, mode => $voiceparms{mode} }); - &::print_log("PAObj: set_xpl: $ref->{object_name} is sending voice text: $voiceparms{text}") if $main::Debug{pa}; + &::print_log("PAobj: set_xpl: $ref->{object_name} is sending voice text: $voiceparms{text}") if $main::Debug{pa}; } else { - &::print_log("PAObj: Unable to locate object for: pa_$room"); + &::print_log("PAobj: Unable to locate object for: pa_$room"); } } } @@ -272,14 +355,14 @@ sub set_weeder my $weeder_command=''; my $command=''; for my $room (@speakers) { - &::print_log("PAObj: set_weeder: " . $room . " / " . $state) if $main::Debug{pa} >=3; + &::print_log("PAobj: set_weeder: " . $room . " / " . $state) if $main::Debug{pa} >=3; my $ref = &::get_object_by_name('pa_'.$room.'_obj'); if ($ref) { $ref->{state} = $state; my ($card,$id) = $ref->{id_by_state}{'on'} =~ /^D?(.)H(.)/s; $weeder_ref{$card}='' unless $weeder_ref{$card}; $weeder_ref{$card} .= $id; - &::print_log("PAObj: card: $card, id: $id, Room: $room") if $main::Debug{pa} >=2; + &::print_log("PAobj: card: $card, id: $id, Room: $room") if $main::Debug{pa} >=2; } } @@ -294,7 +377,7 @@ sub set_weeder } } return 0 unless $weeder_command; - &::print_log("PAObj: Sending $weeder_command to the weeder card(s)") if $main::Debug{pa}; + &::print_log("PAobj: Sending $weeder_command to the weeder card(s)") if $main::Debug{pa}; $weeder_command =~ s/\\r/\r/g; &Serial_Item::send_serial_data($weeder_port, $weeder_command) if $main::Serial_Ports{$weeder_port}{object}; return 1; @@ -323,7 +406,7 @@ sub get_weeder_string } $bit_flag = ($state eq 'on') ? 1 : 0; # get 0 or 1 - &::print_log("PAObj: get_weeder_string card: $card, bit=$bit state=$bit_flag") if $main::Debug{pa} >=2; + &::print_log("PAobj: get_weeder_string card: $card, bit=$bit state=$bit_flag") if $main::Debug{pa} >=2; $byte_code += ($bit_flag << $bit_counter); # get bit in byte position if ($bit_counter++ >= 3) { @@ -351,7 +434,7 @@ sub get_speakers my ($self,$rooms) = @_; my @pazones; - &::print_log("PAObj: get_speakers,rooms: " . $rooms) if $main::Debug{pa} >=2; + &::print_log("PAobj: get_speakers,rooms: " . $rooms) if $main::Debug{pa} >=2; if ($::mh_speakers->{rooms}) { $rooms = $::mh_speakers->{rooms}; $::mh_speakers->{rooms} = ''; @@ -363,22 +446,22 @@ sub get_speakers no strict 'refs'; my $ref = &::get_object_by_name("pa_$room"); if ($ref) { - &::print_log("PAObj: name=$ref->{object_name}") if $main::Debug{pa}; + &::print_log("PAobj: name=$ref->{object_name}") if $main::Debug{pa}; if (UNIVERSAL::isa($ref,'Group')) { - &::print_log("PAObj: It's a group!") if $main::Debug{pa} >=2; + &::print_log("PAobj: It's a group!") if $main::Debug{pa} >=2; for my $grouproom ($ref->list) { $grouproom = $grouproom->get_object_name; $grouproom =~ s/^\$pa_//; $grouproom =~ s/^\$paxpl_//; $grouproom =~ s/^\$paxap_//; - &::print_log("PAObj: - member: $grouproom\n") if $main::Debug{pa} >=2; + &::print_log("PAobj: - member: $grouproom") if $main::Debug{pa} >=2; push(@pazones, $grouproom); } } else { push(@pazones, $room); } } else { - &::print_log("PAObj: WARNING: PA zone of '$room' not found!"); + &::print_log("PAobj: WARNING: PA zone of '$room' not found!"); } } return @pazones; @@ -387,13 +470,13 @@ sub get_speakers sub check_group { my ($self,$group) = @_; - &::print_log("PAObj: check group=$group") if $main::Debug{pa} >=2; + &::print_log("PAobj: check group=$group") if $main::Debug{pa} >=2; my $ref = &::get_object_by_name("pa_$group"); - if (!$ref) {&::print_log("PAObj: check group: Error! Group does not exist: $group"); return;} + if (!$ref) {&::print_log("PAobj: check group: Error! Group does not exist: $group"); return;} my @list = $ref->list; - &::print_log("PAObj: check group=$group, list=$#list") if $main::Debug{pa} >=2; + &::print_log("PAobj: check group=$group, list=$#list") if $main::Debug{pa} >=2; if ($#list == -1) { - &::print_log("PAObj: check populating group: $group!") if $main::Debug{pa}; + &::print_log("PAobj: check populating group: $group!") if $main::Debug{pa}; for my $room ($self->get_speakers('allspeakers')) { my $ref2 = &::get_object_by_name("pa_$room"); $ref->add($ref2); @@ -411,19 +494,26 @@ sub get_speakers_speakable for my $room (@zones) { my $ref = &::get_object_by_name("pa_$room"); - &::print_log("PAObj: speakable: name=$ref->{object_name}") if $main::Debug{pa} >=3; + &::print_log("PAobj: speakable: name=$ref->{object_name}") if $main::Debug{pa} >=3; if ($ref->{sleeping} == 0) { $ref->{mode} = 'normal' unless $ref->{mode}; my $gss_mode = $ref->{mode}; if ($gss_mode ne 'sleeping' && ($gss_mode eq 'normal' || $mode eq 'unmuted')) { push(@pazones,$room); - &::print_log("PAObj: speakable: Pushing $room into pazones array:$#pazones") if $main::Debug{pa} >=2; + &::print_log("PAobj: speakable: Pushing $room into pazones array:$#pazones") if $main::Debug{pa} >=2; } } } return @pazones; } +sub get_pa_zones +{ + my ($self) = @_; + &::print_log("PAobj: get_pa_zones");# if $main::Debug{pa} >=3; + return %pa_zones; +} + sub set_delay { my ($self,$delay) = @_; @@ -439,7 +529,7 @@ sub print_speaker_states $ref = &::get_object_by_name("pa_$speaker"); $room = $ref->{object_name}; $room =~ s/^\$pa_//; - &::print_log("PAObj: name=$room, state=$ref->{state}") if $main::Debug{pa}; + &::print_log("PAobj: name=$room, state=$ref->{state}") if $main::Debug{pa}; } } diff --git a/lib/read_table_A.pl b/lib/read_table_A.pl index 0d197677e..f924d1343 100644 --- a/lib/read_table_A.pl +++ b/lib/read_table_A.pl @@ -22,12 +22,12 @@ sub read_table_init_A { %groups=(); %objects=(); %packages=(); - %addresses=(); + %addresses=(); } sub read_table_A { my ($record) = @_; - + if($record =~ /^#/ or $record =~ /^\s*$/) { return; } @@ -551,6 +551,10 @@ sub read_table_A { $code .= sprintf "\$%-35s -> tie_items(\$%s,'off','off');\n",$name,$address; $code .= sprintf "\$%-35s -> tie_items(\$%s,'on','on');\n",$name,$address; } + } elsif (lc $pa_type eq 'audrey') { + require 'Audrey_Play.pm'; + $code .= sprintf "\$%-35s = new Audrey_Play('%s');\n",$name.'_obj',$address; + $code .= sprintf "\$%-35s -> hidden(1);\n", $name.'_obj'; } elsif (lc $pa_type eq 'x10') { $other = join ', ', (map {"'$_'"} @other); # Quote data $code .= sprintf "\$%-35s = new X10_Appliance('%s','%s');\n",$name.'_obj',$address, $serial; @@ -1130,4 +1134,4 @@ sub read_table_A { # Revision 1.3 2000/10/01 23:29:40 winter # - 2.29 release # -# +# \ No newline at end of file From b0c32815c78faa3ada3172b5c191736948ce5584 Mon Sep 17 00:00:00 2001 From: Pmatis Date: Thu, 10 Oct 2013 21:19:16 -0400 Subject: [PATCH 05/18] Add audrey documentation, clean up code, adjust debug clauses on several lines --- code/common/pa_control.pl | 83 ++++++++++++++++++++++++++++++++------- lib/PAobj.pm | 43 ++++++++++++++------ 2 files changed, 98 insertions(+), 28 deletions(-) diff --git a/code/common/pa_control.pl b/code/common/pa_control.pl index da32500e7..b12884b8d 100644 --- a/code/common/pa_control.pl +++ b/code/common/pa_control.pl @@ -48,11 +48,13 @@ $pactrl->init() if $Startup or $Reload; # Hooks to flag which rooms to turn on based on "rooms=" parm in speak command -&Speak_parms_add_hook(\&pa_parms_stub) if $Reload; -&Speak_pre_add_hook(\&pa_control_stub) if $Reload; -&Play_parms_add_hook(\&pa_parms_stub) if $Reload; -&Play_pre_add_hook(\&pa_control_stub) if $Reload; - +if ($Reload) { + print_log("PA: Hooking into speech events"); + &Speak_parms_add_hook(\&pa_parms_stub); + &Speak_pre_add_hook(\&pa_control_stub); + &Play_parms_add_hook(\&pa_parms_stub); + &Play_pre_add_hook(\&pa_control_stub); +} if (said $v_pa_test) { my $state = $v_pa_test->{state}; $v_pa_test->respond('app=pa Testing PA...'); @@ -65,7 +67,7 @@ my $state = $v_pa_speakers->{state}; $v_pa_speakers->respond("app=pa Turning speakers $state..."); $state = ($state eq 'on') ? ON : OFF; - print "PA: Turning speakers $state\n" if $Debug{pa}; + print_log("PA: Turning speakers $state") if $Debug{pa}; $pactrl->set('allspeakers',$state,'unmuted'); } @@ -85,7 +87,7 @@ sub pa_parms_stub { my %pa_zones = $pactrl->get_pa_zones(); push(@{$parms->{web_hook}},\&pa_web_hook) if $pa_zones{audrey} ne ''; - print "PA: parms_stub set results: $results\n" if $Debug{pa} >=2; + print_log("PA: parms_stub set results: $results") if $Debug{pa} >=2; } @@ -103,9 +105,9 @@ sub pa_control_stub { return if $mode eq 'mute' or $mode eq 'offline'; my $rooms = $parms{rooms}; - print "PA: control_stub: rooms=$rooms, mode=$mode\n" if $Debug{pa}; + print_log("PA: control_stub: rooms=$rooms, mode=$mode") if $Debug{pa}; my $results = $pactrl->audio_hook(ON,%parms); - print "PA: control_stub set results: $results\n" if $Debug{pa} >=2; + print_log("PA: control_stub set results: $results") if $Debug{pa} >=2; set $pa_speaker_timer $pa_timer if $results; return $results; } @@ -119,7 +121,7 @@ sub pa_web_hook { #Turn off speakers when MH says it's done speaking/playing if (state_now $mh_speakers eq OFF) { unset $pa_speaker_timer; - print "PA: Turning speakers off\n" if $Debug{pa}; + print_log("PA: Turning speakers off") if $Debug{pa}; $pactrl->audio_hook(OFF,'normal'); } @@ -127,7 +129,7 @@ sub pa_web_hook { $pa_speaker_timer = new Timer; set $pa_speaker_timer 60 if state_now $mh_speakers eq ON; if (expired $pa_speaker_timer) { - print "PA: Timer expired. Forcing PA speakers off.\n" if $Debug{pa}; + print_log("PA: Timer expired. Forcing PA speakers off.") if $Debug{pa}; set $mh_speakers OFF; } @@ -137,7 +139,7 @@ sub pa_web_hook { Example pa.mht file: # -#Type Address Name Groups Serial Other +#Type Address Name Groups Serial Type # PA, AA, kitchen, all|default|mainfloor, weeder, wdio PA, AB, server, all|basement, weeder, wdio @@ -146,16 +148,17 @@ sub pa_web_hook { PA, objname, living, all|mainfloor, , object PA, 192.168.0.1,family, all|mainfloor, , xap PA, 192.168.0.2,dining, all|mainfloor, , xpl +PA, 192.168.0.3,table, all|mainfloor, , audrey Type: "PA", constant. This must be there. Address: Address or Object name. - If Other is "object", then this should be an object name that can accept an ON or OFF + If Type is "object", then this should be an object name that can accept an ON or OFF For Weeder, 2 characters. First character is the weeder address, the second is the pin if the command to turn on the pin you want is: BHC, then the Address is: BC For X10, the X10 address of the (likely) relay device. - For xAP and xPL, use the IP address or hostname of the target device. + For xAP, xPL and audrey, use the IP address or hostname of the target device. For "object", use the name of the object (without the $). You may use anything that responds ON and OFF set commands. Tested with and Insteon device. @@ -174,7 +177,57 @@ sub pa_web_hook { The default is "weeder". Note that this can be changed with an INI parm. Other: Optional. Sets the type of PA control. Defaults to 'wdio'. Available options are: - wdio,wdio_old,X10,xpl,xap,object + wdio,wdio_old,X10,xpl,xap,audrey,object @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +=begin Audrey Config + +Exerpt from audreyspeak.pl + +You must make certain modifications to your Audrey, as follows: + +- Update the software and obtain root shell access capabilities (this + should be available by using Bruce's CF card image or by following + instructions available on the internet.) + +- Open the Audrey's web server to outside http requests + 1) Start the "Root Shell" + 2) type: cd /config + 3) type: cp rm-apps rm-apps.copy + 4) type: vi rm-apps + You'll be in the editor, editing the "rm-apps" file + About the 14th line down is "rb,/kojak/kojak-slinger, -c -e -s -i 127.1" + You need to delete the "-i 127.1" from the line. + To do this, place the cursor under the space right after the "-s" + Type the "x" key to start deleting from the line. + The line should end up looking like this: + "rb,/kojak/kojak-slinger, -c -e -s" + If you need to start over type a colon to get to the vi command line + At the colon prompt type "q!" and hit "enter" (this quits without saving) + If it looks good then at the colon prompt type "wq" to save changes + Now restart the Audrey by unplugging it, waiting 30 seconds and + plugging it back in. + +- Install playsound_noph and it's DLL + 1) Grab the zip file from http://www.planetwebb.com/audrey/ + 2) Place playsound_noph on the Audrey in /nto/photon/bin/ + 3) Place soundfile_noph.so on the Audrey in /nto/photon/dll/ + +- Install mhspeak.shtml on the Audrey + 1) Start the "Root Shell" + 2) type: cd /data/XML + 3) type: ftp blah.com mhspeak.shtml + + The MHSPEAK.SHTML file placed on the Audrey should contain the following: + + + + Shell + + + + + + + =cut diff --git a/lib/PAobj.pm b/lib/PAobj.pm index f75832ffe..b9c3e6e6a 100644 --- a/lib/PAobj.pm +++ b/lib/PAobj.pm @@ -68,7 +68,7 @@ sub init { for my $room (@speakers) { my $ref = &::get_object_by_name("pa_$room"); my $type = $ref->get_type(); - &::print_log("PAobj: init: room=$room, zonetype=$type"); + &::print_log("PAobj: init: room=$room, zonetype=$type") if $main::Debug{pa}; $pa_zone_types{$type}++ unless $pa_zone_types{$type}; if($type eq 'wdio') { @@ -91,12 +91,12 @@ sub init { } } - &::print_log("PAobj: speakers_wdio: $#speakers_wdio") if $main::Debug{pa} || $#speakers_wdio gt -1; - &::print_log("PAobj: speakers_x10: $#speakers_x10") if $main::Debug{pa} || $#speakers_x10 gt -1; - &::print_log("PAobj: speakers_xap: $#speakers_xap") if $main::Debug{pa} || $#speakers_xap gt -1; - &::print_log("PAobj: speakers_xpl: $#speakers_xpl") if $main::Debug{pa} || $#speakers_xpl gt -1; - &::print_log("PAobj: speakers_obj: $#speakers_obj") if $main::Debug{pa} || $#speakers_obj gt -1; - &::print_log("PAobj: speakers_audrey: $#speakers_audrey") if $main::Debug{pa} || $#speakers_audrey gt -1; + &::print_log("PAobj: speakers_wdio: $#speakers_wdio") if $main::Debug{pa};# || $#speakers_wdio gt -1; + &::print_log("PAobj: speakers_x10: $#speakers_x10") if $main::Debug{pa};# || $#speakers_x10 gt -1; + &::print_log("PAobj: speakers_xap: $#speakers_xap") if $main::Debug{pa};# || $#speakers_xap gt -1; + &::print_log("PAobj: speakers_xpl: $#speakers_xpl") if $main::Debug{pa};# || $#speakers_xpl gt -1; + &::print_log("PAobj: speakers_obj: $#speakers_obj") if $main::Debug{pa};# || $#speakers_obj gt -1; + &::print_log("PAobj: speakers_audrey: $#speakers_audrey") if $main::Debug{pa};# || $#speakers_audrey gt -1; if ($#speakers_wdio > -1) { $self->init_weeder(@speakers_wdio); @@ -152,7 +152,7 @@ sub prep_parms @speakers = $self->get_speakers('') if $#speakers == -1; &::print_log("PAobj: Proposed rooms: ".join(', ', @speakers)) if $main::Debug{pa} >=2; @speakers = $self->get_speakers_speakable($parms->{mode},@speakers); - &::print_log("PAobj: Will speak in rooms: ".join(', ', @speakers)) if $main::Debug{pa}; + &::print_log("PAobj: Will speak in rooms: ".join(', ', @speakers)); $parms->{pa_zones} = join(',', @speakers); @@ -241,11 +241,20 @@ sub audio_hook $results = $self->set_xpl($state,\@speakers_xpl,\%voiceparms) if $#speakers_xpl > -1; $results = $self->set_obj($state,@speakers_obj) if $#speakers_obj > -1; + &::print_log("PAobj: set results: $results") if $main::Debug{pa}; select undef, undef, undef, $$self{pa_delay} if $results; - &::print_log("PAobj: set results: $results"); $results=0; - if($pa_zones{wdio} ne '') {$results=1;print_log('------> wdio detected, talking...');} + if( + lc $state eq 'on' + && ( + $pa_zones{wdio} ne '' + || $pa_zones{x10} ne '' + || $pa_zones{obj} ne '' + ) + ) { + $results=1; + } return $results; } @@ -253,7 +262,7 @@ sub audio_hook sub web_hook { my ($self,$parms) = @_; - &::print_log("PAobj: web_hook! Audrey: " . $pa_zones{audrey}); + &::print_log("PAobj: web_hook! Audrey: " . $pa_zones{audrey}) if $main::Debug{pa}; return unless $pa_zones{audrey} ne ''; my $results=0; my @speakers_audrey=split(',', $pa_zones{audrey}); @@ -267,10 +276,12 @@ sub set_obj { my ($self,$state,@speakers) = @_; for my $room (@speakers) { - &::print_log("PAobj: set_obj: " . $room . " / " . $state) if $main::Debug{pa} >=2; my $ref = &::get_object_by_name("pa_$room"); if ($ref) { + &::print_log("PAobj: set_obj: " . $room . " / " . $state) if $main::Debug{pa} >=2; $ref->set($state); + } else { + &::print_log("PAobj: Unable to locate object for: pa_$room"); } } } @@ -287,6 +298,8 @@ sub set_audrey if ($refobj) { &::print_log("PAobj: set_audrey: " . $room . " / " . $speakFile) if $main::Debug{pa} >=2; $refobj->play($speakFile); + } else { + &::print_log("PAobj: Unable to locate object for: pa_$room"); } } } @@ -304,6 +317,8 @@ sub set_x10 my ($id) = $ref->get_address(); &::print_log("PAobj: set_x10 ID: $id, State: $state, Room: $room") if $main::Debug{pa} >=2; $refobj->set($state); + } else { + &::print_log("PAobj: Unable to locate object for: pa_$room"); } } } @@ -363,6 +378,8 @@ sub set_weeder $weeder_ref{$card}='' unless $weeder_ref{$card}; $weeder_ref{$card} .= $id; &::print_log("PAobj: card: $card, id: $id, Room: $room") if $main::Debug{pa} >=2; + } else { + &::print_log("PAobj: Unable to locate object for: pa_$room"); } } @@ -510,7 +527,7 @@ sub get_speakers_speakable sub get_pa_zones { my ($self) = @_; - &::print_log("PAobj: get_pa_zones");# if $main::Debug{pa} >=3; + &::print_log("PAobj: get_pa_zones") if $main::Debug{pa} >=3; return %pa_zones; } From f6b096250c4988f784f8df5a7bdbc3ecceaa96c7 Mon Sep 17 00:00:00 2001 From: Pmatis Date: Thu, 10 Oct 2013 21:32:21 -0400 Subject: [PATCH 06/18] Add comments to audreyspeak.pl, pointing people to pa_control.pl. --- code/common/audreyspeak.pl | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/code/common/audreyspeak.pl b/code/common/audreyspeak.pl index f35145bb3..d7471c29a 100644 --- a/code/common/audreyspeak.pl +++ b/code/common/audreyspeak.pl @@ -13,6 +13,13 @@ 1.0 Original version by Tim Doyle - 9/10/2002 +********************************************************************* +*This script is now deprecated, as support for Audrey has been added +*to the PAobj object. Enable pa_control.pl and follow examples to +*add audrey zones to your pa.mht file. Example: +*PA, 192.168.0.1,family, all|mainfloor, , audrey +********************************************************************* + This script allows MisterHouse to capture and send speech and played wav files to an Audrey unit. The original version was based upon Keith Webb's work outlined in his email of 12/23/01. From 7036d311fd4f232e009820ed7cdca4ba45c6ffbb Mon Sep 17 00:00:00 2001 From: Pmatis Date: Fri, 11 Oct 2013 10:59:13 -0400 Subject: [PATCH 07/18] Roll back $parms->{mode} use, interferred with Voice_Text.pm when using cepstral swift for voice --- code/common/pa_control.pl | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/code/common/pa_control.pl b/code/common/pa_control.pl index b12884b8d..c0475412a 100644 --- a/code/common/pa_control.pl +++ b/code/common/pa_control.pl @@ -73,14 +73,15 @@ sub pa_parms_stub { my ($parms) = @_; - unless ($parms->{mode}) { + my $mode = $parms->{mode}; + unless ($mode) { if (defined $mode_mh) { # *** Outdated (?) - $parms->{mode} = state $mode_mh; + $mode = state $mode_mh; } else { - $parms->{mode} = $Save{mode}; + $mode = $Save{mode}; } } - return if $parms->{mode} eq 'mute' or $parms->{mode} eq 'offline'; + return if $mode eq 'mute' or $mode eq 'offline'; my $results = $pactrl->prep_parms($parms); From 2b6c6a223e39c0698de594ac82bad52dd020f21e Mon Sep 17 00:00:00 2001 From: Pmatis Date: Fri, 11 Oct 2013 12:06:17 -0400 Subject: [PATCH 08/18] Fix so web_file is only used when needed. Clean up a little standardize on arrow notation for parms. --- code/common/pa_control.pl | 21 +++++++++------------ lib/PAobj.pm | 2 +- 2 files changed, 10 insertions(+), 13 deletions(-) diff --git a/code/common/pa_control.pl b/code/common/pa_control.pl index c0475412a..5f9c87b11 100644 --- a/code/common/pa_control.pl +++ b/code/common/pa_control.pl @@ -81,31 +81,28 @@ sub pa_parms_stub { $mode = $Save{mode}; } } + $parms->{pa_mode} = $mode; return if $mode eq 'mute' or $mode eq 'offline'; my $results = $pactrl->prep_parms($parms); - my %pa_zones = $pactrl->get_pa_zones(); - push(@{$parms->{web_hook}},\&pa_web_hook) if $pa_zones{audrey} ne ''; + + if (defined $pa_zones{audrey} && $pa_zones{audrey} ne '') { + print_log("PA: audrey zone detected, hooking via web_hook. (".$pa_zones{audrey}.")") if $Debug{pa}; + push(@{$parms->{web_hook}},\&pa_web_hook); + } print_log("PA: parms_stub set results: $results") if $Debug{pa} >=2; } sub pa_control_stub { - my (%parms) = @_; + my ($parms) = @_; my @pazones; - my $mode = $parms{mode}; -# unless ($mode) { -# if (defined $mode_mh) { # *** Outdated (?) -# $mode = state $mode_mh; -# } else { -# $mode = $Save{mode}; -# } -# } + my $mode = $parms->{pa_mode}; return if $mode eq 'mute' or $mode eq 'offline'; - my $rooms = $parms{rooms}; + my $rooms = $parms->{rooms}; print_log("PA: control_stub: rooms=$rooms, mode=$mode") if $Debug{pa}; my $results = $pactrl->audio_hook(ON,%parms); print_log("PA: control_stub set results: $results") if $Debug{pa} >=2; diff --git a/lib/PAobj.pm b/lib/PAobj.pm index b9c3e6e6a..1e2d00033 100644 --- a/lib/PAobj.pm +++ b/lib/PAobj.pm @@ -202,7 +202,7 @@ sub prep_parms $pa_zones{obj}=join(',',@speakers_obj); $pa_zones{audrey}=join(',',@speakers_audrey); - $parms->{web_file}="web_file";# if $#speakers_wdio gt -1; + $parms->{web_file}="web_file" if $#speakers_audrey gt -1; if( 1 From aaa64e8e71a26f4a990313330bf30a14d3367c62 Mon Sep 17 00:00:00 2001 From: Pmatis Date: Sat, 12 Oct 2013 23:41:45 -0400 Subject: [PATCH 09/18] Start changes to make sure only the desired speakers are on, even if they were on before starting speech. --- code/common/pa_control.pl | 8 +++--- lib/PAobj.pm | 55 +++++++++++++++++++++------------------ 2 files changed, 34 insertions(+), 29 deletions(-) diff --git a/code/common/pa_control.pl b/code/common/pa_control.pl index 5f9c87b11..74e23e55c 100644 --- a/code/common/pa_control.pl +++ b/code/common/pa_control.pl @@ -97,14 +97,14 @@ sub pa_parms_stub { } sub pa_control_stub { - my ($parms) = @_; + my (%parms) = @_; my @pazones; - my $mode = $parms->{pa_mode}; + my $mode = $parms{pa_mode}; return if $mode eq 'mute' or $mode eq 'offline'; - my $rooms = $parms->{rooms}; + my $rooms = $parms{rooms}; print_log("PA: control_stub: rooms=$rooms, mode=$mode") if $Debug{pa}; - my $results = $pactrl->audio_hook(ON,%parms); + my $results = $pactrl->audio_hook(ON,\%parms); print_log("PA: control_stub set results: $results") if $Debug{pa} >=2; set $pa_speaker_timer $pa_timer if $results; return $results; diff --git a/lib/PAobj.pm b/lib/PAobj.pm index 1e2d00033..0862edbd8 100644 --- a/lib/PAobj.pm +++ b/lib/PAobj.pm @@ -98,6 +98,13 @@ sub init { &::print_log("PAobj: speakers_obj: $#speakers_obj") if $main::Debug{pa};# || $#speakers_obj gt -1; &::print_log("PAobj: speakers_audrey: $#speakers_audrey") if $main::Debug{pa};# || $#speakers_audrey gt -1; + $pa_zones{all}{wdio}=join(',',@speakers_wdio); + $pa_zones{all}{x10}=join(',',@speakers_x10); + $pa_zones{all}{xap}=join(',',@speakers_xap); + $pa_zones{all}{xpl}=join(',',@speakers_xpl); + $pa_zones{all}{obj}=join(',',@speakers_obj); + $pa_zones{all}{audrey}=join(',',@speakers_audrey); + if ($#speakers_wdio > -1) { $self->init_weeder(@speakers_wdio); return 0 unless %pa_weeder_max_port; @@ -195,22 +202,22 @@ sub prep_parms &::print_log("PAobj: speakers_audrey: $#speakers_audrey") if $main::Debug{pa} >=2 || $#speakers_audrey gt -1; - $pa_zones{wdio}=join(',',@speakers_wdio); - $pa_zones{x10}=join(',',@speakers_x10); - $pa_zones{xap}=join(',',@speakers_xap); - $pa_zones{xpl}=join(',',@speakers_xpl); - $pa_zones{obj}=join(',',@speakers_obj); - $pa_zones{audrey}=join(',',@speakers_audrey); + $pa_zones{active}{wdio}=join(',',@speakers_wdio); + $pa_zones{active}{x10}=join(',',@speakers_x10); + $pa_zones{active}{xap}=join(',',@speakers_xap); + $pa_zones{active}{xpl}=join(',',@speakers_xpl); + $pa_zones{active}{obj}=join(',',@speakers_obj); + $pa_zones{active}{audrey}=join(',',@speakers_audrey); $parms->{web_file}="web_file" if $#speakers_audrey gt -1; if( 1 - && $pa_zones{wdio} eq '' - && $pa_zones{x10} eq '' - && $pa_zones{xap} eq '' - && $pa_zones{xpl} eq '' - && $pa_zones{obj} eq '' + && $pa_zones{active}{wdio} eq '' + && $pa_zones{active}{x10} eq '' + && $pa_zones{active}{xap} eq '' + && $pa_zones{active}{xpl} eq '' + && $pa_zones{active}{obj} eq '' ) { $$parms{to_file}='/dev/null'; @@ -226,16 +233,16 @@ sub audio_hook my $results = 0; # my @speakers = split(',', $voiceparms{pa_zones}); - my @speakers_wdio=split(',',$pa_zones{wdio}); - my @speakers_x10=split(',',$pa_zones{x10}); - my @speakers_xap=split(',',$pa_zones{xap}); - my @speakers_xpl=split(',',$pa_zones{xpl}); - my @speakers_obj=split(',',$pa_zones{obj}); + my @speakers_wdio=split(',',$pa_zones{active}{wdio}); + my @speakers_x10=split(',',$pa_zones{active}{x10}); + my @speakers_xap=split(',',$pa_zones{active}{xap}); + my @speakers_xpl=split(',',$pa_zones{active}{xpl}); + my @speakers_obj=split(',',$pa_zones{active}{obj}); #TODO: Properly handle $results across multiple types #TODO: Break up the wdio zones based on serial port, in case there are more than one. $results=0; - $results = $self->set_weeder($state,'weeder',@speakers_wdio) if $#speakers_wdio > -1; + $results = $self->set_weeder($state,'weeder',@speakers_wdio) if $#speakers_wdio > -1; $results = $self->set_x10($state,@speakers_x10) if $#speakers_x10 > -1; $results = $self->set_xap($state,\@speakers_xap,\%voiceparms) if $#speakers_xap > -1; $results = $self->set_xpl($state,\@speakers_xpl,\%voiceparms) if $#speakers_xpl > -1; @@ -248,9 +255,9 @@ sub audio_hook if( lc $state eq 'on' && ( - $pa_zones{wdio} ne '' - || $pa_zones{x10} ne '' - || $pa_zones{obj} ne '' + $pa_zones{active}{wdio} ne '' + || $pa_zones{active}{x10} ne '' + || $pa_zones{active}{obj} ne '' ) ) { $results=1; @@ -262,10 +269,10 @@ sub audio_hook sub web_hook { my ($self,$parms) = @_; - &::print_log("PAobj: web_hook! Audrey: " . $pa_zones{audrey}) if $main::Debug{pa}; - return unless $pa_zones{audrey} ne ''; + &::print_log("PAobj: web_hook! Audrey: " . $pa_zones{active}{audrey}) if $main::Debug{pa}; + return unless $pa_zones{active}{audrey} ne ''; my $results=0; - my @speakers_audrey=split(',', $pa_zones{audrey}); + my @speakers_audrey=split(',', $pa_zones{active}{audrey}); $results = $self->set_audrey($parms->{web_file},@speakers_audrey); @@ -469,8 +476,6 @@ sub get_speakers for my $grouproom ($ref->list) { $grouproom = $grouproom->get_object_name; $grouproom =~ s/^\$pa_//; - $grouproom =~ s/^\$paxpl_//; - $grouproom =~ s/^\$paxap_//; &::print_log("PAobj: - member: $grouproom") if $main::Debug{pa} >=2; push(@pazones, $grouproom); } From 9232a5b3b3b5f617ce312741cb20b0cfd715ed79 Mon Sep 17 00:00:00 2001 From: Pmatis Date: Mon, 14 Oct 2013 21:12:26 -0400 Subject: [PATCH 10/18] Added support for the aviosys USB Power 8840 relay board --- lib/PAobj.pm | 63 +++++++++++++++++++++++++++++++++++++-------- lib/read_table_A.pl | 6 ++++- 2 files changed, 57 insertions(+), 12 deletions(-) diff --git a/lib/PAobj.pm b/lib/PAobj.pm index 0862edbd8..e79680945 100644 --- a/lib/PAobj.pm +++ b/lib/PAobj.pm @@ -63,7 +63,7 @@ sub init { $self->check_group('default'); my @speakers = $self->get_speakers('allspeakers'); - my (@speakers_wdio,@speakers_x10,@speakers_obj,@speakers_xap,@speakers_xpl,@speakers_audrey); + my (@speakers_wdio,@speakers_x10,@speakers_obj,@speakers_xap,@speakers_xpl,@speakers_audrey,@speakers_aviosys); for my $room (@speakers) { my $ref = &::get_object_by_name("pa_$room"); @@ -89,21 +89,27 @@ sub init { if($type eq 'audrey') { push(@speakers_audrey,$room); } + if($type eq 'aviosys') { + push(@speakers_aviosys,$room); + } } &::print_log("PAobj: speakers_wdio: $#speakers_wdio") if $main::Debug{pa};# || $#speakers_wdio gt -1; &::print_log("PAobj: speakers_x10: $#speakers_x10") if $main::Debug{pa};# || $#speakers_x10 gt -1; &::print_log("PAobj: speakers_xap: $#speakers_xap") if $main::Debug{pa};# || $#speakers_xap gt -1; &::print_log("PAobj: speakers_xpl: $#speakers_xpl") if $main::Debug{pa};# || $#speakers_xpl gt -1; - &::print_log("PAobj: speakers_obj: $#speakers_obj") if $main::Debug{pa};# || $#speakers_obj gt -1; &::print_log("PAobj: speakers_audrey: $#speakers_audrey") if $main::Debug{pa};# || $#speakers_audrey gt -1; + &::print_log("PAobj: speakers_aviosys: $#speakers_aviosys") if $main::Debug{pa};# || $#speakers_aviosys gt -1; + &::print_log("PAobj: speakers_obj: $#speakers_obj") if $main::Debug{pa};# || $#speakers_obj gt -1; + $pa_zones{all}{wdio}=join(',',@speakers_wdio); $pa_zones{all}{x10}=join(',',@speakers_x10); $pa_zones{all}{xap}=join(',',@speakers_xap); $pa_zones{all}{xpl}=join(',',@speakers_xpl); - $pa_zones{all}{obj}=join(',',@speakers_obj); $pa_zones{all}{audrey}=join(',',@speakers_audrey); + $pa_zones{all}{aviosys}=join(',',@speakers_aviosys); + $pa_zones{all}{obj}=join(',',@speakers_obj); if ($#speakers_wdio > -1) { $self->init_weeder(@speakers_wdio); @@ -163,7 +169,7 @@ sub prep_parms $parms->{pa_zones} = join(',', @speakers); - my (@speakers_wdio,@speakers_x10,@speakers_obj,@speakers_xap,@speakers_xpl,@speakers_audrey); + my (@speakers_wdio,@speakers_x10,@speakers_obj,@speakers_xap,@speakers_xpl,@speakers_audrey,@speakers_aviosys); for my $room (@speakers) { my $ref = &::get_object_by_name("pa_$room"); @@ -184,30 +190,36 @@ sub prep_parms &::print_log("PAobj: speakers_xpl: Adding $room") if $main::Debug{pa} >=3; push(@speakers_xpl,$room); } - if($type eq 'object') { - &::print_log("PAobj: speakers_object: Adding $room") if $main::Debug{pa} >=3; - push(@speakers_obj,$room); - } if($type eq 'audrey') { &::print_log("PAobj: speakers_audrey: Adding $room") if $main::Debug{pa} >=3; push(@speakers_audrey,$room); } + if($type eq 'aviosys') { + &::print_log("PAobj: speakers_aviosys: Adding $room") if $main::Debug{pa} >=3; + push(@speakers_aviosys,$room); + } + if($type eq 'object') { + &::print_log("PAobj: speakers_object: Adding $room") if $main::Debug{pa} >=3; + push(@speakers_obj,$room); + } } &::print_log("PAobj: speakers_wdio: $#speakers_wdio") if $main::Debug{pa} >=2 || $#speakers_wdio gt -1; &::print_log("PAobj: speakers_x10: $#speakers_x10") if $main::Debug{pa} >=2 || $#speakers_x10 gt -1; &::print_log("PAobj: speakers_xap: $#speakers_xap") if $main::Debug{pa} >=2 || $#speakers_xap gt -1; &::print_log("PAobj: speakers_xpl: $#speakers_xpl") if $main::Debug{pa} >=2 || $#speakers_xpl gt -1; - &::print_log("PAobj: speakers_obj: $#speakers_obj") if $main::Debug{pa} >=2 || $#speakers_obj gt -1; &::print_log("PAobj: speakers_audrey: $#speakers_audrey") if $main::Debug{pa} >=2 || $#speakers_audrey gt -1; + &::print_log("PAobj: speakers_aviosys: $#speakers_aviosys") if $main::Debug{pa} >=2 || $#speakers_aviosys gt -1; + &::print_log("PAobj: speakers_obj: $#speakers_obj") if $main::Debug{pa} >=2 || $#speakers_obj gt -1; $pa_zones{active}{wdio}=join(',',@speakers_wdio); $pa_zones{active}{x10}=join(',',@speakers_x10); $pa_zones{active}{xap}=join(',',@speakers_xap); $pa_zones{active}{xpl}=join(',',@speakers_xpl); - $pa_zones{active}{obj}=join(',',@speakers_obj); $pa_zones{active}{audrey}=join(',',@speakers_audrey); + $pa_zones{active}{aviosys}=join(',',@speakers_aviosys); + $pa_zones{active}{obj}=join(',',@speakers_obj); $parms->{web_file}="web_file" if $#speakers_audrey gt -1; @@ -217,6 +229,7 @@ sub prep_parms && $pa_zones{active}{x10} eq '' && $pa_zones{active}{xap} eq '' && $pa_zones{active}{xpl} eq '' + && $pa_zones{active}{aviosys} eq '' && $pa_zones{active}{obj} eq '' ) { @@ -237,15 +250,17 @@ sub audio_hook my @speakers_x10=split(',',$pa_zones{active}{x10}); my @speakers_xap=split(',',$pa_zones{active}{xap}); my @speakers_xpl=split(',',$pa_zones{active}{xpl}); + my @speakers_aviosys=split(',',$pa_zones{active}{aviosys}); my @speakers_obj=split(',',$pa_zones{active}{obj}); #TODO: Properly handle $results across multiple types - #TODO: Break up the wdio zones based on serial port, in case there are more than one. + #TODO: Break up the wdio and aviosys zones based on serial port, in case there are more than one. $results=0; $results = $self->set_weeder($state,'weeder',@speakers_wdio) if $#speakers_wdio > -1; $results = $self->set_x10($state,@speakers_x10) if $#speakers_x10 > -1; $results = $self->set_xap($state,\@speakers_xap,\%voiceparms) if $#speakers_xap > -1; $results = $self->set_xpl($state,\@speakers_xpl,\%voiceparms) if $#speakers_xpl > -1; + $results = $self->set_aviosys($state,'aviosys',@speakers_aviosys) if $#speakers_aviosys > -1; $results = $self->set_obj($state,@speakers_obj) if $#speakers_obj > -1; &::print_log("PAobj: set results: $results") if $main::Debug{pa}; @@ -257,6 +272,7 @@ sub audio_hook && ( $pa_zones{active}{wdio} ne '' || $pa_zones{active}{x10} ne '' + || $pa_zones{active}{aviosys} ne '' || $pa_zones{active}{obj} ne '' ) ) { @@ -453,6 +469,31 @@ sub get_weeder_string return $card . "W$weeder_code"; } +sub set_aviosys +{ + my ($self,$state,$aviosys_port,@speakers) = @_; + my $aviosysref = {'on' => {'1' => '!','2' => '#','3' => '%','4' => '&','5' => '(','6' => '_','7' => '{','8' => '}' },'off' => {'1' => '@','2' => '$','3' => '^','4' => '*','5' => ')','6' => '-','7' => '[','8' => ']'}}; + my %aviosys_ref; + my $aviosys_command=''; + for my $room (@speakers) { + &::print_log("PAobj: set_aviosys: " . $room . " / " . $state) if $main::Debug{pa} >=3; + my $ref = &::get_object_by_name('pa_'.$room); + if ($ref) { + my ($id) = $ref->get_address(); + $aviosys_command .= $aviosysref->{$state}{$id}; + &::print_log("PAobj: port: $id, Room: $room") if $main::Debug{pa} >=2; + } else { + &::print_log("PAobj: Unable to locate object for: pa_$room"); + } + } + + return 0 unless $aviosys_command; + &::print_log("PAobj: Sending $aviosys_command to the aviosys card") if $main::Debug{pa}; + #$aviosys_command =~ s/\\r/\r/g; + #&Serial_Item::send_serial_data($aviosys_port, $aviosys_command) if $main::Serial_Ports{$aviosys_port}{object}; + return 1; +} + sub get_speakers { my ($self,$rooms) = @_; diff --git a/lib/read_table_A.pl b/lib/read_table_A.pl index f924d1343..fb3282303 100644 --- a/lib/read_table_A.pl +++ b/lib/read_table_A.pl @@ -573,6 +573,10 @@ sub read_table_A { $code .= sprintf "\$%-35s -> target_address('%s');\n",$name.'_obj',$address; $code .= sprintf "\$%-35s -> class_name('%s');\n",$name.'_obj',$serial; $code .= sprintf "\$%-35s -> tie_items(\$%s,'on','on');\n",$name,$name.'_obj'; + } elsif (lc $pa_type eq 'aviosys') { + my $aviosysref = {'on' => {'1' => '!','2' => '#','3' => '%','4' => '&','5' => '(','6' => '_','7' => '{','8' => '}' },'off' => {'1' => '@','2' => '$','3' => '^','4' => '*','5' => ')','6' => '-','7' => '[','8' => ']'}}; + $code .= sprintf "\$%-35s = new Serial_Item('%s','on','%s');\n",$name.'_obj',$aviosysref->{'on'}{$address},$serial; + $code .= sprintf "\$%-35s -> add ('%s','off');\n",$name.'_obj',$aviosysref->{'off'}{$address}; } else { print "\nUnrecognized .mht entry for PA: $record\n"; return; @@ -1134,4 +1138,4 @@ sub read_table_A { # Revision 1.3 2000/10/01 23:29:40 winter # - 2.29 release # -# \ No newline at end of file +# From 19e06d14f11c11a15dc2186068de9a2363b83162 Mon Sep 17 00:00:00 2001 From: Pmatis Date: Mon, 14 Oct 2013 22:34:33 -0400 Subject: [PATCH 11/18] Add support for multiple serial ports for weeder and aviosys. Fix erroneous code comment. --- lib/PAobj.pm | 32 ++++++++++++++++++++++++-------- 1 file changed, 24 insertions(+), 8 deletions(-) diff --git a/lib/PAobj.pm b/lib/PAobj.pm index e79680945..eceac04fd 100644 --- a/lib/PAobj.pm +++ b/lib/PAobj.pm @@ -244,23 +244,39 @@ sub audio_hook { my ($self,$state,%voiceparms) = @_; my $results = 0; -# my @speakers = split(',', $voiceparms{pa_zones}); - my @speakers_wdio=split(',',$pa_zones{active}{wdio}); + my (%speakers_aviosys,%speakers_wdio); my @speakers_x10=split(',',$pa_zones{active}{x10}); my @speakers_xap=split(',',$pa_zones{active}{xap}); my @speakers_xpl=split(',',$pa_zones{active}{xpl}); - my @speakers_aviosys=split(',',$pa_zones{active}{aviosys}); my @speakers_obj=split(',',$pa_zones{active}{obj}); - + #TODO: Properly handle $results across multiple types - #TODO: Break up the wdio and aviosys zones based on serial port, in case there are more than one. + $results=0; - $results = $self->set_weeder($state,'weeder',@speakers_wdio) if $#speakers_wdio > -1; $results = $self->set_x10($state,@speakers_x10) if $#speakers_x10 > -1; $results = $self->set_xap($state,\@speakers_xap,\%voiceparms) if $#speakers_xap > -1; $results = $self->set_xpl($state,\@speakers_xpl,\%voiceparms) if $#speakers_xpl > -1; - $results = $self->set_aviosys($state,'aviosys',@speakers_aviosys) if $#speakers_aviosys > -1; + + for my $room (split(',',$pa_zones{active}{aviosys})) { + my $ref = &::get_object_by_name('pa_'.$room); + my $serial=$ref->get_serial(); + &::print_log("PAobj: aviosys serial: " . $room . " / " . $serial) if $main::Debug{pa} >=3; + push(@{$speakers_aviosys{$serial}},$room); + } + foreach my $serial (keys(%speakers_aviosys)) { + $results = $self->set_aviosys($state,$serial,@{$speakers_aviosys{$serial}}); + } + for my $room (split(',',$pa_zones{active}{wdio})) { + my $ref = &::get_object_by_name('pa_'.$room); + my $serial=$ref->get_serial(); + &::print_log("PAobj: wdio serial: " . $room . " / " . $serial) if $main::Debug{pa} >=3; + push(@{$speakers_wdio{$serial}},$room); + } + foreach my $serial (keys(%speakers_wdio)) { + $results = $self->set_weeder($state,$serial,@{$speakers_wdio{$serial}}); + } + $results = $self->set_obj($state,@speakers_obj) if $#speakers_obj > -1; &::print_log("PAobj: set results: $results") if $main::Debug{pa}; @@ -490,7 +506,7 @@ sub set_aviosys return 0 unless $aviosys_command; &::print_log("PAobj: Sending $aviosys_command to the aviosys card") if $main::Debug{pa}; #$aviosys_command =~ s/\\r/\r/g; - #&Serial_Item::send_serial_data($aviosys_port, $aviosys_command) if $main::Serial_Ports{$aviosys_port}{object}; + &Serial_Item::send_serial_data($aviosys_port, $aviosys_command) if $main::Serial_Ports{$aviosys_port}{object}; return 1; } From fd3270da684ac159371cc3242dd39728d343309f Mon Sep 17 00:00:00 2001 From: Pmatis Date: Tue, 15 Oct 2013 13:21:24 -0400 Subject: [PATCH 12/18] Added debug print_log calls for serial port loops --- lib/PAobj.pm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/PAobj.pm b/lib/PAobj.pm index eceac04fd..68603e594 100644 --- a/lib/PAobj.pm +++ b/lib/PAobj.pm @@ -265,6 +265,7 @@ sub audio_hook push(@{$speakers_aviosys{$serial}},$room); } foreach my $serial (keys(%speakers_aviosys)) { + &::print_log("PAobj: calling set for aviosys serial port: $serial") if $main::Debug{pa} >=3; $results = $self->set_aviosys($state,$serial,@{$speakers_aviosys{$serial}}); } for my $room (split(',',$pa_zones{active}{wdio})) { @@ -274,6 +275,7 @@ sub audio_hook push(@{$speakers_wdio{$serial}},$room); } foreach my $serial (keys(%speakers_wdio)) { + &::print_log("PAobj: calling set for wdio serial port: $serial") if $main::Debug{pa} >=3; $results = $self->set_weeder($state,$serial,@{$speakers_wdio{$serial}}); } From a8f31f33058ca0fd8b00d9aaf7fe48949dce40f1 Mon Sep 17 00:00:00 2001 From: Pmatis Date: Tue, 15 Oct 2013 23:24:11 -0400 Subject: [PATCH 13/18] Embed speech clash resolution into pa_control.pl. Works better and speaks more reliably in desired rooms, due to correcting a race condition. --- code/common/pa_control.pl | 48 +++++++++++++++++++++++++++++++-------- lib/PAobj.pm | 19 ++++++++++++++-- 2 files changed, 55 insertions(+), 12 deletions(-) diff --git a/code/common/pa_control.pl b/code/common/pa_control.pl index 74e23e55c..3418fb753 100644 --- a/code/common/pa_control.pl +++ b/code/common/pa_control.pl @@ -35,7 +35,9 @@ #noloop=start my $pa_delay = $config_parms{pa_delay}; +my $pa_clash_delay = $config_parms{pa_clash_delay}; my $pa_timer = $config_parms{pa_timer}; +$pa_clash_delay = 1 unless $pa_clash_delay; $pa_delay = 0.5 unless $pa_delay; $pa_timer = 60 unless $pa_timer; $pactrl = new PAobj(); @@ -83,17 +85,42 @@ sub pa_parms_stub { } $parms->{pa_mode} = $mode; return if $mode eq 'mute' or $mode eq 'offline'; - - my $results = $pactrl->prep_parms($parms); - my %pa_zones = $pactrl->get_pa_zones(); - if (defined $pa_zones{audrey} && $pa_zones{audrey} ne '') { - print_log("PA: audrey zone detected, hooking via web_hook. (".$pa_zones{audrey}.")") if $Debug{pa}; - push(@{$parms->{web_hook}},\&pa_web_hook); - } + if($pactrl->active(1)) { + my $results = $pactrl->prep_parms($parms); + my %pa_zones = $pactrl->get_pa_zones(); + + if (defined $pa_zones{audrey} && $pa_zones{audrey} ne '') { + print_log("PA: audrey zone detected, hooking via web_hook. (".$pa_zones{audrey}.")") if $Debug{pa}; + push(@{$parms->{web_hook}},\&pa_web_hook); + } + + print_log("PA: parms_stub set results: $results") if $Debug{pa} >=2; + + } else { + #MH is already speaking, and other PA zones are already active. Delay speech. + if ($main::Debug{voice}) { + $$parms{clash_retry}=0 unless $$parms{clash_retry}; + &print_log("PA SPEECH CLASH($$parms{clash_retry}): Delaying speech call for " . $$parms{text} . "\n") unless $$parms{clash_retry} lt 1; + $$parms{clash_retry}++; #To track how many loops are made + } + $$parms{nolog}=1; #To stop MH from logging the speech again + + my $parmstxt; + my ($pkey,$pval); + while (($pkey,$pval) = each(%{$parms})) { + $parmstxt.=', ' if $parmstxt; + $parmstxt .= "$pkey => q($pval)"; + } + &print_log("PA SPEECH CLASH Parameters: $parmstxt") if $main::Debug{voice} && $$parms{clash_retry} eq 0; + &run_after_delay($pa_clash_delay, "speak($parmstxt)"); - print_log("PA: parms_stub set results: $results") if $Debug{pa} >=2; - + $$parms{no_speak}=1; #To stop MH from speaking this time around + return; + } + if ($$parms{clash_retry}) { + &print_log("PA SPEECH CLASH: Resolved, continuing speech."); + } } sub pa_control_stub { @@ -121,6 +148,7 @@ sub pa_web_hook { unset $pa_speaker_timer; print_log("PA: Turning speakers off") if $Debug{pa}; $pactrl->audio_hook(OFF,'normal'); + $pactrl->active(0); } #Setup Fail-safe speaker shutoff @@ -139,7 +167,7 @@ sub pa_web_hook { # #Type Address Name Groups Serial Type # -PA, AA, kitchen, all|default|mainfloor, weeder, wdio +PA, AA, kitchen, all|default|mainfloor, weeder, wdio PA, AB, server, all|basement, weeder, wdio PA, AG, master, all|default|upstairs, weeder2, wdio_old PA, B12, garage, all|outside, , X10 diff --git a/lib/PAobj.pm b/lib/PAobj.pm index 68603e594..8091f851c 100644 --- a/lib/PAobj.pm +++ b/lib/PAobj.pm @@ -33,6 +33,8 @@ package PAobj; @PAobj::ISA = ('Generic_Item'); +my $active; + sub last_char { my ($self,$string) = @_; @@ -61,6 +63,7 @@ sub init { return 0; } $self->check_group('default'); + $self->active(0); my @speakers = $self->get_speakers('allspeakers'); my (@speakers_wdio,@speakers_x10,@speakers_obj,@speakers_xap,@speakers_xpl,@speakers_audrey,@speakers_aviosys); @@ -113,7 +116,6 @@ sub init { if ($#speakers_wdio > -1) { $self->init_weeder(@speakers_wdio); - return 0 unless %pa_weeder_max_port; } if ($pa_zone_types{'x10'}) { &::print_log("PAobj: x10 PA type initialized...") if $main::Debug{pa}; @@ -154,10 +156,23 @@ sub init_weeder %pa_weeder_max_port = %weeder_max; } +sub active +{ + my ($self,$setactive) = @_; + &::print_log("PAobj: setactive: active: $active / set: $setactive\n") if $main::Debug{pa} >=4; + return $active unless defined $setactive; + if($active && $setactive) { + &::print_log("PAobj: Cannot make active, already active\n") if $main::Debug{pa} >=3; + return 0; + } + &::print_log("PAobj: setting active to: ".$setactive."\n") if $main::Debug{pa} >=3; + $active=$setactive; + return 1; +} + sub prep_parms { my ($self,$parms) = @_; - #my $self = {}; &::print_log("PAobj: delay: $$self{pa_delay}\n") if $main::Debug{pa} >=3; &::print_log("PAobj: set,mode: " . $parms->{mode} . ",rooms: " . $parms->{rooms}) if $main::Debug{pa} >=3; From de9e7d88d50e2aa5f8085dda8a7fb77a47665542 Mon Sep 17 00:00:00 2001 From: Pmatis Date: Wed, 16 Oct 2013 00:35:57 -0400 Subject: [PATCH 14/18] Clean up lib/Audrey_Play.pm, add proper description. --- lib/Audrey_Play.pm | 73 +++++++++++++++++++++++++++++++++++++++------- 1 file changed, 63 insertions(+), 10 deletions(-) diff --git a/lib/Audrey_Play.pm b/lib/Audrey_Play.pm index 550739e14..78cdc48e0 100644 --- a/lib/Audrey_Play.pm +++ b/lib/Audrey_Play.pm @@ -8,19 +8,23 @@ B - This object can be used to play sound files on the Audrey. =head1 SYNOPSIS +Created for use with PAobj.pm, but can be used separately. -blah blah - +=head1 DESCRIPTION +Tells an Audrey to download and play a file, already in the data/web folder, +by passing the name of the file. The Audrey must be modified to respond to +this request. -=head1 DESCRIPTION +$audrey1 = new Audrey_Play('192.168.0.11'); +#Create file data/web/tempfile.wav - perhaps by speaking to a file? +my $speakFile = 'tempfile.wav'; +$audrey1->play($speakFile); =head1 INHERITS B -=head1 METHODS - =over =cut @@ -29,10 +33,6 @@ B my $address; -sub Init { - #&::MainLoop_pre_add_hook( \&Weather_Item::check_weather, 1 ); -} - =item C $ip is the IP address of the Audrey. @@ -62,4 +62,57 @@ sub play { &::run("get_url -quiet http://" . $self->{address} . "/mhspeak.shtml?http://" . $MHWeb . "/" . $web_file . " /dev/null"); } -1; \ No newline at end of file +1; + +#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +=begin Audrey Config + +Exerpt from audreyspeak.pl + +You must make certain modifications to your Audrey, as follows: + +- Update the software and obtain root shell access capabilities (this + should be available by using Bruce's CF card image or by following + instructions available on the internet.) + +- Open the Audrey's web server to outside http requests + 1) Start the "Root Shell" + 2) type: cd /config + 3) type: cp rm-apps rm-apps.copy + 4) type: vi rm-apps + You'll be in the editor, editing the "rm-apps" file + About the 14th line down is "rb,/kojak/kojak-slinger, -c -e -s -i 127.1" + You need to delete the "-i 127.1" from the line. + To do this, place the cursor under the space right after the "-s" + Type the "x" key to start deleting from the line. + The line should end up looking like this: + "rb,/kojak/kojak-slinger, -c -e -s" + If you need to start over type a colon to get to the vi command line + At the colon prompt type "q!" and hit "enter" (this quits without saving) + If it looks good then at the colon prompt type "wq" to save changes + Now restart the Audrey by unplugging it, waiting 30 seconds and + plugging it back in. + +- Install playsound_noph and it's DLL + 1) Grab the zip file from http://www.planetwebb.com/audrey/ + 2) Place playsound_noph on the Audrey in /nto/photon/bin/ + 3) Place soundfile_noph.so on the Audrey in /nto/photon/dll/ + +- Install mhspeak.shtml on the Audrey + 1) Start the "Root Shell" + 2) type: cd /data/XML + 3) type: ftp blah.com mhspeak.shtml + + The MHSPEAK.SHTML file placed on the Audrey should contain the following: + + + + Shell + + + + + + + +=cut From 10f0dc5bf8fbc7e851fd7c85e0eae96c9fae986f Mon Sep 17 00:00:00 2001 From: Pmatis Date: Sun, 20 Oct 2013 01:31:41 -0400 Subject: [PATCH 15/18] Simplify pa type iteration, switch to arrow notation for referenced hash values. --- code/common/pa_control.pl | 14 ++-- lib/PAobj.pm | 162 +++++++++++--------------------------- 2 files changed, 51 insertions(+), 125 deletions(-) diff --git a/code/common/pa_control.pl b/code/common/pa_control.pl index 3418fb753..bb36db5ab 100644 --- a/code/common/pa_control.pl +++ b/code/common/pa_control.pl @@ -100,11 +100,11 @@ sub pa_parms_stub { } else { #MH is already speaking, and other PA zones are already active. Delay speech. if ($main::Debug{voice}) { - $$parms{clash_retry}=0 unless $$parms{clash_retry}; - &print_log("PA SPEECH CLASH($$parms{clash_retry}): Delaying speech call for " . $$parms{text} . "\n") unless $$parms{clash_retry} lt 1; - $$parms{clash_retry}++; #To track how many loops are made + $parms->{clash_retry}=0 unless $parms->{clash_retry}; + &print_log("PA SPEECH CLASH($parms->{clash_retry}): Delaying speech call for " . $parms->{text} . "\n") unless $parms->{clash_retry} lt 1; + $parms->{clash_retry}++; #To track how many loops are made } - $$parms{nolog}=1; #To stop MH from logging the speech again + $parms->{nolog}=1; #To stop MH from logging the speech again my $parmstxt; my ($pkey,$pval); @@ -112,13 +112,13 @@ sub pa_parms_stub { $parmstxt.=', ' if $parmstxt; $parmstxt .= "$pkey => q($pval)"; } - &print_log("PA SPEECH CLASH Parameters: $parmstxt") if $main::Debug{voice} && $$parms{clash_retry} eq 0; + &print_log("PA SPEECH CLASH Parameters: $parmstxt") if $main::Debug{voice} && $parms->{clash_retry} eq 0; &run_after_delay($pa_clash_delay, "speak($parmstxt)"); - $$parms{no_speak}=1; #To stop MH from speaking this time around + $parms->{no_speak}=1; #To stop MH from speaking this time around return; } - if ($$parms{clash_retry}) { + if ($parms->{clash_retry}) { &print_log("PA SPEECH CLASH: Resolved, continuing speech."); } } diff --git a/lib/PAobj.pm b/lib/PAobj.pm index 8091f851c..4a7f1949a 100644 --- a/lib/PAobj.pm +++ b/lib/PAobj.pm @@ -49,7 +49,7 @@ sub new bless $self,$class; - $$self{pa_delay} = 0.5; + $self->{pa_delay} = 0.5; return $self; } @@ -66,66 +66,26 @@ sub init { $self->active(0); my @speakers = $self->get_speakers('allspeakers'); - my (@speakers_wdio,@speakers_x10,@speakers_obj,@speakers_xap,@speakers_xpl,@speakers_audrey,@speakers_aviosys); + my %speakertype; for my $room (@speakers) { my $ref = &::get_object_by_name("pa_$room"); my $type = $ref->get_type(); &::print_log("PAobj: init: room=$room, zonetype=$type") if $main::Debug{pa}; $pa_zone_types{$type}++ unless $pa_zone_types{$type}; - - if($type eq 'wdio') { - push(@speakers_wdio,$room); - } - if($type eq 'x10') { - push(@speakers_x10,$room); - } - if($type eq 'xap') { - push(@speakers_xap,$room); - } - if($type eq 'xpl') { - push(@speakers_xpl,$room); - } - if($type eq 'object') { - push(@speakers_obj,$room); - } - if($type eq 'audrey') { - push(@speakers_audrey,$room); - } - if($type eq 'aviosys') { - push(@speakers_aviosys,$room); - } + push(@{$speakertype{$type}}, $room); } - &::print_log("PAobj: speakers_wdio: $#speakers_wdio") if $main::Debug{pa};# || $#speakers_wdio gt -1; - &::print_log("PAobj: speakers_x10: $#speakers_x10") if $main::Debug{pa};# || $#speakers_x10 gt -1; - &::print_log("PAobj: speakers_xap: $#speakers_xap") if $main::Debug{pa};# || $#speakers_xap gt -1; - &::print_log("PAobj: speakers_xpl: $#speakers_xpl") if $main::Debug{pa};# || $#speakers_xpl gt -1; - &::print_log("PAobj: speakers_audrey: $#speakers_audrey") if $main::Debug{pa};# || $#speakers_audrey gt -1; - &::print_log("PAobj: speakers_aviosys: $#speakers_aviosys") if $main::Debug{pa};# || $#speakers_aviosys gt -1; - &::print_log("PAobj: speakers_obj: $#speakers_obj") if $main::Debug{pa};# || $#speakers_obj gt -1; - - - $pa_zones{all}{wdio}=join(',',@speakers_wdio); - $pa_zones{all}{x10}=join(',',@speakers_x10); - $pa_zones{all}{xap}=join(',',@speakers_xap); - $pa_zones{all}{xpl}=join(',',@speakers_xpl); - $pa_zones{all}{audrey}=join(',',@speakers_audrey); - $pa_zones{all}{aviosys}=join(',',@speakers_aviosys); - $pa_zones{all}{obj}=join(',',@speakers_obj); - - if ($#speakers_wdio > -1) { - $self->init_weeder(@speakers_wdio); - } - if ($pa_zone_types{'x10'}) { - &::print_log("PAobj: x10 PA type initialized...") if $main::Debug{pa}; - } - if ($pa_zone_types{'xap'}) { - &::print_log("PAobj: xAP PA type initialized...") if $main::Debug{pa}; - } - if ($pa_zone_types{'xpl'}) { - &::print_log("PAobj: xPL PA type initialized...") if $main::Debug{pa}; - } + foreach my $type (keys(%speakertype)) { + my @thespeakers = \@{$speakertype{$type}}; + &::print_log("PAobj: speakers_$type: $#thespeakers") if $main::Debug{pa}; + $pa_zones{all}{$type}=join(',',@thespeakers); + if ($#thespeakers > -1) { + &::print_log("PAobj: $type PA type initialized...") if $main::Debug{pa}; + $self->init_weeder(@thespeakers) if $type eq 'wdio'; + } + } + return 1; } @@ -162,10 +122,10 @@ sub active &::print_log("PAobj: setactive: active: $active / set: $setactive\n") if $main::Debug{pa} >=4; return $active unless defined $setactive; if($active && $setactive) { - &::print_log("PAobj: Cannot make active, already active\n") if $main::Debug{pa} >=3; + &::print_log("PAobj: Cannot make active, already active\n") if $main::Debug{pa}; return 0; } - &::print_log("PAobj: setting active to: ".$setactive."\n") if $main::Debug{pa} >=3; + &::print_log("PAobj: setting active to: ".$setactive."\n") if $main::Debug{pa} >=2; $active=$setactive; return 1; } @@ -184,59 +144,24 @@ sub prep_parms $parms->{pa_zones} = join(',', @speakers); - my (@speakers_wdio,@speakers_x10,@speakers_obj,@speakers_xap,@speakers_xpl,@speakers_audrey,@speakers_aviosys); + my %speakertype; for my $room (@speakers) { my $ref = &::get_object_by_name("pa_$room"); - my $type = lc $ref->get_type(); - if($type eq 'wdio' || $type eq 'wdio_old') { - &::print_log("PAobj: speakers_wdio: Adding $room") if $main::Debug{pa} >=3; - push(@speakers_wdio,$room); - } - if($type eq 'x10') { - &::print_log("PAobj: speakers_x10: Adding $room") if $main::Debug{pa} >=3; - push(@speakers_x10,$room); - } - if($type eq 'xap') { - &::print_log("PAobj: speakers_xap: Adding $room") if $main::Debug{pa} >=3; - push(@speakers_xap,$room); - } - if($type eq 'xpl') { - &::print_log("PAobj: speakers_xpl: Adding $room") if $main::Debug{pa} >=3; - push(@speakers_xpl,$room); - } - if($type eq 'audrey') { - &::print_log("PAobj: speakers_audrey: Adding $room") if $main::Debug{pa} >=3; - push(@speakers_audrey,$room); - } - if($type eq 'aviosys') { - &::print_log("PAobj: speakers_aviosys: Adding $room") if $main::Debug{pa} >=3; - push(@speakers_aviosys,$room); - } - if($type eq 'object') { - &::print_log("PAobj: speakers_object: Adding $room") if $main::Debug{pa} >=3; - push(@speakers_obj,$room); - } + my $type = $ref->get_type(); + &::print_log("PAobj: speakers_$type: Adding $room") if $main::Debug{pa} >=3; + $pa_zone_types{$type}++ unless $pa_zone_types{$type}; + push(@{$speakertype{$type}}, $room); } - &::print_log("PAobj: speakers_wdio: $#speakers_wdio") if $main::Debug{pa} >=2 || $#speakers_wdio gt -1; - &::print_log("PAobj: speakers_x10: $#speakers_x10") if $main::Debug{pa} >=2 || $#speakers_x10 gt -1; - &::print_log("PAobj: speakers_xap: $#speakers_xap") if $main::Debug{pa} >=2 || $#speakers_xap gt -1; - &::print_log("PAobj: speakers_xpl: $#speakers_xpl") if $main::Debug{pa} >=2 || $#speakers_xpl gt -1; - &::print_log("PAobj: speakers_audrey: $#speakers_audrey") if $main::Debug{pa} >=2 || $#speakers_audrey gt -1; - &::print_log("PAobj: speakers_aviosys: $#speakers_aviosys") if $main::Debug{pa} >=2 || $#speakers_aviosys gt -1; - &::print_log("PAobj: speakers_obj: $#speakers_obj") if $main::Debug{pa} >=2 || $#speakers_obj gt -1; - - - $pa_zones{active}{wdio}=join(',',@speakers_wdio); - $pa_zones{active}{x10}=join(',',@speakers_x10); - $pa_zones{active}{xap}=join(',',@speakers_xap); - $pa_zones{active}{xpl}=join(',',@speakers_xpl); - $pa_zones{active}{audrey}=join(',',@speakers_audrey); - $pa_zones{active}{aviosys}=join(',',@speakers_aviosys); - $pa_zones{active}{obj}=join(',',@speakers_obj); - - $parms->{web_file}="web_file" if $#speakers_audrey gt -1; + foreach my $type (keys(%speakertype)) { + my @thespeakers = @{$speakertype{$type}}; + &::print_log("PAobj: speakers_$type: $#thespeakers: " . join(',',@thespeakers)) if $main::Debug{pa}; + $pa_zones{active}{$type}=join(',',@thespeakers); + if ($#thespeakers > -1) { + $parms->{web_file}="web_file" if $type eq 'audrey'; + } + } if( 1 @@ -248,7 +173,7 @@ sub prep_parms && $pa_zones{active}{obj} eq '' ) { - $$parms{to_file}='/dev/null'; + $parms->{to_file}='/dev/null'; } return 1; @@ -297,7 +222,7 @@ sub audio_hook $results = $self->set_obj($state,@speakers_obj) if $#speakers_obj > -1; &::print_log("PAobj: set results: $results") if $main::Debug{pa}; - select undef, undef, undef, $$self{pa_delay} if $results; + select undef, undef, undef, $self->{pa_delay} if $results; $results=0; if( @@ -469,7 +394,8 @@ sub get_weeder_string for $bit ('A' .. $pa_weeder_max_port{$card}) { $id = $card . 'L' . $bit; - $id = "D$id" if $$self{pa_type} eq 'wdio_old'; #TODO: Find way to implement this with new code + #TODO: Find way to implement this with new code + #$id = "D$id" if $self->{pa_type} eq 'wdio_old'; my $ref = &Device_Item::item_by_id($id); if ($ref) { $state = $ref->{state}; @@ -495,7 +421,7 @@ sub get_weeder_string $weeder_code = $decimal_to_hex{$byte_code} . $weeder_code; } - if ($$self{pa_type} eq 'wdio_old') { #TODO: Find way to implement this with new code + if ($self->{pa_type} eq 'wdio_old') { #TODO: Find way to implement this with new code $card = "D$card"; $weeder_code = 'h' . $weeder_code; } @@ -613,7 +539,7 @@ sub get_pa_zones sub set_delay { my ($self,$delay) = @_; - $$self{pa_delay} = $delay; + $self->{pa_delay} = $delay; } sub print_speaker_states @@ -648,11 +574,11 @@ sub new bless $self,$class; - $$self{name} = $paz_name; - $$self{address} = $paz_address; - $$self{groups} = $paz_groups; - $$self{serial} = $paz_serial; - $$self{other} = $paz_other; + $self->{name} = $paz_name; + $self->{address} = $paz_address; + $self->{groups} = $paz_groups; + $self->{serial} = $paz_serial; + $self->{other} = $paz_other; return $self; } @@ -665,31 +591,31 @@ sub init sub get_address { my ($self) = @_; - return $$self{address}; + return $self->{address}; } sub get_name { my ($self) = @_; - return $$self{name}; + return $self->{name}; } sub get_groups { my ($self) = @_; - return $$self{groups}; + return $self->{groups}; } sub get_serial { my ($self) = @_; - return $$self{serial}; + return $self->{serial}; } sub get_type { my ($self) = @_; - return $$self{other}; + return $self->{other}; } 1; From 6cb48b78d9fb8648986338c6fecf6e3762ceaef9 Mon Sep 17 00:00:00 2001 From: Pmatis Date: Sun, 20 Oct 2013 01:49:18 -0400 Subject: [PATCH 16/18] Fix array reference for wdio. --- lib/PAobj.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/PAobj.pm b/lib/PAobj.pm index 4a7f1949a..abee38043 100644 --- a/lib/PAobj.pm +++ b/lib/PAobj.pm @@ -77,7 +77,7 @@ sub init { } foreach my $type (keys(%speakertype)) { - my @thespeakers = \@{$speakertype{$type}}; + my @thespeakers = @{$speakertype{$type}}; &::print_log("PAobj: speakers_$type: $#thespeakers") if $main::Debug{pa}; $pa_zones{all}{$type}=join(',',@thespeakers); if ($#thespeakers > -1) { From 10e62b596bc02447eec0bdf9c043781dc06dd8cc Mon Sep 17 00:00:00 2001 From: Pmatis Date: Sun, 20 Oct 2013 02:00:39 -0400 Subject: [PATCH 17/18] Cause print_log statements to display the actual number of array elements, rather than the index of the last element. (index 0 = element 1) --- lib/PAobj.pm | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lib/PAobj.pm b/lib/PAobj.pm index abee38043..a106a067b 100644 --- a/lib/PAobj.pm +++ b/lib/PAobj.pm @@ -78,7 +78,7 @@ sub init { foreach my $type (keys(%speakertype)) { my @thespeakers = @{$speakertype{$type}}; - &::print_log("PAobj: speakers_$type: $#thespeakers") if $main::Debug{pa}; + &::print_log("PAobj: speakers_$type: ".($#thespeakers+1)) if $main::Debug{pa}; $pa_zones{all}{$type}=join(',',@thespeakers); if ($#thespeakers > -1) { &::print_log("PAobj: $type PA type initialized...") if $main::Debug{pa}; @@ -156,7 +156,7 @@ sub prep_parms foreach my $type (keys(%speakertype)) { my @thespeakers = @{$speakertype{$type}}; - &::print_log("PAobj: speakers_$type: $#thespeakers: " . join(',',@thespeakers)) if $main::Debug{pa}; + &::print_log("PAobj: speakers_$type: ".($#thespeakers+1).": " . join(',',@thespeakers)) if $main::Debug{pa}; $pa_zones{active}{$type}=join(',',@thespeakers); if ($#thespeakers > -1) { $parms->{web_file}="web_file" if $type eq 'audrey'; @@ -271,7 +271,7 @@ sub set_audrey { my ($self,$speakFile,@speakers) = @_; &::print_log("PAobj: set_audrey: file: " . $speakFile) if $main::Debug{pa} >=4; - &::print_log("PAobj: set_audrey: count: " . $#speakers) if $main::Debug{pa} >=4; + &::print_log("PAobj: set_audrey: count: " . ($#speakers+1)) if $main::Debug{pa} >=4; for my $room (@speakers) { #my $ref = &::get_object_by_name('pa_'.$room); @@ -496,7 +496,7 @@ sub check_group my $ref = &::get_object_by_name("pa_$group"); if (!$ref) {&::print_log("PAobj: check group: Error! Group does not exist: $group"); return;} my @list = $ref->list; - &::print_log("PAobj: check group=$group, list=$#list") if $main::Debug{pa} >=2; + &::print_log("PAobj: check group=$group, list=".($#list+1)) if $main::Debug{pa} >=2; if ($#list == -1) { &::print_log("PAobj: check populating group: $group!") if $main::Debug{pa}; for my $room ($self->get_speakers('allspeakers')) { @@ -522,7 +522,7 @@ sub get_speakers_speakable my $gss_mode = $ref->{mode}; if ($gss_mode ne 'sleeping' && ($gss_mode eq 'normal' || $mode eq 'unmuted')) { push(@pazones,$room); - &::print_log("PAobj: speakable: Pushing $room into pazones array:$#pazones") if $main::Debug{pa} >=2; + &::print_log("PAobj: speakable: Pushed $room into pazones array. New count:".($#pazones+1)) if $main::Debug{pa} >=2; } } } From 26976c267afbf7155788a5e8af1414796dfc6b30 Mon Sep 17 00:00:00 2001 From: Pmatis Date: Mon, 21 Oct 2013 21:55:31 -0400 Subject: [PATCH 18/18] Added Alsa support through amixer to enable left and right audio and multiple speaker out channels to be used as separate PA rooms. --- code/common/pa_control.pl | 12 ++++++++- lib/PAobj.pm | 51 ++++++++++++++++++++++++++++++++++----- lib/read_table_A.pl | 4 ++- 3 files changed, 59 insertions(+), 8 deletions(-) diff --git a/code/common/pa_control.pl b/code/common/pa_control.pl index bb36db5ab..5ce3d7b51 100644 --- a/code/common/pa_control.pl +++ b/code/common/pa_control.pl @@ -175,6 +175,11 @@ sub pa_web_hook { PA, 192.168.0.1,family, all|mainfloor, , xap PA, 192.168.0.2,dining, all|mainfloor, , xpl PA, 192.168.0.3,table, all|mainfloor, , audrey +# +PA, Headphone:0:L, mix1l, all, , amixer +PA, Headphone:0:R, mix1r, all, , amixer +PA, Headphone:1, mix2, all, , amixer +PA, Headphone:1:R, mix2r, all, , amixer Type: "PA", constant. This must be there. @@ -185,6 +190,11 @@ sub pa_web_hook { if the command to turn on the pin you want is: BHC, then the Address is: BC For X10, the X10 address of the (likely) relay device. For xAP, xPL and audrey, use the IP address or hostname of the target device. + For amixer (Linux Only), use the alsa mixer name. My laptop has "Headphone" and + "Headphone 1". This is really "Headphone,0" and "Headphone,1". They are also both + stereo. Use : as a separator, and then add L or R to control the left or right + channel. Omitting this causes BOTH channels to be turned on. There's several examples + above. For "object", use the name of the object (without the $). You may use anything that responds ON and OFF set commands. Tested with and Insteon device. @@ -203,7 +213,7 @@ sub pa_web_hook { The default is "weeder". Note that this can be changed with an INI parm. Other: Optional. Sets the type of PA control. Defaults to 'wdio'. Available options are: - wdio,wdio_old,X10,xpl,xap,audrey,object + wdio,wdio_old,X10,xpl,xap,audrey,amixer,object @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ =begin Audrey Config diff --git a/lib/PAobj.pm b/lib/PAobj.pm index a106a067b..ae3f8b346 100644 --- a/lib/PAobj.pm +++ b/lib/PAobj.pm @@ -170,6 +170,7 @@ sub prep_parms && $pa_zones{active}{xap} eq '' && $pa_zones{active}{xpl} eq '' && $pa_zones{active}{aviosys} eq '' + && $pa_zones{active}{amixer} eq '' && $pa_zones{active}{obj} eq '' ) { @@ -189,6 +190,7 @@ sub audio_hook my @speakers_x10=split(',',$pa_zones{active}{x10}); my @speakers_xap=split(',',$pa_zones{active}{xap}); my @speakers_xpl=split(',',$pa_zones{active}{xpl}); + my @speakers_amixer=split(',',$pa_zones{active}{amixer}); my @speakers_obj=split(',',$pa_zones{active}{obj}); #TODO: Properly handle $results across multiple types @@ -200,7 +202,7 @@ sub audio_hook for my $room (split(',',$pa_zones{active}{aviosys})) { my $ref = &::get_object_by_name('pa_'.$room); - my $serial=$ref->get_serial(); + my $serial=$ref->get_serial(); &::print_log("PAobj: aviosys serial: " . $room . " / " . $serial) if $main::Debug{pa} >=3; push(@{$speakers_aviosys{$serial}},$room); } @@ -210,7 +212,7 @@ sub audio_hook } for my $room (split(',',$pa_zones{active}{wdio})) { my $ref = &::get_object_by_name('pa_'.$room); - my $serial=$ref->get_serial(); + my $serial=$ref->get_serial(); &::print_log("PAobj: wdio serial: " . $room . " / " . $serial) if $main::Debug{pa} >=3; push(@{$speakers_wdio{$serial}},$room); } @@ -219,6 +221,7 @@ sub audio_hook $results = $self->set_weeder($state,$serial,@{$speakers_wdio{$serial}}); } + $results = $self->set_amixer($state,@speakers_amixer) if $#speakers_amixer > -1; $results = $self->set_obj($state,@speakers_obj) if $#speakers_obj > -1; &::print_log("PAobj: set results: $results") if $main::Debug{pa}; @@ -453,6 +456,34 @@ sub set_aviosys return 1; } +sub set_amixer +{ + my ($self,$state,@speakers) = @_; + my %amixerref; + my $mixpercent; + $mixpercent = '0%' if lc $state eq 'off'; + $mixpercent = '100%' if lc $state eq 'on'; + for my $room (@speakers) { + my $ref = &::get_object_by_name('pa_'.$room); + &::print_log("PAobj: set_amixer: " . $room . " / " . $state . " / " . $ref->{mixer} . " / " . $ref->{mixerchan}) if $main::Debug{pa} >=3; + + if(defined($ref->{mixerchan})) { + $amixerref{$ref->{mixer}}{'l'}='0%' unless $amixerref{$ref->{mixer}}{'l'}; + $amixerref{$ref->{mixer}}{'r'}='0%' unless $amixerref{$ref->{mixer}}{'r'}; + $amixerref{$ref->{mixer}}{$ref->{mixerchan}}=$mixpercent if $mixpercent; + } else { + $amixerref{$ref->{mixer}}{'l'}=$mixpercent if $mixpercent; + $amixerref{$ref->{mixer}}{'r'}=$mixpercent if $mixpercent; + } + } + foreach my $mixer (keys(%amixerref)) { + my $mixcmd = "amixer -q set $mixer ".$amixerref{$mixer}{'l'}.','.$amixerref{$mixer}{'r'}; + &main::print_log("PAobj: set_amixer: CMD: $mixcmd") if $main::Debug{pa} >=2; + my $r = system $mixcmd; + &main::print_log("PAobj: set_amixer: ERROR running command: $mixcmd") if $r != 0; + } +} + sub get_speakers { my ($self,$rooms) = @_; @@ -566,10 +597,10 @@ sub last_char return((sort @chars)[-1]); } -#Type Address Name Groups Serial Other +#Type Address Name Groups Serial Type sub new { - my ($class,$paz_address,$paz_name,$paz_groups,$paz_serial,$paz_other) = @_; + my ($class,$paz_address,$paz_name,$paz_groups,$paz_serial,$paz_type) = @_; my $self={}; bless $self,$class; @@ -578,7 +609,15 @@ sub new $self->{address} = $paz_address; $self->{groups} = $paz_groups; $self->{serial} = $paz_serial; - $self->{other} = $paz_other; + $self->{type} = $paz_type; + + if(lc $paz_type eq 'amixer') { + #Headphone:0:L + my ($mixer,$mixernum,$channel) = split(':',$self->{address}); + &main::print_log("$mixer / $mixernum / $channel"); + $self->{mixer} = "$mixer,$mixernum"; + $self->{mixerchan} = lc $channel if $channel; + } return $self; } @@ -615,7 +654,7 @@ sub get_serial sub get_type { my ($self) = @_; - return $self->{other}; + return $self->{type}; } 1; diff --git a/lib/read_table_A.pl b/lib/read_table_A.pl index f162ed2a8..26a28e39e 100644 --- a/lib/read_table_A.pl +++ b/lib/read_table_A.pl @@ -528,7 +528,7 @@ sub read_table_A { my ($pa_type, $serial); ($address, $name, $grouplist, $serial, $pa_type, @other) = @item_info; $pa_type = 'wdio' unless $pa_type; - + if( ! $packages{PAobj}++ ) { # first time for this object type? $code .= "my (%pa_weeder_max_port,%pa_zone_types,%pa_zone_type_by_zone);\n"; } @@ -585,6 +585,8 @@ sub read_table_A { my $aviosysref = {'on' => {'1' => '!','2' => '#','3' => '%','4' => '&','5' => '(','6' => '_','7' => '{','8' => '}' },'off' => {'1' => '@','2' => '$','3' => '^','4' => '*','5' => ')','6' => '-','7' => '[','8' => ']'}}; $code .= sprintf "\$%-35s = new Serial_Item('%s','on','%s');\n",$name.'_obj',$aviosysref->{'on'}{$address},$serial; $code .= sprintf "\$%-35s -> add ('%s','off');\n",$name.'_obj',$aviosysref->{'off'}{$address}; + } elsif (lc $pa_type eq 'amixer') { + #Nothing needed here, except to avoid the "else" statement. } else { print "\nUnrecognized .mht entry for PA: $record\n"; return;