6 use Debbugs::Config qw(:config);
7 use Debbugs::CGI qw(cgi_parameters);
9 use Digest::MD5 qw(md5_hex);
11 use File::Temp qw(tempfile);
20 my $q = CGI::Simple->new();
23 cgi_parameters(query => $q,
24 single => [qw(email avatar default)],
25 default => {avatar => 'yes',
26 default => $config{libravatar_uri_options},
29 # if avatar is no, serve the empty png
30 if ($param{avatar} ne 'yes' or not defined $param{email} or not length $param{email}) {
35 # figure out what the md5sum of the e-mail is.
36 my $email_md5sum = md5_hex(lc($param{email}));
37 my $cache_location = cache_location($email_md5sum);
38 # if we've got it, and it's less than one hour old, return it.
39 if (cache_valid($cache_location)) {
40 serve_cache($cache_location,$q);
43 # if we don't have it, get it, and store it in the cache
44 $cache_location = retreive_libravatar(location => $cache_location,
45 email => lc($param{email}),
47 if (not defined $cache_location) {
48 # failure, serve the default image
52 serve_cache($cache_location,$q);
58 my ($cache_location,$q) = @_;
59 if (not defined $cache_location or not length $cache_location) {
60 # serve the default image
61 $cache_location = $config{libravatar_default_image};
63 my $fh = IO::File->new($cache_location,'r') or
64 error(404, "Failed to open cached image $cache_location");
65 my $m = File::LibMagic->new() or
66 error(500,'Unable to create File::LibMagic object');
67 my $mime_string = $m->checktype_filename($cache_location) or
68 error(500,'Bad file; no mime known');
69 print $q->header(-type => $mime_string,
78 my ($error,$text) = @_;
80 print $q->header(-status => $error);
81 print "<h2>$error: $text</h2>";