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