Listings 8-1 to 8-3 contain only the code for the new programs. If you need the old programs and templates, a visit to this book's Web site is the easiest way to obtain them.
Listing 8-1: auction_up.cgi
01: #!/usr/bin/perl -wT 02: # auction_up.cgi 03: use strict; 04: use DBI; 05: use CGI qw(:standard); 06: print header; 07: my ($image_data, $data, %fd); 08: my $image = param(‘logo'); 09: my $mime = CGI::uploadInfo($image)->{‘Content-Type'}; 10: my @fields = qw(auction_name start_bid stop_bid); 11: for(@fields){ $fd{$_} = param($_); } 12: my $dbh = DBI->connect("dbi:mysql:auction_img", "bookuser", "testpass") 13: or die("Error! $!\nAborting"); 14: while( read($image, $data, 2048) ) { 15: $image_data .= $data; 16: } 17: $image_data = $dbh->quote($image_data); 18: $mime = $dbh->quote($mime); 19: my $sql = qq{INSERT INTO auction 20: (name, start_bidding, stop_bidding, logo, mime) 21: VALUES 22: (?, ?, ?, $image_data, $mime) }; 23: my $sth = $dbh->prepare($sql); 24: $sth->execute($fd{auction_name}, $fd{start_bid},$fd{stop_bid}) 25: or die("Error: $DBI::errstr \nAborting"); 26: print "SUCCESS!!!\nMIME type: $mime\n";
Listing 8-2: upload.cgi
01: #!/usr/bin/perl -wT 02: # upload.cgi 03: use strict; 04: use DBI; 05: use CGI qw(:standard); 06: print header; 07: my ($image_data, $data, %fd); 08: my $image_handle = param(‘image1'); 09: my $mime = CGI::uploadInfo($image_handle)->{‘Content-Type'}; 10: my @fields = qw(item_name description donor_id 11: value min_bid min_incr auction_id); 12: for(@fields){ $fd{$_} = param($_); } 13: my $dbh = DBI->connect("dbi:mysql:auction_img", "bookuser", "testpass") 14: or die("Error! $!\nAborting"); 15: while( read($image_handle, $data, 2048) ) { 16: $image_data .= $data; 17: } 18: $image_data = $dbh->quote($image_data); 19: $mime = $dbh->quote($mime); 20: my $sql = qq{INSERT INTO item 21: ( name, description, donor_id, value, min_bid, 22: min_incr, auction_id, item_image, mime) 23: VALUES 24: (?, ?, ?, ?, ?, ?, ?, $image_data, $mime) }; 25: my $sth = $dbh->prepare($sql); 26: $sth->execute( @fd{ qw(item_name description donor_id 27: value min_bid min_incr auction_id) }) 28: or die("Error: $DBI::errstr \nAborting"); 29: print "Success!\n"; 30: print "MIME type: $mime\n";
Listing 8-3: display_image.cgi
01: #!/usr/bin/perl -wT 02: # display_image.cgi 03: use strict; 04: use DBI; 05: use CGI qw(:standard); 06: my $a_id = param("a_id"); 07: my $item_id = param("item_id"); 08: my ($sth, $sql, $item); 09: my $dbh = DBI->connect("dbi:mysql:auction_img", "bookuser", "testpass") 10: or die("Error! $DBI::errstr\nAborting"); 11: if($a_id) { 12: die "No valid a_id?" unless $a_id =~ m/\A\d+\z/; 13: $sql = qq{SELECT logo, mime FROM auction WHERE auction_id = ? }; 14: $item = $a_id; 15: } 16: else { 17: die "No valid item_id?" unless $item_id and $item_id =~ m/\A\d+\z/; 18: $sql = qq(SELECT item_image, mime FROM item WHERE item_id = ?); 19: $item = $item_id; 20: } 21: $sth = $dbh->prepare($sql); 22: $sth->execute($item); 23: my ($image, $mime) = $sth->fetchrow_array; 24: if($mime) { 25: print header(-type => $mime); 26: print $image; 27: } 28: else { 29: $mime = "image/jpeg"; 30: print header(-type => $mime); 31: open(PX, "templates/pixel.jpg") or die("Error: $!\nAborting"); 32: binmode(PX); 33: while( read(PX, my $data, 1024) ) { 34: print $data; 35: } 36: }