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);
}