Program Listings | Perl Database Programming

Listings 12-1 to 12-3 show the complete and uninterrupted code from this chapter.

Listing 12-1: soap_server.cgi

01: #!/usr/bin/perl -w 02: # A simple, SOAP server 03: use strict; 04: use DBI; 05: use LWP::Simple; 06: use HTML::LinkExtor; 07: use SOAP::Transport::HTTP; 08: package Catalog; 09: my $dbh = DBI->connect("DBI:mysql:books:switch.perlguy.net",      "bookuser","") 10:     or die("Cannot connect: $DBI::errstr\n"); 11: my @imgs; 12: SOAP::Transport::HTTP::CGI 13:   -> dispatch_to(‘Catalog’) 14:   -> handle; 15: sub Get_Product_List { 16:     my $sql = qq(SELECT title, isbn FROM library); 17:     my $sth = $dbh->prepare($sql); 18:     $sth->execute; 19:     my @products = (); 20:     while(my $ptr = $sth->fetch){ 21:         push (@products, [ @$ptr ]);  22:     } 23:     return(\@products); 24: } 25: sub Get_Product_Data { 26:     my $rval; 27:     my ($class, $input) = @_; 28:     $Catalog::input     = $input; 29:     my $sql    = "SELECT * FROM library WHERE isbn            = ‘$input’"; 30:     my $p       = $dbh->selectrow_hashref($sql); 31:     $p->{image} = _get_image($input); 32:     if($p){ 33:         $rval  = qq(<?xml version="1.0"?>\n); 34:         $rval .= qq( <catalog_item>\n); 35:         while(my($k,$v) = each %$p) { 36:             if($v) { 37:                 $v     =~ s/^ +//; 38:                 $v     =~ s/(\015?\012)$//; 39:                 $rval .= "  <$k>$v</$k>\n"; 40:             } 41:         } 42:         $rval .= qq( </catalog_item>\n); 43:     } 44:     $dbh->disconnect; 45:     return($rval); 46: } 47: sub _get_image { 48:     my $input = $Catalog::input; 49:     my $url   = http://www.amazon.com/exec/obidos/ASIN/         . $input; 50:     my $p  = HTML::LinkExtor 51:      ->new(\&_callback) 52:      ->parse(LWP::Simple::get($url)); 53:     return($imgs[0]); 54: } 55: sub _callback { 56:     my($tag, %attr) = @_; 57:     return if $tag ne ‘img’; 58:     my @foo = values %attr; 59:     return if($foo[0] !~ /$Catalog::input/i); 60:     push(@imgs, values %attr); 61: }

Listing 12-2: catalog.cgi

01: #!/usr/bin/perl -wT 02: use strict; 03: use SOAP::Lite; 04: use CGI qw(:standard); 05: my $rval = SOAP::Lite 06:   -> uri(‘http://goliath.perlguy.net/Catalog’) 07:   -> proxy(‘http://goliath.perlguy.net/cgi-     bin/soap_server.cgi’) 08:   -> Get_Product_List() 09:   -> result; 10: print header; 11: print<<HTML; 12: <html> 13:  <head><title>Product Catalog</title></head> 14:  <body> 15:   <table border="1" cellspacing="0" align="center"> 16:    <tr> 17:     <td colspan="2" align="center"> 18:      <font size="6"> 19:       Product Catalog 20:      </font> 21:     </td> 22:    </tr> 23:    <tr> 24:     <td align="center"> 25:      <b>Part #</b> 26:     </td> 27:     <td align="center"> 28:      <b>Item</b> 29:     </td> 30:    </tr> 31: HTML 32: for (@$rval){ 33:     print qq(   <tr><td>); 34:     print qq(<a href="/cgi-bin/item_details.cgi?item_num=$_           ->[1]">$_->[1]</a>); 35:     print qq(    </td><td>$_->[0]); 36:     print qq(   </td></tr>\n); 37: } 38: print<<HTML; 39:   </table> 40:  </body> 41: </html> 42: HTML

Listing 12-3: Item_details.cgi

01: #!/usr/bin/perl -wT 02: use strict; 03: use CGI qw(:standard); 04: use SOAP::Lite; 05: use XML::Simple; 06: print header; 07: my $input = param(‘item_num’); 08: my $data = SOAP::Lite 09:   -> uri(‘http://goliath.perlguy.net/Catalog’) 10:   -> proxy(‘http://goliath.perlguy.net/cgi-     bin/soap_server.cgi’) 11:   -> Get_Product_Data($input) 12:   -> result; 13: $data =~ s/\&amp;|\&/\&amp;/g; 14: my $item = XMLin($data); 15: print<<HTML; 16: <html> 17:  <head><title>Product $item->{title}</title></head> 18:  <body> 19:   <table border="1" align="center"> 20:    <tr bgcolor="#c0c0c0"> 21:     <td colspan="3" align="center"> 22:      <font size="5">Item Details</font> 23:     </td> 24:    </tr> 25:    <tr> 26:     <td rowspan="6" bgcolor="#e0e0e0"><img src="/books/2/889/1/html/2/$item          ->{image}"></td> 27:     <td bgcolor="#e0e0e0"><b>Item Name:</b></td> 28:     <td>$item->{title}</td> 29:    </tr> 30:    <tr> 31:     <td bgcolor="#e0e0e0"><b>Publisher:</b></td> 32:     <td>$item->{publisher}</td> 33:    </tr> 34:    <tr> 35:     <td bgcolor="#e0e0e0"><b>Format:</b></td> 36:     <td>$item->{format}</td> 37:    </tr> 38:    <tr> 39:     <td bgcolor="#e0e0e0"><b>Author:</b></td> 40:     <td>$item->{author}</td> 41:    </tr> 42:    <tr> 43:     <td bgcolor="#e0e0e0"><b>Publish Date:</b></td> 44:     <td>$item->{pubdate}</td> 45:    </tr> 46:    <tr> 47:     <td bgcolor="#e0e0e0"><b>Price:</b></td> 48:     <td>$item->{price}</td> 49:    </tr> 50:    <tr bgcolor="#e0e0e0"> 51:     <td colspan="3" align="center"> 52:   <a href="/cgi-bin/catalog.cgi">Back to Product Listing</a> 53:     </td> 54:    </tr> 55:   </table> 56:  </body> 57: </html> 58: HTML