Subversion Repositories CoffeeCatalog

#!/usr/bin/perl -w

use strict;

use CGI qw(:standard escape escapeHTML);

print header (),

			start_html (-title => "Form Element Demonstration", -bgcolor => "white");

if (defined (param ("roaster"))) {

	process_form ();

} else {

	display_upload_form ();

}

print end_html ();

sub display_upload_form  {

	print start_multipart_form (-action => url ()),

		    "Roaster: ",

		    textfield (-name => "roaster",

					 -value => "",

					 -override => 1,

					 -size => 30), br (),

		    "URL: ",

		    textfield (-name => "url",

					 -value => "",

					 -override => 1,

					 -size => 30), br (),

		    "Location (City, State): ",

		    textfield (-name => "location",

					 -value => "",

					 -override => 1,

					 -size => 60),

		    br (), br (),

		    "Logo: ", br (),

		    filefield (-name => "logo", -size => 60),

		    br (),

		    submit (-name => "choice", -value => "Submit"),

		    end_form ();

}

sub process_form  {

  use WebDB;

	my $roaster = param ("roaster");

	my $url = param ("url");

	my $location = param ("location");

	my $logo = param ("logo");

	my @errors = ();

  my $dbh;

  my $mime_type;

  my ($full, $thumb);

  my $serve_url;

  $roaster = WebDB::trim ($roaster);	        # trim extraneous whitespace from name

  $url = WebDB::trim ($url);	        # trim extraneous whitespace from name

  $location = WebDB::trim ($location);	        # trim extraneous whitespace from name

  $logo = "" unless defined ($logo); # convert undef to empty string

  	 # check for required fields

  push (@errors, "Please supply a Roaster name") if $roaster eq "";

  push (@errors, "Please supply the Roaster's location") if $location eq "";

  push (@errors, "Please supply a URL to the Roaster") if $url eq "";

  push (@errors, "Please specify an image file") if $logo eq "";

  if (@errors)	 {

  	print p ("The following errors occurred:");

  	print ul (li (\@errors));

  	print p ("Please click your Browser's Back button to\n"

  				   . "return to the previous page and correct the problem.");

  	return;

  }	 # Form was okay;  get image type and contents and create new record.

  # Use REPLACE to clobber any old image with the same name.

  $mime_type = uploadInfo ($logo)->{'Content-Type'};

  ($full, $thumb) = read_image_file ($logo);

  $dbh = WebDB::connect ();

  $dbh->do (

  		   "REPLACE INTO roasters

		    (roaster,url,logo,thumbnail,location,note,mime_type)

		    VALUES(?,?,?,?,?,?,?)",

			   undef,

			   $roaster, $url, $full, $thumb, $location, "", $mime_type);

	$dbh->disconnect ();	 # Image was stored into database successfully.  Present confirmation

		 # page that displays both the full size and thumbnail images.

	print p ("Roaster successfully added.");

	# encode the name with escape() for URL, but with escapeHTML() otherwise

	$serve_url = sprintf ("serve_image.pl?name=%s", escape ($roaster));

	$roaster = escapeHTML ($roaster);

	$mime_type = escapeHTML ($mime_type);

	print p ("Roaster: $roaster"),

		    p ("MIME type: $mime_type"),

		    p ("Full size image:"),

		    img ({-src => $serve_url, -alt => $roaster}), "\n",

		    p ("Thumbnail image:"),

		    img ({-src => "$serve_url;thumbnail=1", -alt => $roaster}), "\n";

	# Display link to main page so user can upload another image

	print hr (), a ({-href => url ()}, "Upload next image");

}

use Image::Magick;

sub read_image_file {

	my $fh = shift;             # filename/file handle

	my $img = new Image::Magick;

	my ($full, $thumb);

	my $err;

	# read full-size image directly from upload file

	(read ($fh, $full, (stat ($fh))[7]) == (stat ($fh))[7])

          or error ("Can't read image file: $!");

	# produce thumbnail from full-size image

	$err = $img->BlobToImage ($full);

	error ("Can't convert image data: $err") if $err;

	$err = $img->Scale (geometry => "64x64");

	error ("Can't scale image file: $err") if $err;

	$thumb = $img->ImageToBlob ();

	return ($full, $thumb);

}

sub error {

	my $msg = shift;

	print p (escapeHTML ("Error: $msg")), end_html ();

	exit (0);

}