Subversion Repositories CoffeeCatalog

Rev

Rev 2 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
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