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/\&|\&/\&/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