#!/usr/bin/perl # # faceClient # CGI speech cue interface to local voiceServer # 0.03 5/21/2002 # Added back-end support for emotion # # 0.02 5/9/2002 # Added speech cue character sanitizing. # # 0.01 # First working version # Requires # URI::Escape # IPC::Shareable # CGI::Request use IPC::Shareable; use CGI::Request; # Debugging stuff $IPC::Shareable::Debug = 1; # Simple interface: (combines SendHeaders, new and import_names) my $req = GetRequest($pkg); # Full Interface: # We only need to output info, so this isn't required. $req = new CGI::Request; # fetch and parse request my $cueglue = 'cuedata'; my %options = ( 'key' => 'cue', 'create' => 0, 'exclusive' => 0, 'mode' => 0644, 'destroy' => 0, ); $knot = tie(%cueinfo, IPC::Shareable, $cueglue, { %options }) or die "$$: tie failed $!\n"; if ($req->param('speechtext') eq "") { if($req->param('speechmacro') eq "") { if ($req->param('emotion') ne "") { # Send emotion only setcue(0, $req->param('emotion')); } } else { # Send macro setcue($req->param('speechmacro'), $req->param('emotion')); } } else { # Send speechtext setcue($req->param('speechtext'), $req->param('emotion')); } print ""; print "

"; print ""; print "

"; print ""; #print ""; print ""; print "

Macros:

"; print ""; print "

"; exit; sub setcue { ($cuestring, $emotion) = @_; $OK_CHARS='-a-zA-Z0-9_.?!,\'\r\n '; $cuestring =~ s/[^$OK_CHARS]/ /go; if ($emotion =~ m/happy/) { $emotion = "happy"; } if ($emotion =~ m/sad/) { $emotion = "sad"; } if ($emotion =~ m/neutral/) { $emotion = "neutral"; } if ($emotion =~ m/angry/) { $emotion = "angry"; } if ($emotion eq "") { $emotion= "neutral"; } if (($cuestring ne "") && ($cuestring ne " ")) { $knot->shlock; $cueinfo{cuestring} = $cuestring; $cueinfo{timestamp} = time(); $cueinfo{emotion} = $emotion; $knot->shunlock; print "Saying: $cuestring\n"; } }