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

#
#  This is an example of writing a VXML application for TellMe.com in Perl.
#  I wrote this because when I walk into a book, CD or DVD store, I 
#  immediately forget what I own.  Using my cell phone, I can call into 
#  1-800-555-TELL, select the book database, enter the ISBN number, and know
#  if I own it or not.  I've built in some infra-structure for the CD and 
#  DVD portion, but at the moment it only returns a 'Not implemented 
#  message'. I'll prolly add this as I go on.
#
#  To use it, you'll first need an account at www.TellMe.com.  It's free, so
#  you should go get one now.  As far as setting up the TellMe side, it's 
#  pretty straight forward, and I don't want to explain it here, since they 
#  may change it.  Next, put the script in your favorite directory.  I put 
#  mine in /vxml off my docroot, and name it according to the extension it 
#  will be assigned to from TellMe.com.  Since I have multiple extensions, it
#  makes it easy to keep track of what scripts are associated with what 
#  extensions.
#
#  You'll need to create a database (I use mySQL) with the structure that's 
#  at the  __END__ section.  It's a direct mysqldump of my Media database.  
#  Set the variables below to the host, database name, etc.  Security says 
#  you should make sure that the user you allow to access the database only 
#  has SELECT privledges.  If someone manages to dump your script source, you
#  don't want a DB writable password being exposed.  Don't forget to put a 
#  index.html file in the directory also, so it's not browsable.
#
#  Odds & ends: Some ISBN numbers have an 'X' in the 10th position.  Since a
#  DTMF pad doesn't have 'X', we use '9'.  If the script sees a '9' in the 
#  10th position it will check for both an entry ending in '9' and in 'X'.  
#  If it finds both (and you'd be way out beyond the statistical norm if you
#  did), it will read back both titles.  The help could no doubt be clearer, 
#  but since only trained users are using it, you get what I needed as a 
#  reminder.
#
#  Requires the following modules:
#    CGI
#    DBI
#
#  Copyright 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.
#
#  2001/03/23 - 1.00.00 - Initial release
#
#

use strict;
use CGI;
use DBI;
use Carp;

#
#  Our script name. TellMe doesn't handle not having a script name correctly.
#
use constant cScriptName   	=> '54529.pl';

#
#  Tune these for your database setup
#
use constant cDB_Host         => 'localhost';   # Host for database
use constant cDB_Database     => 'Media';       # Database to use
use constant cDB_Table_Books  => 'Books';       # Table name
use constant cDB_User         => 'media';       # User name to access DB with
use constant cDB_Pass         => 'media';       # Our super-secret password (!)

#
#  Action dispatch list
#
my %actionList = ('mainmenu'  => \&function_mainmenu,
                  'books'     => \&function_books,
                  'cds'       => \&function_cds,
                  'dvds'      => \&function_dvds,
                  'help'      => \&function_help,
                 );

my %actionListBooks = ('getisbn'    => \&function_books_getisbn,
                       'lookup'     => \&function_books_lookup,
                       'mainmenu'   => \&function_books_mainmenu,
                      );

#
#  Help for the clueless (or me, after two days of not using it)
#
my %helpList = ('mainmenu' => qq{Say books or press 1 for the book database.
                                 Say C dees or press 2 for the C D database.
                                 Say D V dees or press 3 for the D V D database.
                                 Hang up to exit system.
                                 End of help.
                                },
                'getisbn'  => qq{Say or type the 10 digit I S B N number.
                                 If the number has the letter X in it use 9, instead.
                                 Say menu or press star to return to the main menu, or hang up.
                                 End of help.
                                },
                'unknown'  => qq{Unknown help request.
                                },
               );

#
#  Main
#
{
   my $cgi = new CGI;

   $| = 1;

   $cgi->cache (1);

   my $goto = $cgi->param ('goto') || 'mainmenu';

   $goto = 'mainmenu' if (!$actionList {$goto});

   &{$actionList {$goto}} ($cgi);
}

#
#  Main menu (doncha love redundant comments?)
#
sub function_mainmenu
{
   my $cgi = shift;

   write_headers ($cgi);

   print <<"ENDHERE";

   <vxml>
     <form id="function_mainmenu">
       <field name="function">
         <grammar>
           <![CDATA[
             [
             [dtmf-1 books] {<option "books">}
             [dtmf-2 seedees] {<option "cds">}
             [dtmf-3 deeveedees] {<option "dvds">}
             ]
           ]]>
         </grammar>
         <prompt>
           <audio>
             Select option, or say help.
           </audio>
         </prompt>
         <nomatch>
           <audio>
             I'm sorry, I didn't understand what you said.
           </audio>
           <reprompt/>
         </nomatch>
         <help>
           <goto next="@{[cScriptName]}?goto=help&amp;helplevel=mainmenu&amp;lastgoto=mainmenu"/>
         </help>
         <filled>
           <result name="books">
             <goto next="@{[cScriptName]}?goto=books"/>
           </result>
           <result name="cds">
             <goto next="@{[cScriptName]}?goto=cds"/>
           </result>
           <result name="dvds">
             <goto next="@{[cScriptName]}?goto=dvds"/>
           </result>
           <audio>
             I'm sorry, I didn't understand what you said.
           </audio>
           <reprompt/>
         </filled>
         <error>
           <audio>
             I'm sorry, I didn't understand what you said.
           </audio>
           <reprompt/>
         </error>
       </field>
     </form>
   </vxml>

ENDHERE

}

#
#  Book handler
#
sub function_books
{
   my $cgi = shift;

   my $option = $cgi->param ('option') || 'getisbn';

   $option = 'getisbn' if (!$actionListBooks {$option});

   &{$actionListBooks {$option}} ($cgi);
}

sub function_books_getisbn
{
   my $cgi = shift;

   write_headers ($cgi);

   print <<"ENDHERE";

   <vxml>
     <form id="function_books_getisbn">
       <field name="isbn">
         <grammar>
           <![CDATA[
             [
             [Ten_digits]
             [dtmf-star menu] {<option "mainmenu">}
             ]
           ]]>
         </grammar>
         <prompt>
           <audio>
             Say or enter the I S B N number.
             Use 9 for X, and don't use dashes.
             Use star or say menu to return to the main menu.
           </audio>
         </prompt>
         <help>
           <goto next="@{[cScriptName]}?goto=help&amp;helplevel=getisbn&amp;lastgoto=books&amp;lastoption=getisbn"/>
         </help>
         <filled>
           <result name="mainmenu">
             <submit next="@{[cScriptName]}?goto=mainmenu"/>
           </result>
           <submit next="@{[cScriptName]}?goto=books&amp;option=lookup" namelist="isbn"/>
         </filled>
         <noinput>
           <audio>
             I'm sorry, I didn't hear you.
           </audio>
           <pause>500</pause>
           <reprompt/>
         </noinput>
         <error>
           <audio>
             I'm sorry, I didn't understand what you said.
           </audio>
           <pause>500</pause>
           <reprompt/>
         </error>
       </field>
     </form>
   </vxml>

ENDHERE
}

sub function_books_lookup
{
   my $cgi = shift;

   my $isbn = $cgi->param ('isbn') || 0;

   if (length ($isbn) != 10)
   {
      short_message ($cgi, "The I S B N entered was not 10 digits.  Please try again.", 'books', 'getisbn');
   }
   elsif ($isbn =~ m/[^0-9]/)
   {
      short_message ($cgi, "The I S B N must be all digits.  Please try again.", 'books', 'getisbn');
   }
   else
   {
      if (my $database = DBI->connect ("DBI:mysql:@{[cDB_Database]}:@{[cDB_Host]}", cDB_User, cDB_Pass))
      {
         my $query = qq{SELECT Title,ISBN FROM @{[cDB_Table_Books]} WHERE ISBN='$isbn'};

         $query .= qq{ OR ISBN='} . substr ($isbn, 0, 9) . qq{X'} if (substr ($isbn, -1, 1) eq '9');

         my $cursor = $database->prepare ($query) or internal_error ($cgi, $database->errstr);
         $cursor->execute or internal_error ($cgi, $database->errstr);
         my $rows = $cursor->fetchall_arrayref;

         if (scalar @$rows)
         {
            if (scalar @$rows == 1)
            {
               short_message ($cgi, "I S B N present.  Title is @$rows[0]->[0].", 'books', 'getisbn');
            }
            else
            {
               my $titles = "Multiple I S B N matches.  Titles are ";

               $titles .= $_->[0] . '</audio><pause>1000</pause><audio>' foreach (@$rows);

               short_message ($cgi, $titles, 'books', 'getisbn');
            }
         }
         else
         {
            short_message ($cgi, "The requested I S B N is not in the database. $query", 'books', 'getisbn');
         }

         $database->disconnect;
      }
      else
      {
         internal_error ($cgi);
      }
   }
}

sub function_books_mainmenu
{
   my $cgi = shift;

   write_headers ($cgi);

   print <<"ENDHERE";

   <vxml>
     <form id="mainmenu">
       <block>
         <goto next="@{[cScriptName]}?option=mainmenu"/>
       </block>
     </form>
   </vxml>

ENDHERE
}

#
#  Had I written something to handle CDs, it would go here.
#
sub function_cds
{
   function_not_implemented (shift);
}

#
#  Had I written something to have DVDs, it would go here.
#
sub function_dvds
{
   function_not_implemented (shift);
}

#
#  Help dispatcher.
#
sub function_help
{
   my $cgi = shift;

   my $help    = $cgi->param ('helplevel')   || 'unknown';
   my $goto    = $cgi->param ('lastgoto')    || 'mainmenu';
   my $option  = $cgi->param ('lastoption')  || undef;

   short_message ($cgi, $helpList {$help}, $goto, $option);
}

#
#  Internal errors are *bad*.  Just tell the user, and hang up.
#  It's not like this is a life support application, or a pr0n
#  credit card service where error recovery is a must...
#
sub internal_error
{
   my ($cgi, $msg) = @_;

   write_headers ($cgi);

   print <<"ENDHERE";

   <vxml>
     <form id="error_internal">
       <block>
         <audio>
           An internal error has occurred.  Please try again later.
         </audio>
         <pause>500</pause>
         <disconnect/>
       </block>
     </form>
     <!-- $msg -->
   </vxml>

ENDHERE

   die $msg;
}

#
#  For the parts I've been too fscking lazy to write
#
sub function_not_implemented
{
   short_message (shift, "Sorry, that function isn't implemented yet.", 'mainmenu');
}

#
#  Handle like short message routine.
#
sub short_message
{
   my ($cgi, $msg, $goto, $option) = @_;
   my $parms = "";

   $parms  = "?" if defined ($goto) || defined ($option);
   $parms .= "goto=$goto" if defined ($goto);
   $parms .= "&amp;option=$option" if defined ($option);

   write_headers ($cgi);

   print <<"ENDHERE";

   <vxml>
     <form id="error">
       <block>
         <audio>
           $msg
         </audio>
         <pause>500</pause>
         <goto next="@{[cScriptName]}$parms"/>
       </block>
     </form>
   </vxml>

ENDHERE
}

#
#  Generic header for TellMe.  No cacheing *very* important.  TellMe
#  does bad things if you don't tell him you're not cacheable.
#
sub write_headers
{
   my $cgi = shift;

   print $cgi->header (-expires => 'Mon, 26 Jul 1997 05:00:00 GMT',
                       -last_modified => scalar localtime (),
                       -cache_control => 'no-cache, must-revalidate',
                       -pragma => 'no-cache');

   print '<?xml version="1.0"?>', "\n";
   print '<!DOCTYPE vxml PUBLIC "-//Tellme Networks//Voice Markup Language 1.0//EN" "http://resources.tellme.com/toolbox/vxml-tellme.dtd">', "\n";
}


__END__

# MySQL dump 8.12
#
# Host: localhost    Database: Media
#--------------------------------------------------------
# Server version  3.23.32

#
# Table structure for table 'Books'
#

CREATE TABLE Books (
  Title varchar(255) default NULL,
  ISBN varchar(10) NOT NULL default '0',
  PRIMARY KEY (ISBN),
  UNIQUE KEY ISBN(ISBN)
) TYPE=MyISAM;