Subversion Repositories CoffeeCatalog

#!/usr/bin/perl -w

use strict;
use CGI qw(:standard escape escapeHTML);
use WebDB;

if (defined (param ("name"))) {
  my $image = param ("name");
  my $thumb = param ("thumbnail");
        display_image ($image, $thumb);
} elsif (defined (param ("gallery"))) {
        display_gallery ()
} else {
        error ("Unknown request type");
}


sub display_image {
        my ($name, $show_thumbnail) = @_;
        my $col_name = (defined ($show_thumbnail) ? "thumbnail" : "logo");
        my ($dbh, $mime_type, $data);
        
        $dbh = WebDB::connect ();
        ($mime_type, $data) = $dbh->selectrow_array (
                     "SELECT mime_type, $col_name FROM roasters WHERE roaster = ?",
                      undef, $name);
        $dbh->disconnect ();
        
        # did we find a record?
        error ("Cannot find image named $name") unless defined ($mime_type);
        
        print header (-type => $mime_type, -Content_Length => length ($data)), $data;
}

sub display_gallery {
        my ($dbh, $sth);
        
        print header (), start_html ("Image Gallery");
        
        $dbh = WebDB::connect ();
        $sth = $dbh->prepare ("SELECT roaster FROM roasters ORDER BY roaster");
        $sth->execute ();
        
        # we're fetching a single value (name), so we can call fetchrow_array()
        # in a scalar context to get the value
        
        while (my $name = $sth->fetchrow_array ()) {
                # encode the name with escape() for the URL, with escapeHTML() otherwise
                my $url = url () . sprintf ("?name=%s", escape ($name));
                $name = escapeHTML ($name);
                print p ($name),
                                        a ({-href => $url},     # link for full size image
                  # embed thumbnail as the link content to make it clickable
                                        img ({-src => "$url;thumbnail=1", -alt => $name})
                                        ),
                                        "\n";
        }
        $sth->finish ();
        $dbh->disconnect ();
        print end_html ();
}

sub error {
        my $msg = shift;
        print header (),
                start_html ("Error"),
                p (escapeHTML ($msg)),
                end_html ();
        exit (0);
}