Added voice control

Former-commit-id: 6f69079bf44f0d8f9ae40de6b0f1638d103464c2
This commit is contained in:
Ziver Koc 2015-05-13 21:14:10 +00:00
parent 35c92407a3
commit 53da641909
863 changed files with 192681 additions and 0 deletions

View file

@ -0,0 +1,177 @@
#!/usr/bin/perl -T
# -*- Mode: Perl -*-
# MARY Text-to-Speech System
# CGI Script implementing a simple mary client,
# can be used for web pages.
##########################################################################
# Copyright (C) 2000-2006 DFKI GmbH.
# All rights reserved. Use is subject to license terms.
#
# Permission is hereby granted, free of charge, to use and distribute
# this software and its documentation without restriction, including
# without limitation the rights to use, copy, modify, merge, publish,
# distribute, sublicense, and/or sell copies of this work, and to
# permit persons to whom this work is furnished to do so, subject to
# the following conditions:
#
# 1. The code must retain the above copyright notice, this list of
# conditions and the following disclaimer.
# 2. Any modifications must be clearly marked as such.
# 3. Original authors' names are not deleted.
# 4. The authors' names are not used to endorse or promote products
# derived from this software without specific prior written
# permission.
#
# DFKI GMBH AND THE CONTRIBUTORS TO THIS WORK DISCLAIM ALL WARRANTIES WITH
# REGARD TO THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL DFKI GMBH NOR THE
# CONTRIBUTORS BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL
# DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR
# PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS
# ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
# THIS SOFTWARE.
##########################################################################
# Author: Marc Schroeder
use strict;
use IO::Socket;
use CGI;
# variables getting their values from form:
my ($inputtext, $in, $out, $audiotype, $voice);
# little helpers:
my ($var, $tmp);
# contacting the mary server:
my ($host, $port, $maryInfoSocket, $maryDataSocket, $id);
# helping with audio output:
my ($save_to_disk, $audiosubtype, $filename);
my $cgi = new CGI;
my @param = $cgi->param();
$inputtext = $cgi->param('inputtext');
$in = $cgi->param('in');
$out = $cgi->param('out');
$audiotype = $cgi->param('audiotype');
$save_to_disk = $cgi->param('save_to_disk');
$voice = $cgi->param('voice');
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
$year += 1900;
printf STDERR "[%04i-%02i-%02i %02i:%02i:%02i] ", $year, $mon, $mday, $hour, $min, $sec;
print STDERR "Request from ",$cgi->remote_user(),"@",$cgi->remote_host(),": \n";
print STDERR " in=",$in;
print STDERR " out=",$out;
print STDERR " audiotype=",$audiotype;
print STDERR " voice=",$voice;
print STDERR " save_to_disk=",$save_to_disk,"\n";
print STDERR " inputtext: ";
print STDERR $inputtext,"\n";
# Limit inputtext length to 5000 bytes:
if (length $inputtext > 5000) {
$inputtext = substr $inputtext, 0, 5000;
}
# set audio subtype
if ($out eq "AUDIO") {
if ($audiotype eq "AU") {
$audiosubtype = "basic";
$filename = "mary.au";
} elsif ($audiotype eq "AIFF") {
$audiosubtype = "x-aiff";
$filename = "mary.aiff";
} elsif ($audiotype eq "WAVE") {
$audiosubtype = "x-wav";
$filename = "mary.wav";
} elsif ($audiotype eq "MP3") {
$audiosubtype = "mp3";
$filename = "mary.mp3";
} else {
$audiosubtype = "x-wav";
$filename = "mary.wav";
}
}
# announce data type on stdout
if ($save_to_disk) {
print "Content-Type: application/octet-stream";
} else {
print "Content-Type: audio/$audiosubtype";
}
print "\nContent-Disposition: filename=\"$filename\"\n\n";
# contact mary server
$host = "cling.dfki.uni-sb.de";
$port = 59125;
# create a tcp connection to the specified host and port
$maryInfoSocket = IO::Socket::INET->new(Proto => "tcp",
PeerAddr => $host,
PeerPort => $port)
or die "can't connect to port $port on $host: $!";
# avoid buffering when writing to server:
$maryInfoSocket->autoflush(1); # so output gets there right away
########## Write input to server: ##########
# formulate the request:
print $maryInfoSocket "MARY IN=$in OUT=$out AUDIO=$audiotype";
if ($voice && $voice ne 'v') { print $maryInfoSocket " VOICE=$voice"; }
print $maryInfoSocket " LOG=\"REMOTE_HOST=$ENV{'REMOTE_HOST'}",
", REMOTE_ADDR=$ENV{'REMOTE_ADDR'}\"";
print $maryInfoSocket "\015\012";
# receive a request ID:
$id = <$maryInfoSocket>;
# open second socket for the data:
$maryDataSocket = IO::Socket::INET->new(Proto => "tcp",
PeerAddr => $host,
PeerPort => $port)
or die "can't connect to port $port on $host: $!";
# identify with request number:
print $maryDataSocket $id; # $id contains a newline character
# copy $inputtext to mary data socket
print $maryDataSocket $inputtext;
# mark end-of-request:
print $maryDataSocket "\015\012"; # that is a \n, actually
$maryDataSocket->shutdown(1); # we have stopped writing data
########## Read output from server: ##########
# copy the data socket to standard output
if ($out ne "AUDIO") { # text output
my $line;
while (defined ($line = <$maryDataSocket>)) {
print STDOUT $line;
}
} else { # audio data output
my $nr; # number of bytes read
my $buf; # buffer to read into
my $outnr; # number of bytes written
while($nr = read($maryDataSocket, $buf, 8192)) {
# (read returns no. of bytes read, 0 at eof)
print STDOUT $buf
or die "Write error on stdout";
} # while read something from socket
} # audio output
### Read complaints from server:
my $line;
while (defined ($line = <$maryInfoSocket>)) {
print STDERR $line;
}