package Perlbox::VoiceServer;

#==============================================================================
#=== License
#==============================================================================
# Copyright (c) Date Fri Nov  8 21:11:38 MST 2002
# Author Shane Mason <me@perlbox.org>

#This file is part of Perlbox Voice.

#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.

require 5.002;

use strict;
use Perlbox::ThirdParty::Config::Simple;

use Perlbox::Response::VoiceResponse;               #handles voice response
use Perlbox::Vocabulary::VocabularyAdd;             #handles vocabulary editing
use Perlbox::Plugins::Desktop;



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

use constant SHARABLE_LOCK_OPTION	=> ':lock';

use Perlbox::ThirdParty::IPC::Shareable (SHARABLE_LOCK_OPTION);

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

use constant NO_NEW_STATE	        => 0;	        #no message from sphinx


#new message says: same state
use constant MSG_READY_STATE        => 1;           #new message says: listener is ready
use constant MSG_LISTENING_STATE    => 2;           #new message says: listener is hearing something
use constant MSG_UNDERSTOOD_STATE	=> 3;           #new message says: input parsed and understood
use constant MSG_GARBLED_STATE      => 4;           #new message says: input parsed bot not understood
use constant MSG_EXITED_STATE       => 5;           #new message says: listener has exited
use constant MSG_SAY_STATE	         => 6;           #new message says:Perlbox::Voice raised and unknown event
use constant MSG_LOCKED_STATE       => 7;
use constant MSG_UNLOCKED_STATE     => 8;

my  $PATH_TO_AGENT_BIN	         = undef;       #path to agent executable
use constant CONFIG_FPATH	      => $ENV{"HOME"}."/.perlbox-voice/Listener.conf";        #path to configuration file
use constant USER_DIR            => $ENV{"HOME"}."/.perlbox-voice/";

use constant MAGIC_TAG           => "PERLBOXMAGICWORD";

my $first_listener_wakeup   = TRUE;
my $listener_state          = FALSE;
my $listening_agent_pid     = undef;                #the Process ID number of the listener
my $current_message         = FALSE;                #current message from the agent
my $playsound               = undef;
my $verbosity_level         = undef;
my $voice_responder         = undef;
my $lib_path                = undef;

my $desktop_plugger = Perlbox::Plugins::Desktop->new;

my $language_model = Perlbox::Vocabulary::VocabularyAdd->new;


sub new {
    my $class = shift;
    my $self = {
        @_,
    };

    bless ( $self, $class );

    $self->init();
    return $self;
}

#sub set_handlers{

#}

sub init {

     my $self = shift;

     #set up shared memory options
     my %shared_memory_options = (
         create    => TRUE,
         exclusive => FALSE,
         mode      => SHARED_MEMORY_MODE,
         destroy   => TRUE,
     );

     #tie our reference variable to the shared slot
     tie $current_message, 'Perlbox::ThirdParty::IPC::Shareable', SHARED_MEMORY_GLUE, { %shared_memory_options } or
     die "Perlbox Voice server error: shared memory tie failed\n";

     
     my $cfg = new Perlbox::ThirdParty::Config::Simple( CONFIG_FPATH);
     $playsound = $cfg->param( 'option_section.playsound' );
     $verbosity_level=$cfg->param( 'option_section.verbosity_level' );
     $lib_path =  $cfg->param( 'path_section.perlbox_lib' );
     $PATH_TO_AGENT_BIN =$cfg->param( 'path_section.agent_bin' );
     $voice_responder = Perlbox::Response::VoiceResponse->new;

     #make sure we start at 0
     $current_message = FALSE;

     #if there is a desktop plugin, we want to load that
     load_current_desktop_plugin();

}
#Start a PerlboxListener and Sphinx if none exists.
sub start_listener{
    my $self = shift;
    my $return_str=undef;
    if($listener_state == FALSE){
        die "fork: $!" unless defined ( $listening_agent_pid = fork );
        if ( $listening_agent_pid ) {
            #this is the parent process
            $return_str = "Starting the listener";
            #we are awake
            $listener_state=TRUE;
            #return to being a parent
            goto fork_label;
        }
        else {
            #replace our child process with listening agent
            exec $PATH_TO_AGENT_BIN;
        }
    }
    else{
       $return_str="CAN NOT START: LISTENER ALREADY STARTED";
    }

    fork_label:
    return $return_str;

}

#Stop the currently running listener. This stops the running PerlboxListener and Sphinx if it exists.
sub stop_listener{
    my $return_str="";
    if( $listener_state == TRUE ){
       $return_str = "Killing the listener softly\n";
       `kill -9 $listening_agent_pid`;
       killall();
       $listener_state=FALSE;
       $first_listener_wakeup=TRUE;
    }
    else{
        $return_str = "CAN NOT KILL: LISTENER IS DEAD";
    }

    return $return_str;
}

#kill all  currently running sphinx process
sub killall{
    $listener_state=FALSE;
    $first_listener_wakeup=TRUE;
    `killall sphinx2-continuous`;
    return "KILLED ALL LISTENERS";
}

#Test a text entry to be safe for creating a new vocabulary
sub validate_vocabulary_entry{
   my $self=shift;
   my $entry=shift;
   return $language_model->validate_entry($entry);
}

#Make a new vocabulary from parallel lists of $phrase - $execute array references
sub create_language_model{
   my $self=shift;
   my $phrase = shift;
   my $execute = shift;
   my (@phrase_array, @execute_array);

   for(my $i=0; $i<@$phrase; $i++){
      $phrase_array[$i]=$phrase->[$i];
      $execute_array[$i]=$execute->[$i];
      #print "$phrase_array[$i] EXECUTES $execute_array[$i]\n";
   }

   #now, if there is a codec (plugin), we need to 'quietly' load this data into out phrase/execute arrays
   #we will do this here to insulate the vocabulary modeler from the Plugins.

   my $start_index = @phrase_array;                #length
   if($desktop_plugger->is_plugin_loaded()){
      my $dtarray = $desktop_plugger->get_codec();
      for(my $i=0; $i<@$dtarray; $i++){
         #print "PLUGIN ADD: ".$dtarray->[$i]->{'spoken'}." EXECUTES ".$dtarray->[$i]->{'execute'}."\n";
         $phrase_array [$start_index+$i]  = $dtarray->[$i]->{'spoken'};
         $execute_array[$start_index+$i]  = $dtarray->[$i]->{'execute'};
      }
   }

   #now for the magic word, again, we silently load this
   if( $self->get_use_magicword() ){
      $phrase_array [@phrase_array] = lc($self->get_magicword());
      $execute_array[@execute_array] = "PERLBOXMAGICWORD";
   }
   
   my $modeler_response=$language_model->create_language_model(\@phrase_array, \@execute_array);

   #if it worked, we want to update the config file, so we know what to open
   if($modeler_response == TRUE){
      my $config = new Perlbox::ThirdParty::Config::Simple( CONFIG_FPATH );
      #first clear it
      $config->param(-block=>"command_section", -values=>{});

      for(my $i=0; $i < $start_index; $i++){
         my $key = uc($phrase_array[$i]);
         my $value = $execute_array[$i];
         $config->param(-name=>"command_section.$key", -value=>$value);
      }

      $config->write();
   }



   if( $modeler_response == TRUE ){
      if( $listener_state == TRUE ){
         stop_listener();
         start_listener();
      }
      return ("New Model Created::Updating Listener");
   }
   else{
      return ("Failed Model Creation::Tsk Tsk");
   }
}


#Check for generated messages from the Server. These are generaly used as
#responses to the user.
sub check_messages(){
   my $self = shift;
   if( $current_message == NO_NEW_STATE ){
      return $current_message;
   }
   else{
      #print "SERVER RETRIEVED NEW MESSAGE $current_message\n";
      my $tmp;
      my @message_parts;
      if($current_message =~ /^\d\|/ ){
         @message_parts = split(/\|/,$current_message);

         #first see if this fits a plugin profile
         if($message_parts[0] == MSG_GARBLED_STATE){
            my $result=$desktop_plugger->input_command($message_parts[1]);
            if($result == 0){
               $tmp = $self->message_code_tostring ( $message_parts[0] );
            }
         }
         else{
            $tmp = $self->message_code_tostring ( $message_parts[0] ).$message_parts[1];
         }
      }
      else{
         $tmp = $self->message_code_tostring ( $current_message );
      }

      $current_message = NO_NEW_STATE;
      return $tmp;
   }
}

#PRIVATE
#parse the message code and give a readable string
sub message_code_tostring {
    my $self = shift;
    my $state = shift;

    my $msg_str="";
    if( $state == MSG_READY_STATE){
        if($first_listener_wakeup == TRUE){
            $msg_str = "The listener has started";
            $first_listener_wakeup = FALSE;
        }
        else{
            $msg_str = "";
        }
    }
    elsif( $state == MSG_LISTENING_STATE ){
        $msg_str = "Listening...";
    }
    elsif( $state == MSG_UNDERSTOOD_STATE ){
        $msg_str = "I executed ";
    }
    elsif( $state == MSG_GARBLED_STATE ){
        $msg_str = "Did not understand";
    }
    elsif( $state == MSG_EXITED_STATE ){
        $msg_str = "The listener is asleep";
    }
    elsif( $state == MSG_SAY_STATE ){
        $msg_str = "SAY:";
    }
    elsif($state == MSG_LOCKED_STATE){
        $msg_str = "Waiting for magic word";
    }
    elsif($state == MSG_UNLOCKED_STATE){
        $msg_str = "Got the magic word";
    }
    
    return $msg_str;
}


#sub commands_toarray accepts two array references and fills them
#with values from the config pertaining to commands. This method is
#taken from and writes to the users config file
sub commands_toarrays {
	#get a hash
    my $self = shift;
    my $human_says = shift;
    my $computer_does = shift;
    my $config= new Perlbox::ThirdParty::Config::Simple( CONFIG_FPATH );
	 my %commands_hash = $config->param_hash();
    #read command hashed into arrays. Why? Hashes are not proper.
    foreach my $key ( keys (%commands_hash) ) {
        if($key =~ /command_section/){
           my @tmp = split(/\./,$key);
           push( @$human_says, $tmp[1]);
           push( @$computer_does, $commands_hash{$key} );
        }
    }
}#end sub commands_tostring

#======================================================================
#Voice Response Methods
#======================================================================
#call to voice response system
sub say{
    my $self = shift;
    my $speech = shift;
    my $this_verbosity=shift;
    if ($verbosity_level>=$this_verbosity){
       $voice_responder->respond( $speech );
    }

}

#======================================================================
#Documentation Methods
#======================================================================
#start the tutorial in the default help browser
sub start_tutorial{
    my $self = shift;
    my $browser=$self->get_helpbrowser;
    system ( "$browser $lib_path"."docs/tutorial/index.html &" );
}
#start the API documentation in the default help browser
sub start_api{
    my $self = shift;
    my $browser=$self->get_helpbrowser;
    system ( "$browser $lib_path"."docs/api/index.html &" );
}
#start the help documentation in the default help browser
sub start_help{
    my $self = shift;
    my $browser=$self->get_helpbrowser;
    system ( "$browser $lib_path"."docs/help/index.html &" );
}

sub start_plugdoc{
    my $self = shift;
    my $browser=$self->get_helpbrowser;
    system ( "$browser $lib_path"."docs/plugins/index.html &" );
}

#======================================================================
#Configuration Methods
#======================================================================

#set the default browser to open help documents
sub set_helpbrowser {
    my $self = shift;
    my $newbrowser = shift;

    my $cfg = new Perlbox::ThirdParty::Config::Simple( CONFIG_FPATH );

    # update config
    $cfg->param( 'option_section.help_browser', $newbrowser );

    # saving the changes back into the file
    $cfg->write();
}

#get the default browser to open help documents
sub get_helpbrowser {
    my $cfg = new Perlbox::ThirdParty::Config::Simple( CONFIG_FPATH );
    my $browser = $cfg->param( 'option_section.help_browser' );
    return $browser;
}

#set the the path for sphinx2continuous
sub set_sphinxpath {
    my $self=shift;
    my $new_path=shift;

    my $cfg = new Perlbox::ThirdParty::Config::Simple( CONFIG_FPATH );

    # update config
    $cfg->param( 'path_section.s2continuous', $new_path );
    # save the changes
    $cfg->write();
}

#get the the path for sphinx2continuous
sub get_sphinxpath {
    my $cfg = new Perlbox::ThirdParty::Config::Simple( CONFIG_FPATH );
    my $browser = $cfg->param( 'path_section.s2continuous' );
    return $browser;
}

#toggle the speech agent
sub set_playsound {
    my $self=shift;
    $playsound=shift;     #expects an integer (0=false, 1=true)
    my $cfg = new Perlbox::ThirdParty::Config::Simple( CONFIG_FPATH );
    $cfg->param( 'option_section.playsound',$playsound) ;
    $cfg->write();
}

#Find out is the speaking agent is on
sub get_playsound{
    return $playsound;
}


#set verbosity level (0 does not speak, 10 is a chatterbox)
sub set_verbosity {
    my $self=shift;
    $verbosity_level=shift;     #expects an integer (0=false, 1=true)
    my $cfg = new Perlbox::ThirdParty::Config::Simple( CONFIG_FPATH );
    $cfg->param( 'option_section.verbosity_level',$verbosity_level) ;
    $cfg->write();
}


#get verbosity level (0 does not speak, 10 is a chatterbox)
sub get_verbosity {
    return $verbosity_level;
}


#path to logo for current Perlbox Voice Applications
sub get_logopath{
    my $self=shift;
    return $lib_path."docs/pixels/perl.png";
}

#list of desktop plugins, beware: this is a list of desktop_plugin objects!
sub get_desktop_plugins{
    my $self = shift;
    my $path_to_plugins= USER_DIR."dtplugins/";
    my @return_ref;
    $desktop_plugger->list_plugins( $path_to_plugins, \@return_ref );
    return \@return_ref;
}

#gets the current desktop plugin from the config file (could be 'none')
sub get_currrent_desktop_plugin{
    my $self = shift;
    my $cfg = new Perlbox::ThirdParty::Config::Simple( CONFIG_FPATH );
    my $dtplugin = $cfg->param( 'option_section.desktop_plugin' );
    return $dtplugin;
}

#find the current desktop plugin and load it
sub load_current_desktop_plugin{
    my $self = shift;
    my $new_desktop = get_currrent_desktop_plugin();
    my $new_desktop_path = USER_DIR."dtplugins/".$new_desktop.".plug";
    if($new_desktop ne "none"){
       $desktop_plugger->load_plugin($new_desktop,$new_desktop_path);
       warn "LOADED DESKTOP PLUGIN: $new_desktop\n";
    }
    else{
       $desktop_plugger->unload_plugin();
    }

}

#set the current desktop plugin and then load it.
sub set_currrent_desktop_plugin{
    my $self = shift;
    my $new_desktop = shift;
    my $cfg = new Perlbox::ThirdParty::Config::Simple( CONFIG_FPATH );
    $cfg->param( 'option_section.desktop_plugin', $new_desktop ) ;
    $cfg->write();
    #and now load it the plugin
    load_current_desktop_plugin();
}


#magic word
sub get_magicword{
    my $self = shift;
    my $cfg = new Perlbox::ThirdParty::Config::Simple( CONFIG_FPATH );
    my $magicword = $cfg->param( 'option_section.magic' );
    return $magicword;
}

sub set_magicword{
    my $self = shift;
    my $new_dmagicword = shift;
    my $cfg = new Perlbox::ThirdParty::Config::Simple( CONFIG_FPATH );
    $cfg->param( 'option_section.magic', $new_dmagicword ) ;
    $cfg->write();
}

sub get_use_magicword{
    my $self = shift;
    my $cfg = new Perlbox::ThirdParty::Config::Simple( CONFIG_FPATH );
    my $usemagicword = $cfg->param( 'option_section.use_magic' );
    return $usemagicword;   
}

sub set_use_magicword{
    my $self = shift;
    my $new_use = shift;
    my $cfg = new Perlbox::ThirdParty::Config::Simple( CONFIG_FPATH );
    $cfg->param( 'option_section.use_magic', $new_use ) ;
    $cfg->write();
}
1;
=head1 NAME

 Perlbox::VoiceServer - Unified interface for the rapid creation of voice enabled applications.

=head1 VERSION

 This document refers to version 0.7-8 of Perlbox::VoiceServer of Perlbox Voice Application Framework,
 release date 12 19 2004

=head1 SYNOPSIS

 use Perlbox::VoiceServer

 my $voice_server     =Perlbox::VoiceServer->new;

 $voice_server->say(string to_say,int priority);

=head1 DESCRIPTION

 Creates an easy to use programmers API for rapidly creating voice enabled applications
 for the Linux and *nix operating sytems. The methods available from this class are
 complete for creating, controling and configuring responsive voice enabled apps.

 This is the main and only interface for controling the Perlbox Voirce Application Framework.
 The Sphinx2 listenening agent should be installed on the local system, with the optional
 Festival Speech Synthesis System

 use Perlbox::VoiceServer
 Load the VoiceServer module.


 my $voice_server =Perlbox::VoiceServer->new;
 create a new instance of the voice server

=head2  Controling the Listener

 Start a PerlboxListener and Sphinx if none exists.
 sub start_listener()

 Stop the currently running listener. This stops any running PerlboxListener and Sphinx process.
 sub stop_listener()
 -no parameters
 -returns status as string

 kill all  currently running sphinx process
 sub killall
 -no parameters
 -returns status as string

 Check for generated messages from the Server. These are generaly used as
 responses to the user.
 sub check_messages()
 -no parameter
 -this should be called on a set interval, say once a second, the return is
new status messages


=head2 Voice Response

 Make a new vocabulary from parallel lists of $phrase - $execute array references
 sub create_language_model(<string>$phrase,<string>$execute)
 -$phrase = what the human will say;
 -$execute = what the computer will execute;
 -returns status as string

 sub commands_toarray accepts two array references and fills them
 with values from the config pertaining to commands. This method is
 taken from and writes to the users config file
 sub commands_toarrays ()
 -$phrase = what the human will say;
 -$execute = what the computer will execute;
 -returns status as string

 Test a text entry to be safe for creating a new vocabulary
 sub validate_vocabulary_entry(<string>$entry)
 -1 parameter
 -returns 0 on failure;
 -returns 1 on success



=head2 Voice Synthesis

 Call to voice response system to 'say' "text"
 sub say(<string>$text,<int>$priority)
 -$text= the text for the Festival speaker
 -$priority= int 0 to 10 of importance

=head2 Display Documentation

 Start the tutorial in the default help browser
 sub start_tutorial()

 Start the API documentation in the default help browser
 sub start_api()

 Start the help documentation in the default help browser
 sub start_help()

=head2 Configuration Methods

 Set the default browser to open help documents
 sub set_helpbrowser(<string>$new_browser)


 Get the default browser as a string (eg "mozilla")
 sub get_helpbrowser()

 Set the the path for sphinx2continuous executable in config file
 sub set_sphinxpath(<string>$path)

 Get the the path for sphinx2continuous
 sub get_sphinxpath

 Toggle the speech agent
 sub set_playsound(0=true,1=false)

 Find out is the speaking agent is on
 sub get_playsound()
 -return 0=false 1=true

 Set verbosity level (0 does not speak, 10 is a chatterbox)
 sub set_verbosity(0 - 10)

 Get verbosity level (0 does not speak, 10 is a chatterbox)
 sub get_verbosity
 -returns 0-10

 Path to logo for current Perlbox Voice Applications
 sub get_logopath()

=head2  Desktop plugins

 List of desktop plugins, beware: this is a list of desktop_plugin objects!
 sub get_desktop_plugins()

 Gets the current desktop plugin from the config file (could be 'none')
 sub get_currrent_desktop_plugin()

 Find the current desktop plugin and load it
 sub load_current_desktop_plugin()

 Set the current desktop plugin and then load it.
 sub set_currrent_desktop_plugin

=head2 Magic Word

 Magic words allow you to 'not listen' unless a magic word has been spoken.
 Once this word is spoken, there is an interval where commands will be
 interpreted, else they will be solintly ignored. The command can directly
 follow the magic word, or come within the interval set in perlbox config.
 
 Are we to use magic words?
 sub get_use_magicword

 sub set_use_magicword

 And what is the magic word?
 sub get_magicword

 sub set_magicword


=head1 SEE ALSO

 For more information on how to program with perlbox: look at the code then drop me an email.

=head1 FILES

  Requires Perlbox (All included with this package):

  Perlbox::Response::VoiceResponse;
  Perlbox::Vocabulary::VocabularyAdd;
  Perlbox::ThirdParty::IPC::Shareable;
  Perlbox::ThirdParty::Config::Simple;
  use Perlbox::Plugins::Desktop;
  
  Other Requirements:
  None

=head1 AUTHOR

 Shane C. Mason <me@perlbox.org>
 
 Special thanks to: 
 
 Eric Andrechek (eric at openthought dot net)
 
 http://perlbox.org

=head1 COPYRIGHT

 Copyright (c) Date Fri Nov  8 21:11:38 MST 2002
 Author Shane Mason <me@perlbox.org>

 This file is part of Perlbox Voice.

 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.

=cut



