#!c:/perl/bin/perl -w
$| = 1;

use strict;
use CGI;
use LWP::Simple;
use XML::Simple ();

my $q = CGI->new();

print $q->header( {
    Cache_control => 'no-cache',
    Expires       => '-1y',
    Content_type  => 'text/xml'
} ), qq{

    <?xml version="1.0" encoding="UTF-8"?>
    <vxml version = "2.0" >
        <var name="skipintro" expr="0" />
        <var name="last_id" expr="0" />
        <var name="doc_count" expr="0" />

        <form id="main">
};

my $xml = XML::Simple->new();
my $chatter = get( 'http://www.perlmonks.org/index.pl?node_id=207304' );
my $chat = $xml->XMLin( $chatter, ForceArray => [ 'message' ] );

my $last_id = $q->param('last_id') || 0;
my $doc_count = $q->param('doc_count') || 0;
++$doc_count;

unless ( $q->param('skipintro') ) {
    print qq{
        <block>
            <prompt bargein="false">
                Welcome to the purl-munks voice XML chatterbox listener.
                Whenever you hear the <audio src="/audio/ding.wav" />
                sound, it means that new messages are about to be read out
                loud. The <audio src="/audio/buzzer.wav" /> sound means
                that no new messages are available on the public chatterbox.
                Note that this phone call runs in an infinite loop to make
                sure you catch all the chatter! \\!p2000 
            </prompt>
        </block>
    };
}

if ( $doc_count == 19 ) {
    print qq{
        <field name="keepgoing" type="boolean">
            <prompt bargein="true">
                User input required. Press <emphasis>one</emphasis>
                to continue listening.
            </prompt>
            <filled>
                <prompt>Thank you. \\!p1000 </prompt>
                <assign name="skipintro" expr="1" />
                <assign name="doc_count" expr="0" />
            </filled>
        </field>
    };
}
else {
    print qq{
        <block>
            <assign name="doc_count" expr="'$doc_count'" />
        </block>
    };
}

if ( grep { $_->{message_id} > $last_id } @{ $chat->{message} } ) {
    print qq{
        <block>
            <prompt><audio src="/audio/ding.wav" /> \\!p2500 </prompt>
        </block>
    };
}
else {
    print qq{
        <block>
            <prompt><audio src="/audio/buzzer.wav" /></prompt>
        </block>
    };
}

for my $msg ( @{ $chat->{message} } ) {
    next if ( $msg->{message_id} <= $last_id );

    my $txt = $msg->{text};

    # Fix up output to sound better in oral speech.
    # This could use a _heck_ of a lot of work.

    # strip out links
    $txt =~ s!\[[^\|]+\|([^\]]+)\]!$1!g;
    $txt =~ s!\[([^\]]+)\]!$1!g;

    # remove html tags.
    1 while $txt =~ s!<[^>]+>!!g;

    # remove smileys :)
    $txt =~ s![:;]\-?[\(\)\|]!!g;

    # remove [tye]-type smileys (:
    $txt =~ s![\(\)\|]\-?[:;]!!g;

    if ( $txt =~ s!\A/me!! ) {
        print qq{
            <block>
                <prompt>
                    <emphasis>$msg->{author}</emphasis>
                    <![CDATA[ $txt ]]> \\!p2000 
                </prompt>
            </block>
        };
    }
    else {
        print qq{
            <block>
                <prompt>
                    <emphasis>$msg->{author}</emphasis> says:
                    \\!p500 <![CDATA[ $txt ]]> \\!p2000 
                </prompt>
            </block>
        };
    }

    $last_id = $msg->{message_id};
}

print qq{
        <block>
            <prompt> \\!p35000 </prompt>
            <assign name="last_id" expr="'$last_id'" />
            <assign name="skipintro" expr="1" />

            <submit next="/chat.xml" fetchhint="safe" method="get"
                namelist="last_id skipintro doc_count" />
        </block>
    </form>
</vxml>

};