Program Listings

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: }