#!/usr/bin/perl -w
#==============================================================================
#=== License
#==============================================================================
# Copyright (c) Date Fri Nov  8 21:11:38 MST 2002
# Author Shane Mason <me@perlbox.org>
# Author Eric Andrechek <eric@openthought.net>

#This file is part of Perlbox Voice Application Framework.

#Perlbox Voice is free software; you can redistribute it and/or modify
#it under the terms of the GNU General Public License as published by
#the Free Software Foundation; either version 2 of the License, or
#(at your option) any later version.

#Perlbox Voice is distributed in the hope that it will be useful,
#but WITHOUT ANY WARRANTY; without even the implied warranty of
#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#GNU General Public License for more details.

#You should have received a copy of the GNU General Public License
#along with Foobar; if not, write to the Free Software
#Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

#==============================================================================
#=== PerlboxListener.pl:
#This script plays the part of controling and decoding information from the
#sphinx2 listnening agent.
#==============================================================================



use lib "/usr/lib/perlbox-voice";

use lib ".";

use Perlbox::ThirdParty::Config::Simple;
#use Perlbox::Voice();
use strict;
use constant SHARABLE_LOCK_OPTION	=> ':lock';
use Perlbox::ThirdParty::IPC::Shareable (SHARABLE_LOCK_OPTION);


#Initialize constants
use constant CONFIG_FPATH	=> $ENV{"HOME"}."/.perlbox-voice/Listener.conf";	#path to configuration file

use constant READY_STATE        => 1;			#listener is ready
use constant LISTENING_STATE	  => 2;			#listener is hearing something
use constant UNDERSTOOD_STATE   => 3;			#input parsed and understood
use constant GARBLED_STATE      => 4;			#input parsed but not understood
use constant EXITED_STATE       => 5;			#listener has exited
use constant SAY_STATE	        => 6;			#Perlbox::Voice raised and unknown event
use constant LOCKED_STATE       => 7;
use constant UNLOCKED_STATE     => 8;

use constant TRUE		=> 1;			#boolean true
use constant FALSE		=> 0;			#boolean false

use constant SHARED_MEMORY_MODE	=> 0644;		#mode for
use constant SHARED_MEMORY_GLUE	=> 'data';		#type for shared memory slot

    #command-Action paralel arrays
    my @human_says;
    my @computer_does;

    #Initialize some variables
    my $current_message = FALSE;			#shareed memory reference slot
    
    my $use_magicword   = FALSE;
    my $magicword       = "";
    my $magicword_on    = 0;
    my $magicword_ontime   = 0;
    my $magicword_interval = 0;
    
    #Initialize Shared memory
    my %shared_memory_options = (			#options for IPC::Sharable
        create    => FALSE,
        exclusive => FALSE,
        mode      => SHARED_MEMORY_MODE,
        destroy   => FALSE,
        );


    #tie our reference variable to the shared slot
    tie $current_message, 'Perlbox::ThirdParty::IPC::Shareable', SHARED_MEMORY_GLUE, { %shared_memory_options } or
                                                    die "Listener.pl says: tie on shared memory failed\n";
                                                    
 
     
    #make sure it starts at zero
    $current_message=FALSE;

	# Create a config
	my $config = 'Perlbox::ThirdParty::Config::Simple'->new( CONFIG_FPATH );


#Due to the simplicity of this script, there is no reason
#to not use a simple event loop: So here we call it:
run_sphinx();



exit;

#implements the event loop.
sub run_sphinx{
    #Now read the commands array
    $config=undef;
    $config = 'Perlbox::ThirdParty::Config::Simple'->new( CONFIG_FPATH );
    read_commands_config();

    open(LISTENER, make_sphinx_command()."|");

    while(my $msg = <LISTENER>){
       chomp $msg;
       #first we test the magic interval is up
       if( $magicword_on ){
          my $lapsed = time - $magicword_ontime; 
          if($lapsed >= $magicword_interval){
             $magicword_on = 0;
             super_handler( LOCKED_STATE, $msg );
          } 
          
       }
           
      if( $msg =~/^READY\.\.\.\.$/ ) {
            super_handler( READY_STATE );
      }
      elsif( $msg =~/^Listening\.\.\.$/ ) {
            super_handler( LISTENING_STATE );
      }
      elsif( $msg =~ /^\d+\: / ) {
            $msg =~ s/^\d+\: (.*) $/$1/;
            #then go see if we have a command
            issue_command($msg);
            sleep 1;
      }
    

    }
    $current_message = EXITED_STATE;
}

#here we decode the message passed by sphinx. If it matches a known command, we are in business
sub issue_command{
    my $this_command = lc(shift);
    my $found_flag = FALSE;
    my $magic_flag = FALSE;
    if ( $use_magicword and not $magicword_on ){
       if( $this_command =~ /^$magicword/ ){
          super_handler( UNLOCKED_STATE );
          $magicword_on = TRUE;
          #now we need to set the tie to turn it off
          $magicword_ontime = time;
          #now we want to remove the magic word and send it on to process
          $this_command =~ s/^$magicword //;
          $magic_flag = TRUE;
       }
    }
    
    if(($use_magicword and $magicword_on) or not $use_magicword){
      for(my $i=0; ($i<@human_says and (!$found_flag)) ;$i++){
      
         if($this_command eq $human_says[$i]){
            
            if(!($computer_does[$i]=~/^say/)){
               $found_flag=TRUE;
               super_handler( UNDERSTOOD_STATE, $this_command );
               system($computer_does[$i]."&");
            }
            else{
               #then we have a 'say' and we want to handle that ourself
               my $say_string;
               $say_string = $computer_does[$i];
               $say_string =~ s/say //;
             
               #first test for backticks
               #which means that we should get the output of some commands
               if( $say_string =~ /`/ ){
                  $say_string = fill_backticks( $say_string );
               }
               super_handler( SAY_STATE, $say_string );
               $found_flag = SAY_STATE;
            }
         }
      }
    }#end else
    
    if( not $found_flag and $use_magicword and $magicword_on and not $magic_flag){
       super_handler( GARBLED_STATE, $this_command );
    }
    elsif( not $found_flag and $use_magicword and not $magicword_on){
       super_handler( LOCKED_STATE );
    }
    elsif( not $found_flag and not $use_magicword ){
       super_handler( GARBLED_STATE, $this_command );
    }
    return $found_flag;
}#end sub issue_command

#make the command to open sphinx with the correct arguments
sub make_sphinx_command{

    my $task = $config->param("path_section.task");
    my $lm   = $config->param("path_section.language_model");
    my $dict = $config->param("path_section.dict");
    my $hmm  = $config->param("path_section.hmm");
    my $s2continuous = $config->param("path_section.s2continuous");

    my $spinx_command = join " ",
        "$s2continuous -live TRUE -ctloffset 0 -ctlcount 100000000",
        "-cepdir $task/ctl -datadir $task/ctl -agcemax TRUE -langwt 6.5",
        "-fwdflatlw 8.5 -rescorelw 9.5 -ugwt 0.5 -fillpen 1e-10",
        "-silpen 0.005 -inspen 0.65 -top 1 -topsenfrm 3 -topsenthresh -70000",
        "-beam 2e-06 -npbeam 2e-06 -lpbeam 2e-05 -lponlybeam 0.0005",
        "-nwbeam 0.0005 -fwdflat FALSE -fwdflatbeam 1e-08",
        "-fwdflatnwbeam 0.0003 -bestpath TRUE -kbdumpdir $task",
        "-lmfn $lm -dictfn $dict -noisedict $hmm/noisedict",
        "-phnfn $hmm/phone -mapfn $hmm/map -hmmdir $hmm -hmmdirlist $hmm",
        "-8bsen TRUE -sendumpfn $hmm/sendump -cbdir $hmm";

    return $spinx_command;

}#end sub makeCommand

sub read_commands_config {

    #empty anything in the command-Action paralel arrays
    @human_says=();
    @computer_does=();

    #get a hash
    my %commands = $config->param_hash();

    #read command hashed into arrays. Why? Hashes are not proper.
    foreach my $key (keys (%commands)) {
        if($key =~ /command_section/){
           my @tmp = split(/\./,$key);
           push( @human_says, $tmp[1]);
           push( @computer_does, $commands{$key} )
        }
    }
   
    #now we also want to get the magic word
    $magicword = lc($config->param( 'option_section.magic' ));
    $use_magicword = $config->param( 'option_section.use_magic' );
    $magicword_interval = $config->param( 'option_section.magic_interval' );
}

#return information to VoiceServer via the shared memory slot.
sub super_handler {
    my $event = shift;
    my $msg = shift;
    if( $event == READY_STATE ) {
	    $current_message = READY_STATE;
    }
    elsif( $event == LISTENING_STATE ) {
	    $current_message = LISTENING_STATE;
    }
    elsif( $event == EXITED_STATE ) {
	    $current_message = EXITED_STATE;
    }
    elsif( $event == UNDERSTOOD_STATE ) {
	    $current_message = UNDERSTOOD_STATE."|$msg";
    }
    elsif( $event == GARBLED_STATE ) {
	    $current_message = GARBLED_STATE."|$msg";
    }
    elsif( $event == SAY_STATE ) {
	    $current_message = SAY_STATE."|$msg";
    }
    elsif( $event == UNLOCKED_STATE ){
       $current_message = UNLOCKED_STATE;
    }
    elsif( $event == LOCKED_STATE ){
       $current_message = LOCKED_STATE;
    }
}#end sub superhandler

#for say commands with backticks
sub fill_backticks{
   my $say_string = shift;
   
   my @fields = split(/(`)(.*?)(`)/, $say_string);
   my $in_tick = 0;
   
   my $final_string = "";
   foreach my $thispart (@fields){
      if(  $thispart eq '`' and not $in_tick){
         $in_tick = 1;
      }
      elsif( $thispart eq '`' and $in_tick ){
         $in_tick = 0;
      }
      elsif( $thispart ne '`' and $in_tick){
         my $this_output = "";
         open(COM,"$thispart |");
         while( my $this_return = <COM> ){
            chomp $this_return;
            $this_output .= " " .$this_return; 
         }
         $final_string .= $this_output;
      }
      else{
         $final_string .= $thispart;
      }
   }
   
   $final_string =~ s/  / /g;
   
   return $final_string;
}
=head1 NAME
PerlboxListener.pl - This file contains the process object that interfaces Sphinx2 system.

=head Version
This document refers to version 0.8 of PerlboxListener.pl of Perlbox Voice Application Framework and
all future releases.

=head1 SYNOPSIS

This file should not be ran from the command line. This program is depedent upon communication
with a running Perlbox::VoiceServer.

=head1 DESCRIPTION

Running process that controls and own running sphinx listener.

=head1 SEE ALSO

For more information on how to program with perlbox: look at the code.

=head1 Files

  Requires Perlbox (All included with this package):

  Perlbox::Response::VoiceResponse;
  Perlbox::Vocabulary::VocabularyAdd;
  Perlbox::ThirdParty::IPC::Shareable;
  Perlbox::ThirdParty::Config::Simple;

  Other Requirements:
  None

=head1 AUTHORS

 Shane C. Mason (me at perlbox dot org)
 Eric Andrechek (eric at openthought dot net)



=cut
