| 8 |
- |
1 |
#!/usr/bin/perl -w
|
|
|
2 |
|
|
|
3 |
use strict;
|
|
|
4 |
use CGI qw(:standard escape escapeHTML);
|
|
|
5 |
use WebDB;
|
|
|
6 |
|
| 9 |
- |
7 |
if (defined (param ("roaster"))) {
|
|
|
8 |
my $roaster = param ("roaster");
|
|
|
9 |
my $coffee = param ("coffee");
|
| 8 |
- |
10 |
my $thumb = param ("thumbnail");
|
| 9 |
- |
11 |
|
|
|
12 |
display_image ($roaster, $coffee, $thumb);
|
|
|
13 |
|
| 8 |
- |
14 |
} elsif (defined (param ("gallery"))) {
|
|
|
15 |
display_gallery ()
|
|
|
16 |
} else {
|
|
|
17 |
error ("Unknown request type");
|
|
|
18 |
}
|
|
|
19 |
|
|
|
20 |
|
|
|
21 |
sub display_image {
|
| 9 |
- |
22 |
my ($R, $C, $show_thumbnail) = @_;
|
|
|
23 |
|
| 8 |
- |
24 |
my $col_name = (defined ($show_thumbnail) ? "thumbnail" : "logo");
|
|
|
25 |
my ($dbh, $mime_type, $data);
|
|
|
26 |
$dbh = WebDB::connect ();
|
| 9 |
- |
27 |
if (defined ($C)) {
|
|
|
28 |
($mime_type, $data) = $dbh->selectrow_array (
|
|
|
29 |
"SELECT mime_type, $col_name FROM coffees WHERE roaster = ? and coffee = ?",
|
|
|
30 |
undef, $R, $C);
|
|
|
31 |
# If there's no coffee image found, display the roaster image instead.
|
|
|
32 |
unless (defined $mime_type) {
|
|
|
33 |
($mime_type, $data) = $dbh->selectrow_array (
|
| 8 |
- |
34 |
"SELECT mime_type, $col_name FROM roasters WHERE roaster = ?",
|
| 9 |
- |
35 |
undef, $R);
|
|
|
36 |
}
|
|
|
37 |
} else {
|
|
|
38 |
($mime_type, $data) = $dbh->selectrow_array (
|
|
|
39 |
"SELECT mime_type, $col_name FROM roasters WHERE roaster = ?",
|
|
|
40 |
undef, $R);
|
|
|
41 |
}
|
|
|
42 |
|
| 8 |
- |
43 |
$dbh->disconnect ();
|
|
|
44 |
|
| 9 |
- |
45 |
#-----------------------------------------------------------------
|
|
|
46 |
if ($col_name eq "logo") {
|
|
|
47 |
use Image::Magick;
|
|
|
48 |
my $img = new Image::Magick;
|
|
|
49 |
my $err = $img->BlobToImage ($data);
|
|
|
50 |
error ("Can't convert image data: $err") if $err;
|
|
|
51 |
|
|
|
52 |
if ($img->Get("width") > 300 or $img->Get("height") > 300) {
|
|
|
53 |
$err = $img->Scale (geometry => "300x300");
|
|
|
54 |
error ("Can't scale image file: $err") if $err;
|
|
|
55 |
}
|
|
|
56 |
$data = $img->ImageToBlob ();
|
|
|
57 |
}
|
|
|
58 |
#-----------------------------------------------------------------
|
|
|
59 |
|
| 8 |
- |
60 |
# did we find a record?
|
| 9 |
- |
61 |
error ("Cannot find image for $R") unless defined ($mime_type);
|
| 8 |
- |
62 |
|
|
|
63 |
print header (-type => $mime_type, -Content_Length => length ($data)), $data;
|
|
|
64 |
}
|
|
|
65 |
|
|
|
66 |
sub display_gallery {
|
|
|
67 |
my ($dbh, $sth);
|
|
|
68 |
|
|
|
69 |
print header (), start_html ("Image Gallery");
|
|
|
70 |
|
|
|
71 |
$dbh = WebDB::connect ();
|
|
|
72 |
$sth = $dbh->prepare ("SELECT roaster FROM roasters ORDER BY roaster");
|
|
|
73 |
$sth->execute ();
|
|
|
74 |
|
|
|
75 |
# we're fetching a single value (name), so we can call fetchrow_array()
|
|
|
76 |
# in a scalar context to get the value
|
|
|
77 |
|
|
|
78 |
while (my $name = $sth->fetchrow_array ()) {
|
|
|
79 |
# encode the name with escape() for the URL, with escapeHTML() otherwise
|
| 9 |
- |
80 |
my $url = url () . sprintf ("?roaster=%s", escape ($name));
|
| 8 |
- |
81 |
$name = escapeHTML ($name);
|
|
|
82 |
print p ($name),
|
|
|
83 |
a ({-href => $url}, # link for full size image
|
|
|
84 |
# embed thumbnail as the link content to make it clickable
|
|
|
85 |
img ({-src => "$url;thumbnail=1", -alt => $name})
|
|
|
86 |
),
|
|
|
87 |
"\n";
|
|
|
88 |
}
|
|
|
89 |
$sth->finish ();
|
|
|
90 |
$dbh->disconnect ();
|
|
|
91 |
print end_html ();
|
|
|
92 |
}
|
|
|
93 |
|
|
|
94 |
sub error {
|
|
|
95 |
my $msg = shift;
|
|
|
96 |
print header (),
|
|
|
97 |
start_html ("Error"),
|
|
|
98 |
p (escapeHTML ($msg)),
|
|
|
99 |
end_html ();
|
|
|
100 |
exit (0);
|
|
|
101 |
}
|
|
|
102 |
|
|
|
103 |
|
|
|
104 |
|
|
|
105 |
|
|
|
106 |
|
|
|
107 |
|
|
|
108 |
|
|
|
109 |
|