6 use Debbugs::Config qw(:config);
7 use Debbugs::CGI qw(cgi_parameters);
10 use Debbugs::Libravatar qw(:libravatar);
16 use Digest::MD5 qw(md5_hex);
18 my $q = CGI::Simple->new();
21 cgi_parameters(query => $q,
22 single => [qw(email avatar default)],
23 default => {avatar => 'yes',
24 default => $config{libravatar_uri_options},
27 # if avatar is no, serve the empty png
28 if ($param{avatar} ne 'yes' or not defined $param{email} or not length $param{email}) {
33 my ($cache_location, $timestamp) = cache_location(email => lc($param{email}));
34 # if we've got it, and it's less than one hour old, return it.
36 serve_cache($cache_location,$q,$timestamp);
39 # if we don't have it, get it, and store it in the cache
40 ($cache_location,$timestamp) =
41 retrieve_libravatar(location => $cache_location,
42 email => lc($param{email}),
44 if (not defined $cache_location) {
45 # failure, serve the default image
49 serve_cache($cache_location,$q,$timestamp);
55 my ($cache_location,$q,$timestamp) = @_;
56 if (not defined $cache_location or not length $cache_location) {
57 # serve the default image
58 $cache_location = $config{libravatar_default_image};
59 if (not defined $timestamp or not $timestamp) {
60 $timestamp = (stat($cache_location))[9];
63 if (not defined $timestamp) {
64 # this probably means that the default image doesn't exist
65 print $q->header(status => 404);
66 print "404: Not found\n";
69 my $etag = md5_hex($cache_location.$timestamp);
70 if (defined $q->http('if-none-match')
71 and $etag eq $q->http('if-none-match')) {
72 print $q->header(-status => 304);
73 print "304: Not modified\n";
76 my $fh = IO::File->new($cache_location,'r') or
77 error($q,404, "Failed to open cached image $cache_location");
78 my $m = File::LibMagic->new() or
79 error($q,500,'Unable to create File::LibMagic object');
80 my $mime_string = $m->checktype_filename(abs_path($cache_location)) or
81 error($q,500,'Bad file; no mime known');
82 print $q->header(-type => $mime_string,
93 my ($q,$error,$text) = @_;
95 print $q->header(-status => $error);
96 print "<h2>$error: $text</h2>";