| 2 |
- |
1 |
#!/usr/bin/perl -w
|
|
|
2 |
|
|
|
3 |
use strict;
|
| 4 |
- |
4 |
use CGI qw(:standard escape escapeHTML);
|
|
|
5 |
use WebDB;
|
| 2 |
- |
6 |
|
|
|
7 |
if (defined (param ("name"))) {
|
| 4 |
- |
8 |
my $image = param ("name");
|
|
|
9 |
my $thumb = param ("thumbnail");
|
|
|
10 |
display_image ($image, $thumb);
|
| 2 |
- |
11 |
} elsif (defined (param ("gallery"))) {
|
|
|
12 |
display_gallery ()
|
|
|
13 |
} else {
|
|
|
14 |
error ("Unknown request type");
|
|
|
15 |
}
|
|
|
16 |
|
|
|
17 |
|
|
|
18 |
sub display_image {
|
|
|
19 |
my ($name, $show_thumbnail) = @_;
|
| 4 |
- |
20 |
my $col_name = (defined ($show_thumbnail) ? "thumbnail" : "logo");
|
| 2 |
- |
21 |
my ($dbh, $mime_type, $data);
|
|
|
22 |
|
|
|
23 |
$dbh = WebDB::connect ();
|
|
|
24 |
($mime_type, $data) = $dbh->selectrow_array (
|
| 4 |
- |
25 |
"SELECT mime_type, $col_name FROM roasters WHERE roaster = ?",
|
| 2 |
- |
26 |
undef, $name);
|
|
|
27 |
$dbh->disconnect ();
|
|
|
28 |
|
|
|
29 |
# did we find a record?
|
|
|
30 |
error ("Cannot find image named $name") unless defined ($mime_type);
|
|
|
31 |
|
|
|
32 |
print header (-type => $mime_type, -Content_Length => length ($data)), $data;
|
|
|
33 |
}
|
|
|
34 |
|
|
|
35 |
sub display_gallery {
|
|
|
36 |
my ($dbh, $sth);
|
|
|
37 |
|
|
|
38 |
print header (), start_html ("Image Gallery");
|
|
|
39 |
|
|
|
40 |
$dbh = WebDB::connect ();
|
| 4 |
- |
41 |
$sth = $dbh->prepare ("SELECT roaster FROM roasters ORDER BY roaster");
|
| 2 |
- |
42 |
$sth->execute ();
|
|
|
43 |
|
|
|
44 |
# we're fetching a single value (name), so we can call fetchrow_array()
|
|
|
45 |
# in a scalar context to get the value
|
|
|
46 |
|
|
|
47 |
while (my $name = $sth->fetchrow_array ()) {
|
|
|
48 |
# encode the name with escape() for the URL, with escapeHTML() otherwise
|
|
|
49 |
my $url = url () . sprintf ("?name=%s", escape ($name));
|
|
|
50 |
$name = escapeHTML ($name);
|
|
|
51 |
print p ($name),
|
|
|
52 |
a ({-href => $url}, # link for full size image
|
|
|
53 |
# embed thumbnail as the link content to make it clickable
|
|
|
54 |
img ({-src => "$url;thumbnail=1", -alt => $name})
|
|
|
55 |
),
|
|
|
56 |
"\n";
|
|
|
57 |
}
|
|
|
58 |
$sth->finish ();
|
|
|
59 |
$dbh->disconnect ();
|
|
|
60 |
print end_html ();
|
|
|
61 |
}
|
|
|
62 |
|
|
|
63 |
sub error {
|
|
|
64 |
my $msg = shift;
|
|
|
65 |
print header (),
|
|
|
66 |
start_html ("Error"),
|
|
|
67 |
p (escapeHTML ($msg)),
|
|
|
68 |
end_html ();
|
|
|
69 |
exit (0);
|
|
|
70 |
}
|
|
|
71 |
|
|
|
72 |
|
|
|
73 |
|
|
|
74 |
|
|
|
75 |
|
|
|
76 |
|
|
|
77 |
|
|
|
78 |
|