# the shebang (#!) line should preceed this line...

# speechd v0.55
# Implements /dev/speech
#
# This program is released under the GNU General Public License.
#
# Requirements:
#  * A speech synthesis package.  Support is currently provided for Festival 
#    and rsynth.
#     - Festival:  http://www.cstr.ed.ac.uk/projects/festival/
#     - rsynth:  ftp://ftp.cdrom.com/pub/linux/sunsite/apps/sound/speech/
#  * Perl (duh)
#
# Command Line Switches:
#  Run 'speechd -h' for more information
#
#
#  Kyle R. Burton
#  http://www.voicenet.com/~mortis
#  mortis@voicenet.com
#
#  Darxus
#  http://www.op.net/~darxus
#  darxus@op.net
#
#  Michael Matsumura
#  michael@limit.org
#
# Available at http://www.op.net/~darxus/speech

use strict;
use vars qw( 
  $VERSION $opt_q $opt_Q $opt_e $opt_f $opt_h %wordsub 
  $opt_H $opt_P $opt_v $opt_s $use_esd $synth
);

$VERSION   = '0.55';
my $host   = 'localhost';
my $port   = '1314';
my @cmd    = ('echo',qw(no command specified));
my $handle = undef;                      # this is for the tcp connection...

##############################
#USER CONFIGURABLE STUFF BEGIN

#tts_file is unlikely to ever be useful for this application.  
sub use_festival {
  #&use_festival_tts_file();
  &use_festival_SayText();
}

#undef $/;  # Don't break on newlines -- take all the data from 
            # the file handle at once.  This causes text to be sent to
            # Festival in chunks that are too big.

#USER CONFIGURABLE STUFF END
############################

###################
#CMDLINE HELP BEGIN

sub cmdlinehelp {
  print "Usage: speechd [-qQf] [-H <host>] [-P <port>] [-s <festival|rsynth>]\n";
  print "    or speechd [-h]\n";
  print "       -q  Quiet mode (Supresses STDOUT)\n";
  print "       -Q  Very quiet mode (Supresses STDOUT and STDERR)\n";
  print "       -f  Run in foreground (Don't daemonize)\n";
  print "       -H  Set the host to use (Default: localhost)\n";
  print "       -P  Set the port to use (Default: 1314)\n";
  print "       -s  Sets the speech synthesis package to use\n";
  print "       -e  Use esd (the Enlightened Sound Daemon\n";
  print "       -h  This help text\n";
  print "\n";
  print "Report bugs to <darxus\@op.net>\n";
}

#CMDLINE HELP END
#################

##################
#DAEMONIZE - BEGIN

sub daemonize {
  use POSIX 'setsid';
  # set logfile based on who rand the daemon
	my $logfile = ($<) ? "$ENV{HOME}/speechd.log" : '/var/log/speechd';

  chdir '/'                 or die "Can't chdir to /: $!\n";
  open STDIN, '/dev/null'   or die "Can't read /dev/null: $!\n";
  open STDOUT, ">>$logfile" or die "Can't write to $logfile: $!\n";
  defined(my $pid = fork)   or die "Can't fork: $!\n";
  exit(0) if $pid;
  setsid                    or die "Can't start a new session: $!\n";
  open STDERR, '>&STDOUT'   or die "Can't dup stdout: $!\n";
}

#DAEMONIZE - END
################

###############################
# READING CMDLINE OPTIONS BEGIN

if (!eval "require 'getopts.pl';") {
  print "\n\n\
Your perl interpreter is *really* screwed up: the getopts.pl library is not
even there! Have you even bothered to run 'install'?\n";
  exit;
} # from dsirc by orabidoo <roger.espel.llima@pobox.com>

&Getopts('ehqQfH:P:s:v');

if ($opt_h) { &cmdlinehelp; exit 0; }

if ($opt_Q) { $opt_q = 1; open STDERR, '>/dev/null' or die "Can't write to /dev/null: $!\n"; }
if ($opt_q) { open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!\n"; }
if (!$opt_f) { &daemonize; }

if ($opt_H) { $host = $opt_H; }
if ($opt_P) { $port = $opt_P; }

defined($opt_v) && $opt_v && print $0,' Version: ', $VERSION, "\n" && exit 0;

$use_esd = ($opt_e or $use_esd);

#READING CMDLINE OPTIONS END
############################

#####################################################
#Write PID to /var/run/speechd.pid at Turio's request

unless ( $< ) { # only if we're root
  open PIDFILE, '>/var/run/speechd.pid' or die "Cannot open /var/run/speechd.pid ($!)\n";
  print PIDFILE $$,"\n";
  close PIDFILE;
}

#END WRITE PID
##############

###########################
#READING CONFIG FILES BEGIN

&read_speechd_sub();
$SIG{HUP} = \&read_speechd_sub;


#read in /etc/speechdrc
print 'Checking for /etc/speechdrc...';
if (do '/etc/speechdrc') { print "loaded.\n"; }
                    else { print "not found.\n"; }

#read in ~/.speechdrc
print "Checking for $ENV{HOME}/.speechdrc...";
if (do "$ENV{HOME}/.speechdrc") { print "loaded.\n"; }
                           else { print "not found.\n"; }

if ($opt_s) { $synth=$opt_s; }

#READING CONFIG FILES END
#########################

###############################################
# MAKE SURE THE /DEV/SPEECH FIFO EXISTS - BEGIN

#Sets location of speech device:
my $fifo = '/dev/speech';

unless( -p $fifo ) {
  print "trying to create '$fifo'...\n";
  print "You're not root, this might not work.\n" if $<;
  unlink $fifo;     # Make sure it's not there when we try to create it
  if( system('mknod',$fifo,'p') && system('mkfifo',$fifo) ) {
    die "error creating '$fifo' $!\n";
  }
  #this makes the /dev/speech device world writeable
  chmod 0666, $fifo;
}

# MAKE SURE THE /DEV/SPEECH FIFO EXISTS - END
#############################################

##############################
#SYNTH SPECIFIC BEHAVIOR BEGIN

print 'Speech synthesis system = "',$synth,'"',"\n";

if ($synth eq 'rsynth') {
  if ($use_esd) {
    print "rsynth does not seem to work with esd.\n";
    @cmd = qw(esddsp say);
  } else {
    @cmd = qw(say);
    print "cmd = @cmd\n";
  }
  &use_rsynth;
} elsif ($synth eq "morse") {
  if ($use_esd) {
   @cmd = qw(esddsp morse -s 20 -d 0 -p);
  } else {
    @cmd = qw(morse -s 20 -d 0 -p);
    print "cmd = @cmd\n";
  }
  &use_rsynth;
} elsif ($synth eq 'festival') {
  # speical cases here... need to fork and exec...bummer
  if ($use_esd) 
  { 
    @cmd = qw(esddsp festival --server);
  } else {
    @cmd = qw(festival --server);
    print "cmd = @cmd\n";
  }

  #includes libs for TCP socket connection to Festival
  use IO::Socket;


  # create a tcp connection to the festival server
  $handle = &connect_to_festival();
  &use_festival();
} else {
  &cmdlinehelp();
  exit 0;
}

#SYNTH SPECIFIC BEHAVIOR END
############################

##############################
#DEFINITINO OF FUNCTIONS BEGIN

sub use_festival_SayText {
  my $info;

  print "Called use_festival_SayText.\n";
  local $SIG{PIPE} = \&connect_to_festival;
  open( FIFO, "<$fifo" ) || die "can't read from $fifo $!\n";
  while(1) {
    #open( FIFO, "<$fifo" ) || die "can't read from $fifo $!\n";
    my $line = 0;
		my $text;
    while ($text = <FIFO>)
    {
			next if $text eq "\n";
      $line++;
      print "Line: $line\n";
      print "Input:  $text";
      # escape backslashes and quotes
      $text =~ s/(["\\])/\\$1/g;
      # Strip single quotes so contractions are treated as single words by string conversion 
      # & convert "_" characters to " ".
      $text =~ tr/([_'])/ /d;
      # convert to lowercase so string substitution isn't case sensitive
      $text = lc ($text);
      #Thanks to Abigail in #Perl on EFNet for assistance w/ the followoing line.
      #This does the string conversion.
      $text =~ s/(\w+)/$wordsub{$1} || $1/eg;
      if ($handle) {   # Sanity checks are always nice...
        print "Output: $text";
        print($handle '(SayText "',$text,'")') or die "Could not write to Festival ($!)\n";
        recv($handle, $info, 200, 0);
        print "Festival: $info\n";
      } else {
        $handle = &connect_to_festival;
      }
    }
    #close FIFO;
    sleep 1;  # this is recommended by the perlipc
              # manpage to avoid dup signals
  }
}

sub use_festival_tts_file {
	my $info;
  print "Called use_festival_tts_file.\n";
  local $SIG{PIPE} = \&connect_to_festival;
  while(1) {
    if ($handle) {   # Sanity checks are always nice...
      print $handle '(tts_file "/dev/speech")'  or die "Could not write to Festival ($!)\n";
      recv($handle, $info, 50, 0);
    } else {
      $handle = &connect_to_festival;
    }
    sleep 2;  # this is recommended by the perlipc
              # manpage to avoid dup signals
  }
}

sub use_rsynth {
  open( FIFO, "<$fifo" ) || die "can't read from $fifo $!\n";
  while(1) {
    # reads will block till someone writes something
    my $text = <FIFO>; 
    if (defined $text) {
      system(@cmd,$text);
      print "loop\n";
      #close FIFO;
    }
    sleep 2;  # this is recommended by the perlipc
            # manpage to avoid dup signals
  }
}


sub connect_to_festival
{
  my $handle = '';
  my $tries = 0;

  while ($handle eq '')
  {
    print "($tries) Attempting to connect to the Festival server.\n";
    if ($handle = IO::Socket::INET->new(Proto     => 'tcp',
                                        PeerAddr  => $host,
                                        PeerPort  => $port))
    {
      print "Successfully opened connection to Festival.\n";
    } else
    {
      if ($tries)
      {
        print "Waiting for Festival server to load -- Can't connect to port $port on $host yet ($!).\n";
      } else
      {
        if ($host eq 'localhost') {
          print "Failed to connect to Festival server, attempting to load it myself.\n";
          &runBackgroundCommand(@cmd);
        }
      }
      sleep 1;
    }
    $tries++;
  }

  $handle->autoflush(1);     # so output gets there right away

	return $handle;
}

sub runBackgroundCommand
{
  my(@cmd) = @_;
  my $pid = fork();
  unless(defined($pid)) {
    &throw("Error forking command:  [@cmd] : $!\n");
  }
  if($pid) {
    # this is the parent
    # to be thorough, we should really wait to see if the child is
    # up and running to make sure the exec was successful, but we'll
    # just return for now...
    return $pid;
  }
  else {
    # this is the child, exec the program, which will discard us...
    unless(exec(@cmd)) {
      &throw("Error execing command: [@cmd] : $!\n");
    }
  }
}

sub throw
{
  my($p,$f,$l) = caller();
  die "$p->$f($l) ",@_,"\n",&_buildStackTrace(),"\n";
}

sub _buildStackTrace
{
  my $s = '';
  my $i = shift || 1;
  while(1) {
    my($p,$f,$l,$sub) = caller($i++);
    last unless $p or $f or $l;
    $s .= "  $p->$sub() called from: $f line $l\n";
  }
  return $s;
}

sub read_speechd_sub
{
  if (do '/etc/speechd.sub') {print "Loaded speechd.sub.\n";}
                        else {print "Failed to load speechd.sub.\n"}
  print('String substitutions: ',scalar(keys(%wordsub)),"\n");
}

#DEFINITION OF FUNCTIONS END
############################

__END__

=head1 NAME

speechd - text to speach daemon

=head1 SYNOPSIS

speechd [I<OPTIONS>]...

=head1 DESCRIPTION

speechd is a dameon that implements a bridge between a FIFO (acts
like a device file) and a speech synthesis program.  Currently only
the festival and rsynth speech synthesis packages.  Any text written
to the device file listened to by speechd will be redirected into
the speech synthesis package for output to the computer's wave device.

The most recent version of this software can be obtained at:
I<http://SpeechIO.undef.net>

=head1 OPTIONS

=over 4

=item
C<-h>  

Display command line help.

=item
C<-q>  

Quiet mode (supresses STDOUT).

=item
C<-Q>  

Very quiet mode (supresses STDERR in addition to STDOUT).

=item
C<-f>  

Run in foreground (don't daemonize).

=item 
C<-H host>  

Set the host to use (Default: localhost).

=item 
C<-P port>  

Set the port to use (Default: 1314).

=item 
C<-s pkg>  

Sets the speech synthesis package to use.  pkg can be either 
'festival' or 'rsynth'.

=item 
C<-e>  

Use esd (the Enlightened Sound Daemon).

=back

=head1 FILES

=over 4

=item
/dev/speech

This is the 'deivce' (currently a FIFO) that the speech daemon listens
to.  Any text that you write to this device is sent to the speech synthesis
package.  Please note: if you choose write directly to /dev/speech, it
should be openend in append mode.

=item
/var/run/speechd.pid

This file will contain the process id of the currently running speechd
process.

=item 
/etc/speechdrc

Global configuration file.  This is evaluated right in the currently running
speechd.  You can use it to fine tune, and extend, the behavior of the
speechd daemon.  Please note that if run as root, this file could be a 
security concern.  Please make sure it is not writable (or possibly readable)
by anyone other than root.

=item
F<~/.speechdrc>

User specific configuraiton file.  This is acted upon in the same manner
as the global /etc/speechdrc file.  As with the global speechdrc file, 
this one could also be cause for security concerns, but probably only
for the root user.

=item
/etc/speechd.sub

This file (as installed) contains a hashtable of string substitions to
perform on incomming text.  The substitution raises the overhead of
the speechd process, but greatly improves the usablility of the daemon
by expanding things such as common abbriviations, and other annoying
things that appear in written text but do not translate cleanly to the
spoken word.

=item
~/speechd.log

When run by a non-root user, this is the file that speechd uses as it's
log file.

=item
/var/log/speechd

When run as root, speechd uses this file as it's log file.

=back

=head1 ENVIORNMENT

=over 4

=item
HOME 

Used to locate .speechdrc, and as the default location of the log file.

=back

=head1 BUGS

No known bugs.  Report bugs to I<darxus@op.net>

=head1 SEE ALSO

L<catspeech>

L<perl>

The Festival voice synthesis package:  I<http://www.cstr.ed.ac.uk/projects/festival/>

The rsynth voice sysnthesis package:  I<ftp://ftp.cdrom.com/pub/linux/sunsite/apps/sound/speech/>

=head1 AUTHORS

Kyle R. Burton         I<mortis@voicenet.com>

Darxus                 I<Darxus@op.net>

Michael Matsumura      I<michael@limit.org>

=cut

