#!/usr/local/bin/perl -w

#
#  Invoke with './monkyack.pl'
#
#  This script delivers the chatterbox as MP3 encoded streaming audio.  It
#  uses the festival/MBROLA text-to-speech (TTS) system to create the audio
#  on the fly.
#
#  The audio quality is a little funky, since there's a lot of special symbols
#  and 'odd words' (like user names) that the TTS has to contend with.  On top
#  of that, I encode at 8K bits per second because of my limited bandwidth.
#  Nonetheless, it's kind of amusing to listen to the chatterbox.
#
#  Requires that the festival/MBROLA server be installed, preferrably on a
#  local machine.  Needs lame 3.88beta or higher (8K bits requires MPEG III
#  Layer 2.5) for the MP3 encoding.  Also needs libshout and Shout.pm.  Last,
#  but not least, you'll need a ShoutCast/IcyCast server to connect to.  I
#  I suggest the ShoutCast server.
#
#  festival/MBROLA   - http://www.cstr.ed.ac.uk/projects/festival/
#  lame              - http://www.lame.org
#  ShoutCast server  - http://www.shoutcast.com/download/
#  IcyCast server    - http://www.icecast.org/download.html
#  libshout          - http://developer.icecast.org/libshout/
#  Shout.pm          - http://developer.icecast.org/libshout/
#  LWP::Simple       - http://cpan.org
#  XML::Twig         - http://cpan.org (yay, mirod!  Great stuff!)
#  HTML::Entities    - http://cpan.org
#
#  Notes and aimless meanderings through my thoughts:
#
#    I started out using mp3stream from http://www.prilnari.com/mp3stream/  I
#    wrote a complete Inline wrapper set for it, only to find that while it
#    would often work, it would frequently disconnect from the ShoutCast
#    server for no apparent reason.  Found the Shout.pm reference in the
#    [Internet Radio] node, switched to that.  Much better success.
#
#    I've been using festival/MBROLA for a good while (I use it to TTS my
#    weather station), and just kept reusing my old socket code.  Works, but
#    it's not good enough to publish.  So I decided that I would move into
#    the 90's, and use Speech::Synthesizer.  It's not very good, and I'm being
#    really nice.  It didn't have a couple of necessary methods, and the way
#    it's written, there was no decent way to subclass them.  The main problem
#    was that give input with 2 or 3 sentences in it, it would only speak the
#    last sentence.  What the heck good is that?  Wasn't this ever tested?
#    So, instead I just call festival-client, and pass a temp file with the
#    text (supposed to be able to read from STDIN, but when kicking it off
#    with an open statement, it hangs.
#
#    Now I decided to look for that cute bit of code someone write a while
#    back for embedding images in the __DATA__ section of a script, and
#    decoding them on the fly.  I find the reference to it at [Hex Embedded
#    Images], but the code is on his no-longer-up webserver.  In passing, I
#    find that [httptech] has done something similiar, about 10 months ago.
#    It speaks the chatterbox, but only to the local machine.  It took the
#    shininess off a bit, because I didn't think this had been done before.
#    It's at [MonkTalk], which, oddly enough, this script was called when I
#    first started.  I changed the name, of course.
#
#    I've been using WinAmp 2.74 and XMMS 1.2.4.  WinAmp sounds far better
#    but periodically disconnects from the server, for no apparent reason
#    (gotta love error messages.  Or lack thereof...)  XMMS, on the other,
#    stays connect through hell and high water, but sounds like crap on a
#    8K stream.
#
#  Copyright 2000,2001(c) J.C.Wren   jcwren@jcwren.com
#  A production of Twitching Monk Software
#  No rights reserved, use as you see fit.
#  I'd like to know about it, though, just for kicks.
#
#  Version 1.00.00 - 2001/04/11 - Initial incarnation
#  Version 1.00.10 - 2001/04/12 - Fix for XML with high bit set
#

use strict;
use LWP::Simple;
use XML::Twig;
use HTML::Entities;
use POSIX ":sys_wait_h";
use Shout;

#
#  This to change to tailor the system
#
use constant cSCIP            => 'localhost';
use constant cSCPort          => 8001;
use constant cSCPassword      => 'montyhall';
use constant cSCBitRate       => 8;
use constant cSCName          => 'Chatterbox';
use constant cSCGenre         => 'Talk Radio';
use constant cSCURL           => 'http://www.tinymicros.com:8000';
use constant cSCDescription   => 'Perlmonks Chatterbox encoded by Festival/MBROLA';
use constant cFestivalSever   => 'localhost';
use constant cTTS             => '/usr/bin/festival_client --prolog mt.parms --output _temp.wav --otype wav --ttw _temp.txt';
use constant cMP3Encoder      => '/usr/local/bin/lame --silent -a -m m -b 8 -s 16 _temp.wav _temp.mp3 >/dev/null';
use constant cSilence         => 'silence8m.mp3';
use constant cPerlMonks       => 'http://www.perlmonks.org/index.pl?node=chatterbox+xml+ticker';

#
#  Pretty simplistic main...
#
{
   createParmsFile () or die "Can't create Festival parameter file: $!";

   my $result = fork ();

   die ("Can't fork off a child") if !defined ($result);

   $result ? playTalkies ($result) : makeTalkies ();
}

#
#  The parent.  Scans the directory every 3 or more seconds (depending on the
#  length of the playlist), and sends the files to the server to be played.
#
sub playTalkies
{
   @_ >= 1 || die "Incorrect number of arguments";

   my $kidpid = shift;
   my $conn = new Shout;

   $conn->ip (cSCIP);
   $conn->port (cSCPort);
   $conn->password (cSCPassword);
   $conn->name (cSCName);
   $conn->bitrate (cSCBitRate);
   $conn->genre (cSCGenre);
   $conn->description (cSCDescription);
   $conn->url (cSCURL);
   $conn->icy_compat (1);
   $conn->ispublic (0);

   die "Can't connect to server" if (!$conn->connect);

   while (1)
   {
      opendir (DIR, ".") or die "Can't read directory: $!";

      my @playlist = sort grep { /\d{14}\.mp3/ && -f "./$_" } readdir (DIR);

      close (DIR);

      if (!scalar (@playlist))
      {
         playFile ($conn, cSilence) or die "Error while playing: " . $conn->error . "\n";
      }
      else
      {
         foreach (@playlist)
         {
            playFile ($conn, $_) or die "Error while playing $_: " . $conn->error . "\n";
            unlink $_ or die "Can't unlink file: $!";
         }
      }

      die "Child died!\n" if (waitpid ($kidpid, &WNOHANG) == -1);
   }
}

#
#  Send a file to the Shoutcast/Icycast server
#
sub playFile
{
   @_ >= 2 || die "Incorrect number of arguments";

   my ($conn, $file) = @_;
   my ($buff, $len);

   print scalar localtime, " Playing  $file\n";

   open (MP3, "< $file") or return 0;

   while (($len = sysread (MP3, $buff, 1024)) > 0)
   {
      if (!$conn->sendData ($buff, $len))
      {
         close MP3;
         return 0;
      }

      $conn->sleep;
   }

   close MP3;

   return 1;
}

#
#  Child thread that looks for new XML, and runs the text through festival
#
sub makeTalkies
{
   my %hcbxml = ();

   while (1)
   {
      getChatterXML (\%hcbxml) or die;

      chatterXmlToSpeech (\%hcbxml);

      sleep (10);
   }
}

#
#  Run through the list return by getChatterXML(), and create MP3 files with the authors
#  name and text.  The file name is the timestamp of the xml node.  If all the comments
#  are already encoded, simply return (avoid overhead of opening unnecessary festival
#  connections)
#
sub chatterXmlToSpeech
{
   @_ >= 1 || die "Incorrect number of arguments";

   my $hcbxml = shift;
   my $encoded = 1;

   $encoded &= $hcbxml->{$_}->{encoded} foreach keys (%$hcbxml);

   return if $encoded;

   foreach my $line (sort keys %$hcbxml)
   {
      if (!$hcbxml->{$line}->{encoded})
      {
         my $text;

         #
         #  Some minor hacking to get rid of the more problematic characters.
         #  Some rule based logic would be nice, but too much work.
         #
         $text = $hcbxml->{$line}->{text};
         $text =~ s/[\[\]\(\)\{\}"]//g;
         $text =~ s/[:;\|\/]/ /g;
         $text .= '.';

         print scalar localtime, " Encoding $line\n";

         open (TEMPFILE, ">_temp.txt") or die "Can't open _temp.txt: $!";
         print TEMPFILE $hcbxml->{$line}->{author} . ", " . $text;
         close TEMPFILE;
         system (cTTS) and die "Can't run TTS encoder: $!";
         system (cMP3Encoder) and die "Can't run MP3 encoder: $!";
         rename ("_temp.mp3", "$line.mp3") or die;
         unlink ("_temp.txt");

         $hcbxml->{$line}->{encoded} = 1;
      }
   }
}

#
#  Fetch the chatterbox XML page, and return a hash, keyed by time, with the
#  author, user_id, and text fields from the XML as an anon-hash.
#
sub getChatterXML
{
   @_ >= 1 || die "Incorrect number of arguments";

   my $rhcbxml = shift;
   my $xml;

   $LWP::Simple::FULL_LWP = 1;

   if ((my $xml = get (cPerlMonks)))
   {
      #
      #  Survive an [epoptai] DoS attack
      #
      $xml =~ s/[\r\n\t]//g;
      $xml =~ tr/\x80-\xff/_/;
      $xml =~ tr/\x00-\x1f/_/;

      my $twig = new XML::Twig (TwigRoots =>
               { message => sub { my ($t, $node) = @_;
                                  my $text = decode_entities ($node->text ());
                                  $text =~ s/&apos;/'/g;
                                  $text =~ tr/[\r\n]//d;
                                  $rhcbxml->{$node->att ('time')} = {'author'  => $node->att ('author'),
                                                                     'user_id' => $node->att ('user_id'),
                                                                     'text'    => $text,
                                                                     'encoded' => (defined ($rhcbxml->{$node->att ('time')}) ? $rhcbxml->{$node->att ('time')}->{encoded} : 0)
                                                                    };
                                  $t->purge;
                                }
               });

      $twig->parse ($xml);

      return (1);
   }

   return 0;
}

#
#  festival_clients won't take the parms as a string, so we have to
#  create a temp file.  Rather than lose the data somewhere, it's
#  at the end of the program.
#
sub createParmsFile
{
   local $/ = undef;

   my $prolog = <DATA>;

   open (TEMPFILE, ">mt.parms") or return 0;
   print TEMPFILE $prolog;
   close TEMPFILE;

   return 1;
}

__DATA__
(voice_kal_diphone)
(Parameter.set 'Duration_Stretch 1.1)