Subversion Repositories CoffeeCatalog

#!/usr/bin/perl -w

use strict;

use CGI qw(:standard escapeHTML);

print header (),

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

if (defined (param ("name"))) {

	process_form ();

} else {

	display_upload_form ();

}

print end_html ();

sub display_upload_form  {

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

		    "Image file: ", br (),

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

		    br (),

		    "Descriptive name for image: ", br (),

		    textfield (-name => "name",

					 -value => "",

					 -override => 1,

					 -size => 60),

		    br (), br (),

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

		    end_form ();

}

sub process_form  {

	my $name = param ("name");    # image name

	my $image = param ("image");	# image file

	my @errors = ();

  my $dbh;

  my $mime_type;

  my ($full, $thumb);

  my $serve_url;

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

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

  	 # check for required fields

  push (@errors, "Please supply an image name") if $name eq "";

  push (@errors, "Please specify an image file") if $image 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 ($image)->{'Content-Type'};

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

  $dbh = WebDB::connect ();

  $dbh->do (

  		   "REPLACE INTO image

		    (name,image,thumbnail,mime_type)

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

			   undef,

			   $name, $full, $thumb, $mime_type);

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

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

	print p ("The image upload was successful.");

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

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

	$name = escapeHTML ($name);

	$mime_type = escapeHTML ($mime_type);

	print p ("Image name: $name"),

		    p ("MIME type: $mime_type"),

		    p ("Full size image:"),

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

		    p ("Thumbnail image:"),

		    img ({-src => "$serve_url;thumbnail=1", -alt => $name}), "\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);

}