Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

VXML Book, CD & DVD Database (well, 1 out of 3)

by jcwren (Prior)
on Mar 24, 2001 at 06:38 UTC ( #66818=sourcecode: print w/ replies, xml ) Need Help??

Category: CGI Programming
Author/Contact Info J.C. Wren
jcwren@jcwren.com
Twitching Monk Software Productions
Description:

This is a VXML/TellMe.com book looker-upper. I have an innate ability to walk into a book, CD or DVD store, and completely forget every book, CD and DVD I own. I thought it would be cool to put them in a database, and be able to call into to TellMe with my cellphone, and find out if I already own it or not. So I wrote this. It only does books at the moment, but someday (real soon now) it'll handle the CDs and DVDs, too. It's a good simple demonstration of using VXML, CGI, and DBI.

To give it a try, call 1-800-555-TELL (8355), at the main menu say 'Extensions' or press 1. At the extensions menu, say 'five four five two nine' or press 5-4-5-2-9 (the letters spell K4JCW, my amateur callsign). The program should be able to step you through the rest. A known ISBN you can try is '0345260716' (Have Space Suit, Will Travel)

Like all Twitching Monk Software, there's a limited warranty. It's limited to assuring you that it won't get a cold beer from the 'fridge without your help, and if you drink too much, you'll fall down.

If you don't like the way I wrote something, fix it. I wrote it, I like it, I use it, it works for, see figure one.

#!/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 int
+o 
#  1-800-555-TELL, select the book database, enter the ISBN number, an
+d 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 fr
+ee, so
#  you should go get one now.  As far as setting up the TellMe side, i
+t'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 extensio
+n it 
#  will be assigned to from TellMe.com.  Since I have multiple extensi
+ons, it
#  makes it easy to keep track of what scripts are associated with wha
+t 
#  extensions.
#
#  You'll need to create a database (I use mySQL) with the structure t
+hat's 
#  at the  __END__ section.  It's a direct mysqldump of my Media datab
+ase.  
#  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 sour
+ce, you
#  don't want a DB writable password being exposed.  Don't forget to p
+ut 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.  S
+ince 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 cl
+earer, 
#  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 cor
+rectly.
#
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 pas
+sword (!)

#
#  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 dat
+abase.
                                 Say C dees or press 2 for the C D dat
+abase.
                                 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 numb
+er.
                                 If the number has the letter X in it 
+use 9, instead.
                                 Say menu or press star to return to t
+he 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=mainme
+nu&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=getisb
+n&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.  Pl
+ease try again.", 'books', 'getisbn');
   }
   elsif ($isbn =~ m/[^0-9]/)
   {
      short_message ($cgi, "The I S B N must be all digits.  Please tr
+y 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]} WH
+ERE 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 Lang
+uage 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;

Comment on VXML Book, CD & DVD Database (well, 1 out of 3)
Download Code

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://66818]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (7)
As of 2015-07-06 01:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (68 votes), past polls